From 4aef107f446dec201af29e2de562044f8f50983c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= <edwin@etorok.net>
Date: Wed, 27 Dec 2023 12:56:29 +0000
Subject: [PATCH 1/8] hlint: fix some warnings

---
 src/Text/Pandoc/Writers/Docx.hs | 7 +++----
 1 file changed, 3 insertions(+), 4 deletions(-)

diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs
index 07633922ff56..4fc2ac6b4ff6 100644
--- a/src/Text/Pandoc/Writers/Docx.hs
+++ b/src/Text/Pandoc/Writers/Docx.hs
@@ -36,8 +36,7 @@ import Control.Monad.State.Strict ( StateT(runStateT), gets, modify )
 import qualified Data.ByteString.Lazy as BL
 import Data.Containers.ListUtils (nubOrd)
 import Data.Char (isSpace, isLetter)
-import Data.List (intercalate, isPrefixOf, isSuffixOf, sortBy)
-import Data.Ord (comparing)
+import Data.List (intercalate, isPrefixOf, isSuffixOf, sortOn)
 import Data.String (fromString)
 import qualified Data.Map as M
 import Data.Maybe (fromMaybe, isNothing, mapMaybe, maybeToList, isJust)
@@ -126,7 +125,7 @@ rPrTagOrder =
 
 sortSquashed :: [Element] -> [Element]
 sortSquashed l =
-  sortBy (comparing tagIndex) l
+  sortOn tagIndex l
   where
     tagIndex :: Element -> Int
     tagIndex el =
@@ -1564,7 +1563,7 @@ inlineToOpenXML' opts (Image attr@(imgident, _, _) alt (src, title)) = do
                (either (const def) id (imageSize opts img))
         -- 12700 emu = 1 pt
         pageWidthPt = case dimension Width attr of
-                        Just (Percent a) -> pageWidth * (floor $ a * 127)
+                        Just (Percent a) -> pageWidth * floor (a * 127)
                         _                -> pageWidth * 12700
         (xemu,yemu) = fitToPage (xpt * 12700, ypt * 12700) pageWidthPt
         cNvPicPr = mknode "pic:cNvPicPr" [] $

From 0c88562950bc73cf7d8e4e7a4322f82e9fb9a52f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= <edwin@etorok.net>
Date: Tue, 26 Dec 2023 17:19:56 +0000
Subject: [PATCH 2/8] log(svgToPng): log calls to rsvg-convert with --trace
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Signed-off-by: Edwin Török <edwin@etorok.net>
---
 src/Text/Pandoc/Image.hs | 8 ++++++--
 1 file changed, 6 insertions(+), 2 deletions(-)

diff --git a/src/Text/Pandoc/Image.hs b/src/Text/Pandoc/Image.hs
index 06e6bc9cf7da..5f95b19d970f 100644
--- a/src/Text/Pandoc/Image.hs
+++ b/src/Text/Pandoc/Image.hs
@@ -18,18 +18,22 @@ import Data.Text (Text)
 import Text.Pandoc.Shared (tshow)
 import qualified Control.Exception as E
 import Control.Monad.IO.Class (MonadIO(liftIO))
+import Text.Pandoc.Class.PandocMonad
+import qualified Data.Text as T
 
 -- | Convert svg image to png. rsvg-convert
 -- is used and must be available on the path.
-svgToPng :: MonadIO m
+svgToPng :: (PandocMonad m, MonadIO m)
          => Int           -- ^ DPI
          -> L.ByteString  -- ^ Input image as bytestring
          -> m (Either Text L.ByteString)
 svgToPng dpi bs = do
   let dpi' = show dpi
