@@ -14,65 +14,39 @@ module Text.Pandoc.Writers.Docx.Table
1414 ) where
1515
1616import Control.Monad.State.Strict
17+import Data.Array
1718import Data.Text (Text)
1819import Text.Pandoc.Definition
1920import Text.Pandoc.Class.PandocMonad (PandocMonad)
2021import Text.Pandoc.Writers.Docx.Types
2122import Text.Pandoc.Shared
22−import Text.Pandoc.Writers.Shared
2323import Text.Printf (printf)
24+import Text.Pandoc.Writers.GridTable hiding (Table)
2425import Text.Pandoc.Writers.OOXML
25−import Text.Pandoc.XML.Light as XML
26+import Text.Pandoc.XML.Light as XML hiding (Attr)
2627import qualified Data.Text as T
28+import qualified Text.Pandoc.Writers.GridTable as Grid
2729
2830tableToOpenXML :: PandocMonad m
2931 => ([Block] -> WS m [Content])
30− -> Caption
31− -> [ColSpec]
32− -> TableHead
33− -> [TableBody]
34− -> TableFoot
32+ -> Grid.Table
3533 -> WS m [Content]
36−tableToOpenXML blocksToOpenXML blkCapt specs thead tbody tfoot = do
37− let (caption, aligns, widths, headers, rows) =
38− toLegacyTable blkCapt specs thead tbody tfoot
34+tableToOpenXML blocksToOpenXML gridTable = do
3935 setFirstPara
4036 modify $ \s -> s { stInTable = True }
41− let captionStr = stringify caption
42− caption' <- if null caption
43− then return []
44− else withParaPropM (pStyleM "Table Caption")
45− $ blocksToOpenXML [Para caption]
46− let alignmentFor al = mknode "w:jc" [("w:val",alignmentToString al)] ()
47− -- Table cells require a <w:p> element, even an empty one!
48− -- Not in the spec but in Word 2007, 2010. See #4953. And
49− -- apparently the last element must be a <w:p>, see #6983.
50− let cellToOpenXML (al, cell) = do
51− es <- withParaProp (alignmentFor al) $ blocksToOpenXML cell
52− return $
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" []
63− $ if null contents
64− then emptyCell'
65− else contents
66− let mkrow cells =
67− mknode "w:tr" [] $
68− map mkcell cells
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
75− modify $ \s -> s { stInTable = False }
37+ let (Grid.Table _attr caption colspecs _rowheads thead tbodies tfoot) =
38+ gridTable
39+ let (Caption _maybeShortCaption captionBlocks) = caption
40+ let captionStr = stringify captionBlocks
41+ captionXml <- if null captionBlocks
42+ then return []
43+ else withParaPropM (pStyleM "Table Caption")
44+ $ blocksToOpenXML captionBlocks
45+ head' <- cellGridToOpenXML blocksToOpenXML thead
46+ bodies <- mapM (cellGridToOpenXML blocksToOpenXML) tbodies
47+ foot' <- cellGridToOpenXML blocksToOpenXML tfoot
48+
49+ let hasHeader = not . null . indices . partRowAttrs $ thead
7650 -- for compatibility with Word <= 2007, we include a val with a bitmask
7751 -- 0×0020 Apply first row conditional formatting
7852 -- 0×0040 Apply last row conditional formatting
@@ -80,18 +54,12 @@ tableToOpenXML blocksToOpenXML blkCapt specs thead tbody tfoot = do
8054 -- 0×0100 Apply last column conditional formatting
8155 -- 0×0200 Do not apply row banding conditional formatting
8256 -- 0×0400 Do not apply column banding conditional formattin
83− let tblLookVal :: Int
84− tblLookVal = if hasHeader then 0x20 else 0
85− return $
86− caption' ++
87− [Elem $
88− mknode "w:tbl" []
89− ( mknode "w:tblPr" []
90− ( mknode "w:tblStyle" [("w:val","Table")] () :
91− mknode "w:tblW" (if all (== 0) widths
92− then [("w:type", "auto"), ("w:w", "0")]
93− else [("w:type", "pct"), ("w:w", tshow rowwidth)])
94− () :
57+ let tblLookVal = if hasHeader then (0x20 :: Int) else 0
58+ let (gridCols, tblWattr) = tableLayout (elems colspecs)
59+ let tbl = mknode "w:tbl" []
60+ ( mknode "w:tblPr" []
61+ ( mknode "w:tblStyle" [("w:val","Table")] () :
62+ mknode "w:tblW" tblWattr () :
9563 mknode "w:tblLook" [("w:firstRow",if hasHeader then "1" else "0")
9664 ,("w:lastRow","0")
9765 ,("w:firstColumn","0")
@@ -100,15 +68,14 @@ tableToOpenXML blocksToOpenXML blkCapt specs thead tbody tfoot = do
10068 ,("w:noVBand","0")
10169 ,("w:val", T.pack $ printf "%04x" tblLookVal)
10270 ] () :
103− [ mknode "w:tblCaption" [("w:val", captionStr)] ()
104− | not (null caption) ] )
105− : mknode "w:tblGrid" []
106− (if all (==0) widths
107− then []
108− else map mkgridcol widths)
109− : [ mkrow headers' | hasHeader ] ++
110− map mkrow rows'
111− )]
71+ [ mknode "w:tblCaption" [("w:val", captionStr)] ()
72+ | not (T.null captionStr) ]
73+ )
74+ : mknode "w:tblGrid" [] gridCols
75+ : head' ++ mconcat bodies ++ foot'
76+ )
77+ modify $ \s -> s { stInTable = False }
78+ return $ captionXml ++ [Elem tbl]
11279
11380alignmentToString :: Alignment -> Text
11481alignmentToString = \case
@@ -116,3 +83,104 @@ alignmentToString = \case
11683 AlignRight -> "right"
11784 AlignCenter -> "center"
11885 AlignDefault -> "left"
86+
87+tableLayout :: [ColSpec] -> ([Element], [(Text, Text)])
88+tableLayout specs =
89+ let
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)
92+ ncols = length specs
93+ getWidth = \case
94+ ColWidth n -> n
95+ _ -> 0
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) ])
105+
106+cellGridToOpenXML :: PandocMonad m
107+ => ([Block] -> WS m [Content])
108+ -> Part
109+ -> WS m [Element]
110+cellGridToOpenXML blocksToOpenXML part@(Part _ _ rowAttrs) =
111+ if null (indices rowAttrs)
112+ then return mempty
113+ else mapM (rowToOpenXML blocksToOpenXML) $ partToRows part
114+
115+data OOXMLCell
116+ = OOXMLCell Attr Alignment RowSpan ColSpan [Block]
117+ | OOXMLCellMerge ColSpan
118+
119+data OOXMLRow = OOXMLRow Attr [OOXMLCell]
120+
121+partToRows :: Part -> [OOXMLRow]
122+partToRows part =
123+ let
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'
133+ _ -> mempty
134+ mkRow :: (RowIndex, Attr) -> OOXMLRow
135+ mkRow (ridx, attr) = OOXMLRow attr
136+ . concatMap (uncurry $ toOOXMLCell ridx)
137+ . assocs
138+ . rowArray ridx
139+ $ partCellArray part
140+ in map mkRow $ assocs (partRowAttrs part)
141+
142+rowToOpenXML :: PandocMonad m
143+ => ([Block] -> WS m [Content])
144+ -> OOXMLRow
145+ -> WS m Element
146+rowToOpenXML blocksToOpenXML (OOXMLRow _attr cells) = do
147+ xmlcells <- mapM (ooxmlCellToOpenXML blocksToOpenXML) cells
148+ -- let align' = case align of
149+ -- AlignDefault -> colAlign
150+ -- _ -> align
151+ return $ mknode "w:tr" [] xmlcells
152+
153+ooxmlCellToOpenXML :: PandocMonad m
154+ => ([Block] -> WS m [Content])
155+ -> OOXMLCell
156+ -> WS m Element
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
165+
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" [] $
172+ Elem
173+ (mknode "w:tcPr" [] ([ mknode "w:gridSpan" [("w:val", tshow colspan)] ()
174+ | colspan > 1] ++
175+ [ mknode "w:vMerge" [("w:val", "restart")] ()
176+ | rowspan > RowSpan 1 ])) :
177+ if null contents
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" [] ()]
184+
185+alignmentFor :: Alignment -> Element
186+alignmentFor al = mknode "w:jc" [("w:val",alignmentToString al)] ()