aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--MANUAL.txt6
-rw-r--r--src/Text/Pandoc/Writers/Docx.hs77
-rw-r--r--test/Tests/Writers/Docx.hs4
-rw-r--r--test/docx/custom-style-preserve.native15
-rw-r--r--test/docx/golden/custom_style_preserve.docxbin0 -> 10595 bytes
-rw-r--r--test/docx/golden/document-properties.docxbin10358 -> 10350 bytes
6 files changed, 78 insertions, 24 deletions
diff --git a/MANUAL.txt b/MANUAL.txt
index 8b9e02da2..3c9f158ef 100644
--- a/MANUAL.txt
+++ b/MANUAL.txt
@@ -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.
diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs
index b41b17ff9..02db23db5 100644
--- a/src/Text/Pandoc/Writers/Docx.hs
+++ b/src/Text/Pandoc/Writers/Docx.hs
@@ -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]
diff --git a/test/Tests/Writers/Docx.hs b/test/Tests/Writers/Docx.hs
index c958ddf7d..9e1414c40 100644
--- a/test/Tests/Writers/Docx.hs
+++ b/test/Tests/Writers/Docx.hs
@@ -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)"
diff --git a/test/docx/custom-style-preserve.native b/test/docx/custom-style-preserve.native
new file mode 100644
index 000000000..859f71c20
--- /dev/null
+++ b/test/docx/custom-style-preserve.native
@@ -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 "..."]]]]]]
diff --git a/test/docx/golden/custom_style_preserve.docx b/test/docx/golden/custom_style_preserve.docx
new file mode 100644
index 000000000..06371d51e
--- /dev/null
+++ b/test/docx/golden/custom_style_preserve.docx
Binary files differ
diff --git a/test/docx/golden/document-properties.docx b/test/docx/golden/document-properties.docx
index 00c78bc0f..8bb498e02 100644
--- a/test/docx/golden/document-properties.docx
+++ b/test/docx/golden/document-properties.docx
Binary files differ
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-01 18:43:38 +0000