{- Copyright (C) 2007 John MacFarlane 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.ConTeXt Copyright : Copyright (C) 2007 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane Stability : alpha Portability : portable Conversion of 'Pandoc' format into ConTeXt. -} module Text.Pandoc.Writers.ConTeXt ( writeConTeXt ) where import Text.Pandoc.Definition import Text.Pandoc.Shared import Text.Printf ( printf ) import Data.List ( (\\), intersperse ) import Control.Monad.State type WriterState = Int -- number of next URL reference -- | Convert Pandoc to ConTeXt. writeConTeXt :: WriterOptions -> Pandoc -> String writeConTeXt options document = evalState (pandocToConTeXt options document) 1 pandocToConTeXt :: WriterOptions -> Pandoc -> State WriterState String pandocToConTeXt options (Pandoc meta blocks) = do main <- blockListToConTeXt blocks let body = writerIncludeBefore options ++ main ++ writerIncludeAfter options head <- if writerStandalone options then contextHeader options meta else return "" let toc = if writerTableOfContents options then "\\placecontent\n\n" else "" let foot = if writerStandalone options then "\n\\stoptext\n" else "" return $ head ++ toc ++ body ++ foot -- | Insert bibliographic information into ConTeXt header. contextHeader :: WriterOptions -- ^ Options, including ConTeXt header -> Meta -- ^ Meta with bibliographic information -> State WriterState String contextHeader options (Meta title authors date) = do titletext <- if null title then return "" else inlineListToConTeXt title let authorstext = if null authors then "" else if length authors == 1 then stringToConTeXt $ head authors else stringToConTeXt $ (joinWithSep ", " $ init authors) ++ " & " ++ last authors let datetext = if date == "" then "" else stringToConTeXt date let titleblock = "\\doctitle{" ++ titletext ++ "}\n\ \ \\author{" ++ authorstext ++ "}\n\ \ \\date{" ++ datetext ++ "}\n\n" let setupheads = if (writerNumberSections options) then "\\setupheads[sectionnumber=yes, style=\\bf]\n" else "\\setupheads[sectionnumber=no, style=\\bf]\n" let header = writerHeader options return $ header ++ setupheads ++ titleblock ++ "\\starttext\n\\maketitle\n\n" -- escape things as needed for ConTeXt escapeCharForConTeXt :: Char -> String escapeCharForConTeXt ch = case ch of '{' -> "\\letteropenbrace{}" '}' -> "\\letterclosebrace{}" '\\' -> "\\letterbackslash{}" '$' -> "\\$" '|' -> "\\letterbar{}" '^' -> "\\letterhat{}" '%' -> "\\%" '~' -> "\\lettertilde{}" '&' -> "\\&" '#' -> "\\#" '<' -> "\\letterless{}" '>' -> "\\lettermore{}" '_' -> "\\letterunderscore{}" x -> [x] -- | Escape string for ConTeXt stringToConTeXt :: String -> String stringToConTeXt = concatMap escapeCharForConTeXt -- | Convert Pandoc block element to ConTeXt. blockToConTeXt :: Block -> State WriterState String blockToConTeXt Null = return "" blockToConTeXt (Plain lst) = inlineListToConTeXt lst >>= return . (++ "\n") blockToConTeXt (Para lst) = inlineListToConTeXt lst >>= return . (++ "\n\n") blockToConTeXt (BlockQuote lst) = do contents <- blockListToConTeXt lst return $ "\\startblockquote\n" ++ contents ++ "\\stopblockquote\n\n" blockToConTeXt (CodeBlock str) = return $ "\\starttyping\n" ++ str ++ "\n\\stoptyping\n" blockToConTeXt (RawHtml str) = return "" blockToConTeXt (BulletList lst) = do contents <- mapM listItemToConTeXt lst return $ "\\startltxitem\n" ++ concat contents ++ "\\stopltxitem\n" blockToConTeXt (OrderedList attribs lst) = case attribs of (1, DefaultStyle, DefaultDelim) -> do contents <- mapM listItemToConTeXt lst return $ "\\startltxenum\n" ++ concat contents ++ "\\stopltxenum\n" _ -> do let markers = take (length lst) $ orderedListMarkers attribs contents <- zipWithM orderedListItemToConTeXt markers lst let markerWidth = maximum $ map length markers let markerWidth' = if markerWidth < 3 then "" else "[width=" ++ show ((markerWidth + 2) `div` 2) ++ "em]" return $ "\\startitemize" ++ markerWidth' ++ "\n" ++ concat contents ++ "\\stopitemize\n" blockToConTeXt (DefinitionList lst) = mapM defListItemToConTeXt lst >>= return . (++ "\n") . concat blockToConTeXt HorizontalRule = return "\\thinrule\n\n" blockToConTeXt (Header level lst) = do contents <- inlineListToConTeXt lst return $ if level > 0 && level <= 3 then "\\" ++ concat (replicate (level - 1) "sub") ++ "section{" ++ contents ++ "}\n\n" else contents ++ "\n\n" blockToConTeXt (Table caption aligns widths heads rows) = do let colWidths = map printDecimal widths let colDescriptor colWidth alignment = (case alignment of AlignLeft -> 'l' AlignRight -> 'r' AlignCenter -> 'c' AlignDefault -> 'l'): "p(" ++ colWidth ++ "\\textwidth)|" let colDescriptors = "|" ++ (concat $ zipWith colDescriptor colWidths aligns) headers <- tableRowToConTeXt heads captionText <- inlineListToConTeXt caption let captionText' = if null caption then "none" else captionText rows' <- mapM tableRowToConTeXt rows return $ "\\placetable[here]{" ++ captionText' ++ "}\n\\starttable[" ++ colDescriptors ++ "]\n" ++ "\\HL\n" ++ headers ++ "\\HL\n" ++ concat rows' ++ "\\HL\n\\stoptable\n\n" printDecimal :: Float -> String printDecimal = printf "%.2f" tableRowToConTeXt cols = do cols' <- mapM blockListToConTeXt cols return $ "\\NC " ++ (concat $ intersperse "\\NC " cols') ++ "\\NC\\AR\n" listItemToConTeXt list = do contents <- blockListToConTeXt list return $ "\\item " ++ contents orderedListItemToConTeXt marker list = do contents <- blockListToConTeXt list return $ "\\sym{" ++ marker ++ "} " ++ contents defListItemToConTeXt (term, def) = do term' <- inlineListToConTeXt term def' <- blockListToConTeXt def return $ "\\startdescr{" ++ term' ++ "}\n" ++ def' ++ "\n\\stopdescr\n" -- | Convert list of block elements to ConTeXt. blockListToConTeXt :: [Block] -> State WriterState String blockListToConTeXt lst = mapM blockToConTeXt lst >>= return . concat -- | Convert list of inline elements to ConTeXt. inlineListToConTeXt :: [Inline] -- ^ Inlines to convert -> State WriterState String inlineListToConTeXt lst = mapM inlineToConTeXt lst >>= return . concat isQuoted :: Inline -> Bool isQuoted (Quoted _ _) = True isQuoted Apostrophe = True isQuoted _ = False -- | Convert inline element to ConTeXt inlineToConTeXt :: Inline -- ^ Inline to convert -> State WriterState String inlineToConTeXt (Emph lst) = do contents <- inlineListToConTeXt lst return $ "{\\em " ++ contents ++ "}" inlineToConTeXt (Strong lst) = do contents <- inlineListToConTeXt lst return $ "{\\bf " ++ contents ++ "}" inlineToConTeXt (Strikeout lst) = do contents <- inlineListToConTeXt lst return $ "\\overstrikes{" ++ contents ++ "}" inlineToConTeXt (Superscript lst) = do contents <- inlineListToConTeXt lst return $ "\\high{" ++ contents ++ "}" inlineToConTeXt (Subscript lst) = do contents <- inlineListToConTeXt lst return $ "\\low{" ++ contents ++ "}" inlineToConTeXt (Code str) = return $ "\\type{" ++ str ++ "}" inlineToConTeXt (Quoted SingleQuote lst) = do contents <- inlineListToConTeXt lst return $ "\\quote{" ++ contents ++ "}" inlineToConTeXt (Quoted DoubleQuote lst) = do contents <- inlineListToConTeXt lst return $ "\\quotation{" ++ contents ++ "}" inlineToConTeXt Apostrophe = return "'" inlineToConTeXt EmDash = return "---" inlineToConTeXt EnDash = return "--" inlineToConTeXt Ellipses = return "\\ldots{}" inlineToConTeXt (Str str) = return $ stringToConTeXt str inlineToConTeXt (TeX str) = return str inlineToConTeXt (HtmlInline str) = return "" inlineToConTeXt (LineBreak) = return "\\crlf\n" inlineToConTeXt Space = return " " inlineToConTeXt (Link [Code str] (src, tit)) = -- since ConTeXt has its own inlineToConTeXt (Link [Str str] (src, tit)) -- way of printing links... inlineToConTeXt (Link text (src, _)) = do next <- get put (next + 1) let ref = show next label <- inlineListToConTeXt text return $ "\\useurl[" ++ ref ++ "][" ++ src ++ "][][" ++ label ++ "]\\from[" ++ ref ++ "]" inlineToConTeXt (Image alternate (src, tit)) = do alt <- inlineListToConTeXt alternate return $ "\\placefigure\n[]\n[fig:" ++ alt ++ "]\n{" ++ tit ++ "}\n{\\externalfigure[" ++ src ++ "]}" inlineToConTeXt (Note contents) = do contents' <- blockListToConTeXt contents return $ "\\footnote{" ++ contents' ++ "}"