aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-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>"
+ ]
+ ]
]