@@ -22,7 +22,6 @@ import Control.Applicative ((<|>))
2222import Control.Monad.Except (catchError, throwError)
2323import Control.Monad.Reader
2424import Control.Monad.State.Strict
25−import qualified Data.ByteString as B
2625import qualified Data.ByteString.Lazy as BL
2726import Data.Char (isSpace, isLetter)
2827import Data.List (intercalate, isPrefixOf, isSuffixOf)
@@ -47,123 +46,24 @@ import Text.Pandoc.Highlighting (highlight)
4746import Text.Pandoc.Error
4847import Text.Pandoc.ImageSize
4948import Text.Pandoc.Logging
50−import Text.Pandoc.MIME (MimeType, extensionFromMimeType, getMimeType,
51− getMimeTypeDef)
49+import Text.Pandoc.MIME (extensionFromMimeType, getMimeType, getMimeTypeDef)
5250import Text.Pandoc.Options
5351import Text.Pandoc.Writers.Docx.StyleMap
52+import Text.Pandoc.Writers.Docx.Table
53+import Text.Pandoc.Writers.Docx.Types
5454import Text.Pandoc.Shared
5555import Text.Pandoc.Walk
5656import Text.Pandoc.Writers.Math
5757import Text.Pandoc.Writers.Shared
58−import Text.Printf (printf)
5958import Text.TeXMath
6059import Text.Pandoc.Writers.OOXML
6160import Text.Pandoc.XML.Light as XML
6261import Data.Generics (mkT, everywhere)
6362
64−data ListMarker = NoMarker
65− | BulletMarker
66− | NumberMarker ListNumberStyle ListNumberDelim Int
67− deriving (Show, Read, Eq, Ord)
68−
69−listMarkerToId :: ListMarker -> Text
70−listMarkerToId NoMarker = "990"
71−listMarkerToId BulletMarker = "991"
72−listMarkerToId (NumberMarker sty delim n) = T.pack $
73− '9' : '9' : styNum : delimNum : show n
74− where styNum = case sty of
75− DefaultStyle -> '2'
76− Example -> '3'
77− Decimal -> '4'
78− LowerRoman -> '5'
79− UpperRoman -> '6'
80− LowerAlpha -> '7'
81− UpperAlpha -> '8'
82− delimNum = case delim of
83− DefaultDelim -> '0'
84− Period -> '1'
85− OneParen -> '2'
86− TwoParens -> '3'
87−
88−data EnvProps = EnvProps{ styleElement :: Maybe Element
89− , otherElements :: [Element]
90− }
91−
92−instance Semigroup EnvProps where
93− EnvProps s es <> EnvProps s' es' = EnvProps (s <|> s') (es ++ es')
94−
95−instance Monoid EnvProps where
96− mempty = EnvProps Nothing []
97− mappend = (<>)
98−
9963squashProps :: EnvProps -> [Element]
10064squashProps (EnvProps Nothing es) = es
10165squashProps (EnvProps (Just e) es) = e : es
10266
103−data WriterEnv = WriterEnv{ envTextProperties :: EnvProps
104− , envParaProperties :: EnvProps
105− , envRTL :: Bool
106− , envListLevel :: Int
107− , envListNumId :: Int
108− , envInDel :: Bool
109− , envChangesAuthor :: Text
110− , envChangesDate :: Text
111− , envPrintWidth :: Integer
112− }
113−
114−defaultWriterEnv :: WriterEnv
115−defaultWriterEnv = WriterEnv{ envTextProperties = mempty
116− , envParaProperties = mempty
117− , envRTL = False
118− , envListLevel = -1
119− , envListNumId = 1
120− , envInDel = False
121− , envChangesAuthor = "unknown"
122− , envChangesDate = "1969-12-31T19:00:00Z"
123− , envPrintWidth = 1
124− }
125−
126−data WriterState = WriterState{
127− stFootnotes :: [Element]
128− , stComments :: [([(Text, Text)], [Inline])]
129− , stSectionIds :: Set.Set Text
130− , stExternalLinks :: M.Map Text Text
131− , stImages :: M.Map FilePath (String, String, Maybe MimeType, B.ByteString)
132− , stLists :: [ListMarker]
133− , stInsId :: Int
134− , stDelId :: Int
135− , stStyleMaps :: StyleMaps
136− , stFirstPara :: Bool
137− , stInTable :: Bool
138− , stInList :: Bool
139− , stTocTitle :: [Inline]
140− , stDynamicParaProps :: Set.Set ParaStyleName
141− , stDynamicTextProps :: Set.Set CharStyleName
142− , stCurId :: Int
143− }
144−
145−defaultWriterState :: WriterState
146−defaultWriterState = WriterState{
147− stFootnotes = defaultFootnotes
148− , stComments = []
149− , stSectionIds = Set.empty
150− , stExternalLinks = M.empty
151− , stImages = M.empty
152− , stLists = [NoMarker]
153− , stInsId = 1
154− , stDelId = 1
155− , stStyleMaps = StyleMaps M.empty M.empty
156− , stFirstPara = False
157− , stInTable = False
158− , stInList = False
159− , stTocTitle = [Str "Table of Contents"]
160− , stDynamicParaProps = Set.empty
161− , stDynamicTextProps = Set.empty
162− , stCurId = 20
163− }
164−
165−type WS m = ReaderT WriterEnv (StateT WriterState m)
166−
16767renumIdMap :: Int -> [Element] -> M.Map Text Text
16868renumIdMap _ [] = M.empty
16969renumIdMap n (e:es)
@@ -858,12 +758,6 @@ separateTables (x@Table{}:xs@(Table{}:_)) =
858758 x : RawBlock (Format "openxml") "<w:p />" : separateTables xs
859759separateTables (x:xs) = x : separateTables xs
860760
861−pStyleM :: (PandocMonad m) => ParaStyleName -> WS m XML.Element
862−pStyleM styleName = do
863− pStyleMap <- gets (smParaStyle . stStyleMaps)
864− let sty' = getStyleIdFromName styleName pStyleMap
865− return $ mknode "w:pStyle" [("w:val", fromStyleId sty')] ()
866−
867761rStyleM :: (PandocMonad m) => CharStyleName -> WS m XML.Element
868762rStyleM styleName = do
869763 cStyleMap <- gets (smCharStyle . stStyleMaps)
@@ -995,78 +889,8 @@ blockToOpenXML' _ HorizontalRule = do
995889 $ mknode "v:rect" [("style","width:0;height:1.5pt"),
996890 ("o:hralign","center"),
997891 ("o:hrstd","t"),("o:hr","t")] () ]
998−blockToOpenXML' opts (Table _ blkCapt specs thead tbody tfoot) = do
999− let (caption, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot
1000− setFirstPara
1001− modify $ \s -> s { stInTable = True }
1002− let captionStr = stringify caption
1003− caption' <- if null caption
1004− then return []
1005− else withParaPropM (pStyleM "Table Caption")
1006− $ blockToOpenXML opts (Para caption)
1007− let alignmentFor al = mknode "w:jc" [("w:val",alignmentToString al)] ()
1008− -- Table cells require a <w:p> element, even an empty one!
1009− -- Not in the spec but in Word 2007, 2010. See #4953. And
1010− -- apparently the last element must be a <w:p>, see #6983.
1011− let cellToOpenXML (al, cell) = do
1012− es <- withParaProp (alignmentFor al) $ blocksToOpenXML opts cell
1013− return $
1014− case reverse (onlyElems es) of
1015− b:e:_ | qName (elName b) == "bookmarkEnd"
1016− , qName (elName e) == "p" -> es
1017− e:_ | qName (elName e) == "p" -> es
1018− _ -> es ++ [Elem $ mknode "w:p" [] ()]
1019− headers' <- mapM cellToOpenXML $ zip aligns headers
1020− rows' <- mapM (mapM cellToOpenXML . zip aligns) rows
1021− compactStyle <- pStyleM "Compact"
1022− let emptyCell' = [Elem $ mknode "w:p" [] [mknode "w:pPr" [] [compactStyle]]]
1023− let mkcell contents = mknode "w:tc" []
1024− $ if null contents
1025− then emptyCell'
1026− else contents
1027− let mkrow cells =
1028− mknode "w:tr" [] $
1029− map mkcell cells
1030− let textwidth = 7920 -- 5.5 in in twips, 1/20 pt
1031− let fullrow = 5000 -- 100% specified in pct
1032− let (rowwidth :: Int) = round $ fullrow * sum widths
1033− let mkgridcol w = mknode "w:gridCol"
1034− [("w:w", tshow (floor (textwidth * w) :: Integer))] ()
1035− let hasHeader = not $ all null headers
1036− modify $ \s -> s { stInTable = False }
1037− -- for compatibility with Word <= 2007, we include a val with a bitmask
1038− -- 0×0020 Apply first row conditional formatting
1039− -- 0×0040 Apply last row conditional formatting
1040− -- 0×0080 Apply first column conditional formatting
1041− -- 0×0100 Apply last column conditional formatting
1042− -- 0×0200 Do not apply row banding conditional formatting
1043− -- 0×0400 Do not apply column banding conditional formattin
1044− let tblLookVal :: Int
1045− tblLookVal = if hasHeader then 0x20 else 0
1046− return $
1047− caption' ++
1048− [Elem $
1049− mknode "w:tbl" []
1050− ( mknode "w:tblPr" []
1051− ( mknode "w:tblStyle" [("w:val","Table")] () :
1052− mknode "w:tblW" [("w:type", "pct"), ("w:w", tshow rowwidth)] () :
1053− mknode "w:tblLook" [("w:firstRow",if hasHeader then "1" else "0")
1054− ,("w:lastRow","0")
1055− ,("w:firstColumn","0")
1056− ,("w:lastColumn","0")
1057− ,("w:noHBand","0")
1058− ,("w:noVBand","0")
1059− ,("w:val", T.pack $ printf "%04x" tblLookVal)
1060− ] () :
1061− [ mknode "w:tblCaption" [("w:val", captionStr)] ()
1062− | not (null caption) ] )
1063− : mknode "w:tblGrid" []
1064− (if all (==0) widths
1065− then []
1066− else map mkgridcol widths)
1067− : [ mkrow headers' | hasHeader ] ++
1068− map mkrow rows'
1069− )]
892+blockToOpenXML' opts (Table _ blkCapt specs thead tbody tfoot) =
893+ tableToOpenXML (blocksToOpenXML opts) blkCapt specs thead tbody tfoot
1070894blockToOpenXML' opts el
1071895 | BulletList lst <- el = addOpenXMLList BulletMarker lst
1072896 | OrderedList (start, numstyle, numdelim) lst <- el
@@ -1121,13 +945,6 @@ listItemToOpenXML opts numid (first:rest) = do
1121945 modify $ \st -> st{ stInList = oldInList }
1122946 return $ first'' ++ rest''
1123947
1124−alignmentToString :: Alignment -> Text
1125−alignmentToString alignment = case alignment of
1126− AlignLeft -> "left"
1127− AlignRight -> "right"
1128− AlignCenter -> "center"
1129− AlignDefault -> "left"
1130−
1131948-- | Convert a list of inline elements to OpenXML.
1132949inlinesToOpenXML :: PandocMonad m => WriterOptions -> [Inline] -> WS m [Content]
1133950inlinesToOpenXML opts lst = concat `fmap` mapM (inlineToOpenXML opts) lst
@@ -1138,10 +955,6 @@ withNumId numid = local $ \env -> env{ envListNumId = numid }
1138955asList :: (PandocMonad m) => WS m a -> WS m a
1139956asList = local $ \env -> env{ envListLevel = envListLevel env + 1 }
1140957
1141−isStyle :: Element -> Bool
1142−isStyle e = isElem [] "w" "rStyle" e ||
1143− isElem [] "w" "pStyle" e
1144−
1145958getTextProps :: (PandocMonad m) => WS m [Element]
1146959getTextProps = do
1147960 props <- asks envTextProperties
@@ -1170,16 +983,6 @@ getParaProps displayMathPara = do
1170983 [] -> []
1171984 ps -> [mknode "w:pPr" [] ps]
1172985
1173−withParaProp :: PandocMonad m => Element -> WS m a -> WS m a
1174−withParaProp d p =
1175− local (\env -> env {envParaProperties = ep <> envParaProperties env}) p
1176− where ep = if isStyle d then EnvProps (Just d) [] else EnvProps Nothing [d]
1177−
1178−withParaPropM :: PandocMonad m => WS m Element -> WS m a -> WS m a
1179−withParaPropM md p = do
1180− d <- md
1181− withParaProp d p
1182−
1183986formattedString :: PandocMonad m => Text -> WS m [Element]
1184987formattedString str =
1185988 -- properly handle soft hyphens
@@ -1200,9 +1003,6 @@ formattedRun els = do
12001003 props <- getTextProps
12011004 return [ mknode "w:r" [] $ props ++ els ]
12021005
1203−setFirstPara :: PandocMonad m => WS m ()
1204−setFirstPara = modify $ \s -> s { stFirstPara = True }
1205−
12061006-- | Convert an inline element to OpenXML.
12071007inlineToOpenXML :: PandocMonad m => WriterOptions -> Inline -> WS m [Content]
12081008inlineToOpenXML opts il = withDirection $ inlineToOpenXML' opts il
@@ -1494,22 +1294,6 @@ inlineToOpenXML' opts (Image attr@(imgident, _, _) alt (src, title)) = do
14941294br :: Element
14951295br = mknode "w:r" [] [mknode "w:br" [] ()]
14961296
1497−-- Word will insert these footnotes into the settings.xml file
1498−-- (whether or not they're visible in the document). If they're in the
1499−-- file, but not in the footnotes.xml file, it will produce
1500−-- problems. So we want to make sure we insert them into our document.
1501−defaultFootnotes :: [Element]
1502−defaultFootnotes = [ mknode "w:footnote"
1503− [("w:type", "separator"), ("w:id", "-1")]
1504− [ mknode "w:p" []
1505− [mknode "w:r" []
1506− [ mknode "w:separator" [] ()]]]
1507− , mknode "w:footnote"
1508− [("w:type", "continuationSeparator"), ("w:id", "0")]
1509− [ mknode "w:p" []
1510− [ mknode "w:r" []
1511− [ mknode "w:continuationSeparator" [] ()]]]]
1512−
15131297
15141298withDirection :: PandocMonad m => WS m a -> WS m a
15151299withDirection x = do