Merge branch 'main' into develop

backend/src/app/tasks/file_media_gc.clj

@@ -64,16 +64,21 @@
   (comp
    (map :objects)
    (mapcat vals)
-   (filter #(= :image (:type %)))
-   (map :metadata)
-   (map :id)))
+   (map (fn [{:keys [type] :as obj}]
+          (case type
+            :path (get-in obj [:fill-image :id])
+            :image (get-in obj [:metadata :id])
+            nil)))
+   (filter uuid?)))
 
 (defn- collect-used-media
   [data]
+  (let [pages (concat
+               (vals (:pages-index data))
+               (vals (:components data)))]
   (-> #{}
-      (into collect-media-xf (vals (:pages-index data)))
-      (into collect-media-xf (vals (:components data)))
-      (into (keys (:media data)))))
+      (into collect-media-xf pages)
+      (into (keys (:media data))))))
 
 (defn- process-file
   [{:keys [conn] :as cfg} {:keys [id data age] :as file}]

common/src/app/common/pages/changes.cljc

@@ -293,23 +293,24 @@
 
 (defmethod process-change :add-page
   [data {:keys [id name page]}]
-  (cond
-    (and (string? name) (uuid? id))
-    (let [page (assoc init/empty-page-data
-                      :id id
-                      :name name)]
-      (-> data
-          (update :pages conj id)
-          (update :pages-index assoc id page)))
-
-    (map? page)
-    (-> data
-        (update :pages conj (:id page))
-        (update :pages-index assoc (:id page) page))
-
-    :else
+  (when (and id name page)
     (ex/raise :type :conflict
-              :hint "name or page should be provided, never both")))
+              :hint "name or page should be provided, never both"))
+  (letfn [(conj-if-not-exists [pages id]
+            (cond-> pages
+              (not (d/seek #(= % id) pages))
+              (conj id)))]
+    (if (and (string? name) (uuid? id))
+      (let [page (assoc init/empty-page-data
+                        :id id
+                        :name name)]
+        (-> data
+            (update :pages conj-if-not-exists id)
+            (update :pages-index assoc id page)))
+
+      (-> data
+          (update :pages conj-if-not-exists (:id page))
+          (update :pages-index assoc (:id page) page)))))
 
 (defmethod process-change :mod-page
   [data {:keys [id name]}]

common/src/app/common/pages/helpers.cljc

@@ -99,7 +99,8 @@
 
 ;; Implemented with transient for performance
 (defn get-children
-  "Retrieve all children ids recursively for a given object"
+  "Retrieve all children ids recursively for a given object. The
+  children's order will be breadth first."
   [id objects]
 
   (loop [result (transient [])

frontend/src/app/main/data/workspace/changes.cljs

@@ -141,6 +141,11 @@
           (try
             (us/assert ::spec/changes redo-changes)
             (us/assert ::spec/changes undo-changes)
+
+            ;; (prn "====== commit-changes ======" path)
+            ;; (cljs.pprint/pprint redo-changes)
+            ;; (cljs.pprint/pprint undo-changes)
+
             (update-in state path cp/process-changes redo-changes false)
 
             (catch :default e

frontend/src/app/main/data/workspace/common.cljs

@@ -350,6 +350,8 @@
       (let [page-id (:current-page-id state)
             objects (wsh/lookup-page-objects state page-id)
 
+            ids     (cp/clean-loops objects ids)
+
             groups-to-unmask
             (reduce (fn [group-ids id]
                       ;; When the shape to delete is the mask of a masked group,
@@ -387,10 +389,12 @@
                     ids)
 
             all-children
-            (reduce (fn [res id]
-                      (into res (cp/get-children id objects)))
-                    (d/ordered-set)
-                    ids)
+            (->> ids
+                 (reduce (fn [res id]
+                           (into res (cp/get-children id objects)))
+                         [])
+                 (reverse)
+                 (into (d/ordered-set)))
 
             empty-parents
             (into (d/ordered-set) empty-parents-xform all-parents)

frontend/src/app/main/data/workspace/undo.cljs

@@ -6,7 +6,6 @@
 
 (ns app.main.data.workspace.undo
   (:require
-   [app.common.pages :as cp]
    [app.common.pages.spec :as spec]
    [app.common.spec :as us]
    [cljs.spec.alpha :as s]
@@ -31,13 +30,13 @@
       (subvec undo (- cnt MAX-UNDO-SIZE))
       undo)))
 
+;; TODO: Review the necessity of this method
 (defn materialize-undo
-  [changes index]
+  [_changes index]
   (ptk/reify ::materialize-undo
     ptk/UpdateEvent
     (update [_ state]
       (-> state
-          (update :workspace-data cp/process-changes changes)
           (assoc-in [:workspace-undo :index] index)))))
 
 (defn- add-undo-entry

frontend/src/app/util/path/shapes_to_path.cljs

@@ -139,8 +139,8 @@
           (d/without-keys dissoc-attrs)
           (assoc :type :path)
           (assoc :content new-content)
-          (cond-> (= :image type)
-            (assoc :fill-image metadata))))
+          (cond-> (= :image type) (-> (assoc :fill-image metadata)
+                                      (dissoc :metadata)))))
     ;; Do nothing if the shape is not of a correct type
     shape))
 

frontend/src/app/util/svg.cljs

@@ -488,8 +488,9 @@
            filter-values)))
 
 (defn extract-ids [val]
-  (->> (re-seq xml-id-regex val)
-       (mapv second)))
+  (when (some? val)
+    (->> (re-seq xml-id-regex val)
+         (mapv second))))
 
 (defn fix-dot-number
   "Fixes decimal numbers starting in dot but without leading 0"