diff options
Diffstat (limited to 'src/Text')
| -rw-r--r-- | src/Text/Pandoc/Writers/ConTeXt.hs | 144 |
1 files changed, 71 insertions, 73 deletions
diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs index a3a30f0a0..8e0387a84 100644 --- a/src/Text/Pandoc/Writers/ConTeXt.hs +++ b/src/Text/Pandoc/Writers/ConTeXt.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} {- Copyright (C) 2007-2010 John MacFarlane <jgm@berkeley.edu> @@ -31,9 +32,9 @@ module Text.Pandoc.Writers.ConTeXt ( writeConTeXt ) where import Text.Pandoc.Definition import Text.Pandoc.Shared import Text.Printf ( printf ) -import Data.List ( isSuffixOf, intercalate, intersperse ) +import Data.List ( intercalate ) import Control.Monad.State -import Text.PrettyPrint.HughesPJ hiding ( Str ) +import Text.Pandoc.Pretty import Text.Pandoc.Templates ( renderTemplate ) data WriterState = @@ -56,15 +57,18 @@ writeConTeXt options document = pandocToConTeXt :: WriterOptions -> Pandoc -> State WriterState String pandocToConTeXt options (Pandoc (Meta title authors date) blocks) = do + let colwidth = if writerWrapText options + then Just $ writerColumns options + else Nothing titletext <- if null title then return "" - else liftM render $ inlineListToConTeXt title - authorstext <- mapM (liftM render . inlineListToConTeXt) authors + else liftM (render colwidth) $ inlineListToConTeXt title + authorstext <- mapM (liftM (render colwidth) . inlineListToConTeXt) authors datetext <- if null date then return "" - else liftM render $ inlineListToConTeXt date - body <- blockListToConTeXt blocks - let main = render $ body $$ text "" + else liftM (render colwidth) $ inlineListToConTeXt date + body <- blockListToConTeXt blocks + let main = render colwidth $ body let context = writerVariables options ++ [ ("toc", if writerTableOfContents options then "yes" else "") , ("body", main) @@ -104,32 +108,26 @@ stringToConTeXt = concatMap escapeCharForConTeXt -- | Convert Pandoc block element to ConTeXt. blockToConTeXt :: Block - -> State WriterState BlockWrapper -blockToConTeXt Null = return $ Reg empty -blockToConTeXt (Plain lst) = do - st <- get - let options = stOptions st - contents <- wrapTeXIfNeeded options False inlineListToConTeXt lst - return $ Reg contents + -> State WriterState Doc +blockToConTeXt Null = return empty +blockToConTeXt (Plain lst) = inlineListToConTeXt lst blockToConTeXt (Para [Image txt (src,_)]) = do capt <- inlineListToConTeXt txt - return $ Pad $ text "\\placefigure[here,nonumber]{" <> capt <> - text "}{\\externalfigure[" <> text src <> text "]}" + return $ blankline $$ "\\placefigure[here,nonumber]" <> braces capt <> + braces ("\\externalfigure" <> brackets (text src)) <> blankline blockToConTeXt (Para lst) = do - st <- get - let options = stOptions st - contents <- wrapTeXIfNeeded options False inlineListToConTeXt lst - return $ Pad contents + contents <- inlineListToConTeXt lst + return $ contents <> blankline blockToConTeXt (BlockQuote lst) = do contents <- blockListToConTeXt lst - return $ Pad $ text "\\startblockquote" $$ contents $$ text "\\stopblockquote" -blockToConTeXt (CodeBlock _ str) = - return $ Reg $ text $ "\\starttyping\n" ++ str ++ "\n\\stoptyping\n" - -- \n because \stoptyping can't have anything after it, inc. } -blockToConTeXt (RawHtml _) = return $ Reg empty -blockToConTeXt (BulletList lst) = do + return $ "\\startblockquote" $$ nest 0 contents $$ "\\stopblockquote" <> blankline +blockToConTeXt (CodeBlock _ str) = + return $ "\\starttyping" <> cr <> flush (text str) <> cr <> "\\stoptyping" <> blankline + -- blankline because \stoptyping can't have anything after it, inc. '}' +blockToConTeXt (RawHtml _) = return empty +blockToConTeXt (BulletList lst) = do contents <- mapM listItemToConTeXt lst - return $ Pad $ text "\\startitemize" $$ vcat contents $$ text "\\stopitemize" + return $ "\\startitemize" $$ vcat contents $$ text "\\stopitemize" <> blankline blockToConTeXt (OrderedList (start, style', delim) lst) = do st <- get let level = stOrderedListLevel st @@ -161,20 +159,20 @@ blockToConTeXt (OrderedList (start, style', delim) lst) = do LowerAlpha -> "[a]" UpperAlpha -> "[A]" let specs = style'' ++ specs2 - return $ Pad $ text ("\\startitemize" ++ specs) $$ vcat contents $$ - text "\\stopitemize" + return $ "\\startitemize" <> text specs $$ vcat contents $$ + "\\stopitemize" <> blankline blockToConTeXt (DefinitionList lst) = - mapM defListItemToConTeXt lst >>= return . Pad . wrappedBlocksToDoc -blockToConTeXt HorizontalRule = return $ Pad $ text "\\thinrule" + liftM vcat $ mapM defListItemToConTeXt lst +blockToConTeXt HorizontalRule = return $ "\\thinrule" <> blankline blockToConTeXt (Header level lst) = do contents <- inlineListToConTeXt lst st <- get let opts = stOptions st let base = if writerNumberSections opts then "section" else "subject" - return $ Pad $ if level >= 1 && level <= 5 - then char '\\' <> text (concat (replicate (level - 1) "sub")) <> - text base <> char '{' <> contents <> char '}' - else contents + return $ if level >= 1 && level <= 5 + then char '\\' <> text (concat (replicate (level - 1) "sub")) <> + text base <> char '{' <> contents <> char '}' <> blankline + else contents <> blankline blockToConTeXt (Table caption aligns widths heads rows) = do let colDescriptor colWidth alignment = (case alignment of AlignLeft -> 'l' @@ -188,80 +186,83 @@ blockToConTeXt (Table caption aligns widths heads rows) = do zipWith colDescriptor widths aligns) headers <- if all null heads then return empty - else liftM ($$ text "\\HL") $ tableRowToConTeXt heads + else liftM ($$ "\\HL") $ tableRowToConTeXt heads captionText <- inlineListToConTeXt caption let captionText' = if null caption then text "none" else captionText rows' <- mapM tableRowToConTeXt rows - return $ Pad $ text "\\placetable[here]{" <> captionText' <> char '}' $$ - text "\\starttable[" <> text colDescriptors <> char ']' $$ - text "\\HL" $$ headers $$ - vcat rows' $$ text "\\HL\n\\stoptable" + return $ "\\placetable[here]" <> braces captionText' $$ + "\\starttable" <> brackets (text colDescriptors) $$ + "\\HL" $$ headers $$ + vcat rows' $$ "\\HL" $$ "\\stoptable" <> blankline tableRowToConTeXt :: [[Block]] -> State WriterState Doc tableRowToConTeXt cols = do cols' <- mapM blockListToConTeXt cols - return $ (vcat (map (text "\\NC " <>) cols')) $$ - text "\\NC\\AR" + return $ (vcat (map ("\\NC " <>) cols')) $$ "\\NC\\AR" listItemToConTeXt :: [Block] -> State WriterState Doc listItemToConTeXt list = blockListToConTeXt list >>= - return . (text "\\item" $$) . (nest 2) + return . ("\\item" $$) . (nest 2) -defListItemToConTeXt :: ([Inline], [[Block]]) -> State WriterState BlockWrapper +defListItemToConTeXt :: ([Inline], [[Block]]) -> State WriterState Doc defListItemToConTeXt (term, defs) = do term' <- inlineListToConTeXt term - def' <- liftM (vcat . intersperse (text "")) $ mapM blockListToConTeXt defs - return $ Pad $ text "\\startdescr{" <> term' <> char '}' $$ def' $$ text "\\stopdescr" + def' <- liftM vsep $ mapM blockListToConTeXt defs + return $ "\\startdescr" <> braces term' $$ nest 2 def' $$ + "\\stopdescr" <> blankline -- | Convert list of block elements to ConTeXt. blockListToConTeXt :: [Block] -> State WriterState Doc -blockListToConTeXt lst = mapM blockToConTeXt lst >>= return . wrappedBlocksToDoc +blockListToConTeXt lst = liftM vcat $ mapM blockToConTeXt lst -- | Convert list of inline elements to ConTeXt. inlineListToConTeXt :: [Inline] -- ^ Inlines to convert -> State WriterState Doc -inlineListToConTeXt lst = mapM inlineToConTeXt lst >>= return . hcat +inlineListToConTeXt lst = liftM hcat $ mapM inlineToConTeXt lst -- | 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 '}' + return $ braces $ "\\em " <> contents inlineToConTeXt (Strong lst) = do contents <- inlineListToConTeXt lst - return $ text "{\\bf " <> contents <> char '}' + return $ braces $ "\\bf " <> contents inlineToConTeXt (Strikeout lst) = do contents <- inlineListToConTeXt lst - return $ text "\\overstrikes{" <> contents <> char '}' + return $ "\\overstrikes" <> braces contents inlineToConTeXt (Superscript lst) = do contents <- inlineListToConTeXt lst - return $ text "\\high{" <> contents <> char '}' + return $ "\\high" <> braces contents inlineToConTeXt (Subscript lst) = do contents <- inlineListToConTeXt lst - return $ text "\\low{" <> contents <> char '}' + return $ "\\low" <> braces contents inlineToConTeXt (SmallCaps lst) = do contents <- inlineListToConTeXt lst - return $ text "{\\sc " <> contents <> char '}' -inlineToConTeXt (Code str) = return $ text $ "\\type{" ++ str ++ "}" + return $ braces $ "\\sc " <> contents +inlineToConTeXt (Code str) = + return $ "\\type" <> braces (text str) inlineToConTeXt (Quoted SingleQuote lst) = do contents <- inlineListToConTeXt lst - return $ text "\\quote{" <> contents <> char '}' + return $ "\\quote" <> braces contents inlineToConTeXt (Quoted DoubleQuote lst) = do contents <- inlineListToConTeXt lst - return $ text "\\quotation{" <> contents <> char '}' + return $ "\\quotation" <> braces contents inlineToConTeXt (Cite _ lst) = inlineListToConTeXt lst inlineToConTeXt Apostrophe = return $ char '\'' -inlineToConTeXt EmDash = return $ text "---" -inlineToConTeXt EnDash = return $ text "--" -inlineToConTeXt Ellipses = return $ text "\\ldots{}" +inlineToConTeXt EmDash = return "---" +inlineToConTeXt EnDash = return "--" +inlineToConTeXt Ellipses = return "\\ldots{}" inlineToConTeXt (Str str) = return $ text $ stringToConTeXt str -inlineToConTeXt (Math InlineMath str) = return $ char '$' <> text str <> char '$' -inlineToConTeXt (Math DisplayMath str) = return $ text "\\startformula " <> text str <> text " \\stopformula" +inlineToConTeXt (Math InlineMath str) = + return $ char '$' <> text str <> char '$' +inlineToConTeXt (Math DisplayMath str) = + return $ text "\\startformula " <> text str <> text " \\stopformula" inlineToConTeXt (TeX str) = return $ text str inlineToConTeXt (HtmlInline _) = return empty -inlineToConTeXt (LineBreak) = return $ text "\\crlf\n" -inlineToConTeXt Space = return $ char ' ' +inlineToConTeXt (LineBreak) = return $ text "\\crlf" <> cr +inlineToConTeXt Space = return space 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 @@ -270,15 +271,12 @@ inlineToConTeXt (Link txt (src, _)) = do 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 ']' + return $ "\\useURL" <> brackets (text ref) <> brackets (text src) <> + brackets empty <> brackets label <> + "\\from" <> brackets (text ref) inlineToConTeXt (Image _ (src, _)) = do - return $ text "{\\externalfigure[" <> text src <> text "]}" + return $ braces $ "\\externalfigure" <> brackets (text src) inlineToConTeXt (Note contents) = do contents' <- blockListToConTeXt contents - let rawnote = stripTrailingNewlines $ render contents' - -- note: a \n before } is needed when note ends with a \stoptyping - let optNewline = "\\stoptyping" `isSuffixOf` rawnote - return $ text "\\footnote{" <> - text rawnote <> (if optNewline then char '\n' else empty) <> char '}' - + return $ text "\\footnote{" <> + nest 2 contents' <> char '}' <> cr |