@@ -12,7 +12,7 @@ Conversion of DocBook XML to 'Pandoc' document.
1212-}
1313module Text.Pandoc.Readers.DocBook ( readDocBook ) where
1414import Control.Monad.State.Strict
15−import Data.Char (isSpace, toUpper)
15+import Data.Char (isSpace, toUpper, isLetter)
1616import Data.Default
1717import Data.Either (rights)
1818import Data.Foldable (asum)
@@ -21,7 +21,10 @@ import Data.List (intersperse,elemIndex)
2121import Data.Maybe (fromMaybe,mapMaybe)
2222import Data.Text (Text)
2323import qualified Data.Text as T
24+import qualified Data.Text.Lazy as TL
25+import Control.Monad.Except (throwError)
2426import Text.HTML.TagSoup.Entity (lookupEntity)
27+import Text.Pandoc.Error (PandocError(..))
2528import Text.Pandoc.Builder
2629import Text.Pandoc.Class.PandocMonad (PandocMonad, report)
2730import Text.Pandoc.Options
@@ -29,6 +32,7 @@ import Text.Pandoc.Logging (LogMessage(..))
2932import Text.Pandoc.Shared (crFilter, safeRead, extractSpaces)
3033import Text.TeXMath (readMathML, writeTeX)
3134import Text.XML.Light
35+import Text.Pandoc.XMLParser (parseXMLContents)
3236
3337{-
3438
@@ -537,22 +541,25 @@ instance Default DBState where
537541
538542readDocBook :: PandocMonad m => ReaderOptions -> Text -> m Pandoc
539543readDocBook _ inp = do
540− let tree = normalizeTree . parseXML . handleInstructions $ crFilter inp
544+ tree <- either (throwError . PandocXMLError "") (return . normalizeTree) $
545+ parseXMLContents (TL.fromStrict . handleInstructions $ crFilter inp)
541546 (bs, st') <- flip runStateT (def{ dbContent = tree }) $ mapM parseBlock tree
542547 return $ Pandoc (dbMeta st') (toList . mconcat $ bs)
543548
544−-- We treat <?asciidoc-br?> specially (issue #1236), converting it
545−-- to <br/>, since xml-light doesn't parse the instruction correctly.
546−-- Other xml instructions are simply removed from the input stream.
549+-- We treat certain processing instructions by converting them to tags
550+-- beginning "pi-".
547551handleInstructions :: Text -> Text
548−handleInstructions = T.pack . handleInstructions' . T.unpack
549−
550−handleInstructions' :: String -> String
551−handleInstructions' ('<':'?':'a':'s':'c':'i':'i':'d':'o':'c':'-':'b':'r':'?':'>':xs) = '<':'b':'r':'/':'>': handleInstructions' xs
552−handleInstructions' xs = case break (=='<') xs of
553− (ys, []) -> ys
554− ([], '<':zs) -> '<' : handleInstructions' zs
555− (ys, zs) -> ys ++ handleInstructions' zs
552+handleInstructions t =
553+ let (x,y) = T.breakOn "<?" t
554+ in if T.null y
555+ then x
556+ else
557+ let (w,z) = T.breakOn "?>" y
558+ in (if T.takeWhile (\c -> isLetter c || c == '-')
559+ (T.drop 2 w) `elem` ["asciidoc-br", "dbfo"]
560+ then x <> "<pi-" <> T.drop 2 w <> "/>"
561+ else x <> w <> T.take 2 z) <>
562+ handleInstructions (T.drop 2 z)
556563
557564getFigure :: PandocMonad m => Element -> DB m Blocks
558565getFigure e = do
@@ -892,7 +899,11 @@ parseBlock (Elem e) =
892899 "subtitle" -> return mempty -- handled in parent element
893900 _ -> skip >> getBlocks e
894901 where skip = do
895− lift $ report $ IgnoredElement $ T.pack $ qName (elName e)
902+ let qn = T.pack $ qName $ elName e
903+ let name = if "pi-" `T.isPrefixOf` qn
904+ then "<?" <> qn <> "?>"
905+ else qn
906+ lift $ report $ IgnoredElement name
896907 return mempty
897908
898909 codeBlockWithLang = do
@@ -964,7 +975,7 @@ parseBlock (Elem e) =
964975 cs -> map toAlignment cs
965976 let parseWidth s = safeRead (T.filter (\x -> (x >= '0' && x <= '9')
966977 || x == '.') s)
967− let textWidth = case filterChild (named "?dbfo") e of
978+ let textWidth = case filterChild (named "pi-dbfo") e of
968979 Just d -> case attrValue "table-width" d of
969980 "" -> 1.0
970981 w -> fromMaybe 100.0 (parseWidth w) / 100.0
@@ -1165,12 +1176,15 @@ parseInline (Elem e) =
11651176 "title" -> return mempty
11661177 "affiliation" -> skip
11671178 -- Note: this isn't a real docbook tag; it's what we convert
1168− -- <?asciidor-br?> to in handleInstructions, above. A kludge to
1169− -- work around xml-light's inability to parse an instruction.
1170− "br" -> return linebreak
1179+ -- <?asciidor-br?> to in handleInstructions, above.
1180+ "pi-asciidoc-br" -> return linebreak
11711181 _ -> skip >> innerInlines id
11721182 where skip = do
1173− lift $ report $ IgnoredElement $ T.pack $ qName (elName e)
1183+ let qn = T.pack $ qName $ elName e
1184+ let name = if "pi-" `T.isPrefixOf` qn
1185+ then "<?" <> qn <> "?>"
1186+ else qn
1187+ lift $ report $ IgnoredElement name
11741188 return mempty
11751189
11761190 innerInlines f = extractSpaces f . mconcat <$>