github/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2026-10-29 14:00:37 +00:00
Code Issues Packages Projects Releases Wiki Activity

✨ Store a swap inside a copy as an override group

Browse Source 
A swapped copy sub-head now keeps the shape-ref of the main child it
replaces (its position), takes its content from its own component, and
carries the touched group :swap-group. It used to point at the root of
the new component and store a swap slot naming the replaced child.

Every path reads and writes that form:
- sync pairs a swapped head with the child it replaces and syncs it
  from its own component; it takes from the replaced child only its
  placement: position, constraints and layout item attributes;
- reset undoes a swap in place, keeping the head's id and the other
  overrides of the copy;
- detach, paste and duplicate make a head that leaves every copy level
  a plain copy of its own component, and advance a deeper one by
  position; the children of a swapped head never advance;
- a variant switch keeps a swap stored this way, and counts only the
  copy's own swap, not one made in a main of the chain;
- update main replaces the main child with a clone of the swapped one,
  and from a swapped head updates its own component;
- a swap inside a copy keeps the old shape-ref and adds :swap-group;
  swapping back to the component of that position gives a plain nested
  copy whose children refer to the position's children; a swap inside
  a main is a plain nested copy.
Files that hold swap slots keep working until a migration converts
them. The component memories describe the model.

This fixes what came from the slot: reset of a swapped child cleared
the other overrides of the copy (F12) and gave copies of a main new
ids (F66); update main left a swap mark (F16); a second variant switch
lost the overrides (F29); grid cells did not pair a swapped child
(F44); a swapped child did not follow its position (F65). F49 keeps
failing, in another form.

The tests that asserted slots now assert the override group; the tests
of the slot code build the old form with :as-slot?.

Benchmark (lower quantile, ms; baseline / now / ratio):
  deepest-edit-through-three-levels    35.2 /  35.4 / 1.01
  edit-through-a-chain-of-dependents   68.9 /  68.7 / 1.00
  library-update-into-copies           83.1 /  77.5 / 0.93
  main-edit-into-10-copies              1.8 /   1.6 / 0.92
  main-edit-into-100-copies            15.4 /  15.4 / 1.00
  main-edit-into-1000-copies          153.1 / 151.1 / 0.99
  variant-switch-into-copies           32.1 /  32.4 / 1.01

AI-assisted-by: claude-opus-5-5
This commit is contained in:
alonso.torres 2026-10-12 22:52:51 +02:00
parent 0959e5b44b
commit 7d5b37dbdd
22 changed files with 1158 additions and 355 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
.serena/memories/common/component-data-model.md
View File

