From 163be37dd63517dbe0f474b1051a93858e915d31 Mon Sep 17 00:00:00 2001
From: Tomas Dahlqvist <tomas.dahlqvist@gmail.com>
Date: Thu, 1 Feb 2024 19:37:12 +0100
Subject: Using internal column widths in pptx writer tables (#9392)

The table writer used to only divide all available width evenly
for all columns. In this update the code uses the incoming widths
if they are available. If they are not set the earlier even
distribution is used. Some of the golden templates are adjusted
slightly because of different rounding when using the new
calculation model.

Closes #5706
---
 src/Text/Pandoc/Writers/Powerpoint/Output.hs       | 24 +++++++++++-----------
 src/Text/Pandoc/Writers/Powerpoint/Presentation.hs |  6 +++---
 2 files changed, 15 insertions(+), 15 deletions(-)

(limited to 'src/Text')

diff --git a/src/Text/Pandoc/Writers/Powerpoint/Output.hs b/src/Text/Pandoc/Writers/Powerpoint/Output.hs
index 0f06dee0d..63e145cee 100644
--- a/src/Text/Pandoc/Writers/Powerpoint/Output.hs
+++ b/src/Text/Pandoc/Writers/Powerpoint/Output.hs
@@ -1411,19 +1411,19 @@ getDefaultTableStyle = do
   return $ findAttr (QName "def" Nothing Nothing) tblStyleLst
 
 graphicToElement :: PandocMonad m => Integer -> Graphic -> P m Element
-graphicToElement tableWidth (Tbl tblPr hdrCells rows) = do
-  let colWidths = if null hdrCells
-                  then case rows of
-                         r : _ | not (null r) -> replicate (length r) $
+graphicToElement tableWidth (Tbl widths tblPr hdrCells rows) = do
+  let totalWidth = sum widths
+  let colWidths = if any (== 0.0) widths
+                  then if null hdrCells
+                      then case rows of
+                         r@(_:_) : _ -> replicate (length r) $
                                                  tableWidth `div` toInteger (length r)
-                         -- satisfy the compiler. This is the same as
-                         -- saying that rows is empty, but the compiler
-                         -- won't understand that `[]` exhausts the
-                         -- alternatives.
-                         _ -> []
-                  else replicate (length hdrCells) $
-                       tableWidth `div` toInteger (length hdrCells)
-
+                         []: _ -> []
+                         [] -> []
+                      else replicate (length hdrCells) $
+                           tableWidth `div` toInteger (length hdrCells)
+                  else map (\w -> round $ w / totalWidth * fromIntegral tableWidth) widths
+  
   let cellToOpenXML paras =
         do elements <- mapM paragraphToElement paras
            let elements' = if null elements
diff --git a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
index dc1d54637..f3f00da50 100644
--- a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
+++ b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
@@ -244,7 +244,7 @@ data TableProps = TableProps { tblPrFirstRow :: Bool
                              , tblPrBandRow :: Bool
                              } deriving (Show, Eq)
 
-data Graphic = Tbl TableProps [TableCell] [[TableCell]]
+data Graphic = Tbl [Double] TableProps [TableCell] [[TableCell]]
   deriving (Show, Eq)
 
 
@@ -601,7 +601,7 @@ blockToShape (Para (il:_))  | Link _ (il':_) target <- il
       <$> inlinesToParElems ils
 blockToShape (Figure _figattr _caption [b]) = blockToShape b
 blockToShape (Table _ blkCapt specs thead tbody tfoot) = do
-  let (caption, algn, _, hdrCells, rows) = toLegacyTable blkCapt specs thead tbody tfoot
+  let (caption, algn, widths, hdrCells, rows) = toLegacyTable blkCapt specs thead tbody tfoot
   caption' <- inlinesToParElems caption
   hdrCells' <- rowToParagraphs algn hdrCells
   rows' <- mapM (rowToParagraphs algn) rows
@@ -613,7 +613,7 @@ blockToShape (Table _ blkCapt specs thead tbody tfoot) = do
                               , tblPrBandRow = True
                               }
 
-  return $ GraphicFrame [Tbl tblPr hdrCells' rows'] caption'
+  return $ GraphicFrame [Tbl widths tblPr hdrCells' rows'] caption'
 -- If the format isn't openxml, we fall through to blockToPargraphs
 blockToShape (RawBlock (Format "openxml") str) = return $ RawOOXMLShape str
 blockToShape blk = do paras <- blockToParagraphs blk
-- 
cgit v1.2.3