aboutsummaryrefslogtreecommitdiff
path: root/src/Text
diff options
context:
space:
mode:
authorEmily Bourke <undergroundquizscene@protonmail.com>2021-09-02 10:54:55 +0100
committerJohn MacFarlane <jgm@berkeley.edu>2021-09-10 17:06:45 -0700
commitb60c6157fecd868671baf055045a324ffe20c233 (patch)
tree0aa6fd20e2adf6e66e7616dad545a3bf8f4a7808 /src/Text
parent8ec9b884f1005e2935181045339614937159a0ad (diff)
downloadpandoc-b60c6157fecd868671baf055045a324ffe20c233.tar.gz
pptx: Don’t add relationships unnecessarily
Before now, for any layouts added to the output from the default reference doc, the relationships were unconditionally added to the output. However, if there was already a layout in slideMaster1 at the same index then that results in duplicate relationships. This commit checks first, and only adds the relationship if it doesn’t already exist.
Diffstat (limited to 'src/Text')
-rw-r--r--src/Text/Pandoc/Writers/Powerpoint/Output.hs19
1 files changed, 14 insertions, 5 deletions
diff --git a/src/Text/Pandoc/Writers/Powerpoint/Output.hs b/src/Text/Pandoc/Writers/Powerpoint/Output.hs
index a28eaf54c..0b6ca50c2 100644
--- a/src/Text/Pandoc/Writers/Powerpoint/Output.hs
+++ b/src/Text/Pandoc/Writers/Powerpoint/Output.hs
@@ -384,9 +384,11 @@ updateMasterElems layouts master masterRels = (updatedMaster, updatedMasterRels)
Element ->
([Text], Element)
addLayoutRels e = let
- layoutsToAdd = filter (not . slInReferenceDoc) (toList layouts)
+ layoutsToAdd = filter (\l -> not (slInReferenceDoc l) && isNew e l)
+ (toList layouts)
newRelationships = snd (foldr mkRelationship (maxIdNumber e, []) layoutsToAdd)
- newRelationshipIds = mapMaybe getRelationshipId newRelationships
+ newRelationshipIds =
+ mapMaybe (findElemAttr (QName "Id" Nothing Nothing)) newRelationships
mkRelationship layout (lastId, relationships) = let
thisId = lastId + 1
slideLayoutPath = "../slideLayouts/" <> T.pack (takeFileName (slPath layout))
@@ -403,9 +405,16 @@ updateMasterElems layouts master masterRels = (updatedMaster, updatedMasterRels)
in (thisId, Elem newRelationship : relationships)
in (newRelationshipIds, e {elContent = elContent e <> newRelationships})
- getRelationshipId :: Content -> Maybe Text
- getRelationshipId (Elem e) = findAttr (QName "Id" Nothing Nothing) e
- getRelationshipId _ = Nothing
+ -- | Whether the layout needs to be added to the Relationships element.
+ isNew :: Element -> SlideLayout -> Bool
+ isNew relationships SlideLayout{..} = let
+ toDetails = fmap (takeFileName . T.unpack)
+ . findElemAttr (QName "Target" Nothing Nothing)
+ in takeFileName slPath `notElem` mapMaybe toDetails (elContent relationships)
+
+ findElemAttr :: QName -> Content -> Maybe Text
+ findElemAttr attr (Elem e) = findAttr attr e
+ findElemAttr _ _ = Nothing
maxIdNumber :: Element -> Integer
maxIdNumber relationships = maximum (0 : idNumbers)