diff options
Diffstat (limited to 'src/Text/Pandoc/Writers/Docbook.hs')
| -rw-r--r-- | src/Text/Pandoc/Writers/Docbook.hs | 136 |
1 files changed, 69 insertions, 67 deletions
diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs index b46bb0eb4..fc97ed3ac 100644 --- a/src/Text/Pandoc/Writers/Docbook.hs +++ b/src/Text/Pandoc/Writers/Docbook.hs @@ -31,53 +31,49 @@ module Text.Pandoc.Writers.Docbook ( writeDocbook) where import Text.Pandoc.Definition import Text.Pandoc.XML import Text.Pandoc.Shared +import Text.Pandoc.Templates (renderTemplate) import Text.Pandoc.Readers.TeXMath -import Data.List ( isPrefixOf, drop, intercalate ) +import Data.List ( isPrefixOf, intercalate ) import Data.Char ( toLower ) import Text.PrettyPrint.HughesPJ hiding ( Str ) import Text.Pandoc.Highlighting (languages, languagesByExtension) -- | Convert list of authors to a docbook <author> section -authorToDocbook :: [Char] -> Doc -authorToDocbook name = inTagsIndented "author" $ - if ',' `elem` name - then -- last name first - let (lastname, rest) = break (==',') name - firstname = removeLeadingSpace rest in - inTagsSimple "firstname" (text $ escapeStringForXML firstname) <> - inTagsSimple "surname" (text $ escapeStringForXML lastname) - else -- last name last - let namewords = words name - lengthname = length namewords - (firstname, lastname) = case lengthname of - 0 -> ("","") - 1 -> ("", name) - n -> (intercalate " " (take (n-1) namewords), last namewords) - in inTagsSimple "firstname" (text $ escapeStringForXML firstname) $$ - inTagsSimple "surname" (text $ escapeStringForXML lastname) +authorToDocbook :: WriterOptions -> [Inline] -> Doc +authorToDocbook opts name' = + let name = render $ inlinesToDocbook opts name' + in if ',' `elem` name + then -- last name first + let (lastname, rest) = break (==',') name + firstname = removeLeadingSpace rest in + inTagsSimple "firstname" (text $ escapeStringForXML firstname) <> + inTagsSimple "surname" (text $ escapeStringForXML lastname) + else -- last name last + let namewords = words name + lengthname = length namewords + (firstname, lastname) = case lengthname of + 0 -> ("","") + 1 -> ("", name) + n -> (intercalate " " (take (n-1) namewords), last namewords) + in inTagsSimple "firstname" (text $ escapeStringForXML firstname) $$ + inTagsSimple "surname" (text $ escapeStringForXML lastname) -- | Convert Pandoc document to string in Docbook format. writeDocbook :: WriterOptions -> Pandoc -> String -writeDocbook opts (Pandoc (Meta title authors date) blocks) = - let head' = if writerStandalone opts - then text (writerHeader opts) - else empty - meta = if writerStandalone opts - then inTagsIndented "articleinfo" $ - (inTagsSimple "title" (wrap opts title)) $$ - (vcat (map authorToDocbook authors)) $$ - (inTagsSimple "date" (text $ escapeStringForXML date)) - else empty +writeDocbook opts (Pandoc (Meta tit auths dat) blocks) = + let title = wrap opts tit + authors = map (authorToDocbook opts) auths + date = inlinesToDocbook opts dat elements = hierarchicalize blocks - before = writerIncludeBefore opts - after = writerIncludeAfter opts - body = (if null before then empty else text before) $$ - vcat (map (elementToDocbook opts) elements) $$ - (if null after then empty else text after) - body' = if writerStandalone opts - then inTagsIndented "article" (meta $$ body) - else body - in render $ head' $$ body' $$ text "" + main = render $ vcat (map (elementToDocbook opts) elements) + context = writerVariables opts ++ + [ ("body", main) + , ("title", render title) + , ("date", render date) ] ++ + [ ("author", render a) | a <- authors ] + in if writerStandalone opts + then renderTemplate context $ writerTemplate opts + else main -- | Convert an Element to Docbook. elementToDocbook :: WriterOptions -> Element -> Doc @@ -128,6 +124,14 @@ blockToDocbook :: WriterOptions -> Block -> Doc blockToDocbook _ Null = empty blockToDocbook _ (Header _ _) = empty -- should not occur after hierarchicalize blockToDocbook opts (Plain lst) = wrap opts lst +blockToDocbook opts (Para [Image txt (src,_)]) = + let capt = inlinesToDocbook opts txt + in inTagsIndented "figure" $ + inTagsSimple "title" capt $$ + (inTagsIndented "mediaobject" $ + (inTagsIndented "imageobject" + (selfClosingTag "imagedata" [("fileref",src)])) $$ + inTagsSimple "textobject" (inTagsSimple "phrase" capt)) blockToDocbook opts (Para lst) = inTagsIndented "para" $ wrap opts lst blockToDocbook opts (BlockQuote blocks) = inTagsIndented "blockquote" $ blocksToDocbook opts blocks @@ -167,24 +171,22 @@ blockToDocbook _ HorizontalRule = empty -- not semantic blockToDocbook opts (Table caption aligns widths headers rows) = let alignStrings = map alignmentToString aligns captionDoc = if null caption - then empty - else inTagsIndented "caption" - (inlinesToDocbook opts caption) + then empty + else inTagsIndented "caption" + (inlinesToDocbook opts caption) tableType = if isEmpty captionDoc then "informaltable" else "table" - in inTagsIndented tableType $ captionDoc $$ - (colHeadsToDocbook opts alignStrings widths headers) $$ - (vcat $ map (tableRowToDocbook opts alignStrings) rows) - -colHeadsToDocbook :: WriterOptions - -> [[Char]] - -> [Double] - -> [[Block]] - -> Doc -colHeadsToDocbook opts alignStrings widths headers = - let heads = zipWith3 (\align width item -> - tableItemToDocbook opts "th" align width item) - alignStrings widths headers - in inTagsIndented "tr" $ vcat heads + percent w = show (truncate (100*w) :: Integer) ++ "%" + coltags = if all (== 0.0) widths + then empty + else vcat $ map (\w -> + selfClosingTag "col" [("width", percent w)]) widths + head' = if all null headers + then empty + else inTagsIndented "thead" $ + tableRowToDocbook opts alignStrings "th" headers + body' = inTagsIndented "tbody" $ + vcat $ map (tableRowToDocbook opts alignStrings "td") rows + in inTagsIndented tableType $ captionDoc $$ coltags $$ head' $$ body' alignmentToString :: Alignment -> [Char] alignmentToString alignment = case alignment of @@ -193,22 +195,22 @@ alignmentToString alignment = case alignment of AlignCenter -> "center" AlignDefault -> "left" -tableRowToDocbook :: WriterOptions -> [[Char]] -> [[Block]] -> Doc -tableRowToDocbook opts aligns cols = inTagsIndented "tr" $ - vcat $ zipWith3 (tableItemToDocbook opts "td") aligns (repeat 0) cols +tableRowToDocbook :: WriterOptions + -> [String] + -> String + -> [[Block]] + -> Doc +tableRowToDocbook opts aligns celltype cols = + inTagsIndented "tr" $ vcat $ + zipWith (tableItemToDocbook opts celltype) aligns cols tableItemToDocbook :: WriterOptions -> [Char] -> [Char] - -> Double -> [Block] -> Doc -tableItemToDocbook opts tag align width item = - let attrib = [("align", align)] ++ - if width /= 0 - then [("style", "{width: " ++ - show (truncate (100*width) :: Integer) ++ "%;}")] - else [] +tableItemToDocbook opts tag align item = + let attrib = [("align", align)] in inTags True tag attrib $ vcat $ map (blockToDocbook opts) item -- | Take list of inline elements and return wrapped doc. @@ -243,9 +245,9 @@ inlineToDocbook opts (Quoted _ lst) = inlineToDocbook opts (Cite _ lst) = inlinesToDocbook opts lst inlineToDocbook _ Apostrophe = char '\'' -inlineToDocbook _ Ellipses = text "…" -inlineToDocbook _ EmDash = text "—" -inlineToDocbook _ EnDash = text "–" +inlineToDocbook _ Ellipses = text "…" +inlineToDocbook _ EmDash = text "—" +inlineToDocbook _ EnDash = text "–" inlineToDocbook _ (Code str) = inTagsSimple "literal" $ text (escapeStringForXML str) inlineToDocbook opts (Math _ str) = inlinesToDocbook opts $ readTeXMath str |