diff options
-rw-r--r-- | MANUAL.txt | 4 | ||||
-rw-r--r-- | src/Text/Pandoc/Readers/Docx.hs | 75 | ||||
-rw-r--r-- | 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."]]]] |