@@ -5,6 +5,7 @@ import Text.Pandoc.Definition
55import Text.Pandoc.Builder
66import Text.XML.Light
77import Text.HTML.TagSoup.Entity (lookupEntity)
8+import Data.Generics
89import Data.Monoid
910import Data.Char (isSpace)
1011import Control.Monad.State
@@ -121,7 +122,7 @@ List of all DocBook tags, with [x] indicating implemented,
121122[x] entry - A cell in a table
122123[ ] entrytbl - A subtable appearing in place of an Entry in a table
123124[ ] envar - A software environment variable
124−[ ] epigraph - A short inscription at the beginning of a document or component
125+[x] epigraph - A short inscription at the beginning of a document or component
125126 note: also handle embedded attribution tag
126127[ ] equation - A displayed mathematical equation
127128[ ] errorcode - An error code
@@ -507,7 +508,7 @@ readDocBook st inp = setTitle (dbDocTitle st')
507508 $ setAuthors (dbDocAuthors st')
508509 $ setDate (dbDocDate st')
509510 $ doc $ mconcat bs
510− where (bs, st') = runState (mapM parseBlock $ parseXML inp)
511+ where (bs, st') = runState (mapM parseBlock $ normalizeTree $ parseXML inp)
511512 DBState{ dbSectionLevel = 0
512513 , dbQuoteType = DoubleQuote
513514 , dbDocTitle = mempty
@@ -516,6 +517,25 @@ readDocBook st inp = setTitle (dbDocTitle st')
516517 , dbBook = False
517518 }
518519
520+-- normalize input, consolidating adjacent Text and CRef elements
521+normalizeTree :: [Content] -> [Content]
522+normalizeTree = everywhere (mkT go)
523+ where go :: [Content] -> [Content]
524+ go (Text (CData CDataRaw _ _):xs) = xs
525+ go (Text (CData CDataText s1 z):Text (CData CDataText s2 _):xs) =
526+ Text (CData CDataText (s1 ++ s2) z):xs
527+ go (Text (CData CDataText s1 z):CRef r:xs) =
528+ Text (CData CDataText (s1 ++ [c]) z):xs
529+ where c = maybe '?' id (lookupEntity r)
530+ go (CRef r:Text (CData CDataText s1 z):xs) =
531+ Text (CData CDataText ([c] ++ s1) z):xs
532+ where c = maybe '?' id (lookupEntity r)
533+ go (CRef r1:CRef r2:xs) =
534+ Text (CData CDataText [c1,c2] Nothing):xs
535+ where c1 = maybe '?' id (lookupEntity r1)
536+ c2 = maybe '?' id (lookupEntity r2)
537+ go xs = xs
538+
519539-- convenience function to get an attribute value, defaulting to ""
520540attrValue :: String -> Element -> String
521541attrValue attr elt =
@@ -553,19 +573,14 @@ parseBlock :: Content -> DB Blocks
553573parseBlock (Text (CData CDataRaw _ _)) = return mempty -- DOCTYPE
554574parseBlock (Text (CData _ s _)) = if all isSpace s
555575 then return mempty
556− else return $ plain $ text s
576+ else return $ plain $ trimInlines $ text s
557577parseBlock (CRef _) = return mempty -- TODO need something better here
558578parseBlock (Elem e) =
559579 case qName (elName e) of
560580 "para" -> para <$> getInlines e
561581 "ackno" -> para <$> getInlines e
562− "blockquote" -> do
563− attrib <- case filterChild (named "attribution") e of
564− Nothing -> return mempty
565− Just z -> (para . (str "— " <>) . mconcat)
566− <$> (mapM parseInline $ elContent z)
567− contents <- getBlocks e
568− return $ blockQuote (contents <> attrib)
582+ "epigraph" -> parseBlockquote
583+ "blockquote" -> parseBlockquote
569584 "attribution" -> return mempty
570585 "titleabbrev" -> return mempty
571586 "authorinitials" -> return mempty
@@ -618,6 +633,13 @@ parseBlock (Elem e) =
618633 skipWhite (Text (CData _ s _):xs) | all isSpace s = skipWhite xs
619634 | otherwise = xs
620635 skipWhite xs = xs
636+ parseBlockquote = do
637+ attrib <- case filterChild (named "attribution") e of
638+ Nothing -> return mempty
639+ Just z -> (para . (str "— " <>) . mconcat)
640+ <$> (mapM parseInline $ elContent z)
641+ contents <- getBlocks e
642+ return $ blockQuote (contents <> attrib)
621643 listitems = mapM getBlocks $ filterChildren (named "listitem") e
622644 deflistitems = mapM parseVarListEntry $ filterChildren
623645 (named "varlistentry") e