From b010a8c5e7ba4969100fe078f0f9a1a6cdaf7c5c Mon Sep 17 00:00:00 2001
From: Mauro Bieg <mb21@users.noreply.github.com>
Date: Mon, 20 Mar 2017 10:06:24 +0100
Subject: [PATCH] docx writer: lang meta, see #1667 (#3515)
---
src/Text/Pandoc/Writers/Docx.hs | 25 ++++++++++++++++++++++++-
1 file changed, 24 insertions(+), 1 deletion(-)
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