2460dce0a5
A paste put an instance of "bg" inside "bg" itself. It saved, loaded, and then threw "symbol cycle in audio" out of nest/audio-tracks, because a container that contains itself has no finite expansion. place-symbol and ui/drag already refused that, each by asking clip/contains-symbol?. Paste asks clip/problems instead, and problems did not encode the invariant at all -- it checked missing symbols, pose tracks and audio links, but never the placement graph. So the rule goes where every command is already checked: paste, cut, duplicate, correction and the span ops all gate on problems, so one rule covers them all. Why it looked like a reasonable thing to do is the other half. place-symbol copied the symbol's name onto the instance it made, and that copy went stale on the next rename: the symbol read "bg" in its tab while an instance of it still read "symbol-18", which is its id from before it was named. One object under two names, with nothing on screen to connect them. So instances are no longer given a name at creation, and clip/node-label reads the symbol's name through on every render. :name on an instance now means only what a person typed, which is what tells two instances of one symbol apart -- "8625 left" and "8625 right" of one "face" -- so an authored name still wins and read-through is the fallback. The label logic was duplicated across four call sites with three different fallback orders; location.cljs already read through and the others did not. They now share one function. Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
163 lines
8.5 KiB
Clojure
163 lines
8.5 KiB
Clojure
(ns arthur.domain.clipboard-test
|
|
(:require [cljs.test :refer [deftest is testing]]
|
|
[arthur.domain.clip :as clip]
|
|
[arthur.domain.clipboard :as clipboard]
|
|
[arthur.domain.node :as node]
|
|
[arthur.domain.sequence-test :as fixture]))
|
|
|
|
(defn- ids []
|
|
(let [n (atom 0)]
|
|
#(keyword (str "copy-" (swap! n inc)))))
|
|
|
|
(defn- address [sid id path] [:node sid id path])
|
|
|
|
(deftest canonical-selection-is-an-occurrence-forest
|
|
(let [doc (-> (fixture/document)
|
|
(assoc-in [:symbols :drawing-a :nodes :g]
|
|
{:id :g :kind :group :z "g"})
|
|
(assoc-in [:symbols :drawing-a :nodes :child]
|
|
{:id :child :kind :rect :parent :g :z "h"}))
|
|
selections [(address :drawing-a :child [:a :g :child])
|
|
(address :drawing-a :g [:a :g])]
|
|
payload (get-in (clipboard/snapshot doc selections) [:clipboard :items])]
|
|
(is (= 1 (count payload)))
|
|
(is (= :g (:root (first payload))))
|
|
(is (= #{:g :child} (set (keys (:nodes (first payload))))))))
|
|
|
|
(deftest copy-paste-remaps-the-subtree-and-keeps-shared-content
|
|
(let [doc (fixture/document)
|
|
payload (:clipboard (clipboard/snapshot doc [(address :main :a [:a])]))
|
|
r (clipboard/paste (update-in doc [:symbols :main] dissoc :display)
|
|
payload :main 20 {:fresh-id (ids)})
|
|
made (:clip r)
|
|
id (first (:roots r))
|
|
n (get-in made [:symbols :main :nodes id])]
|
|
(is (nil? (:refused r)))
|
|
(is (= :drawing-a (node/source n)) "normal paste keeps symbol identity")
|
|
(is (= [20 24] (node/placed-span n)))
|
|
(is (= 12 (get-in made [:symbols :main :frames]))
|
|
"an ordinary symbol may contain cropped content beyond its window")
|
|
(is (empty? (clip/problems made)))))
|
|
|
|
(deftest pasting-a-symbol-into-itself-is-refused
|
|
;; What happened to a real document: an instance of "bg" was copied from the
|
|
;; symbol holding it, and pasted while "bg" itself was the open symbol. Nothing
|
|
;; on the paste path looked at the placement graph, so it saved, loaded, and
|
|
;; then threw "symbol cycle in audio" out of nest/audio-tracks.
|
|
(let [doc (-> (clip/blank)
|
|
(assoc-in [:symbols :outer] {:id :outer :frames 200 :nodes {}})
|
|
(assoc-in [:symbols :inner] {:id :inner :frames 10 :nodes {}})
|
|
(clip/place-symbol nil :outer :inner 5 (random-uuid) nil))
|
|
id (first (keys (get-in doc [:symbols :outer :nodes])))
|
|
payload (:clipboard (clipboard/snapshot doc [(address :outer id [id])]))]
|
|
(testing "into the symbol it places"
|
|
(let [r (clipboard/paste doc payload :inner 0 {:fresh-id (ids)})]
|
|
(is (= "symbol :inner instance :copy-1 places :inner, which is itself"
|
|
(:refused r)))
|
|
(is (nil? (:clip r)) "and the document is not handed back changed")))
|
|
(testing "while pasting it somewhere harmless still works"
|
|
(let [r (clipboard/paste doc payload :outer 0 {:fresh-id (ids)})]
|
|
(is (nil? (:refused r)))
|
|
(is (empty? (clip/problems (:clip r))))))))
|
|
|
|
(deftest lane-paste-claims-time-as-one-command
|
|
(let [doc (fixture/document)
|
|
payload (:clipboard (clipboard/snapshot doc [(address :main :a [:a])]))
|
|
r (clipboard/paste doc payload :main 4 {:fresh-id (ids)})
|
|
made (:clip r)
|
|
id (first (:roots r))]
|
|
(is (= :drawing-a (node/source (get-in made [:symbols :main :nodes id]))))
|
|
(is (nil? (get-in made [:symbols :main :nodes :b]))
|
|
"the pasted interval replaces the cel it covers")
|
|
(is (= [4 8] (node/placed-span (get-in made [:symbols :main :nodes id]))))
|
|
(is (empty? (clip/problems made)))))
|
|
|
|
(deftest multi-paste-has-one-destination-and-preserves-root-timing
|
|
(let [doc (update-in (fixture/document) [:symbols :main] dissoc :display)
|
|
payload (:clipboard
|
|
(clipboard/snapshot doc [(address :main :a [:a])
|
|
(address :main :b [:b])]))
|
|
r (clipboard/paste doc payload :main 20 {:fresh-id (ids)})
|
|
made (:clip r)
|
|
[a2 b2] (:roots r)]
|
|
(is (= [20 24] (node/placed-span (get-in made [:symbols :main :nodes a2]))))
|
|
(is (= [24 28] (node/placed-span (get-in made [:symbols :main :nodes b2]))))
|
|
(is (= 2 (count (:roots r))))
|
|
(is (empty? (clip/problems made)))))
|
|
|
|
(deftest multi-paste-into-a-lane-claims-all-intervals-atomically
|
|
(let [doc (fixture/document)
|
|
payload (:clipboard
|
|
(clipboard/snapshot doc [(address :main :a [:a])
|
|
(address :main :insert [:insert])]))
|
|
r (clipboard/paste doc payload :main 4 {:fresh-id (ids)})
|
|
made (:clip r)
|
|
[a2 insert2] (:roots r)]
|
|
(is (= [4 8] (node/placed-span (get-in made [:symbols :main :nodes a2]))))
|
|
(is (= [12 16] (node/placed-span (get-in made [:symbols :main :nodes insert2]))))
|
|
(is (nil? (get-in made [:symbols :main :nodes :b])))
|
|
(is (= [8 12] (node/placed-span (get-in made [:symbols :main :nodes :insert]))))
|
|
(is (= 16 (get-in made [:symbols :main :frames])))
|
|
(is (empty? (clip/problems made)))))
|
|
|
|
(deftest overlapping-multi-paste-into-a-lane-is-all-or-nothing
|
|
(let [base (fixture/document)
|
|
doc (-> base
|
|
(assoc-in [:symbols :source]
|
|
{:id :source :frames 8
|
|
:nodes {:a (get-in base [:symbols :main :nodes :a])
|
|
:b (assoc-in (get-in base [:symbols :main :nodes :b])
|
|
[:time :at] 2)}})
|
|
(assoc-in [:symbols :empty-lane]
|
|
{:id :empty-lane :frames 8 :display :lane :nodes {}}))
|
|
payload (:clipboard
|
|
(clipboard/snapshot doc [(address :source :a [:a])
|
|
(address :source :b [:b])]))
|
|
r (clipboard/paste doc payload :empty-lane 0 {:fresh-id (ids)})]
|
|
(is (= "overlapping copied things cannot be pasted into one lane" (:refused r)))
|
|
(is (nil? (:clip r)))
|
|
(is (= {} (get-in doc [:symbols :empty-lane :nodes])))))
|
|
|
|
(deftest lane-duplicate-is-the-forward-repeat-and-ripples-later-cels
|
|
(let [doc (fixture/document)
|
|
payload (:clipboard
|
|
(clipboard/snapshot doc [(address :main :a [:a])
|
|
(address :main :b [:b])]))
|
|
r (clipboard/duplicate doc payload {:fresh-id (ids)})
|
|
made (:clip r)
|
|
[a2 b2] (map :id (:roots r))]
|
|
(is (= [8 12] (node/placed-span (get-in made [:symbols :main :nodes a2]))))
|
|
(is (= [12 16] (node/placed-span (get-in made [:symbols :main :nodes b2]))))
|
|
(is (= [16 20] (node/placed-span (get-in made [:symbols :main :nodes :insert]))))
|
|
(is (= 20 (get-in made [:symbols :main :frames])))
|
|
(is (empty? (clip/problems made)))))
|
|
|
|
(deftest duplicate-unique-copies-one-complete-shared-symbol-graph
|
|
(let [doc (-> (fixture/document)
|
|
(assoc-in [:symbols :drawing-a :nodes :part]
|
|
{:id :part :kind :instance :z "b" :span [0 1]
|
|
:time {:at 0 :rate 1} :source {:symbol :wave}
|
|
:playback {:in 0 :speed 0 :end :stop}})
|
|
(update-in [:symbols :main] dissoc :display))
|
|
payload (:clipboard (clipboard/snapshot doc [(address :main :a [:a])]))
|
|
shared (:clip (clipboard/duplicate doc payload {:fresh-id (ids)}))
|
|
unique-r (clipboard/duplicate doc payload {:fresh-id (ids) :unique? true})
|
|
unique (:clip unique-r)
|
|
shared-id (:id (first (:roots (clipboard/duplicate doc payload {:fresh-id (ids)}))))
|
|
unique-id (:id (first (:roots unique-r)))
|
|
unique-source (node/source (get-in unique [:symbols :main :nodes unique-id]))]
|
|
(is (= :drawing-a (node/source (get-in shared [:symbols :main :nodes shared-id]))))
|
|
(is (not= :drawing-a unique-source))
|
|
(is (not= :wave (node/source (get-in unique [:symbols unique-source :nodes :part]))))
|
|
(is (empty? (clip/problems unique)))))
|
|
|
|
(deftest cut-keeps-the-snapshot-and-deletes-a-whole-subtree
|
|
(let [doc (-> (fixture/document)
|
|
(assoc-in [:symbols :main :nodes :child]
|
|
{:id :child :kind :rect :parent :plate :z "b"}))
|
|
payload (:clipboard (clipboard/snapshot doc [(address :main :plate [:plate])]))
|
|
made (:clip (clipboard/cut doc payload))]
|
|
(is (= #{:plate :child} (set (keys (:nodes (first (:items payload)))))))
|
|
(is (nil? (get-in made [:symbols :main :nodes :plate])))
|
|
(is (nil? (get-in made [:symbols :main :nodes :child])))
|
|
(is (empty? (clip/problems made)))))
|