From 2870c9be0028140991e7c672895b484ec2931102 Mon Sep 17 00:00:00 2001
From: Jesse Rosenthal <jrosenthal@jhu.edu>
Date: Mon, 15 Aug 2016 12:52:54 -0400
Subject: Docx writer: Inject text properties as well.

---
 src/Text/Pandoc/Writers/Docx.hs | 23 ++++++++++++++++++++---
 1 file changed, 20 insertions(+), 3 deletions(-)

(limited to 'src/Text')

diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs
index 63ea3d07e..fd2670206 100644
--- a/src/Text/Pandoc/Writers/Docx.hs
+++ b/src/Text/Pandoc/Writers/Docx.hs
@@ -407,13 +407,21 @@ writeDocx opts doc@(Pandoc meta _) = do
         $ renderXml $ mknode "Relationships" [("xmlns","http://schemas.openxmlformats.org/package/2006/relationships")]
         linkrels
 
-  -- styles We only want to inject paragraph properties that are not
-  -- already in the style map. Note that keys in the stylemap are
-  -- normalized as lowercase.
+  -- styles
+
+  -- We only want to inject paragraph and text properties that
+  -- are not already in the style map. Note that keys in the stylemap
+  -- are normalized as lowercase.
   let newDynamicParaProps = filter
         (\sty -> isNothing $ M.lookup (toLower <$> sty) $ getMap $ sParaStyleMap styleMaps)
         (stDynamicParaProps st)
+
+      newDynamicTextProps = filter
+        (\sty -> isNothing $ M.lookup (toLower <$> sty) $ getMap $ sCharStyleMap styleMaps)
+        (stDynamicTextProps st)
+
   let newstyles = map newParaPropToOpenXml newDynamicParaProps ++
+                  map newTextPropToOpenXml newDynamicTextProps ++
                   (styleToOpenXml styleMaps $ writerHighlightStyle opts) 
   let styledoc' = styledoc{ elContent = modifyContent (elContent styledoc) }
                   where
@@ -521,6 +529,15 @@ newParaPropToOpenXml s =
      , mknode "w:qFormat" [] ()
      ]
 
+newTextPropToOpenXml :: String -> Element
+newTextPropToOpenXml s =
+  let styleId = filter (not . isSpace) s
+  in mknode "w:style" [ ("w:type", "character")
+                      , ("w:customStyle", "1")
+                      , ("w:styleId", styleId)]
+     [ mknode "w:name" [("w:val", s)] ()
+     , mknode "w:basedOn" [("w:val","BodyTextChar")] ()
+     ]
 
 styleToOpenXml :: StyleMaps -> Style -> [Element]
 styleToOpenXml sm style =
-- 
cgit v1.2.3