+  let args = ["-f","png","-a","--dpi-x",dpi',"--dpi-y",dpi']
+  trace (T.intercalate " " $ map T.pack $ "rsvg-convert" : args)
   liftIO $ E.catch
        (do (exit, out) <- pipeProcess Nothing "rsvg-convert"
-                          ["-f","png","-a","--dpi-x",dpi',"--dpi-y",dpi']
+                          args
                           bs
            return $ if exit == ExitSuccess
               then Right out

From 682f9722642ac50e48cc43a6f20573751a7962ac Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= <edwin@etorok.net>
Date: Wed, 27 Dec 2023 10:29:23 +0000
Subject: [PATCH 3/8] refactor(svgToPng): introduce PandocMonad.svgToPng
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

This will be needed to run the conversion inside the PandocMonad,
where we know the desired image size.

The arguments are: (dpi, width, height).
The width and height is optional to more easily convert existing code.

[API change]

Signed-off-by: Edwin Török <edwin@etorok.net>
---
 pandoc-lua-engine/src/Text/Pandoc/Lua/PandocLua.hs |  1 +
 src/Text/Pandoc/App.hs                             |  5 ++---
 src/Text/Pandoc/Class/IO.hs                        |  7 +++++++
 src/Text/Pandoc/Class/PandocIO.hs                  |  1 +
 src/Text/Pandoc/Class/PandocMonad.hs               |  5 +++++
 src/Text/Pandoc/Class/PandocPure.hs                |  2 ++
 src/Text/Pandoc/Image.hs                           | 11 ++++++++---
 7 files changed, 26 insertions(+), 6 deletions(-)

diff --git a/pandoc-lua-engine/src/Text/Pandoc/Lua/PandocLua.hs b/pandoc-lua-engine/src/Text/Pandoc/Lua/PandocLua.hs
index c3f8139dda8d..86163020c3da 100644
--- a/pandoc-lua-engine/src/Text/Pandoc/Lua/PandocLua.hs
+++ b/pandoc-lua-engine/src/Text/Pandoc/Lua/PandocLua.hs
@@ -70,6 +70,7 @@ instance PandocMonad PandocLua where
   readFileLazy = IO.readFileLazy
   readFileStrict = IO.readFileStrict
   readStdinStrict = IO.readStdinStrict
+  svgToPng = IO.svgToPng
 
   glob = IO.glob
   fileExists = IO.fileExists
diff --git a/src/Text/Pandoc/App.hs b/src/Text/Pandoc/App.hs
index 6d22087853ab..d2d3c3a4a4f1 100644
--- a/src/Text/Pandoc/App.hs
+++ b/src/Text/Pandoc/App.hs
@@ -50,7 +50,6 @@ import qualified System.IO as IO (Newline (..))
 import Text.Pandoc
 import Text.Pandoc.Builder (setMeta)
 import Text.Pandoc.MediaBag (mediaItems)
-import Text.Pandoc.Image (svgToPng)
 import Text.Pandoc.App.Opt (Opt (..), LineEnding (..), defaultOpts,
                             IpynbOutput (..), OptInfo(..))
 import Text.Pandoc.App.CommandLineOptions (parseOptions, parseOptionsFromArgs,
@@ -372,14 +371,14 @@ readAbbreviations mbfilepath =
     >>= fmap (Set.fromList . filter (not . T.null) . T.lines) .
          toTextM (fromMaybe mempty mbfilepath)
 
-createPngFallbacks :: (PandocMonad m, MonadIO m) => Int -> m ()
+createPngFallbacks :: (PandocMonad m) => Int -> m ()
 createPngFallbacks dpi = 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 dpi bs
+        res <- svgToPng (dpi, Nothing, Nothing, bs)
         case res of
           Right bs' -> do
             let fp' = fp <> ".png"
diff --git a/src/Text/Pandoc/Class/IO.hs b/src/Text/Pandoc/Class/IO.hs
index 4ede6df10cf3..d62748a3d6b3 100644
--- a/src/Text/Pandoc/Class/IO.hs
+++ b/src/Text/Pandoc/Class/IO.hs
@@ -31,6 +31,7 @@ module Text.Pandoc.Class.IO
   , readFileLazy
   , readFileStrict
   , readStdinStrict
+  , svgToPng
   , extractMedia
   , writeMedia
  ) where
@@ -80,6 +81,7 @@ import qualified System.Environment as Env
 import qualified System.FilePath.Glob
 import qualified System.Random
 import qualified Text.Pandoc.UTF8 as UTF8
+import Text.Pandoc.Image (svgToPngIO)
 #ifndef EMBED_DATA_FILES
 import qualified Paths_pandoc as Paths
 #endif
@@ -170,6 +172,11 @@ readFileStrict s = liftIOError B.readFile s
 readStdinStrict :: (PandocMonad m, MonadIO m) => m B.ByteString
 readStdinStrict = liftIOError (const B.getContents) "stdin"
 
+-- | Runs an image conversion step, returning an error on failure.
+-- Not available when sandboxed.
+svgToPng :: (PandocMonad m, MonadIO m) => (Int, Maybe Double, Maybe Double, BL.ByteString) -> m (Either T.Text BL.ByteString)
+svgToPng (dpi, xPt, yPt, bs) = svgToPngIO dpi xPt yPt bs
+
 -- | Return a list of paths that match a glob, relative to the working
 -- directory. See 'System.FilePath.Glob' for the glob syntax.
 glob :: (PandocMonad m, MonadIO m) => String -> m [FilePath]
diff --git a/src/Text/Pandoc/Class/PandocIO.hs b/src/Text/Pandoc/Class/PandocIO.hs
index 61ee1f1c629b..38c4e7709661 100644
--- a/src/Text/Pandoc/Class/PandocIO.hs
+++ b/src/Text/Pandoc/Class/PandocIO.hs
@@ -63,6 +63,7 @@ instance PandocMonad PandocIO where
   readFileLazy = IO.readFileLazy
   readFileStrict = IO.readFileStrict
   readStdinStrict = IO.readStdinStrict
+  svgToPng = IO.svgToPng
 
   glob = IO.glob
   fileExists = IO.fileExists
diff --git a/src/Text/Pandoc/Class/PandocMonad.hs b/src/Text/Pandoc/Class/PandocMonad.hs
index 412696e96569..e1cc3e44afe4 100644
--- a/src/Text/Pandoc/Class/PandocMonad.hs
+++ b/src/Text/Pandoc/Class/PandocMonad.hs
@@ -116,6 +116,9 @@ class (Functor m, Applicative m, Monad m, MonadError PandocError m)
   -- | Read the contents of stdin as a strict ByteString, raising
   -- an error on failure.
   readStdinStrict :: m B.ByteString
+  -- | Converts an SVG to a PNG (dpiX, widthPoints, heightPoints, svgBlob)
+  -- Not called when sandboxed.
+  svgToPng :: (Int, Maybe Double, Maybe Double, BL.ByteString) -> m (Either T.Text BL.ByteString)
   -- | Return a list of paths that match a glob, relative to
   -- the working directory.  See 'System.FilePath.Glob' for
   -- the glob syntax.
@@ -505,6 +508,7 @@ instance (MonadTrans t, PandocMonad m, Functor (t m),
   readFileLazy = lift . readFileLazy
   readFileStrict = lift . readFileStrict
   readStdinStrict = lift readStdinStrict
+  svgToPng = lift . svgToPng
   glob = lift . glob
   fileExists = lift . fileExists
   getDataFileName = lift . getDataFileName
@@ -523,6 +527,7 @@ instance {-# OVERLAPS #-} PandocMonad m => PandocMonad (ParsecT s st m) where
   readFileLazy = lift . readFileLazy
   readFileStrict = lift . readFileStrict
   readStdinStrict = lift readStdinStrict
+  svgToPng = lift . svgToPng
   glob = lift . glob
   fileExists = lift . fileExists
   getDataFileName = lift . getDataFileName
diff --git a/src/Text/Pandoc/Class/PandocPure.hs b/src/Text/Pandoc/Class/PandocPure.hs
index c86b20a05bcb..d138d49ff2e3 100644
--- a/src/Text/Pandoc/Class/PandocPure.hs
+++ b/src/Text/Pandoc/Class/PandocPure.hs
@@ -205,6 +205,8 @@ instance PandocMonad PandocPure where
       Nothing -> throwError $ PandocResourceNotFound $ T.pack fp
 
   readStdinStrict = getsPureState stStdin
+  
+  svgToPng _ = return $ Left "SVG conversion not available in PandocPure"
 
   glob s = do
     FileTree ftmap <- getsPureState stFiles
diff --git a/src/Text/Pandoc/Image.hs b/src/Text/Pandoc/Image.hs
index 5f95b19d970f..80c0bf56cfde 100644
--- a/src/Text/Pandoc/Image.hs
+++ b/src/Text/Pandoc/Image.hs
@@ -10,7 +10,7 @@ Portability : portable
 
 Functions for converting images.
 -}
-module Text.Pandoc.Image ( svgToPng ) where
+module Text.Pandoc.Image ( svgToPngIO ) where
 import Text.Pandoc.Process (pipeProcess)
 import qualified Data.ByteString.Lazy as L
 import System.Exit
@@ -20,16 +20,20 @@ import qualified Control.Exception as E
 import Control.Monad.IO.Class (MonadIO(liftIO))
 import Text.Pandoc.Class.PandocMonad
 import qualified Data.Text as T
+import Text.Printf (printf)
 
 -- | Convert svg image to png. rsvg-convert
 -- is used and must be available on the path.
-svgToPng :: (PandocMonad m, MonadIO m)
+svgToPngIO :: (PandocMonad m, MonadIO m)
          => Int           -- ^ DPI
+         -> Maybe Double        -- ^ width in Points
+         -> Maybe Double        -- ^ height in Points
          -> L.ByteString  -- ^ Input image as bytestring
          -> m (Either Text L.ByteString)
-svgToPng dpi bs = do
+svgToPngIO dpi widthPt heightPt bs = do
   let dpi' = show dpi
   let args = ["-f","png","-a","--dpi-x",dpi',"--dpi-y",dpi']
+        ++ pt "width" widthPt ++ pt "height" heightPt
   trace (T.intercalate " " $ map T.pack $ "rsvg-convert" : args)
   liftIO $ E.catch
        (do (exit, out) <- pipeProcess Nothing "rsvg-convert"
@@ -40,3 +44,4 @@ svgToPng dpi bs = do
               else Left "conversion from SVG failed")
        (\(e :: E.SomeException) -> return $ Left $
            "check that rsvg-convert is in path.\n" <> tshow e)
+  where pt name = maybe [] $ \points -> ["--" <> name, printf "%.6fpt" points]
\ No newline at end of file

From 0f45ea16ffee799e923643b2e6ac9f57511ea4d5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= <edwin@etorok.net>
Date: Wed, 27 Dec 2023 10:54:49 +0000
Subject: [PATCH 4/8] fix(docx): use proper DPI when creating fallback images
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Introduce getOrCreateFallback, and pass the desired size in points to
rsvg-convert.
Otherwise it'll guess the size based on the SVG's viewbox and completely
ignore the DPI argument.

Signed-off-by: Edwin Török <edwin@etorok.net>
---
 src/Text/Pandoc/App.hs          | 23 ++--------------------
 src/Text/Pandoc/Image.hs        | 19 ++++++++++++++++--
 src/Text/Pandoc/Writers/Docx.hs | 34 +++++++++++++++++++++++----------
 3 files changed, 43 insertions(+), 33 deletions(-)

diff --git a/src/Text/Pandoc/App.hs b/src/Text/Pandoc/App.hs
index d2d3c3a4a4f1..ac74bafa1682 100644
--- a/src/Text/Pandoc/App.hs
+++ b/src/Text/Pandoc/App.hs
@@ -28,7 +28,7 @@ module Text.Pandoc.App (
           , applyFilters
           ) where
 import qualified Control.Exception as E
-import Control.Monad ( (>=>), when, forM, forM_ )
+import Control.Monad ( (>=>), when, forM )
 import Control.Monad.Trans ( MonadIO(..) )
 import Control.Monad.Catch ( MonadMask )
 import Control.Monad.Except (throwError)
@@ -49,7 +49,6 @@ 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.App.Opt (Opt (..), LineEnding (..), defaultOpts,
                             IpynbOutput (..), OptInfo(..))
 import Text.Pandoc.App.CommandLineOptions (parseOptions, parseOptionsFromArgs,
@@ -64,7 +63,7 @@ import Text.Pandoc.PDF (makePDF)
 import Text.Pandoc.Scripting (ScriptingEngine (..), CustomComponents(..))
 import Text.Pandoc.SelfContained (makeSelfContained)
 import Text.Pandoc.Shared (eastAsianLineBreakFilter,
-         headerShift, filterIpynbOutput, tshow)
+         headerShift, filterIpynbOutput)
 import Text.Pandoc.URI (isURI)
 import Text.Pandoc.Writers.Shared (lookupMetaString)
 import Text.Pandoc.Readers.Markdown (yamlToMeta)
@@ -306,9 +305,6 @@ convertWithOpts' scriptingEngine istty datadir opts = do
             >=> maybe return extractMedia (optExtractMedia opts)
             )
 
-  when (format == "docx" && not (optSandbox opts)) $ do
-    createPngFallbacks (writerDpi writerOptions)
-
   output <- case writer of
     ByteStringWriter f
       | format == "chunkedhtml" -> ZipOutput <$> f writerOptions doc
@@ -371,21 +367,6 @@ readAbbreviations mbfilepath =
     >>= fmap (Set.fromList . filter (not . T.null) . T.lines) .
          toTextM (fromMaybe mempty mbfilepath)
 
-createPngFallbacks :: (PandocMonad m) => Int -> m ()
-createPngFallbacks dpi = 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 (dpi, Nothing, Nothing, 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 ()
-
 getMetadataFromFiles :: PandocMonad m
                      => Text -> ReaderOptions -> [FilePath] -> m Meta
 getMetadataFromFiles readerFormat readerOpts = \case
diff --git a/src/Text/Pandoc/Image.hs b/src/Text/Pandoc/Image.hs
index 80c0bf56cfde..f7e92d3cb516 100644
--- a/src/Text/Pandoc/Image.hs
+++ b/src/Text/Pandoc/Image.hs
@@ -10,7 +10,7 @@ Portability : portable
 
 Functions for converting images.
 -}
-module Text.Pandoc.Image ( svgToPngIO ) where
+module Text.Pandoc.Image ( createPngFallback, svgToPngIO ) where
 import Text.Pandoc.Process (pipeProcess)
 import qualified Data.ByteString.Lazy as L
 import System.Exit
@@ -20,6 +20,9 @@ import qualified Control.Exception as E
 import Control.Monad.IO.Class (MonadIO(liftIO))
 import Text.Pandoc.Class.PandocMonad
 import qualified Data.Text as T
+import Text.Pandoc.Logging (LogMessage(CouldNotConvertImage))
+import Data.ByteString.Lazy (ByteString)
+import Text.Pandoc.MediaBag (MediaItem, lookupMedia)
 import Text.Printf (printf)
 
 -- | Convert svg image to png. rsvg-convert
@@ -44,4 +47,16 @@ svgToPngIO dpi widthPt heightPt bs = do
               else Left "conversion from SVG failed")
        (\(e :: E.SomeException) -> return $ Left $
            "check that rsvg-convert is in path.\n" <> tshow e)
