diff --git a/common/src/app/common/files/helpers.cljc b/common/src/app/common/files/helpers.cljc index 296d4da83c..676ba2c46a 100644 --- a/common/src/app/common/files/helpers.cljc +++ b/common/src/app/common/files/helpers.cljc @@ -361,7 +361,8 @@ (defn set-touched-group [touched group] - (conj (or touched #{}) group)) + (when group + (conj (or touched #{}) group))) (defn touched-group? [shape group] diff --git a/common/src/app/common/types/component.cljc b/common/src/app/common/types/component.cljc index ec9a679a9f..7c6570f0c4 100644 --- a/common/src/app/common/types/component.cljc +++ b/common/src/app/common/types/component.cljc @@ -4,7 +4,11 @@ ;; ;; Copyright (c) KALEIDOS INC -(ns app.common.types.component) +(ns app.common.types.component + (:require + [app.common.data :as d] + [app.common.uuid :as uuid] + [cuerdas.core :as str])) ;; Attributes that may be synced in components, and the group they belong to. ;; When one attribute is modified in a shape inside a component, the corresponding @@ -170,6 +174,29 @@ (and (= shape-id (:main-instance-id component)) (= page-id (:main-instance-page component)))) +(defn build-swap-slot-group + "Convert a swap-slot into a :touched group" + [swap-slot] + (when swap-slot + (keyword (str "swap-slot-" swap-slot)))) + +(defn get-swap-slot + "If the shape has a :touched group in the form :swap-slot-, get the id." + [shape] + (let [group (->> (:touched shape) + (map name) + (d/seek #(str/starts-with? % "swap-slot-")))] + (when group + (uuid/uuid (subs group 10))))) + +(defn match-swap-slot? + [shape-inst shape-main] + (let [slot-inst (get-swap-slot shape-inst) + slot-main (get-swap-slot shape-main)] + (when (some? slot-inst) + (or (= slot-inst slot-main) + (= slot-inst (:id shape-main)))))) + (defn get-component-root [component] (if (true? (:main-instance-id component)) diff --git a/common/src/app/common/types/file.cljc b/common/src/app/common/types/file.cljc index 42a0a77898..9f16496abc 100644 --- a/common/src/app/common/types/file.cljc +++ b/common/src/app/common/types/file.cljc @@ -177,12 +177,36 @@ shape-id))) (dm/get-in component [:objects shape-id])))) +(defn get-component-shape-context + "Retrieve one shape in the component by id. Return the shape and its + context (the file and the container)." + [file component shape-id] + (let [components-v2 (dm/get-in file [:data :options :components-v2])] + (if (and components-v2 (not (:deleted component))) + (let [component-page (get-component-page (:data file) component)] + (when component-page + (let [child (cfh/get-child (:objects component-page) + (:main-instance-id component) + shape-id)] + (when child + [child file (ctn/make-container component-page :page)])))) + [(dm/get-in component [:objects shape-id]) + file + (ctn/make-container component :component)]))) + (defn get-ref-shape "Retrieve the shape in the component that is referenced by the instance shape." [file-data component shape] (when (:shape-ref shape) (get-component-shape file-data component (:shape-ref shape)))) +(defn get-ref-shape-context + "Retrieve the shape in the component that is referenced by the instance shape. + Return the shape and its context (the file and the container)." + [file component shape] + (when (:shape-ref shape) + (get-component-shape-context file component (:shape-ref 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" @@ -196,11 +220,33 @@ [file page libraries shape & {:keys [include-deleted?] :or {include-deleted? false}}] (let [find-ref-shape-in-head (fn [head-shape] - (let [head-file (find-component-file file libraries (:component-file head-shape)) - head-component (when (some? head-file) - (ctkl/get-component (:data head-file) (:component-id head-shape) include-deleted?))] - (when (some? head-component) - (get-ref-shape (:data head-file) head-component shape))))] + (let [component-file (find-component-file file libraries (:component-file head-shape)) + component (when (some? component-file) + (ctkl/get-component (:data component-file) (:component-id head-shape) include-deleted?))] + (when (some? component) + (get-ref-shape (:data component-file) component shape))))] + + (some find-ref-shape-in-head (ctn/get-parent-heads (:objects page) shape)))) + +(defn find-ref-shape-context + "Locate the nearest component in the local file or libraries, and retrieve the shape + referenced by the instance shape. Return the shape and its context (the file and + the container)." + ; TODO: It should be nice to avoid this duplicity without adding overhead in the simple case. + ; Perhaps adding the context as metadata of the shape? + [file page libraries shape & {:keys [include-deleted?] :or {include-deleted? false}}] + (let [find-ref-shape-in-head + (fn [head-shape] + ;; (js/console.log "head-shape" (clj->js head-shape)) + ;; (js/console.log " component-file" (str (:component-file head-shape))) + ;; (js/console.log " component-id" (str (:component-id head-shape))) + (let [component-file (find-component-file file libraries (:component-file head-shape)) + component (when (some? component-file) + (ctkl/get-component (:data component-file) (:component-id head-shape) include-deleted?))] + ;; (js/console.log "component-file" (clj->js component-file)) + ;; (js/console.log "component" (clj->js component)) + (when (some? component) + (get-ref-shape-context component-file component shape))))] (some find-ref-shape-in-head (ctn/get-parent-heads (:objects page) shape)))) @@ -210,12 +256,14 @@ [file page libraries shape & {:keys [include-deleted?] :or {include-deleted? false}}] (let [find-ref-component-in-head (fn [head-shape] - (let [head-file (find-component-file file libraries (:component-file head-shape)) - head-component (when (some? head-file) - (ctkl/get-component (:data head-file) (:component-id head-shape) include-deleted?))] - (when (some? head-component) - (when (get-ref-shape (:data head-file) head-component shape) - head-component))))] + (let [component-file (find-component-file file libraries (:component-file head-shape)) + component (when (some? component-file) + (ctkl/get-component (:data component-file) + (:component-id head-shape) + include-deleted?))] + (when (some? component) + (when (get-ref-shape (:data component-file) component shape) + component))))] (some find-ref-component-in-head (ctn/get-parent-copy-heads (:objects page) shape)))) @@ -251,6 +299,35 @@ (let [ref-component (find-ref-component file page libraries shape :include-deleted? true)] (true? (= (:id component) (:id ref-component))))) +(defn find-swap-slot + [shape page file libraries] + (dm/assert! "expected shape is head" (ctk/instance-head? shape)) + ;; (js/console.log "find-swap-slot" (clj->js shape)) + (if-let [swap-slot (ctk/get-swap-slot shape)] + ;; (do (js/console.log "uno" (str swap-slot)) swap-slot) + swap-slot + (let [[ref-shape ref-file ref-container] (find-ref-shape-context file + page + libraries + shape + :include-deleted? true)] + ;; (js/console.log "ref-shape" (clj->js ref-shape)) + (when ref-shape + ;; (js/console.log "ref-shape" (clj->js ref-shape)) + (if-let [swap-slot (ctk/get-swap-slot ref-shape)] + ;; (do (js/console.log "dos" (str swap-slot)) swap-slot) + swap-slot + (if (ctk/main-instance? ref-shape) + (:id shape) + (find-swap-slot ref-shape ref-container ref-file libraries))))))) + +(defn match-swap-slot? + [shape-inst shape-main page-inst page-main file libraries] + (let [slot-inst (find-swap-slot shape-inst page-inst file libraries) + slot-main (find-swap-slot shape-main page-main file libraries)] + (or (= slot-inst slot-main) + (= slot-inst (:id shape-main))))) + (defn get-component-shapes "Retrieve all shapes of the component" [file-data component] diff --git a/frontend/src/app/main/data/workspace/libraries.cljs b/frontend/src/app/main/data/workspace/libraries.cljs index c24d1d4691..0d64b733de 100644 --- a/frontend/src/app/main/data/workspace/libraries.cljs +++ b/frontend/src/app/main/data/workspace/libraries.cljs @@ -52,7 +52,7 @@ [potok.v2.core :as ptk])) ;; Change this to :info :debug or :trace to debug this module, or :warn to reset to default -(log/set-level! :warn) +(log/set-level! :trace) (defn- log-changes [changes file] @@ -870,16 +870,12 @@ 0))))) (defn- add-component-for-swap - [shape file-id id-new-component index target-cell keep-props-values {:keys [undo-group]}] + [shape file page libraries id-new-component index target-cell keep-props-values {:keys [undo-group]}] (dm/assert! (uuid? id-new-component)) - (dm/assert! (uuid? file-id)) (ptk/reify ::add-component-for-swap ptk/WatchEvent - (watch [it state _] - (let [page (wsh/lookup-page state) - libraries (wsh/get-libraries state) - - objects (:objects page) + (watch [it _ _] + (let [objects (:objects page) position (gpt/point (:x shape) (:y shape)) changes (-> (pcb/empty-changes it (:id page)) (pcb/set-undo-group undo-group) @@ -889,7 +885,7 @@ [new-shape changes] (dwlh/generate-instantiate-component changes objects - file-id + (:id file) id-new-component position page @@ -898,6 +894,16 @@ (:parent-id shape) (:frame-id shape)) + new-shape (cond-> new-shape + (nil? (ctk/get-swap-slot new-shape)) + (update :touched cfh/set-touched-group (-> (ctf/find-swap-slot shape + page + {:id (:id file) + :data file} + libraries) + (ctk/build-swap-slot-group)))) + + ;; _ (js/console.log "new-shape" (str (:id new-shape)) (clj->js new-shape)) changes (-> changes ;; Restore the properties @@ -905,7 +911,11 @@ ;; We need to set the same index as the original shape (pcb/change-parent (:parent-id shape) [new-shape] index {:component-swap true - :ignore-touched true}))] + :ignore-touched true}) + (dwlh/change-touched new-shape + shape + (ctn/make-container page :page) + {}))] ;; First delete so we don't break the grid layout cells (rx/of (dch/commit-changes changes) @@ -921,7 +931,10 @@ (watch [_ state _] ;; First delete shapes so we have space in the layout otherwise we can have problems ;; in the grid creating new rows/columns to make space - (let [objects (wsh/lookup-page-objects state) + (let [file (wsh/get-file state file-id) + libraries (wsh/get-libraries state) + page (wsh/lookup-page state) + objects (wsh/lookup-page-objects state) parent (get objects (:parent-id shape)) ;; If the target parent is a grid layout we need to pass the target cell @@ -941,7 +954,7 @@ (dwsh/delete-shapes nil (d/ordered-set (:id shape)) {:component-swap true :undo-id undo-id :undo-group undo-group}) - (add-component-for-swap shape file-id id-new-component index target-cell keep-props-values + (add-component-for-swap shape file page libraries id-new-component index target-cell keep-props-values {:undo-group undo-group}) (ptk/data-event :layout/update [(:parent-id shape)]) (dwu/commit-undo-transaction undo-id)))))) @@ -958,8 +971,12 @@ {::ev/name "component-swap"}) ptk/WatchEvent - (watch [_ _ _] + (watch [_ state _] (let [undo-id (js/Symbol)] + (log/info :msg "COMPONENT-SWAP" + :file (dwlh/pretty-file file-id state) + :id-new-component id-new-component + :undo-id undo-id) (rx/concat (rx/of (dwu/start-undo-transaction undo-id)) (rx/map #(component-swap % file-id id-new-component) (rx/from shapes)) diff --git a/frontend/src/app/main/data/workspace/libraries_helpers.cljs b/frontend/src/app/main/data/workspace/libraries_helpers.cljs index 32152b2ba3..92b0264560 100644 --- a/frontend/src/app/main/data/workspace/libraries_helpers.cljs +++ b/frontend/src/app/main/data/workspace/libraries_helpers.cljs @@ -30,7 +30,7 @@ [clojure.set :as set])) ;; Change this to :info :debug or :trace to debug this module, or :warn to reset to default -(log/set-level! :warn) +(log/set-level! :trace) (declare generate-sync-container) (declare generate-sync-shape) @@ -594,7 +594,7 @@ "Generate changes to synchronize one shape that is the root of a component instance, and all its children, from the given component." [changes libraries container shape-id reset? components-v2] - (log/debug :msg "Sync shape direct" :shape (str shape-id) :reset? reset?) + (log/debug :msg "Sync shape direct" :shape-inst (str shape-id) :reset? reset?) (let [shape-inst (ctn/get-shape container shape-id) library (dm/get-in libraries [(:component-file shape-inst) :data]) component (ctkl/get-component library (:component-id shape-inst) true)] @@ -656,7 +656,7 @@ (defn- generate-sync-shape-direct-recursive [changes container shape-inst component library shape-main root-inst root-main reset? initial-root? redirect-shaperef components-v2] (log/debug :msg "Sync shape direct recursive" - :shape (str (:name shape-inst)) + :shape-inst (str (:name shape-inst) " " (pretty-uuid (:id shape-inst))) :component (:name component)) (if (nil? shape-main) @@ -713,6 +713,8 @@ (map #(redirect-shaperef %) children-inst) children-inst) only-inst (fn [changes child-inst] + (log/trace :msg "Only inst" + :child-inst (str (:name child-inst) " " (pretty-uuid (:id child-inst)))) (if-not (and omit-touched? (contains? (:touched shape-inst) :shapes-group)) @@ -723,6 +725,8 @@ changes)) only-main (fn [changes child-main] + (log/trace :msg "Only main" + :child-main (str (:name child-main) " " (pretty-uuid (:id child-main)))) (if-not (and omit-touched? (contains? (:touched shape-inst) :shapes-group)) @@ -739,6 +743,9 @@ changes)) both (fn [changes child-inst child-main] + (log/trace :msg "Both" + :child-inst (str (:name child-inst) " " (pretty-uuid (:id child-inst))) + :child-main (str (:name child-main) " " (pretty-uuid (:id child-main)))) (generate-sync-shape-direct-recursive changes container child-inst @@ -753,6 +760,9 @@ components-v2)) moved (fn [changes child-inst child-main] + (log/trace :msg "Move" + :child-inst (str (:name child-inst) " " (pretty-uuid (:id child-inst))) + :child-main (str (:name child-main) " " (pretty-uuid (:id child-main)))) (move-shape changes child-inst @@ -768,7 +778,8 @@ only-main both moved - false)))) + false + reset?)))) (defn- generate-rename-component @@ -939,6 +950,7 @@ only-main both moved + true true) ;; The inverse sync may be made on a component that is inside a @@ -957,12 +969,15 @@ ;; ---- Operation generation helpers ---- (defn- compare-children - [changes children-inst children-main only-inst-cb only-main-cb both-cb moved-cb inverse?] + [changes children-inst children-main only-inst-cb only-main-cb both-cb moved-cb inverse? reset?] + (log/trace :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)] + (log/trace :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 @@ -979,31 +994,58 @@ (next children-main) (both-cb changes child-inst child-main)) - (let [child-inst' (d/seek #(ctk/is-main-of? child-main %) children-inst) - child-main' (d/seek #(ctk/is-main-of? % child-inst) children-main)] - (cond - (nil? child-inst') - (recur children-inst - (next children-main) - (only-main-cb changes child-main)) - - (nil? child-main') + (if (and (ctk/match-swap-slot? child-main child-inst) (not reset?)) + (do + (log/trace :msg "Match slot" + :shape-inst (str (:name child-inst) " " (pretty-uuid (:id child-inst))) + :shape-main (str (:name child-main) " " (pretty-uuid (:id child-main)))) (recur (next children-inst) - children-main - (only-inst-cb changes child-inst)) + (next children-main) + changes)) - :else - (if inverse? - (recur (next children-inst) - (remove #(= (:id %) (:id child-main')) children-main) - (-> changes - (both-cb child-inst child-main') - (moved-cb child-inst child-main'))) - (recur (remove #(= (:id %) (:id child-inst')) children-inst) - (next children-main) - (-> changes - (both-cb child-inst' child-main) - (moved-cb child-inst' child-main))))))))))) + (let [child-inst' (d/seek #(ctk/is-main-of? child-main %) children-inst) + child-main' (d/seek #(ctk/is-main-of? % child-inst) children-main)] + (cond + (nil? child-inst') + (let [matching-inst (d/seek #(ctk/match-swap-slot? % child-main) children-inst)] + (if (and (some? matching-inst) (not reset?)) + (do + (log/trace :msg "Match slot inst" + :shape-inst (str (:name child-inst') " " (pretty-uuid (:id child-inst'))) + :shape-main (str (:name child-main) " " (pretty-uuid (:id child-main)))) + (recur (remove #(= (:id %) (:id matching-inst)) children-inst) + (next children-main) + changes)) + (recur children-inst + (next children-main) + (only-main-cb changes child-main)))) + + (nil? child-main') + (let [matching-main (d/seek #(ctk/match-swap-slot? child-inst %) children-main)] + (if (and (some? matching-main) (not reset?)) + (do + (log/trace :msg "Match slot main" + :shape-inst (str (:name child-inst) " " (pretty-uuid (:id child-inst))) + :shape-main (str (:name child-main') " " (pretty-uuid (:id child-main')))) + (recur (next children-inst) + (remove #(= (:id %) (:id matching-main)) children-inst) + changes)) + (recur (next children-inst) + children-main + (only-inst-cb changes child-inst)))) + + :else + (if inverse? + (recur (next children-inst) + (remove #(= (:id %) (:id child-main')) children-main) + (-> changes + (both-cb child-inst child-main') + (moved-cb child-inst child-main'))) + (recur (remove #(= (:id %) (:id child-inst')) children-inst) + (next children-main) + (-> changes + (both-cb child-inst' child-main) + (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?] @@ -1033,7 +1075,8 @@ (assoc :remote-synced true) :always - (assoc :shape-ref (:id original-shape))))) + (-> (assoc :shape-ref (:id original-shape)) + (dissoc :touched))))) ; New shape, by definition, is synced to the main shape update-original-shape (fn [original-shape _new-shape] original-shape) @@ -1270,11 +1313,10 @@ changes changes'))) -(defn- change-touched +(defn change-touched [changes dest-shape origin-shape container {:keys [reset-touched? copy-touched?] :as options}] - (if (or (nil? (:shape-ref dest-shape)) - (not (or reset-touched? copy-touched?))) + (if (nil? (:shape-ref dest-shape)) changes (do (log/info :msg (str "CHANGE-TOUCHED " @@ -1287,12 +1329,16 @@ (let [new-touched (cond reset-touched? nil + copy-touched? (if (:remote-synced origin-shape) nil (set/union (:touched dest-shape) - (:touched origin-shape))))] + (:touched origin-shape))) + + :else + (:touched dest-shape))] (-> changes (update :redo-changes conj (make-change