diff options
Diffstat (limited to 'src/Text/Pandoc/Readers/DocBook.hs')
| -rw-r--r-- | src/Text/Pandoc/Readers/DocBook.hs | 53 |
1 files changed, 43 insertions, 10 deletions
diff --git a/src/Text/Pandoc/Readers/DocBook.hs b/src/Text/Pandoc/Readers/DocBook.hs index db438e26d..e8fe92e27 100644 --- a/src/Text/Pandoc/Readers/DocBook.hs +++ b/src/Text/Pandoc/Readers/DocBook.hs @@ -8,16 +8,15 @@ import Text.XML.Light import Text.Pandoc.Compat.TagSoupEntity (lookupEntity) import Data.Either (rights) import Data.Generics -import Data.Monoid import Data.Char (isSpace) import Control.Monad.State -import Control.Applicative ((<$>)) import Data.List (intersperse) import Data.Maybe (fromMaybe) import Text.TeXMath (readMathML, writeTeX) import Text.Pandoc.Error (PandocError) import Text.Pandoc.Compat.Except import Data.Default +import Data.Foldable (asum) {- @@ -194,7 +193,7 @@ List of all DocBook tags, with [x] indicating implemented, [x] indexterm - A wrapper for terms to be indexed [x] info - A wrapper for information about a component or other block. (DocBook v5) [x] informalequation - A displayed mathematical equation without a title -[ ] informalexample - A displayed example without a title +[x] informalexample - A displayed example without a title [ ] informalfigure - A untitled figure [ ] informaltable - A table without a title [ ] initializer - The initializer for a FieldSynopsis @@ -498,7 +497,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 +510,7 @@ data DBState = DBState{ dbSectionLevel :: Int , dbAcceptsMeta :: Bool , dbBook :: Bool , dbFigureTitle :: Inlines + , dbContent :: [Content] } deriving Show instance Default DBState where @@ -519,13 +519,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. @@ -611,6 +612,7 @@ isBlockElement (Elem e) = qName (elName e) `elem` blocktags "important","caution","note","tip","warning","qandadiv", "question","answer","abstract","itemizedlist","orderedlist", "variablelist","article","book","table","informaltable", + "informalexample", "screen","programlisting","example","calloutlist"] isBlockElement _ = False @@ -656,7 +658,7 @@ getMediaobject e = do let (caption, title) = if isNull figTitle then (getCaption e, "") else (return figTitle, "fig:") - liftM (imageWith imageUrl title attr) caption + liftM (imageWith attr imageUrl title) caption getBlocks :: Element -> DB Blocks getBlocks e = mconcat <$> (mapM parseBlock $ elContent e) @@ -775,6 +777,8 @@ parseBlock (Elem e) = "book" -> modify (\st -> st{ dbBook = True }) >> getBlocks e "table" -> parseTable "informaltable" -> parseTable + "informalexample" -> divWith ("", ["informalexample"], []) <$> + getBlocks e "literallayout" -> codeBlockWithLang "screen" -> codeBlockWithLang "programlisting" -> codeBlockWithLang @@ -956,7 +960,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 @@ -968,7 +978,7 @@ parseInline (Elem e) = _ -> ('#' : attrValue "linkend" e) let ils' = if ils == mempty then str href else ils let attr = (attrValue "id" e, words $ attrValue "role" e, []) - return $ linkWith href "" attr ils' + return $ linkWith attr href "" ils' "foreignphrase" -> emph <$> innerInlines "emphasis" -> case attrValue "role" e of "bold" -> strong <$> innerInlines @@ -1018,3 +1028,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) |