-  where pt name = maybe [] $ \points -> ["--" <> name, printf "%.6fpt" points]
\ No newline at end of file
+  where pt name = maybe [] $ \points -> ["--" <> name, printf "%.6fpt" points]
+
+createPngFallback :: (PandocMonad m) => Int -> (Double, Double) -> FilePath -> ByteString -> m (Maybe MediaItem)
+createPngFallback dpi (xPt, yPt) fp bs = do
+  -- create fallback pngs for svgs
+  res <- svgToPng (dpi, Just xPt, Just yPt, bs)
+  case res of
+    Right bs' -> do
+      insertMedia fp (Just "image/png") bs'
+      lookupMedia fp <$> getMediaBag
+    Left e -> do
+      report $ CouldNotConvertImage (T.pack fp) (tshow e)
+      return Nothing
diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs
index 4fc2ac6b4ff6..1465d5569dd9 100644
--- a/src/Text/Pandoc/Writers/Docx.hs
+++ b/src/Text/Pandoc/Writers/Docx.hs
@@ -77,6 +77,9 @@ import Text.Pandoc.Writers.OOXML
 import Text.Pandoc.XML.Light as XML
 import Data.Generics (mkT, everywhere)
 import Text.Collate.Lang (renderLang, Lang(..))
+import Text.Pandoc.Image (createPngFallback)
+import Data.ByteString (ByteString)
+import Text.Printf (printf)
 
 -- from wml.xsd EG_RPrBase
 rPrTagOrder :: M.Map Text Int
