@@ -81,8 +81,23 @@ listMarkerToId (NumberMarker sty delim n) =
8181 OneParen -> '2'
8282 TwoParens -> '3'
8383
84−data WriterEnv = WriterEnv{ envTextProperties :: [Element]
85− , envParaProperties :: [Element]
84+data EnvProps = EnvProps{ styleElement :: Maybe Element
85+ , otherElements :: [Element]
86+ }
87+
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')
91+
92+instance Monoid EnvProps where
93+ mempty = EnvProps Nothing []
94+
95+squashProps :: EnvProps -> [Element]
96+squashProps (EnvProps Nothing es) = es
97+squashProps (EnvProps (Just e) es) = e : es
98+
99+data WriterEnv = WriterEnv{ envTextProperties :: EnvProps
100+ , envParaProperties :: EnvProps
86101 , envRTL :: Bool
87102 , envListLevel :: Int
88103 , envListNumId :: Int
@@ -93,8 +108,8 @@ data WriterEnv = WriterEnv{ envTextProperties :: [Element]
93108 }
94109
95110defaultWriterEnv :: WriterEnv
96−defaultWriterEnv = WriterEnv{ envTextProperties = []
97− , envParaProperties = []
111+defaultWriterEnv = WriterEnv{ envTextProperties = mempty
112+ , envParaProperties = mempty
98113 , envRTL = False
99114 , envListLevel = -1
100115 , envListNumId = 1
@@ -115,6 +130,7 @@ data WriterState = WriterState{
115130 , stDelId :: Int
116131 , stStyleMaps :: StyleMaps
117132 , stFirstPara :: Bool
133+ , stInTable :: Bool
118134 , stTocTitle :: [Inline]
119135 , stDynamicParaProps :: Set.Set String
120136 , stDynamicTextProps :: Set.Set String
@@ -133,6 +149,7 @@ defaultWriterState = WriterState{
133149 , stDelId = 1
134150 , stStyleMaps = defaultStyleMaps
135151 , stFirstPara = False
152+ , stInTable = False
136153 , stTocTitle = [Str "Table of Contents"]
137154 , stDynamicParaProps = Set.empty
138155 , stDynamicTextProps = Set.empty
@@ -496,7 +513,7 @@ writeDocx opts doc@(Pandoc meta _) = do
496513 case key' of
497514 "description" -> intercalate "_x000d_\n" (map stringify $ lookupMetaBlocks "description" meta')
498515 _ -> lookupMetaString key' meta'
499−
516+
500517 let docProps = mknode "cp:coreProperties"
501518 [("xmlns:cp","http://schemas.openxmlformats.org/package/2006/metadata/core-properties")
502519 ,("xmlns:dc","http://purl.org/dc/elements/1.1/")
@@ -901,8 +918,12 @@ blockToOpenXML' opts (Header lev (ident,_,_) lst) = do
901918 $ stSectionIds s }
902919 bookmarkedContents <- wrapBookmark bookmarkName contents
903920 return [mknode "w:p" [] (paraProps ++ bookmarkedContents)]
904−blockToOpenXML' opts (Plain lst) = withParaProp (pCustomStyle "Compact")
905− $ blockToOpenXML opts (Para lst)
921+blockToOpenXML' opts (Plain lst) = do
922+ isInTable <- gets stInTable
923+ let block = blockToOpenXML opts (Para lst)
924+ para <- if isInTable then withParaProp (pCustomStyle "Compact") block else block
925+ return $ para
926+
906927-- title beginning with fig: indicates that the image is a figure
907928blockToOpenXML' opts (Para [Image attr alt (src,'f':'i':'g':':':tit)]) = do
908929 setFirstPara
@@ -910,7 +931,7 @@ blockToOpenXML' opts (Para [Image attr alt (src,'f':'i':'g':':':tit)]) = do
910931 if null alt
911932 then "Figure"
912933 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)
914935 contents <- inlinesToOpenXML opts [Image attr alt (src,tit)]
915936 captionNode <- withParaProp (pCustomStyle "ImageCaption")
916937 $ blockToOpenXML opts (Para alt)
@@ -939,7 +960,8 @@ blockToOpenXML' _ b@(RawBlock format str)
939960 report $ BlockNotRendered b
940961 return []
941962blockToOpenXML' opts (BlockQuote blocks) = do
942− p <- withParaPropM (pStyleM "Block Text") $ blocksToOpenXML opts blocks
963+ p <- withParaPropM (pStyleM "Block Text")
964+ $ blocksToOpenXML opts blocks
943965 setFirstPara
944966 return p
945967blockToOpenXML' opts (CodeBlock attrs@(ident, _, _) str) = do
@@ -955,6 +977,7 @@ blockToOpenXML' _ HorizontalRule = do
955977 ("o:hrstd","t"),("o:hr","t")] () ]
956978blockToOpenXML' opts (Table caption aligns widths headers rows) = do
957979 setFirstPara
980+ modify $ \s -> s { stInTable = True }
958981 let captionStr = stringify caption
959982 caption' <- if null caption
960983 then return []
@@ -990,6 +1013,7 @@ blockToOpenXML' opts (Table caption aligns widths headers rows) = do
9901013 let mkgridcol w = mknode "w:gridCol"
9911014 [("w:w", show (floor (textwidth * w) :: Integer))] ()
9921015 let hasHeader = not (all null headers)
1016+ modify $ \s -> s { stInTable = False }
9931017 return $
9941018 caption' ++
9951019 [mknode "w:tbl" []
@@ -1063,16 +1087,22 @@ withNumId numid = local $ \env -> env{ envListNumId = numid }
10631087asList :: (PandocMonad m) => WS m a -> WS m a
10641088asList = local $ \env -> env{ envListLevel = envListLevel env + 1 }
10651089
1090+isStyle :: Element -> Bool
1091+isStyle e = isElem [] "w" "rStyle" e ||
1092+ isElem [] "w" "pStyle" e
1093+
10661094getTextProps :: (PandocMonad m) => WS m [Element]
10671095getTextProps = do
10681096 props <- asks envTextProperties
1069− return $ if null props
1097+ let squashed = squashProps props
1098+ return $ if null squashed
10701099 then []
1071− else [mknode "w:rPr" [] props]
1100+ else [mknode "w:rPr" [] squashed]
10721101
10731102withTextProp :: PandocMonad m => Element -> WS m a -> WS m a
10741103withTextProp 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]
10761106
10771107withTextPropM :: PandocMonad m => WS m Element -> WS m a -> WS m a
10781108withTextPropM = (. flip withTextProp) . (>>=)
@@ -1085,13 +1115,14 @@ getParaProps displayMathPara = do
10851115 let listPr = [mknode "w:numPr" []
10861116 [ mknode "w:ilvl" [("w:val",show listLevel)] ()
10871117 , mknode "w:numId" [("w:val",show numid)] () ] | listLevel >= 0 && not displayMathPara]
1088− return $ case listPr ++ props of
1118+ return $ case listPr ++ squashProps props of
10891119 [] -> []
10901120 ps -> [mknode "w:pPr" [] ps]
10911121
10921122withParaProp :: PandocMonad m => Element -> WS m a -> WS m a
10931123withParaProp 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]
10951126
10961127withParaPropM :: PandocMonad m => WS m Element -> WS m a -> WS m a
10971128withParaPropM = (. flip withParaProp) . (>>=)
@@ -1264,8 +1295,8 @@ inlineToOpenXML' opts (Note bs) = do
12641295 insertNoteRef xs = Para [notemarkerXml] : xs
12651296
12661297 contents <- local (\env -> env{ envListLevel = -1
1267− , envParaProperties = []
1268− , envTextProperties = [] })
1298+ , envParaProperties = mempty
1299+ , envTextProperties = mempty })
12691300 (withParaPropM (pStyleM "Footnote Text") $ blocksToOpenXML opts
12701301 $ insertNoteRef bs)
12711302 let newnote = mknode "w:footnote" [("w:id", notenum)] contents
@@ -1417,16 +1448,18 @@ withDirection x = do
14171448 -- We want to clean all bidirection (bidi) and right-to-left (rtl)
14181449 -- properties from the props first. This is because we don't want
14191450 -- them to stack up.
1420− let paraProps' = filter (\e -> (qName . elName) e /= "bidi") paraProps
1421− textProps' = filter (\e -> (qName . elName) e /= "rtl") textProps
1451+ let paraProps' = filter (\e -> (qName . elName) e /= "bidi") (otherElements paraProps)
1452+ textProps' = filter (\e -> (qName . elName) e /= "rtl") (otherElements textProps)
1453+ paraStyle = styleElement paraProps
1454+ textStyle = styleElement textProps
14221455 if isRTL
14231456 -- if we are going right-to-left, we (re?)add the properties.
14241457 then flip local x $
1425− \env -> env { envParaProperties = mknode "w:bidi" [] () : paraProps'
1426− , envTextProperties = mknode "w:rtl" [] () : textProps'
1458+ \env -> env { envParaProperties = EnvProps paraStyle $ mknode "w:bidi" [] () : paraProps'
1459+ , envTextProperties = EnvProps textStyle $ mknode "w:rtl" [] () : textProps'
14271460 }
1428− else flip local x $ \env -> env { envParaProperties = paraProps'
1429− , envTextProperties = textProps'
1461+ else flip local x $ \env -> env { envParaProperties = EnvProps paraStyle paraProps'
1462+ , envTextProperties = EnvProps textStyle textProps'
14301463 }
14311464
14321465wrapBookmark :: (PandocMonad m) => String -> [Element] -> WS m [Element]