diff options
-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 |