From da802c1a2ef3961854761c988ef946de8677e9c3 Mon Sep 17 00:00:00 2001 From: Jesse Rosenthal Date: Mon, 1 Apr 2019 14:18:25 -0400 Subject: PowerPoint writer: Make default placeholder type for template lookup This is the first step toward making templating work better. It seems that content shapes have a default ph type. In other words, shapes with *NO PH TYPE* should be considered to have an "obj" ph type, and used as content shapes. see https://github.com/scanny/python-pptx/blob/master/docs/dev/analysis/placeholders/slide-placeholders/placeholders-in-new-slide.rst --- src/Text/Pandoc/Writers/Powerpoint/Output.hs | 60 +++++++++++++++++++--------- 1 file changed, 42 insertions(+), 18 deletions(-) diff --git a/src/Text/Pandoc/Writers/Powerpoint/Output.hs b/src/Text/Pandoc/Writers/Powerpoint/Output.hs index 8c0aee696..00845b987 100644 --- a/src/Text/Pandoc/Writers/Powerpoint/Output.hs +++ b/src/Text/Pandoc/Writers/Powerpoint/Output.hs @@ -975,21 +975,45 @@ graphicToElement tableWidth (Tbl tblPr hdrCells rows) = do ] ] -getShapeByPlaceHolderType :: NameSpaces -> Element -> String -> Maybe Element + +-- We get the shape by placeholder type. If there is NO type, it +-- defaults to a content placeholder. + +data PHType = PHType String | ObjType + deriving (Show, Eq) + +findPHType :: NameSpaces -> Element -> PHType -> Bool +findPHType ns spElem phType + | isElem ns "p" "sp" spElem = + let mbPHElem = (Just spElem >>= + findChild (elemName ns "p" "nvSpPr") >>= + findChild (elemName ns "p" "nvPr") >>= + findChild (elemName ns "p" "ph")) + in + case mbPHElem of + -- if it's a named PHType, we want to check that the attribute + -- value matches. + Just phElem | (PHType tp) <- phType -> + case findAttr (QName "type" Nothing Nothing) phElem of + Just tp' -> tp == tp' + Nothing -> False + -- if it's an ObjType, we want to check that there is NO + -- "type" attribute. In other words, a lookup should return nothing. + Just phElem | ObjType <- phType -> + case findAttr (QName "type" Nothing Nothing) phElem of + Just _ -> False + Nothing -> True + Nothing -> False +findPHType _ _ _ = False + +getShapeByPlaceHolderType :: NameSpaces -> Element -> PHType -> Maybe Element getShapeByPlaceHolderType ns spTreeElem phType | isElem ns "p" "spTree" spTreeElem = - let findPhType element = isElem ns "p" "sp" element && - Just phType == (Just element >>= - findChild (elemName ns "p" "nvSpPr") >>= - findChild (elemName ns "p" "nvPr") >>= - findChild (elemName ns "p" "ph") >>= - findAttr (QName "type" Nothing Nothing)) - in - filterChild findPhType spTreeElem + filterChild (\e -> findPHType ns e phType) spTreeElem | otherwise = Nothing -- Like the above, but it tries a number of different placeholder types -getShapeByPlaceHolderTypes :: NameSpaces -> Element -> [String] -> Maybe Element +getShapeByPlaceHolderTypes :: NameSpaces -> Element -> [PHType] -> Maybe Element getShapeByPlaceHolderTypes _ _ [] = Nothing getShapeByPlaceHolderTypes ns spTreeElem (s:ss) = case getShapeByPlaceHolderType ns spTreeElem s of @@ -1010,7 +1034,7 @@ getShapeByPlaceHolderIndex ns spTreeElem phIdx | otherwise = Nothing -nonBodyTextToElement :: PandocMonad m => Element -> [String] -> [ParaElem] -> P m Element +nonBodyTextToElement :: PandocMonad m => Element -> [PHType] -> [ParaElem] -> P m Element nonBodyTextToElement layout phTypes paraElements | ns <- elemToNameSpaces layout , Just cSld <- findChild (elemName ns "p" "cSld") layout @@ -1030,7 +1054,7 @@ contentToElement layout hdrShape shapes | ns <- elemToNameSpaces layout , Just cSld <- findChild (elemName ns "p" "cSld") layout , Just spTree <- findChild (elemName ns "p" "spTree") cSld = do - element <- nonBodyTextToElement layout ["title"] hdrShape + element <- nonBodyTextToElement layout [PHType "title"] hdrShape let hdrShapeElements = if null hdrShape then [] else [element] @@ -1048,7 +1072,7 @@ twoColumnToElement layout hdrShape shapesL shapesR | ns <- elemToNameSpaces layout , Just cSld <- findChild (elemName ns "p" "cSld") layout , Just spTree <- findChild (elemName ns "p" "spTree") cSld = do - element <- nonBodyTextToElement layout ["title"] hdrShape + element <- nonBodyTextToElement layout [PHType "title"] hdrShape let hdrShapeElements = if null hdrShape then [] else [element] @@ -1072,7 +1096,7 @@ titleToElement layout titleElems | ns <- elemToNameSpaces layout , Just cSld <- findChild (elemName ns "p" "cSld") layout , Just spTree <- findChild (elemName ns "p" "spTree") cSld = do - element <- nonBodyTextToElement layout ["title", "ctrTitle"] titleElems + element <- nonBodyTextToElement layout [PHType "title", PHType "ctrTitle"] titleElems let titleShapeElements = if null titleElems then [] else [element] @@ -1086,15 +1110,15 @@ metadataToElement layout titleElems subtitleElems authorsElems dateElems , Just spTree <- findChild (elemName ns "p" "spTree") cSld = do titleShapeElements <- if null titleElems then return [] - else sequence [nonBodyTextToElement layout ["ctrTitle"] titleElems] + else sequence [nonBodyTextToElement layout [PHType "ctrTitle"] titleElems] let combinedAuthorElems = intercalate [Break] authorsElems subtitleAndAuthorElems = intercalate [Break, Break] [subtitleElems, combinedAuthorElems] subtitleShapeElements <- if null subtitleAndAuthorElems then return [] - else sequence [nonBodyTextToElement layout ["subTitle"] subtitleAndAuthorElems] + else sequence [nonBodyTextToElement layout [PHType "subTitle"] subtitleAndAuthorElems] dateShapeElements <- if null dateElems then return [] - else sequence [nonBodyTextToElement layout ["dt"] dateElems] + else sequence [nonBodyTextToElement layout [PHType "dt"] dateElems] return $ replaceNamedChildren ns "p" "sp" (titleShapeElements ++ subtitleShapeElements ++ dateShapeElements) spTree @@ -1155,7 +1179,7 @@ getSlideNumberFieldId notesMaster | ns <- elemToNameSpaces notesMaster , Just cSld <- findChild (elemName ns "p" "cSld") notesMaster , Just spTree <- findChild (elemName ns "p" "spTree") cSld - , Just sp <- getShapeByPlaceHolderType ns spTree "sldNum" + , Just sp <- getShapeByPlaceHolderType ns spTree (PHType "sldNum") , Just txBody <- findChild (elemName ns "p" "txBody") sp , Just p <- findChild (elemName ns "a" "p") txBody , Just fld <- findChild (elemName ns "a" "fld") p -- cgit v1.2.3