diff options
| author | Emily Bourke <undergroundquizscene@protonmail.com> | 2021-09-02 10:54:55 +0100 |
|---|---|---|
| committer | John MacFarlane <jgm@berkeley.edu> | 2021-09-10 17:06:45 -0700 |
| commit | b60c6157fecd868671baf055045a324ffe20c233 (patch) | |
| tree | 0aa6fd20e2adf6e66e7616dad545a3bf8f4a7808 | |
| parent | 8ec9b884f1005e2935181045339614937159a0ad (diff) | |
| download | pandoc-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.
| -rw-r--r-- | src/Text/Pandoc/Writers/Powerpoint/Output.hs | 19 |
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) |