git.iko.soy/typeable/pandoc
on master help sign in
Docx reader: Remove unused anchors.

Docx produces a lot of anchors with nothing pointing to them -- we now remove these to produce cleaner output. Note that this has to occur at the end of the process because it has to follow link/anchor rewriting. Closes #3679.

commite90c714c73be58ef09b08272c676f96e2a21c767 authorJesse Rosenthal <jrosenthal@jhu.edu> dateSat 30 Dec 2017, 22:17 (9 years ago) parente0cf8e6
1 file changed+27−5
src/Text/Pandoc/Readers/Docx.hs+27−5
src/Text/Pandoc/Readers/Docx.hs+27−5
@@ -118,6 +118,7 @@ readDocx _ _ =
118118 throwError $ PandocSomeError "couldn't parse docx file"
119119
120120data DState = DState { docxAnchorMap :: M.Map String String
121+ , docxAnchorSet :: Set.Set String
121122 , docxMediaBag :: MediaBag
122123 , docxDropCap :: Inlines
123124 , docxWarnings :: [String]
@@ -128,6 +129,7 @@ data DState = DState { docxAnchorMap :: M.Map String String
128129
129130instance Default DState where
130131 def = DState { docxAnchorMap = M.empty
132+ , docxAnchorSet = mempty
131133 , docxMediaBag = mempty
132134 , docxDropCap = mempty
133135 , docxWarnings = []
@@ -561,7 +563,7 @@ bodyPartToBlocks (ListItem pPr numId lvl (Just levelInfo) parparts) = do
561563 ]
562564 modify $ \st -> st{ docxListState = M.insert (numId, lvl) start listState}
563565 blks <- bodyPartToBlocks (Paragraph pPr parparts)
564− return $ divWith ("", ["list-item"], kvs) blks
566+ return $ divWith ("", ["list-item"], kvs) blks
565567bodyPartToBlocks (ListItem pPr _ _ _ parparts) =
566568 let pPr' = pPr {pStyle = "ListParagraph": pStyle pPr}
567569 in
@@ -603,21 +605,41 @@ bodyPartToBlocks (OMathPara e) =
603605rewriteLink' :: PandocMonad m => Inline -> DocxContext m Inline
604606rewriteLink' l@(Link attr ils ('#':target, title)) = do
605607 anchorMap <- gets docxAnchorMap
606− return $ case M.lookup target anchorMap of
607− Just newTarget -> Link attr ils ('#':newTarget, title)
608− Nothing -> l
608+ case M.lookup target anchorMap of
609+ Just newTarget -> do
610+ modify $ \s -> s{docxAnchorSet = Set.insert newTarget (docxAnchorSet s)}
611+ return $ Link attr ils ('#':newTarget, title)
612+ Nothing -> do
613+ modify $ \s -> s{docxAnchorSet = Set.insert target (docxAnchorSet s)}
614+ return l
609615rewriteLink' il = return il
610616
611617rewriteLinks :: PandocMonad m => [Block] -> DocxContext m [Block]
612618rewriteLinks = mapM (walkM rewriteLink')
613619
620+removeOrphanAnchors'' :: PandocMonad m => Inline -> DocxContext m [Inline]
621+removeOrphanAnchors'' s@(Span (ident, classes, _) ils)
622+ | "anchor" `elem` classes = do
623+ anchorSet <- gets docxAnchorSet
624+ return $ if ident `Set.member` anchorSet
625+ then [s]
626+ else ils
627+removeOrphanAnchors'' il = return [il]
628+
629+removeOrphanAnchors' :: PandocMonad m => [Inline] -> DocxContext m [Inline]
630+removeOrphanAnchors' ils = liftM concat $ mapM removeOrphanAnchors'' ils
631+
632+removeOrphanAnchors :: PandocMonad m => [Block] -> DocxContext m [Block]
633+removeOrphanAnchors = mapM (walkM removeOrphanAnchors')
634+
614635bodyToOutput :: PandocMonad m => Body -> DocxContext m (Meta, [Block])
615636bodyToOutput (Body bps) = do
616637 let (metabps, blkbps) = sepBodyParts bps
617638 meta <- bodyPartsToMeta metabps
618639 blks <- smushBlocks <$> mapM bodyPartToBlocks blkbps
619640 blks' <- rewriteLinks $ blocksToDefinitions $ blocksToBullets $ toList blks
620− return (meta, blks')
641+ blks'' <- removeOrphanAnchors blks'
642+ return (meta, blks'')
621643
622644docxToOutput :: PandocMonad m
623645 => ReaderOptions