aboutsummaryrefslogtreecommitdiff
path: root/Text/Pandoc/Writers/RTF.hs
diff options
context:
space:
mode:
authorfiddlosopher <fiddlosopher@788f1e2b-df1e-0410-8736-df70ead52e1b>2007-11-03 22:14:03 +0000
committerfiddlosopher <fiddlosopher@788f1e2b-df1e-0410-8736-df70ead52e1b>2007-11-03 22:14:03 +0000
commit4a841bfc5464907adea4cdd655485565565b40ae (patch)
tree36c0a21e3639614c8d25b5fb1909c32d0ab11dcd /Text/Pandoc/Writers/RTF.hs
parent3116d30133196e1bb258f7e74e03d4a85f3b21ae (diff)
downloadpandoc-4a841bfc5464907adea4cdd655485565565b40ae.tar.gz
Use template haskell to avoid the need for templates:
+ Added library Text.Pandoc.Include, with a template haskell function $(includeStrFrom fname) to include a file as a string constant at compile time. + This removes the need for the 'templates' directory or Makefile target. These have been removed. + The base source directory has been changed from src to . + A new 'data' directory has been added, containing the ASCIIMathML.js script, writer headers, and S5 files. + The src/wrappers directory has been moved to 'wrappers'. + The Text.Pandoc.ASCIIMathML library is no longer needed, since Text.Pandoc.Writers.HTML can use includeStrFrom to include the ASCIIMathML.js code directly. It has been removed. git-svn-id: https://pandoc.googlecode.com/svn/trunk@1063 788f1e2b-df1e-0410-8736-df70ead52e1b
Diffstat (limited to 'Text/Pandoc/Writers/RTF.hs')
-rw-r--r--Text/Pandoc/Writers/RTF.hs286
1 files changed, 286 insertions, 0 deletions
diff --git a/Text/Pandoc/Writers/RTF.hs b/Text/Pandoc/Writers/RTF.hs
new file mode 100644
index 000000000..3bd5c63b2
--- /dev/null
+++ b/Text/Pandoc/Writers/RTF.hs
@@ -0,0 +1,286 @@
+{-
+Copyright (C) 2006-7 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.RTF
+ Copyright : Copyright (C) 2006-7 John MacFarlane
+ License : GNU GPL, version 2 or above
+
+ Maintainer : John MacFarlane <jgm@berkeley.edu>
+ Stability : alpha
+ Portability : portable
+
+Conversion of 'Pandoc' documents to RTF (rich text format).
+-}
+module Text.Pandoc.Writers.RTF ( writeRTF ) where
+import Text.Pandoc.Definition
+import Text.Pandoc.Shared
+import Text.Regex ( matchRegexAll, mkRegex )
+import Data.List ( isSuffixOf )
+import Data.Char ( ord )
+
+-- | Convert Pandoc to a string in rich text format.
+writeRTF :: WriterOptions -> Pandoc -> String
+writeRTF options (Pandoc meta blocks) =
+ let head = if writerStandalone options
+ then rtfHeader (writerHeader options) meta
+ else ""
+ toc = if writerTableOfContents options
+ then tableOfContents $ filter isHeaderBlock blocks
+ else ""
+ foot = if writerStandalone options then "\n}\n" else ""
+ body = writerIncludeBefore options ++
+ concatMap (blockToRTF 0 AlignDefault) blocks ++
+ writerIncludeAfter options
+ in head ++ toc ++ body ++ foot
+
+-- | Construct table of contents from list of header blocks.
+tableOfContents :: [Block] -> String
+tableOfContents headers =
+ let contentsTree = hierarchicalize headers
+ in concatMap (blockToRTF 0 AlignDefault) $
+ [Header 1 [Str "Contents"],
+ BulletList (map elementToListItem contentsTree)]
+
+elementToListItem :: Element -> [Block]
+elementToListItem (Blk _) = []
+elementToListItem (Sec sectext subsecs) = [Plain sectext] ++
+ if null subsecs
+ then []
+ else [BulletList (map elementToListItem subsecs)]
+
+-- | Convert unicode characters (> 127) into rich text format representation.
+handleUnicode :: String -> String
+handleUnicode [] = []
+handleUnicode (c:cs) =
+ if ord c > 127
+ then '\\':'u':(show (ord c)) ++ "?" ++ handleUnicode cs
+ else c:(handleUnicode cs)
+
+-- | Escape special characters.
+escapeSpecial :: String -> String
+escapeSpecial = escapeStringUsing (('\t',"\\tab "):(backslashEscapes "{\\}"))
+
+-- | Escape strings as needed for rich text format.
+stringToRTF :: String -> String
+stringToRTF = handleUnicode . escapeSpecial
+
+-- | Escape things as needed for code block in RTF.
+codeStringToRTF :: String -> String
+codeStringToRTF str = joinWithSep "\\line\n" $ lines (stringToRTF str)
+
+-- | Deal with raw LaTeX.
+latexToRTF :: String -> String
+latexToRTF str = "{\\cf1 " ++ (stringToRTF str) ++ "\\cf0 } "
+
+-- | Make a paragraph with first-line indent, block indent, and space after.
+rtfParSpaced :: Int -- ^ space after (in twips)
+ -> Int -- ^ block indent (in twips)
+ -> Int -- ^ first line indent (relative to block) (in twips)
+ -> Alignment -- ^ alignment
+ -> String -- ^ string with content
+ -> String
+rtfParSpaced spaceAfter indent firstLineIndent alignment content =
+ let alignString = case alignment of
+ AlignLeft -> "\\ql "
+ AlignRight -> "\\qr "
+ AlignCenter -> "\\qc "
+ AlignDefault -> "\\ql "
+ in "{\\pard " ++ alignString ++
+ "\\f0 \\sa" ++ (show spaceAfter) ++ " \\li" ++ (show indent) ++
+ " \\fi" ++ (show firstLineIndent) ++ " " ++ content ++ "\\par}\n"
+
+-- | Default paragraph.
+rtfPar :: Int -- ^ block indent (in twips)
+ -> Int -- ^ first line indent (relative to block) (in twips)
+ -> Alignment -- ^ alignment
+ -> String -- ^ string with content
+ -> String
+rtfPar = rtfParSpaced 180
+
+-- | Compact paragraph (e.g. for compact list items).
+rtfCompact :: Int -- ^ block indent (in twips)
+ -> Int -- ^ first line indent (relative to block) (in twips)
+ -> Alignment -- ^ alignment
+ -> String -- ^ string with content
+ -> String
+rtfCompact = rtfParSpaced 0
+
+-- number of twips to indent
+indentIncrement = 720
+listIncrement = 360
+
+-- | Returns appropriate bullet list marker for indent level.
+bulletMarker :: Int -> String
+bulletMarker indent = case indent `mod` 720 of
+ 0 -> "\\bullet "
+ otherwise -> "\\endash "
+
+-- | Returns appropriate (list of) ordered list markers for indent level.
+orderedMarkers :: Int -> ListAttributes -> [String]
+orderedMarkers indent (start, style, delim) =
+ if style == DefaultStyle && delim == DefaultDelim
+ then case indent `mod` 720 of
+ 0 -> orderedListMarkers (start, Decimal, Period)
+ otherwise -> orderedListMarkers (start, LowerAlpha, Period)
+ else orderedListMarkers (start, style, delim)
+
+-- | Returns RTF header.
+rtfHeader :: String -- ^ header text
+ -> Meta -- ^ bibliographic information
+ -> String
+rtfHeader headerText (Meta title authors date) =
+ let titletext = if null title
+ then ""
+ else rtfPar 0 0 AlignCenter $
+ "\\b \\fs36 " ++ inlineListToRTF title
+ authorstext = if null authors
+ then ""
+ else rtfPar 0 0 AlignCenter (" " ++ (joinWithSep "\\" $
+ map stringToRTF authors))
+ datetext = if date == ""
+ then ""
+ else rtfPar 0 0 AlignCenter (" " ++ stringToRTF date) in
+ let spacer = if null (titletext ++ authorstext ++ datetext)
+ then ""
+ else rtfPar 0 0 AlignDefault "" in
+ headerText ++ titletext ++ authorstext ++ datetext ++ spacer
+
+-- | Convert Pandoc block element to RTF.
+blockToRTF :: Int -- ^ indent level
+ -> Alignment -- ^ alignment
+ -> Block -- ^ block to convert
+ -> String
+blockToRTF _ _ Null = ""
+blockToRTF indent alignment (Plain lst) =
+ rtfCompact indent 0 alignment $ inlineListToRTF lst
+blockToRTF indent alignment (Para lst) =
+ rtfPar indent 0 alignment $ inlineListToRTF lst
+blockToRTF indent alignment (BlockQuote lst) =
+ concatMap (blockToRTF (indent + indentIncrement) alignment) lst
+blockToRTF indent _ (CodeBlock str) =
+ rtfPar indent 0 AlignLeft ("\\f1 " ++ (codeStringToRTF str))
+blockToRTF _ _ (RawHtml str) = ""
+blockToRTF indent alignment (BulletList lst) = spaceAtEnd $
+ concatMap (listItemToRTF alignment indent (bulletMarker indent)) lst
+blockToRTF indent alignment (OrderedList attribs lst) = spaceAtEnd $ concat $
+ zipWith (listItemToRTF alignment indent) (orderedMarkers indent attribs) lst
+blockToRTF indent alignment (DefinitionList lst) = spaceAtEnd $
+ concatMap (definitionListItemToRTF alignment indent) lst
+blockToRTF indent _ HorizontalRule =
+ rtfPar indent 0 AlignCenter "\\emdash\\emdash\\emdash\\emdash\\emdash"
+blockToRTF indent alignment (Header level lst) = rtfPar indent 0 alignment $
+ "\\b \\fs" ++ (show (40 - (level * 4))) ++ " " ++ inlineListToRTF lst
+blockToRTF indent alignment (Table caption aligns sizes headers rows) =
+ tableRowToRTF True indent aligns sizes headers ++
+ concatMap (tableRowToRTF False indent aligns sizes) rows ++
+ rtfPar indent 0 alignment (inlineListToRTF caption)
+
+tableRowToRTF :: Bool -> Int -> [Alignment] -> [Float] -> [[Block]] -> String
+tableRowToRTF header indent aligns sizes cols =
+ let columns = concat $ zipWith (tableItemToRTF indent) aligns cols
+ totalTwips = 6 * 1440 -- 6 inches
+ rightEdges = tail $ scanl (\sofar new -> sofar + floor (new * totalTwips))
+ 0 sizes
+ cellDefs = map (\edge -> (if header
+ then "\\clbrdrb\\brdrs"
+ else "") ++ "\\cellx" ++ show edge)
+ rightEdges
+ start = "{\n\\trowd \\trgaph120\n" ++ concat cellDefs ++ "\n" ++
+ "\\trkeep\\intbl\n{\n"
+ end = "}\n\\intbl\\row}\n"
+ in start ++ columns ++ end
+
+tableItemToRTF :: Int -> Alignment -> [Block] -> String
+tableItemToRTF indent alignment item =
+ let contents = concatMap (blockToRTF indent alignment) item
+ in "{\\intbl " ++ contents ++ "\\cell}\n"
+
+-- | Ensure that there's the same amount of space after compact
+-- lists as after regular lists.
+spaceAtEnd :: String -> String
+spaceAtEnd str =
+ if isSuffixOf "\\par}\n" str
+ then (take ((length str) - 6) str) ++ "\\sa180\\par}\n"
+ else str
+
+-- | Convert list item (list of blocks) to RTF.
+listItemToRTF :: Alignment -- ^ alignment
+ -> Int -- ^ indent level
+ -> String -- ^ list start marker
+ -> [Block] -- ^ list item (list of blocks)
+ -> [Char]
+listItemToRTF alignment indent marker [] =
+ rtfCompact (indent + listIncrement) (0 - listIncrement) alignment
+ (marker ++ "\\tx" ++ (show listIncrement) ++ "\\tab ")
+listItemToRTF alignment indent marker list =
+ let (first:rest) = map (blockToRTF (indent + listIncrement) alignment) list in
+ -- insert the list marker into the (processed) first block
+ let modFirst = case matchRegexAll (mkRegex "\\\\fi-?[0-9]+") first of
+ Just (before, matched, after, _) ->
+ before ++ "\\fi" ++ show (0 - listIncrement) ++
+ " " ++ marker ++ "\\tx" ++
+ show listIncrement ++ "\\tab" ++ after
+ Nothing -> first in
+ modFirst ++ concat rest
+
+-- | Convert definition list item (label, list of blocks) to RTF.
+definitionListItemToRTF :: Alignment -- ^ alignment
+ -> Int -- ^ indent level
+ -> ([Inline],[Block]) -- ^ list item (list of blocks)
+ -> [Char]
+definitionListItemToRTF alignment indent (label, items) =
+ let labelText = blockToRTF indent alignment (Plain label)
+ itemsText = concatMap (blockToRTF (indent + listIncrement) alignment) items
+ in labelText ++ itemsText
+
+-- | Convert list of inline items to RTF.
+inlineListToRTF :: [Inline] -- ^ list of inlines to convert
+ -> String
+inlineListToRTF lst = concatMap inlineToRTF lst
+
+-- | Convert inline item to RTF.
+inlineToRTF :: Inline -- ^ inline to convert
+ -> String
+inlineToRTF (Emph lst) = "{\\i " ++ (inlineListToRTF lst) ++ "} "
+inlineToRTF (Strong lst) = "{\\b " ++ (inlineListToRTF lst) ++ "} "
+inlineToRTF (Strikeout lst) = "{\\strike " ++ (inlineListToRTF lst) ++ "} "
+inlineToRTF (Superscript lst) = "{\\super " ++ (inlineListToRTF lst) ++ "} "
+inlineToRTF (Subscript lst) = "{\\sub " ++ (inlineListToRTF lst) ++ "} "
+inlineToRTF (Quoted SingleQuote lst) =
+ "\\u8216'" ++ (inlineListToRTF lst) ++ "\\u8217'"
+inlineToRTF (Quoted DoubleQuote lst) =
+ "\\u8220\"" ++ (inlineListToRTF lst) ++ "\\u8221\""
+inlineToRTF Apostrophe = "\\u8217'"
+inlineToRTF Ellipses = "\\u8230?"
+inlineToRTF EmDash = "\\u8212-"
+inlineToRTF EnDash = "\\u8211-"
+inlineToRTF (Code str) = "{\\f1 " ++ (codeStringToRTF str) ++ "} "
+inlineToRTF (Str str) = stringToRTF str
+inlineToRTF (TeX str) = latexToRTF str
+inlineToRTF (HtmlInline str) = ""
+inlineToRTF (LineBreak) = "\\line "
+inlineToRTF Space = " "
+inlineToRTF (Link text (src, tit)) =
+ "{\\field{\\*\\fldinst{HYPERLINK \"" ++ (codeStringToRTF src) ++
+ "\"}}{\\fldrslt{\\ul\n" ++ (inlineListToRTF text) ++ "\n}}}\n"
+inlineToRTF (Image alternate (source, tit)) =
+ "{\\cf1 [image: " ++ source ++ "]\\cf0}"
+inlineToRTF (Note contents) =
+ "{\\super\\chftn}{\\*\\footnote\\chftn\\~\\plain\\pard " ++
+ (concatMap (blockToRTF 0 AlignDefault) contents) ++ "}"