git.iko.soy/typeable/pandoc
on master help sign in
Docx writer: Inject new paragraph properties
59bc1e6Jesse Rosenthal
src/Text/Pandoc/Writers/Docx.hs+23−4
compare with master
unifiedsplit
@@ -64,8 +64,8 @@ import Text.Pandoc.Compat.Monoid ((<>))
64import Text.Pandoc.MIME (MimeType, getMimeType, getMimeTypeDef,
64import Text.Pandoc.MIME (MimeType, getMimeType, getMimeTypeDef,
65 extensionFromMimeType)
65 extensionFromMimeType)
66import Control.Applicative ((<|>))
66import Control.Applicative ((<|>))
67−import Data.Maybe (fromMaybe, mapMaybe, maybeToList)
67+import Data.Maybe (fromMaybe, mapMaybe, maybeToList, isNothing)
68−import Data.Char (ord)
68+import Data.Char (ord, isSpace, toLower)
69
69
70data ListMarker = NoMarker
70data ListMarker = NoMarker
71 | BulletMarker
71 | BulletMarker
@@ -405,8 +405,14 @@ writeDocx opts doc@(Pandoc meta _) = do
405 $ renderXml $ mknode "Relationships" [("xmlns","http://schemas.openxmlformats.org/package/2006/relationships")]
405 $ renderXml $ mknode "Relationships" [("xmlns","http://schemas.openxmlformats.org/package/2006/relationships")]
406 linkrels
406 linkrels
407
407
408− -- styles
408+ -- styles We only want to inject paragraph properties that are not
409+ -- already in the style map. Note that keys in the stylemap are
410+ -- normalized as lowercase.
411+ let newDynamicParaProps = filter
412+ (\sty -> isNothing $ M.lookup (toLower <$> sty) $ getMap $ sParaStyleMap styleMaps)
413+ (stDynamicParaProps st)
414+ let newstyles = map newParaPropToOpenXml newDynamicParaProps ++
409− let newstyles = styleToOpenXml styleMaps $ writerHighlightStyle opts
415+ (styleToOpenXml styleMaps $ writerHighlightStyle opts)
410 let styledoc' = styledoc{ elContent = modifyContent (elContent styledoc) }
416 let styledoc' = styledoc{ elContent = modifyContent (elContent styledoc) }
411 where
417 where
412 modifyContent
418 modifyContent
@@ -501,6 +507,19 @@ writeDocx opts doc@(Pandoc meta _) = do
501 miscRelEntries ++ otherMediaEntries
507 miscRelEntries ++ otherMediaEntries
502 return $ fromArchive archive
508 return $ fromArchive archive
503
509
510+
511+newParaPropToOpenXml :: String -> Element
512+newParaPropToOpenXml s =
513+ let styleId = filter (not . isSpace) s
514+ in mknode "w:style" [ ("w:type", "paragraph")
515+ , ("w:customStyle", "1")
516+ , ("w:styleId", styleId)]
517+ [ mknode "w:name" [("w:val", s)] ()
518+ , mknode "w:basedOn" [("w:val","BodyText")] ()
519+ , mknode "w:qFormat" [] ()
520+ ]
521+
522+
504styleToOpenXml :: StyleMaps -> Style -> [Element]
523styleToOpenXml :: StyleMaps -> Style -> [Element]
505styleToOpenXml sm style =
524styleToOpenXml sm style =
506 maybeToList parStyle ++ mapMaybe toStyle alltoktypes
525 maybeToList parStyle ++ mapMaybe toStyle alltoktypes