@@ -81,8 +81,23 @@ listMarkerToId (NumberMarker sty delim n) =
81 OneParen -> '2'
81 OneParen -> '2'
82 TwoParens -> '3'
82 TwoParens -> '3'
84+data EnvProps = EnvProps{ styleElement :: Maybe Element
85+ , otherElements :: [Element]
88+instance Semigroup EnvProps where
89+ EnvProps Nothing es <> EnvProps s es' = EnvProps s (es ++ es')
90+ EnvProps s es <> EnvProps _ es' = EnvProps s (es ++ es')
92+instance Monoid EnvProps where
93+ mempty = EnvProps Nothing []
95+squashProps :: EnvProps -> [Element]
96+squashProps (EnvProps Nothing es) = es
97+squashProps (EnvProps (Just e) es) = e : es
84−data WriterEnv = WriterEnv{ envTextProperties :: [Element]
99+data WriterEnv = WriterEnv{ envTextProperties :: EnvProps
85− , envParaProperties :: [Element]
100+ , envParaProperties :: EnvProps
86 , envRTL :: Bool
101 , envRTL :: Bool
87 , envListLevel :: Int
102 , envListLevel :: Int
88 , envListNumId :: Int
103 , envListNumId :: Int
@@ -93,8 +108,8 @@ data WriterEnv = WriterEnv{ envTextProperties :: [Element]
95defaultWriterEnv :: WriterEnv
110defaultWriterEnv :: WriterEnv
96−defaultWriterEnv = WriterEnv{ envTextProperties = []
111+defaultWriterEnv = WriterEnv{ envTextProperties = mempty
97− , envParaProperties = []
112+ , envParaProperties = mempty
98 , envRTL = False
113 , envRTL = False
99 , envListLevel = -1
114 , envListLevel = -1
100 , envListNumId = 1
115 , envListNumId = 1
@@ -115,6 +130,7 @@ data WriterState = WriterState{
115 , stDelId :: Int
130 , stDelId :: Int
116 , stStyleMaps :: StyleMaps
131 , stStyleMaps :: StyleMaps
117 , stFirstPara :: Bool
132 , stFirstPara :: Bool
118 , stTocTitle :: [Inline]
134 , stTocTitle :: [Inline]
119 , stDynamicParaProps :: Set.Set String
135 , stDynamicParaProps :: Set.Set String
120 , stDynamicTextProps :: Set.Set String
136 , stDynamicTextProps :: Set.Set String
@@ -133,6 +149,7 @@ defaultWriterState = WriterState{
133 , stDelId = 1
149 , stDelId = 1
134 , stStyleMaps = defaultStyleMaps
150 , stStyleMaps = defaultStyleMaps
135 , stFirstPara = False
151 , stFirstPara = False
136 , stTocTitle = [Str "Table of Contents"]
153 , stTocTitle = [Str "Table of Contents"]
137 , stDynamicParaProps = Set.empty
154 , stDynamicParaProps = Set.empty
138 , stDynamicTextProps = Set.empty
155 , stDynamicTextProps = Set.empty
@@ -496,7 +513,7 @@ writeDocx opts doc@(Pandoc meta _) = do
496 case key' of
513 case key' of
497 "description" -> intercalate "_x000d_\n" (map stringify $ lookupMetaBlocks "description" meta')
514 "description" -> intercalate "_x000d_\n" (map stringify $ lookupMetaBlocks "description" meta')
498 _ -> lookupMetaString key' meta'
515 _ -> lookupMetaString key' meta'
500 let docProps = mknode "cp:coreProperties"
517 let docProps = mknode "cp:coreProperties"
501 [("xmlns:cp","http://schemas.openxmlformats.org/package/2006/metadata/core-properties")
518 [("xmlns:cp","http://schemas.openxmlformats.org/package/2006/metadata/core-properties")
502 ,("xmlns:dc","http://purl.org/dc/elements/1.1/")
519 ,("xmlns:dc","http://purl.org/dc/elements/1.1/")
@@ -901,8 +918,12 @@ blockToOpenXML' opts (Header lev (ident,_,_) lst) = do
901 $ stSectionIds s }
918 $ stSectionIds s }
902 bookmarkedContents <- wrapBookmark bookmarkName contents
919 bookmarkedContents <- wrapBookmark bookmarkName contents
903 return [mknode "w:p" [] (paraProps ++ bookmarkedContents)]
920 return [mknode "w:p" [] (paraProps ++ bookmarkedContents)]
904−blockToOpenXML' opts (Plain lst) = withParaProp (pCustomStyle "Compact")
921+blockToOpenXML' opts (Plain lst) = do
905− $ blockToOpenXML opts (Para lst)
922+ isInTable <- gets stInTable
923+ let block = blockToOpenXML opts (Para lst)
924+ para <- if isInTable then withParaProp (pCustomStyle "Compact") block else block
906-- title beginning with fig: indicates that the image is a figure
927-- title beginning with fig: indicates that the image is a figure
907blockToOpenXML' opts (Para [Image attr alt (src,'f':'i':'g':':':tit)]) = do
928blockToOpenXML' opts (Para [Image attr alt (src,'f':'i':'g':':':tit)]) = do
908 setFirstPara
929 setFirstPara
@@ -910,7 +931,7 @@ blockToOpenXML' opts (Para [Image attr alt (src,'f':'i':'g':':':tit)]) = do
910 if null alt
931 if null alt
911 then "Figure"
932 then "Figure"
912 else "CaptionedFigure"
933 else "CaptionedFigure"
913− paraProps <- local (\env -> env { envParaProperties = prop : envParaProperties env }) (getParaProps False)
934+ paraProps <- local (\env -> env { envParaProperties = EnvProps (Just prop) [] <> envParaProperties env }) (getParaProps False)
914 contents <- inlinesToOpenXML opts [Image attr alt (src,tit)]
935 contents <- inlinesToOpenXML opts [Image attr alt (src,tit)]
915 captionNode <- withParaProp (pCustomStyle "ImageCaption")
936 captionNode <- withParaProp (pCustomStyle "ImageCaption")
916 $ blockToOpenXML opts (Para alt)
937 $ blockToOpenXML opts (Para alt)
@@ -939,7 +960,8 @@ blockToOpenXML' _ b@(RawBlock format str)
939 report $ BlockNotRendered b
960 report $ BlockNotRendered b
940 return []
961 return []
941blockToOpenXML' opts (BlockQuote blocks) = do
962blockToOpenXML' opts (BlockQuote blocks) = do
942− p <- withParaPropM (pStyleM "Block Text") $ blocksToOpenXML opts blocks
963+ p <- withParaPropM (pStyleM "Block Text")
964+ $ blocksToOpenXML opts blocks
943 setFirstPara
965 setFirstPara
945blockToOpenXML' opts (CodeBlock attrs@(ident, _, _) str) = do
967blockToOpenXML' opts (CodeBlock attrs@(ident, _, _) str) = do
@@ -955,6 +977,7 @@ blockToOpenXML' _ HorizontalRule = do
955 ("o:hrstd","t"),("o:hr","t")] () ]
977 ("o:hrstd","t"),("o:hr","t")] () ]
956blockToOpenXML' opts (Table caption aligns widths headers rows) = do
978blockToOpenXML' opts (Table caption aligns widths headers rows) = do
957 setFirstPara
979 setFirstPara
980+ modify $ \s -> s { stInTable = True }
958 let captionStr = stringify caption
981 let captionStr = stringify caption
959 caption' <- if null caption
982 caption' <- if null caption
960 then return []
983 then return []
@@ -990,6 +1013,7 @@ blockToOpenXML' opts (Table caption aligns widths headers rows) = do
990 let mkgridcol w = mknode "w:gridCol"
1013 let mkgridcol w = mknode "w:gridCol"
991 [("w:w", show (floor (textwidth * w) :: Integer))] ()
1014 [("w:w", show (floor (textwidth * w) :: Integer))] ()
992 let hasHeader = not (all null headers)
1015 let hasHeader = not (all null headers)
1016+ modify $ \s -> s { stInTable = False }
993 return $
1017 return $
994 caption' ++
1018 caption' ++
995 [mknode "w:tbl" []
1019 [mknode "w:tbl" []
@@ -1063,16 +1087,22 @@ withNumId numid = local $ \env -> env{ envListNumId = numid }
1063asList :: (PandocMonad m) => WS m a -> WS m a
1087asList :: (PandocMonad m) => WS m a -> WS m a
1064asList = local $ \env -> env{ envListLevel = envListLevel env + 1 }
1088asList = local $ \env -> env{ envListLevel = envListLevel env + 1 }
1090+isStyle :: Element -> Bool
1091+isStyle e = isElem [] "w" "rStyle" e ||
1092+ isElem [] "w" "pStyle" e
1066getTextProps :: (PandocMonad m) => WS m [Element]
1094getTextProps :: (PandocMonad m) => WS m [Element]
1067getTextProps = do
1095getTextProps = do
1068 props <- asks envTextProperties
1096 props <- asks envTextProperties
1097+ let squashed = squashProps props
1069− return $ if null props
1098+ return $ if null squashed
1071− else [mknode "w:rPr" [] props]
1100+ else [mknode "w:rPr" [] squashed]
1073withTextProp :: PandocMonad m => Element -> WS m a -> WS m a
1102withTextProp :: PandocMonad m => Element -> WS m a -> WS m a
1074withTextProp d p =
1103withTextProp d p =
1075− local (\env -> env {envTextProperties = d : envTextProperties env}) p
1104+ local (\env -> env {envTextProperties = ep <> envTextProperties env}) p
1105+ where ep = if isStyle d then EnvProps (Just d) [] else EnvProps Nothing [d]
1077withTextPropM :: PandocMonad m => WS m Element -> WS m a -> WS m a
1107withTextPropM :: PandocMonad m => WS m Element -> WS m a -> WS m a
1078withTextPropM = (. flip withTextProp) . (>>=)
1108withTextPropM = (. flip withTextProp) . (>>=)
@@ -1085,13 +1115,14 @@ getParaProps displayMathPara = do
1085 let listPr = [mknode "w:numPr" []
1115 let listPr = [mknode "w:numPr" []
1086 [ mknode "w:ilvl" [("w:val",show listLevel)] ()
1116 [ mknode "w:ilvl" [("w:val",show listLevel)] ()
1087 , mknode "w:numId" [("w:val",show numid)] () ] | listLevel >= 0 && not displayMathPara]
1117 , mknode "w:numId" [("w:val",show numid)] () ] | listLevel >= 0 && not displayMathPara]
1088− return $ case listPr ++ props of
1118+ return $ case listPr ++ squashProps props of
1089 [] -> []
1119 [] -> []
1090 ps -> [mknode "w:pPr" [] ps]
1120 ps -> [mknode "w:pPr" [] ps]
1092withParaProp :: PandocMonad m => Element -> WS m a -> WS m a
1122withParaProp :: PandocMonad m => Element -> WS m a -> WS m a
1093withParaProp d p =
1123withParaProp d p =
1094− local (\env -> env {envParaProperties = d : envParaProperties env}) p
1124+ local (\env -> env {envParaProperties = ep <> envParaProperties env}) p
1125+ where ep = if isStyle d then EnvProps (Just d) [] else EnvProps Nothing [d]
1096withParaPropM :: PandocMonad m => WS m Element -> WS m a -> WS m a
1127withParaPropM :: PandocMonad m => WS m Element -> WS m a -> WS m a
1097withParaPropM = (. flip withParaProp) . (>>=)
1128withParaPropM = (. flip withParaProp) . (>>=)
@@ -1264,8 +1295,8 @@ inlineToOpenXML' opts (Note bs) = do
1264 insertNoteRef xs = Para [notemarkerXml] : xs
1295 insertNoteRef xs = Para [notemarkerXml] : xs
1266 contents <- local (\env -> env{ envListLevel = -1
1297 contents <- local (\env -> env{ envListLevel = -1
1267− , envParaProperties = []
1298+ , envParaProperties = mempty
1268− , envTextProperties = [] })
1299+ , envTextProperties = mempty })
1269 (withParaPropM (pStyleM "Footnote Text") $ blocksToOpenXML opts
1300 (withParaPropM (pStyleM "Footnote Text") $ blocksToOpenXML opts
1270 $ insertNoteRef bs)
1301 $ insertNoteRef bs)
1271 let newnote = mknode "w:footnote" [("w:id", notenum)] contents
1302 let newnote = mknode "w:footnote" [("w:id", notenum)] contents
@@ -1417,16 +1448,18 @@ withDirection x = do
1417 -- We want to clean all bidirection (bidi) and right-to-left (rtl)
1448 -- We want to clean all bidirection (bidi) and right-to-left (rtl)
1418 -- properties from the props first. This is because we don't want
1449 -- properties from the props first. This is because we don't want
1419 -- them to stack up.
1450 -- them to stack up.
1420− let paraProps' = filter (\e -> (qName . elName) e /= "bidi") paraProps
1451+ let paraProps' = filter (\e -> (qName . elName) e /= "bidi") (otherElements paraProps)
1421− textProps' = filter (\e -> (qName . elName) e /= "rtl") textProps
1452+ textProps' = filter (\e -> (qName . elName) e /= "rtl") (otherElements textProps)
1453+ paraStyle = styleElement paraProps
1454+ textStyle = styleElement textProps
1422 if isRTL
1455 if isRTL
1423 -- if we are going right-to-left, we (re?)add the properties.
1456 -- if we are going right-to-left, we (re?)add the properties.
1424 then flip local x $
1457 then flip local x $
1425− \env -> env { envParaProperties = mknode "w:bidi" [] () : paraProps'
1458+ \env -> env { envParaProperties = EnvProps paraStyle $ mknode "w:bidi" [] () : paraProps'
1426− , envTextProperties = mknode "w:rtl" [] () : textProps'
1459+ , envTextProperties = EnvProps textStyle $ mknode "w:rtl" [] () : textProps'
1428− else flip local x $ \env -> env { envParaProperties = paraProps'
1461+ else flip local x $ \env -> env { envParaProperties = EnvProps paraStyle paraProps'
1429− , envTextProperties = textProps'
1462+ , envTextProperties = EnvProps textStyle textProps'
1432wrapBookmark :: (PandocMonad m) => String -> [Element] -> WS m [Element]
1465wrapBookmark :: (PandocMonad m) => String -> [Element] -> WS m [Element]