diff options
Diffstat (limited to 'src/Text/Pandoc/Writers/RTF.hs')
-rw-r--r-- | src/Text/Pandoc/Writers/RTF.hs | 194 |
1 files changed, 194 insertions, 0 deletions
diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs new file mode 100644 index 000000000..64f17cc74 --- /dev/null +++ b/src/Text/Pandoc/Writers/RTF.hs @@ -0,0 +1,194 @@ +-- | Convert Pandoc to 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) = + let notes = filter isNoteBlock blocks in -- assumes all notes are at outer level + 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 \\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) = "" -- there shouldn't be any after 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, for better or worse +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) + |