@@ -1321,6 +1324,15 @@ formattedRun els = do
   props <- getTextProps
   return [ mknode "w:r" [] $ props ++ els ]
 
+getOrCreateFallback :: PandocMonad m => Int -> (Integer, Integer) -> FilePath -> ByteString -> m (Maybe MediaItem)
+getOrCreateFallback dpi (xemu, yemu) src' img = do
+  mediabag <- getMediaBag
+  let src = printf "%s_%d_%d.png" src' xemu yemu
+  let xyPt = (fromIntegral xemu / 12700.0, fromIntegral yemu / 12700.0)
+  case lookupMedia src mediabag of
+    Just item -> return $ Just item
+    Nothing -> createPngFallback dpi xyPt src $ BL.fromStrict img
+
 -- | Convert an inline element to OpenXML.
 inlineToOpenXML :: PandocMonad m => WriterOptions -> Inline -> WS m [Content]
 inlineToOpenXML opts il = withDirection $ inlineToOpenXML' opts il
@@ -1522,17 +1534,26 @@ inlineToOpenXML' opts (Image attr@(imgident, _, _) alt (src, title)) = do
   imgs <- gets stImages
   let
     stImage = M.lookup (T.unpack src) imgs
-    generateImgElt (ident, _fp, mt, img) = do
+    generateImgElt (ident, fp, mt, img) = do
       docprid <- getUniqueId
       nvpicprid <- getUniqueId
