diff options
Diffstat (limited to 'src/Text/Pandoc/Writers/RTF.hs')
-rw-r--r-- | src/Text/Pandoc/Writers/RTF.hs | 78 |
1 files changed, 46 insertions, 32 deletions
diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs index fb935fa6a..43405ce3c 100644 --- a/src/Text/Pandoc/Writers/RTF.hs +++ b/src/Text/Pandoc/Writers/RTF.hs @@ -1,5 +1,5 @@ {- -Copyright (C) 2006-2010 John MacFarlane <jgm@berkeley.edu> +Copyright (C) 2006-2014 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 @@ -18,7 +18,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Writers.RTF - Copyright : Copyright (C) 2006-2010 John MacFarlane + Copyright : Copyright (C) 2006-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane <jgm@berkeley.edu> @@ -36,50 +36,64 @@ import Text.Pandoc.Readers.TeXMath import Text.Pandoc.Templates (renderTemplate') import Text.Pandoc.Walk import Data.List ( isSuffixOf, intercalate ) -import Data.Char ( ord, chr, isDigit, toLower ) -import System.FilePath ( takeExtension ) +import Data.Char ( ord, chr, isDigit ) import qualified Data.ByteString as B +import qualified Data.Map as M import Text.Printf ( printf ) -import Network.URI ( isURI, unEscapeString ) -import qualified Control.Exception as E +import Text.Pandoc.ImageSize --- | Convert Image inlines into a raw RTF embedded image, read from a file. +-- | Convert Image inlines into a raw RTF embedded image, read from a file, +-- or a MediaBag, or the internet. -- If file not found or filetype not jpeg or png, leave the inline unchanged. -rtfEmbedImage :: Inline -> IO Inline -rtfEmbedImage x@(Image _ (src,_)) = do - let ext = map toLower (takeExtension src) - if ext `elem` [".jpg",".jpeg",".png"] && not (isURI src) - then do - let src' = unEscapeString src - imgdata <- E.catch (B.readFile src') - (\e -> let _ = (e :: E.SomeException) in return B.empty) - let bytes = map (printf "%02x") $ B.unpack imgdata - let filetype = case ext of - ".jpg" -> "\\jpegblip" - ".jpeg" -> "\\jpegblip" - ".png" -> "\\pngblip" - _ -> error "Unknown file type" - let raw = "{\\pict" ++ filetype ++ " " ++ concat bytes ++ "}" - return $ if B.null imgdata - then x - else RawInline (Format "rtf") raw - else return x -rtfEmbedImage x = return x +rtfEmbedImage :: WriterOptions -> Inline -> IO Inline +rtfEmbedImage opts x@(Image _ (src,_)) = do + result <- fetchItem' (writerMediaBag opts) (writerSourceURL opts) src + case result of + Right (imgdata, Just mime) + | mime == "image/jpeg" || mime == "image/png" -> do + let bytes = map (printf "%02x") $ B.unpack imgdata + let filetype = case mime of + "image/jpeg" -> "\\jpegblip" + "image/png" -> "\\pngblip" + _ -> error "Unknown file type" + let sizeSpec = case imageSize imgdata of + Nothing -> "" + Just sz -> "\\picw" ++ show xpx ++ + "\\pich" ++ show ypx ++ + "\\picwgoal" ++ show (xpt * 20) + ++ "\\pichgoal" ++ show (ypt * 20) + -- twip = 1/1440in = 1/20pt + where (xpx, ypx) = sizeInPixels sz + (xpt, ypt) = sizeInPoints sz + let raw = "{\\pict" ++ filetype ++ sizeSpec ++ " " ++ + concat bytes ++ "}" + return $ if B.null imgdata + then x + else RawInline (Format "rtf") raw + _ -> return x +rtfEmbedImage _ x = return x -- | Convert Pandoc to a string in rich text format, with -- images embedded as encoded binary data. writeRTFWithEmbeddedImages :: WriterOptions -> Pandoc -> IO String writeRTFWithEmbeddedImages options doc = - writeRTF options `fmap` walkM rtfEmbedImage doc + writeRTF options `fmap` walkM (rtfEmbedImage options) doc -- | Convert Pandoc to a string in rich text format. writeRTF :: WriterOptions -> Pandoc -> String -writeRTF options (Pandoc meta blocks) = +writeRTF options (Pandoc meta@(Meta metamap) blocks) = let spacer = not $ all null $ docTitle meta : docDate meta : docAuthors meta + toPlain (MetaBlocks [Para ils]) = MetaInlines ils + toPlain x = x + -- adjust title, author, date so we don't get para inside para + meta' = Meta $ M.adjust toPlain "title" + . M.adjust toPlain "author" + . M.adjust toPlain "date" + $ metamap Just metadata = metaToJSON options (Just . concatMap (blockToRTF 0 AlignDefault)) (Just . inlineListToRTF) - meta + meta' body = concatMap (blockToRTF 0 AlignDefault) blocks isTOCHeader (Header lev _ _) = lev <= writerTOCDepth options isTOCHeader _ = False @@ -259,7 +273,7 @@ tableRowToRTF header indent aligns sizes' cols = tableItemToRTF :: Int -> Alignment -> [Block] -> String tableItemToRTF indent alignment item = let contents = concatMap (blockToRTF indent alignment) item - in "{\\intbl " ++ contents ++ "\\cell}\n" + in "{" ++ substitute "\\pard" "\\pard\\intbl" contents ++ "\\cell}\n" -- | Ensure that there's the same amount of space after compact -- lists as after regular lists. @@ -324,7 +338,7 @@ inlineToRTF (Quoted DoubleQuote lst) = "\\u8220\"" ++ (inlineListToRTF lst) ++ "\\u8221\"" inlineToRTF (Code _ str) = "{\\f1 " ++ (codeStringToRTF str) ++ "}" inlineToRTF (Str str) = stringToRTF str -inlineToRTF (Math t str) = inlineListToRTF $ readTeXMath' t str +inlineToRTF (Math t str) = inlineListToRTF $ texMathToInlines t str inlineToRTF (Cite _ lst) = inlineListToRTF lst inlineToRTF (RawInline f str) | f == Format "rtf" = str |