🐛 Fix touched groups when detaching with nested copies

common/src/app/common/files/changes.cljc

@@ -670,52 +670,14 @@
   (ctyl/delete-typography data id))
 
 ;; === Operations
-
 (defmethod process-operation :set
   [on-changed shape op]
-  (let [attr            (:attr op)
-        group           (get ctk/sync-attrs attr)
-        val             (:val op)
-        shape-val       (get shape attr)
-        ignore          (or (:ignore-touched op) (= attr :position-data)) ;; position-data is a derived attribute and
-        ignore-geometry (:ignore-geometry op)                             ;; never triggers touched by itself
-        is-geometry?    (and (or (= group :geometry-group)
-                                 (and (= group :content-group) (= (:type shape) :path)))
-                             (not (#{:width :height} attr))) ;; :content in paths are also considered geometric
-                        ;; TODO: the check of :width and :height probably may be removed
-                        ;;       after the check added in data/workspace/modifiers/check-delta
-                        ;;       function. Better check it and test toroughly when activating
-                        ;;       components-v2 mode.
-        in-copy?        (ctk/in-component-copy? shape)
-
-        ;; For geometric attributes, there are cases in that the value changes
-        ;; slightly (e.g. when rounding to pixel, or when recalculating text
-        ;; positions in different zoom levels). To take this into account, we
-        ;; ignore geometric changes smaller than 1 pixel.
-        equal? (if is-geometry?
-                 (gsh/close-attrs? attr val shape-val 1)
-                 (gsh/close-attrs? attr val shape-val))]
-
-    ;; Notify when value has changed, except when it has not moved relative to the
-    ;; component head.
-    (when (and group (not equal?) (not (and ignore-geometry is-geometry?)))
-      (on-changed shape))
-
-    (cond-> shape
-      ;; Depending on the origin of the attribute change, we need or not to
-      ;; set the "touched" flag for the group the attribute belongs to.
-      ;; In some cases we need to ignore touched only if the attribute is
-      ;; geometric (position, width or transformation).
-      (and in-copy? group (not ignore) (not equal?)
-           (not (and ignore-geometry is-geometry?)))
-      (-> (update :touched cfh/set-touched-group group)
-          (dissoc :remote-synced))
-
-      (nil? val)
-      (dissoc attr)
-
-      (some? val)
-      (assoc attr val))))
+  (ctn/set-shape-attr shape
+                      (:attr op)
+                      (:val op)
+                      :on-changed on-changed
+                      :ignore-touched (:ignore-touched op)
+                      :ignore-geometry (:ignore-geometry op)))
 
 (defmethod process-operation :set-touched
   [_ shape op]

common/src/app/common/files/helpers.cljc

@@ -357,15 +357,6 @@
 ;; COMPONENTS HELPERS
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defn set-touched-group
-  [touched group]
-  (when group
-    (conj (or touched #{}) group)))
-
-(defn touched-group?
-  [shape group]
-  ((or (:touched shape) #{}) group))
-
 (defn make-container
   [page-or-component type]
   (assoc page-or-component :type type))

common/src/app/common/logic/libraries.cljc

@@ -288,13 +288,23 @@
                         (some? (:shape-ref ref-shape))
                         (pcb/update-shapes [(:id shape)] #(assoc % :shape-ref (:shape-ref ref-shape)))
 
-                        ;; When advancing level, if the referenced shape has a swap slot, it must be
-                        ;; copied to the current shape, because the shape-ref now will not be pointing
-                        ;; to a near main (except for first level subcopies).
+                        ;; When advancing level, the normal touched groups (not swap slots) of the
+                        ;; ref-shape must be merged into the current shape, because they refer to
+                        ;; the new referenced shape.
+                        (some? ref-shape)
+                        (pcb/update-shapes
+                         [(:id shape)]
+                         #(assoc % :touched
+                                 (clojure.set/union (: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.
                         (and (some? (ctk/get-swap-slot ref-shape))
                              (nil? (ctk/get-swap-slot shape))
                              (not= (:id shape) shape-id))
                         (pcb/update-shapes [(:id shape)] #(ctk/set-swap-slot % (ctk/get-swap-slot ref-shape))))))]
+
     (reduce skip-near changes children)))
 
 (defn prepare-restore-component

common/src/app/common/test_helpers/shapes.cljc

@@ -12,6 +12,7 @@
    [app.common.test-helpers.ids-map :as thi]
    [app.common.types.color :as ctc]
    [app.common.types.colors-list :as ctcl]
+   [app.common.types.container :as ctn]
    [app.common.types.file :as ctf]
    [app.common.types.pages-list :as ctpl]
    [app.common.types.shape :as cts]
@@ -69,6 +70,19 @@
                (thf/current-page file))]
     (ctst/get-shape page id)))
 
+(defn update-shape
+  [file shape-label attr val & {:keys [page-label]}]
+  (let [page (if page-label
+               (thf/get-page file page-label)
+               (thf/current-page file))
+        shape (ctst/get-shape page (thi/id shape-label))]
+    (ctf/update-file-data
+     file
+     (fn [file-data]
+       (ctpl/update-page file-data
+                         (:id page)
+                         #(ctst/set-shape % (ctn/set-shape-attr shape attr val)))))))
+
 (defn sample-color
   [label & {:keys [] :as params}]
   (ctc/make-color (assoc params :id (thi/new-id! label))))

common/src/app/common/types/component.cljc

@@ -202,6 +202,11 @@
   [group]
   (str/starts-with? (name group) "swap-slot-"))
 
+(defn normal-touched-groups
+  "Gets all touched groups that are not swap slots."
+  [shape]
+  (into #{} (remove swap-slot? (:touched shape))))
+
 (defn group->swap-slot
   [group]
   (uuid/uuid (subs (name group) 10)))

common/src/app/common/types/container.cljc

@@ -498,7 +498,7 @@
         ; original component doesn't exist or is deleted. So for this function purposes, they
         ; are removed from the list
         remove? (fn [shape]
-                  (let [component (get-in libraries [(:component-file shape) :data  :components (:component-id shape)])]
+                  (let [component (get-in libraries [(:component-file shape) :data :components (:component-id shape)])]
                     (and component (not (:deleted component)))))
 
         selected-components (cond->> (mapcat collect-main-shapes children objects)
@@ -534,3 +534,48 @@
        (if (or no-changes? (not (invalid-structure-for-component? objects parent children pasting? libraries)))
          [parent-id (get-frame parent-id)]
          (recur (:parent-id parent) objects children pasting? libraries))))))
+
+;; --- SHAPE UPDATE
+
+(defn set-shape-attr
+  [shape attr val & {:keys [on-changed ignore-touched ignore-geometry]}]
+  (let [group           (get ctk/sync-attrs attr)
+        shape-val       (get shape attr)
+        ignore          (or ignore-touched (= attr :position-data)) ;; position-data is a derived attribute and
+        is-geometry?    (and (or (= group :geometry-group)          ;; never triggers touched by itself
+                                 (and (= group :content-group) (= (:type shape) :path)))
+                             (not (#{:width :height} attr))) ;; :content in paths are also considered geometric
+                        ;; TODO: the check of :width and :height probably may be removed
+                        ;;       after the check added in data/workspace/modifiers/check-delta
+                        ;;       function. Better check it and test toroughly when activating
+                        ;;       components-v2 mode.
+        in-copy?        (ctk/in-component-copy? shape)
+
+        ;; For geometric attributes, there are cases in that the value changes
+        ;; slightly (e.g. when rounding to pixel, or when recalculating text
+        ;; positions in different zoom levels). To take this into account, we
+        ;; ignore geometric changes smaller than 1 pixel.
+        equal? (if is-geometry?
+                 (gsh/close-attrs? attr val shape-val 1)
+                 (gsh/close-attrs? attr val shape-val))]
+
+    ;; Notify when value has changed, except when it has not moved relative to the
+    ;; component head.
+    (when (and on-changed group (not equal?) (not (and ignore-geometry is-geometry?)))
+      (on-changed shape))
+
+    (cond-> shape
+      ;; Depending on the origin of the attribute change, we need or not to
+      ;; set the "touched" flag for the group the attribute belongs to.
+      ;; In some cases we need to ignore touched only if the attribute is
+      ;; geometric (position, width or transformation).
+      (and in-copy? group (not ignore) (not equal?)
+           (not (and ignore-geometry is-geometry?)))
+      (-> (update :touched ctk/set-touched-group group)
+          (dissoc :remote-synced))
+
+      (nil? val)
+      (dissoc attr)
+
+      (some? val)
+      (assoc attr val))))

common/src/app/common/types/shape.cljc

@@ -501,8 +501,8 @@
       (assoc :proportion-lock true)))
 
 (defn setup-shape
-  "A function that initializes the geometric data of
-  the shape. The props must have :x :y :width :height."
+  "A function that initializes the geometric data of the shape. The props must
+  contain at least :x :y :width :height."
   [{:keys [type] :as props}]
   (let [shape (make-minimal-shape type)
 

common/test/common_tests/logic/comp_detach_with_nested_test.cljc

@@ -4,7 +4,7 @@
 ;;
 ;; Copyright (c) KALEIDOS INC
 
-(ns common-tests.logic.comp-detach-with-swap-test
+(ns common-tests.logic.comp-detach-with-nested-test
   (:require
    [app.common.files.changes-builder :as pcb]
    [app.common.logic.libraries :as cll]
@@ -18,7 +18,7 @@
 
 (t/use-fixtures :each thi/test-fixture)
 
-;; Related .penpot file: common/test/cases/detach-with-swap.penpot
+;; Related .penpot file: common/test/cases/detach-with-nested.penpot
 (defn- setup-file
   []
   ;; {:r-ellipse} [:name Ellipse, :type :frame]                         # [Component :c-ellipse]
@@ -195,3 +195,177 @@
     (t/is (= (:shape-ref copy-nested-rectangle) (thi/id :rectangle)))
     (t/is (nil? (ctk/get-swap-slot copy-nested-rectangle)))))
 
+(t/deftest test-propagate-touched
+  (let [;; ==== Setup
+        file (-> (setup-file)
+                 (ths/update-shape :nested2-ellipse :fills (ths/sample-fills-color :fill-color "#fabada"))
+                 (thc/instantiate-component :c-big-board
+                                            :copy-big-board
+                                            :children-labels [:copy-h-board-with-ellipse
+                                                              :copy-nested2-h-ellipse
+                                                              :copy-nested2-ellipse]))
+
+        page                 (thf/current-page file)
+        nested2-ellipse      (ths/get-shape file :nested2-ellipse)
+        copy-nested2-ellipse (ths/get-shape file :copy-nested2-ellipse)
+
+        ;; ==== Action
+        changes (cll/generate-detach-instance (-> (pcb/empty-changes nil)
+                                                  (pcb/with-page page)
+                                                  (pcb/with-objects (:objects page)))
+                                              page
+                                              {(:id file) file}
+                                              (thi/id :copy-big-board))
+        file'   (thf/apply-changes file changes)
+
+        ;; ==== Get
+        nested2-ellipse'      (ths/get-shape file' :nested2-ellipse)
+        copy-nested2-ellipse' (ths/get-shape file' :copy-nested2-ellipse)
+        fills'                (:fills copy-nested2-ellipse')
+        fill'                 (first fills')]
+
+    ;; ==== Check
+
+    ;; The touched group must be propagated to the copy, because now this copy
+    ;; has the original ellipse component as near main, but its attributes have
+    ;; been inherited from the ellipse inside big-board.
+    (t/is (= (:touched nested2-ellipse) #{:fill-group}))
+    (t/is (= (:touched copy-nested2-ellipse) nil))
+    (t/is (= (:touched nested2-ellipse') #{:fill-group}))
+    (t/is (= (:touched copy-nested2-ellipse') #{:fill-group}))
+    (t/is (= (count fills') 1))
+    (t/is (= (:fill-color fill') "#fabada"))
+    (t/is (= (:fill-opacity fill') 1))))
+
+(t/deftest test-merge-touched
+  (let [;; ==== Setup
+        file (-> (setup-file)
+                 (ths/update-shape :nested2-ellipse :fills (ths/sample-fills-color :fill-color "#fabada"))
+                 (thc/instantiate-component :c-big-board
+                                            :copy-big-board
+                                            :children-labels [:copy-h-board-with-ellipse
+                                                              :copy-nested2-h-ellipse
+                                                              :copy-nested2-ellipse])
+                 (ths/update-shape :copy-nested2-ellipse :name "Modified name")
+                 (ths/update-shape :copy-nested2-ellipse :fills (ths/sample-fills-color :fill-color "#abcdef")))
+
+        page                 (thf/current-page file)
+        nested2-ellipse      (ths/get-shape file :nested2-ellipse)
+        copy-nested2-ellipse (ths/get-shape file :copy-nested2-ellipse)
+
+        ;; ==== Action
+        changes (cll/generate-detach-instance (-> (pcb/empty-changes nil)
+                                                  (pcb/with-page page)
+                                                  (pcb/with-objects (:objects page)))
+                                              page
+                                              {(:id file) file}
+                                              (thi/id :copy-big-board))
+        file'   (thf/apply-changes file changes)
+
+        ;; ==== Get
+        nested2-ellipse'      (ths/get-shape file' :nested2-ellipse)
+        copy-nested2-ellipse' (ths/get-shape file' :copy-nested2-ellipse)
+        fills'                (:fills copy-nested2-ellipse')
+        fill'                 (first fills')]
+
+    ;; ==== Check
+
+    ;; If the copy have been already touched, merge the groups and preserve the modifications.
+    (t/is (= (:touched nested2-ellipse) #{:fill-group}))
+    (t/is (= (:touched copy-nested2-ellipse) #{:name-group :fill-group}))
+    (t/is (= (:touched nested2-ellipse') #{:fill-group}))
+    (t/is (= (:touched copy-nested2-ellipse') #{:name-group :fill-group}))
+    (t/is (= (count fills') 1))
+    (t/is (= (:fill-color fill') "#abcdef"))
+    (t/is (= (:fill-opacity fill') 1))))
+
+(t/deftest test-dont-propagete-touched-when-swapped-copy
+  (let [;; ==== Setup
+        file (-> (setup-file)
+                 (ths/update-shape :nested-rectangle :fills (ths/sample-fills-color :fill-color "#fabada"))
+                 (thc/instantiate-component :c-big-board
+                                            :copy-big-board
+                                            :children-labels [:copy-h-board-with-ellipse
+                                                              :copy-nested2-h-ellipse
+                                                              :copy-nested2-ellipse])
+                 (thc/component-swap :copy-h-board-with-ellipse
+                                     :c-board-with-rectangle
+                                     :copy-h-board-with-rectangle
+                                     :children-labels [:copy-nested2-h-rectangle
+                                                       :copy-nested2-rectangle]))
+
+        page (thf/current-page file)
+        nested2-rectangle      (ths/get-shape file :nested2-rectangle)
+        copy-nested2-rectangle (ths/get-shape file :copy-nested2-rectangle)
+
+        ;; ==== Action
+        changes (cll/generate-detach-instance (-> (pcb/empty-changes nil)
+                                                  (pcb/with-page page)
+                                                  (pcb/with-objects (:objects page)))
+                                              page
+                                              {(:id file) file}
+                                              (thi/id :copy-big-board))
+        file'   (thf/apply-changes file changes)
+
+        ;; ==== Get
+        nested2-rectangle'      (ths/get-shape file' :nested2-rectangle)
+        copy-nested2-rectangle' (ths/get-shape file' :copy-nested2-rectangle)
+        fills'                  (:fills copy-nested2-rectangle')
+        fill'                   (first fills')]
+
+    ;; ==== Check
+
+    ;; If the copy has been swapped, there is nothing to propagate since it's already
+    ;; pointing to the swapped near main.
+    (t/is (= (:touched nested2-rectangle) nil))
+    (t/is (= (:touched copy-nested2-rectangle) nil))
+    (t/is (= (:touched nested2-rectangle') nil))
+    (t/is (= (:touched copy-nested2-rectangle') nil))
+    (t/is (= (count fills') 1))
+    (t/is (= (:fill-color fill') "#fabada"))
+    (t/is (= (:fill-opacity fill') 1))))
+
+(t/deftest test-propagate-touched-when-swapped-main
+  (let [;; ==== Setup
+        file (-> (setup-file)
+                 (thc/component-swap :nested2-h-ellipse
+                                     :c-rectangle
+                                     :nested2-h-rectangle
+                                     :children-labels [:nested2-rectangle])
+                 (ths/update-shape :nested2-rectangle :fills (ths/sample-fills-color :fill-color "#fabada"))
+                 (thc/instantiate-component :c-big-board
+                                            :copy-big-board
+                                            :children-labels [:copy-h-board-with-ellipse
+                                                              :copy-nested2-h-rectangle
+                                                              :copy-nested2-rectangle]))
+
+        page (thf/current-page file)
+        nested2-rectangle      (ths/get-shape file :nested2-rectangle)
+        copy-nested2-rectangle (ths/get-shape file :copy-nested2-rectangle)
+
+        ;; ==== Action
+        changes (cll/generate-detach-instance (-> (pcb/empty-changes nil)
+                                                  (pcb/with-page page)
+                                                  (pcb/with-objects (:objects page)))
+                                              page
+                                              {(:id file) file}
+                                              (thi/id :copy-big-board))
+        file'   (thf/apply-changes file changes)
+
+        ;; ==== Get
+        nested2-rectangle'      (ths/get-shape file' :nested2-rectangle)
+        copy-nested2-rectangle' (ths/get-shape file' :copy-nested2-rectangle)
+        fills'                  (:fills copy-nested2-rectangle')
+        fill'                   (first fills')]
+
+    ;; ==== Check
+
+    ;; If the main has been swapped, there is no difference. It propagates the same as
+    ;; if it were the original component.
+    (t/is (= (:touched nested2-rectangle) #{:fill-group}))
+    (t/is (= (:touched copy-nested2-rectangle) nil))
+    (t/is (= (:touched nested2-rectangle') #{:fill-group}))
+    (t/is (= (:touched copy-nested2-rectangle') #{:fill-group}))
+    (t/is (= (count fills') 1))
+    (t/is (= (:fill-color fill') "#fabada"))
+    (t/is (= (:fill-opacity fill') 1))))