@@ -0,0 +1,461 @@
1+{-
2+Copyright (C) 2008 John MacFarlane and Peter Wang
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.Texinfo
21+ Copyright : Copyright (C) 2008 John MacFarlane and Peter Wang
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 Texinfo.
29+-}
30+module Text.Pandoc.Writers.Texinfo ( writeTexinfo ) where
31+import Text.Pandoc.Definition
32+import Text.Pandoc.Shared
33+import Text.Printf ( printf )
34+import Data.List ( (\\), isSuffixOf )
35+import Data.Char ( toLower, chr, ord )
36+import qualified Data.Set as S
37+import Control.Monad.State
38+import Text.PrettyPrint.HughesPJ hiding ( Str )
39+
40+data WriterState =
41+ WriterState { stIncludes :: S.Set String -- strings to include in header
42+ }
43+
44+{- TODO:
45+ - internal cross references a la HTML
46+ - generated .texi files don't work when run through texi2dvi
47+ -}
48+
49+-- | Add line to header.
50+addToHeader :: String -> State WriterState ()
51+addToHeader str = do
52+ st <- get
53+ let includes = stIncludes st
54+ put st {stIncludes = S.insert str includes}
55+
56+-- | Convert Pandoc to Texinfo.
57+writeTexinfo :: WriterOptions -> Pandoc -> String
58+writeTexinfo options document =
59+ render $ evalState (pandocToTexinfo options $ wrapTop document) $
60+ WriterState { stIncludes = S.empty }
61+
62+-- | Add a "Top" node around the document, needed by Texinfo.
63+wrapTop (Pandoc (Meta title authors date) blocks) =
64+ Pandoc (Meta title authors date) (Header 0 title : blocks)
65+
66+pandocToTexinfo :: WriterOptions -> Pandoc -> State WriterState Doc
67+pandocToTexinfo options (Pandoc meta blocks) = do
68+ main <- blockListToTexinfo blocks
69+ head <- if writerStandalone options
70+ then texinfoHeader options meta
71+ else return empty
72+ let before = if null (writerIncludeBefore options)
73+ then empty
74+ else text (writerIncludeBefore options)
75+ let after = if null (writerIncludeAfter options)
76+ then empty
77+ else text (writerIncludeAfter options)
78+ let body = before $$ main $$ after
79+ -- XXX toc untested
80+ let toc = if writerTableOfContents options
81+ then text "@contents"
82+ else empty
83+ let foot = if writerStandalone options
84+ then text "@bye"
85+ else empty
86+ return $ head $$ toc $$ body $$ foot
87+
88+-- | Insert bibliographic information into Texinfo header.
89+texinfoHeader :: WriterOptions -- ^ Options, including Texinfo header
90+ -> Meta -- ^ Meta with bibliographic information
91+ -> State WriterState Doc
92+texinfoHeader options (Meta title authors date) = do
93+ titletext <- if null title
94+ then return empty
95+ else do
96+ t <- inlineListToTexinfo title
97+ return $ text "@title " <> t
98+ headerIncludes <- get >>= return . S.toList . stIncludes
99+ let extras = text $ unlines headerIncludes
100+ let authorstext = map makeAuthor authors
101+ let datetext = if date == ""
102+ then empty
103+ else text $ stringToTexinfo date
104+
105+ let baseHeader = text $ writerHeader options
106+ let header = baseHeader $$ extras
107+ return $ text "\\input texinfo" $$
108+ header $$
109+ text "@ifnottex" $$
110+ text "@paragraphindent 0" $$
111+ text "@end ifnottex" $$
112+ text "@titlepage" $$
113+ titletext $$ vcat authorstext $$
114+ datetext $$
115+ text "@end titlepage"
116+
117+makeAuthor author = text $ "@author " ++ (stringToTexinfo author)
118+
119+-- | Escape things as needed for Texinfo.
120+stringToTexinfo :: String -> String
121+stringToTexinfo = escapeStringUsing texinfoEscapes
122+ where texinfoEscapes = [ ('{', "@{")
123+ , ('}', "@}")
124+ , ('@', "@@")
125+ , (',', "@comma{}") -- only needed in argument lists
126+ ]
127+
128+-- | Puts contents into Texinfo command.
129+inCmd :: String -> Doc -> Doc
130+inCmd cmd contents = char '@' <> text cmd <> braces contents
131+
132+-- | Remove all code elements from list of inline elements
133+-- (because it's illegal to have verbatim inside some command arguments)
134+-- XXX not sure about this
135+deVerb :: [Inline] -> [Inline]
136+deVerb [] = []
137+deVerb ((Code str):rest) = (Code $ stringToTexinfo str):(deVerb rest)
138+deVerb (other:rest) = other:(deVerb rest)
139+
140+-- | Convert Pandoc block element to Texinfo.
141+blockToTexinfo :: Block -- ^ Block to convert
142+ -> State WriterState Doc
143+
144+blockToTexinfo Null = return empty
145+
146+blockToTexinfo (Plain lst) =
147+ inlineListToTexinfo lst
148+
149+blockToTexinfo (Para lst) = do
150+ result <- inlineListToTexinfo lst
151+ return $ result <> char '\n'
152+
153+blockToTexinfo (BlockQuote lst) = do
154+ contents <- blockListToTexinfo lst
155+ return $ text "@quotation" $$
156+ contents $$
157+ text "@end quotation"
158+
159+blockToTexinfo (CodeBlock _ str) = do
160+ -- XXX a paragraph followed by verbatim looks better if there is no blank
161+ -- line between the paragraph and verbatim, otherwise there is extra blank
162+ -- line in makeinfo output.
163+ return $ text "@verbatim" $$
164+ vcat (map text (lines str)) $$
165+ text "@end verbatim\n"
166+
167+blockToTexinfo (RawHtml str) = return empty
168+
169+blockToTexinfo (BulletList lst) = do
170+ items <- mapM listItemToTexinfo lst
171+ return $ text "@itemize" $$
172+ vcat items $$
173+ text "@end itemize\n"
174+
175+blockToTexinfo (OrderedList (start, numstyle, numdelim) lst) = do
176+ items <- mapM listItemToTexinfo lst
177+ return $ text "@enumerate " <> exemplar $$
178+ vcat items $$
179+ text "@end enumerate"
180+ where
181+ exemplar = case numstyle of
182+ DefaultStyle -> decimal
183+ Decimal -> decimal
184+ UpperRoman -> decimal -- Roman numerals not supported
185+ LowerRoman -> decimal
186+ UpperAlpha -> upperAlpha
187+ LowerAlpha -> lowerAlpha
188+ decimal = if start == 1
189+ then empty
190+ else text (show start)
191+ upperAlpha = text [chr $ ord 'A' + start - 1]
192+ lowerAlpha = text [chr $ ord 'a' + start - 1]
193+
194+blockToTexinfo (DefinitionList lst) = do
195+ items <- mapM defListItemToTexinfo lst
196+ return $ text "@table @asis" $$
197+ vcat items $$
198+ text "@end table"
199+
200+blockToTexinfo HorizontalRule =
201+ -- XXX can't get the equivalent from LaTeX.hs to work
202+ return $ text "@iftex" $$
203+ text "@bigskip@hrule@bigskip" $$
204+ text "@end iftex" $$
205+ text "@ifnottex" $$
206+ text (take 72 $ repeat '-') $$
207+ text "@end ifnottex"
208+
209+blockToTexinfo (Header 0 lst) = do
210+ txt <- if null lst
211+ then return $ text "Top"
212+ else inlineListToTexinfo (deVerb lst)
213+ return $ text "@node Top" $$
214+ text "@top " <> txt <> char '\n'
215+
216+blockToTexinfo (Header level lst) = do
217+ node <- inlineListForNode (deVerb lst)
218+ txt <- inlineListToTexinfo (deVerb lst)
219+ return $ if (level > 0) && (level <= 4)
220+ then text "\n@node " <> node <> char '\n' <>
221+ text (seccmd level) <> txt
222+ else txt
223+ where
224+ seccmd 1 = "@chapter "
225+ seccmd 2 = "@section "
226+ seccmd 3 = "@subsection "
227+ seccmd 4 = "@subsubsection "
228+
229+blockToTexinfo (Table caption aligns widths heads rows) = do
230+ headers <- tableHeadToTexinfo aligns heads
231+ captionText <- inlineListToTexinfo (deVerb caption)
232+ rowsText <- mapM (tableRowToTexinfo aligns) rows
233+ let colWidths = map (printf "%.2f ") widths
234+ let colDescriptors = concat colWidths
235+ let tableBody = text ("@multitable @columnfractions " ++ colDescriptors) $$
236+ headers $$
237+ vcat rowsText $$
238+ text "@end multitable"
239+ return $ if isEmpty captionText
240+ then tableBody <> char '\n'
241+ else text "@float" $$
242+ tableBody $$
243+ inCmd "caption" captionText $$
244+ text "@end float"
245+
246+tableHeadToTexinfo = tableAnyRowToTexinfo "@headitem "
247+
248+tableRowToTexinfo = tableAnyRowToTexinfo "@item "
249+
250+tableAnyRowToTexinfo :: String
251+ -> [Alignment]
252+ -> [[Block]]
253+ -> State WriterState Doc
254+tableAnyRowToTexinfo itemtype aligns cols =
255+ zipWithM alignedBlock aligns cols >>=
256+ return . (text itemtype $$) . foldl (\row item -> row $$
257+ (if isEmpty row then empty else text " @tab ") <> item) empty
258+
259+alignedBlock :: Alignment
260+ -> [Block]
261+ -> State WriterState Doc
262+-- XXX @flushleft and @flushright text won't get word wrapped. Since word
263+-- wrapping is more important than alignment, we ignore the alignment.
264+alignedBlock _ = blockListToTexinfo
265+{-
266+alignedBlock AlignLeft col = do
267+ b <- blockListToTexinfo col
268+ return $ text "@flushleft" $$ b $$ text "@end flushleft"
269+alignedBlock AlignRight col = do
270+ b <- blockListToTexinfo col
271+ return $ text "@flushright" $$ b $$ text "@end flushright"
272+alignedBlock _ col = blockListToTexinfo col
273+-}
274+
275+-- | Convert Pandoc block elements to Texinfo.
276+blockListToTexinfo :: [Block]
277+ -> State WriterState Doc
278+blockListToTexinfo [] = return $ empty
279+blockListToTexinfo (x:xs) = do
280+ x' <- blockToTexinfo x
281+ case x of
282+ (Header level _) -> do
283+ -- We need need to insert a menu for this node.
284+ let (before, after) = break isHeader xs
285+ before' <- blockListToTexinfo before
286+ let menu = if level < 4
287+ then collectNodes (level + 1) after
288+ else []
289+ lines <- mapM makeMenuLine menu
290+ let menu' = if null lines
291+ then empty
292+ else text "@menu" $$
293+ vcat lines $$
294+ text "@end menu"
295+ after' <- blockListToTexinfo after
296+ return $ x' $$ before' $$ menu' $$ after'
297+ _ -> do
298+ xs' <- blockListToTexinfo xs
299+ return $ x' $$ xs'
300+
301+isHeader (Header _ _) = True
302+isHeader _ = False
303+
304+collectNodes level [] = []
305+collectNodes level (x:xs) =
306+ case x of
307+ (Header hl _) ->
308+ if hl < level
309+ then []
310+ else if hl == level
311+ then x : collectNodes level xs
312+ else collectNodes level xs
313+ _ ->
314+ collectNodes level xs
315+
316+makeMenuLine :: Block
317+ -> State WriterState Doc
318+makeMenuLine (Header _ lst) = do
319+ txt <- inlineListForNode (deVerb lst)
320+ return $ text "* " <> txt <> text "::"
321+
322+listItemToTexinfo :: [Block]
323+ -> State WriterState Doc
324+listItemToTexinfo lst = blockListToTexinfo lst >>=
325+ return . (text "@item" $$)
326+
327+defListItemToTexinfo :: ([Inline], [Block])
328+ -> State WriterState Doc
329+defListItemToTexinfo (term, def) = do
330+ term' <- inlineListToTexinfo $ deVerb term
331+ def' <- blockListToTexinfo def
332+ return $ text "@item " <> term' <> text "\n" $$ def'
333+
334+-- | Convert list of inline elements to Texinfo.
335+inlineListToTexinfo :: [Inline] -- ^ Inlines to convert
336+ -> State WriterState Doc
337+inlineListToTexinfo lst = mapM inlineToTexinfo lst >>= return . hcat
338+
339+-- | Convert list of inline elements to Texinfo acceptable for a node name.
340+inlineListForNode :: [Inline] -- ^ Inlines to convert
341+ -> State WriterState Doc
342+inlineListForNode lst = mapM inlineForNode lst >>= return . hcat
343+
344+inlineForNode (Str str) = return $ text $ filter (not.disallowedInNode) str
345+inlineForNode (Emph lst) = inlineListForNode (deVerb lst)
346+inlineForNode (Strong lst) = inlineListForNode (deVerb lst)
347+inlineForNode (Strikeout lst) = inlineListForNode (deVerb lst)
348+inlineForNode (Superscript lst) = inlineListForNode (deVerb lst)
349+inlineForNode (Subscript lst) = inlineListForNode (deVerb lst)
350+inlineForNode (Quoted _ lst) = inlineListForNode (deVerb lst)
351+inlineForNode (Code str) = inlineForNode (Str str)
352+inlineForNode Space = return $ char ' '
353+inlineForNode EmDash = return $ text "---"
354+inlineForNode EnDash = return $ text "--"
355+inlineForNode Apostrophe = return $ char '\''
356+inlineForNode Ellipses = return $ text "..."
357+inlineForNode LineBreak = return empty
358+inlineForNode (Math _) = return empty
359+inlineForNode (TeX _) = return empty
360+inlineForNode (HtmlInline _) = return empty
361+inlineForNode (Link lst _) = inlineListForNode (deVerb lst)
362+inlineForNode (Image lst _) = inlineListForNode (deVerb lst)
363+inlineForNode (Note _) = return empty
364+
365+-- XXX not sure what the complete set of illegal characters is.
366+disallowedInNode '.' = True
367+disallowedInNode ',' = True
368+disallowedInNode _ = False
369+
370+-- | Convert inline element to Texinfo
371+inlineToTexinfo :: Inline -- ^ Inline to convert
372+ -> State WriterState Doc
373+
374+inlineToTexinfo (Emph lst) =
375+ inlineListToTexinfo (deVerb lst) >>= return . inCmd "emph"
376+
377+inlineToTexinfo (Strong lst) =
378+ inlineListToTexinfo (deVerb lst) >>= return . inCmd "strong"
379+
380+inlineToTexinfo (Strikeout lst) = do
381+ addToHeader $ "@macro textstrikeout{text}\n" ++
382+ "~~\\text\\~~\n" ++
383+ "@end macro\n"
384+ contents <- inlineListToTexinfo $ deVerb lst
385+ return $ text "@textstrikeout{" <> contents <> text "}"
386+
387+inlineToTexinfo (Superscript lst) = do
388+ addToHeader $ "@macro textsuperscript{text}\n" ++
389+ "@iftex\n" ++
390+ "@textsuperscript{\\text\\}\n" ++
391+ "@end iftex\n" ++
392+ "@ifnottex\n" ++
393+ "^@{\\text\\@}\n" ++
394+ "@end ifnottex\n" ++
395+ "@end macro\n"
396+ contents <- inlineListToTexinfo $ deVerb lst
397+ return $ text "@textsuperscript{" <> contents <> char '}'
398+
399+inlineToTexinfo (Subscript lst) = do
400+ addToHeader $ "@macro textsubscript{text}\n" ++
401+ "@iftex\n" ++
402+ "@textsubscript{\\text\\}\n" ++
403+ "@end iftex\n" ++
404+ "@ifnottex\n" ++
405+ "_@{\\text\\@}\n" ++
406+ "@end ifnottex\n" ++
407+ "@end macro\n"
408+ contents <- inlineListToTexinfo $ deVerb lst
409+ return $ text "@textsubscript{" <> contents <> char '}'
410+
411+inlineToTexinfo (Code str) = do
412+ let chr = ((enumFromTo '!' '~') \\ str) !! 0
413+ return $ text $ "@verb{" ++ [chr] ++ str ++ [chr] ++ "}"
414+
415+inlineToTexinfo (Quoted SingleQuote lst) = do
416+ contents <- inlineListToTexinfo lst
417+ return $ char '`' <> contents <> char '\''
418+
419+inlineToTexinfo (Quoted DoubleQuote lst) = do
420+ contents <- inlineListToTexinfo lst
421+ return $ text "``" <> contents <> text "''"
422+
423+inlineToTexinfo Apostrophe = return $ char '\''
424+inlineToTexinfo EmDash = return $ text "---"
425+inlineToTexinfo EnDash = return $ text "--"
426+inlineToTexinfo Ellipses = return $ text "@dots{}"
427+inlineToTexinfo (Str str) = return $ text (stringToTexinfo str)
428+inlineToTexinfo (Math str) = return $ inCmd "math" $ text str
429+inlineToTexinfo (TeX str) = return $ text "@tex" $$ text str $$ text "@end tex"
430+inlineToTexinfo (HtmlInline str) = return empty
431+inlineToTexinfo (LineBreak) = return $ text "@*"
432+inlineToTexinfo Space = return $ char ' '
433+
434+inlineToTexinfo (Link txt (src, _)) = do
435+ case txt of
436+ [Code x] | x == src -> -- autolink
437+ do return $ text $ "@url{" ++ x ++ "}"
438+ _ -> do contents <- inlineListToTexinfo $ deVerb txt
439+ let src1 = stringToTexinfo src
440+ return $ text ("@uref{" ++ src1 ++ ",") <> contents <>
441+ char '}'
442+
443+inlineToTexinfo (Image alternate (source, tit)) = do
444+ content <- inlineListToTexinfo $ deVerb alternate
445+ return $ text ("@image{" ++ base ++ ",,,") <> content <> text "," <>
446+ text (ext ++ "}")
447+ where
448+ (revext, revbase) = break (=='.') (reverse source)
449+ ext = reverse revext
450+ base = case revbase of
451+ ('.' : rest) -> reverse rest
452+ _ -> reverse revbase
453+
454+inlineToTexinfo (Note contents) = do
455+ contents' <- blockListToTexinfo contents
456+ let rawnote = stripTrailingNewlines $ render contents'
457+ let optNewline = "@end verbatim" `isSuffixOf` rawnote
458+ return $ text "@footnote{" <>
459+ text rawnote <>
460+ (if optNewline then char '\n' else empty) <>
461+ char '}'