From 5ada5cceaceb05316dbb7241bca7d3effb4d9767 Mon Sep 17 00:00:00 2001
From: Jesse Rosenthal <jrosenthal@jhu.edu>
Date: Fri, 23 Feb 2018 14:23:14 -0500
Subject: [PATCH] Docx reader: Don't look up dependant run styles if +styles is
enabled.
It makes more sense not to interpret -- otherwise using the original
document as the reference-doc would produce two of everything: the
interpreted version and the uninterpreted style version.
---
MANUAL.txt | 4 +-
src/Text/Pandoc/Readers/Docx.hs | 75 ++++++++++++-----------
test/docx/custom-style-with-styles.native | 2 +-
3 files changed, 42 insertions(+), 39 deletions(-)
diff --git a/MANUAL.txt b/MANUAL.txt
index 144ec8494..cf95d8f6c 100644
--- a/MANUAL.txt
+++ b/MANUAL.txt
@@ -4562,8 +4562,8 @@ And with the extension:
:::
::: {custom-style="BodyText"}
- This is text with an [*emphasized*]{custom-style="Emphatic"} text style.
- And this is text with a [**strengthened**]{custom-style="Strengthened"}
+ This is text with an [emphasized]{custom-style="Emphatic"} text style.
+ And this is text with a [strengthened]{custom-style="Strengthened"}
text style.
:::
diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs
index 5f2ca0fff..f1683a394 100644
--- a/src/Text/Pandoc/Readers/Docx.hs
+++ b/src/Text/Pandoc/Readers/Docx.hs
@@ -252,33 +252,36 @@ parPartToString _ = ""
blacklistedCharStyles :: [String]
blacklistedCharStyles = ["Hyperlink"]
-resolveDependentRunStyle :: RunStyle -> RunStyle
+resolveDependentRunStyle :: PandocMonad m => RunStyle -> DocxContext m RunStyle
resolveDependentRunStyle rPr
| Just (s, _) <- rStyle rPr, s `elem` blacklistedCharStyles =
- rPr
- | Just (_, cs) <- rStyle rPr =
- let rPr' = resolveDependentRunStyle cs
- in
- RunStyle { isBold = case isBold rPr of
- Just bool -> Just bool
- Nothing -> isBold rPr'
- , isItalic = case isItalic rPr of
- Just bool -> Just bool
- Nothing -> isItalic rPr'
- , isSmallCaps = case isSmallCaps rPr of
- Just bool -> Just bool
- Nothing -> isSmallCaps rPr'
- , isStrike = case isStrike rPr of
- Just bool -> Just bool
- Nothing -> isStrike rPr'
- , rVertAlign = case rVertAlign rPr of
- Just valign -> Just valign
- Nothing -> rVertAlign rPr'
- , rUnderline = case rUnderline rPr of
- Just ulstyle -> Just ulstyle
- Nothing -> rUnderline rPr'
- , rStyle = rStyle rPr }
- | otherwise = rPr
+ return rPr
+ | Just (_, cs) <- rStyle rPr = do
+ opts <- asks docxOptions
+ if isEnabled Ext_styles opts
+ then return rPr
+ else do rPr' <- resolveDependentRunStyle cs
+ return $
+ RunStyle { isBold = case isBold rPr of
+ Just bool -> Just bool
+ Nothing -> isBold rPr'
+ , isItalic = case isItalic rPr of
+ Just bool -> Just bool
+ Nothing -> isItalic rPr'
+ , isSmallCaps = case isSmallCaps rPr of
+ Just bool -> Just bool
+ Nothing -> isSmallCaps rPr'
+ , isStrike = case isStrike rPr of
+ Just bool -> Just bool
+ Nothing -> isStrike rPr'
+ , rVertAlign = case rVertAlign rPr of
+ Just valign -> Just valign
+ Nothing -> rVertAlign rPr'
+ , rUnderline = case rUnderline rPr of
+ Just ulstyle -> Just ulstyle
+ Nothing -> rUnderline rPr'
+ , rStyle = rStyle rPr }
+ | otherwise = return rPr
extraRunStyleInfo :: PandocMonad m => RunStyle -> DocxContext m (Inlines -> Inlines)
extraRunStyleInfo rPr
@@ -337,18 +340,18 @@ runStyleToTransform rPr
runToInlines :: PandocMonad m => Run -> DocxContext m Inlines
runToInlines (Run rs runElems)
| Just (s, _) <- rStyle rs
- , s `elem` codeStyles =
- let rPr = resolveDependentRunStyle rs
- codeString = code $ concatMap runElemToString runElems
- in
- return $ case rVertAlign rPr of
- Just SupScrpt -> superscript codeString
- Just SubScrpt -> subscript codeString
- _ -> codeString
+ , s `elem` codeStyles = do
+ rPr <- resolveDependentRunStyle rs
+ let codeString = code $ concatMap runElemToString runElems
+ return $ case rVertAlign rPr of
+ Just SupScrpt -> superscript codeString
+ Just SubScrpt -> subscript codeString
+ _ -> codeString
| otherwise = do
- let ils = smushInlines (map runElemToInlines runElems)
- transform <- runStyleToTransform $ resolveDependentRunStyle rs
- return $ transform ils
+ rPr <- resolveDependentRunStyle rs
+ let ils = smushInlines (map runElemToInlines runElems)
+ transform <- runStyleToTransform rPr
+ return $ transform ils
runToInlines (Footnote bps) = do
blksList <- smushBlocks <$> mapM bodyPartToBlocks bps
return $ note blksList
diff --git a/test/docx/custom-style-with-styles.native b/test/docx/custom-style-with-styles.native
index 6b0381408..61f11911d 100644
--- a/test/docx/custom-style-with-styles.native
+++ b/test/docx/custom-style-with-styles.native
@@ -1,7 +1,7 @@
[Div ("",[],[("custom-style","FirstParagraph")])
[Para [Str "This",Space,Str "is",Space,Str "some",Space,Str "text."]]
,Div ("",[],[("custom-style","BodyText")])
- [Para [Str "This",Space,Str "is",Space,Str "text",Space,Str "with",Space,Str "an",Space,Span ("",[],[("custom-style","Emphatic")]) [Emph [Str "emphasized"]],Space,Str "text",Space,Str "style.",Space,Str "And",Space,Str "this",Space,Str "is",Space,Str "text",Space,Str "with",Space,Str "a",Space,Span ("",[],[("custom-style","Strengthened")]) [Strong [Str "strengthened"]],Space,Str "text",Space,Str "style."]]
+ [Para [Str "This",Space,Str "is",Space,Str "text",Space,Str "with",Space,Str "an",Space,Span ("",[],[("custom-style","Emphatic")]) [Str "emphasized"],Space,Str "text",Space,Str "style.",Space,Str "And",Space,Str "this",Space,Str "is",Space,Str "text",Space,Str "with",Space,Str "a",Space,Span ("",[],[("custom-style","Strengthened")]) [Str "strengthened"],Space,Str "text",Space,Str "style."]]
,Div ("",[],[("custom-style","MyBlockStyle")])
[BlockQuote
[Para [Str "Here",Space,Str "is",Space,Str "a",Space,Str "styled",Space,Str "paragraph",Space,Str "that",Space,Str "inherits",Space,Str "from",Space,Str "Block",Space,Str "Text."]]]]