@@ -14,65 +14,39 @@ module Text.Pandoc.Writers.Docx.Table
16import Control.Monad.State.Strict
16import Control.Monad.State.Strict
17import Data.Text (Text)
18import Data.Text (Text)
18import Text.Pandoc.Definition
19import Text.Pandoc.Definition
19import Text.Pandoc.Class.PandocMonad (PandocMonad)
20import Text.Pandoc.Class.PandocMonad (PandocMonad)
20import Text.Pandoc.Writers.Docx.Types
21import Text.Pandoc.Writers.Docx.Types
21import Text.Pandoc.Shared
22import Text.Pandoc.Shared
22−import Text.Pandoc.Writers.Shared
23import Text.Printf (printf)
23import Text.Printf (printf)
24+import Text.Pandoc.Writers.GridTable hiding (Table)
24import Text.Pandoc.Writers.OOXML
25import Text.Pandoc.Writers.OOXML
25−import Text.Pandoc.XML.Light as XML
26+import Text.Pandoc.XML.Light as XML hiding (Attr)
26import qualified Data.Text as T
27import qualified Data.Text as T
28+import qualified Text.Pandoc.Writers.GridTable as Grid
28tableToOpenXML :: PandocMonad m
30tableToOpenXML :: PandocMonad m
29 => ([Block] -> WS m [Content])
31 => ([Block] -> WS m [Content])
30− -> Caption
32+ -> Grid.Table
35 -> WS m [Content]
33 -> WS m [Content]
36−tableToOpenXML blocksToOpenXML blkCapt specs thead tbody tfoot = do
34+tableToOpenXML blocksToOpenXML gridTable = do
37− let (caption, aligns, widths, headers, rows) =
38− toLegacyTable blkCapt specs thead tbody tfoot
39 setFirstPara
35 setFirstPara
40 modify $ \s -> s { stInTable = True }
36 modify $ \s -> s { stInTable = True }
37+ let (Grid.Table _attr caption colspecs _rowheads thead tbodies tfoot) =
39+ let (Caption _maybeShortCaption captionBlocks) = caption
41− let captionStr = stringify caption
40+ let captionStr = stringify captionBlocks
42− caption' <- if null caption
41+ captionXml <- if null captionBlocks
43− then return []
42+ then return []
44− else withParaPropM (pStyleM "Table Caption")
43+ else withParaPropM (pStyleM "Table Caption")
45− $ blocksToOpenXML [Para caption]
44+ $ blocksToOpenXML captionBlocks
46− let alignmentFor al = mknode "w:jc" [("w:val",alignmentToString al)] ()
45+ head' <- cellGridToOpenXML blocksToOpenXML thead
47− -- Table cells require a <w:p> element, even an empty one!
46+ bodies <- mapM (cellGridToOpenXML blocksToOpenXML) tbodies
48− -- Not in the spec but in Word 2007, 2010. See #4953. And
47+ foot' <- cellGridToOpenXML blocksToOpenXML tfoot
49− -- apparently the last element must be a <w:p>, see #6983.
48+
50− let cellToOpenXML (al, cell) = do
51− es <- withParaProp (alignmentFor al) $ blocksToOpenXML cell
53− case reverse (onlyElems es) of
54− b:e:_ | qName (elName b) == "bookmarkEnd"
55− , qName (elName e) == "p" -> es
56− e:_ | qName (elName e) == "p" -> es
57− _ -> es ++ [Elem $ mknode "w:p" [] ()]
58− headers' <- mapM cellToOpenXML $ zip aligns headers
59− rows' <- mapM (mapM cellToOpenXML . zip aligns) rows
60− compactStyle <- pStyleM "Compact"
61− let emptyCell' = [Elem $ mknode "w:p" [] [mknode "w:pPr" [] [compactStyle]]]
62− let mkcell contents = mknode "w:tc" []
69− let textwidth = 7920 -- 5.5 in in twips, 1/20 pt
70− let fullrow = 5000 -- 100% specified in pct
71− let (rowwidth :: Int) = round $ fullrow * sum widths
72− let mkgridcol w = mknode "w:gridCol"
73− [("w:w", tshow (floor (textwidth * w) :: Integer))] ()
74− let hasHeader = not $ all null headers
49+ let hasHeader = not . null . indices . partRowAttrs $ thead
75− modify $ \s -> s { stInTable = False }
76 -- for compatibility with Word <= 2007, we include a val with a bitmask
50 -- for compatibility with Word <= 2007, we include a val with a bitmask
77 -- 0×0020 Apply first row conditional formatting
51 -- 0×0020 Apply first row conditional formatting
78 -- 0×0040 Apply last row conditional formatting
52 -- 0×0040 Apply last row conditional formatting
@@ -80,18 +54,12 @@ tableToOpenXML blocksToOpenXML blkCapt specs thead tbody tfoot = do
80 -- 0×0100 Apply last column conditional formatting
54 -- 0×0100 Apply last column conditional formatting
81 -- 0×0200 Do not apply row banding conditional formatting
55 -- 0×0200 Do not apply row banding conditional formatting
82 -- 0×0400 Do not apply column banding conditional formattin
56 -- 0×0400 Do not apply column banding conditional formattin
83− let tblLookVal :: Int
84− tblLookVal = if hasHeader then 0x20 else 0
57+ let tblLookVal = if hasHeader then (0x20 :: Int) else 0
85− return $
58+ let (gridCols, tblWattr) = tableLayout (elems colspecs)
88− mknode "w:tbl" []
59+ let tbl = mknode "w:tbl" []
89− ( mknode "w:tblPr" []
60+ ( mknode "w:tblPr" []
90− ( mknode "w:tblStyle" [("w:val","Table")] () :
61+ ( mknode "w:tblStyle" [("w:val","Table")] () :
91− mknode "w:tblW" (if all (== 0) widths
62+ mknode "w:tblW" tblWattr () :
92− then [("w:type", "auto"), ("w:w", "0")]
93− else [("w:type", "pct"), ("w:w", tshow rowwidth)])
95 mknode "w:tblLook" [("w:firstRow",if hasHeader then "1" else "0")
63 mknode "w:tblLook" [("w:firstRow",if hasHeader then "1" else "0")
96 ,("w:lastRow","0")
64 ,("w:lastRow","0")
97 ,("w:firstColumn","0")
65 ,("w:firstColumn","0")
@@ -100,15 +68,14 @@ tableToOpenXML blocksToOpenXML blkCapt specs thead tbody tfoot = do
100 ,("w:noVBand","0")
68 ,("w:noVBand","0")
101 ,("w:val", T.pack $ printf "%04x" tblLookVal)
69 ,("w:val", T.pack $ printf "%04x" tblLookVal)
103− [ mknode "w:tblCaption" [("w:val", captionStr)] ()
71+ [ mknode "w:tblCaption" [("w:val", captionStr)] ()
104− | not (null caption) ] )
72+ | not (T.null captionStr) ]
105− : mknode "w:tblGrid" []
74+ : mknode "w:tblGrid" [] gridCols
106− (if all (==0) widths
75+ : head' ++ mconcat bodies ++ foot'
108− else map mkgridcol widths)
77+ modify $ \s -> s { stInTable = False }
109− : [ mkrow headers' | hasHeader ] ++
78+ return $ captionXml ++ [Elem tbl]
113alignmentToString :: Alignment -> Text
80alignmentToString :: Alignment -> Text
114alignmentToString = \case
81alignmentToString = \case
@@ -116,3 +83,104 @@ alignmentToString = \case
116 AlignRight -> "right"
83 AlignRight -> "right"
117 AlignCenter -> "center"
84 AlignCenter -> "center"
118 AlignDefault -> "left"
85 AlignDefault -> "left"
87+tableLayout :: [ColSpec] -> ([Element], [(Text, Text)])
90+ textwidth = 7920 -- 5.5 in in twips (1 twip == 1/20 pt)
91+ fullrow = 5000 -- 100% specified in pct (1 pct == 1/50th of a percent)
96+ widths = map (getWidth . snd) specs
97+ rowwidth = round (fullrow * sum widths) :: Int
98+ widthToTwips w = floor (textwidth * w) :: Int
99+ mkGridCol w = mknode "w:gridCol" [("w:w", tshow (widthToTwips w))] ()
100+ in if all (== 0) widths
101+ then ( replicate ncols $ mkGridCol (1.0 / fromIntegral ncols)
102+ , [ ("w:type", "auto"), ("w:w", "0")])
103+ else ( map mkGridCol widths
104+ , [ ("w:type", "pct"), ("w:w", tshow rowwidth) ])
106+cellGridToOpenXML :: PandocMonad m
107+ => ([Block] -> WS m [Content])
110+cellGridToOpenXML blocksToOpenXML part@(Part _ _ rowAttrs) =
111+ if null (indices rowAttrs)
113+ else mapM (rowToOpenXML blocksToOpenXML) $ partToRows part
116+ = OOXMLCell Attr Alignment RowSpan ColSpan [Block]
117+ | OOXMLCellMerge ColSpan
119+data OOXMLRow = OOXMLRow Attr [OOXMLCell]
121+partToRows :: Part -> [OOXMLRow]
124+ toOOXMLCell :: RowIndex -> ColIndex -> GridCell -> [OOXMLCell]
125+ toOOXMLCell ridx cidx = \case
126+ ContentCell attr align rowspan colspan blocks ->
127+ [OOXMLCell attr align rowspan colspan blocks]
128+ ContinuationCell idx'@(ridx',cidx') | ridx /= ridx', cidx == cidx' ->
129+ case (partCellArray part)!idx' of
130+ (ContentCell _ _ _ colspan _) -> [OOXMLCellMerge colspan]
131+ x -> error $ "Content cell expected, got, " ++ show x ++
132+ " at index " ++ show idx'
134+ mkRow :: (RowIndex, Attr) -> OOXMLRow
135+ mkRow (ridx, attr) = OOXMLRow attr
136+ . concatMap (uncurry $ toOOXMLCell ridx)
139+ $ partCellArray part
140+ in map mkRow $ assocs (partRowAttrs part)
142+rowToOpenXML :: PandocMonad m
143+ => ([Block] -> WS m [Content])
146+rowToOpenXML blocksToOpenXML (OOXMLRow _attr cells) = do
147+ xmlcells <- mapM (ooxmlCellToOpenXML blocksToOpenXML) cells
148+ -- let align' = case align of
149+ -- AlignDefault -> colAlign
151+ return $ mknode "w:tr" [] xmlcells
153+ooxmlCellToOpenXML :: PandocMonad m
154+ => ([Block] -> WS m [Content])
157+ooxmlCellToOpenXML blocksToOpenXML = \case
158+ OOXMLCellMerge (ColSpan colspan) -> do
159+ return $ mknode "w:tc" []
160+ [ mknode "w:tcPr" [] [ mknode "w:gridSpan" [("w:val", tshow colspan)] ()
161+ , mknode "w:vMerge" [("w:val", "continue")] () ]
162+ , mknode "w:p" [] [mknode "w:pPr" [] ()]]
163+ OOXMLCell _attr align rowspan (ColSpan colspan) contents -> do
164+ -- we handle rowspans via 'leftpad', so we can ignore those here
166+ compactStyle <- pStyleM "Compact"
167+ es <- withParaProp (alignmentFor align) $ blocksToOpenXML contents
168+ -- Table cells require a <w:p> element, even an empty one!
169+ -- Not in the spec but in Word 2007, 2010. See #4953. And
170+ -- apparently the last element must be a <w:p>, see #6983.
171+ return . mknode "w:tc" [] $
173+ (mknode "w:tcPr" [] ([ mknode "w:gridSpan" [("w:val", tshow colspan)] ()
175+ [ mknode "w:vMerge" [("w:val", "restart")] ()
176+ | rowspan > RowSpan 1 ])) :
178+ then [Elem $ mknode "w:p" [] [mknode "w:pPr" [] [compactStyle]]]
179+ else case reverse (onlyElems es) of
180+ b:e:_ | qName (elName b) == "bookmarkEnd" -- y tho?
181+ , qName (elName e) == "p" -> es
182+ e:_ | qName (elName e) == "p" -> es
183+ _ -> es ++ [Elem $ mknode "w:p" [] ()]
185+alignmentFor :: Alignment -> Element
186+alignmentFor al = mknode "w:jc" [("w:val",alignmentToString al)] ()