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.

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" [] ()
           ]