aboutsummaryrefslogtreecommitdiff
path: root/src/Text
diff options
context:
space:
mode:
authorMauro Bieg <mb21@users.noreply.github.com>2017-03-20 10:06:24 +0100
committerJohn MacFarlane <jgm@berkeley.edu>2017-03-20 10:06:24 +0100
commitb010a8c5e7ba4969100fe078f0f9a1a6cdaf7c5c (patch)
tree174283a1cdd8ee3ae3e4278b093c288b7585a124 /src/Text
parent34412cf57c904f5729f96553ed9481869dde7358 (diff)
downloadpandoc-b010a8c5e7ba4969100fe078f0f9a1a6cdaf7c5c.tar.gz
docx writer: lang meta, see #1667 (#3515)
Diffstat (limited to 'src/Text')
-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