+      let
+        (xpt,ypt) = desiredSizeInPoints opts attr
+               (either (const def) id (imageSize opts img))
+        -- 12700 emu = 1 pt
+        pageWidthPt = case dimension Width attr of
+                        Just (Percent a) -> pageWidth * floor (a * 127)
+                        _                -> pageWidth * 12700
+        (xemu,yemu) = fitToPage (xpt * 12700, ypt * 12700) pageWidthPt
       (blipAttrs, blipContents) <-
         case T.takeWhile (/=';') <$> mt of
           Just "image/svg+xml" -> do
             -- get fallback png
-            mediabag <- getMediaBag
+            fallback <- getOrCreateFallback (writerDpi opts) (xemu, yemu) fp img
             mbFallback <-
-              case lookupMedia (T.unpack (src <> ".png")) mediabag of
+              case fallback of
                 Just item -> do
+                  P.trace $ "Found fallback " <> tshow (mediaPath item)
                   id' <- T.unpack . ("rId" <>) <$> getUniqueId
                   let fp' = "media/" <> id' <> ".png"
                   let imgdata = (id',
@@ -1559,13 +1580,6 @@ inlineToOpenXML' opts (Image attr@(imgident, _, _) alt (src, title)) = do
                     [extLst])
           _ -> return ([("r:embed", T.pack ident)], [])
       let
-        (xpt,ypt) = desiredSizeInPoints opts attr
-               (either (const def) id (imageSize opts img))
-        -- 12700 emu = 1 pt
-        pageWidthPt = case dimension Width attr of
-                        Just (Percent a) -> pageWidth * floor (a * 127)
-                        _                -> pageWidth * 12700
-        (xemu,yemu) = fitToPage (xpt * 12700, ypt * 12700) pageWidthPt
         cNvPicPr = mknode "pic:cNvPicPr" [] $
                          mknode "a:picLocks" [("noChangeArrowheads","1")
                                              ,("noChangeAspect","1")] ()

