diff options
| author | Jesse Rosenthal <jrosenthal@jhu.edu> | 2016-08-15 12:52:54 -0400 |
|---|---|---|
| committer | Jesse Rosenthal <jrosenthal@jhu.edu> | 2016-08-15 13:56:45 -0400 |
| commit | 2870c9be0028140991e7c672895b484ec2931102 (patch) | |
| tree | 1cfd6fb2beaefca00de3bd720a15d5751e81130c /src/Text/Pandoc/Writers | |
| parent | 66d393ae7ad4199333ef1e61c0c012c169bea093 (diff) | |
| download | pandoc-2870c9be0028140991e7c672895b484ec2931102.tar.gz | |
Docx writer: Inject text properties as well.
Diffstat (limited to 'src/Text/Pandoc/Writers')
| -rw-r--r-- | src/Text/Pandoc/Writers/Docx.hs | 23 |
1 files changed, 20 insertions, 3 deletions
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 = |