@@ -264,8 +264,14 @@ writeDocx opts doc@(Pandoc meta _) = do
264264 , stTocTitle = tocTitle
265265 }
266266
267+ let isRTLmeta = case lookupMeta "dir" meta of
268+ Just (MetaString "rtl") -> True
269+ Just (MetaInlines [Str "rtl"]) -> True
270+ _ -> False
271+
267272 let env = defaultWriterEnv {
268− envChangesAuthor = fromMaybe "unknown" username
273+ envRTL = isRTLmeta
274+ , envChangesAuthor = fromMaybe "unknown" username
269275 , envChangesDate = formatTime defaultTimeLocale "%FT%XZ" utctime
270276 }
271277
@@ -722,11 +728,6 @@ makeTOC _ = return []
722728-- OpenXML elements (the main document and footnotes).
723729writeOpenXML :: WriterOptions -> Pandoc -> WS ([Element], [Element])
724730writeOpenXML opts (Pandoc meta blocks) = do
725− let isRTL = case lookupMeta "dir" meta of
726− Just (MetaString "rtl") -> True
727− Just (MetaInlines [Str "rtl"]) -> True
728− _ -> False
729− (if isRTL then setRTL else id) $ do
730731 let tit = docTitle meta ++ case lookupMeta "subtitle" meta of
731732 Just (MetaBlocks [Plain xs]) -> LineBreak : xs
732733 _ -> []
@@ -792,25 +793,30 @@ dynamicStyleKey = "custom-style"
792793
793794-- | Convert a Pandoc block element to OpenXML.
794795blockToOpenXML :: WriterOptions -> Block -> WS [Element]
795−blockToOpenXML _ Null = return []
796−blockToOpenXML opts (Div (ident,classes,kvs) bs)
796+blockToOpenXML opts blk = withDirection $ blockToOpenXML' opts blk
797+
798+blockToOpenXML' :: WriterOptions -> Block -> WS [Element]
799+blockToOpenXML' _ Null = return []
800+blockToOpenXML' opts (Div (ident,classes,kvs) bs)
797801 | Just sty <- lookup dynamicStyleKey kvs = do
798802 modify $ \s -> s{stDynamicParaProps = sty : (stDynamicParaProps s)}
799803 withParaPropM (pStyleM sty) $ blocksToOpenXML opts bs
800804 | Just "rtl" <- lookup "dir" kvs = do
801805 let kvs' = filter (("dir", "rtl")/=) kvs
802− setRTL $ blockToOpenXML opts (Div (ident,classes,kvs') bs)
806+ local (\env -> env { envRTL = True }) $
807+ blockToOpenXML opts (Div (ident,classes,kvs') bs)
803808 | Just "ltr" <- lookup "dir" kvs = do
804809 let kvs' = filter (("dir", "ltr")/=) kvs
805− setLTR $ blockToOpenXML opts (Div (ident,classes,kvs') bs)
806−blockToOpenXML opts (Div (_,["references"],_) bs) = do
810+ local (\env -> env { envRTL = False }) $
811+ blockToOpenXML opts (Div (ident,classes,kvs') bs)
812+blockToOpenXML' opts (Div (_,["references"],_) bs) = do
807813 let (hs, bs') = span isHeaderBlock bs
808814 header <- blocksToOpenXML opts hs
809815 -- We put the Bibliography style on paragraphs after the header
810816 rest <- withParaPropM (pStyleM "Bibliography") $ blocksToOpenXML opts bs'
811817 return (header ++ rest)
812−blockToOpenXML opts (Div _ bs) = blocksToOpenXML opts bs
813−blockToOpenXML opts (Header lev (ident,_,_) lst) = do
818+blockToOpenXML' opts (Div _ bs) = blocksToOpenXML opts bs
819+blockToOpenXML' opts (Header lev (ident,_,_) lst) = do
814820 setFirstPara
815821 paraProps <- withParaPropM (pStyleM ("Heading "++show lev)) $
816822 getParaProps False
@@ -825,10 +831,10 @@ blockToOpenXML opts (Header lev (ident,_,_) lst) = do
825831 ,("w:name",bookmarkName)] ()
826832 let bookmarkEnd = mknode "w:bookmarkEnd" [("w:id", id')] ()
827833 return [mknode "w:p" [] (paraProps ++ [bookmarkStart, bookmarkEnd] ++ contents)]
828−blockToOpenXML opts (Plain lst) = withParaProp (pCustomStyle "Compact")
834+blockToOpenXML' opts (Plain lst) = withParaProp (pCustomStyle "Compact")
829835 $ blockToOpenXML opts (Para lst)
830836-- title beginning with fig: indicates that the image is a figure
831−blockToOpenXML opts (Para [Image attr alt (src,'f':'i':'g':':':tit)]) = do
837+blockToOpenXML' opts (Para [Image attr alt (src,'f':'i':'g':':':tit)]) = do
832838 setFirstPara
833839 let prop = pCustomStyle $
834840 if null alt
@@ -840,8 +846,8 @@ blockToOpenXML opts (Para [Image attr alt (src,'f':'i':'g':':':tit)]) = do
840846 $ blockToOpenXML opts (Para alt)
841847 return $ mknode "w:p" [] (paraProps ++ contents) : captionNode
842848-- fixDisplayMath sometimes produces a Para [] as artifact
843−blockToOpenXML _ (Para []) = return []
844−blockToOpenXML opts (Para lst) = do
849+blockToOpenXML' _ (Para []) = return []
850+blockToOpenXML' opts (Para lst) = do
845851 isFirstPara <- gets stFirstPara
846852 paraProps <- getParaProps $ case lst of
847853 [Math DisplayMath _] -> True
@@ -854,25 +860,25 @@ blockToOpenXML opts (Para lst) = do
854860 modify $ \s -> s { stFirstPara = False }
855861 contents <- inlinesToOpenXML opts lst
856862 return [mknode "w:p" [] (paraProps' ++ contents)]
857−blockToOpenXML _ (RawBlock format str)
863+blockToOpenXML' _ (RawBlock format str)
858864 | format == Format "openxml" = return [ x | Elem x <- parseXML str ]
859865 | otherwise = return []
860−blockToOpenXML opts (BlockQuote blocks) = do
866+blockToOpenXML' opts (BlockQuote blocks) = do
861867 p <- withParaPropM (pStyleM "Block Text") $ blocksToOpenXML opts blocks
862868 setFirstPara
863869 return p
864−blockToOpenXML opts (CodeBlock attrs str) = do
870+blockToOpenXML' opts (CodeBlock attrs str) = do
865871 p <- withParaProp (pCustomStyle "SourceCode") (blockToOpenXML opts $ Para [Code attrs str])
866872 setFirstPara
867873 return p
868−blockToOpenXML _ HorizontalRule = do
874+blockToOpenXML' _ HorizontalRule = do
869875 setFirstPara
870876 return [
871877 mknode "w:p" [] $ mknode "w:r" [] $ mknode "w:pict" []
872878 $ mknode "v:rect" [("style","width:0;height:1.5pt"),
873879 ("o:hralign","center"),
874880 ("o:hrstd","t"),("o:hr","t")] () ]
875−blockToOpenXML opts (Table caption aligns widths headers rows) = do
881+blockToOpenXML' opts (Table caption aligns widths headers rows) = do
876882 setFirstPara
877883 let captionStr = stringify caption
878884 caption' <- if null caption
@@ -920,21 +926,21 @@ blockToOpenXML opts (Table caption aligns widths headers rows) = do
920926 : [ mkrow True headers' | hasHeader ] ++
921927 map (mkrow False) rows'
922928 )]
923−blockToOpenXML opts (BulletList lst) = do
929+blockToOpenXML' opts (BulletList lst) = do
924930 let marker = BulletMarker
925931 addList marker
926932 numid <- getNumId
927933 l <- asList $ concat `fmap` mapM (listItemToOpenXML opts numid) lst
928934 setFirstPara
929935 return l
930−blockToOpenXML opts (OrderedList (start, numstyle, numdelim) lst) = do
936+blockToOpenXML' opts (OrderedList (start, numstyle, numdelim) lst) = do
931937 let marker = NumberMarker numstyle numdelim start
932938 addList marker
933939 numid <- getNumId
934940 l <- asList $ concat `fmap` mapM (listItemToOpenXML opts numid) lst
935941 setFirstPara
936942 return l
937−blockToOpenXML opts (DefinitionList items) = do
943+blockToOpenXML' opts (DefinitionList items) = do
938944 l <- concat `fmap` mapM (definitionListItemToOpenXML opts) items
939945 setFirstPara
940946 return l
@@ -1027,10 +1033,13 @@ setFirstPara = modify $ \s -> s { stFirstPara = True }
10271033
10281034-- | Convert an inline element to OpenXML.
10291035inlineToOpenXML :: WriterOptions -> Inline -> WS [Element]
1030−inlineToOpenXML _ (Str str) = formattedString str
1031−inlineToOpenXML opts Space = inlineToOpenXML opts (Str " ")
1032−inlineToOpenXML opts SoftBreak = inlineToOpenXML opts (Str " ")
1033−inlineToOpenXML opts (Span (ident,classes,kvs) ils)
1036+inlineToOpenXML opts il = withDirection $ inlineToOpenXML' opts il
1037+
1038+inlineToOpenXML' :: WriterOptions -> Inline -> WS [Element]
1039+inlineToOpenXML' _ (Str str) = formattedString str
1040+inlineToOpenXML' opts Space = inlineToOpenXML opts (Str " ")
1041+inlineToOpenXML' opts SoftBreak = inlineToOpenXML opts (Str " ")
1042+inlineToOpenXML' opts (Span (ident,classes,kvs) ils)
10341043 | Just sty <- lookup dynamicStyleKey kvs = do
10351044 let kvs' = filter ((dynamicStyleKey, sty)/=) kvs
10361045 modify $ \s -> s{stDynamicTextProps = sty : (stDynamicTextProps s)}
@@ -1038,10 +1047,12 @@ inlineToOpenXML opts (Span (ident,classes,kvs) ils)
10381047 inlineToOpenXML opts (Span (ident,classes,kvs') ils)
10391048 | Just "rtl" <- lookup "dir" kvs = do
10401049 let kvs' = filter (("dir", "rtl")/=) kvs
1041− setRTL $ inlineToOpenXML opts (Span (ident,classes,kvs') ils)
1050+ local (\env -> env { envRTL = True }) $
1051+ inlineToOpenXML opts (Span (ident,classes,kvs') ils)
10421052 | Just "ltr" <- lookup "dir" kvs = do
10431053 let kvs' = filter (("dir", "ltr")/=) kvs
1044− setLTR $ inlineToOpenXML opts (Span (ident,classes,kvs') ils)
1054+ local (\env -> env { envRTL = False }) $
1055+ inlineToOpenXML opts (Span (ident,classes,kvs') ils)
10451056 | "insertion" `elem` classes = do
10461057 defaultAuthor <- asks envChangesAuthor
10471058 defaultDate <- asks envChangesDate
@@ -1072,32 +1083,32 @@ inlineToOpenXML opts (Span (ident,classes,kvs) ils)
10721083 (if "csl-no-strong" `elem` classes then off "w:b" else id) .
10731084 (if "csl-no-smallcaps" `elem` classes then off "w:smallCaps" else id))
10741085 $ inlinesToOpenXML opts ils
1075−inlineToOpenXML opts (Strong lst) =
1086+inlineToOpenXML' opts (Strong lst) =
10761087 withTextProp (mknode "w:b" [] ()) $ inlinesToOpenXML opts lst
1077−inlineToOpenXML opts (Emph lst) =
1088+inlineToOpenXML' opts (Emph lst) =
10781089 withTextProp (mknode "w:i" [] ()) $ inlinesToOpenXML opts lst
1079−inlineToOpenXML opts (Subscript lst) =
1090+inlineToOpenXML' opts (Subscript lst) =
10801091 withTextProp (mknode "w:vertAlign" [("w:val","subscript")] ())
10811092 $ inlinesToOpenXML opts lst
1082−inlineToOpenXML opts (Superscript lst) =
1093+inlineToOpenXML' opts (Superscript lst) =
10831094 withTextProp (mknode "w:vertAlign" [("w:val","superscript")] ())
10841095 $ inlinesToOpenXML opts lst
1085−inlineToOpenXML opts (SmallCaps lst) =
1096+inlineToOpenXML' opts (SmallCaps lst) =
10861097 withTextProp (mknode "w:smallCaps" [] ())
10871098 $ inlinesToOpenXML opts lst
1088−inlineToOpenXML opts (Strikeout lst) =
1099+inlineToOpenXML' opts (Strikeout lst) =
10891100 withTextProp (mknode "w:strike" [] ())
10901101 $ inlinesToOpenXML opts lst
1091−inlineToOpenXML _ LineBreak = return [br]
1092−inlineToOpenXML _ (RawInline f str)
1102+inlineToOpenXML' _ LineBreak = return [br]
1103+inlineToOpenXML' _ (RawInline f str)
10931104 | f == Format "openxml" = return [ x | Elem x <- parseXML str ]
10941105 | otherwise = return []
1095−inlineToOpenXML opts (Quoted quoteType lst) =
1106+inlineToOpenXML' opts (Quoted quoteType lst) =
10961107 inlinesToOpenXML opts $ [Str open] ++ lst ++ [Str close]
10971108 where (open, close) = case quoteType of
10981109 SingleQuote -> ("\x2018", "\x2019")
10991110 DoubleQuote -> ("\x201C", "\x201D")
1100−inlineToOpenXML opts (Math mathType str) = do
1111+inlineToOpenXML' opts (Math mathType str) = do
11011112 let displayType = if mathType == DisplayMath
11021113 then DisplayBlock
11031114 else DisplayInline
@@ -1105,8 +1116,8 @@ inlineToOpenXML opts (Math mathType str) = do
11051116 case writeOMML displayType <$> readTeX str of
11061117 Right r -> return [r]
11071118 Left _ -> inlinesToOpenXML opts (texMathToInlines mathType str)
1108−inlineToOpenXML opts (Cite _ lst) = inlinesToOpenXML opts lst
1109−inlineToOpenXML opts (Code attrs str) = do
1119+inlineToOpenXML' opts (Cite _ lst) = inlinesToOpenXML opts lst
1120+inlineToOpenXML' opts (Code attrs str) = do
11101121 let unhighlighted = intercalate [br] `fmap`
11111122 (mapM formattedString $ lines str)
11121123 formatOpenXML _fmtOpts = intercalate [br] . map (map toHlTok)
@@ -1120,7 +1131,7 @@ inlineToOpenXML opts (Code attrs str) = do
11201131 Nothing -> unhighlighted
11211132 Just h -> return h
11221133 else unhighlighted
1123−inlineToOpenXML opts (Note bs) = do
1134+inlineToOpenXML' opts (Note bs) = do
11241135 notes <- gets stFootnotes
11251136 notenum <- getUniqueId
11261137 footnoteStyle <- rStyleM "Footnote Reference"
@@ -1143,11 +1154,11 @@ inlineToOpenXML opts (Note bs) = do
11431154 [ mknode "w:rPr" [] footnoteStyle
11441155 , mknode "w:footnoteReference" [("w:id", notenum)] () ] ]
11451156-- internal link:
1146−inlineToOpenXML opts (Link _ txt ('#':xs,_)) = do
1157+inlineToOpenXML' opts (Link _ txt ('#':xs,_)) = do
11471158 contents <- withTextPropM (rStyleM "Hyperlink") $ inlinesToOpenXML opts txt
11481159 return [ mknode "w:hyperlink" [("w:anchor",xs)] contents ]
11491160-- external link:
1150−inlineToOpenXML opts (Link _ txt (src,_)) = do
1161+inlineToOpenXML' opts (Link _ txt (src,_)) = do
11511162 contents <- withTextPropM (rStyleM "Hyperlink") $ inlinesToOpenXML opts txt
11521163 extlinks <- gets stExternalLinks
11531164 id' <- case M.lookup src extlinks of
@@ -1158,7 +1169,7 @@ inlineToOpenXML opts (Link _ txt (src,_)) = do
11581169 M.insert src i extlinks }
11591170 return i
11601171 return [ mknode "w:hyperlink" [("r:id",id')] contents ]
1161−inlineToOpenXML opts (Image attr alt (src, _)) = do
1172+inlineToOpenXML' opts (Image attr alt (src, _)) = do
11621173 -- first, check to see if we've already done this image
11631174 pageWidth <- gets stPrintWidth
11641175 imgs <- gets stImages
@@ -1269,28 +1280,23 @@ fitToPage (x, y) pageWidth
12691280 (pageWidth, floor $ ((fromIntegral pageWidth) / x) * y)
12701281 | otherwise = (floor x, floor y)
12711282
1272−setRTL :: WS a -> WS a
1273−setRTL x = do
1274− isRTL <- asks envRTL
1275− if isRTL
1276− then x
1277− else flip local x $ \env -> env {
1278− envRTL = True
1279− , envParaProperties = (mknode "w:bidi" [] ()) : envParaProperties env
1280− , envTextProperties = (mknode "w:rtl" [] ()) : envTextProperties env
1281− }
1282−
1283+withDirection :: WS a -> WS a
1284+withDirection x = do
1285+ isDir <- asks envRTL
1286+ paraProps <- asks envParaProperties
1287+ textProps <- asks envTextProperties
1288+ -- we have to do this because we don't want to accumulate these
1289+ -- properties if we have it set while the environment is already
1290+ -- active.
1291+ let paraProps' = filter (\e -> (qName . elName) e /= "bidi") paraProps
1292+ textProps' = filter (\e -> (qName . elName) e /= "rtl") textProps
1293+ if isDir
1294+ then flip local x $
1295+ \env -> env { envParaProperties = (mknode "w:bidi" [] ()) : paraProps'
1296+ , envTextProperties = (mknode "w:rtl" [] ()) : textProps'
1297+ }
1298+ else flip local x $ \env -> env { envParaProperties = paraProps'
1299+ , envTextProperties = textProps'
1300+ }
1301+
12831302
1284−setLTR :: WS a -> WS a
1285−setLTR x = do
1286− isRTL <- asks envRTL
1287− if isRTL
1288− then do paraProps <- asks envParaProperties
1289− textProps <- asks envTextProperties
1290− let paraProps' = filter (\e -> (qName . elName) e /= "bidi") paraProps
1291− textProps' = filter (\e -> (qName . elName) e /= "rtl") textProps
1292− flip local x $ \env -> env { envRTL = False
1293− , envParaProperties = paraProps'
1294− , envTextProperties = textProps'
1295− }
1296− else x