From d56f9bb6bb569d2a72db1d5a280c2b47c44250dd Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= <edwin@etorok.net>
Date: Wed, 27 Dec 2023 16:32:49 +0000
Subject: [PATCH 5/8] test(docx): add PNG fallback generation test for SVG
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Just look at --trace output.
Can't use a golden test because the actual .png will be different
depending on rsvg-convert version.

Signed-off-by: Edwin Török <edwin@etorok.net>
---
 test/command/9288.md | 49 ++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 49 insertions(+)
 create mode 100644 test/command/9288.md

diff --git a/test/command/9288.md b/test/command/9288.md
new file mode 100644
index 000000000000..359367d04d91
--- /dev/null
+++ b/test/command/9288.md
@@ -0,0 +1,49 @@
+```
+% pandoc -f native -t docx -o 9288.docx  --trace --quiet
+[ Figure
+    ( "" , [] , [] )
+    (Caption Nothing [ Plain [ Str "5in" ] ])
+    [ Plain
+        [ Image
+            ( "" , [] , [ ( "width" , "5in" ) ] )
+            [ Str "5in" ]
+            ( "command/SVG_logo.svg" , "" )
+        ]
+    ]
+, Figure
+    ( "" , [] , [] )
+    (Caption Nothing [ Plain [ Str "5in" ] ])
+    [ Plain
+        [ Image
+            ( "" , [] , [ ( "width" , "5in" ) ] )
+            [ Str "5in" ]
+            ( "command/SVG_logo.svg" , "" )
+        ]
+    ]
+, Figure
+    ( "" , [] , [] )
+    (Caption Nothing [ Plain [ Str "80%" ] ])
+    [ Plain
+        [ Image
+            ( "" , [] , [ ( "width" , "80%" ) ] )
+            [ Str "5in" ]
+            ( "command/SVG_logo.svg" , "" )
+        ]
+    ]
+, Figure
+    ( "" , [] , [] )
+    (Caption Nothing [ Plain [ Str "default" ] ])
+    [ Plain
+        [ Image
+            ( "" , [] , [] )
+            [ Str "5in" ]
+            ( "command/SVG_logo.svg" , "" )
+        ]
+    ]
+]
+^D
+2> [trace] rsvg-convert -f png -a --dpi-x 96 --dpi-y 96 --width 360.000000pt --height 360.000000pt
+2> [trace] rsvg-convert -f png -a --dpi-x 96 --dpi-y 96 --width 360.000000pt --height 360.000000pt
+2> [trace] rsvg-convert -f png -a --dpi-x 96 --dpi-y 96 --width 75.000000pt --height 75.000000pt
+2> [trace] rsvg-convert -f png -a --dpi-x 96 --dpi-y 96 --width 75.000000pt --height 75.000000pt
+```

From 438a4516ff8cb398dede75fa009bf68ab6729577 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= <edwin@etorok.net>
Date: Wed, 27 Dec 2023 12:39:24 +0000
Subject: [PATCH 6/8] fix(docx): honour percentage widths for SVG images
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Signed-off-by: Edwin Török <edwin@etorok.net>
---
 src/Text/Pandoc/ImageSize.hs    | 10 +++++++---
 src/Text/Pandoc/Writers/Docx.hs |  4 ++--
 src/Text/Pandoc/Writers/ICML.hs |  2 +-
 src/Text/Pandoc/Writers/RTF.hs  |  2 +-
 test/command/9288.md            |  2 +-
 5 files changed, 12 insertions(+), 8 deletions(-)

diff --git a/src/Text/Pandoc/ImageSize.hs b/src/Text/Pandoc/ImageSize.hs
index 727be238c7e3..b633ecf60c9e 100644
--- a/src/Text/Pandoc/ImageSize.hs
+++ b/src/Text/Pandoc/ImageSize.hs
@@ -166,8 +166,8 @@ sizeInPoints s = (pxXf * 72 / dpiXf, pxYf * 72 / dpiYf)
 -- | Calculate (height, width) in points, considering the desired dimensions in the
 -- attribute, while falling back on the image file's dpi metadata if no dimensions
 -- are specified in the attribute (or only dimensions in percentages).
-desiredSizeInPoints :: WriterOptions -> Attr -> ImageSize -> (Double, Double)
-desiredSizeInPoints opts attr s =
+desiredSizeInPoints :: WriterOptions -> Attr -> Maybe Integer -> ImageSize -> (Double, Double)
+desiredSizeInPoints opts attr pageWidthPoints' s =
   case (getDim Width, getDim Height) of
     (Just w, Just h)   -> (w, h)
     (Just w, Nothing)  -> (w, w / ratio)
@@ -176,7 +176,11 @@ desiredSizeInPoints opts attr s =
   where
     ratio = fromIntegral (pxX s) / fromIntegral (pxY s)
     getDim dir = case dimension dir attr of
