diff options
| author | Jesse Rosenthal <jrosenthal@jhu.edu> | 2019-04-01 15:29:23 -0400 |
|---|---|---|
| committer | Jesse Rosenthal <jrosenthal@jhu.edu> | 2019-04-01 15:29:23 -0400 |
| commit | 9a77da475e418e9ab55ee20878ba750f28f67c8e (patch) | |
| tree | fe7b4b46afd9a698c8be46f52cd742668f9524dc /src | |
| parent | 5e944bf5b06ff9785e3e9c67cf9b8f383e498fde (diff) | |
| download | pandoc-9a77da475e418e9ab55ee20878ba750f28f67c8e.tar.gz | |
PowerPoint writer: Build sp trees correctly
We were previously carrying over too many elements from the layout,
which produced visual artifacts and some corruption. This empties the
sptree (except for properties) after building the shapes, and then
inserts them.
Together with 5e944bf5, fixes #5402
(Note that this addresses the issue and template in that particular
bug report. Other issues will arise no doubt arise with other
templates.)
Diffstat (limited to 'src')
| -rw-r--r-- | src/Text/Pandoc/Writers/Powerpoint/Output.hs | 36 |
1 files changed, 19 insertions, 17 deletions
diff --git a/src/Text/Pandoc/Writers/Powerpoint/Output.hs b/src/Text/Pandoc/Writers/Powerpoint/Output.hs index 6cb4666b1..db16d5ada 100644 --- a/src/Text/Pandoc/Writers/Powerpoint/Output.hs +++ b/src/Text/Pandoc/Writers/Powerpoint/Output.hs @@ -409,12 +409,22 @@ getContentShapeSize _ _ _ = throwError $ PandocSomeError $ "Attempted to find content shape size in non-layout" +buildSpTree :: NameSpaces -> Element -> [Element] -> Element +buildSpTree ns spTreeElem newShapes = + emptySpTreeElem { elContent = newContent } + where newContent = elContent emptySpTreeElem ++ map Elem newShapes + emptySpTreeElem = spTreeElem { elContent = filter fn (elContent spTreeElem) } + fn :: Content -> Bool + fn (Elem e) = isElem ns "p" "nvGrpSpPr" e || + isElem ns "p" "grpSpPr" e + fn _ = True + replaceNamedChildren :: NameSpaces - -> String - -> String - -> [Element] - -> Element - -> Element + -> String + -> String + -> [Element] + -> Element + -> Element replaceNamedChildren ns prefix name newKids element = element { elContent = concat $ fun True $ elContent element } where @@ -1047,10 +1057,7 @@ contentToElement layout hdrShape shapes contentElements <- local (\env -> env {envContentType = NormalContent}) (shapesToElements layout shapes) - return $ - replaceNamedChildren ns "p" "sp" - (hdrShapeElements ++ contentElements) - spTree + return $ buildSpTree ns spTree (hdrShapeElements ++ contentElements) contentToElement _ _ _ = return $ mknode "p:sp" [] () twoColumnToElement :: PandocMonad m => Element -> [ParaElem] -> [Shape] -> [Shape] -> P m Element @@ -1070,10 +1077,7 @@ twoColumnToElement layout hdrShape shapesL shapesR (shapesToElements layout shapesR) -- let contentElementsL' = map (setIdx ns "1") contentElementsL -- contentElementsR' = map (setIdx ns "2") contentElementsR - return $ - replaceNamedChildren ns "p" "sp" - (hdrShapeElements ++ contentElementsL ++ contentElementsR) - spTree + return $ buildSpTree ns spTree (hdrShapeElements ++ contentElementsL ++ contentElementsR) twoColumnToElement _ _ _ _= return $ mknode "p:sp" [] () @@ -1086,7 +1090,7 @@ titleToElement layout titleElems let titleShapeElements = if null titleElems then [] else [element] - return $ replaceNamedChildren ns "p" "sp" titleShapeElements spTree + return $ buildSpTree ns spTree titleShapeElements titleToElement _ _ = return $ mknode "p:sp" [] () metadataToElement :: PandocMonad m => Element -> [ParaElem] -> [ParaElem] -> [[ParaElem]] -> [ParaElem] -> P m Element @@ -1105,9 +1109,7 @@ metadataToElement layout titleElems subtitleElems authorsElems dateElems dateShapeElements <- if null dateElems then return [] else sequence [nonBodyTextToElement layout [PHType "dt"] dateElems] - return $ replaceNamedChildren ns "p" "sp" - (titleShapeElements ++ subtitleShapeElements ++ dateShapeElements) - spTree + return $ buildSpTree ns spTree (titleShapeElements ++ subtitleShapeElements ++ dateShapeElements) metadataToElement _ _ _ _ _ = return $ mknode "p:sp" [] () slideToElement :: PandocMonad m => Slide -> P m Element |