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 /src | |
| 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.
Diffstat (limited to 'src')
| -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) |