aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc
diff options
context:
space:
mode:
authorJesse Rosenthal <jrosenthal@jhu.edu>2019-04-01 14:34:09 -0400
committerJesse Rosenthal <jrosenthal@jhu.edu>2019-04-01 14:45:56 -0400
commit5e944bf5b06ff9785e3e9c67cf9b8f383e498fde (patch)
tree3693458708789b10b7db4887a9d971f726062b14 /src/Text/Pandoc
parentda802c1a2ef3961854761c988ef946de8677e9c3 (diff)
downloadpandoc-5e944bf5b06ff9785e3e9c67cf9b8f383e498fde.tar.gz
PowerPoint writer: Correct application of reference doc for content
Previously we had applied content shapes based on their index (which was "1", "2" in MS Word 2013). It turns out that this was a convention, and could not be relied on. Instead we use a default type (ie, a ph tag with no "type"). This is more correct, and should make the application of reference documents in PowerPoint much more robust.
Diffstat (limited to 'src/Text/Pandoc')
-rw-r--r--src/Text/Pandoc/Writers/Powerpoint/Output.hs46
1 files changed, 16 insertions, 30 deletions
diff --git a/src/Text/Pandoc/Writers/Powerpoint/Output.hs b/src/Text/Pandoc/Writers/Powerpoint/Output.hs
index 00845b987..6cb4666b1 100644
--- a/src/Text/Pandoc/Writers/Powerpoint/Output.hs
+++ b/src/Text/Pandoc/Writers/Powerpoint/Output.hs
@@ -336,22 +336,18 @@ shapeHasId ns ident element
nm == ident
| otherwise = False
--- The content shape in slideLayout2 (Title/Content) has id=3 In
--- slideLayout4 (two column) the left column is id=3, and the right
--- column is id=4.
getContentShape :: PandocMonad m => NameSpaces -> Element -> P m Element
getContentShape ns spTreeElem
| isElem ns "p" "spTree" spTreeElem = do
contentType <- asks envContentType
- let idx = case contentType of
- NormalContent -> "1"
- TwoColumnLeftContent -> "1"
- TwoColumnRightContent -> "2"
- case getShapeByPlaceHolderIndex ns spTreeElem idx of
- Just e -> return e
- Nothing -> throwError $
- PandocSomeError $
- "Could not find shape for Powerpoint content"
+ let contentShapes = getShapesByPlaceHolderType ns spTreeElem ObjType
+ case contentType of
+ NormalContent | (sp : _) <- contentShapes -> return sp
+ TwoColumnLeftContent | (sp : _) <- contentShapes -> return sp
+ TwoColumnRightContent | (_ : sp : _) <- contentShapes -> return sp
+ _ -> throwError $
+ PandocSomeError $
+ "Could not find shape for Powerpoint content"
getContentShape _ _ = throwError $
PandocSomeError $
"Attempted to find content on non shapeTree"
@@ -1006,11 +1002,15 @@ findPHType ns spElem phType
Nothing -> False
findPHType _ _ _ = False
-getShapeByPlaceHolderType :: NameSpaces -> Element -> PHType -> Maybe Element
-getShapeByPlaceHolderType ns spTreeElem phType
+getShapesByPlaceHolderType :: NameSpaces -> Element -> PHType -> [Element]
+getShapesByPlaceHolderType ns spTreeElem phType
| isElem ns "p" "spTree" spTreeElem =
- filterChild (\e -> findPHType ns e phType) spTreeElem
- | otherwise = Nothing
+ filterChildren (\e -> findPHType ns e phType) spTreeElem
+ | otherwise = []
+
+getShapeByPlaceHolderType :: NameSpaces -> Element -> PHType -> Maybe Element
+getShapeByPlaceHolderType ns spTreeElem phType =
+ listToMaybe $ getShapesByPlaceHolderType ns spTreeElem phType
-- Like the above, but it tries a number of different placeholder types
getShapeByPlaceHolderTypes :: NameSpaces -> Element -> [PHType] -> Maybe Element
@@ -1020,20 +1020,6 @@ getShapeByPlaceHolderTypes ns spTreeElem (s:ss) =
Just element -> Just element
Nothing -> getShapeByPlaceHolderTypes ns spTreeElem ss
-getShapeByPlaceHolderIndex :: NameSpaces -> Element -> String -> Maybe Element
-getShapeByPlaceHolderIndex ns spTreeElem phIdx
- | isElem ns "p" "spTree" spTreeElem =
- let findPhType element = isElem ns "p" "sp" element &&
- Just phIdx == (Just element >>=
- findChild (elemName ns "p" "nvSpPr") >>=
- findChild (elemName ns "p" "nvPr") >>=
- findChild (elemName ns "p" "ph") >>=
- findAttr (QName "idx" Nothing Nothing))
- in
- filterChild findPhType spTreeElem
- | otherwise = Nothing
-
-
nonBodyTextToElement :: PandocMonad m => Element -> [PHType] -> [ParaElem] -> P m Element
nonBodyTextToElement layout phTypes paraElements
| ns <- elemToNameSpaces layout