RTF writer: Added writeRTFWithEmbeddedImages.
* RTF writer: Export writeRTFWithEmbeddedImages instead of rtfEmbedImage. * Text.Pandoc: Use writeRTFWithEmbeddedImages for RTF. * Moved code for embedding images in RTF out of pandoc.hs.
This commit is contained in:
parent
4aea26e8e1
commit
8eab759a9c
5 changed files with 14 additions and 13 deletions
|
@ -1 +1 @@
|
|||
Subproject commit 25386101d5428eedca69089ab8e5373f0a079bff
|
||||
Subproject commit b49608bf92ad66f255cd3371da834ddb7bee5211
|
12
pandoc.hs
12
pandoc.hs
|
@ -1062,10 +1062,6 @@ main = do
|
|||
|
||||
let doc0 = foldr ($) doc transforms
|
||||
|
||||
doc1 <- if "rtf" `isPrefixOf` writerName'
|
||||
then bottomUpM rtfEmbedImage doc0
|
||||
else return doc0
|
||||
|
||||
let writeBinary :: B.ByteString -> IO ()
|
||||
writeBinary = B.writeFile (UTF8.encodePath outputFile)
|
||||
|
||||
|
@ -1075,15 +1071,15 @@ main = do
|
|||
|
||||
case getWriter writerName' of
|
||||
Left e -> err 9 e
|
||||
Right (IOStringWriter f) -> f writerOptions doc1 >>= writerFn outputFile
|
||||
Right (IOByteStringWriter f) -> f writerOptions doc1 >>= writeBinary
|
||||
Right (IOStringWriter f) -> f writerOptions doc0 >>= writerFn outputFile
|
||||
Right (IOByteStringWriter f) -> f writerOptions doc0 >>= writeBinary
|
||||
Right (PureStringWriter f)
|
||||
| pdfOutput -> do
|
||||
res <- tex2pdf latexEngine $ f writerOptions doc1
|
||||
res <- tex2pdf latexEngine $ f writerOptions doc0
|
||||
case res of
|
||||
Right pdf -> writeBinary pdf
|
||||
Left err' -> err 43 $ UTF8.toStringLazy err'
|
||||
| otherwise -> selfcontain (f writerOptions doc1 ++
|
||||
| otherwise -> selfcontain (f writerOptions doc0 ++
|
||||
['\n' | not standalone'])
|
||||
>>= writerFn outputFile . handleEntities
|
||||
where htmlFormat = writerName' `elem`
|
||||
|
|
|
@ -103,7 +103,6 @@ module Text.Pandoc
|
|||
-- * Miscellaneous
|
||||
, getReader
|
||||
, getWriter
|
||||
, rtfEmbedImage
|
||||
, jsonFilter
|
||||
, ToJsonFilter(..)
|
||||
) where
|
||||
|
@ -243,7 +242,7 @@ writers = [
|
|||
,("rst" , PureStringWriter writeRST)
|
||||
,("mediawiki" , PureStringWriter writeMediaWiki)
|
||||
,("textile" , PureStringWriter writeTextile)
|
||||
,("rtf" , PureStringWriter writeRTF)
|
||||
,("rtf" , IOStringWriter writeRTFWithEmbeddedImages)
|
||||
,("org" , PureStringWriter writeOrg)
|
||||
,("asciidoc" , PureStringWriter writeAsciiDoc)
|
||||
]
|
||||
|
|
|
@ -27,12 +27,13 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
|||
|
||||
Conversion of 'Pandoc' documents to RTF (rich text format).
|
||||
-}
|
||||
module Text.Pandoc.Writers.RTF ( writeRTF, rtfEmbedImage ) where
|
||||
module Text.Pandoc.Writers.RTF ( writeRTF, writeRTFWithEmbeddedImages ) where
|
||||
import Text.Pandoc.Definition
|
||||
import Text.Pandoc.Options
|
||||
import Text.Pandoc.Shared
|
||||
import Text.Pandoc.Readers.TeXMath
|
||||
import Text.Pandoc.Templates (renderTemplate)
|
||||
import Text.Pandoc.Generic (bottomUpM)
|
||||
import Data.List ( isSuffixOf, intercalate )
|
||||
import Data.Char ( ord, isDigit, toLower )
|
||||
import System.FilePath ( takeExtension )
|
||||
|
@ -64,6 +65,12 @@ rtfEmbedImage x@(Image _ (src,_)) = do
|
|||
else 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` bottomUpM rtfEmbedImage doc
|
||||
|
||||
-- | Convert Pandoc to a string in rich text format.
|
||||
writeRTF :: WriterOptions -> Pandoc -> String
|
||||
writeRTF options (Pandoc (Meta title authors date) blocks) =
|
||||
|
|
|
@ -357,4 +357,3 @@
|
|||
}
|
||||
\intbl\row}
|
||||
{\pard \ql \f0 \sa180 \li0 \fi0 \par}
|
||||
|
||||
|
|
Loading…
Reference in a new issue