Tissevert/pandoc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 1

pptx: Don’t add relationships unnecessarily

Browse source 
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.
This commit is contained in:
Emily Bourke 2021-09-02 10:54:55 +01:00 • committed by John MacFarlane
parent 8ec9b884f1
commit b60c6157fe
1 changed files with 14 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
src/Text/Pandoc/Writers/Powerpoint/Output.hs
View file

@ -384,9 +384,11 @@ updateMasterElems layouts master masterRels = (updatedMaster, updatedMasterRels)
Element -> Element ->
([Text], Element) ([Text], Element)
addLayoutRels e = let 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) newRelationships = snd (foldr mkRelationship (maxIdNumber e, []) layoutsToAdd)
newRelationshipIds = mapMaybe getRelationshipId newRelationships newRelationshipIds =
mapMaybe (findElemAttr (QName "Id" Nothing Nothing)) newRelationships
mkRelationship layout (lastId, relationships) = let mkRelationship layout (lastId, relationships) = let
thisId = lastId + 1 thisId = lastId + 1
slideLayoutPath = "../slideLayouts/" <> T.pack (takeFileName (slPath layout)) slideLayoutPath = "../slideLayouts/" <> T.pack (takeFileName (slPath layout))
@ -403,9 +405,16 @@ updateMasterElems layouts master masterRels = (updatedMaster, updatedMasterRels)
in (thisId, Elem newRelationship : relationships) in (thisId, Elem newRelationship : relationships)
in (newRelationshipIds, e {elContent = elContent e <> newRelationships}) in (newRelationshipIds, e {elContent = elContent e <> newRelationships})
getRelationshipId :: Content -> Maybe Text -- | Whether the layout needs to be added to the Relationships element.
getRelationshipId (Elem e) = findAttr (QName "Id" Nothing Nothing) e isNew :: Element -> SlideLayout -> Bool
getRelationshipId _ = Nothing 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 :: Element -> Integer
maxIdNumber relationships = maximum (0 : idNumbers) maxIdNumber relationships = maximum (0 : idNumbers)