diff options
Diffstat (limited to 'src/Text/Pandoc/Readers/Docx.hs')
-rw-r--r-- | src/Text/Pandoc/Readers/Docx.hs | 88 |
1 files changed, 47 insertions, 41 deletions
diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs index c06adf7e3..5c8f20c18 100644 --- a/src/Text/Pandoc/Readers/Docx.hs +++ b/src/Text/Pandoc/Readers/Docx.hs @@ -246,8 +246,8 @@ runToText _ = "" parPartToText :: ParPart -> T.Text parPartToText (PlainRun run) = runToText run -parPartToText (InternalHyperLink _ runs) = T.concat $ map runToText runs -parPartToText (ExternalHyperLink _ runs) = T.concat $ map runToText runs +parPartToText (InternalHyperLink _ children) = T.concat $ map parPartToText children +parPartToText (ExternalHyperLink _ children) = T.concat $ map parPartToText children parPartToText _ = "" blacklistedCharStyles :: [CharStyleName] @@ -322,6 +322,7 @@ runToInlines (InlineDrawing fp title alt bs ext) = do (lift . lift) $ P.insertMedia fp Nothing bs return $ imageWith (extentToAttr ext) (T.pack fp) title $ text alt runToInlines InlineChart = return $ spanWith ("", ["chart"], []) $ text "[CHART]" +runToInlines InlineDiagram = return $ spanWith ("", ["diagram"], []) $ text "[DIAGRAM]" extentToAttr :: Extent -> Attr extentToAttr (Just (w, h)) = @@ -434,18 +435,21 @@ parPartToInlines' (Drawing fp title alt bs ext) = do return $ imageWith (extentToAttr ext) (T.pack fp) title $ text alt parPartToInlines' Chart = return $ spanWith ("", ["chart"], []) $ text "[CHART]" -parPartToInlines' (InternalHyperLink anchor runs) = do - ils <- smushInlines <$> mapM runToInlines runs +parPartToInlines' Diagram = + return $ spanWith ("", ["diagram"], []) $ text "[DIAGRAM]" +parPartToInlines' (InternalHyperLink anchor children) = do + ils <- smushInlines <$> mapM parPartToInlines' children return $ link ("#" <> anchor) "" ils -parPartToInlines' (ExternalHyperLink target runs) = do - ils <- smushInlines <$> mapM runToInlines runs +parPartToInlines' (ExternalHyperLink target children) = do + ils <- smushInlines <$> mapM parPartToInlines' children return $ link target "" ils parPartToInlines' (PlainOMath exps) = return $ math $ writeTeX exps -parPartToInlines' (Field info runs) = +parPartToInlines' (Field info children) = case info of - HyperlinkField url -> parPartToInlines' $ ExternalHyperLink url runs - UnknownField -> smushInlines <$> mapM runToInlines runs + HyperlinkField url -> parPartToInlines' $ ExternalHyperLink url children + PagerefField fieldAnchor True -> parPartToInlines' $ InternalHyperLink fieldAnchor children + _ -> smushInlines <$> mapM parPartToInlines' children parPartToInlines' NullParPart = return mempty isAnchorSpan :: Inline -> Bool @@ -532,34 +536,36 @@ trimSps (Many ils) = Many $ Seq.dropWhileL isSp $Seq.dropWhileR isSp ils extraAttr :: (Eq (StyleName a), HasStyleName a) => a -> Attr extraAttr s = ("", [], [("custom-style", fromStyleName $ getStyleName s)]) -parStyleToTransform :: PandocMonad m => ParagraphStyle -> DocxContext m (Blocks -> Blocks) -parStyleToTransform pPr = case pStyle pPr of - c@(getStyleName -> styleName):cs - | styleName `elem` divsToKeep -> do - let pPr' = pPr { pStyle = cs } - transform <- parStyleToTransform pPr' - return $ divWith ("", [normalizeToClassName styleName], []) . transform - | styleName `elem` listParagraphStyles -> do - let pPr' = pPr { pStyle = cs, indentation = Nothing} - transform <- parStyleToTransform pPr' - return $ divWith ("", [normalizeToClassName styleName], []) . transform - | otherwise -> do - let pPr' = pPr { pStyle = cs } - transform <- parStyleToTransform pPr' - styles <- asks (isEnabled Ext_styles . docxOptions) - return $ - (if styles then divWith (extraAttr c) else id) - . (if isBlockQuote c then blockQuote else id) - . transform - [] - | Just left <- indentation pPr >>= leftParIndent -> do - let pPr' = pPr { indentation = Nothing } - hang = fromMaybe 0 $ indentation pPr >>= hangingParIndent - transform <- parStyleToTransform pPr' - return $ if (left - hang) > 0 - then blockQuote . transform - else transform - | otherwise -> return id +paragraphStyleToTransform :: PandocMonad m => ParagraphStyle -> DocxContext m (Blocks -> Blocks) +paragraphStyleToTransform pPr = + let stylenames = map getStyleName (pStyle pPr) + transform = if (`elem` listParagraphStyles) `any` stylenames || relativeIndent pPr <= 0 + then id + else blockQuote + in do + extStylesEnabled <- asks (isEnabled Ext_styles . docxOptions) + return $ foldr (\parStyle transform' -> + (parStyleToTransform extStylesEnabled parStyle) . transform' + ) transform (pStyle pPr) + +parStyleToTransform :: Bool -> ParStyle -> Blocks -> Blocks +parStyleToTransform extStylesEnabled parStyle@(getStyleName -> styleName) + | (styleName `elem` divsToKeep) || (styleName `elem` listParagraphStyles) = + divWith ("", [normalizeToClassName styleName], []) + | otherwise = + (if extStylesEnabled then divWith (extraAttr parStyle) else id) + . (if isBlockQuote parStyle then blockQuote else id) + +-- The relative indent is the indentation minus the indentation of the parent style. +-- This tells us whether this paragraph in particular was indented more and thus +-- should be considered a block quote. +relativeIndent :: ParagraphStyle -> Integer +relativeIndent pPr = + let pStyleLeft = fromMaybe 0 $ pStyleIndentation pPr >>= leftParIndent + pStyleHang = fromMaybe 0 $ pStyleIndentation pPr >>= hangingParIndent + left = fromMaybe pStyleLeft $ indentation pPr >>= leftParIndent + hang = fromMaybe pStyleHang $ indentation pPr >>= hangingParIndent + in (left - hang) - (pStyleLeft - pStyleHang) normalizeToClassName :: (FromStyleName a) => a -> T.Text normalizeToClassName = T.map go . fromStyleName @@ -578,7 +584,7 @@ bodyPartToBlocks (Paragraph pPr parparts) local (\s -> s{ docxInBidi = True }) (bodyPartToBlocks (Paragraph pPr' parparts)) | isCodeDiv pPr = do - transform <- parStyleToTransform pPr + transform <- paragraphStyleToTransform pPr return $ transform $ codeBlock $ @@ -605,7 +611,7 @@ bodyPartToBlocks (Paragraph pPr parparts) else prevParaIls <> space) <> ils' handleInsertion = do modify $ \s -> s {docxPrevPara = mempty} - transform <- parStyleToTransform pPr' + transform <- paragraphStyleToTransform pPr' return $ transform $ paraOrPlain ils'' opts <- asks docxOptions case (pChange pPr', readerTrackChanges opts) of @@ -620,7 +626,7 @@ bodyPartToBlocks (Paragraph pPr parparts) , AllChanges) -> do let attr = ("", ["paragraph-insertion"], addAuthorAndDate cAuthor cDate) insertMark = spanWith attr mempty - transform <- parStyleToTransform pPr' + transform <- paragraphStyleToTransform pPr' return $ transform $ paraOrPlain $ ils'' <> insertMark (Just (TrackedChange Deletion _), AcceptChanges) -> do @@ -632,7 +638,7 @@ bodyPartToBlocks (Paragraph pPr parparts) , AllChanges) -> do let attr = ("", ["paragraph-deletion"], addAuthorAndDate cAuthor cDate) insertMark = spanWith attr mempty - transform <- parStyleToTransform pPr' + transform <- paragraphStyleToTransform pPr' return $ transform $ paraOrPlain $ ils'' <> insertMark _ -> handleInsertion |