🐛 Gate pastes on page load and harden base-shape lookup (#11674)

* 🐛 Gate pastes on page load and harden base-shape lookup

Pasting while the workspace is still opening crashed the
session: the layer-order lookup called rseq on a missing
root children list.

Ignore paste events until the page objects are loaded (the
clipboard keeps its content, so retrying works), return empty
instead of throwing from the shared layer-order helpers, and
fall back to pasting at the pointer position when the selection
is detached from the shape tree. Selecting the page root keeps
working as before through the frame branches.

Closes #11666

AI-assisted-by: muse-spark-1.3-contributor

* 🐛 Cover props paste and root-plus-other in paste guards

Address review follow-ups on the paste-before-init fix: gate
props pasting on page readiness like the shape entries, and
route root-plus-other selections without a base shape to the
pointer fallback instead of the unguarded else branch. Pin
single-root selection to the frame path with a regression test.

Closes #11666

AI-assisted-by: muse-spark-1.3-contributor

* ♻️ Hoist page lookup out of paste-shapes gate

Bind page and page-objects once in an outer let instead of
calling lookup-page twice (once for the readiness gate and
once inside the body). No behavior change.

AI-assisted-by: muse-spark-1.3-contributor

* ♻️ Reuse bound ids in paste-shapes page lookup

Bind file-id and page-id once and pass them to the lookup-page
arity that takes both, instead of resolving the page twice and
rebinding file-id in the inner let. No behavior change.

AI-assisted-by: muse-spark-1.3-contributor
This commit is contained in:
Andrey Antukh 2026-09-30 07:24:03 +02:00 committed by GitHub
parent 0ef35fc52a
commit 10ccfd2218
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
7 changed files with 642 additions and 142 deletions

View File

@ -377,7 +377,9 @@
(declare indexed-shapes)
(defn get-base-shape
"Selects the shape that will be the base to add the shapes over"
"Selects the shape that will be the base to add the shapes over.
Returns nil when the selection is empty or when none of the
selected shapes is reachable in the objects tree."
[objects selected]
(let [;; Gets the tree-index for all the shapes
indexed-shapes (indexed-shapes objects selected)
@ -560,6 +562,7 @@
shapes (-> objects
(get uuid/zero)
(get :shapes)
(or [])
(rseq))]
(let [shape-id (first shapes)]

View File

@ -38,6 +38,48 @@
:immediate-suffix? true)
"base-name 3")))
(t/deftest test-get-base-shape-with-missing-data
(let [root-id uuid/zero
shape-a {:id (uuid/custom 1 1) :parent-id root-id :frame-id root-id}
shape-b {:id (uuid/custom 1 2) :parent-id root-id :frame-id root-id}
selected #{(:id shape-a) (:id shape-b)}]
(t/testing "Returns nil instead of throwing with nil objects"
(t/is (nil? (cfh/get-base-shape nil selected))))
(t/testing "Returns nil instead of throwing with empty objects"
(t/is (nil? (cfh/get-base-shape {} selected))))
(t/testing "Returns nil instead of throwing when the root has no shapes"
(t/is (nil? (cfh/get-base-shape {root-id {:id root-id}} selected))))
(t/testing "Returns nil when the selection is not present in the objects"
(let [objects {root-id {:id root-id :shapes [(:id shape-a)]}
(:id shape-a) shape-a}]
(t/is (nil? (cfh/get-base-shape objects #{(:id shape-b)})))))
(t/testing "Selecting the root itself never yields a base shape (callers handle it)"
(let [objects {root-id {:id root-id :shapes [(:id shape-a)]}
(:id shape-a) shape-a}]
(t/is (nil? (cfh/get-base-shape objects #{root-id})))))))
(t/deftest test-order-by-indexed-shapes
(let [root-id uuid/zero
shape-a {:id (uuid/custom 1 1) :parent-id root-id :frame-id root-id}
shape-b {:id (uuid/custom 1 2) :parent-id root-id :frame-id root-id}
shape-c {:id (uuid/custom 1 3) :parent-id root-id :frame-id root-id}
objects {root-id {:id root-id :shapes [(:id shape-a) (:id shape-b) (:id shape-c)]}
(:id shape-a) shape-a
(:id shape-b) shape-b
(:id shape-c) shape-c}]
(t/testing "Orders selection top-most first on healthy inputs"
(t/is (= [(:id shape-c) (:id shape-a)]
(cfh/order-by-indexed-shapes objects #{(:id shape-a) (:id shape-c)})))
(t/is (= shape-c
(cfh/get-base-shape objects #{(:id shape-a) (:id shape-c)}))))
(t/testing "Returns empty instead of throwing with nil objects"
(t/is (= [] (cfh/order-by-indexed-shapes nil #{(:id shape-a)})))
(t/is (nil? (cfh/get-base-shape nil #{(:id shape-a)}))))))
(t/deftest test-get-position-on-parent-with-missing-data
(t/testing "Returns nil instead of throwing with missing data"
(t/is (nil? (cfh/get-position-on-parent nil nil)))
(t/is (nil? (cfh/get-position-on-parent {} (uuid/custom 1 9))))))
(t/deftest test-get-prev-sibling
(let [parent-id (uuid/custom 1 1)
child-a (uuid/custom 1 2)

View File

@ -21,6 +21,7 @@
[common-tests.files-migrations-0025-test]
[common-tests.files-migrations-0026-test]
[common-tests.files-migrations-test]
[common-tests.files.helpers-test]
[common-tests.files.shapes-builder-test]
[common-tests.files.validate-test]
[common-tests.geom-align-test]
@ -101,6 +102,7 @@
'common-tests.data-test
'common-tests.files-changes-test
'common-tests.files-builder-test
'common-tests.files.helpers-test
'common-tests.files-migrations-0025-test
'common-tests.files-migrations-0026-test
'common-tests.files-migrations-test

View File

@ -311,17 +311,28 @@
:timeout 5000}))
(rx/throw cause)))
(defn- page-ready?
"Check the page objects are loaded enough for paste operations: the
root shape exists and carries its children list. Pastes arriving
before that (e.g. right after opening the workspace) are ignored."
[objects]
(and (map? objects)
(some? (get objects uuid/zero))
(some? (:shapes (get objects uuid/zero)))))
(defn paste-from-clipboard
"Perform a `paste` operation using the Clipboard API."
([] (paste-from-clipboard nil))
([{:keys [replace?]}]
(ptk/reify ::paste-from-clipboard
ptk/WatchEvent
(watch [_ _ _]
(->> (clipboard/from-navigator default-options)
(rx/mapcat (create-paste-from-blob false (boolean replace?)))
(rx/take 1)
(rx/catch on-clipboard-permission-error))))))
(watch [_ state _]
(if (page-ready? (dsh/lookup-page-objects state))
(->> (clipboard/from-navigator default-options)
(rx/mapcat (create-paste-from-blob false (boolean replace?)))
(rx/take 1)
(rx/catch on-clipboard-permission-error))
(rx/empty))))))
(defn paste-from-event
"Perform a `paste` operation from user emmited event."
@ -334,8 +345,9 @@
is-editing? (and edit-id (= :text (get-in objects [edit-id :type])))]
;; Some paste events can be fired while we're editing a text
;; we forbid that scenario so the default behaviour is executed
(if is-editing?
;; we forbid that scenario so the default behaviour is executed.
;; Pastes arriving before the page is loaded are ignored as well.
(if (or is-editing? (not (page-ready? objects)))
(rx/empty)
(->> (clipboard/from-synthetic-clipboard-event event default-options)
(rx/mapcat (create-paste-from-blob in-viewport? false))))))))
@ -516,11 +528,13 @@
(js/console.error "Clipboard error:" cause)
(rx/empty)))))]
(->> (clipboard/from-navigator default-options)
(rx/mapcat #(.text %))
(rx/map decode-entry)
(rx/take 1)
(rx/catch on-error)))))))
(if (page-ready? (dsh/lookup-page-objects state))
(->> (clipboard/from-navigator default-options)
(rx/mapcat #(.text %))
(rx/map decode-entry)
(rx/take 1)
(rx/catch on-error))
(rx/empty)))))))
(defn- selected-frame? [state]
(let [selected (dsh/lookup-selected state)
@ -609,17 +623,19 @@
(cfeat/check-paste-features! features (:features pdata))
(case (:type pdata)
:copied-shapes
(if (= file-id (:file-id pdata))
(let [pdata (assoc pdata :images [])]
(rx/of (paste-shapes pdata)))
(->> (rx/from images)
(rx/merge-map (partial upload-media file-id))
(rx/reduce conj [])
(rx/map #(assoc pdata :images %))
(rx/map paste-shapes)))
nil))))))
(if (page-ready? (dsh/lookup-page-objects state))
(case (:type pdata)
:copied-shapes
(if (= file-id (:file-id pdata))
(let [pdata (assoc pdata :images [])]
(rx/of (paste-shapes pdata)))
(->> (rx/from images)
(rx/merge-map (partial upload-media file-id))
(rx/reduce conj [])
(rx/map #(assoc pdata :images %))
(rx/map paste-shapes)))
nil)
(rx/empty)))))))
(defn- paste-transit-props
[pdata]
@ -768,6 +784,17 @@
target-index (cfh/get-position-on-parent page-objects replace-id)]
[parent-id delta target-index])
;; No selection, or selection without a base shape that is
;; not exactly the single root: paste at the pointer
;; position. Selecting the root itself (uuid/zero) is a
;; valid workflow handled by the frame branches below.
(or (empty? page-selected)
(and (nil? base)
(not (= #{uuid/zero} page-selected))))
(let [frame-id (ctst/top-nested-frame page-objects position)
delta (gpt/subtract position orig-pos)]
[frame-id delta])
;; Paste next to selected frame, if selected is itself or of the same size as the copied
(and (selected-frame? state)
(or (any-same-frame-from-selected? state (keys pobjects))
@ -821,11 +848,6 @@
(count (:shapes selected-frame-obj)))]
[frame-id delta target-index])
(empty? page-selected)
(let [frame-id (ctst/top-nested-frame page-objects position)
delta (gpt/subtract position orig-pos)]
[frame-id delta])
:else
(let [parent-id (:parent-id base)
delta (if in-viewport?
@ -870,140 +892,141 @@
ptk/WatchEvent
(watch [it state _]
(let [file-id (:current-file-id state)
page (dsh/lookup-page state)
page-id (:current-page-id state)
page (dsh/lookup-page state file-id page-id)
page-objects (:objects page)]
(if (page-ready? page-objects)
(let [media-idx (->> (:images pdata)
(d/index-by :prev-id))
media-idx (->> (:images pdata)
(d/index-by :prev-id))
selected (:selected pdata)
selected (:selected pdata)
objects (:objects pdata)
objects (:objects pdata)
variant-props (:variant-properties pdata)
variant-props (:variant-properties pdata)
position (deref ms/mouse-position)
position (deref ms/mouse-position)
;; Replace mode is only valid with a single selected shape.
;; In that case we drop the pasted content at its position and
;; delete it in the same transaction.
page-selected (dsh/lookup-selected state)
replace-id (when (and (:replace pdata) (= 1 (count page-selected)))
(first page-selected))
;; Replace mode is only valid with a single selected shape.
;; In that case we drop the pasted content at its position and
;; delete it in the same transaction.
page-selected (dsh/lookup-selected state)
replace-id (when (and (:replace pdata) (= 1 (count page-selected)))
(first page-selected))
;; Calculate position for the pasted elements
[candidate-parent-id
delta
index] (calculate-paste-position state objects selected position replace-id)
;; Calculate position for the pasted elements
[candidate-parent-id
delta
index] (calculate-paste-position state objects selected position replace-id)
libraries (dsh/lookup-libraries state)
ldata (dsh/lookup-file-data state file-id)
page-objects (:objects page)
[parent-id
frame-id] (ctn/find-valid-parent-and-frame-ids candidate-parent-id page-objects (vals objects) true libraries)
libraries (dsh/lookup-libraries state)
ldata (dsh/lookup-file-data state file-id)
index (if (= candidate-parent-id parent-id)
index
0)
[parent-id
frame-id] (ctn/find-valid-parent-and-frame-ids candidate-parent-id page-objects (vals objects) true libraries)
index (if index
index
(dec (count (dm/get-in page-objects [parent-id :shapes]))))
index (if (= candidate-parent-id parent-id)
index
0)
selected (if (and (ctl/flex-layout? page-objects parent-id) (not (ctl/reverse? page-objects parent-id)))
(into (d/ordered-set) (reverse selected))
selected)
index (if index
index
(dec (count (dm/get-in page-objects [parent-id :shapes]))))
valid-file-ids (conj (set (keys libraries)) file-id)
selected (if (and (ctl/flex-layout? page-objects parent-id) (not (ctl/reverse? page-objects parent-id)))
(into (d/ordered-set) (reverse selected))
selected)
objects (update-vals objects (partial process-shape valid-file-ids frame-id parent-id))
valid-file-ids (conj (set (keys libraries)) file-id)
all-objects (merge page-objects objects)
objects (update-vals objects (partial process-shape valid-file-ids frame-id parent-id))
drop-cell (when (ctl/grid-layout? all-objects parent-id)
(gslg/get-drop-cell frame-id all-objects position))
all-objects (merge page-objects objects)
changes (-> (pcb/empty-changes it)
(cll/generate-duplicate-changes all-objects page selected delta
libraries ldata file-id {:variant-props variant-props})
(pcb/amend-changes (partial process-rchange media-idx))
(pcb/amend-changes (partial change-add-obj-index objects selected index)))
drop-cell (when (ctl/grid-layout? all-objects parent-id)
(gslg/get-drop-cell frame-id all-objects position))
;; Adds a resize-parents operation so the groups are
;; updated. We add all the new objects
changes (->> (:redo-changes changes)
(filter add-obj?)
(map :id)
(pcb/resize-parents changes))
changes (-> (pcb/empty-changes it)
(cll/generate-duplicate-changes all-objects page selected delta
libraries ldata file-id {:variant-props variant-props})
(pcb/amend-changes (partial process-rchange media-idx))
(pcb/amend-changes (partial change-add-obj-index objects selected index)))
changes (if (some? replace-id)
(second (cls/generate-delete-shapes changes #{replace-id} {}))
changes)
;; Adds a resize-parents operation so the groups are
;; updated. We add all the new objects
changes (->> (:redo-changes changes)
(filter add-obj?)
(map :id)
(pcb/resize-parents changes))
orig-shapes (map (d/getf all-objects) selected)
changes (if (some? replace-id)
(second (cls/generate-delete-shapes changes #{replace-id} {}))
changes)
children-after (-> (pcb/get-objects changes)
(dm/get-in [parent-id :shapes])
set)
orig-shapes (map (d/getf all-objects) selected)
;; At the end of the process, we want to select the new created shapes
;; that are a direct child of the shape parent-id
selected (into (d/ordered-set)
(comp
(filter add-obj?)
(map (comp :id :obj))
(filter #(contains? children-after %)))
(:redo-changes changes))
children-after (-> (pcb/get-objects changes)
(dm/get-in [parent-id :shapes])
set)
changes (cond-> changes
(some? drop-cell)
(pcb/update-shapes [parent-id]
#(ctl/add-children-to-cell % selected all-objects drop-cell)))
;; At the end of the process, we want to select the new created shapes
;; that are a direct child of the shape parent-id
selected (into (d/ordered-set)
(comp
(filter add-obj?)
(map (comp :id :obj))
(filter #(contains? children-after %)))
(:redo-changes changes))
add-component-to-variant? (and
;; Any of the shapes is a head
(some ctk/instance-head? orig-shapes)
;; Any ancestor of the destination parent is a variant
(->> (cfh/get-parents-with-self page-objects parent-id)
(some ctk/is-variant?)))
undo-id (js/Symbol)]
changes (cond-> changes
(some? drop-cell)
(pcb/update-shapes [parent-id]
#(ctl/add-children-to-cell % selected all-objects drop-cell)))
(rx/concat
(->> (rx/from orig-shapes)
(rx/map (fn [shape]
(let [parent-type (cfh/get-shape-type all-objects (:parent-id shape))
external-lib? (not= file-id (:component-file shape))
component (ctn/get-component-from-shape shape libraries)
origin "workspace:paste"]
add-component-to-variant? (and
;; Any of the shapes is a head
(some ctk/instance-head? orig-shapes)
;; Any ancestor of the destination parent is a variant
(->> (cfh/get-parents-with-self page-objects parent-id)
(some ctk/is-variant?)))
undo-id (js/Symbol)]
;; NOTE: we don't emit the create-shape event all the time for
;; avoid send a lot of events (that are not necessary); this
;; decision is made explicitly by the responsible team.
(if (ctk/instance-head? shape)
(ev/event {::ev/name "use-library-component"
::ev/origin origin
:is-external-library external-lib?
:type (get shape :type)
:parent-type parent-type
:is-variant (ctk/is-variant? component)})
(if (cfh/has-layout? objects (:parent-id shape))
(ev/event {::ev/name "layout-add-element"
::ev/origin origin
:type (get shape :type)
:parent-type parent-type})
(ev/event {::ev/name "create-shape"
::ev/origin origin
:type (get shape :type)
:parent-type parent-type})))))))
(rx/concat
(->> (rx/from orig-shapes)
(rx/map (fn [shape]
(let [parent-type (cfh/get-shape-type all-objects (:parent-id shape))
external-lib? (not= file-id (:component-file shape))
component (ctn/get-component-from-shape shape libraries)
origin "workspace:paste"]
;; NOTE: we don't emit the create-shape event all the time for
;; avoid send a lot of events (that are not necessary); this
;; decision is made explicitly by the responsible team.
(if (ctk/instance-head? shape)
(ev/event {::ev/name "use-library-component"
::ev/origin origin
:is-external-library external-lib?
:type (get shape :type)
:parent-type parent-type
:is-variant (ctk/is-variant? component)})
(if (cfh/has-layout? objects (:parent-id shape))
(ev/event {::ev/name "layout-add-element"
::ev/origin origin
:type (get shape :type)
:parent-type parent-type})
(ev/event {::ev/name "create-shape"
::ev/origin origin
:type (get shape :type)
:parent-type parent-type})))))))
(rx/of (dwu/start-undo-transaction undo-id)
(dch/commit-changes changes)
(dws/select-shapes selected)
(ptk/data-event :layout/update {:ids [frame-id]})
(dwu/commit-undo-transaction undo-id)
(when add-component-to-variant?
(ev/event {::ev/name "add-component-to-variant"})))))))))
(rx/of (dwu/start-undo-transaction undo-id)
(dch/commit-changes changes)
(dws/select-shapes selected)
(ptk/data-event :layout/update {:ids [frame-id]})
(dwu/commit-undo-transaction undo-id)
(when add-component-to-variant?
(ev/event {::ev/name "add-component-to-variant"})))))
(rx/empty)))))))
(defn- as-content [text]
(let [paragraphs (->> (str/lines text)

View File

@ -397,7 +397,8 @@
selected (dsh/lookup-selected state)
base (cfh/get-base-shape objects selected)
parent-id (if (or (and (= 1 (count selected))
parent-id (if (or (nil? base)
(and (= 1 (count selected))
(cfh/frame-shape? (get objects (first selected))))
(empty? selected))
frame-id

View File

@ -93,7 +93,7 @@
(ctst/top-nested-frame objects position)
base-id)
parent-id (if (or selected-frame? (empty? selected))
parent-id (if (or selected-frame? (empty? selected) (nil? base))
frame-id
base-id)

View File

@ -5,23 +5,53 @@
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns frontend-tests.logic.pasting-in-containers-test
(:require
[app.common.geom.point :as gpt]
[app.common.test-helpers.components :as cthc]
[app.common.test-helpers.compositions :as ctho]
[app.common.test-helpers.files :as cthf]
[app.common.test-helpers.ids-map :as cthi]
[app.common.test-helpers.shapes :as cths]
[app.common.test-helpers.variants :as thv]
[app.common.transit :as transit]
[app.common.types.component :as ctk]
[app.common.uuid :as uuid]
[app.main.data.workspace :as dw]
[app.main.data.workspace.selection :as dws]
[app.main.data.workspace.shapes :as dwsh]
[app.main.data.workspace.svg-upload :as dwsvg]
[app.main.streams :as ms]
[beicon.v2.core :as rx]
[cljs.test :as t :include-macros true]
[cuerdas.core :as str]
[frontend-tests.helpers.pages :as thp]
[frontend-tests.helpers.state :as ths]))
[frontend-tests.helpers.state :as ths]
[potok.v2.core :as ptk]))
(defonce ^:private original-navigator-clipboard
(unchecked-get js/navigator "clipboard"))
(defn- restore-navigator-clipboard!
[]
(unchecked-set js/navigator "clipboard" original-navigator-clipboard))
(defn- install-read-clipboard!
"Install a `navigator.clipboard` stub serving `text` as a single
text/plain item, so `from-navigator` resolves it through the usual
transit decoding."
[text]
(unchecked-set
js/navigator "clipboard"
#js {:read (fn []
(js/Promise.resolve
#js [#js {:types #js ["text/plain"]
:getType (fn [_mime]
(js/Promise.resolve
#js {:size (count text)
:text (fn [] (js/Promise.resolve text))}))}]))}))
(t/use-fixtures :each
{:before thp/reset-idmap!})
{:before thp/reset-idmap!
:after restore-navigator-clipboard!})
;; Related .penpot file: common/test/cases/remove-swap-slots.penpot
(defn- setup-file
@ -666,4 +696,403 @@
;;There was 3 components, now there are still 3
(t/is (= 3 (count components)))
(t/is (= 3 (count components')))))))))
(t/is (= 3 (count components')))))))))
(t/deftest paste-with-unloaded-page-is-noop
"Pasting while the page is not loaded (e.g. right after opening the workspace) is ignored instead of crashing"
(t/async
done
(let [;; ==== Setup
file (-> (cthf/sample-file :file1)
(ctho/add-frame :frame-blue {:name "frame-blue"}))
store (ths/setup-store file)
;; ==== Action
page (cthf/current-page file)
page-id (cthf/current-page-id file)
file-id (:id file)
frame-blue (cths/get-shape file :frame-blue)
features #{}
version 67
pdata (thp/simulate-copy-shape #{(:id frame-blue)} (:objects page) {(:id file) file} page file features version)
drop-page (ptk/reify ::drop-current-page
ptk/UpdateEvent
(update [_ state]
(update-in state [:files file-id :data :pages-index] dissoc page-id)))
events
[drop-page
(dw/paste-shapes pdata)]]
(ths/run-store
store done events
(fn [new-state]
(let [;; ==== Get
file' (ths/get-file-from-state new-state)
page' (cthf/current-page file')]
;; ==== Check
;; The page is still not loaded and nothing was pasted anywhere
(t/is (some? file'))
(t/is (nil? page'))))))))
(t/deftest paste-with-detached-selection-pastes-by-position
"Pasting with a selection of shapes detached from the shape tree falls back to pasting at the pointer position"
(t/async
done
(let [;; ==== Setup
file (-> (cthf/sample-file :file1)
(ctho/add-frame :frame-red {:name "frame-red"})
(ctho/add-frame :frame-blue {:name "frame-blue"}))
store (ths/setup-store file)
;; ==== Action
page (cthf/current-page file)
page-id (cthf/current-page-id file)
file-id (:id file)
frame-red (cths/get-shape file :frame-red)
frame-blue (cths/get-shape file :frame-blue)
features #{}
version 67
pdata (thp/simulate-copy-shape #{(:id frame-blue)} (:objects page) {(:id file) file} page file features version)
;; Detach the selected shape from the tree (it stays in the
;; objects map but is no longer reachable from the root)
detach-and-select (ptk/reify ::detach-and-select
ptk/UpdateEvent
(update [_ state]
(-> state
(update-in [:files file-id :data :pages-index page-id :objects uuid/zero :shapes]
(fn [shapes] (vec (remove #(= % (:id frame-red)) shapes))))
(assoc-in [:workspace-local :selected] #{(:id frame-red)}))))
_ (rx/push! ms/mouse-position (gpt/point 1000 1000))
events
[detach-and-select
(dw/paste-shapes pdata)]]
(ths/run-store
store done events
(fn [new-state]
(rx/push! ms/mouse-position nil)
(let [;; ==== Get
file' (ths/get-file-from-state new-state)
page' (cthf/current-page file')
frame-blue' (cths/get-shape file' :frame-blue)
copied' (find-copied-shape frame-blue' page' uuid/zero)]
;; ==== Check
;; The copy lands at the pointer position on the root
(t/is (some? copied'))
(t/is (= 1000 (:x copied')))
(t/is (= 1000 (:y copied')))))))))
(t/deftest paste-with-root-plus-orphan-selection-pastes-by-position
"Pasting with the root plus a shape orphaned from the objects map falls back to pasting at the pointer position"
(t/async
done
(let [;; ==== Setup
file (-> (cthf/sample-file :file1)
(ctho/add-frame :frame-blue {:name "frame-blue" :x 0 :y 0 :width 500 :height 500})
(ctho/add-rect :rect1))
store (ths/setup-store file)
;; ==== Action
page (cthf/current-page file)
page-id (cthf/current-page-id file)
file-id (:id file)
rect1 (cths/get-shape file :rect1)
frame-blue (cths/get-shape file :frame-blue)
features #{}
version 67
pdata (thp/simulate-copy-shape #{(:id frame-blue)} (:objects page) {(:id file) file} page file features version)
;; Orphan the shape (parent missing from the objects map and
;; absent from the tree) and select it together with the root.
;; clean-loops cannot prune either id, so there is no base
;; shape and the frame branches cannot handle the selection.
detach-and-select (ptk/reify ::detach-and-select-root
ptk/UpdateEvent
(update [_ state]
(-> state
(update-in [:files file-id :data :pages-index page-id :objects]
(fn [objects]
(-> objects
(update-in [uuid/zero :shapes]
(fn [shapes]
(vec (remove #(= % (:id rect1)) shapes))))
(update (:id rect1) assoc :parent-id (uuid/custom 9 9)))))
(assoc-in [:workspace-local :selected] #{uuid/zero (:id rect1)}))))
_ (rx/push! ms/mouse-position (gpt/point 1000 1000))
events
[detach-and-select
(dw/paste-shapes pdata)]]
(ths/run-store
store done events
(fn [new-state]
(rx/push! ms/mouse-position nil)
(let [;; ==== Get
file' (ths/get-file-from-state new-state)
page' (cthf/current-page file')
frame-blue' (cths/get-shape file' :frame-blue)
copied' (find-copied-shape frame-blue' page' uuid/zero)]
;; ==== Check
;; The copy lands at the pointer position on the root
(t/is (some? copied'))
(t/is (= 1000 (:x copied')))
(t/is (= 1000 (:y copied')))))))))
(t/deftest paste-with-root-only-selection-stays-on-frame-path
"Pasting with only the root selected keeps using the frame branches, not the pointer fallback"
(t/async
done
(let [;; ==== Setup
file (-> (cthf/sample-file :file1)
(ctho/add-frame :frame-blue {:name "frame-blue" :x 0 :y 0 :width 500 :height 500}))
store (ths/setup-store file)
;; ==== Action
page (cthf/current-page file)
frame-blue (cths/get-shape file :frame-blue)
features #{}
version 67
pdata (thp/simulate-copy-shape #{(:id frame-blue)} (:objects page) {(:id file) file} page file features version)
select-root (ptk/reify ::select-root
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:workspace-local :selected] #{uuid/zero})))
;; Push the pointer far away so a pointer fallback would be
;; observable: the frame path must not land the copy here.
;; (A naive plain `(nil? base)` fallback condition would.)
_ (rx/push! ms/mouse-position (gpt/point 1000 1000))
events
[select-root
(dw/paste-shapes pdata)]]
(ths/run-store
store done events
(fn [new-state]
(rx/push! ms/mouse-position nil)
(let [;; ==== Get
file' (ths/get-file-from-state new-state)
page' (cthf/current-page file')
frame-blue' (cths/get-shape file' :frame-blue)
copied' (find-copied-shape frame-blue' page' uuid/zero)]
;; ==== Check
;; The copy lands under the root through the frame path,
;; away from the pointer position.
(t/is (some? copied'))
(t/is (= uuid/zero (:parent-id copied')))
(t/is (not (= 1000 (:x copied'))))))))))
(t/deftest create-shape-with-detached-selection-uses-cursor-frame
"Creating a shape with a selection detached from the shape tree falls back to the frame under the cursor"
(t/async
done
(let [;; ==== Setup
file (-> (cthf/sample-file :file1)
(ctho/add-frame :frame-red {:name "frame-red" :x 1000 :y 1000 :width 100 :height 100})
(ctho/add-frame :frame-blue {:name "frame-blue" :x 0 :y 0 :width 500 :height 500})
(ctho/add-rect :rect1))
store (ths/setup-store file)
;; ==== Action
page-id (cthf/current-page-id file)
file-id (:id file)
rect1 (cths/get-shape file :rect1)
frame-blue (cths/get-shape file :frame-blue)
;; Detach the selected shape from the tree (it stays in the
;; objects map but is no longer reachable from the root)
detach-and-select (ptk/reify ::detach-and-select
ptk/UpdateEvent
(update [_ state]
(-> state
(update-in [:files file-id :data :pages-index page-id :objects uuid/zero :shapes]
(fn [shapes] (vec (remove #(= % (:id rect1)) shapes))))
(assoc-in [:workspace-local :selected] #{(:id rect1)}))))
events
[detach-and-select
(dwsh/create-and-add-shape :rect 100 100 {:name "detached-rect"
:width 50 :height 50
:x 100 :y 100})]]
(ths/run-store
store done events
(fn [new-state]
(let [;; ==== Get
file' (ths/get-file-from-state new-state)
page' (cthf/current-page file')
created' (->> (vals (:objects page'))
(filter #(= (:name %) "detached-rect"))
first)]
;; ==== Check
;; The shape is created inside the frame under the cursor
(t/is (some? created'))
(t/is (= (:id frame-blue) (:parent-id created')))))))))
(t/deftest svg-upload-with-detached-selection-uses-cursor-frame
"Uploading an SVG with a selection detached from the shape tree falls back to the frame under the cursor"
(t/async
done
(let [;; ==== Setup
file (-> (cthf/sample-file :file1)
(ctho/add-frame :frame-red {:name "frame-red" :x 1000 :y 1000 :width 100 :height 100})
(ctho/add-frame :frame-blue {:name "frame-blue" :x 0 :y 0 :width 500 :height 500})
(ctho/add-rect :rect1))
store (ths/setup-store file)
;; ==== Action
page-id (cthf/current-page-id file)
file-id (:id file)
rect1 (cths/get-shape file :rect1)
frame-blue (cths/get-shape file :frame-blue)
;; Detach the selected shape from the tree (it stays in the
;; objects map but is no longer reachable from the root)
detach-and-select (ptk/reify ::detach-and-select-svg
ptk/UpdateEvent
(update [_ state]
(-> state
(update-in [:files file-id :data :pages-index page-id :objects uuid/zero :shapes]
(fn [shapes] (vec (remove #(= % (:id rect1)) shapes))))
(assoc-in [:workspace-local :selected] #{(:id rect1)}))))
svg-data {:name "test.svg"
:attrs {:width 100 :height 100}
:content [{:tag :rect
:attrs {:x "10" :y "10" :width "20" :height "20"}}]}
events
[detach-and-select
(dwsvg/add-svg-shapes nil svg-data (gpt/point 100 100) nil)]]
(ths/run-store
store done events
(fn [new-state]
(let [;; ==== Get
file' (ths/get-file-from-state new-state)
page' (cthf/current-page file')
created' (->> (vals (:objects page'))
(filter #(= (:name %) "test"))
first)]
;; ==== Check
;; The shape is created inside the frame under the cursor
(t/is (some? created'))
(t/is (= (:id frame-blue) (:parent-id created')))))))))
(t/deftest props-paste-with-unloaded-page-is-noop
"Pasting props while the page is not loaded is ignored instead of crashing"
(t/async
done
(let [;; ==== Setup
file (-> (cthf/sample-file :file1)
(ctho/add-rect :rect1))
store (ths/setup-store file)
;; ==== Action
page-id (cthf/current-page-id file)
file-id (:id file)
rect1 (cths/get-shape file :rect1)
props {:fills (cths/sample-fills-color :fill-color "#ff0000")}
payload (transit/encode-str {:type :copied-props
:features #{"components/v2"}
:version 67
:props props
:images []})
_ (install-read-clipboard! payload)
select-rect (ptk/reify ::select-rect-props
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:workspace-local :selected] #{(:id rect1)})))
drop-page (ptk/reify ::drop-current-page-props
ptk/UpdateEvent
(update [_ state]
(update-in state [:files file-id :data :pages-index] dissoc page-id)))
;; The clipboard read resolves asynchronously, after run-store
;; emits its events; settle the run on a timer so the paste
;; pipeline (or its absence) has completed either way.
_ (js/setTimeout #(ptk/emit! store (ptk/data-event ::props-probe-done)) 250)
stopper (fn [stream] (rx/filter (ptk/type? ::props-probe-done) stream))
events
[select-rect
drop-page
(dw/paste-selected-props)]]
(ths/run-store
store done events
(fn [new-state]
(let [;; ==== Get
file' (ths/get-file-from-state new-state)
page' (cthf/current-page file')]
;; ==== Check
;; The page is still not loaded and nothing was pasted anywhere
(t/is (some? file'))
(t/is (nil? page'))))
stopper))))
(t/deftest props-paste-applies-props-on-loaded-page
"Pasting props on a loaded page applies them to the selection"
(t/async
done
(let [;; ==== Setup
file (-> (cthf/sample-file :file1)
(ctho/add-rect :rect1))
store (ths/setup-store file)
;; ==== Action
rect1 (cths/get-shape file :rect1)
props {:fills (cths/sample-fills-color :fill-color "#ff0000")}
payload (transit/encode-str {:type :copied-props
:features #{"components/v2"}
:version 67
:props props
:images []})
_ (install-read-clipboard! payload)
select-rect (ptk/reify ::select-rect-props-ok
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:workspace-local :selected] #{(:id rect1)})))
_ (js/setTimeout #(ptk/emit! store (ptk/data-event ::props-probe-ok)) 250)
stopper (fn [stream] (rx/filter (ptk/type? ::props-probe-ok) stream))
events
[select-rect
(dw/paste-selected-props)]]
(ths/run-store
store done events
(fn [new-state]
(let [;; ==== Get
file' (ths/get-file-from-state new-state)
rect1' (cths/get-shape file' :rect1)]
;; ==== Check
(t/is (= "#ff0000" (-> rect1' :fills first :fill-color)))))
stopper))))