{- Copyright (C) 2006 John MacFarlane 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 : Copyright : Copyright (C) 2006 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane 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 List ( isSuffixOf ) import Char ( ord, chr ) -- | Convert Pandoc to a string in rich text format. writeRTF :: WriterOptions -> Pandoc -> String writeRTF options (Pandoc meta blocks) = -- assumes all notes are at outer level let notes = filter isNoteBlock blocks in let head = if writerStandalone options then rtfHeader notes (writerHeader options) meta else "" foot = if writerStandalone options then "\n}\n" else "" body = (writerIncludeBefore options) ++ (concatMap (blockToRTF notes 0) (replaceReferenceLinks blocks)) ++ (writerIncludeAfter options) in head ++ body ++ foot -- | 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) escapeSpecial = backslashEscape "{\\}" escapeTab = gsub "\\\\t" "\\\\tab " -- | Escape strings as needed for rich text format. stringToRTF :: String -> String stringToRTF = handleUnicode . escapeSpecial . escapeTab -- | Escape raw LaTeX strings for RTF. Don't escape \t; it might -- be the first letter of a command! latexStringToRTF :: String -> String latexStringToRTF = 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 " ++ (latexStringToRTF 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) -> String -- ^ string with content -> String rtfParSpaced spaceAfter indent firstLineIndent content = "{\\pard \\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) -> 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) -> 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 -> [String] orderedMarkers indent = case (indent `mod` 720) of 0 -> map (\x -> show x ++ ".") [1..] otherwise -> map (\x -> show x ++ ".") $ cycle ['a'..'z'] -- | Returns RTF header. rtfHeader :: [Block] -- ^ list of note blocks -> String -- ^ header text -> Meta -- ^ bibliographic information -> String rtfHeader notes headerText (Meta title authors date) = let titletext = if null title then "" else rtfPar 0 0 ("\\qc \\b \\fs36 " ++ inlineListToRTF notes title) authorstext = if null authors then "" else rtfPar 0 0 ("\\qc " ++ (joinWithSep "\\" (map stringToRTF authors))) datetext = if date == "" then "" else rtfPar 0 0 ("\\qc " ++ stringToRTF date) in let spacer = if null (titletext ++ authorstext ++ datetext) then "" else rtfPar 0 0 "" in headerText ++ titletext ++ authorstext ++ datetext ++ spacer -- | Convert Pandoc block element to RTF. blockToRTF :: [Block] -- ^ list of note blocks -> Int -- ^ indent level -> Block -- ^ block to convert -> String blockToRTF notes indent Blank = rtfPar indent 0 "" blockToRTF notes indent Null = "" blockToRTF notes indent (Plain lst) = rtfCompact indent 0 (inlineListToRTF notes lst) blockToRTF notes indent (Para lst) = rtfPar indent 0 (inlineListToRTF notes lst) blockToRTF notes indent (BlockQuote lst) = concatMap (blockToRTF notes (indent + indentIncrement)) lst blockToRTF notes indent (Note ref lst) = "" -- shouldn't be any aftr filtering blockToRTF notes indent (Key _ _) = "" blockToRTF notes indent (CodeBlock str) = rtfPar indent 0 ("\\f1 " ++ (codeStringToRTF str)) blockToRTF notes indent (RawHtml str) = "" blockToRTF notes indent (BulletList lst) = spaceAtEnd $ concatMap (listItemToRTF notes indent (bulletMarker indent)) lst blockToRTF notes indent (OrderedList lst) = spaceAtEnd $ concat $ zipWith (listItemToRTF notes indent) (orderedMarkers indent) lst blockToRTF notes indent HorizontalRule = rtfPar indent 0 "\\qc \\emdash\\emdash\\emdash\\emdash\\emdash" blockToRTF notes indent (Header level lst) = rtfPar indent 0 ("\\b \\fs" ++ (show (40 - (level * 4))) ++ " " ++ (inlineListToRTF notes lst)) -- | 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 :: [Block] -- ^ list of note blocks -> Int -- ^ indent level -> String -- ^ list start marker -> [Block] -- ^ list item (list of blocks) -> [Char] listItemToRTF notes indent marker [] = rtfCompact (indent + listIncrement) (0 - listIncrement) (marker ++ "\\tx" ++ (show listIncrement) ++ "\\tab ") listItemToRTF notes indent marker list = let (first:rest) = map (blockToRTF notes (indent + listIncrement)) list in let modFirst = gsub "\\\\fi-?[0-9]+" ("\\\\fi" ++ (show (0 - listIncrement)) ++ " " ++ marker ++ "\\\\tx" ++ (show listIncrement) ++ "\\\\tab") first in modFirst ++ (concat rest) -- | Convert list of inline items to RTF. inlineListToRTF :: [Block] -- ^ list of note blocks -> [Inline] -- ^ list of inlines to convert -> String inlineListToRTF notes lst = concatMap (inlineToRTF notes) lst -- | Convert inline item to RTF. inlineToRTF :: [Block] -- ^ list of note blocks -> Inline -- ^ inline to convert -> String inlineToRTF notes (Emph lst) = "{\\i " ++ (inlineListToRTF notes lst) ++ "} " inlineToRTF notes (Strong lst) = "{\\b " ++ (inlineListToRTF notes lst) ++ "} " inlineToRTF notes (Code str) = "{\\f1 " ++ (codeStringToRTF str) ++ "} " inlineToRTF notes (Str str) = stringToRTF str inlineToRTF notes (TeX str) = latexToRTF str inlineToRTF notes (HtmlInline str) = "" inlineToRTF notes (LineBreak) = "\\line " inlineToRTF notes Space = " " inlineToRTF notes (Link text (Src src tit)) = "{\\field{\\*\\fldinst{HYPERLINK \"" ++ (codeStringToRTF src) ++ "\"}}{\\fldrslt{\\ul\n" ++ (inlineListToRTF notes text) ++ "\n}}}\n" inlineToRTF notes (Link text (Ref [])) = "[" ++ (inlineListToRTF notes text) ++ "]" inlineToRTF notes (Link text (Ref ref)) = "[" ++ (inlineListToRTF notes text) ++ "][" ++ (inlineListToRTF notes ref) ++ "]" -- this is what markdown does inlineToRTF notes (Image alternate (Src source tit)) = "{\\cf1 [image: " ++ source ++ "]\\cf0}" inlineToRTF notes (Image alternate (Ref [])) = "![" ++ (inlineListToRTF notes alternate) ++ "]" inlineToRTF notes (Image alternate (Ref ref)) = "![" ++ (inlineListToRTF notes alternate) ++ "][" ++ (inlineListToRTF notes ref) ++ "]" inlineToRTF [] (NoteRef ref) = "" inlineToRTF ((Note firstref firstblocks):rest) (NoteRef ref) = if firstref == ref then "{\\super\\chftn}{\\*\\footnote\\chftn\\~\\plain\\pard " ++ (concatMap (blockToRTF rest 0) firstblocks) ++ "}" else inlineToRTF rest (NoteRef ref)