Merge pull request #2412 from frerich/reader/docbook/xref_support

Added support for <xref> tag in DocBook reader

1 files changed, 37 insertions, 5 deletions

diff --git a/src/Text/Pandoc/Readers/DocBook.hs b/src/Text/Pandoc/Readers/DocBook.hs
index 352b94496..9243221f0 100644
--- a/src/Text/Pandoc/Readers/DocBook.hs
+++ b/src/Text/Pandoc/Readers/DocBook.hs
@@ -18,6 +18,7 @@ import Text.TeXMath (readMathML, writeTeX)
 import Text.Pandoc.Error (PandocError)
 import Text.Pandoc.Compat.Except
 import Data.Default
+import Data.Foldable (asum)
 
 {-
 
@@ -498,7 +499,7 @@ List of all DocBook tags, with [x] indicating implemented,
 [x] warning - An admonition set off from the text
 [x] wordasword - A word meant specifically as a word and not representing
     anything else
-[ ] xref - A cross reference to another part of the document
+[x] xref - A cross reference to another part of the document
 [ ] year - The year of publication of a document
 [x] ?asciidoc-br? - line break from asciidoc docbook output
 -}
@@ -511,6 +512,7 @@ data DBState = DBState{ dbSectionLevel :: Int
                       , dbAcceptsMeta  :: Bool
                       , dbBook         :: Bool
                       , dbFigureTitle  :: Inlines
+                      , dbContent      :: [Content]
                       } deriving Show
 
 instance Default DBState where
@@ -519,13 +521,14 @@ instance Default DBState where
                , dbMeta = mempty
                , dbAcceptsMeta = False
                , dbBook = False
-               , dbFigureTitle = mempty }
+               , dbFigureTitle = mempty
+               , dbContent = [] }
 
 
 readDocBook :: ReaderOptions -> String -> Either PandocError Pandoc
 readDocBook _ inp  = (\blocks -> Pandoc (dbMeta st') (toList . mconcat $ blocks)) <$>  bs
-  where (bs , st') = flip runState def . runExceptT . mapM parseBlock . normalizeTree . parseXML $ inp'
-        inp' = handleInstructions inp
+  where (bs , st') = flip runState (def{ dbContent = tree }) . runExceptT . mapM parseBlock $ tree
+        tree = normalizeTree . parseXML . handleInstructions $ inp
 
 -- We treat <?asciidoc-br?> specially (issue #1236), converting it
 -- to <br/>, since xml-light doesn't parse the instruction correctly.
@@ -950,7 +953,13 @@ parseInline (Elem e) =
         "keycombo" -> keycombo <$> (mapM parseInline $ elContent e)
         "menuchoice" -> menuchoice <$> (mapM parseInline $
                                         filter isGuiMenu $ elContent e)
-        "xref" -> return $ str "?" -- so at least you know something is there
+        "xref" -> do
+            content <- dbContent <$> get
+            let linkend = attrValue "linkend" e
+            let title = case attrValue "endterm" e of
+                            ""      -> maybe "???" xrefTitleByElem (findElementById linkend content)
+                            endterm -> maybe "???" strContent (findElementById endterm content)
+            return $ link ('#' : linkend) "" (singleton (Str title))
         "email" -> return $ link ("mailto:" ++ strContent e) ""
                           $ str $ strContent e
         "uri" -> return $ link (strContent e) "" $ str $ strContent e
@@ -1011,3 +1020,26 @@ parseInline (Elem e) =
          isGuiMenu (Elem x) = named "guimenu" x || named "guisubmenu" x ||
                               named "guimenuitem" x
          isGuiMenu _        = False
+
+         findElementById idString content
+            = asum [filterElement (\x -> attrValue "id" x == idString) el | Elem el <- content]
+
+         -- Use the 'xreflabel' attribute for getting the title of a xref link;
+         -- if there's no such attribute, employ some heuristics based on what
+         -- docbook-xsl does.
+         xrefTitleByElem el
+             | not (null xrefLabel) = xrefLabel
+             | otherwise            = case qName (elName el) of
+                  "chapter"      -> descendantContent "title" el
+                  "sect1"        -> descendantContent "title" el
+                  "sect2"        -> descendantContent "title" el
+                  "sect3"        -> descendantContent "title" el
+                  "sect4"        -> descendantContent "title" el
+                  "sect5"        -> descendantContent "title" el
+                  "cmdsynopsis"  -> descendantContent "command" el
+                  "funcsynopsis" -> descendantContent "function" el
+                  _              -> qName (elName el) ++ "_title"
+          where
+            xrefLabel = attrValue "xreflabel" el
+            descendantContent name = maybe "???" strContent
+                                   . findElement (QName name Nothing Nothing)