Store "unnumbered" class in DocBook role attribute (#8481)

Markdown allows marking a heading as unnumbered, which is stored
as a class token internally. This change will recognize this
particular class token and append it to the role attribute, or
create a role attribute with it if needed. This does not imply
any processing in DocBook but is intended to let customized
stylesheets identify these sections and act accordingly.

Closes #1402

1 files changed, 12 insertions, 3 deletions

diff --git a/src/Text/Pandoc/Writers/DocBook.hs b/src/Text/Pandoc/Writers/DocBook.hs
index 6e3d5bd79..e9eceb60c 100644
--- a/src/Text/Pandoc/Writers/DocBook.hs
+++ b/src/Text/Pandoc/Writers/DocBook.hs
@@ -14,7 +14,7 @@ Conversion of 'Pandoc' documents to DocBook XML.
 module Text.Pandoc.Writers.DocBook ( writeDocBook4, writeDocBook5 ) where
 import Control.Monad.Reader
 import Data.Generics (everywhere, mkT)
-import Data.Maybe (isNothing)
+import Data.Maybe (isNothing, maybeToList)
 import Data.Monoid (Any (..))
 import Data.Text (Text)
 import qualified Data.Text as T
@@ -169,7 +169,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 (_,_,attrs) ils : xs)) = do
+blockToDocBook opts (Div (id',"section":_,_) (Header lvl (_,classes,attrs) ils : xs)) = do
   version <- ask
   -- DocBook doesn't allow sections with no content, so insert some if needed
   let bs = if null xs
@@ -191,7 +191,8 @@ blockToDocBook opts (Div (id',"section":_,_) (Header lvl (_,_,attrs) ils : xs))
                  else []
 
       -- Populate miscAttr with Header.Attr.attributes, filtering out non-valid DocBook section attributes, id, and xml:id
-      miscAttr = filter (isSectionAttr version) attrs
+      -- Also enrich the role attribute with certain class tokens
+      miscAttr = enrichRole (filter (isSectionAttr version) attrs) classes      
       attribs = nsAttr <> idAttr <> miscAttr
   title' <- inlinesToDocBook opts ils
   contents <- blocksToDocBook opts bs
@@ -464,6 +465,14 @@ idAndRole (id',cls,_) = ident <> role
     ident = [("id", id') | not (T.null id')]
     role  = [("role", T.unwords cls) | not (null cls)]
 
+-- Used in blockToDocBook for Header (section) to create or extend
+-- the role attribute with candidate class tokens
+enrichRole :: [(Text, Text)] -> [Text] -> [(Text, Text)]
+enrichRole mattrs cls = [("role",rolevals) | rolevals /= ""]<>(filter (\x -> (fst x) /= "role") mattrs)
+  where
+    rolevals = T.unwords((filter (`elem` cand) cls)<>(maybeToList(lookup "role" mattrs)))
+    cand = ["unnumbered"]
+
 isSectionAttr :: DocBookVersion -> (Text, Text) -> Bool
 isSectionAttr _ ("label",_) = True
 isSectionAttr _ ("status",_) = True