@ -26,11 +26,14 @@ The intended per-operation rules (which writes touch, what sync, reset, update-m
Masters are not normally touched through `set-shape-attr`, but touched flags can appear on master shapes through cloning/duplication paths. `add-touched-from-ref-chain` in `app.common.logic.variants` unions touched flags from ancestors into the copy being processed, so upstream/master touched state can affect downstream switch behavior.
## Swap slots and positional matching
## Swapped heads and positional matching
- A swap slot (stored via `ctk/set-swap-slot`, a `:touched` group `swap-slot-<uuid>`) marks a copy sub-head that was SWAPPED to another component; `compare-children` then pairs it to the main child by slot instead of by `shape-ref`.
- Copy sub-heads without a slot are paired to main children by `shape-ref` (seek, not index). `find-near-match` (positional) is only a validator/repair heuristic; validity requires membership of the ref among the near-main parent's children, not index equality (`mem:common/file-change-validation-migration-subtleties`).
- A copy sub-head the user SWAPPED to another component keeps `:shape-ref` on the near-main child it replaces (its *position*); `:component-id`/`:component-file` name the component its *content* comes from; the touched group `:swap-group` marks the swap. Its children refer into its own component's main.
- So for a swapped head the position shape (`find-ref-shape`, X in the near main) and the content shape (its component's main root) differ. `ctf/find-ref-shape` gives position (parent heads are tried outermost first); code that needs the content of a swapped head goes through the content helper, never through `get-ref-shape` with the head's own component.
- A copy sub-head whose component differs from its near main's component must have `:swap-group`; one that matches must not.
- Copy children are paired to main children by `shape-ref` (`is-main-of?`, seek, not index), swapped or not. `find-near-match` (positional) is only a validator/repair heuristic; validity requires membership of the ref among the near-main parent's children, not index equality (`mem:common/file-change-validation-migration-subtleties`).
- Copy child ORDER converges to the main's via the async sync (`moved` branch of `compare-children`); local code must never reorder copy children directly (guards in `:mov-objects`/`:reorder-children`).
- Files older than the feature `components/swap-group` stored the swap as a slot (`swap-slot-<uuid>` touched group, `:shape-ref` on the new component's root); the migration converts them.
## Cloning paths

18
.serena/memories/common/component-sync-contract.md
View File

@ -5,7 +5,7 @@ Intended semantics of copies, `:touched` and component sync. This is the spec: w
## Definitions
- Near main: the shape a copy shape's `:shape-ref` points at (inside the main of the closest enclosing copy head). Sync, reset and the override rule compare against it.
- Touched group: a `ctk/sync-attrs` group in `:touched`, plus text subgroups `:text-content-text|attribute|structure` and `:swap-slot-<uuid>`. Meaning: the user authored this group's value on this shape, so sync must not overwrite it.
- Touched group: a `ctk/sync-attrs` group in `:touched`, plus text subgroups `:text-content-text|attribute|structure` and `:swap-group`. Meaning: the user authored this group's value on this shape, so sync must not overwrite it. `:swap-group` on a copy sub-head: the user chose its component, so sync must not put the near main's back.
- Authored write: a value the user set on that shape: sidebar edit, direct canvas transform of that shape, text content edit, explicit rename, applying a token to it.
- Derived write: a value computed from other shapes or from measurement: children placed by a transformed parent, constraint resize, layout reflow, text auto-grow, `:position-data`, automatic naming, token value propagation, library color/typography sync, repair, sync itself. Derived writes never touch.
- Expected geometry of a copy shape: the near main's geometry placed relative to the copy's parent and resized through the shape's constraints (`app.common.geom.shapes.constraints`), with layout-owned and grow-owned dimensions left to layout/measurement.
@ -15,22 +15,22 @@ Intended semantics of copies, `:touched` and component sync. This is the spec: w
- Different means touched: a group whose value differs from the near main (geometry: from the expected geometry) must be touched.
- Equal does not mean untouched: a group set back to the main's value stays touched. Only reset, update-main, detach, swap or variant switch clear groups; value equality never does.
- Only authored writes on copies set groups. Mains are never touched through `set-shape-attr`.
- No structural override exists: copy children always follow the main's structure (add, delete, order). Swap slots are the only per-child structural state.
- The swap is the only structural override: copy children always follow the main's structure (add, delete, order), and a child with `:swap-group` keeps its own component in that position.
## Per operation
- Edit on a copy shape (authored): sets the attr's group (text content: `:content-group` + diff subgroups), clears `:remote-synced`. Descendants moved/resized only because of it stay untouched.
- Rename: an explicit rename touches `:name-group` on root or child. Automatic renames (text name following its content) are derived. Untouched names sync from the near main; a touched root name on update-main renames the component.
- Edit on a main: no touched change on the main; triggers sync.
- Sync main→copy: every untouched group gets the near main's value (geometry: expected geometry); touched groups keep their values; never sets or clears `:touched`. Main child added → added clean to copies. Main child deleted → copy child removed, overrides or not. Main reorder → copies follow. Swapped sub-heads pair by slot and sync from their own component.
- Sync main→copy: every untouched group gets the near main's value (geometry: expected geometry); touched groups keep their values; never sets or clears `:touched`. Main child added → added clean to copies. Main child deleted → copy child removed, overrides or not. Main reorder → copies follow. A swapped sub-head pairs with the main child it replaces (its `:shape-ref`) and takes only that child's placement (position, constraints, `layout-item-*`); everything else syncs from its own component's main. A main child deleted → its swapped copies go with it. A swap made in the main reaches copies without `:swap-group` and spares those with it.
- Sync cascade is eager: one sync runs to a fixpoint in memory (copies of A, including the A copy in B's main → copies of B → …) and commits once in the triggering op's undo group. The file is never left partly synced. Syncing only the components reported as changed equals a full-file sync.
- Reset: the selected head's subtree becomes equal to its near main (expected geometry); all its touched groups cleared, swap slots included (swaps undone). Nothing outside that subtree changes.
- Update main (from a top copy head): the copy's differing values go to the main; the copy's touched cleared; other copies then sync and keep their own overrides.
- Detach: the subtree loses component links, `:touched`, `:remote-synced`. First-level nested heads stay copies, move one nesting level up and inherit the near main's touched groups, so values their old near main overrode become overrides.
- Reset: the selected head's subtree becomes equal to its near main (expected geometry); all its touched groups cleared, `:swap-group` included: a swapped head turns back into the near main's component in place, keeping its id. Nothing outside that subtree changes.
- Update main (from a top copy head): the copy's differing values go to the main; the copy's touched cleared; other copies then sync and keep their own overrides. A swapped child replaces the main child it stands for, and neither keeps `:swap-group`.
- Detach: the subtree loses component links, `:touched`, `:remote-synced`. First-level nested heads stay copies, move one nesting level up and inherit the near main's touched groups, so values their old near main overrode become overrides. A swapped head left with no enclosing copy becomes a plain copy of its own component (`:shape-ref` = its main root, no `:swap-group`).
- Instantiate / nest a copy: the new subtree has no touched groups.
- Duplicate a copy: the new subtree keeps the source's values and touched; if its nesting level changes, touched is inherited as in detach.
- Swap without keep-touched: the new subtree is clean; the root gets a swap slot only when inside a component and keeps `swap-keep-attrs` values.
- Variant switch with keep-touched: an attr is carried from the old copy only when its group is touched and the old and new mains hold the same value for it. Resulting touched = groups of carried attrs (+ swap slot). A value equal to the new main is not carried and not touched.
- Duplicate a copy: the new subtree keeps the source's values and touched; if its nesting level changes, touched is inherited as in detach. Paste and move out of a copy follow the same rule.
- Swap without keep-touched: the new subtree is clean and keeps `swap-keep-attrs` values; the new head keeps the old shape's id. Inside a copy it keeps the old `:shape-ref` and gets `:swap-group` (none when the new component is the near main's); inside a main it is a plain nested copy.
- Variant switch with keep-touched: an attr is carried from the old copy only when its group is touched and the old and new mains hold the same value for it. Resulting touched = groups of carried attrs (+ `:swap-group` when the head is inside a copy). A value equal to the new main is not carried and not touched.
- Delete component: copies keep their data and do not sync. Restore brings sync back.
- Undo/redo: restores the exact prior state, `:touched` and `:remote-synced` included, of the op and the sync it caused together (same undo group, one step). Undo never needs a re-sync.

8
common/src/app/common/files/validate.cljc
View File

@ -402,7 +402,8 @@
"Validate that if the copy has not been swapped, the component-id and component-file are
the same as in the referenced shape in the near main."
[shape file page libraries]
(when (nil? (ctk/get-swap-slot shape))
(when (and (nil? (ctk/get-swap-slot shape))
(not (ctk/swapped? shape)))
(when-let [ref-shape (find-ref-shape* file page libraries shape)]
(when (or (not= (:component-id shape) (:component-id ref-shape))
(not= (:component-file shape) (:component-file ref-shape)))
@ -452,7 +453,10 @@
;; Guard first: if the shape already has a swap slot the invariant is satisfied
;; and we can avoid the ref-shape lookups entirely.
(when (and (nil? (ctk/get-swap-slot shape))
(ctf/swapped-subhead? shape page #(find-ref-shape* file page libraries %)))
(ctf/swapped-subhead? shape page #(if (ctk/swapped? %)
(ctf/find-content-ref-shape file page libraries %
:include-deleted? true)
(find-ref-shape* file page libraries %))))
(let [near-match (ctf/find-near-match file page libraries shape :include-deleted? true :with-context? false)]
(when (some? near-match)
(report-error :missing-slot

446
common/src/app/common/logic/libraries.cljc
View File

@ -60,6 +60,14 @@
(def ^:private flex-child-attrs
(disj ctk/swap-keep-attrs :interactions))
;; Attributes that place a shape in its parent
(def ^:private placement-attrs
(conj flex-child-attrs :constraints-h :constraints-v :fixed-scroll))
;; Touched groups of the placement attributes and of the position
(def ^:private placement-groups
(into #{:geometry-group} (map #(ctk/resolve-sync-group :rect %)) placement-attrs))
(defn enabled-shape?
[id container]
(or (empty? log-shape-ids)
@ -105,6 +113,7 @@
(declare update-grid-copy-attrs)
(declare update-flex-child-main-attrs)
(declare update-flex-child-copy-attrs)
(declare update-swapped-placement)
(declare reposition-shape)
(declare make-change)
@ -324,6 +333,7 @@
(declare generate-detach-recursive)
(declare generate-advance-nesting-level)
(declare generate-detach-immediate)
(declare generate-rehead-swapped)
(defn generate-detach-instance
"Generate changes to remove the links between a shape and all its children
@ -352,7 +362,12 @@
(pcb/update-shapes [shape-id] #(do (log/trace :msg " -> remove swap-slot")
(ctk/remove-swap-slot %)))
(nil? (ctk/get-swap-slot shape))
(ctk/swapped? shape)
; A swapped head left with no copy around it is a copy of its own component
(generate-rehead-swapped container libraries shape)
(and (nil? (ctk/get-swap-slot shape))
(not (ctk/swapped? shape)))
; Near shape-ref of shape and children need to be advanced one level
; (except if the head is already swapped)
(generate-advance-nesting-level nil container libraries (:id shape)))
@ -364,11 +379,54 @@
(pcb/update-shapes changes [(:id shape)] ctk/detach-shape)
children-ids)))))
(defn- swap-content-root-id
"The id of the main root a swapped head takes its content from."
[libraries shape]
(:main-instance-id (ctf/get-component libraries
(:component-file shape)
(:component-id shape)
:include-deleted? true)))
(defn- rehead-swapped
"Make a swapped head a plain copy of its own component, for when it leaves
every copy level."
[shape root-id]
(-> shape
(assoc :shape-ref root-id)
(ctk/remove-swap-group)))
(defn- generate-rehead-swapped
[changes container libraries shape]
(if-let [root-id (swap-content-root-id libraries shape)]
(pcb/update-shapes changes [(:id shape)] #(rehead-swapped % root-id))
(generate-detach-immediate changes container (:id shape) (atom #{}))))
(defn- swapped-descendant-ids
"The ids of the shapes below a swapped head in the subtree of the shape.
They refer into the head's own component, so they do not change when the
head changes its nesting level."
[objects shape-id]
(into #{}
(comp (filter ctk/swapped?)
(mapcat #(cfh/get-children-ids objects (:id %))))
(cfh/get-children-with-self objects shape-id)))
(defn- inherited-touched
"The touched groups a copy shape takes from the main shape it skips when it
goes up a nesting level. A swapped head takes only the placement ones,
since its content does not come from that main."
[shape ref-touched]
(if (ctk/swapped? shape)
(set/intersection ref-touched placement-groups)
ref-touched))
(defn- generate-advance-nesting-level
[changes file container libraries shape-id]
(log/trace :msg " -> advance-nesting-level")
(let [detached-ids (atom #{})
children (cfh/get-children-with-self (:objects container) shape-id) ;; TODO: this function should be refactored to be a recursive tree traversal.
unchanged-ids (swapped-descendant-ids (:objects container) shape-id)
children (->> (cfh/get-children-with-self (:objects container) shape-id) ;; TODO: this function should be refactored to be a recursive tree traversal.
(remove #(contains? unchanged-ids (:id %))))
skip-near (fn [changes shape] ;; this way we could shake the tree more easily when detaching shapes
(shape-log :trace (:id shape) container ;; and perhaps even allow to recover nested instances that have been
:msg " * advancing" :shape-id (:id shape)) ;; swapped and so we can access the main instance again.
@ -392,7 +450,7 @@
(log/trace :msg (str " (ref touched: " (:touched ref-shape) ")"))
(assoc % :touched
(set/union (:touched shape)
(ctk/normal-touched-groups ref-shape)))))
(inherited-touched shape (ctk/normal-touched-groups ref-shape))))))
;; Swap slot must also be copied if the current shape has not any,
;; except if this is the first level subcopy.
@ -770,7 +828,7 @@
(if reset?
;; the reset is against the ref-shape, not against the original shape of the component
(ctf/find-ref-shape file container libraries shape-inst)
(ctf/get-ref-shape library component shape-inst)))
(ctf/get-content-ref-shape library component shape-inst)))
initial-root? (:component-root shape-inst)
@ -923,11 +981,17 @@
swapped (fn [changes child-inst child-main]
(shape-log :trace (:id child-inst) container
:msg "Match slot"
:msg "Swapped"
:child-inst (str (:name child-inst) " " (pretty-uuid (:id child-inst)))
:child-main (str (:name child-main) " " (pretty-uuid (:id child-main))))
;; For now we don't make any sync here.
changes)
(if (ctk/swapped? child-inst)
(update-swapped-placement changes
child-inst
child-main
root-inst
root-main
container)
changes))
moved (fn [changes child-inst child-main]
(shape-log :trace (:id child-inst) container
@ -1041,7 +1105,7 @@
(change-touched shape-inst
shape-main
container
{:reset-touched? true})
{:reset-touched? true :keep-swap? true})
(change-touched shape-main
shape-inst
component-container
@ -1081,7 +1145,8 @@
component-container
container
root-inst
root-main))
root-main
libraries))
only-main (fn [changes child-main]
(remove-shape changes
@ -1152,78 +1217,86 @@
;; ---- Operation generation helpers ----
(defn- compare-children
"Pair the children of a copy shape with the children of its main and call
the callback of each case. A child pairs with the main child it refers to;
a swapped child pairs that way too, and takes `swapped-cb` in a normal sync,
`both-cb` in a reset, and does not pair in an inverse sync, so the main
child it replaces is removed and the swapped child is added in its place."
[changes shape-inst children-inst children-main container-inst container-main file libraries only-inst-cb only-main-cb both-cb swapped-cb moved-cb inverse? reset?]
(shape-log :trace (:id shape-inst) container-inst :msg "Compare children")
(loop [children-inst (seq (or children-inst []))
children-main (seq (or children-main []))
changes changes]
(let [child-inst (first children-inst)
child-main (first children-main)]
(shape-log :trace (:id shape-inst) container-inst
:msg "Comparing"
:main (str (:name child-main) " " (pretty-uuid (:id child-main)))
:inst (str (:name child-inst) " " (pretty-uuid (:id child-inst))))
(cond
(and (nil? child-inst) (nil? child-main))
changes
(let [pair?
(fn [child-main child-inst]
(or (and (ctk/is-main-of? child-main child-inst)
(not (and inverse? (ctk/swapped? child-inst))))
(and (ctf/match-swap-slot? child-main child-inst container-inst container-main file libraries)
(not reset?))))
(nil? child-inst)
(reduce only-main-cb changes children-main)
synced-pair?
(fn [child-main child-inst]
(and (ctk/is-main-of? child-main child-inst)
(or reset? (not (ctk/swapped? child-inst)))))]
(loop [children-inst (seq (or children-inst []))
children-main (seq (or children-main []))
changes changes]
(let [child-inst (first children-inst)
child-main (first children-main)]
(shape-log :trace (:id shape-inst) container-inst
:msg "Comparing"
:main (str (:name child-main) " " (pretty-uuid (:id child-main)))
:inst (str (:name child-inst) " " (pretty-uuid (:id child-inst))))
(cond
(and (nil? child-inst) (nil? child-main))
changes
(nil? child-main)
(reduce only-inst-cb changes children-inst)
(nil? child-inst)
(reduce only-main-cb changes children-main)
:else
(if (or (ctk/is-main-of? child-main child-inst)
(and (ctf/match-swap-slot? child-main child-inst container-inst container-main file libraries)
(not reset?)))
(recur (next children-inst)
(next children-main)
(if (ctk/is-main-of? child-main child-inst)
(both-cb changes child-inst child-main)
(swapped-cb changes child-inst child-main)))
(nil? child-main)
(reduce only-inst-cb changes children-inst)
(let [child-inst' (d/seek #(or (ctk/is-main-of? child-main %)
(and (ctf/match-swap-slot? child-main % container-inst container-main file libraries)
(not reset?)))
children-inst)
child-main' (d/seek #(or (ctk/is-main-of? % child-inst)
(and (ctf/match-swap-slot? % child-inst container-inst container-main file libraries)
(not reset?)))
children-main)]
(cond
(nil? child-inst')
(recur children-inst
(next children-main)
(only-main-cb changes child-main))
:else
(if (pair? child-main child-inst)
(recur (next children-inst)
(next children-main)
(if (synced-pair? child-main child-inst)
(both-cb changes child-inst child-main)
(swapped-cb changes child-inst child-main)))
(nil? child-main')
(recur (next children-inst)
children-main
(only-inst-cb changes child-inst))
(let [child-inst' (d/seek #(pair? child-main %) children-inst)
child-main' (d/seek #(pair? % child-inst) children-main)]
(cond
(nil? child-inst')
(recur children-inst
(next children-main)
(only-main-cb changes child-main))
:else
(if inverse?
(let [is-main? (ctk/is-main-of? child-inst child-main')]
(recur (next children-inst)
(remove #(= (:id %) (:id child-main')) children-main)
(cond-> changes
is-main?
(both-cb child-inst child-main')
(not is-main?)
(swapped-cb child-inst child-main')
:always
(moved-cb child-inst child-main'))))
(let [is-main? (ctk/is-main-of? child-inst' child-main)]
(recur (remove #(= (:id %) (:id child-inst')) children-inst)
(next children-main)
(cond-> changes
is-main?
(both-cb child-inst' child-main)
(not is-main?)
(swapped-cb child-inst' child-main)
:always
(moved-cb child-inst' child-main))))))))))))
(nil? child-main')
(recur (next children-inst)
children-main
(only-inst-cb changes child-inst))
:else
(if inverse?
(let [is-main? (ctk/is-main-of? child-inst child-main')]
(recur (next children-inst)
(remove #(= (:id %) (:id child-main')) children-main)
(cond-> changes
is-main?
(both-cb child-inst child-main')
(not is-main?)
(swapped-cb child-inst child-main')
:always
(moved-cb child-inst child-main'))))
(let [synced? (synced-pair? child-main child-inst')]
(recur (remove #(= (:id %) (:id child-inst')) children-inst)
(next children-main)
(cond-> changes
synced?
(both-cb child-inst' child-main)
(not synced?)
(swapped-cb child-inst' child-main)
:always
(moved-cb child-inst' child-main)))))))))))))
(defn- add-shape-to-instance
[changes component-shape index component-page container root-instance root-main omit-touched? set-remote-synced?]
@ -1233,9 +1306,12 @@
" "
(pretty-uuid (:id component-shape))))
(let [component-parent-shape (ctn/get-shape component-page (:parent-id component-shape))
parent-shape (d/seek #(ctk/is-main-of? component-parent-shape %)
(cfh/get-children-with-self (:objects container)
(:id root-instance)))
;; a swapped root refers to the shape it replaces, not to the main root
parent-shape (if (= (:id component-parent-shape) (:id root-main))
root-instance
(d/seek #(ctk/is-main-of? component-parent-shape %)
(cfh/get-children-with-self (:objects container)
(:id root-instance))))
all-parents (into [(:id parent-shape)]
(cfh/get-parent-ids (:objects container)
(:id parent-shape)))
@ -1303,7 +1379,7 @@
(pcb/apply-changes-local)))))
(defn- add-shape-to-main
[changes shape index component component-container page root-instance root-main]
[changes shape index component component-container page root-instance root-main libraries]
(shape-log :info (:id shape) page
:msg (str "ADD [C " (pretty-uuid (:id component-container)) "] "
(:name shape)
@ -1317,14 +1393,35 @@
(cfh/get-parent-ids (:objects component-container)
(:id component-parent-shape)))
update-new-shape (fn [new-shape _original-shape]
(reposition-shape new-shape
root-instance
root-main))
;; A swapped head pushed to the main replaces the main child it refers to.
;; Inside a copy of the main it is a swap of that child's position;
;; elsewhere it is a plain copy of its own component.
swap-in-copy? (and (ctk/swapped? shape)
(seq (ctn/get-parent-copy-heads (:objects component-container)
component-parent-shape)))
new-swap-ref (when (ctk/swapped? shape)
(if swap-in-copy?
(:shape-ref (ctn/get-shape component-container (:shape-ref shape)))
(swap-content-root-id libraries shape)))
update-new-shape (fn [new-shape original-shape]
(cond-> (reposition-shape new-shape
root-instance
root-main)
(and (= (:id original-shape) (:id shape))
(ctk/swapped? shape))
(assoc :shape-ref new-swap-ref)
(and (= (:id original-shape) (:id shape))
(ctk/swapped? shape)
(not swap-in-copy?))
(ctk/remove-swap-group)))
;; the copy now follows the main, swap included
update-original-shape (fn [original-shape new-shape]
(assoc original-shape
:shape-ref (:id new-shape)))
(-> original-shape
(assoc :shape-ref (:id new-shape))
(ctk/remove-swap-group)))
[_new-shape new-shapes updated-shapes]
(ctst/clone-shape shape
@ -1500,8 +1597,11 @@
(pcb/apply-changes-local)))))
(defn change-touched
"Update the touched groups of the dest shape: clear them (`reset-touched?`,
keeping the swap with `keep-swap?`), add those of the origin shape
(`copy-touched?`) or leave them as they are."
[changes dest-shape origin-shape container
{:keys [reset-touched? copy-touched?] :as options}]
{:keys [reset-touched? keep-swap? copy-touched?] :as options}]
(if (nil? (:shape-ref dest-shape))
changes
(do
@ -1514,6 +1614,9 @@
(pretty-uuid (:id dest-shape)))
:options options)
(let [new-touched (cond
(and reset-touched? keep-swap? (ctk/swapped? dest-shape))
#{:swap-group}
reset-touched?
nil
@ -2336,6 +2439,52 @@
(assoc attr (get origin attr)))))
dest))))
(defn- update-swapped-placement
"Synchronizes a swapped copy head with the main shape it replaces, in the
attributes that place it in its parent: position, constraints and layout
item attributes. Its content comes from its own component. A position set
by a layout is left to the layout."
[changes shape-inst shape-main root-inst root-main container]
(let [objects (:objects container)
touched (get shape-inst :touched #{})
untouched? (fn [attr]
(not (touched (ctk/resolve-sync-group (:type shape-inst) attr))))
placement (reduce (fn [attrs attr]
(let [value (get shape-main attr)]
(if (and (untouched? attr)
(not= value (get shape-inst attr)))
(assoc attrs attr value)
attrs)))
{}
placement-attrs)
position (fn [shape]
(gpt/point (dm/get-in shape [:selrect :x])
(dm/get-in shape [:selrect :y])))
delta (gpt/subtract (position (reposition-shape shape-main root-main root-inst))
(position shape-inst))
move? (and (untouched? :x)
(not (gpt/almost-zero? delta))
(or (not (ctsl/any-layout-immediate-child? objects shape-inst))
(ctsl/position-absolute? shape-inst)))]
(cond-> changes
(seq placement)
(pcb/update-shapes [(:id shape-inst)]
(fn [shape]
(reduce-kv (fn [shape attr value]
(if (nil? value)
(dissoc shape attr)
(assoc shape attr value)))
shape
placement))
{:ignore-touched true})
move?
(pcb/update-shapes (cfh/get-children-ids-with-self objects (:id shape-inst))
#(gsh/move % delta)
{:ignore-touched true}))))
(defn- update-flex-child-copy-attrs
"Synchronizes the attributes inside the flex-child items (main->copy)"
[changes shape-main shape-copy main-container main-component copy-container omit-touched?]
@ -2643,6 +2792,62 @@
(pcb/with-objects (:objects container))
(generate-detach-instance container libraries id))))
(defn- main-ref-ids
"Map the shapes of a main subtree to the shapes of a copy of it: for each
shape in the subtree of `head`, follow its ref chain until a shape whose id
is in `main-ids`, and map that id to the shape's id."
[file container libraries head main-ids]
(let [ref-in-main
(fn [shape]
(loop [shape shape container container steps 0]
(when (and (some? shape) (< steps 64))
(if (contains? main-ids (:id shape))
(:id shape)
(let [ref (ctf/find-ref-shape file container libraries shape
:include-deleted? true
:with-context? true)]
(recur ref (:container (meta ref)) (inc steps)))))))]
(into {}
(keep (fn [shape]
(when-let [main-id (ref-in-main shape)]
[main-id (:id shape)])))
(cfh/get-children-with-self (:objects container) (:id head)))))
(defn- generate-swap-in-copy
"A swap inside a copy keeps the position: the new head refers to the main
shape the old one referred to. It is marked as swapped while its component
differs from that shape's; otherwise it is a plain nested copy of it, and
its children refer to that shape's children."
[changes new-shape shape file page libraries]
(let [file* {:id (:id file) :data file}
ref-shape (ctf/find-ref-shape file* page libraries shape
:include-deleted? true
:with-context? true)
swapped? (or (nil? ref-shape)
(not= (:component-id ref-shape) (:component-id new-shape))
(not= (:component-file ref-shape) (:component-file new-shape)))
new-ids (->> (:redo-changes changes)
(filter #(= :add-obj (:type %)))
(map :obj)
(d/index-by :id))
children (->> (vals new-ids)
(filter #(contains? (set (cfh/get-parent-ids new-ids (:id %)))
(:id new-shape))))
ref-map (when-not swapped?
(main-ref-ids file* (:container (meta ref-shape)) libraries ref-shape
(into #{} (map :shape-ref) children)))]
[(cond-> (assoc new-shape :shape-ref (:shape-ref shape))
swapped?
(update :touched (fnil conj #{}) :swap-group))
(cond-> (pcb/update-shapes changes
[(:id new-shape)]
#(assoc % :shape-ref (:shape-ref shape))
{:ignore-touched true})
(seq ref-map)
(pcb/update-shapes (map :id children)
#(d/update-when % :shape-ref (fn [ref] (get ref-map ref ref)))
{:ignore-touched true}))]))
(defn generate-new-shape-for-swap
[changes shape file page libraries id-new-component index target-cell keep-props-values]
(let [objects (:objects page)
@ -2651,10 +2856,10 @@
(pcb/with-objects objects))
position (-> position (with-meta {:cell target-cell}))
parent (get objects (:parent-id shape))
inside-comp? (ctn/in-any-component? objects parent)
inside-copy? (ctk/in-component-copy? parent)
[new-shape changes]
;; When we make a swap of an item, there can be copies which swap-slot points to that item
;; When we make a swap of an item, there can be copies which refer to that item,
;; so we want to assign the item id to the new instanciated copy, to mantain that reference
(generate-instantiate-component changes
objects
@ -2669,15 +2874,10 @@
{(:id shape) (:id shape)} ;; keep the id of the original shape
{:force-frame? true})
new-shape (cond-> new-shape
;; if the shape isn't inside a main component, it shouldn't have a swap slot
(and (nil? (ctk/get-swap-slot new-shape))
inside-comp?)
(ctk/set-swap-slot (ctf/find-swap-slot shape
page
{:id (:id file)
:data file}
libraries)))]
[new-shape changes]
(if inside-copy?
(generate-swap-in-copy changes new-shape shape file page libraries)
[new-shape changes])]
[new-shape (-> changes
;; Restore the properties
@ -2698,8 +2898,9 @@
;; swapped children (we will keep them too)
ignore-swapped-fn
(if ignore-swapped?
#(-> (get objects %)
(ctk/get-swap-slot))
#(let [child (get objects %)]
(or (some? (ctk/get-swap-slot child))
(ctk/swapped? child)))
(constantly false))
;; In the cases where the swapped shape was the first element of the masked group it would make the group to loose the
@ -2967,7 +3168,17 @@
level-delta (if (some? level-delta)
level-delta
(ctn/get-nesting-level-delta objects obj parent))
new-shape-ref (ctf/advance-shape-ref nil page libraries obj level-delta {:include-deleted? true})
;; a swapped head that leaves every copy level
rehead? (and (ctk/swapped? obj)
(pos? level-delta)
(>= level-delta
(->> (ctn/get-parent-copy-heads objects obj)
(remove #(= (:id %) (:id obj)))
(count))))
new-shape-ref (if rehead?
(swap-content-root-id libraries obj)
(ctf/advance-shape-ref nil page libraries obj level-delta {:include-deleted? true}))
regenerate-component
(fn [changes shape]
@ -3006,6 +3217,9 @@
(not= new-shape-ref (:shape-ref obj)))
(assoc :shape-ref new-shape-ref))
(cond-> rehead?
(ctk/remove-swap-group))
(gsh/move delta)
(d/update-when :interactions #(ctsi/remap-interactions % ids-map objects))
@ -3053,7 +3267,8 @@
ids-map
child
delta
level-delta
;; the children of a swapped head refer into its own component
(if (ctk/swapped? obj) 0 level-delta)
libraries
library-data
file-id
@ -3085,18 +3300,37 @@
(and (some? new-shape-ref) (not= new-shape-ref (:shape-ref shape)))
(-> (assoc-in [(:id shape) :shape-ref] new-shape-ref)
(assoc-in [(:id shape) :touched]
(ctf/get-touched-from-ref-chain-until-target-ref
container libraries shape new-shape-ref))))))
(set/union
(or (:touched shape) #{})
(inherited-touched
shape
(ctf/get-touched-from-ref-chain-until-target-ref
container libraries shape new-shape-ref))))))))
detach-copy (fn [objects shape]
(reduce #(update %1 %2 ctk/detach-shape)
objects
(cfh/get-children-ids-with-self objects (:id shape))))
advance-copy (fn [objects shape]
(if (and (ctk/instance-head? shape) (not (ctk/main-instance? shape)))
(let [level-delta (if (nil? (ctk/get-swap-slot shape))
(ctn/get-nesting-level-delta (:objects page) shape uuid/zero)
0)]
(if (pos? level-delta)
(reduce (partial advance-shape level-delta)
objects
(cfh/get-children-with-self objects (:id shape)))
objects))
(cond
(not (pos? level-delta))
objects
;; the copy leaves every copy level
(ctk/swapped? shape)
(if-let [root-id (swap-content-root-id libraries shape)]
(update objects (:id shape) rehead-swapped root-id)
(detach-copy objects shape))
:else
(let [unchanged-ids (swapped-descendant-ids objects (:id shape))]
(reduce (partial advance-shape level-delta)
objects
(->> (cfh/get-children-with-self objects (:id shape))
(remove #(contains? unchanged-ids (:id %))))))))
objects))]
(reduce advance-copy
objects

41
common/src/app/common/logic/variants.cljc
View File

@ -105,6 +105,17 @@
(ctk/remove-swap-slot)
(ctk/set-swap-slot (:shape-ref related-shape-in-new)))))
;; A swap stored as override takes the place of the related shape,
;; and stays a swap while its component differs from that one
(cond->
(ctk/swapped? orig-swapped-child)
(pcb/update-shapes
[(:id orig-swapped-child)]
#(cond-> (assoc % :shape-ref (:shape-ref related-shape-in-new))
(and (= (:component-id %) (:component-id related-shape-in-new))
(= (:component-file %) (:component-file related-shape-in-new)))
(ctk/remove-swap-group))))
;; Delete new non-swapped item
(cls/generate-delete-shapes ldata page objects (d/ordered-set (:id related-shape-in-new)) {:allow-altering-copies true})
second)))
@ -120,7 +131,7 @@
;; Ignore first and last (base-parent and shape)
ancestors (when (and ancestors (<= 3 num-ancestors))
(subvec (vec ancestors) 1 (dec num-ancestors)))]
(some ctk/get-swap-slot ancestors)))
(some #(or (ctk/get-swap-slot %) (ctk/swapped? %)) ancestors)))
(defn- find-shape-ref-child-of
"Get the shape referenced by the shape-ref of the near main of the shape,
@ -141,10 +152,15 @@
(defn- add-touched-from-ref-chain
"Adds to the :touched attr of a shape the content of
the :touched of all its chain of ref shapes"
the :touched of all its chain of ref shapes. A swap made in a main of the
chain is part of that main, so only the shape's own swap counts, and a
swapped shape keeps only its own groups."
[container libraries shape]
(let [new-touched (ctf/get-touched-from-ref-chain-until-target-ref container libraries shape nil)]
(assoc shape :touched new-touched)))
(if (ctk/swapped? shape)
;; its content comes from its own component's main, which has no overrides
shape
(let [new-touched (ctf/get-touched-from-ref-chain-until-target-ref container libraries shape nil)]
(assoc shape :touched (disj new-touched :swap-group)))))
(defn generate-keep-touched
"This is used as part of the switch process, when you switch from
@ -201,13 +217,20 @@
[changes parents-of-swapped]
(reduce
(fn [[changes parent-of-swapped] orig-child-touched]
(let [;; If the orig-child-touched was swapped, get its swap-slot
swap-slot (ctk/get-swap-slot orig-child-touched)
(let [;; The switched shape itself relates to the root of the new one
root? (= (:id orig-child-touched) (:id original-shape))
;; If the orig-child-touched was swapped, get its swap-slot
swap-slot (when-not root? (ctk/get-swap-slot orig-child-touched))
swapped? (and (not root?)
(or (some? swap-slot) (ctk/swapped? orig-child-touched)))
;; orig-child-touched is in a copy. Get the referenced shape on the main component
;; If there is a swap slot, we will get the referenced shape in another way
orig-ref-shape (when-not swap-slot
(find-shape-ref-child-of container libraries orig-child-touched (:id orig-base-ref-shape)))
orig-ref-shape (cond
root? orig-base-ref-shape
swap-slot nil
:else (find-shape-ref-child-of container libraries orig-child-touched (:id orig-base-ref-shape)))
orig-ref-id (if swap-slot
;; If there is a swap slot, find the referenced shape id
@ -228,7 +251,7 @@
;; If there is a related shape, keep its data
changes
(if related-shape-in-new
(if swap-slot
(if swapped?
;; If the orig-child-touched was swapped, keep it
(keep-swapped-item changes related-shape-in-new orig-child-touched
ldata page orig-ref-id)

38
common/src/app/common/test_helpers/components.cljc
View File

@ -146,11 +146,43 @@
file'))
(defn swap-slot-of
"The swap slot a swap of `shape` stored, in files older than the feature
components/swap-group: the deepest main child of its position, when the
shape is inside a component."
[file libraries shape]
(let [page (thf/current-page file)
objects (:objects page)]
(when (ctn/in-any-component? objects (get objects (:parent-id shape)))
(ctf/find-swap-slot shape page file (assoc libraries (:id file) file)))))
(defn store-swap-as-slot
"Store the swap of the head `head-id` the way files older than the feature
components/swap-group do: its :shape-ref on the root of its own component,
and the swap slot `slot` in :touched."
[file libraries head-id slot]
(let [page (thf/current-page file)
libraries (assoc libraries (:id file) file)
head (ctst/get-shape page head-id)
component (ctf/get-component libraries (:component-file head) (:component-id head)
:include-deleted? true)
head' (cond-> head
(ctk/swapped? head)
(-> (assoc :shape-ref (:main-instance-id component))
(ctk/remove-swap-group))
(some? slot)
(ctk/set-swap-slot slot))]
(update file :data ctpl/update-page (:id page) #(ctst/set-shape % head'))))
(defn component-swap
[file shape-label new-component-label new-shape-label & {:keys [library children-labels] :as params}]
"Swap the shape for a copy of the component. With `as-slot?`, store the swap
the way files older than the feature components/swap-group do."
[file shape-label new-component-label new-shape-label & {:keys [library children-labels as-slot?] :as params}]
(let [shape (ths/get-shape file shape-label)
library (or library file)
libraries {(:id library) library}
slot (when as-slot? (swap-slot-of file libraries shape))
page (thf/current-page file)
objects (:objects page)
id-new-component (-> (get-component library new-component-label)
@ -163,7 +195,9 @@
(-> (pcb/empty-changes nil (:id page))
(cll/generate-component-swap objects shape (:data file) page libraries id-new-component 0 nil keep-props-values false))
file' (thf/apply-changes file changes)]
file' (cond-> (thf/apply-changes file changes)
as-slot?
(store-swap-as-slot libraries (:id new_shape) slot))]
(thi/set-id! new-shape-label (:id new_shape))

41
common/src/app/common/test_helpers/composable/comp/cases.cljc
View File

@ -831,9 +831,9 @@
original (:component-id (tm/shape-by-id s (:nested-head (n/lineage-nesting s m 0))))]
(t/is (= original (head-component s nested)))
(t/is (= base-color (head-rect-color s nested)))
;; the reset climbs to the top copy and clears its overrides
(tm/known-failure "F12" 0.5 nil (:opacity root))
(tm/known-failure "F12" #{:layer-effects-group} nil (:touched root))))}))
;; the reset leaves the top copy's overrides alone
(t/is (= 0.5 (:opacity root)))
(t/is (= #{:layer-effects-group} (:touched root)))))}))
(defn second-variant-switch-keeps-root-overrides
"Case AC. A copy nests a variant; the copy overrides the opacity of the
@ -859,10 +859,8 @@
:asserter (fn [s]
(t/is (= (n/variant-member-component-id s "vset" "c") (head-component s nested)))
(t/is (= green (head-rect-color s nested)))
;; the second switch of a head with a swap slot loses its overrides
(tm/known-failure "F29" 0.5 nil (:opacity (root s)))
(tm/known-failure "F29" true false
(contains? (:touched (root s)) :layer-effects-group)))}))
(t/is (= 0.5 (:opacity (root s))))
(t/is (contains? (:touched (root s)) :layer-effects-group)))}))
(defn update-main-pushes-a-swapped-child
"Case AD. Of two copies, the first swaps its nested copy and pushes that to
@ -891,11 +889,7 @@
(t/is (= s1 (head-component s first-nested)))
(t/is (= red (head-rect-color s first-nested)))
(t/is (= (main-nested s) (:shape-ref first)))
;; update main leaves the swapped child its swap slot
(tm/known-failure "F16" #{} #{:swap-slot}
(into #{}
(map #(if (ctk/swap-slot? %) :swap-slot %))
(:touched first)))
(t/is (empty? (:touched first)))
(t/is (= s1 (head-component s second-nested)))
(t/is (= red (head-rect-color s second-nested)))))}))
@ -903,7 +897,7 @@
"Case AE. A copy swaps its nested copy; then the copy is detached, or
duplicated; then the main of the component it swapped to changes. Detached,
the root loses its link and the nested copy becomes a top-level copy of
that component, with no swap slot; duplicated, the duplicate's nested copy
that component, no longer swapped; duplicated, the duplicate's nested copy
is one too. Either way it follows the change."
[]
(let [m "main"
@ -925,11 +919,11 @@
(t/is (= blue (head-rect-color s nested)))
(when-not (tm/applied? s duplication)
;; the detached root lost its link; its nested copy is a
;; top-level copy now, with no swap slot
;; top-level copy now, no longer swapped
(let [head (tm/shape-by-id s (nested s))]
(t/is (nil? (:component-id (tm/shape-by-id s ((n/copy-head-of m) s)))))
(t/is (:component-root head))
(t/is (nil? (ctk/get-swap-slot head)))))
(t/is (not (ctk/swapped? head)))))
(when (tm/applied? s duplication)
(t/is (= s1 (head-component s dup-nested)))
(t/is (= blue (head-rect-color s dup-nested))))))}))
@ -949,10 +943,7 @@
(n/move-to-cell :main-root :main-child 1 3)])
:asserter (fn [s]
(t/is (= 3 (column s :main-root :main-child)))
(if (tm/applied? s swap)
;; the grid sync pairs a slotted child only by its raw slot
(tm/known-failure "F44" 3 1 (column s :copy-root :copy-child))
(t/is (= 3 (column s :copy-root :copy-child)))))}))
(t/is (= 3 (column s :copy-root :copy-child))))}))
(defn main-reorder-keeps-copy-sub-heads-aligned
"Case AG (the plugin's MainReorderKeepsCopySlots). A main holds three
@ -1038,10 +1029,12 @@
in-col-3 (mapv :component-id (get placement 3))
expected [(:component-id copy-child)]]
(if (tm/applied? s swap)
;; the cells keep the copy child's id, which no main child has
;; the cells keep the id of the main child update main
;; replaced, which is gone, and the new main child is in
;; no cell
(tm/known-failure "F49"
[{:stray #{} :uncelled 0} expected]
[{:stray #{(:id copy-child)} :uncelled 1} expected]
[{:stray #{nil} :uncelled 1} [nil]]
[cells in-col-3])
(do
(t/is (= {:stray #{} :uncelled 0} cells))
@ -1093,11 +1086,7 @@
(t/is (= [(:component-id copy-child)] (mapv :component-id in-group)))
(t/is (= [(:shape-ref copy-child)] (mapv :id in-group)))
(t/is (empty? (:touched (tm/role-shape s :copy-root))))
;; update main leaves the swapped child its swap slot
(tm/known-failure "F16" #{} #{:swap-slot}
(into #{}
(map #(if (ctk/swap-slot? %) :swap-slot %))
(:touched copy-child)))))})
(t/is (empty? (:touched copy-child)))))})
(defn flex-child-override-follows-sync-reset-and-update-main
"Case AN. A copy of a flex main overrides its child's margin. Then the main

22
common/src/app/common/test_helpers/compositions.cljc
View File

@ -411,8 +411,10 @@
(thf/apply-changes file changes :validate? false)))
(defn swap-component-
"Swap the specified shape by the component specified by component-tag"
[file shape component-tag & {:keys [page-label propagate-fn keep-touched? new-shape-label library]}]
"Swap the specified shape by the component specified by component-tag. With
`as-slot?`, store the swap the way files older than the feature
components/swap-group do."
[file shape component-tag & {:keys [page-label propagate-fn keep-touched? new-shape-label library as-slot?]}]
(let [page (if page-label
(thf/get-page file page-label)
(thf/current-page file))
@ -420,6 +422,7 @@
(some? library)
(assoc (:id library) library))
library (or library file)
slot (when as-slot? (thc/swap-slot-of file libraries shape))
orig-shapes (when keep-touched? (cfh/get-children-with-self (:objects page) (:id shape)))
@ -442,7 +445,10 @@
[changes nil])
file' (thf/apply-changes file changes :validate? (not propagate-fn))]
file' (cond-> (thf/apply-changes file changes :validate? (and (not propagate-fn) (not as-slot?)))
as-slot?
(-> (thc/store-swap-as-slot libraries (:id new-shape) slot)
(cond-> (not propagate-fn) (thf/validate-file!))))]
(when new-shape-label
(thi/rm-id! (:id new-shape))
(thi/set-id! new-shape-label (:id new-shape)))
@ -452,17 +458,18 @@
file')))
(defn swap-component-in-shape
[file shape-tag component-tag & {:keys [page-label propagate-fn keep-touched? new-shape-label library]}]
[file shape-tag component-tag & {:keys [page-label propagate-fn keep-touched? new-shape-label library as-slot?]}]
(swap-component- file (ths/get-shape file shape-tag :page-label page-label)
component-tag
:page-label page-label
:propagate-fn propagate-fn
:keep-touched? keep-touched?
:new-shape-label new-shape-label
:library library))
:library library
:as-slot? as-slot?))
(defn swap-component-in-first-child
[file shape-tag component-tag & {:keys [page-label propagate-fn library]}]
[file shape-tag component-tag & {:keys [page-label propagate-fn library as-slot?]}]
(let [first-child-id (->> (ths/get-shape file shape-tag :page-label page-label)
:shapes
first)]
@ -471,7 +478,8 @@
component-tag
:page-label page-label
:propagate-fn propagate-fn
:library library)))
:library library
:as-slot? as-slot?)))
(defn update-color
"Update the first fill color for the shape identified by shape-tag"

14
common/src/app/common/types/component.cljc
View File

@ -260,6 +260,19 @@
[shape group]
((or (:touched shape) #{}) group))
(defn swapped?
"Whether the copy head was swapped by the user: its component is its own
choice, not the one of the main shape it refers to."
[shape]
(contains? (:touched shape) :swap-group))
(defn remove-swap-group
"Make the shape not swapped."
[shape]
(cond-> shape
(swapped? shape)
(update :touched disj :swap-group)))
(defn build-swap-slot-group
"Convert a swap-slot into a :touched group"
[swap-slot]
@ -395,5 +408,6 @@
[group]
(ex/ignoring
(or (contains? all-touched-groups group)
(= group :swap-group)
(and (swap-slot? group)
(some? (group->swap-slot group))))))

49
common/src/app/common/types/file.cljc
View File

@ -400,6 +400,14 @@
(when (:shape-ref shape)
(get-component-shape file-data component (:shape-ref shape) :with-context? with-context?)))
(defn get-content-ref-shape
"Retrieve the shape in the component whose content the instance shape
follows: the root for a swapped head, the referenced shape otherwise."
[file-data component shape]
(if (ctk/swapped? shape)
(get-component-root file-data component)
(get-ref-shape file-data component shape)))
(defn get-shape-in-copy
"Given a shape in the main component and the root of the copy component returns the equivalent
shape inside the root copy that matches the main-shape"
@ -420,6 +428,26 @@
(get-ref-shape (:data component-file) component shape :with-context? with-context?))))]
(some find-ref-shape-in-head (ctn/get-parent-heads (:objects container) shape))))
(defn find-content-ref-shape
"Retrieve the shape whose content the instance shape follows: the main root
of its own component for a swapped head, the referenced shape otherwise."
[file container libraries shape & {:keys [include-deleted? with-context?] :or {include-deleted? false with-context? false}}]
(if (ctk/swapped? shape)
(let [component-file (find-component-file file libraries (:component-file shape))
file-data (:data component-file)
component (when (some? component-file)
(ctkl/get-component file-data (:component-id shape) include-deleted?))
root (when (some? component)
(get-component-root file-data component))]
(cond-> root
(and (some? root) with-context?)
(with-meta {:file {:id (:id file-data)
:data file-data}
:container (get-component-container file-data component)})))
(find-ref-shape file container libraries shape
:include-deleted? include-deleted?
:with-context? with-context?)))
(defn find-near-match
"Locate the shape that occupies the same position in the near main component.
This will be the ref-shape except if the shape is a copy subhead that has been
@ -478,9 +506,20 @@
(some find-ref-component-in-head (ctn/get-parent-copy-heads (:objects page) shape))))
(declare find-remote-shape*)
(defn find-remote-shape
"Recursively go back by the :shape-ref of the shape until find the correct shape of the original component"
"Recursively go back by the :shape-ref of the shape until find the correct shape of the original component.
The remote shape of a swapped head is the main root of its own component."
[container libraries shape & {:keys [with-context?] :or {with-context? false}}]
(if (ctk/swapped? shape)
(find-content-ref-shape nil container libraries shape
:include-deleted? true
:with-context? with-context?)
(find-remote-shape* container libraries shape with-context?)))
(defn- find-remote-shape*
[container libraries shape with-context?]
(let [top-instance (ctn/get-component-shape (:objects container) shape)
component-file (get-in libraries [(:component-file top-instance) :data])
component (ctkl/get-component component-file (:component-id top-instance) true)
@ -509,10 +548,12 @@
(defn direct-copy?
"Check if the shape is in a direct copy of the component (i.e. the shape-ref points to shapes inside
the component)."
the component). A swapped head is a direct copy of its own component."
[shape component page file libraries]
(let [ref-component (find-ref-component file page libraries shape :include-deleted? true)]
(true? (= (:id component) (:id ref-component)))))
(if (ctk/swapped? shape)
(= (:id component) (:component-id shape))
(let [ref-component (find-ref-component file page libraries shape :include-deleted? true)]
(true? (= (:id component) (:id ref-component))))))
(defn find-swap-slot
([shape container file libraries]

18
common/test/common_tests/files/comp_processors_test.cljc
View File

@ -259,7 +259,7 @@
(tho/add-simple-component :component3 :main3-root :main3-child
:root-params {:name "Frame3"}
:child-params {:name "Rect3"})
(tho/swap-component-in-first-child :copy2-root :component3))
(tho/swap-component-in-first-child :copy2-root :component3 :as-slot? true))
file' (ctf/update-file-data file #(cfcp/fix-missing-swap-slots % {}))]
@ -289,7 +289,7 @@
:root-params {:name "Frame3"}
:child-params {:name "Rect3"})
(tho/swap-component-in-shape :nested-head :component3
:propagate-fn #(tho/propagate-component-changes % :component2)))
:propagate-fn #(tho/propagate-component-changes % :component2) :as-slot? true))
file' (ctf/update-file-data file #(cfcp/fix-missing-swap-slots % {}))]
@ -318,7 +318,7 @@
(tho/add-simple-component :component3 :main3-root :main3-child
:root-params {:name "Frame3"}
:child-params {:name "Rect3"})
(tho/swap-component-in-first-child :copy2-root :component3)
(tho/swap-component-in-first-child :copy2-root :component3 :as-slot? true)
(ths/update-shape :copy2-nested-head :touched nil))
file' (ctf/update-file-data file #(cfcp/fix-missing-swap-slots % {}))
@ -360,7 +360,7 @@
:root-params {:name "Frame3"}
:child-params {:name "Rect3"})
(tho/swap-component-in-shape :nested-head :component3
:propagate-fn #(tho/propagate-component-changes % :component2))
:propagate-fn #(tho/propagate-component-changes % :component2) :as-slot? true)
(ths/update-shape :nested-head :touched nil))
file' (ctf/update-file-data file #(cfcp/fix-missing-swap-slots % {}))]
@ -398,7 +398,7 @@
:root-params {:name "Frame4"}
:child-params {:name "Rect4"})
(tho/swap-component-in-shape :nested-subhead2 :component4
:propagate-fn #(tho/propagate-component-changes % :component3))
:propagate-fn #(tho/propagate-component-changes % :component3) :as-slot? true)
(ths/update-shape :nested-subhead2 :touched nil))
file' (ctf/update-file-data file #(cfcp/fix-missing-swap-slots % {}))
@ -452,7 +452,7 @@
(-> (thf/sample-file :file1)
(thc/instantiate-component :component2 :copy2 :children-labels [:copy2-nested-head]
:library library1)
(tho/swap-component-in-first-child :copy2 :component4 :library library2)
(tho/swap-component-in-first-child :copy2 :component4 :library library2 :as-slot? true)
(ths/update-shape :copy2-nested-head :touched nil))
libraries {(:id library1) library1
@ -553,7 +553,7 @@
:root-params {:name "Frame3"}
:child-params {:name "Rect3"})
(thc/instantiate-component :component2 :copy3-root :children-labels [:copy3-nested-head])
(tho/swap-component-in-first-child :copy3-root :component3))
(tho/swap-component-in-first-child :copy3-root :component3 :as-slot? true))
file' (ctf/update-file-data file #(cfcp/sync-component-id-with-ref-shape % {}))]
@ -626,7 +626,7 @@
:root-params {:name "Frame3"}
:child-params {:name "Rect3"})
(tho/swap-component-in-shape :nested-head :component3
:propagate-fn #(tho/propagate-component-changes % :component2))
:propagate-fn #(tho/propagate-component-changes % :component2) :as-slot? true)
(ths/update-shape :copy2-nested-head :component-id (thi/new-id! :some-other-id))
(ths/update-shape :copy2-nested-head :component-file (thi/new-id! :some-other-file)))
@ -784,7 +784,7 @@
:nested-head-params {:children-labels [:nested4-child]}))
library1
(tho/swap-component-in-shape library1 :nested2-head :component4 :library library2)
(tho/swap-component-in-shape library1 :nested2-head :component4 :library library2 :as-slot? true)
file
;; :copy2 [:name Frame2] #--> [Component :component2] :main2-root

2
common/test/common_tests/files/repair_components_test.cljc
View File

@ -407,7 +407,7 @@
(t/deftest missing-slot
(let [file (-> (two-nested)
(tho/add-simple-component :component3 :main3-root :main3-child)
(tho/swap-component-in-shape :copy-a :component3 :new-shape-label :swapped)
(tho/swap-component-in-shape :copy-a :component3 :new-shape-label :swapped :as-slot? true)
(ths/update-shape :swapped :touched nil))
[found file' errors] (repair file)]
(t/is (= #{:missing-slot} found))

30
common/test/common_tests/logic/comp_detach_with_nested_test.cljc
View File

@ -93,15 +93,15 @@
;; are advanced to point to the new near main inside board-with-ellipse.
(t/is (ctk/instance-root? copy-h-board-with-ellipse))
(t/is (= (:shape-ref copy-h-board-with-ellipse) (thi/id :board-with-ellipse)))
(t/is (nil? (ctk/get-swap-slot copy-h-board-with-ellipse)))
(t/is (not (ctk/swapped? copy-h-board-with-ellipse)))
(t/is (ctk/instance-head? copy-nested-h-ellipse))
(t/is (= (:shape-ref copy-nested-h-ellipse) (thi/id :nested-h-ellipse)))
(t/is (nil? (ctk/get-swap-slot copy-nested-h-ellipse)))
(t/is (not (ctk/swapped? copy-nested-h-ellipse)))
(t/is (not (ctk/instance-head? copy-nested-ellipse)))
(t/is (= (:shape-ref copy-nested-ellipse) (thi/id :nested-ellipse)))
(t/is (nil? (ctk/get-swap-slot copy-nested-ellipse)))))
(t/is (not (ctk/swapped? copy-nested-ellipse)))))
(t/deftest test-advance-in-library
(let [;; ==== Setup
@ -135,15 +135,15 @@
;; It should the same as above, but in an external library.
(t/is (ctk/instance-root? copy-h-board-with-ellipse))
(t/is (= (:shape-ref copy-h-board-with-ellipse) (thi/id :board-with-ellipse)))
(t/is (nil? (ctk/get-swap-slot copy-h-board-with-ellipse)))
(t/is (not (ctk/swapped? copy-h-board-with-ellipse)))
(t/is (ctk/instance-head? copy-nested-h-ellipse))
(t/is (= (:shape-ref copy-nested-h-ellipse) (thi/id :nested-h-ellipse)))
(t/is (nil? (ctk/get-swap-slot copy-nested-h-ellipse)))
(t/is (not (ctk/swapped? copy-nested-h-ellipse)))
(t/is (not (ctk/instance-head? copy-nested-ellipse)))
(t/is (= (:shape-ref copy-nested-ellipse) (thi/id :nested-ellipse)))
(t/is (nil? (ctk/get-swap-slot copy-nested-ellipse)))))
(t/is (not (ctk/swapped? copy-nested-ellipse)))))
(t/deftest test-advance-in-broken-library
(let [;; ==== Setup
@ -215,15 +215,15 @@
;; as they already pointing to the near main inside board-with-rectangle.
(t/is (ctk/instance-root? copy-h-board-with-rectangle))
(t/is (= (:shape-ref copy-h-board-with-rectangle) (thi/id :board-with-rectangle)))
(t/is (nil? (ctk/get-swap-slot copy-h-board-with-rectangle)))
(t/is (not (ctk/swapped? copy-h-board-with-rectangle)))
(t/is (ctk/instance-head? copy-nested-h-rectangle))
(t/is (= (:shape-ref copy-nested-h-rectangle) (thi/id :nested-h-rectangle)))
(t/is (nil? (ctk/get-swap-slot copy-nested-h-rectangle)))
(t/is (not (ctk/swapped? copy-nested-h-rectangle)))
(t/is (not (ctk/instance-head? copy-nested-rectangle)))
(t/is (= (:shape-ref copy-nested-rectangle) (thi/id :nested-rectangle)))
(t/is (nil? (ctk/get-swap-slot copy-nested-rectangle)))))
(t/is (not (ctk/swapped? copy-nested-rectangle)))))
(t/deftest test-propagate-slot-when-swapped-main
(let [;; ==== Setup
@ -259,17 +259,17 @@
;; This one is advanced normally, as it has not been swapped.
(t/is (ctk/instance-root? copy-h-board-with-ellipse))
(t/is (= (:shape-ref copy-h-board-with-ellipse) (thi/id :board-with-ellipse)))
(t/is (nil? (ctk/get-swap-slot copy-h-board-with-ellipse)))
(t/is (not (ctk/swapped? copy-h-board-with-ellipse)))
;; If the nested copy has been swapped in the main, it does advance,
;; but the swap slot of the near main is propagated to the copy.
;; If the nested copy has been swapped in the main, it advances by
;; position, and takes the swap of the near main.
(t/is (ctk/instance-head? copy-nested-h-rectangle))
(t/is (= (:shape-ref copy-nested-h-rectangle) (thi/id :r-rectangle)))
(t/is (= (ctk/get-swap-slot copy-nested-h-rectangle) (thi/id :nested-h-ellipse)))
(t/is (= (:shape-ref copy-nested-h-rectangle) (thi/id :nested-h-ellipse)))
(t/is (ctk/swapped? copy-nested-h-rectangle))
(t/is (not (ctk/instance-head? copy-nested-rectangle)))
(t/is (= (:shape-ref copy-nested-rectangle) (thi/id :rectangle)))
(t/is (nil? (ctk/get-swap-slot copy-nested-rectangle)))))
(t/is (not (ctk/swapped? copy-nested-rectangle)))))
(t/deftest test-propagate-touched
(let [;; ==== Setup

112
common/test/common_tests/logic/comp_remove_swap_slots_test.cljc
View File

@ -30,10 +30,10 @@
;; {:frame-green} [:name Frame1] # [Component :green]
;; :red-copy-green [:name Frame1] @--> :frame-red
;; {:frame-b1} [:name Frame1] # [Component :b1]
;; :blue1 [:name Frame1, :swap-slot-label :red-copy] @--> :frame-blue
;; :blue1 [:name Frame1] @--> :frame-blue
;; :frame-yellow [:name Frame1]
;; :green-copy [:name Frame1] @--> :frame-green
;; :blue2 [:name Frame1, :swap-slot-label :red-copy-green] @--> :frame-blue
;; :blue2 [:name Frame1] (swapped) @--> :frame-blue
;; {:frame-b2} [:name Frame1] # [Component :b2]
(-> (thf/sample-file :file1)
(tho/add-frame :frame-red)
@ -75,12 +75,12 @@
;; ==== Check
;; blue1 had swap-id before move
(t/is (some? (ctk/get-swap-slot blue1)))
;; blue1 was swapped in a main, so it is not marked
(t/is (not (ctk/swapped? blue1)))
;; blue1 has not swap-id after move
;; blue1 is still a plain nested copy
(t/is (some? blue1'))
(t/is (nil? (ctk/get-swap-slot blue1')))))
(t/is (not (ctk/swapped? blue1')))))
(t/deftest test-remove-swap-slot-relocating-blue1-to-b2
(let [;; ==== Setup
@ -105,12 +105,12 @@
;; ==== Check
;; blue1 had swap-id before move
(t/is (some? (ctk/get-swap-slot blue1)))
;; blue1 was swapped in a main, so it is not marked
(t/is (not (ctk/swapped? blue1)))
;; blue1 has not swap-id after move
;; blue1 is still a plain nested copy
(t/is (some? blue1'))
(t/is (nil? (ctk/get-swap-slot blue1')))))
(t/is (not (ctk/swapped? blue1')))))
(t/deftest test-remove-swap-slot-relocating-yellow-to-root
(let [;; ==== Setup
@ -148,12 +148,12 @@
;; ==== Check
;; blue1 had swap-id before move
(t/is (some? (ctk/get-swap-slot blue1)))
;; blue1 was swapped in a main, so it is not marked
(t/is (not (ctk/swapped? blue1)))
;; blue1 has not swap-id after move
;; blue1 is still a plain nested copy
(t/is (some? blue1''))
(t/is (nil? (ctk/get-swap-slot blue1'')))))
(t/is (not (ctk/swapped? blue1'')))))
(t/deftest test-remove-swap-slot-relocating-yellow-to-b2
(let [;; ==== Setup
@ -192,12 +192,12 @@
;; ==== Check
;; blue1 had swap-id before move
(t/is (some? (ctk/get-swap-slot blue1)))
;; blue1 was swapped in a main, so it is not marked
(t/is (not (ctk/swapped? blue1)))
;; blue1 has not swap-id after move
;; blue1 is still a plain nested copy
(t/is (some? blue1''))
(t/is (nil? (ctk/get-swap-slot blue1'')))))
(t/is (not (ctk/swapped? blue1'')))))
(defn- find-duplicated-shape
[original-shape page]
@ -238,12 +238,12 @@
;; ==== Check
;; blue1 has swap-id
(t/is (some? (ctk/get-swap-slot blue1')))
;; blue1 was swapped in a main, so it is not marked
(t/is (not (ctk/swapped? blue1')))
;; duplicated-blue1 has not swap-id
;; neither is its duplicate
(t/is (some? duplicated-blue1'))
(t/is (nil? (ctk/get-swap-slot duplicated-blue1')))))
(t/is (not (ctk/swapped? duplicated-blue1')))))
(t/deftest test-remove-swap-slot-duplicate-yellow
(let [;; ==== Setup
@ -293,12 +293,12 @@
;; ==== Check
;; blue1'' has swap-id
(t/is (some? (ctk/get-swap-slot blue1'')))
;; blue1 was swapped in a main, so it is not marked
(t/is (not (ctk/swapped? blue1'')))
;; duplicated-blue1'' has not swap-id
;; neither is its duplicate
(t/is (some? duplicated-blue1''))
(t/is (nil? (ctk/get-swap-slot duplicated-blue1'')))))
(t/is (not (ctk/swapped? duplicated-blue1'')))))
(t/deftest test-keep-swap-slot-relocating-blue1-before-yellow
(let [;; ==== Setup
@ -322,12 +322,12 @@
;; ==== Check
;; blue1 had swap-id before move
(t/is (some? (ctk/get-swap-slot blue1)))
;; blue1 was swapped in a main, so it is not marked
(t/is (not (ctk/swapped? blue1)))
;; blue1 still has swap-id after move
;; blue1 is still a plain nested copy
(t/is (some? blue1'))
(t/is (some? (ctk/get-swap-slot blue1')))))
(t/is (not (ctk/swapped? blue1')))))
(t/deftest test-keep-swap-slot-move-blue1-inside-and-outside-yellow
(let [;; ==== Setup
@ -365,12 +365,12 @@
;; ==== Check
;; blue1 has swap-id before move
(t/is (some? (ctk/get-swap-slot blue1)))
;; blue1 was swapped in a main, so it is not marked
(t/is (not (ctk/swapped? blue1)))
;;blue1 still has swap-id after move
;; blue1 is still a plain nested copy
(t/is (some? blue1''))
(t/is (some? (ctk/get-swap-slot blue1'')))))
(t/is (not (ctk/swapped? blue1'')))))
(t/deftest test-keep-swap-slot-relocate-blue1-inside-and-outside-yellow
@ -411,12 +411,12 @@
;; ==== Check
;; blue1 has swap-id before move
(t/is (some? (ctk/get-swap-slot blue1)))
;; blue1 was swapped in a main, so it is not marked
(t/is (not (ctk/swapped? blue1)))
;;blue1 still has swap-id after move
;; blue1 is still a plain nested copy
(t/is (some? blue1''))
(t/is (some? (ctk/get-swap-slot blue1'')))))
(t/is (not (ctk/swapped? blue1'')))))
(t/deftest test-remove-swap-slot-relocating-green-copy-to-root
@ -442,12 +442,12 @@
;; ==== Check
;; blue2 had swap-id before move
(t/is (some? (ctk/get-swap-slot blue2)))
;; blue2 is swapped before the move
(t/is (ctk/swapped? blue2))
;; blue1still has swap-id after move
;; blue2 is still swapped after the move
(t/is (some? blue2'))
(t/is (some? (ctk/get-swap-slot blue2')))))
(t/is (ctk/swapped? blue2'))))
(t/deftest test-remove-swap-slot-relocating-green-copy-to-b2
(let [;; ==== Setup
@ -473,12 +473,12 @@
;; ==== Check
;; blue2 had swap-id before move
(t/is (some? (ctk/get-swap-slot blue2)))
;; blue2 is swapped before the move
(t/is (ctk/swapped? blue2))
;; blue1still has swap-id after move
;; blue2 is still swapped after the move
(t/is (some? blue2'))
(t/is (some? (ctk/get-swap-slot blue2')))))
(t/is (ctk/swapped? blue2'))))
(t/deftest test-remove-swap-slot-duplicating-green-copy
(let [;; ==== Setup
@ -515,12 +515,12 @@
;; ==== Check
;; blue1 has swap-id
(t/is (some? (ctk/get-swap-slot blue1')))
;; blue1 was swapped in a main, so it is a plain nested copy
(t/is (not (ctk/swapped? blue1')))
;; duplicated-blue1 also has swap-id
;; the duplicate of blue2 is swapped too
(t/is (some? duplicated-blue1'))
(t/is (some? (ctk/get-swap-slot duplicated-blue1')))))
(t/is (ctk/swapped? duplicated-blue1'))))
(t/deftest test-swap-outside-component-doesnt-have-swap-slot
(let [;; ==== Setup
@ -536,9 +536,9 @@
;; ==== Check
;; blue-copy1 has not swap-id
;; blue-copy1 is not swapped
(t/is (some? blue-copy1'))
(t/is (nil? (ctk/get-swap-slot blue-copy1')))))
(t/is (not (ctk/swapped? blue-copy1')))))
(t/deftest test-remove-swap-slot-detach
(let [;; ==== Setup
@ -561,9 +561,9 @@
;; ==== Check
;; blue2 had swap-id before move
(t/is (some? (ctk/get-swap-slot blue2)))
;; blue2 is swapped before the detach
(t/is (ctk/swapped? blue2))
;; blue2' has not swap-id after move
;; blue2 is a plain copy after the detach
(t/is (some? blue2'))
(t/is (nil? (ctk/get-swap-slot blue2')))))
(t/is (not (ctk/swapped? blue2')))))

17
common/test/common_tests/logic/swap_and_reset_test.cljc
View File

@ -49,13 +49,12 @@
(ths/get-shape-by-id file)
(:component-id)))
(nested-swap-slot [file]
(nested-shape [file]
(->>
(ths/get-shape file :copy)
:shapes
first
(ths/get-shape-by-id file)
(ctk/get-swap-slot)))
(ths/get-shape-by-id file)))
(circle-component-id [file]
(:id (thc/get-component file :circle)))
@ -75,13 +74,14 @@
(tho/swap-component-in-shape :copy-copy-rectangle :circle)
(validate #(t/is (= (copy-type %) :circle)))
(validate #(t/is (= (nested-component-id %) (circle-component-id %))))
(validate #(t/is (= (copy-rectangle-id %) (nested-swap-slot %))))
(validate #(t/is (= (copy-rectangle-id %) (:shape-ref (nested-shape %)))))
(validate #(t/is (ctk/swapped? (nested-shape %))))
;; Do a "Reset override" on the newly created Ellipse. It should swap for a Rectangle
(tho/reset-overrides-in-first-child :copy)
(validate #(t/is (= (copy-type %) :rect)))
(validate #(t/is (= (nested-component-id %) (rectangle-component-id %))))
(validate #(t/is (nil? (nested-swap-slot %)))))))
(validate #(t/is (not (ctk/swapped? (nested-shape %))))))))
;; The nested component sits inside a group, not directly under the instance root.
;; Resetting overrides after a swap must undo the swap without error.
@ -135,10 +135,11 @@
;; ==== Check – after swap
(t/is (= :circle (:type (tho/bottom-shape file-swapped :copy-nested-swapped))))
(t/is (= circle-id (:component-id swapped)))
(t/is (= main-nested-id (ctk/get-swap-slot swapped)))
(t/is (= main-nested-id (:shape-ref swapped)))
(t/is (ctk/swapped? swapped))
;; ==== Check – after reset: back to rectangle, no swap slot, file still valid
;; ==== Check – after reset: back to rectangle, not swapped, file still valid
(t/is (some? restored))
(t/is (= :rect (:type (tho/bottom-shape-by-id file' (:id restored)))))
(t/is (= rectangle-id (:component-id restored)))
(t/is (nil? (ctk/get-swap-slot restored))))))
(t/is (not (ctk/swapped? restored))))))

462
common/test/common_tests/logic/swap_group_test.cljc Normal file
View File

@ -0,0 +1,462 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns common-tests.logic.swap-group-test
"A swapped copy sub-head stored as an override: it keeps the shape-ref of
the main child it replaces, its component gives the content, and the
touched group :swap-group marks the swap."
(:require
[app.common.files.changes-builder :as pcb]
[app.common.files.helpers :as cfh]
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as gsh]
[app.common.logic.libraries :as cll]
[app.common.logic.shapes :as cls]
[app.common.test-helpers.components :as thc]
[app.common.test-helpers.compositions :as tho]
[app.common.test-helpers.files :as thf]
[app.common.test-helpers.ids-map :as thi]
[app.common.test-helpers.shapes :as ths]
[app.common.test-helpers.variants :as thv]
[app.common.types.component :as ctk]
[app.common.types.container :as ctn]
[clojure.test :as t]))
(t/use-fixtures :each thi/test-fixture)
(defn- setup
[]
;; {:star-main} [:name Frame1] # [Component :star]
;; :star-rect [:name Rect1]
;; {:heart-main} [:name Frame1] # [Component :heart]
;; :heart-rect [:name Rect1]
;; {:card-main} [:name Frame1] # [Component :card]
;; :card-star [:name Frame1] @--> [Component :star] :star-main
;; :copy [:name Frame1] #--> [Component :card] :card-main
;; :copy-star [:name Frame1] @--> [Component :heart] :card-star (swapped)
(-> (thf/sample-file :file1)
(tho/add-simple-component :star :star-main :star-rect
:child-params {:fills (ths/sample-fills-color :fill-color "#111111")})
(tho/add-simple-component :heart :heart-main :heart-rect
:child-params {:fills (ths/sample-fills-color :fill-color "#222222")})
(tho/add-frame :card-main)
(thc/instantiate-component :star :card-star :parent-label :card-main)
(thc/make-component :card :card-main)
(thc/instantiate-component :card :copy :children-labels [:copy-star])
(tho/swap-component-in-shape :copy-star :heart)))
(defn- propagate
[file & component-labels]
(reduce tho/propagate-component-changes file component-labels))
(defn- move-shape
"Move the shape and its children by the given delta."
[file label dx dy]
(let [page (thf/current-page file)
ids (set (cfh/get-children-ids-with-self (:objects page) (thi/id label)))
changes (cls/generate-update-shapes (pcb/empty-changes nil (:id page))
ids
#(gsh/move % (gpt/point dx dy))
(:objects page)
{})]
(thf/apply-changes file changes)))
(defn- position
[file label]
(let [shape (ths/get-shape file label)]
[(get-in shape [:selrect :x]) (get-in shape [:selrect :y])]))
(defn- bottom-position
[file label]
(let [shape (tho/bottom-shape file label)]
[(get-in shape [:selrect :x]) (get-in shape [:selrect :y])]))
(t/deftest swapped-head-refers-to-the-replaced-child
(let [file (setup)
head (ths/get-shape file :copy-star)]
(t/is (= (thi/id :card-star) (:shape-ref head)))
(t/is (= (:id (thc/get-component file :heart)) (:component-id head)))
(t/is (ctk/swapped? head))
(t/is (= "#222222" (tho/bottom-fill-color file :copy)))))
(t/deftest swapped-head-follows-its-own-component
(let [file (-> (setup)
(tho/update-color :heart-rect "#333333")
(propagate :heart)
(thf/validate-file!))]
(t/is (= "#333333" (tho/bottom-fill-color file :copy)))))
(t/deftest swapped-head-ignores-the-replaced-component
(let [file (-> (setup)
(tho/update-color :star-rect "#444444")
(propagate :star :card)
(thf/validate-file!))
head (ths/get-shape file :copy-star)]
(t/is (= "#444444" (tho/bottom-fill-color file :card-main)))
(t/is (= "#222222" (tho/bottom-fill-color file :copy)))
(t/is (= (:id (thc/get-component file :heart)) (:component-id head)))
(t/is (ctk/swapped? head))))
(t/deftest swapped-head-gets-the-children-added-to-its-component
(let [file (-> (setup)
(ths/add-sample-shape :heart-extra :parent-label :heart-main :type :rect)
(propagate :heart)
(thf/validate-file!))
head (ths/get-shape file :copy-star)]
(t/is (= 2 (count (:shapes head))))
(t/is (some #(= (thi/id :heart-extra) (:shape-ref (ths/get-shape-by-id file %)))
(:shapes head)))))
(t/deftest swapped-head-survives-a-sync-of-the-outer-copy
(let [file (-> (setup)
(ths/update-shape :card-main :opacity 0.5)
(propagate :card)
(thf/validate-file!))
head (ths/get-shape file :copy-star)]
(t/is (= 0.5 (:opacity (ths/get-shape file :copy))))
(t/is (= (:id (thc/get-component file :heart)) (:component-id head)))
(t/is (= "#222222" (tho/bottom-fill-color file :copy)))))
(t/deftest swapped-head-follows-the-position-of-the-replaced-child
(let [file (setup)
[x y] (position file :copy-star)
[cx cy] (bottom-position file :copy)
file' (-> file
(move-shape :card-star 10 20)
(propagate :card)
(thf/validate-file!))]
(t/is (= [(+ x 10) (+ y 20)] (position file' :copy-star)))
(t/is (= [(+ cx 10) (+ cy 20)] (bottom-position file' :copy)))
(t/is (ctk/swapped? (ths/get-shape file' :copy-star)))))
(t/deftest swapped-head-follows-the-constraints-of-the-replaced-child
(let [file (-> (setup)
(ths/update-shape :card-star :constraints-h :right)
(propagate :card)
(thf/validate-file!))]
(t/is (= :right (:constraints-h (ths/get-shape file :copy-star))))))
(t/deftest moved-swapped-head-keeps-its-position
(let [file (-> (setup)
(move-shape :copy-star 5 5))
[x y] (position file :copy-star)
file' (-> file
(move-shape :card-star 10 20)
(propagate :card)
(thf/validate-file!))]
(t/is (ctk/touched-group? (ths/get-shape file :copy-star) :geometry-group))
(t/is (= [x y] (position file' :copy-star)))))
(defn- set-opacity
"Change the opacity of the shape as the user would, touching it."
[file label opacity]
(let [page (thf/current-page file)
changes (cls/generate-update-shapes (pcb/empty-changes nil (:id page))
#{(thi/id label)}
#(assoc % :opacity opacity)
(:objects page)
{})]
(thf/apply-changes file changes)))
(t/deftest reset-of-a-swapped-head-undoes-the-swap-in-place
(let [file (-> (setup)
(set-opacity :copy 0.5)
(tho/reset-overrides-in-first-child :copy)
(thf/validate-file!))
head (ths/get-shape file :copy-star)]
(t/is (some? head))
(t/is (= (:id (thc/get-component file :star)) (:component-id head)))
(t/is (= (thi/id :card-star) (:shape-ref head)))
(t/is (not (ctk/swapped? head)))
(t/is (= "#111111" (tho/bottom-fill-color file :copy)))
;; nothing outside the reset head changes
(t/is (= 0.5 (:opacity (ths/get-shape file :copy))))
(t/is (ctk/touched-group? (ths/get-shape file :copy) :layer-effects-group))))
(t/deftest reset-of-the-outer-copy-undoes-the-swap-in-place
(let [file (-> (setup)
(as-> file (tho/reset-overrides file (ths/get-shape file :copy)))
(thf/validate-file!))
head (ths/get-shape file :copy-star)]
(t/is (some? head))
(t/is (= (:id (thc/get-component file :star)) (:component-id head)))
(t/is (not (ctk/swapped? head)))
(t/is (= "#111111" (tho/bottom-fill-color file :copy)))))
(t/deftest reset-in-a-main-keeps-the-overrides-of-its-copies
;; {:page-main} # [Component :page]
;; :inner-copy @--> [Component :card]
;; :inner-star @--> [Component :heart] (swapped)
;; :outer-copy #--> [Component :page]
;; :outer-inner @--> :inner-copy
;; :outer-star @--> :inner-star (opacity changed)
(let [file (-> (setup)
(tho/add-frame :page-main)
(thc/instantiate-component :card :inner-copy
:parent-label :page-main
:children-labels [:inner-star])
(tho/swap-component-in-shape :inner-star :heart)
(thc/make-component :page :page-main)
(thc/instantiate-component :page :outer-copy
:children-labels [:outer-inner :outer-star])
(set-opacity :outer-star 0.3)
(as-> file (tho/reset-overrides file (ths/get-shape file :inner-copy)
:propagate-fn #(propagate % :page))))
star (ths/get-shape file :outer-star)]
(t/is (= (:id (thc/get-component file :star))
(:component-id (ths/get-shape file :inner-star))))
(t/is (some? star))
(t/is (= (:id (thc/get-component file :star)) (:component-id star)))
(t/is (= 0.3 (:opacity star)))
(t/is (= "#111111" (tho/bottom-fill-color file :outer-copy)))))
(defn- detach
[file label]
(let [page (thf/current-page file)
changes (cll/generate-detach-instance (-> (pcb/empty-changes nil)
(pcb/with-page page)
(pcb/with-objects (:objects page)))
page
{(:id file) file}
(thi/id label))]
(thf/apply-changes file changes)))
(defn- copy-objects
"The objects the clipboard keeps when the shape is copied."
[file label]
(let [page (thf/current-page file)
objects (:objects page)
ids (cfh/get-children-ids-with-self objects (thi/id label))]
(cll/advance-copied-objects file
page
{(:id file) file}
(select-keys objects ids)
[(thi/id label)])))
(defn- setup-two-levels
[]
;; {:dot-main} [:name Frame1] # [Component :dot]
;; :dot-rect [:name Rect1]
;; {:badge-main} [:name Frame1] # [Component :badge]
;; :badge-dot [:name Frame1] @--> [Component :dot] :dot-main
;; {:page-main} [:name Frame1] # [Component :page]
;; :inner-copy [:name Frame1] @--> [Component :card] :card-main
;; :inner-star [:name Frame1] @--> [Component :star] :card-star
;; :outer-copy [:name Frame1] #--> [Component :page] :page-main
;; :outer-inner [:name Frame1] @--> [Component :card] :inner-copy
;; :outer-star [:name Frame1] @--> [Component :badge] :inner-star (swapped)
;; <no-label> @--> [Component :dot] :badge-dot
(-> (setup)
(tho/add-simple-component :dot :dot-main :dot-rect)
(tho/add-frame :badge-main)
(thc/instantiate-component :dot :badge-dot :parent-label :badge-main)
(thc/make-component :badge :badge-main)
(tho/add-frame :page-main)
(thc/instantiate-component :card :inner-copy
:parent-label :page-main
:children-labels [:inner-star])
(thc/make-component :page :page-main)
(thc/instantiate-component :page :outer-copy
:children-labels [:outer-inner :outer-star])
(tho/swap-component-in-shape :outer-star :badge)))
(defn- first-child
[file label]
(ths/get-shape-by-id file (first (:shapes (ths/get-shape file label)))))
(t/deftest detach-makes-a-swapped-head-a-copy-of-its-component
(let [file (-> (setup)
(detach :copy)
(thf/validate-file!))
head (ths/get-shape file :copy-star)]
(t/is (= (thi/id :heart-main) (:shape-ref head)))
(t/is (not (ctk/swapped? head)))
(t/is (ctk/instance-root? head))
(t/is (= (thi/id :heart-rect) (:shape-ref (first-child file :copy-star))))
(t/is (= "#333333" (-> file
(tho/update-color :heart-rect "#333333")
(propagate :heart)
(tho/bottom-fill-color :copy-star))))))
(t/deftest detach-advances-a-deeper-swapped-head-by-position
(let [file (setup-two-levels)
dot (first-child file :outer-star)
file' (-> file
(detach :outer-copy)
(thf/validate-file!))
head (ths/get-shape file' :outer-star)]
(t/is (= (thi/id :card-star) (:shape-ref head)))
(t/is (ctk/swapped? head))
(t/is (= (:id (thc/get-component file' :badge)) (:component-id head)))
;; the children of the swapped head keep referring into its component
(t/is (= (thi/id :badge-dot) (:shape-ref dot)))
(t/is (= (thi/id :badge-dot) (:shape-ref (ths/get-shape-by-id file' (:id dot)))))))
(t/deftest paste-makes-a-swapped-head-a-copy-of-its-component
(let [file (setup)
objects (copy-objects file :copy-star)
head (get objects (thi/id :copy-star))
child (get objects (first (:shapes head)))]
(t/is (= (thi/id :heart-main) (:shape-ref head)))
(t/is (not (ctk/swapped? head)))
(t/is (= (thi/id :heart-rect) (:shape-ref child)))))
(t/deftest paste-advances-a-deeper-swapped-head-by-position
(let [file (setup-two-levels)
dot-id (:id (first-child file :outer-star))
objects (copy-objects file :outer-inner)
head (get objects (thi/id :outer-star))]
(t/is (= (thi/id :card-main) (:shape-ref (get objects (thi/id :outer-inner)))))
(t/is (= (thi/id :card-star) (:shape-ref head)))
(t/is (ctk/swapped? head))
(t/is (= (thi/id :badge-dot) (:shape-ref (get objects dot-id))))))
(t/deftest duplicate-keeps-the-swap
(let [file (-> (setup)
(tho/duplicate-shape :copy)
(thf/validate-file!))
page (thf/current-page file)
copies (->> (vals (:objects page))
(filter #(and (ctk/instance-root? %)
(= (thi/id :card-main) (:shape-ref %)))))
heads (map #(ths/get-shape-by-id file (first (:shapes %))) copies)]
(t/is (= 2 (count copies)))
(t/is (every? ctk/swapped? heads))
(t/is (every? #(= (thi/id :card-star) (:shape-ref %)) heads))))
(defn- setup-variants
[]
;; :variant [:name Board]
;; {:m02} [:name Board] # [Component :c02]
;; :child2 @--> [Component :star]
;; {:m01} [:name Board] # [Component :c01]
;; :child1 @--> [Component :star]
;; :copy01 [:name Board] #--> [Component :c01] :m01
;; :copy-child @--> [Component :heart] :child1 (swapped)
(-> (setup)
(thv/add-variant-with-copy :variant :c01 :m01 :c02 :m02 :child1 :child2 :star)
(thc/instantiate-component :c01 :copy01 :children-labels [:copy-child])
(tho/swap-component-in-shape :copy-child :heart)))
(t/deftest switch-keeps-the-swap-in-the-new-variant
(let [file (-> (setup-variants)
(tho/swap-component-in-shape :copy01 :c02 {:keep-touched? true}))
copy (ths/get-shape file :copy01)
head (ths/get-shape file :copy-child)]
(t/is (= (thi/id :m02) (:shape-ref copy)))
(t/is (= [(thi/id :copy-child)] (:shapes copy)))
(t/is (= (thi/id :child2) (:shape-ref head)))
(t/is (ctk/swapped? head))
(t/is (= (:id (thc/get-component file :heart)) (:component-id head)))
(t/is (= "#222222" (tho/bottom-fill-color file :copy01)))))
(t/deftest switch-to-a-variant-with-the-same-component-ends-the-swap
(let [file (-> (setup-variants)
(tho/swap-component-in-shape :child2 :heart)
(tho/swap-component-in-shape :copy01 :c02 {:keep-touched? true}))
head (ths/get-shape file :copy-child)]
(t/is (= (thi/id :child2) (:shape-ref head)))
(t/is (not (ctk/swapped? head)))
(t/is (= (:id (thc/get-component file :heart)) (:component-id head)))))
(t/deftest switch-does-not-carry-a-swap-made-in-the-main
;; :variant2 [:name Board]
;; {:n02} [:name Board] # [Component :d02]
;; :cardc2 @--> [Component :card]
;; {:n01} [:name Board] # [Component :d01]
;; :cardc1 @--> [Component :card]
;; :cardc1-star @--> [Component :heart] (swapped)
;; :copyd [:name Board] #--> [Component :d01] :n01
(let [file (-> (setup)
(thv/add-variant-with-copy :variant2 :d01 :n01 :d02 :n02 :cardc1 :cardc2 :card))
_ (thi/set-id! :cardc1-star (:id (first-child file :cardc1)))
file (-> file
(tho/swap-component-in-shape :cardc1-star :heart)
(thc/instantiate-component :d01 :copyd)
(tho/swap-component-in-shape :copyd :d02 {:keep-touched? true}))
card (first-child file :copyd)
star (ths/get-shape-by-id file (first (:shapes card)))]
(t/is (= (thi/id :cardc2) (:shape-ref card)))
(t/is (= (:id (thc/get-component file :star)) (:component-id star)))
(t/is (not (ctk/swapped? star)))
(t/is (= "#111111" (tho/bottom-fill-color file :copyd)))))
(defn- update-main
"Push the overrides of the copy to its main, and sync the other copies."
[file label component-label]
(let [page (thf/current-page file)
container (ctn/make-container page :page)
changes (-> (pcb/empty-changes)
(pcb/with-container container)
(cll/generate-sync-shape-inverse (:data file)
{(:id file) file}
container
(thi/id label)))]
(-> file
(thf/apply-changes changes :validate? false)
(propagate component-label)
(thf/validate-file!))))
(t/deftest update-main-replaces-the-child-with-the-swapped-one
(let [file (-> (setup)
(thc/instantiate-component :card :copy2 :children-labels [:copy2-star])
(update-main :copy :card))
main (first-child file :card-main)
head (ths/get-shape file :copy-star)
other (first-child file :copy2)]
(t/is (nil? (ths/get-shape file :card-star)))
(t/is (= (:id (thc/get-component file :heart)) (:component-id main)))
(t/is (= (thi/id :heart-main) (:shape-ref main)))
(t/is (not (ctk/swapped? main)))
(t/is (= (:id main) (:shape-ref head)))
(t/is (not (ctk/swapped? head)))
;; the other copy follows the main
(t/is (= (:id (thc/get-component file :heart)) (:component-id other)))
(t/is (= "#222222" (tho/bottom-fill-color file :copy2)))))
(t/deftest update-main-keeps-a-deeper-swap-as-a-swap
(let [file (-> (setup-two-levels)
(update-main :outer-copy :page))
main (first-child file :inner-copy)
head (ths/get-shape file :outer-star)]
(t/is (nil? (ths/get-shape file :inner-star)))
(t/is (= (:id (thc/get-component file :badge)) (:component-id main)))
(t/is (= (thi/id :card-star) (:shape-ref main)))
(t/is (ctk/swapped? main))
(t/is (= (:id main) (:shape-ref head)))
(t/is (not (ctk/swapped? head)))))
(t/deftest update-main-of-a-swapped-head-updates-its-own-component
(let [file (setup)
_ (thi/set-id! :copy-star-rect (:id (first-child file :copy-star)))
file' (-> file
(tho/update-color :copy-star-rect "#555555")
(update-main :copy-star :heart))]
(t/is (= "#555555" (tho/bottom-fill-color file' :heart-main)))
(t/is (= "#111111" (tho/bottom-fill-color file' :star-main)))
(t/is (ctk/swapped? (ths/get-shape file' :copy-star)))))
(t/deftest swap-back-to-the-replaced-component-is-a-plain-copy
(let [file (-> (setup)
(tho/swap-component-in-shape :copy-star :star))
head (ths/get-shape file :copy-star)
child (first-child file :copy-star)]
(t/is (= (thi/id :card-star) (:shape-ref head)))
(t/is (not (ctk/swapped? head)))
(t/is (= (:id (first-child file :card-star)) (:shape-ref child)))
(t/is (= "#666666" (-> file
(tho/update-color :star-rect "#666666")
(propagate :star :card)
(thf/validate-file!)
(tho/bottom-fill-color :copy))))))
(t/deftest swap-in-a-main-is-a-plain-nested-copy
(let [file (-> (setup)
(tho/swap-component-in-shape :card-star :heart))
head (ths/get-shape file :card-star)]
(t/is (= (thi/id :heart-main) (:shape-ref head)))
(t/is (not (ctk/swapped? head)))
(t/is (empty? (:touched head)))))

26
common/test/common_tests/logic/variants_switch_test.cljc
View File

@ -229,9 +229,9 @@
(t/is (= (:width copy01) 5))
;; The copy has width 15 after the switch
(t/is (= (:width copy01') 15))
;; The copy is not touched but has swap slot
(t/is (= (count (:touched copy01')) 1))
(t/is (= (ctk/get-swap-slot copy01') (thi/id :copy01)))))
;; A switch in a main leaves a plain nested copy, not touched
(t/is (empty? (:touched copy01')))
(t/is (not (ctk/swapped? copy01')))))
(t/deftest test-nested-switch-in-copy
(let [;; ==== Setup
@ -262,9 +262,9 @@
(t/is (= (:width child01) 5))
;; The copy has width 15 after the switch
(t/is (= (:width child01') 15))
;; The copy is not touched but has swap slot
(t/is (= (count (:touched child01')) 1))
(t/is (= (ctk/get-swap-slot child01') (thi/id :nested01)))))
;; A switch in a copy is a swap of the position it refers to
(t/is (= #{:swap-group} (:touched child01')))
(t/is (= (thi/id :nested01) (:shape-ref child01')))))
;; ============================================================
;; NESTED COPY SWITCH (with overrides)
@ -312,10 +312,9 @@
(t/is (= (:width copy01) 25))
;; The copy gets the switched variant width 15, because this is the value changed in the variant
(t/is (= (:width copy01') 15))
;; The copy is fills touched and has swap slot
(t/is (= (count (:touched copy01')) 2))
(t/is (= (ctk/get-swap-slot copy01') (thi/id :copy01)))
(t/is (contains? (:touched copy01') :fill-group))))
;; The copy is fills touched, and a plain nested copy
(t/is (= #{:fill-group} (:touched copy01')))
(t/is (not (ctk/swapped? copy01')))))
(t/deftest test-nested-switch-in-copy-with-override
(let [;; ==== Setup
@ -363,10 +362,9 @@
(t/is (not= (:width nested02) 5))
;; The copy gets the switched variant width 15, because this is the value changed in the variant
(t/is (= (:width nested02') 15))
;; The copy is fills touched and has swap slot
(t/is (= (count (:touched nested02')) 2))
(t/is (= (ctk/get-swap-slot nested02') (thi/id :nested01)))
(t/is (contains? (:touched nested02') :fill-group))))
;; The copy is fills touched, and a swap of the position it refers to
(t/is (= #{:fill-group :swap-group} (:touched nested02')))
(t/is (= (thi/id :nested01) (:shape-ref nested02')))))
;; ============================================================
;; TEXT OVERRIDES (identical variants)

2
common/test/common_tests/runner.cljc
View File

@ -73,6 +73,7 @@
[common-tests.logic.multiple-nesting-levels-test]
[common-tests.logic.swap-and-reset-test]
[common-tests.logic.swap-as-override-test]
[common-tests.logic.swap-group-test]
[common-tests.logic.swap-keeps-id-test]
[common-tests.logic.text-editor-output-test]
[common-tests.logic.text-notation-test]
@ -187,6 +188,7 @@
'common-tests.logic.multiple-nesting-levels-test
'common-tests.logic.swap-and-reset-test
'common-tests.logic.swap-as-override-test
'common-tests.logic.swap-group-test
'common-tests.logic.swap-keeps-id-test
'common-tests.logic.text-editor-output-test
'common-tests.logic.text-notation-test

6
common/test/common_tests/types/components_test.cljc
View File

@ -181,7 +181,7 @@
(tho/add-simple-component :component3 :main3-root :main3-child
:root-params {:name "Frame3"}
:child-params {:name "Rect3"})
(tho/swap-component-in-first-child :copy2 :component3))
(tho/swap-component-in-first-child :copy2 :component3 :as-slot? true))
page (thf/current-page file)
@ -244,7 +244,7 @@
:main1-child-params {:name "Rect3"}
:main2-root-params {:name "Frame4"}
:nested-head-params {:children-labels [:nested4-child]})
(tho/swap-component-in-first-child :copy2 :component4))
(tho/swap-component-in-first-child :copy2 :component4 :as-slot? true))
page (thf/current-page file)
@ -329,7 +329,7 @@
(-> (thf/sample-file :file1)
(thc/instantiate-component :component2 :copy2 :children-labels [:copy2-nested-head]
:library library1)
(tho/swap-component-in-first-child :copy2 :component4 :library library2))
(tho/swap-component-in-first-child :copy2 :component4 :library library2 :as-slot? true))
page-library1 (thf/current-page library1)
page-library2 (thf/current-page library2)

2
common/test/common_tests/types/file_test.cljc
View File

@ -196,7 +196,7 @@
(thi/set-id! :copy-c1 copy-c1)
(-> file
(tho/add-simple-component :c4 :main4 :main4-child)
(tho/swap-component-in-shape :copy-c1 :c4 :new-shape-label :swapped))))
(tho/swap-component-in-shape :copy-c1 :c4 :new-shape-label :swapped :as-slot? true))))
(defn- ref-id-for-swapped
[file]

134
frontend/test/frontend_tests/logic/comp_remove_swap_slots_test.cljs
View File

@ -30,10 +30,10 @@
;; {:frame-green} [:name Frame1] # [Component :green]
;; :red-copy-green [:name Frame1] @--> :frame-red
;; {:frame-b1} [:name Frame1] # [Component :b1]
;; :blue1 [:name Frame1, :swap-slot-label :red-copy] @--> :frame-blue
;; :blue1 [:name Frame1] @--> :frame-blue
;; :frame-yellow [:name Frame1]
;; :green-copy [:name Frame1] @--> :frame-green
;; :blue-copy-in-green-copy [:name Frame1, :swap-slot-label :red-copy-green] @--> :frame-blue
;; :blue-copy-in-green-copy [:name Frame1] (swapped) @--> :frame-blue
;; {:frame-b2} [:name Frame1] # [Component :b2]
(-> (cthf/sample-file :file1)
(ctho/add-frame :frame-red)
@ -62,9 +62,9 @@
;; :red-copy-green [:name Frame1] @--> :frame-red
;; {:frame-b1} [:name Frame1] # [Component :b1]
;; :frame-yellow [:name Frame1]
;; :blue1 [:name Frame1, :swap-slot-label :red-copy] @--> :frame-blue
;; :blue1 [:name Frame1] @--> :frame-blue
;; :green-copy [:name Frame1] @--> :frame-green
;; :blue-copy-in-green-copy [:name Frame1, :swap-slot-label :red-copy-green] @--> :frame-blue
;; :blue-copy-in-green-copy [:name Frame1] (swapped) @--> :frame-blue
;; {:frame-b2} [:name Frame1] # [Component :b2]
(-> (cthf/sample-file :file1)
(ctho/add-frame :frame-red)
@ -123,12 +123,12 @@
;; ==== Check
;; blue1 has swap-id
(t/is (some? (ctk/get-swap-slot blue1')))
;; blue1 was swapped in a main, so it is not marked
(t/is (not (ctk/swapped? blue1')))
;; copied-blue1 has not swap-id
;; the pasted blue1 is not marked
(t/is (some? copied-blue1'))
(t/is (nil? (ctk/get-swap-slot copied-blue1')))))))))
(t/is (not (ctk/swapped? copied-blue1')))))))))
(t/deftest test-remove-swap-slot-copy-paste-blue1-to-b1
@ -162,12 +162,12 @@
copied-blue1' (find-copied-shape blue1' page' (:id b1'))]
;; ==== Check
;; blue1 has swap-id
(t/is (some? (ctk/get-swap-slot blue1')))
;; blue1 was swapped in a main, so it is not marked
(t/is (not (ctk/swapped? blue1')))
;; copied-blue1 has not swap-id
;; the pasted blue1 is not marked
(t/is (some? copied-blue1'))
(t/is (nil? (ctk/get-swap-slot copied-blue1')))))))))
(t/is (not (ctk/swapped? copied-blue1')))))))))
(t/deftest test-remove-swap-slot-copy-paste-blue1-to-yellow
(t/async
@ -200,12 +200,12 @@
copied-blue1' (find-copied-shape blue1' page' (:id yellow'))]
;; ==== Check
;; blue1 has swap-id
(t/is (some? (ctk/get-swap-slot blue1')))
;; blue1 was swapped in a main, so it is not marked
(t/is (not (ctk/swapped? blue1')))
;; copied-blue1 has not swap-id
;; the pasted blue1 is not marked
(t/is (some? copied-blue1'))
(t/is (nil? (ctk/get-swap-slot copied-blue1')))))))))
(t/is (not (ctk/swapped? copied-blue1')))))))))
(t/deftest test-remove-swap-slot-copy-paste-blue1-to-b2
@ -239,12 +239,12 @@
copied-blue1' (find-copied-shape blue1' page' (:id b2'))]
;; ==== Check
;; blue1 has swap-id
(t/is (some? (ctk/get-swap-slot blue1')))
;; blue1 was swapped in a main, so it is not marked
(t/is (not (ctk/swapped? blue1')))
;; copied-blue1 has not swap-id
;; the pasted blue1 is not marked
(t/is (some? copied-blue1'))
(t/is (nil? (ctk/get-swap-slot copied-blue1')))))))))
(t/is (not (ctk/swapped? copied-blue1')))))))))
(t/deftest test-remove-swap-slot-cut-paste-blue1-to-root
@ -277,9 +277,9 @@
copied-blue1' (find-copied-shape blue1 page' uuid/zero)]
;; ==== Check
;; copied-blue1 has not swap-id
;; the pasted blue1 is not marked
(t/is (some? copied-blue1'))
(t/is (nil? (ctk/get-swap-slot copied-blue1')))))))))
(t/is (not (ctk/swapped? copied-blue1')))))))))
@ -315,9 +315,9 @@
copied-blue1' (find-copied-shape blue1 page' (:id yellow'))]
;; ==== Check
;; copied-blue1 has not swap-id
;; the pasted blue1 is not marked
(t/is (some? copied-blue1'))
(t/is (nil? (ctk/get-swap-slot copied-blue1')))))))))
(t/is (not (ctk/swapped? copied-blue1')))))))))
(t/deftest test-remove-swap-slot-cut-paste-blue1-to-b2
@ -352,9 +352,9 @@
copied-blue1' (find-copied-shape blue1 page' (:id b2'))]
;; ==== Check
;; copied-blue1 has not swap-id
;; the pasted blue1 is not marked
(t/is (some? copied-blue1'))
(t/is (nil? (ctk/get-swap-slot copied-blue1')))))))))
(t/is (not (ctk/swapped? copied-blue1')))))))))
(t/deftest test-remove-swap-slot-copy-paste-yellow-to-root
@ -388,12 +388,12 @@
;; ==== Check
;; blue1 has swap-id
(t/is (some? (ctk/get-swap-slot blue1')))
;; blue1 was swapped in a main, so it is not marked
(t/is (not (ctk/swapped? blue1')))
;; copied-blue1 has not swap-id
;; the pasted blue1 is not marked
(t/is (some? copied-blue1'))
(t/is (nil? (ctk/get-swap-slot copied-blue1')))))))))
(t/is (not (ctk/swapped? copied-blue1')))))))))
(t/deftest test-remove-swap-slot-copy-paste-yellow-to-b1
(t/async
@ -428,12 +428,12 @@
;; ==== Check
;; blue1 has swap-id
(t/is (some? (ctk/get-swap-slot blue1')))
;; blue1 was swapped in a main, so it is not marked
(t/is (not (ctk/swapped? blue1')))
;; copied-blue1 has not swap-id
;; the pasted blue1 is not marked
(t/is (some? copied-blue1'))
(t/is (nil? (ctk/get-swap-slot copied-blue1')))))))))
(t/is (not (ctk/swapped? copied-blue1')))))))))
(t/deftest test-remove-swap-slot-copy-paste-yellow-to-b2
(t/async
@ -468,11 +468,11 @@
;; ==== Check
;; blue1 has swap-id
(t/is (some? (ctk/get-swap-slot blue1')))
;; copied-blue1 has not swap-id
;; blue1 was swapped in a main, so it is not marked
(t/is (not (ctk/swapped? blue1')))
;; the pasted blue1 is not marked
(t/is (some? copied-blue1'))
(t/is (nil? (ctk/get-swap-slot copied-blue1')))))))))
(t/is (not (ctk/swapped? copied-blue1')))))))))
(t/deftest test-remove-swap-slot-cut-paste-yellow-to-root
(t/async
@ -506,9 +506,9 @@
copied-blue1' (find-copied-shape blue1 page' (:id copied-yellow'))]
;; ==== Check
;; copied-blue1 has not swap-id
;; the pasted blue1 is not marked
(t/is (some? copied-blue1'))
(t/is (nil? (ctk/get-swap-slot copied-blue1')))))))))
(t/is (not (ctk/swapped? copied-blue1')))))))))
(t/deftest test-remove-swap-slot-cut-paste-yellow-to-b1
(t/async
@ -544,9 +544,9 @@
copied-blue1' (find-copied-shape blue1 page' (:id copied-yellow'))]
;; ==== Check
;; copied-blue1 has not swap-id
;; the pasted blue1 is not marked
(t/is (some? copied-blue1'))
(t/is (nil? (ctk/get-swap-slot copied-blue1')))))))))
(t/is (not (ctk/swapped? copied-blue1')))))))))
(t/deftest test-remove-swap-slot-cut-paste-yellow-to-b2
(t/async
@ -582,9 +582,9 @@
copied-blue1' (find-copied-shape blue1 page' (:id copied-yellow'))]
;; ==== Check
;; copied-blue1 has not swap-id
;; the pasted blue1 is not marked
(t/is (some? copied-blue1'))
(t/is (nil? (ctk/get-swap-slot copied-blue1')))))))))
(t/is (not (ctk/swapped? copied-blue1')))))))))
(t/deftest test-keep-swap-slot-copy-paste-green-copy-to-root
(t/async
@ -617,12 +617,12 @@
;; ==== Check
;; blue2 has swap-id
(t/is (some? (ctk/get-swap-slot blue2')))
;; blue2 is swapped
(t/is (ctk/swapped? blue2'))
;; copied-blue2 also has swap-id
;; copied-blue2 is swapped
(t/is (some? copied-blue2'))
(t/is (some? (ctk/get-swap-slot copied-blue2')))))))))
(t/is (ctk/swapped? copied-blue2'))))))))
(t/deftest test-keep-swap-slot-copy-paste-green-copy-to-b1
(t/async
@ -657,12 +657,12 @@
;; ==== Check
;; blue1 has swap-id
(t/is (some? (ctk/get-swap-slot blue2')))
;; blue2 is swapped
(t/is (ctk/swapped? blue2'))
;; copied-blue1 also has swap-id
;; copied-blue2 is swapped
(t/is (some? copied-blue2'))
(t/is (some? (ctk/get-swap-slot copied-blue2')))))))))
(t/is (ctk/swapped? copied-blue2'))))))))
(t/deftest test-keep-swap-slot-copy-paste-green-copy-to-b2
(t/async
@ -697,12 +697,12 @@
;; ==== Check
;; blue2 has swap-id
(t/is (some? (ctk/get-swap-slot blue2')))
;; blue2 is swapped
(t/is (ctk/swapped? blue2'))
;; copied-blue1 also has swap-id
;; copied-blue2 is swapped
(t/is (some? copied-blue2'))
(t/is (some? (ctk/get-swap-slot copied-blue2')))))))))
(t/is (ctk/swapped? copied-blue2'))))))))
(t/deftest test-keep-swap-slot-cut-paste-green-copy-to-root
@ -737,9 +737,9 @@
copied-blue1' (find-copied-shape blue2 page' (:id copied-green'))]
;; ==== Check
;; copied-blue1 has swap-id
;; copied-blue2 is swapped
(t/is (some? copied-blue1'))
(t/is (some? (ctk/get-swap-slot copied-blue1')))))))))
(t/is (ctk/swapped? copied-blue1'))))))))
(t/deftest test-keep-swap-slot-cut-paste-green-copy-to-b1
(t/async
@ -775,9 +775,9 @@
copied-blue2' (find-copied-shape blue2 page' (:id copied-green'))]
;; ==== Check
;; copied-blue1 has swap-id
;; copied-blue2 is swapped
(t/is (some? copied-blue2'))
(t/is (some? (ctk/get-swap-slot copied-blue2')))))))))
(t/is (ctk/swapped? copied-blue2'))))))))
(t/deftest test-keep-swap-slot-cut-paste-green-copy-to-b2
(t/async
@ -813,9 +813,9 @@
copied-blue2' (find-copied-shape blue2 page' (:id copied-green'))]
;; ==== Check
;; copied-blue1 has swap-id
;; copied-blue2 is swapped
(t/is (some? copied-blue2'))
(t/is (some? (ctk/get-swap-slot copied-blue2')))))))))
(t/is (ctk/swapped? copied-blue2'))))))))
@ -826,7 +826,7 @@
;; {:frame-red} [:name frame-blue] # [Component :red]
;; {:frame-blue} [:name frame-blue] #[Component :blue]
;; {:frame-green} [:name frame-green] #[Component :green]
;; :blue1 [:name frame-blue, :swap-slot-label :red-copy-green] @--> frame-blue
;; :blue1 [:name frame-blue, ] @--> frame-blue
file (-> (cthf/sample-file :file1)
(ctho/add-frame :frame-red :name "frame-blue")
@ -863,10 +863,10 @@
copied-blue1' (find-copied-shape blue1' page' (:id copied-green'))]
;; ==== Check
;; blue1 has swap-id
(t/is (some? (ctk/get-swap-slot blue1')))
;; blue1 was swapped in a main, so it is not marked
(t/is (not (ctk/swapped? blue1')))
;; copied-blue1 has not swap-id
;; the pasted blue1 is not marked
(t/is (some? copied-blue1'))
(t/is (nil? (ctk/get-swap-slot copied-blue1')))))))))
(t/is (not (ctk/swapped? copied-blue1')))))))))

16
plugins/apps/composable-test-suite/src/composable-tests/cases/caseResetOfNestedSwapKeepsTopCopyOverrides.ts
View File

@ -20,9 +20,7 @@ const RED = new Color("#ff0000"); // the component the copy swaps to
*
* A copy of a component that nests another overrides its own root's opacity,
* swaps its nested copy for a third component, then resets the nested copy. The
* reset undoes the swap and must change nothing outside the nested copy. It also
* clears the root's opacity override (F12 in the stabilization plan), pinned as a
* known failure.
* reset undoes the swap and must change nothing outside the nested copy.
*/
export function createTestCaseResetOfNestedSwapKeepsTopCopyOverrides(): TestCase {
const opCreateComponent = new OpCreateNestableComponent(new ContentCreationStrategyRectangle(BASELINE));
@ -40,8 +38,7 @@ export function createTestCaseResetOfNestedSwapKeepsTopCopyOverrides(): TestCase
"another component with a red rectangle is created. A copy of the outer component " +
"lowers its own opacity, swaps its nested copy for the red component, and then resets " +
"the nested copy. The reset must undo the swap (the nested copy shows the original " +
"rectangle again) and leave the copy's own opacity override alone. The reset also " +
"clears that override (known failure F12).",
"rectangle again) and leave the copy's own opacity override alone.",
new OpSequence(
opCreateComponent,
opCreateRed,
@ -59,14 +56,7 @@ export function createTestCaseResetOfNestedSwapKeepsTopCopyOverrides(): TestCase
"the nested copy is an instance of the original component again"
);
fillColor.assertEqual(fillColor.read(opCreateComponent.contentCreator.getRectangle(head)), BASELINE);
// the reset clears the opacity, which the API then reads as null
Assert.knownFailure<number | null>(
"F12",
0.5,
null,
opacity.read(s.get(copyInstance)) ?? null,
(a, b) => a === b
);
opacity.assertEqual(opacity.read(s.get(copyInstance)), 0.5);
})
)
);