diff options
Diffstat (limited to 'src/Text/Pandoc/Writers/ConTeXt.hs')
| -rw-r--r-- | src/Text/Pandoc/Writers/ConTeXt.hs | 297 |
1 files changed, 0 insertions, 297 deletions
diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs deleted file mode 100644 index 98252f172..000000000 --- a/src/Text/Pandoc/Writers/ConTeXt.hs +++ /dev/null @@ -1,297 +0,0 @@ -{- -Copyright (C) 2007 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.ConTeXt - Copyright : Copyright (C) 2007 John MacFarlane - License : GNU GPL, version 2 or above - - Maintainer : John MacFarlane <jgm@berkeley.edu> - 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 -import Text.PrettyPrint.HughesPJ hiding ( Str ) - -data WriterState = - WriterState { stNextRef :: Int -- number of next URL reference - , stOrderedListLevel :: Int -- level of ordered list - , stOptions :: WriterOptions -- writer options - } - -orderedListStyles = cycle ["[n]","[a]", "[r]", "[g]"] - --- | Convert Pandoc to ConTeXt. -writeConTeXt :: WriterOptions -> Pandoc -> String -writeConTeXt options document = - let defaultWriterState = WriterState { stNextRef = 1 - , stOrderedListLevel = 0 - , stOptions = options - } - in render $ - evalState (pandocToConTeXt options document) defaultWriterState - -pandocToConTeXt :: WriterOptions -> Pandoc -> State WriterState Doc -pandocToConTeXt options (Pandoc meta blocks) = do - main <- blockListToConTeXt blocks - let before = if null (writerIncludeBefore options) - then empty - else text $ writerIncludeBefore options - let after = if null (writerIncludeAfter options) - then empty - else text $ writerIncludeAfter options - let body = before $$ main $$ after - head <- if writerStandalone options - then contextHeader options meta - else return empty - let toc = if writerTableOfContents options - then text "\\placecontent\n" - else empty - let foot = if writerStandalone options - then text "\\stoptext\n" - else empty - return $ head $$ toc $$ body $$ foot - --- | Insert bibliographic information into ConTeXt header. -contextHeader :: WriterOptions -- ^ Options, including ConTeXt header - -> Meta -- ^ Meta with bibliographic information - -> State WriterState Doc -contextHeader options (Meta title authors date) = do - titletext <- if null title - then return empty - 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 = text "\\doctitle{" <> titletext <> char '}' $$ - text ("\\author{" ++ authorstext ++ "}") $$ - text ("\\date{" ++ datetext ++ "}") - let header = text $ writerHeader options - return $ header $$ titleblock $$ text "\\starttext\n\\maketitle\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 Doc -blockToConTeXt Null = return empty -blockToConTeXt (Plain lst) = do - st <- get - let options = stOptions st - contents <- wrapTeXIfNeeded options False inlineListToConTeXt lst - return contents -blockToConTeXt (Para lst) = do - st <- get - let options = stOptions st - contents <- wrapTeXIfNeeded options False inlineListToConTeXt lst - return $ contents <> char '\n' -blockToConTeXt (BlockQuote lst) = do - contents <- blockListToConTeXt lst - return $ text "\\startblockquote\n" $$ contents $$ text "\\stopblockquote" -blockToConTeXt (CodeBlock str) = - return $ text $ "\\starttyping\n" ++ str ++ "\n\\stoptyping\n" -- \n needed - -- because \stoptyping can't have anything after it -blockToConTeXt (RawHtml str) = return empty -blockToConTeXt (BulletList lst) = do - contents <- mapM listItemToConTeXt lst - return $ text "\\startitemize" $$ vcat contents $$ text "\\stopitemize\n" -blockToConTeXt (OrderedList (start, style, delim) lst) = do - st <- get - let level = stOrderedListLevel st - put $ st {stOrderedListLevel = level + 1} - contents <- mapM listItemToConTeXt lst - put $ st {stOrderedListLevel = level} - let start' = if start == 1 then "" else "start=" ++ show start - let delim' = case delim of - DefaultDelim -> "" - Period -> "stopper=." - OneParen -> "stopper=)" - TwoParens -> "left=(,stopper=)" - let width = maximum $ map length $ take (length contents) - (orderedListMarkers (start, style, delim)) - let width' = (toEnum width + 1) / 2 - let width'' = if width' > 1.5 - then "width=" ++ show width' ++ "em" - else "" - let specs2Items = filter (not . null) [start', delim', width''] - let specs2 = if null specs2Items - then "" - else "[" ++ joinWithSep "," specs2Items ++ "]" - let style' = case style of - DefaultStyle -> orderedListStyles !! level - Decimal -> "[n]" - LowerRoman -> "[r]" - UpperRoman -> "[R]" - LowerAlpha -> "[a]" - UpperAlpha -> "[A]" - let specs = style' ++ specs2 - return $ text ("\\startitemize" ++ specs) $$ vcat contents $$ - text "\\stopitemize\n" -blockToConTeXt (DefinitionList lst) = - mapM defListItemToConTeXt lst >>= return . (<> char '\n') . vcat -blockToConTeXt HorizontalRule = return $ text "\\thinrule\n" -blockToConTeXt (Header level lst) = do - contents <- inlineListToConTeXt lst - st <- get - let opts = stOptions st - let base = if writerNumberSections opts then "section" else "subject" - return $ if level >= 1 && level <= 5 - then char '\\' <> text (concat (replicate (level - 1) "sub")) <> - text base <> char '{' <> contents <> char '}' <> char '\n' - else contents <> char '\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 text "none" else captionText - rows' <- mapM tableRowToConTeXt rows - return $ text "\\placetable[here]{" <> captionText' <> char '}' $$ - text "\\starttable[" <> text colDescriptors <> char ']' $$ - text "\\HL" $$ headers $$ text "\\HL" $$ - vcat rows' $$ text "\\HL\n\\stoptable\n" - -printDecimal :: Float -> String -printDecimal = printf "%.2f" - -tableRowToConTeXt cols = do - cols' <- mapM blockListToConTeXt cols - return $ (vcat (map (text "\\NC " <>) cols')) $$ - text "\\NC\\AR" - -listItemToConTeXt list = blockListToConTeXt list >>= - return . (text "\\item " $$) . (nest 2) - -orderedListItemToConTeXt marker list = blockListToConTeXt list >>= - return . (text ("\\sym{" ++ marker ++ "} ") $$) . (nest 2) - -defListItemToConTeXt (term, def) = do - term' <- inlineListToConTeXt term - def' <- blockListToConTeXt def - return $ text "\\startdescr{" <> term' <> char '}' $$ def' $$ text "\\stopdescr" - --- | Convert list of block elements to ConTeXt. -blockListToConTeXt :: [Block] -> State WriterState Doc -blockListToConTeXt lst = mapM blockToConTeXt lst >>= return . vcat - --- | Convert list of inline elements to ConTeXt. -inlineListToConTeXt :: [Inline] -- ^ Inlines to convert - -> State WriterState Doc -inlineListToConTeXt lst = mapM inlineToConTeXt lst >>= return . hcat - -isQuoted :: Inline -> Bool -isQuoted (Quoted _ _) = True -isQuoted Apostrophe = True -isQuoted _ = False - --- | Convert inline element to ConTeXt -inlineToConTeXt :: Inline -- ^ Inline to convert - -> State WriterState Doc -inlineToConTeXt (Emph lst) = do - contents <- inlineListToConTeXt lst - return $ text "{\\em " <> contents <> char '}' -inlineToConTeXt (Strong lst) = do - contents <- inlineListToConTeXt lst - return $ text "{\\bf " <> contents <> char '}' -inlineToConTeXt (Strikeout lst) = do - contents <- inlineListToConTeXt lst - return $ text "\\overstrikes{" <> contents <> char '}' -inlineToConTeXt (Superscript lst) = do - contents <- inlineListToConTeXt lst - return $ text "\\high{" <> contents <> char '}' -inlineToConTeXt (Subscript lst) = do - contents <- inlineListToConTeXt lst - return $ text "\\low{" <> contents <> char '}' -inlineToConTeXt (Code str) = return $ text $ "\\type{" ++ str ++ "}" -inlineToConTeXt (Quoted SingleQuote lst) = do - contents <- inlineListToConTeXt lst - return $ text "\\quote{" <> contents <> char '}' -inlineToConTeXt (Quoted DoubleQuote lst) = do - contents <- inlineListToConTeXt lst - return $ text "\\quotation{" <> contents <> char '}' -inlineToConTeXt Apostrophe = return $ char '\'' -inlineToConTeXt EmDash = return $ text "---" -inlineToConTeXt EnDash = return $ text "--" -inlineToConTeXt Ellipses = return $ text "\\ldots{}" -inlineToConTeXt (Str str) = return $ text $ stringToConTeXt str -inlineToConTeXt (TeX str) = return $ text str -inlineToConTeXt (HtmlInline str) = return empty -inlineToConTeXt (LineBreak) = return $ text "\\crlf\n" -inlineToConTeXt Space = return $ char ' ' -inlineToConTeXt (Link [Code str] (src, tit)) = -- since ConTeXt has its own - inlineToConTeXt (Link [Str str] (src, tit)) -- way of printing links... -inlineToConTeXt (Link txt (src, _)) = do - st <- get - let next = stNextRef st - put $ st {stNextRef = next + 1} - let ref = show next - label <- inlineListToConTeXt txt - return $ text "\\useURL[" <> text ref <> text "][" <> text src <> - text "][][" <> label <> text "]\\from[" <> text ref <> char ']' -inlineToConTeXt (Image alternate (src, tit)) = do - alt <- inlineListToConTeXt alternate - return $ text "\\placefigure\n[]\n[fig:" <> alt <> text "]\n{" <> - text tit <> text "}\n{\\externalfigure[" <> text src <> text "]}" -inlineToConTeXt (Note contents) = do - contents' <- blockListToConTeXt contents - return $ text " \\footnote{" <> - text (stripTrailingNewlines $ render contents') <> - char '}' - |