-                   Just (Percent _) -> Nothing
+                   Just (Percent a) ->
+                     case (dir, pageWidthPoints') of
+                     (Width, Just pageWidthPoints) ->
+                       Just $ fromIntegral pageWidthPoints * a
+                     _ -> Nothing
                    Just dim         -> Just $ inPoints opts dim
                    Nothing          -> Nothing
 
diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs
index 1465d5569dd9..de81d664f28a 100644
--- a/src/Text/Pandoc/Writers/Docx.hs
+++ b/src/Text/Pandoc/Writers/Docx.hs
@@ -1530,7 +1530,7 @@ inlineToOpenXML' opts (Link _ txt (src,_)) = do
               return i
   return [ Elem $ mknode "w:hyperlink" [("r:id",id')] contents ]
 inlineToOpenXML' opts (Image attr@(imgident, _, _) alt (src, title)) = do
-  pageWidth <- asks envPrintWidth
+  pageWidth <- asks envPrintWidth -- in Points
   imgs <- gets stImages
   let
     stImage = M.lookup (T.unpack src) imgs
@@ -1538,7 +1538,7 @@ inlineToOpenXML' opts (Image attr@(imgident, _, _) alt (src, title)) = do
       docprid <- getUniqueId
       nvpicprid <- getUniqueId
       let
-        (xpt,ypt) = desiredSizeInPoints opts attr
+        (xpt,ypt) = desiredSizeInPoints opts attr (Just pageWidth)
                (either (const def) id (imageSize opts img))
         -- 12700 emu = 1 pt
         pageWidthPt = case dimension Width attr of
diff --git a/src/Text/Pandoc/Writers/ICML.hs b/src/Text/Pandoc/Writers/ICML.hs
index a19121968b5d..7247d39b72b8 100644
--- a/src/Text/Pandoc/Writers/ICML.hs
+++ b/src/Text/Pandoc/Writers/ICML.hs
@@ -613,7 +613,7 @@ imageICML opts style attr (src, _) = do
                report $ CouldNotFetchResource src $ tshow e
                return def)
   let (ow, oh) = sizeInPoints imgS
-      (imgWidth, imgHeight) = desiredSizeInPoints opts attr imgS
+      (imgWidth, imgHeight) = desiredSizeInPoints opts attr Nothing imgS
       hw = showFl $ ow / 2
       hh = showFl $ oh / 2
       scale = showFl (imgWidth / ow) <> " 0 0 " <> showFl (imgHeight / oh)
diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs
index 0b1d36edaa05..ecd41459694a 100644
--- a/src/Text/Pandoc/Writers/RTF.hs
+++ b/src/Text/Pandoc/Writers/RTF.hs
@@ -64,7 +64,7 @@ rtfEmbedImage opts x@(Image attr _ (src,_)) = catchError
                                 <> "\\pichgoal" <> tshow (floor (ypt * 20) :: Integer)
                         -- twip = 1/1440in = 1/20pt
                         where (xpx, ypx) = sizeInPixels sz
-                              (xpt, ypt) = desiredSizeInPoints opts attr sz
+                              (xpt, ypt) = desiredSizeInPoints opts attr Nothing sz
              let raw = "{\\pict" <> filetype <> sizeSpec <> " " <>
                         T.concat bytes <> "}"
              if B.null imgdata
diff --git a/test/command/9288.md b/test/command/9288.md
index 359367d04d91..6673d40bbc81 100644
--- a/test/command/9288.md
+++ b/test/command/9288.md
@@ -44,6 +44,6 @@
 ^D
 2> [trace] rsvg-convert -f png -a --dpi-x 96 --dpi-y 96 --width 360.000000pt --height 360.000000pt
 2> [trace] rsvg-convert -f png -a --dpi-x 96 --dpi-y 96 --width 360.000000pt --height 360.000000pt
-2> [trace] rsvg-convert -f png -a --dpi-x 96 --dpi-y 96 --width 75.000000pt --height 75.000000pt
+2> [trace] rsvg-convert -f png -a --dpi-x 96 --dpi-y 96 --width 336.000000pt --height 336.000000pt
 2> [trace] rsvg-convert -f png -a --dpi-x 96 --dpi-y 96 --width 75.000000pt --height 75.000000pt
 ```

From 39cc916df5e36586ccb3f7a2c9f11b8d526c7237 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= <edwin@etorok.net>
Date: Wed, 27 Dec 2023 20:04:21 +0000
Subject: [PATCH 7/8] fixup! refactor(svgToPng): introduce PandocMonad.svgToPng

---
 src/Text/Pandoc/Class/IO.hs          | 4 ++--
 src/Text/Pandoc/Class/PandocMonad.hs | 6 +++---
 src/Text/Pandoc/Class/PandocPure.hs  | 2 +-
 3 files changed, 6 insertions(+), 6 deletions(-)

diff --git a/src/Text/Pandoc/Class/IO.hs b/src/Text/Pandoc/Class/IO.hs
index d62748a3d6b3..531b16b47eca 100644
--- a/src/Text/Pandoc/Class/IO.hs
+++ b/src/Text/Pandoc/Class/IO.hs
@@ -174,8 +174,8 @@ readStdinStrict = liftIOError (const B.getContents) "stdin"
 
 -- | Runs an image conversion step, returning an error on failure.
 -- Not available when sandboxed.
-svgToPng :: (PandocMonad m, MonadIO m) => (Int, Maybe Double, Maybe Double, BL.ByteString) -> m (Either T.Text BL.ByteString)
-svgToPng (dpi, xPt, yPt, bs) = svgToPngIO dpi xPt yPt bs
+svgToPng :: (PandocMonad m, MonadIO m) => Int -> Maybe Double -> Maybe Double -> BL.ByteString -> m (Either T.Text BL.ByteString)
+svgToPng = svgToPngIO
 
 -- | Return a list of paths that match a glob, relative to the working
 -- directory. See 'System.FilePath.Glob' for the glob syntax.
diff --git a/src/Text/Pandoc/Class/PandocMonad.hs b/src/Text/Pandoc/Class/PandocMonad.hs
index e1cc3e44afe4..81eaafb28dfa 100644
--- a/src/Text/Pandoc/Class/PandocMonad.hs
+++ b/src/Text/Pandoc/Class/PandocMonad.hs
@@ -118,7 +118,7 @@ class (Functor m, Applicative m, Monad m, MonadError PandocError m)
   readStdinStrict :: m B.ByteString
   -- | Converts an SVG to a PNG (dpiX, widthPoints, heightPoints, svgBlob)
   -- Not called when sandboxed.
-  svgToPng :: (Int, Maybe Double, Maybe Double, BL.ByteString) -> m (Either T.Text BL.ByteString)
+  svgToPng :: Int -> Maybe Double -> Maybe Double -> BL.ByteString -> m (Either T.Text BL.ByteString)
   -- | Return a list of paths that match a glob, relative to
   -- the working directory.  See 'System.FilePath.Glob' for
   -- the glob syntax.
@@ -508,7 +508,7 @@ instance (MonadTrans t, PandocMonad m, Functor (t m),
   readFileLazy = lift . readFileLazy
   readFileStrict = lift . readFileStrict
   readStdinStrict = lift readStdinStrict
-  svgToPng = lift . svgToPng
+  svgToPng dpi width height bs = lift $ svgToPng dpi width height bs
   glob = lift . glob
   fileExists = lift . fileExists
   getDataFileName = lift . getDataFileName
@@ -527,7 +527,7 @@ instance {-# OVERLAPS #-} PandocMonad m => PandocMonad (ParsecT s st m) where
   readFileLazy = lift . readFileLazy
   readFileStrict = lift . readFileStrict
   readStdinStrict = lift readStdinStrict
-  svgToPng = lift . svgToPng
+  svgToPng dpi width height bs = lift $ svgToPng dpi width height bs
   glob = lift . glob
   fileExists = lift . fileExists
   getDataFileName = lift . getDataFileName
diff --git a/src/Text/Pandoc/Class/PandocPure.hs b/src/Text/Pandoc/Class/PandocPure.hs
index d138d49ff2e3..c578d6d058ef 100644
--- a/src/Text/Pandoc/Class/PandocPure.hs
+++ b/src/Text/Pandoc/Class/PandocPure.hs
@@ -206,7 +206,7 @@ instance PandocMonad PandocPure where
 
   readStdinStrict = getsPureState stStdin
   
-  svgToPng _ = return $ Left "SVG conversion not available in PandocPure"
+  svgToPng _ _ _ _ = return $ Left "SVG conversion not available in PandocPure"
 
   glob s = do
     FileTree ftmap <- getsPureState stFiles

From 1e2dbf94d03e148f3a670f93bcc9d8641fd62cc8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= <edwin@etorok.net>
Date: Wed, 27 Dec 2023 20:04:21 +0000
Subject: [PATCH 8/8] fixup! fix(docx): use proper DPI when creating fallback
 images

---
 src/Text/Pandoc/Image.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Text/Pandoc/Image.hs b/src/Text/Pandoc/Image.hs
index f7e92d3cb516..a9c735bf4e3c 100644
--- a/src/Text/Pandoc/Image.hs
+++ b/src/Text/Pandoc/Image.hs
@@ -52,7 +52,7 @@ svgToPngIO dpi widthPt heightPt bs = do
 createPngFallback :: (PandocMonad m) => Int -> (Double, Double) -> FilePath -> ByteString -> m (Maybe MediaItem)
 createPngFallback dpi (xPt, yPt) fp bs = do
   -- create fallback pngs for svgs
-  res <- svgToPng (dpi, Just xPt, Just yPt, bs)
+  res <- svgToPng dpi (Just xPt) (Just yPt) bs
   case res of
     Right bs' -> do
       insertMedia fp (Just "image/png") bs'