aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Text/Pandoc/Writers/Docx.hs25
1 files changed, 24 insertions, 1 deletions
diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs
index 04daf3b4b..5e4fe7731 100644
--- a/src/Text/Pandoc/Writers/Docx.hs
+++ b/src/Text/Pandoc/Writers/Docx.hs
@@ -72,6 +72,7 @@ import Text.Pandoc.Writers.Shared (fixDisplayMath)
import Text.Printf (printf)
import Text.TeXMath
import Text.XML.Light as XML
+import Text.XML.Light.Cursor as XMLC
data ListMarker = NoMarker
| BulletMarker
@@ -256,8 +257,30 @@ writeDocx opts doc@(Pandoc meta _) = do
)
-- styles
+ let lang = case lookupMeta "lang" meta of
+ Just (MetaInlines [Str s]) -> Just s
+ Just (MetaString s) -> Just s
+ _ -> Nothing
+ let addLang :: Element -> Element
+ addLang e = case lang >>= \l -> (return . XMLC.toTree . go l . XMLC.fromElement) e of
+ Just (Elem e') -> e'
+ _ -> e -- return original
+ where go :: String -> Cursor -> Cursor
+ go l cursor = case XMLC.findRec (isLangElt . current) cursor of
+ Nothing -> cursor
+ Just t -> XMLC.modifyContent (setval l) t
+ setval :: String -> Content -> Content
+ setval l (Elem e') = Elem $ e'{ elAttribs = map (setvalattr l) $
+ elAttribs e' }
+ setval _ x = x
+ setvalattr :: String -> XML.Attr -> XML.Attr
+ setvalattr l (XML.Attr qn@(QName "val" _ _) _) = XML.Attr qn l
+ setvalattr _ x = x
+ isLangElt (Elem e') = qName (elName e') == "lang"
+ isLangElt _ = False
+
let stylepath = "word/styles.xml"
- styledoc <- parseXml refArchive distArchive stylepath
+ styledoc <- addLang <$> parseXml refArchive distArchive stylepath
-- parse styledoc for heading styles
let styleMaps = getStyleMaps styledoc