3pp-mirror/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-07-23 11:57:24 +02:00
Code Issues Projects Releases Packages Wiki Activity

✨ Use touched flags when adding/deleting/moving shapes

Browse source
This commit is contained in:
Andrés Moya 2020-11-19 15:35:34 +01:00
parent 830d932eec
commit 6db1a907c8
5 changed files with 270 additions and 173 deletions
Download patch file Download diff file Expand all files Collapse all files

81
common/app/common/pages.cljc
View file

@ -340,6 +340,7 @@
:rx :radius-group :rx :radius-group
:ry :radius-group :ry :radius-group
:masked-group? :mask-group}) :masked-group? :mask-group})
;; shapes-group is handled differently
(s/def ::minimal-shape (s/def ::minimal-shape
(s/keys :req-un [::type ::name] (s/keys :req-un [::type ::name]
@ -468,30 +469,52 @@
(s/def :internal.changes.add-obj/obj ::shape) (s/def :internal.changes.add-obj/obj ::shape)
(defn- valid-container-id-frame?
[o]
(or (and (contains? o :page-id)
(not (contains? o :component-id))
(some? (:frame-id o)))
(and (contains? o :component-id)
(not (contains? o :page-id))
(nil? (:frame-id o)))))
(defn- valid-container-id?
[o]
(or (and (contains? o :page-id)
(not (contains? o :component-id)))
(and (contains? o :component-id)
(not (contains? o :page-id)))))
(defmethod change-spec :add-obj [_] (defmethod change-spec :add-obj [_]
(s/keys :req-un [::id (or ::page-id ::component-id) (s/and (s/keys :req-un [::id :internal.changes.add-obj/obj]
:internal.changes.add-obj/obj] :opt-un [::page-id ::component-id ::parent-id ::frame-id])
:opt-un [::parent-id ::frame-id])) valid-container-id-frame?))
(s/def ::operation (s/multi-spec operation-spec :type)) (s/def ::operation (s/multi-spec operation-spec :type))
(s/def ::operations (s/coll-of ::operation)) (s/def ::operations (s/coll-of ::operation))
(defmethod change-spec :mod-obj [_] (defmethod change-spec :mod-obj [_]
(s/keys :req-un [::id (or ::page-id ::component-id) ::operations])) (s/and (s/keys :req-un [::id ::operations]
:opt-un [::page-id ::component-id])
valid-container-id?))
(defmethod change-spec :del-obj [_] (defmethod change-spec :del-obj [_]
(s/keys :req-un [::id (or ::page-id ::component-id)])) (s/and (s/keys :req-un [::id]
:opt-un [::page-id ::component-id])
valid-container-id?))
(s/def :internal.changes.reg-objects/shapes (s/def :internal.changes.reg-objects/shapes
(s/coll-of uuid? :kind vector?)) (s/coll-of uuid? :kind vector?))
(defmethod change-spec :reg-objects [_] (defmethod change-spec :reg-objects [_]
(s/keys :req-un [(or ::page-id ::component-id) (s/and (s/keys :req-un [:internal.changes.reg-objects/shapes]
:internal.changes.reg-objects/shapes])) :opt-un [::page-id ::component-id])
valid-container-id?))
(defmethod change-spec :mov-objects [_] (defmethod change-spec :mov-objects [_]
(s/keys :req-un [(or ::page-id ::component-id) ::parent-id :internal.shape/shapes] (s/and (s/keys :req-un [::parent-id :internal.shape/shapes]
:opt-un [::index])) :opt-un [::page-id ::component-id ::index])
valid-container-id?))
(defmethod change-spec :add-page [_] (defmethod change-spec :add-page [_]
(s/or :empty (s/keys :req-un [::id ::name]) (s/or :empty (s/keys :req-un [::id ::name])
@ -710,7 +733,8 @@
(assoc data :options (d/dissoc-in (:options data) path))))))) (assoc data :options (d/dissoc-in (:options data) path)))))))
(defmethod process-change :add-obj (defmethod process-change :add-obj
[data {:keys [id obj page-id component-id frame-id parent-id index] :as change}] [data {:keys [id obj page-id component-id frame-id parent-id
index ignore-touched] :as change}]
(let [update-fn (fn [data] (let [update-fn (fn [data]
(let [parent-id (or parent-id frame-id) (let [parent-id (or parent-id frame-id)
objects (:objects data)] objects (:objects data)]
@ -726,7 +750,13 @@
(cond (cond
(some #{id} shapes) shapes (some #{id} shapes) shapes
(nil? index) (conj shapes id) (nil? index) (conj shapes id)
:else (cph/insert-at-index shapes index [id])))))))))] :else (cph/insert-at-index shapes index [id])))))
(cond->
(and (:shape-ref (get-in data [:objects parent-id]))
(not= parent-id frame-id)
(not ignore-touched))
(update-in [:objects parent-id :touched]
cph/set-touched-group :shapes-group))))))]
(if page-id (if page-id
(d/update-in-when data [:pages-index page-id] update-fn) (d/update-in-when data [:pages-index page-id] update-fn)
(d/update-in-when data [:components component-id] update-fn)))) (d/update-in-when data [:components component-id] update-fn))))
@ -742,7 +772,7 @@
(d/update-in-when data [:components component-id :objects] update-fn)))) (d/update-in-when data [:components component-id :objects] update-fn))))
(defmethod process-change :del-obj (defmethod process-change :del-obj
[data {:keys [page-id component-id id] :as change}] [data {:keys [page-id component-id id ignore-touched] :as change}]
(letfn [(delete-object [objects] (letfn [(delete-object [objects]
(if-let [target (get objects id)] (if-let [target (get objects id)]
(let [parent-id (cph/get-parent id objects) (let [parent-id (cph/get-parent id objects)
@ -754,6 +784,9 @@
(= :group (:type parent))) (= :group (:type parent)))
(update-in [parent-id :shapes] (fn [s] (filterv #(not= % id) s))) (update-in [parent-id :shapes] (fn [s] (filterv #(not= % id) s)))
(and (:shape-ref parent) (not ignore-touched))
(update-in [parent-id :touched] cph/set-touched-group :shapes-group)
(contains? objects frame-id) (contains? objects frame-id)
(update-in [frame-id :shapes] (fn [s] (filterv #(not= % id) s))) (update-in [frame-id :shapes] (fn [s] (filterv #(not= % id) s)))
@ -813,7 +846,7 @@
(d/update-in-when data [:components component-id :objects] reg-objects)))) (d/update-in-when data [:components component-id :objects] reg-objects))))
(defmethod process-change :mov-objects (defmethod process-change :mov-objects
[data {:keys [parent-id shapes index page-id component-id] :as change}] [data {:keys [parent-id shapes index page-id component-id ignore-touched] :as change}]
(letfn [(is-valid-move? [objects shape-id] (letfn [(is-valid-move? [objects shape-id]
(let [invalid-targets (cph/calculate-invalid-targets shape-id objects)] (let [invalid-targets (cph/calculate-invalid-targets shape-id objects)]
(and (not (invalid-targets parent-id)) (and (not (invalid-targets parent-id))
@ -840,6 +873,14 @@
(strip-id [coll id] (strip-id [coll id]
(filterv #(not= % id) coll)) (filterv #(not= % id) coll))
(add-to-parent [parent index shapes]
(cond-> parent
true
(update :shapes check-insert-items parent index shapes)
(and (:shape-ref parent) (= (:type parent) :group) (not ignore-touched))
(update :touched cph/set-touched-group :shapes-group)))
(remove-from-old-parent [cpindex objects shape-id] (remove-from-old-parent [cpindex objects shape-id]
(let [prev-parent-id (get cpindex shape-id)] (let [prev-parent-id (get cpindex shape-id)]
;; Do nothing if the parent id of the shape is the same as ;; Do nothing if the parent id of the shape is the same as
@ -856,7 +897,15 @@
(recur pid (recur pid
(:parent-id obj) (:parent-id obj)
(dissoc objects pid)) (dissoc objects pid))
(update-in objects [pid :shapes] strip-id sid))))))) (cond-> objects
true
(update-in [pid :shapes] strip-id sid)
(and (:shape-ref obj)
(= (:type obj) :group)
(not ignore-touched))
(update-in [pid :touched]
cph/set-touched-group :shapes-group))))))))
(update-parent-id [objects id] (update-parent-id [objects id]
(update objects id assoc :parent-id parent-id)) (update objects id assoc :parent-id parent-id))
@ -888,7 +937,7 @@
(if valid? (if valid?
(as-> objects $ (as-> objects $
(update-in $ [parent-id :shapes] check-insert-items parent index shapes) (update $ parent-id #(add-to-parent % index shapes))
(reduce update-parent-id $ shapes) (reduce update-parent-id $ shapes)
(reduce (partial remove-from-old-parent cpindex) $ shapes) (reduce (partial remove-from-old-parent cpindex) $ shapes)
(reduce (partial update-frame-ids frm-id) $ (get-in $ [parent-id :shapes]))) (reduce (partial update-frame-ids frm-id) $ (get-in $ [parent-id :shapes])))
@ -1016,7 +1065,7 @@
(cond-> shape (cond-> shape
(and shape-ref group (not ignore) (not= val (get shape attr))) (and shape-ref group (not ignore) (not= val (get shape attr)))
(update :touched #(conj (or % #{}) group)) (update :touched cph/set-touched-group group)
(nil? val) (nil? val)
(dissoc attr) (dissoc attr)

10
common/app/common/pages_helpers.cljc
View file

@ -49,6 +49,7 @@
(defn page? (defn page?
[container] [container]
(assert (some? (:type container)))
(= (:type container) :page)) (= (:type container) :page))
(defn component? (defn component?
@ -297,3 +298,12 @@
(d/seek #(gsh/has-point? % position)) (d/seek #(gsh/has-point? % position))
:id) :id)
uuid/zero))) uuid/zero)))
(defn set-touched-group
[touched group]
(conj (or touched #{}) group))
(defn touched-group?
[shape group]
((or (:touched shape) #{}) group))

9
frontend/src/app/main/data/workspace.cljs
View file

@ -711,6 +711,7 @@
(reduce (fn [res id] (reduce (fn [res id]
(let [children (cph/get-children id objects) (let [children (cph/get-children id objects)
parents (cph/get-parents id objects) parents (cph/get-parents id objects)
parent (get objects (first parents))
add-change (fn [id] add-change (fn [id]
(let [item (get objects id)] (let [item (get objects id)]
{:type :add-obj {:type :add-obj
@ -726,7 +727,13 @@
(map add-change children) (map add-change children)
[{:type :reg-objects [{:type :reg-objects
:page-id page-id :page-id page-id
:shapes (vec parents)}]))) :shapes (vec parents)}]
(when (some? parent)
[{:type :mod-obj
:page-id page-id
:id (:id parent)
:operations [{:type :set-touched
:touched (:touched parent)}]}]))))
[] []
ids) ids)
(map #(array-map (map #(array-map

4
frontend/src/app/main/data/workspace/libraries.cljs
View file

@ -398,13 +398,15 @@
:page-id page-id :page-id page-id
:frame-id (:frame-id obj) :frame-id (:frame-id obj)
:parent-id (:parent-id obj) :parent-id (:parent-id obj)
:ignore-touched true
:obj obj}) :obj obj})
new-shapes) new-shapes)
uchanges (map (fn [obj] uchanges (map (fn [obj]
{:type :del-obj {:type :del-obj
:id (:id obj) :id (:id obj)
:page-id page-id}) :page-id page-id
:ignore-touched true})
new-shapes)] new-shapes)]
(rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true}) (rx/of (dwc/commit-changes rchanges uchanges {:commit-local? true})

281
frontend/src/app/main/data/workspace/libraries_helpers.cljs
View file

@ -48,9 +48,7 @@
(declare add-shape-to-master) (declare add-shape-to-master)
(declare remove-shape) (declare remove-shape)
(declare move-shape) (declare move-shape)
(declare remove-component-and-ref) (declare change-touched)
(declare remove-ref)
(declare reset-touched)
(declare update-attrs) (declare update-attrs)
(declare calc-new-pos) (declare calc-new-pos)
@ -375,13 +373,18 @@
root-master root-master
{:omit-touched? (not reset?) {:omit-touched? (not reset?)
:reset-touched? reset? :reset-touched? reset?
:set-touched? false}))) :copy-touched? false})))
(defn- generate-sync-shape-direct-recursive (defn- generate-sync-shape-direct-recursive
[container shape-inst component shape-master root-inst root-master options] [container shape-inst component shape-master root-inst root-master
(log/trace :msg "Sync shape direct" {:keys [omit-touched? reset-touched? copy-touched?]
:as options :or {omit-touched? false
reset-touched? false
copy-touched? false}}]
(log/trace :msg "Sync shape direct recursive"
:shape (str (:name shape-inst)) :shape (str (:name shape-inst))
:component (:name component)) :component (:name component)
:options options)
(let [root-inst (if (:component-id shape-inst) (let [root-inst (if (:component-id shape-inst)
shape-inst shape-inst
@ -391,12 +394,17 @@
root-master) root-master)
[rchanges uchanges] [rchanges uchanges]
(concat-changes
(update-attrs shape-inst (update-attrs shape-inst
shape-master shape-master
root-inst root-inst
root-master root-master
container container
options) options)
(change-touched shape-inst
shape-master
container
options))
children-inst (mapv #(cph/get-shape container %) children-inst (mapv #(cph/get-shape container %)
(:shapes shape-inst)) (:shapes shape-inst))
@ -405,21 +413,22 @@
only-inst (fn [shape-inst] only-inst (fn [shape-inst]
(remove-shape shape-inst (remove-shape shape-inst
container)) container
omit-touched?))
only-master (fn [shape-master] only-master (fn [shape-master]
(add-shape-to-instance shape-master (add-shape-to-instance shape-master
component component
container container
root-inst root-inst
root-master)) root-master
omit-touched?))
both (fn [shape-inst shape-master] both (fn [shape-inst shape-master]
(let [options (if-not (:component-id shape-inst) (let [options (if-not (:component-id shape-inst)
options options
{:omit-touched? false {:omit-touched? false
:reset-touched? false :reset-touched? false
:set-touched? false
:copy-touched? true})] :copy-touched? true})]
(generate-sync-shape-direct-recursive container (generate-sync-shape-direct-recursive container
@ -435,7 +444,8 @@
shape-inst shape-inst
(d/index-of children-inst shape-inst) (d/index-of children-inst shape-inst)
(d/index-of children-master shape-master) (d/index-of children-master shape-master)
container)) container
omit-touched?))
[child-rchanges child-uchanges] [child-rchanges child-uchanges]
(compare-children children-inst (compare-children children-inst
@ -476,15 +486,20 @@
shape-master shape-master
root-inst root-inst
root-master root-master
{:omit-touched? false {:reset-touched? false
:reset-touched? false :set-touched? true
:set-touched? true}))) :copy-touched? false})))
(defn- generate-sync-shape-inverse-recursive (defn- generate-sync-shape-inverse-recursive
[container shape-inst component shape-master root-inst root-master options] [container shape-inst component shape-master root-inst root-master
(log/trace :msg "Sync shape inverse" {:keys [reset-touched? set-touched? copy-touched?]
:as options :or {reset-touched? false
set-touched? false
copy-touched? false}}]
(log/trace :msg "Sync shape inverse recursive"
:shape (str (:name shape-inst)) :shape (str (:name shape-inst))
:component (:name component)) :component (:name component)
:options options)
(let [root-inst (if (:component-id shape-inst) (let [root-inst (if (:component-id shape-inst)
shape-inst shape-inst
@ -503,9 +518,14 @@
root-inst root-inst
component-container component-container
options) options)
(concat-changes
(change-touched shape-master
shape-inst
component-container
options)
(if (:set-touched? options) (if (:set-touched? options)
(reset-touched shape-inst container) (change-touched shape-inst nil container {:reset-touched? true})
empty-changes)) empty-changes)))
children-inst (mapv #(cph/get-shape container %) children-inst (mapv #(cph/get-shape container %)
(:shapes shape-inst)) (:shapes shape-inst))
@ -521,13 +541,13 @@
only-master (fn [shape-master] only-master (fn [shape-master]
(remove-shape shape-master (remove-shape shape-master
component-container)) component-container
false))
both (fn [shape-inst shape-master] both (fn [shape-inst shape-master]
(let [options (if-not (:component-id shape-inst) (let [options (if-not (:component-id shape-inst)
options options
{:omit-touched? false {:reset-touched? false
:reset-touched? false
:set-touched? false :set-touched? false
:copy-touched? true})] :copy-touched? true})]
@ -544,7 +564,8 @@
shape-master shape-master
(d/index-of children-master shape-master) (d/index-of children-master shape-master)
(d/index-of children-inst shape-inst) (d/index-of children-inst shape-inst)
component-container)) component-container
false))
[child-rchanges child-uchanges] [child-rchanges child-uchanges]
(compare-children children-inst (compare-children children-inst
@ -560,6 +581,7 @@
; ---- Operation generation helpers ---- ; ---- Operation generation helpers ----
(defn- compare-children (defn- compare-children
[children-inst children-master only-inst-cb only-master-cb both-cb moved-cb inverse?] [children-inst children-master only-inst-cb only-master-cb both-cb moved-cb inverse?]
(loop [children-inst (seq (or children-inst [])) (loop [children-inst (seq (or children-inst []))
@ -626,14 +648,14 @@
(d/concat uchanges1 uchanges2)]) (d/concat uchanges1 uchanges2)])
(defn- add-shape-to-instance (defn- add-shape-to-instance
[component-shape component page root-instance root-master] [component-shape component container root-instance root-master omit-touched?]
(log/info :msg (str "ADD [P] " (:name component-shape))) (log/info :msg (str "ADD [P] " (:name component-shape)))
(let [component-parent-shape (cph/get-shape component (:parent-id component-shape)) (let [component-parent-shape (cph/get-shape component (:parent-id component-shape))
parent-shape (d/seek #(cph/is-master-of component-parent-shape %) parent-shape (d/seek #(cph/is-master-of component-parent-shape %)
(cph/get-object-with-children (:id root-instance) (cph/get-object-with-children (:id root-instance)
(:objects page))) (:objects container)))
all-parents (vec (cons (:id parent-shape) all-parents (vec (cons (:id parent-shape)
(cph/get-parents parent-shape (:objects page)))) (cph/get-parents parent-shape (:objects container))))
update-new-shape (fn [new-shape original-shape] update-new-shape (fn [new-shape original-shape]
(let [new-pos (calc-new-pos new-shape (let [new-pos (calc-new-pos new-shape
@ -665,29 +687,43 @@
[new-shape new-shapes _] [new-shape new-shapes _]
(cph/clone-object component-shape (cph/clone-object component-shape
(:id parent-shape) (:id parent-shape)
(get page :objects) (get container :objects)
update-new-shape update-new-shape
update-original-shape) update-original-shape)
rchanges (d/concat rchanges (d/concat
(mapv (fn [shape'] (mapv (fn [shape']
{:type :add-obj (as-> {:type :add-obj
:id (:id shape') :id (:id shape')
:page-id (:id page)
:parent-id (:parent-id shape') :parent-id (:parent-id shape')
:obj shape'}) :ignore-touched true
:obj shape'} $
(cond-> $
(:frame-id shape')
(assoc :frame-id (:frame-id shape')))
(if (cph/page? container)
(assoc $ :page-id (:id container))
(assoc $ :component-id (:id container)))))
new-shapes) new-shapes)
[{:type :reg-objects [(as-> {:type :reg-objects
:page-id (:id page) :shapes all-parents} $
:shapes all-parents}]) (if (cph/page? container)
(assoc $ :page-id (:id container))
(assoc $ :component-id (:id container))))])
uchanges (mapv (fn [shape'] uchanges (d/concat
{:type :del-obj (mapv (fn [shape']
(as-> {:type :del-obj
:id (:id shape') :id (:id shape')
:page-id (:id page)}) :ignore-touched true} $
new-shapes)] (if (cph/page? container)
(assoc $ :page-id (:id container))
(assoc $ :component-id (:id container)))))
new-shapes))]
[rchanges uchanges])) (if (and (cph/touched-group? parent-shape :shapes-group) omit-touched?)
empty-changes
[rchanges uchanges])))
(defn- add-shape-to-master (defn- add-shape-to-master
[shape component page root-instance root-master] [shape component page root-instance root-master]
@ -716,7 +752,7 @@
[new-shape new-shapes updated-shapes] [new-shape new-shapes updated-shapes]
(cph/clone-object shape (cph/clone-object shape
(:shape-ref parent-shape) (:id component-parent-shape)
(get page :objects) (get page :objects)
update-new-shape update-new-shape
update-original-shape) update-original-shape)
@ -727,6 +763,7 @@
:id (:id shape') :id (:id shape')
:component-id (:id component) :component-id (:id component)
:parent-id (:parent-id shape') :parent-id (:parent-id shape')
:ignore-touched true
:obj shape'}) :obj shape'})
new-shapes) new-shapes)
[{:type :reg-objects [{:type :reg-objects
@ -753,29 +790,40 @@
:val (:touched shape')}]}) :val (:touched shape')}]})
updated-shapes)) updated-shapes))
uchanges (mapv (fn [shape'] uchanges (d/concat
(mapv (fn [shape']
{:type :del-obj {:type :del-obj
:id (:id shape') :id (:id shape')
:page-id (:id page)}) :page-id (:id page)
new-shapes)] :ignore-touched true})
new-shapes))]
[rchanges uchanges])) [rchanges uchanges]))
(defn- remove-shape (defn- remove-shape
[shape container] [shape container omit-touched?]
(log/info :msg (str "REMOVE-SHAPE " (log/info :msg (str "REMOVE-SHAPE "
(if (cph/page? container) "[P] " "[C] ") (if (cph/page? container) "[P] " "[C] ")
(:name shape))) (:name shape)))
(let [objects (get container :objects) (let [objects (get container :objects)
parents (cph/get-parents (:id shape) objects) parents (cph/get-parents (:id shape) objects)
parent (first parents)
children (cph/get-children (:id shape) objects) children (cph/get-children (:id shape) objects)
rchanges [(as-> {:type :del-obj
:id (:id shape)
:ignore-touched true} $
(if (cph/page? container)
(assoc $ :page-id (:id container))
(assoc $ :component-id (:id container))))]
add-change (fn [id] add-change (fn [id]
(let [shape' (get objects id)] (let [shape' (get objects id)]
(as-> {:type :add-obj (as-> {:type :add-obj
:id id :id id
:index (cph/position-on-parent id objects) :index (cph/position-on-parent id objects)
:parent-id (:parent-id shape') :parent-id (:parent-id shape')
:ignore-touched true
:obj shape'} $ :obj shape'} $
(cond-> $ (cond-> $
(:frame-id shape') (:frame-id shape')
@ -784,12 +832,6 @@
(assoc $ :page-id (:id container)) (assoc $ :page-id (:id container))
(assoc $ :component-id (:id container)))))) (assoc $ :component-id (:id container))))))
rchanges [(as-> {:type :del-obj
:id (:id shape)} $
(if (cph/page? container)
(assoc $ :page-id (:id container))
(assoc $ :component-id (:id container))))]
uchanges (d/concat uchanges (d/concat
[(add-change (:id shape))] [(add-change (:id shape))]
(map add-change children) (map add-change children)
@ -798,10 +840,13 @@
(if (cph/page? container) (if (cph/page? container)
(assoc $ :page-id (:id container)) (assoc $ :page-id (:id container))
(assoc $ :component-id (:id container))))])] (assoc $ :component-id (:id container))))])]
[rchanges uchanges]))
(if (and (cph/touched-group? parent :shapes-group) omit-touched?)
empty-changes
[rchanges uchanges])))
(defn- move-shape (defn- move-shape
[shape index-before index-after container] [shape index-before index-after container omit-touched?]
(log/info :msg (str "MOVE " (log/info :msg (str "MOVE "
(if (cph/page? container) "[P] " "[C] ") (if (cph/page? container) "[P] " "[C] ")
(:name shape) (:name shape)
@ -809,111 +854,93 @@
index-before index-before
" -> " " -> "
index-after)) index-after))
(let [rchanges [(as-> {:type :mov-objects (let [parent (cph/get-shape container (:parent-id shape))
rchanges [(as-> {:type :mov-objects
:parent-id (:parent-id shape) :parent-id (:parent-id shape)
:shapes [(:id shape)] :shapes [(:id shape)]
:index index-after} $ :index index-after
:ignore-touched true} $
(if (cph/page? container) (if (cph/page? container)
(assoc $ :page-id (:id container)) (assoc $ :page-id (:id container))
(assoc $ :component-id (:id container))))] (assoc $ :component-id (:id container))))]
uchanges [(as-> {:type :mov-objects uchanges [(as-> {:type :mov-objects
:parent-id (:parent-id shape) :parent-id (:parent-id shape)
:shapes [(:id shape)] :shapes [(:id shape)]
:index index-before} $ :index index-before
:ignore-touched true} $
(if (cph/page? container) (if (cph/page? container)
(assoc $ :page-id (:id container)) (assoc $ :page-id (:id container))
(assoc $ :component-id (:id container))))]] (assoc $ :component-id (:id container))))]]
[rchanges uchanges]))
(defn- remove-component-and-ref (if (and (cph/touched-group? parent :shapes-group) omit-touched?)
[shape container] empty-changes
(log/info :msg (str "REMOVE-COMPONENT-AND-REF " [rchanges uchanges])))
(defn- change-touched
[dest-shape orig-shape container
{:keys [reset-touched? copy-touched?]
:as options :or {reset-touched? false
copy-touched? false}}]
(if (or (nil? (:shape-ref dest-shape))
(not (or reset-touched? copy-touched?)))
empty-changes
(do
(log/info :msg (str "CHANGE-TOUCHED "
(if (cph/page? container) "[P] " "[C] ") (if (cph/page? container) "[P] " "[C] ")
(:name shape))) (:name dest-shape))
[[(as-> {:type :mod-obj :options options)
:id (:id shape) (let [rchanges [(as-> {:type :mod-obj
:operations [{:type :set :id (:id dest-shape)
:attr :component-root? :operations
:val nil} [{:type :set-touched
{:type :set :touched
:attr :component-id (cond reset-touched?
:val nil} nil
{:type :set copy-touched?
:attr :component-file (:touched orig-shape))}]} $
:val nil}
{:type :set
:attr :shape-ref
:val nil}
{:type :set-touched
:touched nil}]} $
(if (cph/page? container) (if (cph/page? container)
(assoc $ :page-id (:id container)) (assoc $ :page-id (:id container))
(assoc $ :component-id (:id container))))] (assoc $ :component-id (:id container))))]
[(as-> {:type :mod-obj
:id (:id shape) uchanges [(as-> {:type :mod-obj
:operations [{:type :set :id (:id dest-shape)
:attr :component-root? :operations
:val (:component-root? shape)} [{:type :set-touched
{:type :set :touched (:touched dest-shape)}]} $
:attr :component-id
:val (:component-id shape)}
{:type :set
:attr :component-file
:val (:component-file shape)}
{:type :set
:attr :shape-ref
:val (:shape-ref shape)}
{:type :set-touched
:touched (:touched shape)}]} $
(if (cph/page? container) (if (cph/page? container)
(assoc $ :page-id (:id container)) (assoc $ :page-id (:id container))
(assoc $ :component-id (:id container))))]]) (assoc $ :component-id (:id container))))]]
[rchanges uchanges]))))
(defn- remove-ref (defn- set-touched-shapes-group
[shape container] [shape container]
(log/info :msg (str "REMOVE-REF " (if-not (:shape-ref shape)
empty-changes
(do
(log/info :msg (str "SET-TOUCHED-SHAPES-GROUP "
(if (cph/page? container) "[P] " "[C] ") (if (cph/page? container) "[P] " "[C] ")
(:name shape))) (:name shape)))
[[(as-> {:type :mod-obj (let [rchanges [(as-> {:type :mod-obj
:id (:id shape) :id (:id shape)
:operations [{:type :set :operations
:attr :shape-ref [{:type :set-touched
:val nil} :touched (cph/set-touched-group
{:type :set-touched (:touched shape)
:touched nil}]} $ :shapes-group)}]} $
(if (cph/page? container) (if (cph/page? container)
(assoc $ :page-id (:id container)) (assoc $ :page-id (:id container))
(assoc $ :component-id (:id container))))] (assoc $ :component-id (:id container))))]
[(as-> {:type :mod-obj
:id (:id shape)
:operations [{:type :set
:attr :shape-ref
:val (:shape-ref shape)}
{:type :set-touched
:touched (:touched shape)}]} $
(if (cph/page? container)
(assoc $ :page-id (:id container))
(assoc $ :component-id (:id container))))]])
(defn- reset-touched uchanges [(as-> {:type :mod-obj
[shape container]
(log/info :msg (str "RESET-TOUCHED "
(if (cph/page? container) "[P] " "[C] ")
(:name shape)))
[[(as-> {:type :mod-obj
:id (:id shape) :id (:id shape)
:operations [{:type :set-touched :operations
:touched nil}]} $ [{:type :set-touched
(if (cph/page? container)
(assoc $ :page-id (:id container))
(assoc $ :component-id (:id container))))]
[(as-> {:type :mod-obj
:id (:id shape)
:operations [{:type :set-touched
:touched (:touched shape)}]} $ :touched (:touched shape)}]} $
(if (cph/page? container) (if (cph/page? container)
(assoc $ :page-id (:id container)) (assoc $ :page-id (:id container))
(assoc $ :component-id (:id container))))]]) (assoc $ :component-id (:id container))))]]
[rchanges uchanges]))))
(defn- update-attrs (defn- update-attrs
"The main function that implements the sync algorithm. Copy "The main function that implements the sync algorithm. Copy
@ -923,7 +950,9 @@
If reset-touched? is true, the 'touched' flags will be cleared in If reset-touched? is true, the 'touched' flags will be cleared in
the dest shape. the dest shape.
If set-touched? is true, the corresponding 'touched' flags will be If set-touched? is true, the corresponding 'touched' flags will be
set in dest shape if they are different than their current values." set in dest shape if they are different than their current values.
If copy-touched? is true, the value of 'touched' flags in the
origin shape will be copied as is to the dest shape."
[dest-shape origin-shape dest-root origin-root container [dest-shape origin-shape dest-root origin-root container
{:keys [omit-touched? reset-touched? set-touched? copy-touched?] {:keys [omit-touched? reset-touched? set-touched? copy-touched?]
:as options :or {omit-touched? false :as options :or {omit-touched? false