diff options
Diffstat (limited to 'src/Text/Pandoc/Writers')
| -rw-r--r-- | src/Text/Pandoc/Writers/ConTeXt.hs | 12 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Custom.hs | 4 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Docx.hs | 11 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/DokuWiki.hs | 5 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/EPUB.hs | 5 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/HTML.hs | 73 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/LaTeX.hs | 47 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Markdown.hs | 9 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Org.hs | 9 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/TEI.hs | 320 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Texinfo.hs | 7 |
11 files changed, 432 insertions, 70 deletions
diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs index 498e2d10f..8d54d62bd 100644 --- a/src/Text/Pandoc/Writers/ConTeXt.hs +++ b/src/Text/Pandoc/Writers/ConTeXt.hs @@ -279,7 +279,17 @@ blockListToConTeXt lst = liftM vcat $ mapM blockToConTeXt lst -- | Convert list of inline elements to ConTeXt. inlineListToConTeXt :: [Inline] -- ^ Inlines to convert -> State WriterState Doc -inlineListToConTeXt lst = liftM hcat $ mapM inlineToConTeXt lst +inlineListToConTeXt lst = liftM hcat $ mapM inlineToConTeXt $ addStruts lst + -- We add a \strut after a line break that precedes a space, + -- or the space gets swallowed + where addStruts (LineBreak : s : xs) | isSpacey s = + LineBreak : RawInline (Format "context") "\\strut " : s : + addStruts xs + addStruts (x:xs) = x : addStruts xs + addStruts [] = [] + isSpacey Space = True + isSpacey (Str ('\160':_)) = True + isSpacey _ = False -- | Convert inline element to ConTeXt inlineToConTeXt :: Inline -- ^ Inline to convert diff --git a/src/Text/Pandoc/Writers/Custom.hs b/src/Text/Pandoc/Writers/Custom.hs index 9671fc05b..d69eaaa64 100644 --- a/src/Text/Pandoc/Writers/Custom.hs +++ b/src/Text/Pandoc/Writers/Custom.hs @@ -222,8 +222,8 @@ blockToCustom _ Null = return "" blockToCustom lua (Plain inlines) = callfunc lua "Plain" inlines -blockToCustom lua (Para [Image _ txt (src,tit)]) = - callfunc lua "CaptionedImage" src tit txt +blockToCustom lua (Para [Image attr txt (src,tit)]) = + callfunc lua "CaptionedImage" src tit txt (attrToMap attr) blockToCustom lua (Para inlines) = callfunc lua "Para" inlines diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index 827d32620..a841e1b66 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -34,6 +34,7 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Char8 as BL8 import qualified Data.Map as M +import qualified Data.Set as Set import qualified Text.Pandoc.UTF8 as UTF8 import Codec.Archive.Zip import Data.Time.Clock.POSIX @@ -95,7 +96,7 @@ data WriterState = WriterState{ stTextProperties :: [Element] , stParaProperties :: [Element] , stFootnotes :: [Element] - , stSectionIds :: [String] + , stSectionIds :: Set.Set String , stExternalLinks :: M.Map String String , stImages :: M.Map FilePath (String, String, Maybe MimeType, Element, B.ByteString) , stListLevel :: Int @@ -117,7 +118,7 @@ defaultWriterState = WriterState{ stTextProperties = [] , stParaProperties = [] , stFootnotes = defaultFootnotes - , stSectionIds = [] + , stSectionIds = Set.empty , stExternalLinks = M.empty , stImages = M.empty , stListLevel = -1 @@ -742,7 +743,7 @@ blockToOpenXML opts (Header lev (ident,_,_) lst) = do let bookmarkName = if null ident then uniqueIdent lst usedIdents else ident - modify $ \s -> s{ stSectionIds = bookmarkName : stSectionIds s } + modify $ \s -> s{ stSectionIds = Set.insert bookmarkName $ stSectionIds s } id' <- getUniqueId let bookmarkStart = mknode "w:bookmarkStart" [("w:id", id') ,("w:name",bookmarkName)] () @@ -1102,7 +1103,7 @@ inlineToOpenXML opts (Link _ txt (src,_)) = do M.insert src i extlinks } return i return [ mknode "w:hyperlink" [("r:id",id')] contents ] -inlineToOpenXML opts (Image attr alt (src, tit)) = do +inlineToOpenXML opts (Image attr alt (src, _)) = do -- first, check to see if we've already done this image pageWidth <- gets stPrintWidth imgs <- gets stImages @@ -1153,7 +1154,7 @@ inlineToOpenXML opts (Image attr alt (src, tit)) = do mknode "wp:inline" [] [ mknode "wp:extent" [("cx",show xemu),("cy",show yemu)] () , mknode "wp:effectExtent" [("b","0"),("l","0"),("r","0"),("t","0")] () - , mknode "wp:docPr" [("descr",tit),("id","1"),("name","Picture")] () + , mknode "wp:docPr" [("descr",stringify alt),("id","1"),("name","Picture")] () , graphic ] let imgext = case mt >>= extensionFromMimeType of Just x -> '.':x diff --git a/src/Text/Pandoc/Writers/DokuWiki.hs b/src/Text/Pandoc/Writers/DokuWiki.hs index f1088b158..56e2b9027 100644 --- a/src/Text/Pandoc/Writers/DokuWiki.hs +++ b/src/Text/Pandoc/Writers/DokuWiki.hs @@ -452,8 +452,11 @@ inlineToDokuWiki _ (Code _ str) = inlineToDokuWiki _ (Str str) = return $ escapeString str -inlineToDokuWiki _ (Math _ str) = return $ "$" ++ str ++ "$" +inlineToDokuWiki _ (Math mathType str) = return $ delim ++ str ++ delim -- note: str should NOT be escaped + where delim = case mathType of + DisplayMath -> "$$" + InlineMath -> "$" inlineToDokuWiki _ (RawInline f str) | f == Format "dokuwiki" = return str diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs index 64f94f41f..804dbb926 100644 --- a/src/Text/Pandoc/Writers/EPUB.hs +++ b/src/Text/Pandoc/Writers/EPUB.hs @@ -31,6 +31,7 @@ Conversion of 'Pandoc' documents to EPUB. module Text.Pandoc.Writers.EPUB ( writeEPUB ) where import Data.IORef ( IORef, newIORef, readIORef, modifyIORef ) import qualified Data.Map as M +import qualified Data.Set as Set import Data.Maybe ( fromMaybe, catMaybes ) import Data.List ( isPrefixOf, isInfixOf, intercalate ) import System.Environment ( getEnv ) @@ -916,13 +917,13 @@ showChapter = printf "ch%03d.xhtml" -- Add identifiers to any headers without them. addIdentifiers :: [Block] -> [Block] -addIdentifiers bs = evalState (mapM go bs) [] +addIdentifiers bs = evalState (mapM go bs) Set.empty where go (Header n (ident,classes,kvs) ils) = do ids <- get let ident' = if null ident then uniqueIdent ils ids else ident - put $ ident' : ids + modify $ Set.insert ident' return $ Header n (ident',classes,kvs) ils go x = return x diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index 73a8906c3..c5b6a6db2 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -140,40 +140,38 @@ pandocToHtml opts (Pandoc meta blocks) = do st <- get let notes = reverse (stNotes st) let thebody = blocks' >> footnoteSection opts notes - let math = if stMath st - then case writerHTMLMathMethod opts of - LaTeXMathML (Just url) -> - H.script ! A.src (toValue url) - ! A.type_ "text/javascript" - $ mempty - MathML (Just url) -> - H.script ! A.src (toValue url) - ! A.type_ "text/javascript" - $ mempty - MathJax url -> - H.script ! A.src (toValue url) - ! A.type_ "text/javascript" - $ case writerSlideVariant opts of - SlideousSlides -> - preEscapedString - "MathJax.Hub.Queue([\"Typeset\",MathJax.Hub]);" - _ -> mempty - JsMath (Just url) -> - H.script ! A.src (toValue url) - ! A.type_ "text/javascript" - $ mempty - KaTeX js css -> - (H.script ! A.src (toValue js) $ mempty) <> - (H.link ! A.rel "stylesheet" ! A.href (toValue css)) <> - (H.script ! A.type_ "text/javascript" $ toHtml renderKaTeX) - _ -> case lookup "mathml-script" (writerVariables opts) of - Just s | not (writerHtml5 opts) -> - H.script ! A.type_ "text/javascript" - $ preEscapedString - ("/*<![CDATA[*/\n" ++ s ++ "/*]]>*/\n") - | otherwise -> mempty - Nothing -> mempty - else mempty + let math = case writerHTMLMathMethod opts of + LaTeXMathML (Just url) -> + H.script ! A.src (toValue url) + ! A.type_ "text/javascript" + $ mempty + MathML (Just url) -> + H.script ! A.src (toValue url) + ! A.type_ "text/javascript" + $ mempty + MathJax url -> + H.script ! A.src (toValue url) + ! A.type_ "text/javascript" + $ case writerSlideVariant opts of + SlideousSlides -> + preEscapedString + "MathJax.Hub.Queue([\"Typeset\",MathJax.Hub]);" + _ -> mempty + JsMath (Just url) -> + H.script ! A.src (toValue url) + ! A.type_ "text/javascript" + $ mempty + KaTeX js css -> + (H.script ! A.src (toValue js) $ mempty) <> + (H.link ! A.rel "stylesheet" ! A.href (toValue css)) <> + (H.script ! A.type_ "text/javascript" $ toHtml renderKaTeX) + _ -> case lookup "mathml-script" (writerVariables opts) of + Just s | not (writerHtml5 opts) -> + H.script ! A.type_ "text/javascript" + $ preEscapedString + ("/*<![CDATA[*/\n" ++ s ++ "/*]]>*/\n") + | otherwise -> mempty + Nothing -> mempty let context = (if stHighlighting st then defField "highlighting-css" (styleToCss $ writerHighlightStyle opts) @@ -647,7 +645,7 @@ alignmentToString alignment = case alignment of AlignLeft -> "left" AlignRight -> "right" AlignCenter -> "center" - AlignDefault -> "left" + AlignDefault -> "" tableItemToHtml :: WriterOptions -> (Html -> Html) @@ -660,7 +658,10 @@ tableItemToHtml opts tag' align' item = do let attribs = if writerHtml5 opts then A.style (toValue $ "text-align: " ++ alignStr ++ ";") else A.align (toValue alignStr) - return $ (tag' ! attribs $ contents) >> nl opts + let tag'' = if null alignStr + then tag' + else tag' ! attribs + return $ (tag'' $ contents) >> nl opts toListItems :: WriterOptions -> [Html] -> [Html] toListItems opts items = map (toListItem opts) items ++ [nl opts] diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index 7b2911bcf..0f47132b3 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -113,12 +113,7 @@ pandocToLaTeX options (Pandoc meta blocks) = do (fmap (render colwidth) . inlineListToLaTeX) meta let bookClasses = ["memoir","book","report","scrreprt","scrbook"] - let documentClass = case P.parse (do P.skipMany (P.satisfy (/='\\')) - P.string "\\documentclass" - P.skipMany (P.satisfy (/='{')) - P.char '{' - P.manyTill P.letter (P.char '}')) "template" - template of + let documentClass = case P.parse pDocumentClass "template" template of Right r -> r Left _ -> "" case lookup "documentclass" (writerVariables options) `mplus` @@ -577,26 +572,29 @@ blockToLaTeX (Header level (id',classes,_) lst) = do blockToLaTeX (Table caption aligns widths heads rows) = do headers <- if all null heads then return empty - else ($$ "\\midrule\n") `fmap` - (tableRowToLaTeX True aligns widths) heads + else do + contents <- (tableRowToLaTeX True aligns widths) heads + return ("\\toprule" $$ contents $$ "\\midrule") let endhead = if all null heads then empty else text "\\endhead" + let endfirsthead = if all null heads + then empty + else text "\\endfirsthead" captionText <- inlineListToLaTeX caption let capt = if isEmpty captionText then empty - else text "\\caption" <> braces captionText - <> "\\tabularnewline\n\\toprule\n" - <> headers - <> "\\endfirsthead" + else text "\\caption" <> braces captionText <> "\\tabularnewline" + $$ headers + $$ endfirsthead rows' <- mapM (tableRowToLaTeX False aligns widths) rows let colDescriptors = text $ concat $ map toColDescriptor aligns modify $ \s -> s{ stTable = True } - return $ "\\begin{longtable}[c]" <> + return $ "\\begin{longtable}[]" <> braces ("@{}" <> colDescriptors <> "@{}") -- the @{} removes extra space at beginning and end $$ capt - $$ "\\toprule" + $$ (if all null heads then "\\toprule" else empty) $$ headers $$ endhead $$ vcat rows' @@ -1265,3 +1263,24 @@ commonFromBcp47 x = fromIso $ head x deNote :: Inline -> Inline deNote (Note _) = RawInline (Format "latex") "" deNote x = x + +pDocumentOptions :: P.Parsec String () [String] +pDocumentOptions = do + P.char '[' + opts <- P.sepBy + (P.many $ P.spaces *> P.noneOf (" ,]" :: String) <* P.spaces) + (P.char ',') + P.char ']' + return opts + +pDocumentClass :: P.Parsec String () String +pDocumentClass = + do P.skipMany (P.satisfy (/='\\')) + P.string "\\documentclass" + classOptions <- pDocumentOptions <|> return [] + if ("article" :: String) `elem` classOptions + then return "article" + else do P.skipMany (P.satisfy (/='{')) + P.char '{' + P.manyTill P.letter (P.char '}') + diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index 5a92f3cdf..ce993093c 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -53,6 +53,7 @@ import Data.Yaml (Value(Object,String,Array,Bool,Number)) import qualified Data.HashMap.Strict as H import qualified Data.Vector as V import qualified Data.Text as T +import qualified Data.Set as Set type Notes = [[Block]] type Ref = ([Inline], Target, Attr) @@ -61,11 +62,11 @@ data WriterState = WriterState { stNotes :: Notes , stRefs :: Refs , stRefShortcutable :: Bool , stInList :: Bool - , stIds :: [String] + , stIds :: Set.Set String , stPlain :: Bool } instance Default WriterState where def = WriterState{ stNotes = [], stRefs = [], stRefShortcutable = True, - stInList = False, stIds = [], stPlain = False } + stInList = False, stIds = Set.empty, stPlain = False } -- | Convert Pandoc to Markdown. writeMarkdown :: WriterOptions -> Pandoc -> String @@ -116,7 +117,7 @@ plainTitleBlock tit auths dat = dat <> cr yamlMetadataBlock :: Value -> Doc -yamlMetadataBlock v = "---" $$ (jsonToYaml v) $$ "..." +yamlMetadataBlock v = "---" $$ (jsonToYaml v) $$ "---" jsonToYaml :: Value -> Doc jsonToYaml (Object hashmap) = @@ -364,7 +365,7 @@ blockToMarkdown opts (Header level attr inlines) = do -- so we know whether to print an explicit identifier ids <- gets stIds let autoId = uniqueIdent inlines ids - modify $ \st -> st{ stIds = autoId : ids } + modify $ \st -> st{ stIds = Set.insert autoId ids } let attr' = case attr of ("",[],[]) -> empty (id',[],[]) | isEnabled Ext_auto_identifiers opts diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs index d843d2efd..20086ed19 100644 --- a/src/Text/Pandoc/Writers/Org.hs +++ b/src/Text/Pandoc/Writers/Org.hs @@ -102,6 +102,10 @@ escapeString = escapeStringUsing $ , ('\x2026',"...") ] ++ backslashEscapes "^_" +isRawFormat :: Format -> Bool +isRawFormat f = + f == Format "latex" || f == Format "tex" || f == Format "org" + -- | Convert Pandoc block element to Org. blockToOrg :: Block -- ^ Block element -> State WriterState Doc @@ -129,7 +133,7 @@ blockToOrg (Para inlines) = do blockToOrg (RawBlock "html" str) = return $ blankline $$ "#+BEGIN_HTML" $$ nest 2 (text str) $$ "#+END_HTML" $$ blankline -blockToOrg (RawBlock f str) | f `elem` ["org", "latex", "tex"] = +blockToOrg (RawBlock f str) | isRawFormat f = return $ text str blockToOrg (RawBlock _ _) = return empty blockToOrg HorizontalRule = return $ blankline $$ "--------------" $$ blankline @@ -271,7 +275,8 @@ inlineToOrg (Math t str) = do return $ if t == InlineMath then "$" <> text str <> "$" else "$$" <> text str <> "$$" -inlineToOrg (RawInline f str) | f == "tex" || f == "latex" = return $ text str +inlineToOrg (RawInline f str) | isRawFormat f = + return $ text str inlineToOrg (RawInline _ _) = return empty inlineToOrg (LineBreak) = return (text "\\\\" <> cr) inlineToOrg Space = return space diff --git a/src/Text/Pandoc/Writers/TEI.hs b/src/Text/Pandoc/Writers/TEI.hs new file mode 100644 index 000000000..b9e683ab9 --- /dev/null +++ b/src/Text/Pandoc/Writers/TEI.hs @@ -0,0 +1,320 @@ +{-# LANGUAGE OverloadedStrings, PatternGuards #-} +{- +Copyright (C) 2006-2015 John MacFarlane <jgm@berkeley.edu> + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +-} + +{- | + Module : Text.Pandoc.Writers.Docbook + Copyright : Copyright (C) 2006-2015 John MacFarlane + License : GNU GPL, version 2 or above + + Maintainer : John MacFarlane <jgm@berkeley.edu> + Stability : alpha + Portability : portable + +Conversion of 'Pandoc' documents to Docbook XML. +-} +module Text.Pandoc.Writers.TEI (writeTEI) where +import Text.Pandoc.Definition +import Text.Pandoc.XML +import Text.Pandoc.Shared +import Text.Pandoc.Writers.Shared +import Text.Pandoc.Options +import Text.Pandoc.Templates (renderTemplate') +import Data.List ( stripPrefix, isPrefixOf, isSuffixOf ) +import Data.Char ( toLower ) +import Text.Pandoc.Highlighting ( languages, languagesByExtension ) +import Text.Pandoc.Pretty +import Text.Pandoc.ImageSize +import qualified Text.Pandoc.Builder as B + +-- | Convert list of authors to a docbook <author> section +authorToTEI :: WriterOptions -> [Inline] -> B.Inlines +authorToTEI opts name' = + let name = render Nothing $ inlinesToTEI opts name' + colwidth = if writerWrapText opts == WrapAuto + then Just $ writerColumns opts + else Nothing + in B.rawInline "tei" $ render colwidth $ + inTagsSimple "author" (text $ escapeStringForXML name) + +-- | Convert Pandoc document to string in Docbook format. +writeTEI :: WriterOptions -> Pandoc -> String +writeTEI opts (Pandoc meta blocks) = + let elements = hierarchicalize blocks + colwidth = if writerWrapText opts == WrapAuto + then Just $ writerColumns opts + else Nothing + render' = render colwidth + opts' = if "/book>" `isSuffixOf` + (trimr $ writerTemplate opts) + then opts{ writerChapters = True } + else opts + startLvl = if writerChapters opts' then 0 else 1 + auths' = map (authorToTEI opts) $ docAuthors meta + meta' = B.setMeta "author" auths' meta + Just metadata = metaToJSON opts + (Just . render colwidth . (vcat . + (map (elementToTEI opts' startLvl)) . hierarchicalize)) + (Just . render colwidth . inlinesToTEI opts') + meta' + main = render' $ vcat (map (elementToTEI opts' startLvl) elements) + context = defField "body" main + $ defField "mathml" (case writerHTMLMathMethod opts of + MathML _ -> True + _ -> False) + $ metadata + in if writerStandalone opts + then renderTemplate' (writerTemplate opts) context + else main + +-- | Convert an Element to TEI. +elementToTEI :: WriterOptions -> Int -> Element -> Doc +elementToTEI opts _ (Blk block) = blockToTEI opts block +elementToTEI opts lvl (Sec _ _num (id',_,_) title elements) = + -- TEI doesn't allow sections with no content, so insert some if needed + let elements' = if null elements + then [Blk (Para [])] + else elements + divType = case lvl of + n | n == 0 -> "chapter" + | n >= 1 && n <= 5 -> "level" ++ show n + | otherwise -> "section" + in inTags True "div" [("type", divType) | not (null id')] $ +-- ("id", writerIdentifierPrefix opts ++ id') | not (null id')] $ + inTagsSimple "head" (inlinesToTEI opts title) $$ + vcat (map (elementToTEI opts (lvl + 1)) elements') + +-- | Convert a list of Pandoc blocks to TEI. +blocksToTEI :: WriterOptions -> [Block] -> Doc +blocksToTEI opts = vcat . map (blockToTEI opts) + +-- | Auxiliary function to convert Plain block to Para. +plainToPara :: Block -> Block +plainToPara (Plain x) = Para x +plainToPara x = x + +-- | Convert a list of pairs of terms and definitions into a TEI +-- list with labels and items. +deflistItemsToTEI :: WriterOptions -> [([Inline],[[Block]])] -> Doc +deflistItemsToTEI opts items = + vcat $ map (\(term, defs) -> deflistItemToTEI opts term defs) items + +-- | Convert a term and a list of blocks into a TEI varlistentry. +deflistItemToTEI :: WriterOptions -> [Inline] -> [[Block]] -> Doc +deflistItemToTEI opts term defs = + let def' = concatMap (map plainToPara) defs + in inTagsIndented "label" (inlinesToTEI opts term) $$ + inTagsIndented "item" (blocksToTEI opts def') + +-- | Convert a list of lists of blocks to a list of TEI list items. +listItemsToTEI :: WriterOptions -> [[Block]] -> Doc +listItemsToTEI opts items = vcat $ map (listItemToTEI opts) items + +-- | Convert a list of blocks into a TEI list item. +listItemToTEI :: WriterOptions -> [Block] -> Doc +listItemToTEI opts item = + inTagsIndented "item" $ blocksToTEI opts $ map plainToPara item + +imageToTEI :: WriterOptions -> Attr -> String -> Doc +imageToTEI _ attr src = selfClosingTag "graphic" $ + ("url", src) : idAndRole attr ++ dims + where + dims = go Width "width" ++ go Height "depth" + go dir dstr = case (dimension dir attr) of + Just a -> [(dstr, show a)] + Nothing -> [] + +-- | Convert a Pandoc block element to TEI. +blockToTEI :: WriterOptions -> Block -> Doc +blockToTEI _ Null = empty +-- Add ids to paragraphs in divs with ids - this is needed for +-- pandoc-citeproc to get link anchors in bibliographies: +blockToTEI opts (Div (ident,_,_) [Para lst]) = + let attribs = [("id", ident) | not (null ident)] in + inTags False "p" attribs $ inlinesToTEI opts lst +blockToTEI opts (Div _ bs) = blocksToTEI opts $ map plainToPara bs +blockToTEI _ (Header _ _ _) = empty -- should not occur after hierarchicalize +-- For TEI simple, text must be within containing block element, so +-- we use plainToPara to ensure that Plain text ends up contained by +-- something. +blockToTEI opts (Plain lst) = blockToTEI opts $ Para lst +-- title beginning with fig: indicates that the image is a figure +--blockToTEI opts (Para [Image attr txt (src,'f':'i':'g':':':_)]) = +-- let alt = inlinesToTEI opts txt +-- capt = if null txt +-- then empty +-- else inTagsSimple "title" alt +-- in inTagsIndented "figure" $ +-- capt $$ +-- (inTagsIndented "mediaobject" $ +-- (inTagsIndented "imageobject" +-- (imageToTEI opts attr src)) $$ +-- inTagsSimple "textobject" (inTagsSimple "phrase" alt)) +blockToTEI opts (Para lst) = + inTags False "p" [] $ inlinesToTEI opts lst +blockToTEI opts (BlockQuote blocks) = + inTagsIndented "quote" $ blocksToTEI opts blocks +blockToTEI _ (CodeBlock (_,classes,_) str) = + text ("<ab type='codeblock " ++ lang ++ "'>") <> cr <> + flush (text (escapeStringForXML str) <> cr <> text "</ab>") + where lang = if null langs + then "" + else escapeStringForXML (head langs) + isLang l = map toLower l `elem` map (map toLower) languages + langsFrom s = if isLang s + then [s] + else languagesByExtension . map toLower $ s + langs = concatMap langsFrom classes +blockToTEI opts (BulletList lst) = + let attribs = [("type", "unordered")] + in inTags True "list" attribs $ listItemsToTEI opts lst +blockToTEI _ (OrderedList _ []) = empty +blockToTEI opts (OrderedList (start, numstyle, _) (first:rest)) = + let attribs = case numstyle of + DefaultStyle -> [] + Decimal -> [("type", "ordered:arabic")] + Example -> [("type", "ordered:arabic")] + UpperAlpha -> [("type", "ordered:upperalpha")] + LowerAlpha -> [("type", "ordered:loweralpha")] + UpperRoman -> [("type", "ordered:upperroman")] + LowerRoman -> [("type", "ordered:lowerroman")] + items = if start == 1 + then listItemsToTEI opts (first:rest) + else (inTags True "item" [("n",show start)] + (blocksToTEI opts $ map plainToPara first)) $$ + listItemsToTEI opts rest + in inTags True "list" attribs items +blockToTEI opts (DefinitionList lst) = + let attribs = [("type", "definition")] + in inTags True "list" attribs $ deflistItemsToTEI opts lst +blockToTEI _ (RawBlock f str) + | f == "tei" = text str -- raw TEI block (should such a thing exist). +-- | f == "html" = text str -- allow html for backwards compatibility + | otherwise = empty +blockToTEI _ HorizontalRule = + selfClosingTag "milestone" [("unit","undefined"), ("type","separator"),("rendition","line")] + +-- | TEI Tables +-- TEI Simple's tables are composed of cells and rows; other +-- table info in the AST is here lossily discard. +blockToTEI opts (Table _ _ _ headers rows) = + let + headers' = tableHeadersToTEI opts headers +-- headers' = if all null headers +-- then return empty +-- else tableRowToTEI opts headers + in + inTags True "table" [] $ + vcat $ [headers'] <> map (tableRowToTEI opts) rows + +tableRowToTEI :: WriterOptions + -> [[Block]] + -> Doc +tableRowToTEI opts cols = + inTagsIndented "row" $ vcat $ map (tableItemToTEI opts) cols + +tableHeadersToTEI :: WriterOptions + -> [[Block]] + -> Doc +tableHeadersToTEI opts cols = + inTags True "row" [("role","label")] $ vcat $ map (tableItemToTEI opts) cols + +tableItemToTEI :: WriterOptions + -> [Block] + -> Doc +tableItemToTEI opts item = + inTags False "cell" [] $ vcat $ map (blockToTEI opts) item + +-- | Convert a list of inline elements to TEI. +inlinesToTEI :: WriterOptions -> [Inline] -> Doc +inlinesToTEI opts lst = hcat $ map (inlineToTEI opts) lst + +-- | Convert an inline element to TEI. +inlineToTEI :: WriterOptions -> Inline -> Doc +inlineToTEI _ (Str str) = text $ escapeStringForXML str +inlineToTEI opts (Emph lst) = + inTags False "hi" [("rendition","simple:italic")] $ inlinesToTEI opts lst +inlineToTEI opts (Strong lst) = + inTags False "hi" [("rendition", "simple:bold")] $ inlinesToTEI opts lst +inlineToTEI opts (Strikeout lst) = + inTags False "hi" [("rendition", "simple:strikethrough")] $ + inlinesToTEI opts lst +inlineToTEI opts (Superscript lst) = + inTags False "hi" [("rendition", "simple:superscript")] $ inlinesToTEI opts lst +inlineToTEI opts (Subscript lst) = + inTags False "hi" [("rendition", "simple:subscript")] $ inlinesToTEI opts lst +inlineToTEI opts (SmallCaps lst) = + inTags False "hi" [("rendition", "simple:smallcaps")] $ + inlinesToTEI opts lst +inlineToTEI opts (Quoted _ lst) = + inTagsSimple "quote" $ inlinesToTEI opts lst +inlineToTEI opts (Cite _ lst) = + inlinesToTEI opts lst +inlineToTEI opts (Span _ ils) = + inlinesToTEI opts ils +inlineToTEI _ (Code _ str) = + inTags False "seg" [("type","code")] $ text (escapeStringForXML str) +-- Distinguish display from inline math by wrapping the former in a "figure." +inlineToTEI _ (Math t str) = + case t of + InlineMath -> inTags False "formula" [("notation","TeX")] $ + text (str) + DisplayMath -> inTags True "figure" [("type","math")] $ + inTags False "formula" [("notation","TeX")] $ text (str) + +inlineToTEI _ (RawInline f x) | f == "tei" = text x + | otherwise = empty +inlineToTEI _ LineBreak = selfClosingTag "lb" [] +inlineToTEI _ Space = space +-- because we use \n for LineBreak, we can't do soft breaks: +inlineToTEI _ SoftBreak = space +inlineToTEI opts (Link attr txt (src, _)) + | Just email <- stripPrefix "mailto:" src = + let emailLink = text $ + escapeStringForXML $ email + in case txt of + [Str s] | escapeURI s == email -> emailLink + _ -> inlinesToTEI opts txt <+> + char '(' <> emailLink <> char ')' + | otherwise = + (if isPrefixOf "#" src + then inTags False "ref" $ ("target", drop 1 src) : idAndRole attr + else inTags False "ref" $ ("target", src) : idAndRole attr ) $ + inlinesToTEI opts txt +inlineToTEI opts (Image attr description (src, tit)) = + let titleDoc = if null tit + then empty + else inTags False "figDesc" [] (text $ escapeStringForXML tit) + imageDesc = if null description + then empty + else inTags False "head" [] (inlinesToTEI opts description) + in inTagsIndented "figure" $ imageDesc $$ + imageToTEI opts attr src $$ titleDoc +inlineToTEI opts (Note contents) = + inTagsIndented "note" $ blocksToTEI opts contents + +idAndRole :: Attr -> [(String, String)] +idAndRole (id',cls,_) = ident ++ role + where + ident = if null id' + then [] + else [("id", id')] + role = if null cls + then [] + else [("role", unwords cls)] + diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs index 1aefaa678..8420704dc 100644 --- a/src/Text/Pandoc/Writers/Texinfo.hs +++ b/src/Text/Pandoc/Writers/Texinfo.hs @@ -43,13 +43,14 @@ import Text.Pandoc.Pretty import Text.Pandoc.ImageSize import Network.URI ( isURI, unEscapeString ) import System.FilePath +import qualified Data.Set as Set data WriterState = WriterState { stStrikeout :: Bool -- document contains strikeout , stSuperscript :: Bool -- document contains superscript , stSubscript :: Bool -- document contains subscript , stEscapeComma :: Bool -- in a context where we need @comma - , stIdentifiers :: [String] -- header ids used already + , stIdentifiers :: Set.Set String -- header ids used already , stOptions :: WriterOptions -- writer options } @@ -64,7 +65,7 @@ writeTexinfo options document = evalState (pandocToTexinfo options $ wrapTop document) $ WriterState { stStrikeout = False, stSuperscript = False, stEscapeComma = False, stSubscript = False, - stIdentifiers = [], stOptions = options} + stIdentifiers = Set.empty, stOptions = options} -- | Add a "Top" node around the document, needed by Texinfo. wrapTop :: Pandoc -> Pandoc @@ -215,7 +216,7 @@ blockToTexinfo (Header level _ lst) = do txt <- inlineListToTexinfo lst idsUsed <- gets stIdentifiers let id' = uniqueIdent lst idsUsed - modify $ \st -> st{ stIdentifiers = id' : idsUsed } + modify $ \st -> st{ stIdentifiers = Set.insert id' idsUsed } return $ if (level > 0) && (level <= 4) then blankline <> text "@node " <> node $$ text (seccmd level) <> txt $$ |