@@ -1,3 +1,4 @@
1+{-# LANGUAGE OverloadedStrings #-}
12{-
23Copyright (C) 2007-2010 John MacFarlane <jgm@berkeley.edu>
34
@@ -31,9 +32,9 @@ module Text.Pandoc.Writers.ConTeXt ( writeConTeXt ) where
3132import Text.Pandoc.Definition
3233import Text.Pandoc.Shared
3334import Text.Printf ( printf )
34−import Data.List ( isSuffixOf, intercalate, intersperse )
35+import Data.List ( intercalate )
3536import Control.Monad.State
36−import Text.PrettyPrint.HughesPJ hiding ( Str )
37+import Text.Pandoc.Pretty
3738import Text.Pandoc.Templates ( renderTemplate )
3839
3940data WriterState =
@@ -56,15 +57,18 @@ writeConTeXt options document =
5657
5758pandocToConTeXt :: WriterOptions -> Pandoc -> State WriterState String
5859pandocToConTeXt options (Pandoc (Meta title authors date) blocks) = do
60+ let colwidth = if writerWrapText options
61+ then Just $ writerColumns options
62+ else Nothing
5963 titletext <- if null title
6064 then return ""
61− else liftM render $ inlineListToConTeXt title
62− authorstext <- mapM (liftM render . inlineListToConTeXt) authors
65+ else liftM (render colwidth) $ inlineListToConTeXt title
66+ authorstext <- mapM (liftM (render colwidth) . inlineListToConTeXt) authors
6367 datetext <- if null date
6468 then return ""
65− else liftM render $ inlineListToConTeXt date
66− body <- blockListToConTeXt blocks
67− let main = render $ body $$ text ""
69+ else liftM (render colwidth) $ inlineListToConTeXt date
70+ body <- blockListToConTeXt blocks
71+ let main = render colwidth $ body
6872 let context = writerVariables options ++
6973 [ ("toc", if writerTableOfContents options then "yes" else "")
7074 , ("body", main)
@@ -104,32 +108,26 @@ stringToConTeXt = concatMap escapeCharForConTeXt
104108
105109-- | Convert Pandoc block element to ConTeXt.
106110blockToConTeXt :: Block
107− -> State WriterState BlockWrapper
108−blockToConTeXt Null = return $ Reg empty
109−blockToConTeXt (Plain lst) = do
110− st <- get
111− let options = stOptions st
112− contents <- wrapTeXIfNeeded options False inlineListToConTeXt lst
113− return $ Reg contents
111+ -> State WriterState Doc
112+blockToConTeXt Null = return empty
113+blockToConTeXt (Plain lst) = inlineListToConTeXt lst
114114blockToConTeXt (Para [Image txt (src,_)]) = do
115115 capt <- inlineListToConTeXt txt
116− return $ Pad $ text "\\placefigure[here,nonumber]{" <> capt <>
117− text "}{\\externalfigure[" <> text src <> text "]}"
116+ return $ blankline $$ "\\placefigure[here,nonumber]" <> braces capt <>
117+ braces ("\\externalfigure" <> brackets (text src)) <> blankline
118118blockToConTeXt (Para lst) = do
119− st <- get
120− let options = stOptions st
121− contents <- wrapTeXIfNeeded options False inlineListToConTeXt lst
122− return $ Pad contents
119+ contents <- inlineListToConTeXt lst
120+ return $ contents <> blankline
123121blockToConTeXt (BlockQuote lst) = do
124122 contents <- blockListToConTeXt lst
125− return $ Pad $ text "\\startblockquote" $$ contents $$ text "\\stopblockquote"
126−blockToConTeXt (CodeBlock _ str) =
127− return $ Reg $ text $ "\\starttyping\n" ++ str ++ "\n\\stoptyping\n"
128− -- \n because \stoptyping can't have anything after it, inc. }
129−blockToConTeXt (RawHtml _) = return $ Reg empty
130−blockToConTeXt (BulletList lst) = do
123+ return $ "\\startblockquote" $$ nest 0 contents $$ "\\stopblockquote" <> blankline
124+blockToConTeXt (CodeBlock _ str) =
125+ return $ "\\starttyping" <> cr <> flush (text str) <> cr <> "\\stoptyping" <> blankline
126+ -- blankline because \stoptyping can't have anything after it, inc. '}'
127+blockToConTeXt (RawHtml _) = return empty
128+blockToConTeXt (BulletList lst) = do
131129 contents <- mapM listItemToConTeXt lst
132− return $ Pad $ text "\\startitemize" $$ vcat contents $$ text "\\stopitemize"
130+ return $ "\\startitemize" $$ vcat contents $$ text "\\stopitemize" <> blankline
133131blockToConTeXt (OrderedList (start, style', delim) lst) = do
134132 st <- get
135133 let level = stOrderedListLevel st
@@ -161,20 +159,20 @@ blockToConTeXt (OrderedList (start, style', delim) lst) = do
161159 LowerAlpha -> "[a]"
162160 UpperAlpha -> "[A]"
163161 let specs = style'' ++ specs2
164− return $ Pad $ text ("\\startitemize" ++ specs) $$ vcat contents $$
165− text "\\stopitemize"
162+ return $ "\\startitemize" <> text specs $$ vcat contents $$
163+ "\\stopitemize" <> blankline
166164blockToConTeXt (DefinitionList lst) =
167− mapM defListItemToConTeXt lst >>= return . Pad . wrappedBlocksToDoc
168−blockToConTeXt HorizontalRule = return $ Pad $ text "\\thinrule"
165+ liftM vcat $ mapM defListItemToConTeXt lst
166+blockToConTeXt HorizontalRule = return $ "\\thinrule" <> blankline
169167blockToConTeXt (Header level lst) = do
170168 contents <- inlineListToConTeXt lst
171169 st <- get
172170 let opts = stOptions st
173171 let base = if writerNumberSections opts then "section" else "subject"
174− return $ Pad $ if level >= 1 && level <= 5
175− then char '\\' <> text (concat (replicate (level - 1) "sub")) <>
176− text base <> char '{' <> contents <> char '}'
177− else contents
172+ return $ if level >= 1 && level <= 5
173+ then char '\\' <> text (concat (replicate (level - 1) "sub")) <>
174+ text base <> char '{' <> contents <> char '}' <> blankline
175+ else contents <> blankline
178176blockToConTeXt (Table caption aligns widths heads rows) = do
179177 let colDescriptor colWidth alignment = (case alignment of
180178 AlignLeft -> 'l'
@@ -188,80 +186,83 @@ blockToConTeXt (Table caption aligns widths heads rows) = do
188186 zipWith colDescriptor widths aligns)
189187 headers <- if all null heads
190188 then return empty
191− else liftM ($$ text "\\HL") $ tableRowToConTeXt heads
189+ else liftM ($$ "\\HL") $ tableRowToConTeXt heads
192190 captionText <- inlineListToConTeXt caption
193191 let captionText' = if null caption then text "none" else captionText
194192 rows' <- mapM tableRowToConTeXt rows
195− return $ Pad $ text "\\placetable[here]{" <> captionText' <> char '}' $$
196− text "\\starttable[" <> text colDescriptors <> char ']' $$
197− text "\\HL" $$ headers $$
198− vcat rows' $$ text "\\HL\n\\stoptable"
193+ return $ "\\placetable[here]" <> braces captionText' $$
194+ "\\starttable" <> brackets (text colDescriptors) $$
195+ "\\HL" $$ headers $$
196+ vcat rows' $$ "\\HL" $$ "\\stoptable" <> blankline
199197
200198tableRowToConTeXt :: [[Block]] -> State WriterState Doc
201199tableRowToConTeXt cols = do
202200 cols' <- mapM blockListToConTeXt cols
203− return $ (vcat (map (text "\\NC " <>) cols')) $$
204− text "\\NC\\AR"
201+ return $ (vcat (map ("\\NC " <>) cols')) $$ "\\NC\\AR"
205202
206203listItemToConTeXt :: [Block] -> State WriterState Doc
207204listItemToConTeXt list = blockListToConTeXt list >>=
208− return . (text "\\item" $$) . (nest 2)
205+ return . ("\\item" $$) . (nest 2)
209206
210−defListItemToConTeXt :: ([Inline], [[Block]]) -> State WriterState BlockWrapper
207+defListItemToConTeXt :: ([Inline], [[Block]]) -> State WriterState Doc
211208defListItemToConTeXt (term, defs) = do
212209 term' <- inlineListToConTeXt term
213− def' <- liftM (vcat . intersperse (text "")) $ mapM blockListToConTeXt defs
214− return $ Pad $ text "\\startdescr{" <> term' <> char '}' $$ def' $$ text "\\stopdescr"
210+ def' <- liftM vsep $ mapM blockListToConTeXt defs
211+ return $ "\\startdescr" <> braces term' $$ nest 2 def' $$
212+ "\\stopdescr" <> blankline
215213
216214-- | Convert list of block elements to ConTeXt.
217215blockListToConTeXt :: [Block] -> State WriterState Doc
218−blockListToConTeXt lst = mapM blockToConTeXt lst >>= return . wrappedBlocksToDoc
216+blockListToConTeXt lst = liftM vcat $ mapM blockToConTeXt lst
219217
220218-- | Convert list of inline elements to ConTeXt.
221219inlineListToConTeXt :: [Inline] -- ^ Inlines to convert
222220 -> State WriterState Doc
223−inlineListToConTeXt lst = mapM inlineToConTeXt lst >>= return . hcat
221+inlineListToConTeXt lst = liftM hcat $ mapM inlineToConTeXt lst
224222
225223-- | Convert inline element to ConTeXt
226224inlineToConTeXt :: Inline -- ^ Inline to convert
227225 -> State WriterState Doc
228226inlineToConTeXt (Emph lst) = do
229227 contents <- inlineListToConTeXt lst
230− return $ text "{\\em " <> contents <> char '}'
228+ return $ braces $ "\\em " <> contents
231229inlineToConTeXt (Strong lst) = do
232230 contents <- inlineListToConTeXt lst
233− return $ text "{\\bf " <> contents <> char '}'
231+ return $ braces $ "\\bf " <> contents
234232inlineToConTeXt (Strikeout lst) = do
235233 contents <- inlineListToConTeXt lst
236− return $ text "\\overstrikes{" <> contents <> char '}'
234+ return $ "\\overstrikes" <> braces contents
237235inlineToConTeXt (Superscript lst) = do
238236 contents <- inlineListToConTeXt lst
239− return $ text "\\high{" <> contents <> char '}'
237+ return $ "\\high" <> braces contents
240238inlineToConTeXt (Subscript lst) = do
241239 contents <- inlineListToConTeXt lst
242− return $ text "\\low{" <> contents <> char '}'
240+ return $ "\\low" <> braces contents
243241inlineToConTeXt (SmallCaps lst) = do
244242 contents <- inlineListToConTeXt lst
245− return $ text "{\\sc " <> contents <> char '}'
246−inlineToConTeXt (Code str) = return $ text $ "\\type{" ++ str ++ "}"
243+ return $ braces $ "\\sc " <> contents
244+inlineToConTeXt (Code str) =
245+ return $ "\\type" <> braces (text str)
247246inlineToConTeXt (Quoted SingleQuote lst) = do
248247 contents <- inlineListToConTeXt lst
249− return $ text "\\quote{" <> contents <> char '}'
248+ return $ "\\quote" <> braces contents
250249inlineToConTeXt (Quoted DoubleQuote lst) = do
251250 contents <- inlineListToConTeXt lst
252− return $ text "\\quotation{" <> contents <> char '}'
251+ return $ "\\quotation" <> braces contents
253252inlineToConTeXt (Cite _ lst) = inlineListToConTeXt lst
254253inlineToConTeXt Apostrophe = return $ char '\''
255−inlineToConTeXt EmDash = return $ text "---"
256−inlineToConTeXt EnDash = return $ text "--"
257−inlineToConTeXt Ellipses = return $ text "\\ldots{}"
254+inlineToConTeXt EmDash = return "---"
255+inlineToConTeXt EnDash = return "--"
256+inlineToConTeXt Ellipses = return "\\ldots{}"
258257inlineToConTeXt (Str str) = return $ text $ stringToConTeXt str
259−inlineToConTeXt (Math InlineMath str) = return $ char '$' <> text str <> char '$'
260−inlineToConTeXt (Math DisplayMath str) = return $ text "\\startformula " <> text str <> text " \\stopformula"
258+inlineToConTeXt (Math InlineMath str) =
259+ return $ char '$' <> text str <> char '$'
260+inlineToConTeXt (Math DisplayMath str) =
261+ return $ text "\\startformula " <> text str <> text " \\stopformula"
261262inlineToConTeXt (TeX str) = return $ text str
262263inlineToConTeXt (HtmlInline _) = return empty
263−inlineToConTeXt (LineBreak) = return $ text "\\crlf\n"
264−inlineToConTeXt Space = return $ char ' '
264+inlineToConTeXt (LineBreak) = return $ text "\\crlf" <> cr
265+inlineToConTeXt Space = return space
265266inlineToConTeXt (Link [Code str] (src, tit)) = -- since ConTeXt has its own
266267 inlineToConTeXt (Link [Str str] (src, tit)) -- way of printing links...
267268inlineToConTeXt (Link txt (src, _)) = do
@@ -270,15 +271,12 @@ inlineToConTeXt (Link txt (src, _)) = do
270271 put $ st {stNextRef = next + 1}
271272 let ref = show next
272273 label <- inlineListToConTeXt txt
273− return $ text "\\useURL[" <> text ref <> text "][" <> text src <>
274− text "][][" <> label <> text "]\\from[" <> text ref <> char ']'
274+ return $ "\\useURL" <> brackets (text ref) <> brackets (text src) <>
275+ brackets empty <> brackets label <>
276+ "\\from" <> brackets (text ref)
275277inlineToConTeXt (Image _ (src, _)) = do
276− return $ text "{\\externalfigure[" <> text src <> text "]}"
278+ return $ braces $ "\\externalfigure" <> brackets (text src)
277279inlineToConTeXt (Note contents) = do
278280 contents' <- blockListToConTeXt contents
279− let rawnote = stripTrailingNewlines $ render contents'
280− -- note: a \n before } is needed when note ends with a \stoptyping
281− let optNewline = "\\stoptyping" `isSuffixOf` rawnote
282− return $ text "\\footnote{" <>
283− text rawnote <> (if optNewline then char '\n' else empty) <> char '}'
284−
281+ return $ text "\\footnote{" <>
282+ nest 2 contents' <> char '}' <> cr