aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorErik Rask <erik.rask@paligo.net>2021-02-19 13:05:35 +0100
committerAlbert Krewinkel <albert+github@zeitkraut.de>2021-03-20 21:29:17 +0100
commit82e8c29cb0a89d7129f459bef6696254ec56e0c6 (patch)
tree5c731b7ce446a3622cb4a6091b2ed5d46a749e3f
parent38618098153c29ea2a39fa6102e9e681136e6fd4 (diff)
downloadpandoc-82e8c29cb0a89d7129f459bef6696254ec56e0c6.tar.gz
Include Header.Attr.attributes as XML attributes on section
Add key-value pairs found in the attributes list of Header.Attr as XML attributes on the corresponding section element. Any key name not allowed as an XML attribute name is dropped, as are keys with invalid values where they are defined as enums in DocBook, and xml:id (for DocBook 5)/id (for DocBook 4) to not intervene with computed identifiers.
-rw-r--r--src/Text/Pandoc/Writers/Docbook.hs47
-rw-r--r--test/Tests/Writers/Docbook.hs37
2 files changed, 82 insertions, 2 deletions
diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs
index a6776608d..1f10c9d04 100644
--- a/src/Text/Pandoc/Writers/Docbook.hs
+++ b/src/Text/Pandoc/Writers/Docbook.hs
@@ -168,7 +168,7 @@ blockToDocbook :: PandocMonad m => WriterOptions -> Block -> DB m (Doc Text)
blockToDocbook _ Null = return empty
-- Add ids to paragraphs in divs with ids - this is needed for
-- pandoc-citeproc to get link anchors in bibliographies:
-blockToDocbook opts (Div (id',"section":_,_) (Header lvl _ ils : xs)) = do
+blockToDocbook opts (Div (id',"section":_,_) (Header lvl (_,_,attrs) ils : xs)) = do
version <- ask
-- Docbook doesn't allow sections with no content, so insert some if needed
let bs = if null xs
@@ -188,7 +188,10 @@ blockToDocbook opts (Div (id',"section":_,_) (Header lvl _ ils : xs)) = do
-- standalone documents will include them in the template.
then [("xmlns", "http://docbook.org/ns/docbook"),("xmlns:xlink", "http://www.w3.org/1999/xlink")]
else []
- attribs = nsAttr <> idAttr
+
+ -- Populate miscAttr with Header.Attr.attributes, filtering out non-valid DocBook section attributes, id, and xml:id
+ miscAttr = filter (isSectionAttr version) attrs
+ attribs = nsAttr <> idAttr <> miscAttr
title' <- inlinesToDocbook opts ils
contents <- blocksToDocbook opts bs
return $ inTags True tag attribs $ inTagsSimple "title" title' $$ contents
@@ -451,3 +454,43 @@ idAndRole (id',cls,_) = ident <> role
where
ident = [("id", id') | not (T.null id')]
role = [("role", T.unwords cls) | not (null cls)]
+
+isSectionAttr :: DocBookVersion -> (Text, Text) -> Bool
+isSectionAttr _ ("label",_) = True
+isSectionAttr _ ("status",_) = True
+isSectionAttr DocBook5 ("annotations",_) = True
+isSectionAttr DocBook5 ("dir","ltr") = True
+isSectionAttr DocBook5 ("dir","rtl") = True
+isSectionAttr DocBook5 ("dir","lro") = True
+isSectionAttr DocBook5 ("dir","rlo") = True
+isSectionAttr _ ("remap",_) = True
+isSectionAttr _ ("revisionflag","changed") = True
+isSectionAttr _ ("revisionflag","added") = True
+isSectionAttr _ ("revisionflag","deleted") = True
+isSectionAttr _ ("revisionflag","off") = True
+isSectionAttr _ ("role",_) = True
+isSectionAttr DocBook5 ("version",_) = True
+isSectionAttr DocBook5 ("xml:base",_) = True
+isSectionAttr DocBook5 ("xml:lang",_) = True
+isSectionAttr _ ("xreflabel",_) = True
+isSectionAttr DocBook5 ("linkend",_) = True
+isSectionAttr DocBook5 ("linkends",_) = True
+isSectionAttr DocBook5 ("xlink:actuate",_) = True
+isSectionAttr DocBook5 ("xlink:arcrole",_) = True
+isSectionAttr DocBook5 ("xlink:from",_) = True
+isSectionAttr DocBook5 ("xlink:href",_) = True
+isSectionAttr DocBook5 ("xlink:label",_) = True
+isSectionAttr DocBook5 ("xlink:role",_) = True
+isSectionAttr DocBook5 ("xlink:show",_) = True
+isSectionAttr DocBook5 ("xlink:title",_) = True
+isSectionAttr DocBook5 ("xlink:to",_) = True
+isSectionAttr DocBook5 ("xlink:type",_) = True
+isSectionAttr DocBook4 ("arch",_) = True
+isSectionAttr DocBook4 ("condition",_) = True
+isSectionAttr DocBook4 ("conformance",_) = True
+isSectionAttr DocBook4 ("lang",_) = True
+isSectionAttr DocBook4 ("os",_) = True
+isSectionAttr DocBook4 ("revision",_) = True
+isSectionAttr DocBook4 ("security",_) = True
+isSectionAttr DocBook4 ("vendor",_) = True
+isSectionAttr _ (_,_) = False \ No newline at end of file
diff --git a/test/Tests/Writers/Docbook.hs b/test/Tests/Writers/Docbook.hs
index 842aed7ae..46203eeae 100644
--- a/test/Tests/Writers/Docbook.hs
+++ b/test/Tests/Writers/Docbook.hs
@@ -11,9 +11,14 @@ import Text.Pandoc.Builder
docbook :: (ToPandoc a) => a -> String
docbook = docbookWithOpts def{ writerWrapText = WrapNone }
+docbook5 :: (ToPandoc a) => a -> String
+docbook5 = docbook5WithOpts def{ writerWrapText = WrapNone }
+
docbookWithOpts :: ToPandoc a => WriterOptions -> a -> String
docbookWithOpts opts = unpack . purely (writeDocbook4 opts) . toPandoc
+docbook5WithOpts :: ToPandoc a => WriterOptions -> a -> String
+docbook5WithOpts opts = unpack . purely (writeDocbook5 opts) . toPandoc
{-
"my test" =: X =?> Y
@@ -366,4 +371,36 @@ tests = [ testGroup "line blocks"
]
]
]
+ , testGroup "section attributes" $
+ let
+ headers = headerWith ("myid1",[],[("role","internal"),("xml:id","anotherid"),("dir","rtl")]) 1 "header1"
+ <> headerWith ("myid2",[],[("invalidname","value"),("arch","linux"),("dir","invaliddir")]) 1 "header2"
+ in
+ [ test docbook5 "sections with attributes (db5)" $
+ headers =?>
+ unlines [ "<section xmlns=\"http://docbook.org/ns/docbook\" xmlns:xlink=\"http://www.w3.org/1999/xlink\" xml:id=\"myid1\" role=\"internal\" dir=\"rtl\">"
+ , " <title>header1</title>"
+ , " <para>"
+ , " </para>"
+ , "</section>"
+ , "<section xmlns=\"http://docbook.org/ns/docbook\" xmlns:xlink=\"http://www.w3.org/1999/xlink\" xml:id=\"myid2\">"
+ , " <title>header2</title>"
+ , " <para>"
+ , " </para>"
+ , "</section>"
+ ]
+ , test docbook "sections with attributes (db4)" $
+ headers =?>
+ unlines [ "<sect1 id=\"myid1\" role=\"internal\">"
+ , " <title>header1</title>"
+ , " <para>"
+ , " </para>"
+ , "</sect1>"
+ , "<sect1 id=\"myid2\" arch=\"linux\">"
+ , " <title>header2</title>"
+ , " <para>"
+ , " </para>"
+ , "</sect1>"
+ ]
+ ]
]