1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
|
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{- |
Module : Text.Pandoc.Writers.Docx
Copyright : Copyright (C) 2012-2021 John MacFarlane
License : GNU GPL, version 2 or above
Maintainer : John MacFarlane <jgm@berkeley.edu>
Conversion of table blocks to docx.
-}
module Text.Pandoc.Writers.Docx.Table
( tableToOpenXML
) where
import Control.Monad.State.Strict
import Data.Text (Text)
import Text.Pandoc.Definition
import Text.Pandoc.Class.PandocMonad (PandocMonad)
import Text.Pandoc.Writers.Docx.Types
import Text.Pandoc.Shared
import Text.Pandoc.Writers.Shared
import Text.Printf (printf)
import Text.Pandoc.Writers.OOXML
import Text.Pandoc.XML.Light as XML
import qualified Data.Text as T
tableToOpenXML :: PandocMonad m
=> ([Block] -> WS m [Content])
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> WS m [Content]
tableToOpenXML blocksToOpenXML blkCapt specs thead tbody tfoot = do
let (caption, aligns, widths, headers, rows) =
toLegacyTable blkCapt specs thead tbody tfoot
setFirstPara
modify $ \s -> s { stInTable = True }
let captionStr = stringify caption
caption' <- if null caption
then return []
else withParaPropM (pStyleM "Table Caption")
$ blocksToOpenXML [Para caption]
let alignmentFor al = mknode "w:jc" [("w:val",alignmentToString al)] ()
-- Table cells require a <w:p> element, even an empty one!
-- Not in the spec but in Word 2007, 2010. See #4953. And
-- apparently the last element must be a <w:p>, see #6983.
let cellToOpenXML (al, cell) = do
es <- withParaProp (alignmentFor al) $ blocksToOpenXML cell
return $
case reverse (onlyElems es) of
b:e:_ | qName (elName b) == "bookmarkEnd"
, qName (elName e) == "p" -> es
e:_ | qName (elName e) == "p" -> es
_ -> es ++ [Elem $ mknode "w:p" [] ()]
headers' <- mapM cellToOpenXML $ zip aligns headers
rows' <- mapM (mapM cellToOpenXML . zip aligns) rows
compactStyle <- pStyleM "Compact"
let emptyCell' = [Elem $ mknode "w:p" [] [mknode "w:pPr" [] [compactStyle]]]
let mkcell contents = mknode "w:tc" []
$ if null contents
then emptyCell'
else contents
let mkrow cells =
mknode "w:tr" [] $
map mkcell cells
let textwidth = 7920 -- 5.5 in in twips, 1/20 pt
let fullrow = 5000 -- 100% specified in pct
let (rowwidth :: Int) = round $ fullrow * sum widths
let mkgridcol w = mknode "w:gridCol"
[("w:w", tshow (floor (textwidth * w) :: Integer))] ()
let hasHeader = not $ all null headers
modify $ \s -> s { stInTable = False }
-- for compatibility with Word <= 2007, we include a val with a bitmask
-- 0×0020 Apply first row conditional formatting
-- 0×0040 Apply last row conditional formatting
-- 0×0080 Apply first column conditional formatting
-- 0×0100 Apply last column conditional formatting
-- 0×0200 Do not apply row banding conditional formatting
-- 0×0400 Do not apply column banding conditional formattin
let tblLookVal :: Int
tblLookVal = if hasHeader then 0x20 else 0
return $
caption' ++
[Elem $
mknode "w:tbl" []
( mknode "w:tblPr" []
( mknode "w:tblStyle" [("w:val","Table")] () :
mknode "w:tblW" [("w:type", "pct"), ("w:w", tshow rowwidth)] () :
mknode "w:tblLook" [("w:firstRow",if hasHeader then "1" else "0")
,("w:lastRow","0")
,("w:firstColumn","0")
,("w:lastColumn","0")
,("w:noHBand","0")
,("w:noVBand","0")
,("w:val", T.pack $ printf "%04x" tblLookVal)
] () :
[ mknode "w:tblCaption" [("w:val", captionStr)] ()
| not (null caption) ] )
: mknode "w:tblGrid" []
(if all (==0) widths
then []
else map mkgridcol widths)
: [ mkrow headers' | hasHeader ] ++
map mkrow rows'
)]
alignmentToString :: Alignment -> Text
alignmentToString alignment = case alignment of
AlignLeft -> "left"
AlignRight -> "right"
AlignCenter -> "center"
AlignDefault -> "left"
|
