github/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2026-10-03 01:06:14 +00:00
Code Issues Packages Projects Releases Wiki Activity

Merge remote-tracking branch 'origin/staging' into develop

Browse Source
This commit is contained in:
Andrey Antukh 2026-09-30 08:42:19 +02:00
commit 34f4c8ee28
14 changed files with 891 additions and 178 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
common/src/app/common/files/helpers.cljc
View File

@ -377,7 +377,9 @@
(declare indexed-shapes)
(defn get-base-shape
"Selects the shape that will be the base to add the shapes over"
"Selects the shape that will be the base to add the shapes over.
Returns nil when the selection is empty or when none of the
selected shapes is reachable in the objects tree."
[objects selected]
(let [;; Gets the tree-index for all the shapes
indexed-shapes (indexed-shapes objects selected)
@ -560,6 +562,7 @@
shapes (-> objects
(get uuid/zero)
(get :shapes)
(or [])
(rseq))]
(let [shape-id (first shapes)]

132
common/src/app/common/logging.cljc
View File

@ -104,8 +104,26 @@
100)
(recur (get-parent-logger logger'))))))))))
(def valid-levels
"The set of log levels accepted on every runtime."
#{:trace :debug :info :warn :error :fatal})
(defn valid-level?
"True when `level` is accepted on every runtime."
[level]
(contains? valid-levels level))
(defn valid-logger?
"True when `logger` is a usable logger name."
[logger]
(and (string? logger) (not (str/blank? logger))))
(defn enabled?
"Check if logger has enabled logging for given level."
"Check if logger has enabled logging for given level.
On CLJS, invalid loggers and levels warn and return false so logging
can never crash the app; on CLJ, invalid levels still throw
IllegalArgumentException."
[logger level]
#?(:clj
(let [logger (LoggerFactory/getLogger ^String logger)]
@ -118,13 +136,26 @@
:fatal (and (.isErrorEnabled ^Logger logger) logger)
(throw (IllegalArgumentException. (str "invalid level:" level)))))
:cljs
(>= (level->int level)
(get-logger-level logger))))
(cond
(not (valid-logger? logger))
(do
(js/console.warn "ignoring invalid logger:" (pr-str logger))
false)
(not (valid-level? level))
(do
(js/console.warn "ignoring invalid log level:" (pr-str level) "logger:" (pr-str logger))
false)
:else
(>= (level->int level)
(get-logger-level logger)))))
(defn- level->color
[level]
(case level
:error "#c82829"
:fatal "#c82829"
:warn "#f5871f"
:info "#4271ae"
:debug "#969896"
@ -140,6 +171,7 @@
:info "INF"
:warn "WRN"
:error "ERR"
:fatal "ERR"
(let [hint (str "invalid level provided to `level->name` function: " (pr-str level))]
(throw (ex-info hint {:level level})))))
@ -151,9 +183,26 @@
:info 30
:warn 40
:error 50
:fatal 50
(let [hint (str "invalid level provided to `level->int` function: " (pr-str level))]
(throw (ex-info hint {:level level})))))
#?(:cljs
(defn level->color-safe
"Like `level->color` but falls back to a neutral gray instead of throwing."
[level]
(if (valid-level? level)
(level->color level)
"#969896")))
#?(:cljs
(defn level->name-safe
"Like `level->name` but falls back to \"UNK\" instead of throwing."
[level]
(if (valid-level? level)
(level->name level)
"UNK")))
(defn build-message
[props]
(loop [props (seq props)
@ -284,43 +333,55 @@
(defn console-log-handler
{:no-doc true}
[_ _ _ {:keys [::logger ::props ::level ::cause ::trace ::message]}]
(when (enabled? logger level)
(let [hstyles (str/ffmt "font-weight: 600; color: %" (level->color level))
mstyles (str/ffmt "font-weight: 300; color: %" (level->color level))
ts (ct/format-inst (ct/now) "kk:mm:ss.SSSS")
header (str/concat "%c" (level->name level) " " ts " [" logger "] ")
message (str/concat header "%c" @message)]
;; Invalid levels render with a fallback style instead of being
;; dropped, so a corrupt record stays visible; the warn below keeps
;; it noticeable. The normal `log!` path never reaches here because
;; `enabled?` already drops such records before `emit-log`.
(if-not (valid-logger? logger)
(js/console.warn "ignoring log record with invalid logger:" (pr-str logger))
(when (or (not (valid-level? level))
(enabled? logger level))
(when-not (valid-level? level)
(js/console.warn "invalid level on log record, using fallback rendering:" (pr-str level) "logger:" (pr-str logger)))
(let [hstyles (str/ffmt "font-weight: 600; color: %" (level->color-safe level))
mstyles (str/ffmt "font-weight: 300; color: %" (level->color-safe level))
ts (ct/format-inst (ct/now) "kk:mm:ss.SSSS")
header (str/concat "%c" (level->name-safe level) " " ts " [" logger "] ")
message (str/concat header "%c" @message)]
(js/console.group message hstyles mstyles)
(doseq [[type n v] (get-special-props props)]
(case type
:js (js/console.log n v)
:error (if (ex/error? v)
(js/console.error n (pr-str v))
(js/console.error n v))))
(js/console.group message hstyles mstyles)
(doseq [[type n v] (get-special-props props)]
(case type
:js (js/console.log n v)
:error (if (ex/error? v)
(js/console.error n (pr-str v))
(js/console.error n v))))
(when (ex/exception? cause)
(let [data (ex-data cause)
explain (or (:explain data)
(ex/explain data))]
(when explain
(js/console.log "Explain:")
(js/console.log explain))
(when (ex/exception? cause)
(let [data (ex-data cause)
explain (or (:explain data)
(ex/explain data))]
(when explain
(js/console.log "Explain:")
(js/console.log explain))
(when (and data (not explain))
(js/console.log "Data:")
(js/console.log (pp/pprint-str data)))
(when (and data (not explain))
(js/console.log "Data:")
(js/console.log (pp/pprint-str data)))
(js/console.log @trace #_(.-stack cause))))
(js/console.log @trace #_(.-stack cause))))
(js/console.groupEnd message)))))
(js/console.groupEnd message))))))
#?(:clj (add-watch log-record ::default slf4j-log-handler)
:cljs (add-watch log-record ::default console-log-handler))
(defmacro set-level!
"A CLJS-only macro for set logging level to current (that matches the
current namespace) or user specified logger."
current namespace) or user specified logger.
Callers passing a dynamic level must check `valid-level?` first;
`level->int` throws on anything outside `valid-levels`."
([level]
(when (:ns &env)
`(.set ^js/Map loggers ~(str *ns*) (level->int ~level))))
@ -332,9 +393,16 @@
(defn setup!
[{:as config}]
(run! (fn [[logger level]]
(let [logger (if (keyword? logger) (name logger) logger)
level (level->int level)]
(.set ^js/Map loggers logger level)))
(let [logger (if (keyword? logger) (name logger) logger)]
(cond
(not (valid-logger? logger))
(js/console.warn "ignoring invalid logger in setup!:" (pr-str logger))
(not (valid-level? level))
(js/console.warn "ignoring invalid log level in setup!:" (pr-str level) "logger:" (pr-str logger))
:else
(.set ^js/Map loggers logger (level->int level)))))
config)))
(defmacro raw!

42
common/test/common_tests/files/helpers_test.cljc
View File

@ -38,6 +38,48 @@
:immediate-suffix? true)
"base-name 3")))
(t/deftest test-get-base-shape-with-missing-data
(let [root-id uuid/zero
shape-a {:id (uuid/custom 1 1) :parent-id root-id :frame-id root-id}
shape-b {:id (uuid/custom 1 2) :parent-id root-id :frame-id root-id}
selected #{(:id shape-a) (:id shape-b)}]
(t/testing "Returns nil instead of throwing with nil objects"
(t/is (nil? (cfh/get-base-shape nil selected))))
(t/testing "Returns nil instead of throwing with empty objects"
(t/is (nil? (cfh/get-base-shape {} selected))))
(t/testing "Returns nil instead of throwing when the root has no shapes"
(t/is (nil? (cfh/get-base-shape {root-id {:id root-id}} selected))))
(t/testing "Returns nil when the selection is not present in the objects"
(let [objects {root-id {:id root-id :shapes [(:id shape-a)]}
(:id shape-a) shape-a}]
(t/is (nil? (cfh/get-base-shape objects #{(:id shape-b)})))))
(t/testing "Selecting the root itself never yields a base shape (callers handle it)"
(let [objects {root-id {:id root-id :shapes [(:id shape-a)]}
(:id shape-a) shape-a}]
(t/is (nil? (cfh/get-base-shape objects #{root-id})))))))
(t/deftest test-order-by-indexed-shapes
(let [root-id uuid/zero
shape-a {:id (uuid/custom 1 1) :parent-id root-id :frame-id root-id}
shape-b {:id (uuid/custom 1 2) :parent-id root-id :frame-id root-id}
shape-c {:id (uuid/custom 1 3) :parent-id root-id :frame-id root-id}
objects {root-id {:id root-id :shapes [(:id shape-a) (:id shape-b) (:id shape-c)]}
(:id shape-a) shape-a
(:id shape-b) shape-b
(:id shape-c) shape-c}]
(t/testing "Orders selection top-most first on healthy inputs"
(t/is (= [(:id shape-c) (:id shape-a)]
(cfh/order-by-indexed-shapes objects #{(:id shape-a) (:id shape-c)})))
(t/is (= shape-c
(cfh/get-base-shape objects #{(:id shape-a) (:id shape-c)}))))
(t/testing "Returns empty instead of throwing with nil objects"
(t/is (= [] (cfh/order-by-indexed-shapes nil #{(:id shape-a)})))
(t/is (nil? (cfh/get-base-shape nil #{(:id shape-a)}))))))
(t/deftest test-get-position-on-parent-with-missing-data
(t/testing "Returns nil instead of throwing with missing data"
(t/is (nil? (cfh/get-position-on-parent nil nil)))
(t/is (nil? (cfh/get-position-on-parent {} (uuid/custom 1 9))))))
(t/deftest test-get-prev-sibling
(let [parent-id (uuid/custom 1 1)
child-a (uuid/custom 1 2)

101
common/test/common_tests/logging_test.cljc Normal file
View File

@ -0,0 +1,101 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC Sucursal en España SL
(ns common-tests.logging-test
(:require
[app.common.logging :as l]
[clojure.test :as t]))
(defn- throws?
[thunk]
#?(:clj (try (thunk) false (catch clojure.lang.ExceptionInfo _ true))
:cljs (try (thunk) false (catch :default _ true))))
(t/deftest level->int-test
(t/is (= 10 (l/level->int :trace)))
(t/is (= 20 (l/level->int :debug)))
(t/is (= 30 (l/level->int :info)))
(t/is (= 40 (l/level->int :warn)))
(t/is (= 50 (l/level->int :error)))
(t/is (= 50 (l/level->int :fatal)))
(t/is (throws? #(l/level->int nil)))
(t/is (throws? #(l/level->int :bogus))))
#?(:cljs
(t/use-fixtures
:each
(fn [f]
(f)
(doseq [k ["logging-test-probe-xyz"
"logging-test-fatal-xyz"
"logging-test-setup-xyz"
"logging-test-bad-xyz"
"logging-test-key-xyz"]]
(.delete l/loggers k)))))
#?(:cljs
(t/deftest browser-boundaries-test
(t/testing "unknown levels never throw and disable logging"
(t/is (false? (l/enabled? "logging-test-probe-xyz" nil)))
(t/is (false? (l/enabled? "logging-test-probe-xyz" :bogus))))
(t/testing "invalid loggers never throw and disable logging"
(t/is (false? (l/enabled? nil :error)))
(t/is (false? (l/enabled? "" :error)))
(t/is (false? (l/enabled? 123 :error))))
(t/testing "unknown logger defaults to disabled"
(t/is (false? (l/enabled? "logging-test-probe-xyz" :fatal)))
(t/is (false? (l/enabled? "logging-test-probe-xyz" :error))))
(t/testing "fatal filters exactly like error when enabled"
(l/setup! {"logging-test-fatal-xyz" :debug})
(t/is (true? (l/enabled? "logging-test-fatal-xyz" :fatal)))
(t/is (= (l/enabled? "logging-test-fatal-xyz" :fatal)
(l/enabled? "logging-test-fatal-xyz" :error)))
(l/setup! {"logging-test-fatal-xyz" :error})
(t/is (true? (l/enabled? "logging-test-fatal-xyz" :fatal)))
(t/is (false? (l/enabled? "logging-test-fatal-xyz" :debug)))
(t/is (false? (l/enabled? "logging-test-fatal-xyz" :trace))))
(t/testing "setup! skips invalid entries and installs valid ones"
(t/is (do (l/setup! {"logging-test-setup-xyz" :error
"logging-test-bad-xyz" nil})
true))
(t/is (true? (l/enabled? "logging-test-setup-xyz" :error)))
(t/is (false? (l/enabled? "logging-test-setup-xyz" :bogus)))
(t/is (false? (l/enabled? "logging-test-bad-xyz" :error))))
(t/testing "setup! skips invalid logger keys and installs valid ones"
(t/is (do (l/setup! {"logging-test-key-xyz" :error
"" :error
nil :error})
true))
(t/is (true? (l/enabled? "logging-test-key-xyz" :error))))
(t/testing "safe fallbacks never throw"
(t/is (= "#969896" (l/level->color-safe nil)))
(t/is (= "UNK" (l/level->name-safe nil)))
(t/is (= "#c82829" (l/level->color-safe :fatal)))
(t/is (= "ERR" (l/level->name-safe :fatal))))
(t/testing "console handler survives a nil-level record"
(t/is (nil? (l/console-log-handler
nil nil nil
{::l/logger "logging-test-probe-xyz"
::l/level nil
::l/message (delay "hi")
::l/props {}}))))
(t/testing "console handler skips invalid-logger records"
(t/is (nil? (l/console-log-handler
nil nil nil
{::l/logger nil
::l/level nil
::l/message (delay "hi")
::l/props {}}))))))
#?(:clj
(t/deftest backend-strict-test
(t/testing "fatal does not throw"
(t/is (do (l/enabled? "app" :fatal) true)))
(t/testing "JVM branch still rejects invalid levels loudly"
(t/is (try (l/enabled? "app" nil) false
(catch IllegalArgumentException _ true)))
(t/is (try (l/enabled? "app" :bogus) false
(catch IllegalArgumentException _ true))))))

4
common/test/common_tests/runner.cljc
View File

@ -21,6 +21,7 @@
[common-tests.files-migrations-0025-test]
[common-tests.files-migrations-0026-test]
[common-tests.files-migrations-test]
[common-tests.files.helpers-test]
[common-tests.files.shapes-builder-test]
[common-tests.files.validate-test]
[common-tests.geom-align-test]
@ -47,6 +48,7 @@
[common-tests.geom-shapes-tree-seq-test]
[common-tests.geom-snap-test]
[common-tests.geom-test]
[common-tests.logging-test]
[common-tests.logic.chained-propagation-test]
[common-tests.logic.comp-creation-test]
[common-tests.logic.comp-detach-with-nested-test]
@ -100,6 +102,7 @@
'common-tests.data-test
'common-tests.files-changes-test
'common-tests.files-builder-test
'common-tests.files.helpers-test
'common-tests.files-migrations-0025-test
'common-tests.files-migrations-0026-test
'common-tests.files-migrations-test
@ -128,6 +131,7 @@
'common-tests.geom-shapes-tree-seq-test
'common-tests.geom-snap-test
'common-tests.geom-test
'common-tests.logging-test
'common-tests.logic.chained-propagation-test
'common-tests.logic.comp-creation-test
'common-tests.logic.comp-detach-with-nested-test

1
frontend/config.js
View File

@ -1 +0,0 @@
var penpotFlags = "enable-login-with-google enable-login-with-oidc enable-access-tokens enable-mcp enable-render-wasm";

1
frontend/config2.js
View File

@ -1 +0,0 @@
var penpotPublicURI = "http://localhost:3450/penpot/";

295
frontend/src/app/main/data/workspace/clipboard.cljs
View File

@ -311,17 +311,28 @@
:timeout 5000}))
(rx/throw cause)))
(defn- page-ready?
"Check the page objects are loaded enough for paste operations: the
root shape exists and carries its children list. Pastes arriving
before that (e.g. right after opening the workspace) are ignored."
[objects]
(and (map? objects)
(some? (get objects uuid/zero))
(some? (:shapes (get objects uuid/zero)))))
(defn paste-from-clipboard
"Perform a `paste` operation using the Clipboard API."
([] (paste-from-clipboard nil))
([{:keys [replace?]}]
(ptk/reify ::paste-from-clipboard
ptk/WatchEvent
(watch [_ _ _]
(->> (clipboard/from-navigator default-options)
(rx/mapcat (create-paste-from-blob false (boolean replace?)))
(rx/take 1)
(rx/catch on-clipboard-permission-error))))))
(watch [_ state _]
(if (page-ready? (dsh/lookup-page-objects state))
(->> (clipboard/from-navigator default-options)
(rx/mapcat (create-paste-from-blob false (boolean replace?)))
(rx/take 1)
(rx/catch on-clipboard-permission-error))
(rx/empty))))))
(defn paste-from-event
"Perform a `paste` operation from user emmited event."
@ -334,8 +345,9 @@
is-editing? (and edit-id (= :text (get-in objects [edit-id :type])))]
;; Some paste events can be fired while we're editing a text
;; we forbid that scenario so the default behaviour is executed
(if is-editing?
;; we forbid that scenario so the default behaviour is executed.
;; Pastes arriving before the page is loaded are ignored as well.
(if (or is-editing? (not (page-ready? objects)))
(rx/empty)
(->> (clipboard/from-synthetic-clipboard-event event default-options)
(rx/mapcat (create-paste-from-blob in-viewport? false))))))))
@ -516,11 +528,13 @@
(js/console.error "Clipboard error:" cause)
(rx/empty)))))]
(->> (clipboard/from-navigator default-options)
(rx/mapcat #(.text %))
(rx/map decode-entry)
(rx/take 1)
(rx/catch on-error)))))))
(if (page-ready? (dsh/lookup-page-objects state))
(->> (clipboard/from-navigator default-options)
(rx/mapcat #(.text %))
(rx/map decode-entry)
(rx/take 1)
(rx/catch on-error))
(rx/empty)))))))
(defn- selected-frame? [state]
(let [selected (dsh/lookup-selected state)
@ -609,17 +623,19 @@
(cfeat/check-paste-features! features (:features pdata))
(case (:type pdata)
:copied-shapes
(if (= file-id (:file-id pdata))
(let [pdata (assoc pdata :images [])]
(rx/of (paste-shapes pdata)))
(->> (rx/from images)
(rx/merge-map (partial upload-media file-id))
(rx/reduce conj [])
(rx/map #(assoc pdata :images %))
(rx/map paste-shapes)))
nil))))))
(if (page-ready? (dsh/lookup-page-objects state))
(case (:type pdata)
:copied-shapes
(if (= file-id (:file-id pdata))
(let [pdata (assoc pdata :images [])]
(rx/of (paste-shapes pdata)))
(->> (rx/from images)
(rx/merge-map (partial upload-media file-id))
(rx/reduce conj [])
(rx/map #(assoc pdata :images %))
(rx/map paste-shapes)))
nil)
(rx/empty)))))))
(defn- paste-transit-props
[pdata]
@ -768,6 +784,17 @@
target-index (cfh/get-position-on-parent page-objects replace-id)]
[parent-id delta target-index])
;; No selection, or selection without a base shape that is
;; not exactly the single root: paste at the pointer
;; position. Selecting the root itself (uuid/zero) is a
;; valid workflow handled by the frame branches below.
(or (empty? page-selected)
(and (nil? base)
(not (= #{uuid/zero} page-selected))))
(let [frame-id (ctst/top-nested-frame page-objects position)
delta (gpt/subtract position orig-pos)]
[frame-id delta])
;; Paste next to selected frame, if selected is itself or of the same size as the copied
(and (selected-frame? state)
(or (any-same-frame-from-selected? state (keys pobjects))
@ -821,11 +848,6 @@
(count (:shapes selected-frame-obj)))]
[frame-id delta target-index])
(empty? page-selected)
(let [frame-id (ctst/top-nested-frame page-objects position)
delta (gpt/subtract position orig-pos)]
[frame-id delta])
:else
(let [parent-id (:parent-id base)
delta (if in-viewport?
@ -870,140 +892,141 @@
ptk/WatchEvent
(watch [it state _]
(let [file-id (:current-file-id state)
page (dsh/lookup-page state)
page-id (:current-page-id state)
page (dsh/lookup-page state file-id page-id)
page-objects (:objects page)]
(if (page-ready? page-objects)
(let [media-idx (->> (:images pdata)
(d/index-by :prev-id))
media-idx (->> (:images pdata)
(d/index-by :prev-id))
selected (:selected pdata)
selected (:selected pdata)
objects (:objects pdata)
objects (:objects pdata)
variant-props (:variant-properties pdata)
variant-props (:variant-properties pdata)
position (deref ms/mouse-position)
position (deref ms/mouse-position)
;; Replace mode is only valid with a single selected shape.
;; In that case we drop the pasted content at its position and
;; delete it in the same transaction.
page-selected (dsh/lookup-selected state)
replace-id (when (and (:replace pdata) (= 1 (count page-selected)))
(first page-selected))
;; Replace mode is only valid with a single selected shape.
;; In that case we drop the pasted content at its position and
;; delete it in the same transaction.
page-selected (dsh/lookup-selected state)
replace-id (when (and (:replace pdata) (= 1 (count page-selected)))
(first page-selected))
;; Calculate position for the pasted elements
[candidate-parent-id
delta
index] (calculate-paste-position state objects selected position replace-id)
;; Calculate position for the pasted elements
[candidate-parent-id
delta
index] (calculate-paste-position state objects selected position replace-id)
libraries (dsh/lookup-libraries state)
ldata (dsh/lookup-file-data state file-id)
page-objects (:objects page)
[parent-id
frame-id] (ctn/find-valid-parent-and-frame-ids candidate-parent-id page-objects (vals objects) true libraries)
libraries (dsh/lookup-libraries state)
ldata (dsh/lookup-file-data state file-id)
index (if (= candidate-parent-id parent-id)
index
0)
[parent-id
frame-id] (ctn/find-valid-parent-and-frame-ids candidate-parent-id page-objects (vals objects) true libraries)
index (if index
index
(dec (count (dm/get-in page-objects [parent-id :shapes]))))
index (if (= candidate-parent-id parent-id)
index
0)
selected (if (and (ctl/flex-layout? page-objects parent-id) (not (ctl/reverse? page-objects parent-id)))
(into (d/ordered-set) (reverse selected))
selected)
index (if index
index
(dec (count (dm/get-in page-objects [parent-id :shapes]))))
valid-file-ids (conj (set (keys libraries)) file-id)
selected (if (and (ctl/flex-layout? page-objects parent-id) (not (ctl/reverse? page-objects parent-id)))
(into (d/ordered-set) (reverse selected))
selected)
objects (update-vals objects (partial process-shape valid-file-ids frame-id parent-id))
valid-file-ids (conj (set (keys libraries)) file-id)
all-objects (merge page-objects objects)
objects (update-vals objects (partial process-shape valid-file-ids frame-id parent-id))
drop-cell (when (ctl/grid-layout? all-objects parent-id)
(gslg/get-drop-cell frame-id all-objects position))
all-objects (merge page-objects objects)
changes (-> (pcb/empty-changes it)
(cll/generate-duplicate-changes all-objects page selected delta
libraries ldata file-id {:variant-props variant-props})
(pcb/amend-changes (partial process-rchange media-idx))
(pcb/amend-changes (partial change-add-obj-index objects selected index)))
drop-cell (when (ctl/grid-layout? all-objects parent-id)
(gslg/get-drop-cell frame-id all-objects position))
;; Adds a resize-parents operation so the groups are
;; updated. We add all the new objects
changes (->> (:redo-changes changes)
(filter add-obj?)
(map :id)
(pcb/resize-parents changes))
changes (-> (pcb/empty-changes it)
(cll/generate-duplicate-changes all-objects page selected delta
libraries ldata file-id {:variant-props variant-props})
(pcb/amend-changes (partial process-rchange media-idx))
(pcb/amend-changes (partial change-add-obj-index objects selected index)))
changes (if (some? replace-id)
(second (cls/generate-delete-shapes changes #{replace-id} {}))
changes)
;; Adds a resize-parents operation so the groups are
;; updated. We add all the new objects
changes (->> (:redo-changes changes)
(filter add-obj?)
(map :id)
(pcb/resize-parents changes))
orig-shapes (map (d/getf all-objects) selected)
changes (if (some? replace-id)
(second (cls/generate-delete-shapes changes #{replace-id} {}))
changes)
children-after (-> (pcb/get-objects changes)
(dm/get-in [parent-id :shapes])
set)
orig-shapes (map (d/getf all-objects) selected)
;; At the end of the process, we want to select the new created shapes
;; that are a direct child of the shape parent-id
selected (into (d/ordered-set)
(comp
(filter add-obj?)
(map (comp :id :obj))
(filter #(contains? children-after %)))
(:redo-changes changes))
children-after (-> (pcb/get-objects changes)
(dm/get-in [parent-id :shapes])
set)
changes (cond-> changes
(some? drop-cell)
(pcb/update-shapes [parent-id]
#(ctl/add-children-to-cell % selected all-objects drop-cell)))
;; At the end of the process, we want to select the new created shapes
;; that are a direct child of the shape parent-id
selected (into (d/ordered-set)
(comp
(filter add-obj?)
(map (comp :id :obj))
(filter #(contains? children-after %)))
(:redo-changes changes))
add-component-to-variant? (and
;; Any of the shapes is a head
(some ctk/instance-head? orig-shapes)
;; Any ancestor of the destination parent is a variant
(->> (cfh/get-parents-with-self page-objects parent-id)
(some ctk/is-variant?)))
undo-id (js/Symbol)]
changes (cond-> changes
(some? drop-cell)
(pcb/update-shapes [parent-id]
#(ctl/add-children-to-cell % selected all-objects drop-cell)))
(rx/concat
(->> (rx/from orig-shapes)
(rx/map (fn [shape]
(let [parent-type (cfh/get-shape-type all-objects (:parent-id shape))
external-lib? (not= file-id (:component-file shape))
component (ctn/get-component-from-shape shape libraries)
origin "workspace:paste"]
add-component-to-variant? (and
;; Any of the shapes is a head
(some ctk/instance-head? orig-shapes)
;; Any ancestor of the destination parent is a variant
(->> (cfh/get-parents-with-self page-objects parent-id)
(some ctk/is-variant?)))
undo-id (js/Symbol)]
;; NOTE: we don't emit the create-shape event all the time for
;; avoid send a lot of events (that are not necessary); this
;; decision is made explicitly by the responsible team.
(if (ctk/instance-head? shape)
(ev/event {::ev/name "use-library-component"
::ev/origin origin
:is-external-library external-lib?
:type (get shape :type)
:parent-type parent-type
:is-variant (ctk/is-variant? component)})
(if (cfh/has-layout? objects (:parent-id shape))
(ev/event {::ev/name "layout-add-element"
::ev/origin origin
:type (get shape :type)
:parent-type parent-type})
(ev/event {::ev/name "create-shape"
::ev/origin origin
:type (get shape :type)
:parent-type parent-type})))))))
(rx/concat
(->> (rx/from orig-shapes)
(rx/map (fn [shape]
(let [parent-type (cfh/get-shape-type all-objects (:parent-id shape))
external-lib? (not= file-id (:component-file shape))
component (ctn/get-component-from-shape shape libraries)
origin "workspace:paste"]
;; NOTE: we don't emit the create-shape event all the time for
;; avoid send a lot of events (that are not necessary); this
;; decision is made explicitly by the responsible team.
(if (ctk/instance-head? shape)
(ev/event {::ev/name "use-library-component"
::ev/origin origin
:is-external-library external-lib?
:type (get shape :type)
:parent-type parent-type
:is-variant (ctk/is-variant? component)})
(if (cfh/has-layout? objects (:parent-id shape))
(ev/event {::ev/name "layout-add-element"
::ev/origin origin
:type (get shape :type)
:parent-type parent-type})
(ev/event {::ev/name "create-shape"
::ev/origin origin
:type (get shape :type)
:parent-type parent-type})))))))
(rx/of (dwu/start-undo-transaction undo-id)
(dch/commit-changes changes)
(dws/select-shapes selected)
(ptk/data-event :layout/update {:ids [frame-id]})
(dwu/commit-undo-transaction undo-id)
(when add-component-to-variant?
(ev/event {::ev/name "add-component-to-variant"})))))))))
(rx/of (dwu/start-undo-transaction undo-id)
(dch/commit-changes changes)
(dws/select-shapes selected)
(ptk/data-event :layout/update {:ids [frame-id]})
(dwu/commit-undo-transaction undo-id)
(when add-component-to-variant?
(ev/event {::ev/name "add-component-to-variant"})))))
(rx/empty)))))))
(defn- as-content [text]
(let [paragraphs (->> (str/lines text)

3
frontend/src/app/main/data/workspace/shapes.cljs
View File

@ -397,7 +397,8 @@
selected (dsh/lookup-selected state)
base (cfh/get-base-shape objects selected)
parent-id (if (or (and (= 1 (count selected))
parent-id (if (or (nil? base)
(and (= 1 (count selected))
(cfh/frame-shape? (get objects (first selected))))
(empty? selected))
frame-id

2
frontend/src/app/main/data/workspace/svg_upload.cljs
View File

@ -93,7 +93,7 @@
(ctst/top-nested-frame objects position)
base-id)
parent-id (if (or selected-frame? (empty? selected))
parent-id (if (or selected-frame? (empty? selected) (nil? base))
frame-id
base-id)

18
frontend/src/debug.cljs
View File

@ -50,11 +50,25 @@
(l/set-level! :debug)
(defn- coerce-keyword
"Coerce `v` to a keyword when it is a string or keyword, nil otherwise."
[v]
(when (or (keyword? v) (string? v))
(keyword v)))
(defn ^:export set-logging
([level]
(l/set-level! :app (keyword level)))
(let [level (coerce-keyword level)]
(if (l/valid-level? level)
(l/set-level! "app" level)
(js/console.warn "ignoring invalid log level:" (pr-str level)))))
([ns level]
(l/set-level! (keyword ns) (keyword level))))
(let [ns (coerce-keyword ns)
level (coerce-keyword level)]
(if (and (l/valid-logger? (some-> ns name))
(l/valid-level? level))
(l/set-level! (name ns) level)
(js/console.warn "ignoring invalid logging config:" (pr-str ns) (pr-str level))))))
;; These events are excluded when we activate the :events flag
(def debug-exclude-events

28
frontend/test/frontend_tests/debug_logging_test.cljs Normal file
View File

@ -0,0 +1,28 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC Sucursal en España SL
(ns frontend-tests.debug-logging-test
(:require
[app.common.logging :as l]
[cljs.test :as t :include-macros true]
[debug :as dbg]))
(t/deftest set-logging-test
(t/testing "invalid inputs warn and do not throw"
(t/is (nil? (dbg/set-logging nil)))
(t/is (nil? (dbg/set-logging "bogus")))
(t/is (nil? (dbg/set-logging 123)))
(t/is (nil? (dbg/set-logging nil nil)))
(t/is (nil? (dbg/set-logging "app" "bogus")))
(t/is (nil? (dbg/set-logging "app" nil)))
(t/is (nil? (dbg/set-logging "" "debug"))))
(t/testing "valid inputs install a string logger key"
(dbg/set-logging "app" "debug")
(t/is (true? (l/enabled? "app" :debug)))
(dbg/set-logging "app" "error")
(t/is (true? (l/enabled? "app" :error)))
(t/is (false? (l/enabled? "app" :debug)))
(.delete l/loggers "app")))

435
frontend/test/frontend_tests/logic/pasting_in_containers_test.cljs
View File

@ -5,23 +5,53 @@
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns frontend-tests.logic.pasting-in-containers-test
(:require
[app.common.geom.point :as gpt]
[app.common.test-helpers.components :as cthc]
[app.common.test-helpers.compositions :as ctho]
[app.common.test-helpers.files :as cthf]
[app.common.test-helpers.ids-map :as cthi]
[app.common.test-helpers.shapes :as cths]
[app.common.test-helpers.variants :as thv]
[app.common.transit :as transit]
[app.common.types.component :as ctk]
[app.common.uuid :as uuid]
[app.main.data.workspace :as dw]
[app.main.data.workspace.selection :as dws]
[app.main.data.workspace.shapes :as dwsh]
[app.main.data.workspace.svg-upload :as dwsvg]
[app.main.streams :as ms]
[beicon.v2.core :as rx]
[cljs.test :as t :include-macros true]
[cuerdas.core :as str]
[frontend-tests.helpers.pages :as thp]
[frontend-tests.helpers.state :as ths]))
[frontend-tests.helpers.state :as ths]
[potok.v2.core :as ptk]))
(defonce ^:private original-navigator-clipboard
(unchecked-get js/navigator "clipboard"))
(defn- restore-navigator-clipboard!
[]
(unchecked-set js/navigator "clipboard" original-navigator-clipboard))
(defn- install-read-clipboard!
"Install a `navigator.clipboard` stub serving `text` as a single
text/plain item, so `from-navigator` resolves it through the usual
transit decoding."
[text]
(unchecked-set
js/navigator "clipboard"
#js {:read (fn []
(js/Promise.resolve
#js [#js {:types #js ["text/plain"]
:getType (fn [_mime]
(js/Promise.resolve
#js {:size (count text)
:text (fn [] (js/Promise.resolve text))}))}]))}))
(t/use-fixtures :each
{:before thp/reset-idmap!})
{:before thp/reset-idmap!
:after restore-navigator-clipboard!})
;; Related .penpot file: common/test/cases/remove-swap-slots.penpot
(defn- setup-file
@ -666,4 +696,403 @@
;;There was 3 components, now there are still 3
(t/is (= 3 (count components)))
(t/is (= 3 (count components')))))))))
(t/is (= 3 (count components')))))))))
(t/deftest paste-with-unloaded-page-is-noop
"Pasting while the page is not loaded (e.g. right after opening the workspace) is ignored instead of crashing"
(t/async
done
(let [;; ==== Setup
file (-> (cthf/sample-file :file1)
(ctho/add-frame :frame-blue {:name "frame-blue"}))
store (ths/setup-store file)
;; ==== Action
page (cthf/current-page file)
page-id (cthf/current-page-id file)
file-id (:id file)
frame-blue (cths/get-shape file :frame-blue)
features #{}
version 67
pdata (thp/simulate-copy-shape #{(:id frame-blue)} (:objects page) {(:id file) file} page file features version)
drop-page (ptk/reify ::drop-current-page
ptk/UpdateEvent
(update [_ state]
(update-in state [:files file-id :data :pages-index] dissoc page-id)))
events
[drop-page
(dw/paste-shapes pdata)]]
(ths/run-store
store done events
(fn [new-state]
(let [;; ==== Get
file' (ths/get-file-from-state new-state)
page' (cthf/current-page file')]
;; ==== Check
;; The page is still not loaded and nothing was pasted anywhere
(t/is (some? file'))
(t/is (nil? page'))))))))
(t/deftest paste-with-detached-selection-pastes-by-position
"Pasting with a selection of shapes detached from the shape tree falls back to pasting at the pointer position"
(t/async
done
(let [;; ==== Setup
file (-> (cthf/sample-file :file1)
(ctho/add-frame :frame-red {:name "frame-red"})
(ctho/add-frame :frame-blue {:name "frame-blue"}))
store (ths/setup-store file)
;; ==== Action
page (cthf/current-page file)
page-id (cthf/current-page-id file)
file-id (:id file)
frame-red (cths/get-shape file :frame-red)
frame-blue (cths/get-shape file :frame-blue)
features #{}
version 67
pdata (thp/simulate-copy-shape #{(:id frame-blue)} (:objects page) {(:id file) file} page file features version)
;; Detach the selected shape from the tree (it stays in the
;; objects map but is no longer reachable from the root)
detach-and-select (ptk/reify ::detach-and-select
ptk/UpdateEvent
(update [_ state]
(-> state
(update-in [:files file-id :data :pages-index page-id :objects uuid/zero :shapes]
(fn [shapes] (vec (remove #(= % (:id frame-red)) shapes))))
(assoc-in [:workspace-local :selected] #{(:id frame-red)}))))
_ (rx/push! ms/mouse-position (gpt/point 1000 1000))
events
[detach-and-select
(dw/paste-shapes pdata)]]
(ths/run-store
store done events
(fn [new-state]
(rx/push! ms/mouse-position nil)
(let [;; ==== Get
file' (ths/get-file-from-state new-state)
page' (cthf/current-page file')
frame-blue' (cths/get-shape file' :frame-blue)
copied' (find-copied-shape frame-blue' page' uuid/zero)]
;; ==== Check
;; The copy lands at the pointer position on the root
(t/is (some? copied'))
(t/is (= 1000 (:x copied')))
(t/is (= 1000 (:y copied')))))))))
(t/deftest paste-with-root-plus-orphan-selection-pastes-by-position
"Pasting with the root plus a shape orphaned from the objects map falls back to pasting at the pointer position"
(t/async
done
(let [;; ==== Setup
file (-> (cthf/sample-file :file1)
(ctho/add-frame :frame-blue {:name "frame-blue" :x 0 :y 0 :width 500 :height 500})
(ctho/add-rect :rect1))
store (ths/setup-store file)
;; ==== Action
page (cthf/current-page file)
page-id (cthf/current-page-id file)
file-id (:id file)
rect1 (cths/get-shape file :rect1)
frame-blue (cths/get-shape file :frame-blue)
features #{}
version 67
pdata (thp/simulate-copy-shape #{(:id frame-blue)} (:objects page) {(:id file) file} page file features version)
;; Orphan the shape (parent missing from the objects map and
;; absent from the tree) and select it together with the root.
;; clean-loops cannot prune either id, so there is no base
;; shape and the frame branches cannot handle the selection.
detach-and-select (ptk/reify ::detach-and-select-root
ptk/UpdateEvent
(update [_ state]
(-> state
(update-in [:files file-id :data :pages-index page-id :objects]
(fn [objects]
(-> objects
(update-in [uuid/zero :shapes]
(fn [shapes]
(vec (remove #(= % (:id rect1)) shapes))))
(update (:id rect1) assoc :parent-id (uuid/custom 9 9)))))
(assoc-in [:workspace-local :selected] #{uuid/zero (:id rect1)}))))
_ (rx/push! ms/mouse-position (gpt/point 1000 1000))
events
[detach-and-select
(dw/paste-shapes pdata)]]
(ths/run-store
store done events
(fn [new-state]
(rx/push! ms/mouse-position nil)
(let [;; ==== Get
file' (ths/get-file-from-state new-state)
page' (cthf/current-page file')
frame-blue' (cths/get-shape file' :frame-blue)
copied' (find-copied-shape frame-blue' page' uuid/zero)]
;; ==== Check
;; The copy lands at the pointer position on the root
(t/is (some? copied'))
(t/is (= 1000 (:x copied')))
(t/is (= 1000 (:y copied')))))))))
(t/deftest paste-with-root-only-selection-stays-on-frame-path
"Pasting with only the root selected keeps using the frame branches, not the pointer fallback"
(t/async
done
(let [;; ==== Setup
file (-> (cthf/sample-file :file1)
(ctho/add-frame :frame-blue {:name "frame-blue" :x 0 :y 0 :width 500 :height 500}))
store (ths/setup-store file)
;; ==== Action
page (cthf/current-page file)
frame-blue (cths/get-shape file :frame-blue)
features #{}
version 67
pdata (thp/simulate-copy-shape #{(:id frame-blue)} (:objects page) {(:id file) file} page file features version)
select-root (ptk/reify ::select-root
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:workspace-local :selected] #{uuid/zero})))
;; Push the pointer far away so a pointer fallback would be
;; observable: the frame path must not land the copy here.
;; (A naive plain `(nil? base)` fallback condition would.)
_ (rx/push! ms/mouse-position (gpt/point 1000 1000))
events
[select-root
(dw/paste-shapes pdata)]]
(ths/run-store
store done events
(fn [new-state]
(rx/push! ms/mouse-position nil)
(let [;; ==== Get
file' (ths/get-file-from-state new-state)
page' (cthf/current-page file')
frame-blue' (cths/get-shape file' :frame-blue)
copied' (find-copied-shape frame-blue' page' uuid/zero)]
;; ==== Check
;; The copy lands under the root through the frame path,
;; away from the pointer position.
(t/is (some? copied'))
(t/is (= uuid/zero (:parent-id copied')))
(t/is (not (= 1000 (:x copied'))))))))))
(t/deftest create-shape-with-detached-selection-uses-cursor-frame
"Creating a shape with a selection detached from the shape tree falls back to the frame under the cursor"
(t/async
done
(let [;; ==== Setup
file (-> (cthf/sample-file :file1)
(ctho/add-frame :frame-red {:name "frame-red" :x 1000 :y 1000 :width 100 :height 100})
(ctho/add-frame :frame-blue {:name "frame-blue" :x 0 :y 0 :width 500 :height 500})
(ctho/add-rect :rect1))
store (ths/setup-store file)
;; ==== Action
page-id (cthf/current-page-id file)
file-id (:id file)
rect1 (cths/get-shape file :rect1)
frame-blue (cths/get-shape file :frame-blue)
;; Detach the selected shape from the tree (it stays in the
;; objects map but is no longer reachable from the root)
detach-and-select (ptk/reify ::detach-and-select
ptk/UpdateEvent
(update [_ state]
(-> state
(update-in [:files file-id :data :pages-index page-id :objects uuid/zero :shapes]
(fn [shapes] (vec (remove #(= % (:id rect1)) shapes))))
(assoc-in [:workspace-local :selected] #{(:id rect1)}))))
events
[detach-and-select
(dwsh/create-and-add-shape :rect 100 100 {:name "detached-rect"
:width 50 :height 50
:x 100 :y 100})]]
(ths/run-store
store done events
(fn [new-state]
(let [;; ==== Get
file' (ths/get-file-from-state new-state)
page' (cthf/current-page file')
created' (->> (vals (:objects page'))
(filter #(= (:name %) "detached-rect"))
first)]
;; ==== Check
;; The shape is created inside the frame under the cursor
(t/is (some? created'))
(t/is (= (:id frame-blue) (:parent-id created')))))))))
(t/deftest svg-upload-with-detached-selection-uses-cursor-frame
"Uploading an SVG with a selection detached from the shape tree falls back to the frame under the cursor"
(t/async
done
(let [;; ==== Setup
file (-> (cthf/sample-file :file1)
(ctho/add-frame :frame-red {:name "frame-red" :x 1000 :y 1000 :width 100 :height 100})
(ctho/add-frame :frame-blue {:name "frame-blue" :x 0 :y 0 :width 500 :height 500})
(ctho/add-rect :rect1))
store (ths/setup-store file)
;; ==== Action
page-id (cthf/current-page-id file)
file-id (:id file)
rect1 (cths/get-shape file :rect1)
frame-blue (cths/get-shape file :frame-blue)
;; Detach the selected shape from the tree (it stays in the
;; objects map but is no longer reachable from the root)
detach-and-select (ptk/reify ::detach-and-select-svg
ptk/UpdateEvent
(update [_ state]
(-> state
(update-in [:files file-id :data :pages-index page-id :objects uuid/zero :shapes]
(fn [shapes] (vec (remove #(= % (:id rect1)) shapes))))
(assoc-in [:workspace-local :selected] #{(:id rect1)}))))
svg-data {:name "test.svg"
:attrs {:width 100 :height 100}
:content [{:tag :rect
:attrs {:x "10" :y "10" :width "20" :height "20"}}]}
events
[detach-and-select
(dwsvg/add-svg-shapes nil svg-data (gpt/point 100 100) nil)]]
(ths/run-store
store done events
(fn [new-state]
(let [;; ==== Get
file' (ths/get-file-from-state new-state)
page' (cthf/current-page file')
created' (->> (vals (:objects page'))
(filter #(= (:name %) "test"))
first)]
;; ==== Check
;; The shape is created inside the frame under the cursor
(t/is (some? created'))
(t/is (= (:id frame-blue) (:parent-id created')))))))))
(t/deftest props-paste-with-unloaded-page-is-noop
"Pasting props while the page is not loaded is ignored instead of crashing"
(t/async
done
(let [;; ==== Setup
file (-> (cthf/sample-file :file1)
(ctho/add-rect :rect1))
store (ths/setup-store file)
;; ==== Action
page-id (cthf/current-page-id file)
file-id (:id file)
rect1 (cths/get-shape file :rect1)
props {:fills (cths/sample-fills-color :fill-color "#ff0000")}
payload (transit/encode-str {:type :copied-props
:features #{"components/v2"}
:version 67
:props props
:images []})
_ (install-read-clipboard! payload)
select-rect (ptk/reify ::select-rect-props
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:workspace-local :selected] #{(:id rect1)})))
drop-page (ptk/reify ::drop-current-page-props
ptk/UpdateEvent
(update [_ state]
(update-in state [:files file-id :data :pages-index] dissoc page-id)))
;; The clipboard read resolves asynchronously, after run-store
;; emits its events; settle the run on a timer so the paste
;; pipeline (or its absence) has completed either way.
_ (js/setTimeout #(ptk/emit! store (ptk/data-event ::props-probe-done)) 250)
stopper (fn [stream] (rx/filter (ptk/type? ::props-probe-done) stream))
events
[select-rect
drop-page
(dw/paste-selected-props)]]
(ths/run-store
store done events
(fn [new-state]
(let [;; ==== Get
file' (ths/get-file-from-state new-state)
page' (cthf/current-page file')]
;; ==== Check
;; The page is still not loaded and nothing was pasted anywhere
(t/is (some? file'))
(t/is (nil? page'))))
stopper))))
(t/deftest props-paste-applies-props-on-loaded-page
"Pasting props on a loaded page applies them to the selection"
(t/async
done
(let [;; ==== Setup
file (-> (cthf/sample-file :file1)
(ctho/add-rect :rect1))
store (ths/setup-store file)
;; ==== Action
rect1 (cths/get-shape file :rect1)
props {:fills (cths/sample-fills-color :fill-color "#ff0000")}
payload (transit/encode-str {:type :copied-props
:features #{"components/v2"}
:version 67
:props props
:images []})
_ (install-read-clipboard! payload)
select-rect (ptk/reify ::select-rect-props-ok
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:workspace-local :selected] #{(:id rect1)})))
_ (js/setTimeout #(ptk/emit! store (ptk/data-event ::props-probe-ok)) 250)
stopper (fn [stream] (rx/filter (ptk/type? ::props-probe-ok) stream))
events
[select-rect
(dw/paste-selected-props)]]
(ths/run-store
store done events
(fn [new-state]
(let [;; ==== Get
file' (ths/get-file-from-state new-state)
rect1' (cths/get-shape file' :rect1)]
;; ==== Check
(t/is (= "#ff0000" (-> rect1' :fills first :fill-color)))))
stopper))))

2
frontend/test/frontend_tests/runner.cljs
View File

@ -35,6 +35,7 @@
[frontend-tests.data.workspace-texts-test]
[frontend-tests.data.workspace-thumbnails-test]
[frontend-tests.data.workspace-versions-test]
[frontend-tests.debug-logging-test]
[frontend-tests.errors-governor-test]
[frontend-tests.errors-test]
[frontend-tests.fonts-test]
@ -169,6 +170,7 @@
'frontend-tests.data.workspace-texts-test
'frontend-tests.data.workspace-thumbnails-test
'frontend-tests.data.workspace-versions-test
'frontend-tests.debug-logging-test
'frontend-tests.errors-governor-test
'frontend-tests.errors-test
'frontend-tests.fonts-test