Tissevert/pandoc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 1

Preserve built-in styles in DOCX with custom style (#5670)

Browse source 
This commit prevents custom styles on divs and spans from overriding
styles on certain elements inside them, like headings, blockquotes,
and links. On those elements, the "native" style is required for the
element to display correctly. This change also allows nesting of
custom styles; in order to do so, it removes the default "Compact"
style applied to Plain blocks, except when inside a table.
This commit is contained in:
Ben Steinberg 2019-09-21 01:13:29 -04:00 committed by John MacFarlane
parent 5ebd5105ad
commit 7389919bb4
6 changed files with 78 additions and 24 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
MANUAL.txt
View file

@ -5255,8 +5255,10 @@ styles, pandoc allows you to define custom styles for blocks and text
using `div`s and `span`s, respectively.
If you define a `div` or `span` with the attribute `custom-style`,
pandoc will apply your specified style to the contained elements. So,
for example using the `bracketed_spans` syntax,
pandoc will apply your specified style to the contained elements (with
the exception of elements whose function depends on a style, like
headings, code blocks, block quotes, or links). So, for example, using
the `bracketed_spans` syntax,
[Get out]{custom-style="Emphatically"}, he said.

77
src/Text/Pandoc/Writers/Docx.hs
View file

@ -81,8 +81,23 @@ listMarkerToId (NumberMarker sty delim n) =
OneParen -> '2'
TwoParens -> '3'
data WriterEnv = WriterEnv{ envTextProperties :: [Element]
, envParaProperties :: [Element]
data EnvProps = EnvProps{ styleElement :: Maybe Element
, otherElements :: [Element]
}
instance Semigroup EnvProps where
EnvProps Nothing es <> EnvProps s es' = EnvProps s (es ++ es')
EnvProps s es <> EnvProps _ es' = EnvProps s (es ++ es')
instance Monoid EnvProps where
mempty = EnvProps Nothing []
squashProps :: EnvProps -> [Element]
squashProps (EnvProps Nothing es) = es
squashProps (EnvProps (Just e) es) = e : es
data WriterEnv = WriterEnv{ envTextProperties :: EnvProps
, envParaProperties :: EnvProps
, envRTL :: Bool
, envListLevel :: Int
, envListNumId :: Int
@ -93,8 +108,8 @@ data WriterEnv = WriterEnv{ envTextProperties :: [Element]
}
defaultWriterEnv :: WriterEnv
defaultWriterEnv = WriterEnv{ envTextProperties = []
, envParaProperties = []
defaultWriterEnv = WriterEnv{ envTextProperties = mempty
, envParaProperties = mempty
, envRTL = False
, envListLevel = -1
, envListNumId = 1
@ -115,6 +130,7 @@ data WriterState = WriterState{
, stDelId :: Int
, stStyleMaps :: StyleMaps
, stFirstPara :: Bool
, stInTable :: Bool
, stTocTitle :: [Inline]
, stDynamicParaProps :: Set.Set String
, stDynamicTextProps :: Set.Set String
@ -133,6 +149,7 @@ defaultWriterState = WriterState{
, stDelId = 1
, stStyleMaps = defaultStyleMaps
, stFirstPara = False
, stInTable = False
, stTocTitle = [Str "Table of Contents"]
, stDynamicParaProps = Set.empty
, stDynamicTextProps = Set.empty
@ -496,7 +513,7 @@ writeDocx opts doc@(Pandoc meta _) = do
case key' of
"description" -> intercalate "_x000d_\n" (map stringify $ lookupMetaBlocks "description" meta')
_ -> lookupMetaString key' meta'
let docProps = mknode "cp:coreProperties"
[("xmlns:cp","http://schemas.openxmlformats.org/package/2006/metadata/core-properties")
,("xmlns:dc","http://purl.org/dc/elements/1.1/")
@ -901,8 +918,12 @@ blockToOpenXML' opts (Header lev (ident,_,_) lst) = do
$ stSectionIds s }
bookmarkedContents <- wrapBookmark bookmarkName contents
return [mknode "w:p" [] (paraProps ++ bookmarkedContents)]
blockToOpenXML' opts (Plain lst) = withParaProp (pCustomStyle "Compact")
$ blockToOpenXML opts (Para lst)
blockToOpenXML' opts (Plain lst) = do
isInTable <- gets stInTable
let block = blockToOpenXML opts (Para lst)
para <- if isInTable then withParaProp (pCustomStyle "Compact") block else block
return $ para
-- title beginning with fig: indicates that the image is a figure
blockToOpenXML' opts (Para [Image attr alt (src,'f':'i':'g':':':tit)]) = do
setFirstPara
@ -910,7 +931,7 @@ blockToOpenXML' opts (Para [Image attr alt (src,'f':'i':'g':':':tit)]) = do
if null alt
then "Figure"
else "CaptionedFigure"
paraProps <- local (\env -> env { envParaProperties = prop : envParaProperties env }) (getParaProps False)
paraProps <- local (\env -> env { envParaProperties = EnvProps (Just prop) [] <> envParaProperties env }) (getParaProps False)
contents <- inlinesToOpenXML opts [Image attr alt (src,tit)]
captionNode <- withParaProp (pCustomStyle "ImageCaption")
$ blockToOpenXML opts (Para alt)
@ -939,7 +960,8 @@ blockToOpenXML' _ b@(RawBlock format str)
report $ BlockNotRendered b
return []
blockToOpenXML' opts (BlockQuote blocks) = do
p <- withParaPropM (pStyleM "Block Text") $ blocksToOpenXML opts blocks
p <- withParaPropM (pStyleM "Block Text")
$ blocksToOpenXML opts blocks
setFirstPara
return p
blockToOpenXML' opts (CodeBlock attrs@(ident, _, _) str) = do
@ -955,6 +977,7 @@ blockToOpenXML' _ HorizontalRule = do
("o:hrstd","t"),("o:hr","t")] () ]
blockToOpenXML' opts (Table caption aligns widths headers rows) = do
setFirstPara
modify $ \s -> s { stInTable = True }
let captionStr = stringify caption
caption' <- if null caption
then return []
@ -990,6 +1013,7 @@ blockToOpenXML' opts (Table caption aligns widths headers rows) = do
let mkgridcol w = mknode "w:gridCol"
[("w:w", show (floor (textwidth * w) :: Integer))] ()
let hasHeader = not (all null headers)
modify $ \s -> s { stInTable = False }
return $
caption' ++
[mknode "w:tbl" []
@ -1063,16 +1087,22 @@ withNumId numid = local $ \env -> env{ envListNumId = numid }
asList :: (PandocMonad m) => WS m a -> WS m a
asList = local $ \env -> env{ envListLevel = envListLevel env + 1 }
isStyle :: Element -> Bool
isStyle e = isElem [] "w" "rStyle" e ||
isElem [] "w" "pStyle" e
getTextProps :: (PandocMonad m) => WS m [Element]
getTextProps = do
props <- asks envTextProperties
return $ if null props
let squashed = squashProps props
return $ if null squashed
then []
else [mknode "w:rPr" [] props]
else [mknode "w:rPr" [] squashed]
withTextProp :: PandocMonad m => Element -> WS m a -> WS m a
withTextProp d p =
local (\env -> env {envTextProperties = d : envTextProperties env}) p
local (\env -> env {envTextProperties = ep <> envTextProperties env}) p
where ep = if isStyle d then EnvProps (Just d) [] else EnvProps Nothing [d]
withTextPropM :: PandocMonad m => WS m Element -> WS m a -> WS m a
withTextPropM = (. flip withTextProp) . (>>=)
@ -1085,13 +1115,14 @@ getParaProps displayMathPara = do
let listPr = [mknode "w:numPr" []
[ mknode "w:ilvl" [("w:val",show listLevel)] ()
, mknode "w:numId" [("w:val",show numid)] () ] | listLevel >= 0 && not displayMathPara]
return $ case listPr ++ props of
return $ case listPr ++ squashProps props of
[] -> []
ps -> [mknode "w:pPr" [] ps]
withParaProp :: PandocMonad m => Element -> WS m a -> WS m a
withParaProp d p =
local (\env -> env {envParaProperties = d : envParaProperties env}) p
local (\env -> env {envParaProperties = ep <> envParaProperties env}) p
where ep = if isStyle d then EnvProps (Just d) [] else EnvProps Nothing [d]
withParaPropM :: PandocMonad m => WS m Element -> WS m a -> WS m a
withParaPropM = (. flip withParaProp) . (>>=)
@ -1264,8 +1295,8 @@ inlineToOpenXML' opts (Note bs) = do
insertNoteRef xs = Para [notemarkerXml] : xs
contents <- local (\env -> env{ envListLevel = -1
, envParaProperties = []
, envTextProperties = [] })
, envParaProperties = mempty
, envTextProperties = mempty })
(withParaPropM (pStyleM "Footnote Text") $ blocksToOpenXML opts
$ insertNoteRef bs)
let newnote = mknode "w:footnote" [("w:id", notenum)] contents
@ -1417,16 +1448,18 @@ withDirection x = do
-- We want to clean all bidirection (bidi) and right-to-left (rtl)
-- properties from the props first. This is because we don't want
-- them to stack up.
let paraProps' = filter (\e -> (qName . elName) e /= "bidi") paraProps
textProps' = filter (\e -> (qName . elName) e /= "rtl") textProps
let paraProps' = filter (\e -> (qName . elName) e /= "bidi") (otherElements paraProps)
textProps' = filter (\e -> (qName . elName) e /= "rtl") (otherElements textProps)
paraStyle = styleElement paraProps
textStyle = styleElement textProps
if isRTL
-- if we are going right-to-left, we (re?)add the properties.
then flip local x $
\env -> env { envParaProperties = mknode "w:bidi" [] () : paraProps'
, envTextProperties = mknode "w:rtl" [] () : textProps'
\env -> env { envParaProperties = EnvProps paraStyle $ mknode "w:bidi" [] () : paraProps'
, envTextProperties = EnvProps textStyle $ mknode "w:rtl" [] () : textProps'
}
else flip local x $ \env -> env { envParaProperties = paraProps'
, envTextProperties = textProps'
else flip local x $ \env -> env { envParaProperties = EnvProps paraStyle paraProps'
, envTextProperties = EnvProps textStyle textProps'
}
wrapBookmark :: (PandocMonad m) => String -> [Element] -> WS m [Element]

4
test/Tests/Writers/Docx.hs
View file

@ -155,6 +155,10 @@ tests = [ testGroup "inlines"
def{writerReferenceDoc = Just "docx/custom-style-reference.docx"}
"docx/custom_style.native"
"docx/golden/custom_style_reference.docx"
, docxTest "suppress custom style for headers and blockquotes"
def
"docx/custom-style-preserve.native"
"docx/golden/custom_style_preserve.docx"
]
, testGroup "metadata"
[ docxTest "document properties (core, custom)"

15
test/docx/custom-style-preserve.native Normal file
View file

@ -0,0 +1,15 @@
[Para [Span ("",[],[("custom-style","MyStyle")]) [Str "This",Space,Str "span",Note [Para [Str "Neither",Space,Str "footnote",Space,Str "nor",Space,Str "footnote",Space,Str "reference",Space,Str "should",Space,Str "get",Space,Str "a",Space,Str "custom",Space,Str "style",Space,Str "from",Space,Str "its",Space,Str "span."]],Space,Str "should",Space,Str "have",Space,Str "a",Space,Str "custom",Space,Str "style",Space,Str "(",Link ("",[],[]) [Str "link"] ("http://example.com/",""),Str "),"],Space,Str "but",Space,Str "the",Space,Str "text",Space,Str "after",Space,Str "the",Space,Str "comma",Space,Str "shouldn\8217t,",Space,Str "nor",Space,Str "should",Space,Str "the",Space,Str "link."]
,Div ("",[],[("custom-style","MyOtherStyle")])
[Para [Str "The",Space,Str "contents",Space,Str "of",Space,Str "this",Space,Str "div",Space,Str "should",Space,Str "have",Space,Str "a",Space,Str "custom",Space,Str "style,",Space,Str "but",Space,Link ("",[],[]) [Str "this",Space,Str "link",Space,Str "should",Space,Str "not"] ("http://example.com/",""),Str "."]
,Header 2 ("this-header-should-not-have-the-divs-custom-style",[],[]) [Str "This",Space,Str "header",Space,Str "should",Space,Str "not",Space,Str "have",Space,Str "the",Space,Str "div\8217s",Space,Str "custom",Space,Str "style"]
,BlockQuote
[Para [Str "This",Space,Str "blockquote",Space,Str "should",Space,Str "not."]]
,CodeBlock ("",[],[]) "# This code block should not."
,Para [Str "But",Space,Str "this",Space,Str "paragraph",Space,Str "should.",Note [Para [Str "Neither",Space,Str "footnote",Space,Str "nor",Space,Str "footnote",Space,Str "reference",Space,Str "should",Space,Str "get",Space,Str "a",Space,Str "custom",Space,Str "style",Space,Str "from",Space,Str "its",Space,Str "div."]]]]
,Div ("",[],[("custom-style","MyOuterStyle")])
[Div ("",[],[("custom-style","MyInnerStyle")])
[Para [Str "This",Space,Str "should",Space,Str "have",Space,Str "MyInnerStyle."]
,Header 3 ("this-heading-should-not",[],[]) [Str "This",Space,Str "heading",Space,Str "should",Space,Str "not"]]
,Para [Str "This",Space,Str "should",Space,Str "have",Space,Str "MyOuterStyle,",Space,Str "but",Space,Str "the",Space,Str "following",Space,Str "elision",Space,Str "should",Space,Str "have",Space,Str "its",SoftBreak,Str "own",Space,Str "style.",Space,Span ("",[],[("custom-style","Elision")]) [Str "..."]]
,BlockQuote
[Para [Str "This",Space,Str "blockquote",Space,Str "should",Space,Str "include",Space,Strong [Str "bold",Space,Str "text",Space,Str "with",Space,Str "an",Space,Str "elision:",SoftBreak,Span ("",[],[("custom-style","Elision")]) [Str "..."]]]]]]

BIN
test/docx/golden/custom_style_preserve.docx Normal file
View file

Binary file not shown.

BIN
test/docx/golden/document-properties.docx
View file

Binary file not shown.