diff options
author | John MacFarlane <jgm@berkeley.edu> | 2021-08-28 09:19:50 -0700 |
---|---|---|
committer | John MacFarlane <jgm@berkeley.edu> | 2021-08-28 12:16:14 -0700 |
commit | 51caa8b78d66ac81253766cc2c6916d39c14efc2 (patch) | |
tree | db2ca0329597c3018bba6f9838a713f044f34605 /src/Text/Pandoc | |
parent | 4d7cdc467163601fd819199a69860616a9778040 (diff) | |
download | pandoc-51caa8b78d66ac81253766cc2c6916d39c14efc2.tar.gz |
Docx writer: handle SVG images.
This change has several parts:
- In Text.Pandoc.App, if the writer is docx, we fill the media
bag and attempt to convert any SVG images to PNG, adding these
to the media bag. The PNG backups have the same filenames as
the SVG images, but with an added .png extension. If the conversion
cannot be done (e.g. because rsvg-convert is not present),
a warning is omitted.
- In Text.Pandoc.Writers.Docx, we now use Word 2016's syntax for
including SVG images. If a PNG fallback is present in the media bag,
we include a link to that too.
It would be helpful if someone with an old Word version could test
to see that the documents we produce can be opened and viewed with
the PNG fallbacks. If not, then perhaps we can eliminate the
slightly complex code for producing these fallbacks.
Closes #4058.
Diffstat (limited to 'src/Text/Pandoc')
-rw-r--r-- | src/Text/Pandoc/App.hs | 21 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/Docx.hs | 41 |
2 files changed, 56 insertions, 6 deletions
diff --git a/src/Text/Pandoc/App.hs b/src/Text/Pandoc/App.hs index 0b7f2458d..15236896c 100644 --- a/src/Text/Pandoc/App.hs +++ b/src/Text/Pandoc/App.hs @@ -26,7 +26,7 @@ module Text.Pandoc.App ( , applyFilters ) where import qualified Control.Exception as E -import Control.Monad ( (>=>), when ) +import Control.Monad ( (>=>), when, forM_ ) import Control.Monad.Trans ( MonadIO(..) ) import Control.Monad.Except (throwError, catchError) import qualified Data.ByteString as BS @@ -45,12 +45,14 @@ import qualified Data.Text.Encoding.Error as TSE import Network.URI (URI (..), parseURI) import System.Directory (doesDirectoryExist) import System.Exit (exitSuccess) -import System.FilePath ( takeBaseName, takeExtension ) +import System.FilePath ( takeBaseName, takeExtension) import System.IO (nativeNewline, stdout) import qualified System.IO as IO (Newline (..)) import Text.Pandoc import Text.Pandoc.Builder (setMeta) +import Text.Pandoc.MediaBag (mediaItems) import Text.Pandoc.MIME (getCharset, MimeType) +import Text.Pandoc.Image (svgToPng) import Text.Pandoc.App.FormatHeuristics (formatFromFilePaths) import Text.Pandoc.App.Opt (Opt (..), LineEnding (..), defaultOpts, IpynbOutput (..)) @@ -71,7 +73,6 @@ import qualified Text.Pandoc.UTF8 as UTF8 import System.Posix.IO (stdOutput) import System.Posix.Terminal (queryTerminal) #endif --- import Debug.Trace convertWithOpts :: Opt -> IO () convertWithOpts opts = do @@ -274,6 +275,7 @@ convertWithOpts opts = do mconcat <$> mapM (r readerOpts . inputToLazyByteString) inputs) >>= ( (if isJust (optExtractMedia opts) + || writerNameBase == "docx" -- for fallback png creation then fillMediaBag else return) >=> return . adjustMetadata (metadataFromFile <>) @@ -284,6 +286,19 @@ convertWithOpts opts = do >=> maybe return extractMedia (optExtractMedia opts) ) + when (writerNameBase == "docx") $ do -- create fallback pngs for svgs + items <- mediaItems <$> getMediaBag + forM_ items $ \(fp, mt, bs) -> + case T.takeWhile (/=';') mt of + "image/svg+xml" -> do + res <- svgToPng (writerDpi writerOptions) bs + case res of + Right bs' -> do + let fp' = fp <> ".png" + insertMedia fp' (Just "image/png") bs' + Left e -> report $ CouldNotConvertImage (T.pack fp) (tshow e) + _ -> return () + output <- case writer of ByteStringWriter f -> BinaryOutput <$> f writerOptions doc TextWriter f -> case outputPdfProgram outputSettings of diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index efd8b2658..c0e2aae97 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -36,7 +36,9 @@ import Data.Time.Clock.POSIX import Data.Digest.Pure.SHA (sha1, showDigest) import Skylighting import Text.Collate.Lang (renderLang) -import Text.Pandoc.Class.PandocMonad (PandocMonad, report, toLang, translateTerm) +import Text.Pandoc.Class (PandocMonad, report, toLang, translateTerm, + getMediaBag) +import Text.Pandoc.MediaBag (lookupMedia, mediaItems, MediaItem(..)) import qualified Text.Pandoc.Translations as Term import qualified Text.Pandoc.Class.PandocMonad as P import Data.Time @@ -1233,9 +1235,42 @@ inlineToOpenXML' opts (Image attr@(imgident, _, _) alt (src, title)) = do imgs <- gets stImages let stImage = M.lookup (T.unpack src) imgs - generateImgElt (ident, _, _, img) = do + generateImgElt (ident, _fp, mt, img) = do docprid <- getUniqueId nvpicprid <- getUniqueId + (blipAttrs, blipContents) <- + case T.takeWhile (/=';') <$> mt of + Just "image/svg+xml" -> do + -- get fallback png + mediabag <- getMediaBag + mbFallback <- + case lookupMedia (T.unpack (src <> ".png")) mediabag of + Just item -> do + id' <- T.unpack . ("rId" <>) <$> getUniqueId + let fp' = "media/" <> id' <> ".png" + let imgdata = (id', + fp', + Just (mediaMimeType item), + BL.toStrict $ mediaContents item) + modify $ \st -> st { stImages = + M.insert fp' imgdata $ stImages st } + return $ Just id' + Nothing -> return Nothing + let extLst = mknode "a:extLst" [] + [ mknode "a:ext" + [("uri","{28A0092B-C50C-407E-A947-70E740481C1C}")] + [ mknode "a14:useLocalDpi" + [("xmlns:a14","http://schemas.microsoft.com/office/drawing/2010/main"), + ("val","0")] () ] + , mknode "a:ext" + [("uri","{96DAC541-7B7A-43D3-8B79-37D633B846F1}")] + [ mknode "asvg:svgBlip" + [("xmlns:asvg", "http://schemas.microsoft.com/office/drawing/2016/SVG/main"), + ("r:embed",T.pack ident)] () ] + ] + return (maybe [] (\id'' -> [("r:embed", T.pack id'')]) mbFallback, + [extLst]) + _ -> return ([("r:embed", T.pack ident)], []) let (xpt,ypt) = desiredSizeInPoints opts attr (either (const def) id (imageSize opts img)) @@ -1252,7 +1287,7 @@ inlineToOpenXML' opts (Image attr@(imgident, _, _) alt (src, title)) = do ,("name","Picture")] () , cNvPicPr ] blipFill = mknode "pic:blipFill" [] - [ mknode "a:blip" [("r:embed",T.pack ident)] () + [ mknode "a:blip" blipAttrs blipContents , mknode "a:stretch" [] $ mknode "a:fillRect" [] () ] |