@@ -0,0 +1,225 @@
1+{-
2+Copyright (C) 2007 John MacFarlane <jgm@berkeley.edu>
3+
4+This program is free software; you can redistribute it and/or modify
5+it under the terms of the GNU General Public License as published by
6+the Free Software Foundation; either version 2 of the License, or
7+(at your option) any later version.
8+
9+This program is distributed in the hope that it will be useful,
10+but WITHOUT ANY WARRANTY; without even the implied warranty of
11+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12+GNU General Public License for more details.
13+
14+You should have received a copy of the GNU General Public License
15+along with this program; if not, write to the Free Software
16+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
17+-}
18+
19+{- |
20+ Module : Text.Pandoc.Writers.ConTeXt
21+ Copyright : Copyright (C) 2006-7 John MacFarlane
22+ License : GNU GPL, version 2 or above
23+
24+ Maintainer : John MacFarlane <jgm@berkeley.edu>
25+ Stability : alpha
26+ Portability : portable
27+
28+Conversion of 'Pandoc' format into ConTeXt.
29+-}
30+module Text.Pandoc.Writers.ConTeXt (
31+ writeConTeXt
32+ ) where
33+import Text.Pandoc.Definition
34+import Text.Pandoc.Shared
35+import Text.Printf ( printf )
36+import Data.List ( (\\), intersperse )
37+import Control.Monad.State
38+
39+type WriterState = Int -- number of next URL reference
40+
41+-- | Convert Pandoc to ConTeXt.
42+writeConTeXt :: WriterOptions -> Pandoc -> String
43+writeConTeXt options document =
44+ evalState (pandocToConTeXt options document) 1
45+
46+pandocToConTeXt :: WriterOptions -> Pandoc -> State WriterState String
47+pandocToConTeXt options (Pandoc meta blocks) = do
48+ main <- blockListToConTeXt blocks
49+ let body = writerIncludeBefore options ++ main ++ writerIncludeAfter options
50+ head <- if writerStandalone options
51+ then contextHeader options meta
52+ else return ""
53+ let toc = if writerTableOfContents options
54+ then "\\placecontent\n\n"
55+ else ""
56+ let foot = if writerStandalone options
57+ then "\n\\stoptext\n"
58+ else ""
59+ return $ head ++ toc ++ body ++ foot
60+
61+-- | Insert bibliographic information into ConTeXt header.
62+contextHeader :: WriterOptions -- ^ Options, including ConTeXt header
63+ -> Meta -- ^ Meta with bibliographic information
64+ -> State WriterState String
65+contextHeader options (Meta title authors date) = do
66+ titletext <- if null title
67+ then return ""
68+ else inlineListToConTeXt title
69+ let authorstext = if null authors
70+ then ""
71+ else if length authors == 1
72+ then stringToConTeXt $ head authors
73+ else stringToConTeXt $ (joinWithSep ", " $
74+ init authors) ++ " & " ++ last authors
75+ let datetext = if date == ""
76+ then ""
77+ else stringToConTeXt date
78+ let titleblock = "\\doctitle{" ++ titletext ++ "}\n\
79+ \ \\author{" ++ authorstext ++ "}\n\
80+ \ \\date{" ++ datetext ++ "}\n\n"
81+ let setupheads = if (writerNumberSections options)
82+ then "\\setupheads[sectionnumber=yes, style=\\bf]\n"
83+ else "\\setupheads[sectionnumber=no, style=\\bf]\n"
84+ let header = writerHeader options
85+ return $ header ++ setupheads ++ titleblock ++ "\\starttext\n\\maketitle\n\n"
86+
87+-- escape things as needed for ConTeXt
88+
89+escapeCharForConTeXt :: Char -> String
90+escapeCharForConTeXt ch =
91+ case ch of
92+ '{' -> "\\letteropenbrace{}"
93+ '}' -> "\\letterclosebrace{}"
94+ '\\' -> "\\letterbackslash{}"
95+ '$' -> "\\$"
96+ '|' -> "\\letterbar{}"
97+ '^' -> "\\letterhat{}"
98+ '%' -> "\\%"
99+ '~' -> "\\lettertilde{}"
100+ '&' -> "\\&"
101+ '#' -> "\\#"
102+ '<' -> "\\letterless{}"
103+ '>' -> "\\lettermore{}"
104+ '_' -> "\\letterunderscore{}"
105+ x -> [x]
106+
107+-- | Escape string for ConTeXt
108+stringToConTeXt :: String -> String
109+stringToConTeXt = concatMap escapeCharForConTeXt
110+
111+-- | Convert Pandoc block element to ConTeXt.
112+blockToConTeXt :: Block -> State WriterState String
113+blockToConTeXt Null = return ""
114+blockToConTeXt (Plain lst) = inlineListToConTeXt lst >>= (return . (++ "\n"))
115+blockToConTeXt (Para lst) = inlineListToConTeXt lst >>= (return . (++ "\n\n"))
116+blockToConTeXt (BlockQuote lst) = do
117+ contents <- blockListToConTeXt lst
118+ return $ "\\startnarrower\n" ++ contents ++ "\\stopnarrower\n\n"
119+blockToConTeXt (CodeBlock str) =
120+ return $ "\\starttyping\n" ++ str ++ "\n\\stoptyping\n"
121+blockToConTeXt (RawHtml str) = return ""
122+blockToConTeXt (BulletList lst) = do
123+ contents <- mapM listItemToConTeXt lst
124+ return $ "\\startltxitem\n" ++ concat contents ++ "\\stopltxitem\n"
125+blockToConTeXt (OrderedList lst) = do
126+ contents <- mapM listItemToConTeXt lst
127+ return $ "\\startltxenum\n" ++ concat contents ++ "\\stopltxenum\n"
128+blockToConTeXt (DefinitionList lst) =
129+ mapM defListItemToConTeXt lst >>= (return . (++ "\n") . concat)
130+blockToConTeXt HorizontalRule = return "\\thinrule\n\n"
131+blockToConTeXt (Header level lst) = do
132+ contents <- inlineListToConTeXt lst
133+ return $ if (level > 0) && (level <= 3)
134+ then "\\" ++ (concat (replicate (level - 1) "sub")) ++
135+ "section{" ++ contents ++ "}\n\n"
136+ else contents ++ "\n\n"
137+blockToConTeXt (Table caption aligns widths heads rows) = do
138+ let colWidths = map printDecimal widths
139+ let colDescriptor colWidth alignment = (case alignment of
140+ AlignLeft -> 'l'
141+ AlignRight -> 'r'
142+ AlignCenter -> 'c'
143+ AlignDefault -> 'l'):
144+ "p(" ++ colWidth ++ "\\textwidth)|"
145+ let colDescriptors = "|" ++ (concat $
146+ zipWith colDescriptor colWidths aligns)
147+ headers <- tableRowToConTeXt heads
148+ captionText <- inlineListToConTeXt caption
149+ let captionText' = if null caption then "none" else captionText
150+ rows' <- mapM tableRowToConTeXt rows
151+ return $ "\\placetable[here]{" ++ captionText' ++ "}\n\\starttable[" ++
152+ colDescriptors ++ "]\n" ++ "\\HL\n" ++ headers ++ "\\HL\n" ++
153+ concat rows' ++ "\\HL\n\\stoptable\n\n"
154+
155+printDecimal :: Float -> String
156+printDecimal = printf "%.2f"
157+
158+tableRowToConTeXt cols = do
159+ cols' <- mapM blockListToConTeXt cols
160+ return $ "\\NC " ++ (concat $ intersperse "\\NC " cols') ++ "\\NC\\AR\n"
161+
162+listItemToConTeXt list = do
163+ contents <- blockListToConTeXt list
164+ return $ "\\item " ++ contents
165+
166+defListItemToConTeXt (term, def) = do
167+ term' <- inlineListToConTeXt term
168+ def' <- blockListToConTeXt def
169+ return $ "\\startdescr{" ++ term' ++ "}\n" ++
170+ def' ++ "\n\\stopdescr\n"
171+
172+-- | Convert list of block elements to ConTeXt.
173+blockListToConTeXt :: [Block] -> State WriterState String
174+blockListToConTeXt lst = mapM blockToConTeXt lst >>= (return . concat)
175+
176+-- | Convert list of inline elements to ConTeXt.
177+inlineListToConTeXt :: [Inline] -- ^ Inlines to convert
178+ -> State WriterState String
179+inlineListToConTeXt lst = mapM inlineToConTeXt lst >>= (return . concat)
180+
181+isQuoted :: Inline -> Bool
182+isQuoted (Quoted _ _) = True
183+isQuoted Apostrophe = True
184+isQuoted _ = False
185+
186+-- | Convert inline element to ConTeXt
187+inlineToConTeXt :: Inline -- ^ Inline to convert
188+ -> State WriterState String
189+inlineToConTeXt (Emph lst) = do
190+ contents <- inlineListToConTeXt lst
191+ return $ "{\\em " ++ contents ++ "}"
192+inlineToConTeXt (Strong lst) = do
193+ contents <- inlineListToConTeXt lst
194+ return $ "{\\bf " ++ contents ++ "}"
195+inlineToConTeXt (Code str) = return $ "\\type{" ++ str ++ "}"
196+inlineToConTeXt (Quoted SingleQuote lst) = do
197+ contents <- inlineListToConTeXt lst
198+ return $ "\\quote{" ++ contents ++ "}"
199+inlineToConTeXt (Quoted DoubleQuote lst) = do
200+ contents <- inlineListToConTeXt lst
201+ return $ "\\quotation{" ++ contents ++ "}"
202+inlineToConTeXt Apostrophe = return "'"
203+inlineToConTeXt EmDash = return "---"
204+inlineToConTeXt EnDash = return "--"
205+inlineToConTeXt Ellipses = return "\\ldots{}"
206+inlineToConTeXt (Str str) = return $ stringToConTeXt str
207+inlineToConTeXt (TeX str) = return str
208+inlineToConTeXt (HtmlInline str) = return ""
209+inlineToConTeXt (LineBreak) = return "\\hfil\\break\n"
210+inlineToConTeXt Space = return " "
211+inlineToConTeXt (Link text (src, _)) = do
212+ next <- get
213+ put (next + 1)
214+ let ref = show next
215+ label <- inlineListToConTeXt text
216+ return $ "\\useurl[" ++ ref ++ "][" ++ src ++ "][][" ++ label ++
217+ "]\\from[" ++ ref ++ "]"
218+inlineToConTeXt (Image alternate (src, tit)) = do
219+ alt <- inlineListToConTeXt alternate
220+ return $ "\\placefigure\n[]\n[fig:" ++ alt ++ "]\n{" ++
221+ tit ++ "}\n{\\externalfigure[" ++ src ++ "]}"
222+inlineToConTeXt (Note contents) = do
223+ contents' <- blockListToConTeXt contents
224+ return $ "\\footnote{" ++ contents' ++ "}"
225+