Add `<titleabbr>` support to DocBook reader

4 files changed, 24 insertions, 6 deletions

diff --git a/src/Text/Pandoc/Readers/DocBook.hs b/src/Text/Pandoc/Readers/DocBook.hs
index bdf802925..be90eb23e 100644
--- a/src/Text/Pandoc/Readers/DocBook.hs
+++ b/src/Text/Pandoc/Readers/DocBook.hs
@@ -19,7 +19,7 @@ import Data.Foldable (asum)
 import Data.Generics
 import Data.List (intersperse,elemIndex)
 import Data.List.NonEmpty (nonEmpty)
-import Data.Maybe (catMaybes,fromMaybe,mapMaybe)
+import Data.Maybe (catMaybes,fromMaybe,mapMaybe,maybeToList)
 import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as TL
@@ -829,7 +829,7 @@ parseBlock (Elem e) =
         "section" -> gets dbSectionLevel >>= sect . (+1)
         "simplesect" ->
           gets dbSectionLevel >>=
-          sectWith (attrValue "id" e,["unnumbered"],[]) . (+1)
+          sectWith(attrValue "id" e) ["unnumbered"] [] . (+1)
         "refsect1" -> sect 1
         "refsect2" -> sect 2
         "refsect3" -> sect 3
@@ -994,8 +994,8 @@ parseBlock (Elem e) =
                                      (TableHead nullAttr $ toHeaderRow headrows)
                                      [TableBody nullAttr 0 [] $ map toRow bodyrows]
                                      (TableFoot nullAttr [])
-         sect n = sectWith (attrValue "id" e,[],[]) n
-         sectWith attr n = do
+         sect n = sectWith(attrValue "id" e) [] [] n
+         sectWith elId classes attrs n = do
            isbook <- gets dbBook
            let n' = if isbook || n == 0 then n + 1 else n
            headerText <- case filterChild (named "title") e `mplus`
@@ -1006,7 +1006,14 @@ parseBlock (Elem e) =
            modify $ \st -> st{ dbSectionLevel = n }
            b <- getBlocks e
            modify $ \st -> st{ dbSectionLevel = n - 1 }
-           return $ headerWith attr n' headerText <> b
+           return $ headerWith (elId, classes, maybeToList titleabbrevElAsAttr++attrs) n' headerText <> b
+         titleabbrevElAsAttr = do
+           txt <- case filterChild (named "titleabbrev") e `mplus`
+                            (filterChild (named "info") e >>=
+                                filterChild (named "titleabbrev")) of
+                            Just t  -> Just ("titleabbrev", strContentRecursive t)
+                            Nothing -> Nothing
+           return txt
          lineItems = mapM getInlines $ filterChildren (named "line") e
          -- | Admonitions are parsed into a div. Following other Docbook tools that output HTML,
          -- we parse the optional title as a div with the @title@ class, and give the
diff --git a/test/docbook-reader.docbook b/test/docbook-reader.docbook
index 00bd84649..8b0b34c42 100644
--- a/test/docbook-reader.docbook
+++ b/test/docbook-reader.docbook
@@ -1615,4 +1615,8 @@ or here: &lt;http://example.com/&gt;
     <indexterm><primary>food</primary><secondary>big <foreignphrase>baguette</foreignphrase> <strong>supreme</strong></secondary></indexterm>Nested content in index term elements is flattened.
   </para>
 </sect1>
+<sect1 id="titleabbrev">
+  <title>Abbreviated title</title>
+  <titleabbrev>Abbr. title</titleabbrev>
+</sect1>
 </article>
diff --git a/test/docbook-reader.native b/test/docbook-reader.native
index 7520068b1..16eef6632 100644
--- a/test/docbook-reader.native
+++ b/test/docbook-reader.native
@@ -3117,4 +3117,11 @@ Pandoc
       , Space
       , Str "flattened."
       ]
+  , Header
+      1
+      ( "titleabbrev"
+      , []
+      , [ ( "titleabbrev" , "Abbr. title" ) ]
+      )
+      [ Str "Abbreviated" , Space , Str "title" ]
   ]
diff --git a/test/docbook-xref.native b/test/docbook-xref.native
index 1b4ced24e..2983eac0c 100644
--- a/test/docbook-xref.native
+++ b/test/docbook-xref.native
@@ -156,7 +156,7 @@ Pandoc
       [ Str "Some" , Space , Str "content" , Space , Str "here" ]
   , Header
       1
-      ( "ch04" , [] , [] )
+      ( "ch04" , [] , [ ( "titleabbrev" , "Chapter 4" ) ] )
       [ Str "The" , Space , Str "Fourth" , Space , Str "Chapter" ]
   , Para
       [ Str "Some" , Space , Str "content" , Space , Str "here" ]