github/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2026-10-05 10:16:16 +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) (declare indexed-shapes)
(defn get-base-shape (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] [objects selected]
(let [;; Gets the tree-index for all the shapes (let [;; Gets the tree-index for all the shapes
indexed-shapes (indexed-shapes objects selected) indexed-shapes (indexed-shapes objects selected)
@ -560,6 +562,7 @@
shapes (-> objects shapes (-> objects
(get uuid/zero) (get uuid/zero)
(get :shapes) (get :shapes)
(or [])
(rseq))] (rseq))]
(let [shape-id (first shapes)] (let [shape-id (first shapes)]

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

@ -104,8 +104,26 @@
100) 100)
(recur (get-parent-logger logger')))))))))) (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? (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] [logger level]
#?(:clj #?(:clj
(let [logger (LoggerFactory/getLogger ^String logger)] (let [logger (LoggerFactory/getLogger ^String logger)]
@ -118,13 +136,26 @@
:fatal (and (.isErrorEnabled ^Logger logger) logger) :fatal (and (.isErrorEnabled ^Logger logger) logger)
(throw (IllegalArgumentException. (str "invalid level:" level))))) (throw (IllegalArgumentException. (str "invalid level:" level)))))
:cljs :cljs
(>= (level->int level) (cond
(get-logger-level logger)))) (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 (defn- level->color
[level] [level]
(case level (case level
:error "#c82829" :error "#c82829"
:fatal "#c82829"
:warn "#f5871f" :warn "#f5871f"
:info "#4271ae" :info "#4271ae"
:debug "#969896" :debug "#969896"
@ -140,6 +171,7 @@
:info "INF" :info "INF"
:warn "WRN" :warn "WRN"
:error "ERR" :error "ERR"
:fatal "ERR"
(let [hint (str "invalid level provided to `level->name` function: " (pr-str level))] (let [hint (str "invalid level provided to `level->name` function: " (pr-str level))]
(throw (ex-info hint {:level level}))))) (throw (ex-info hint {:level level})))))
@ -151,9 +183,26 @@
:info 30 :info 30
:warn 40 :warn 40
:error 50 :error 50
:fatal 50
(let [hint (str "invalid level provided to `level->int` function: " (pr-str level))] (let [hint (str "invalid level provided to `level->int` function: " (pr-str level))]
(throw (ex-info hint {:level 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 (defn build-message
[props] [props]
(loop [props (seq props) (loop [props (seq props)
@ -284,43 +333,55 @@
(defn console-log-handler (defn console-log-handler
{:no-doc true} {:no-doc true}
[_ _ _ {:keys [::logger ::props ::level ::cause ::trace ::message]}] [_ _ _ {:keys [::logger ::props ::level ::cause ::trace ::message]}]
(when (enabled? logger level) ;; Invalid levels render with a fallback style instead of being
(let [hstyles (str/ffmt "font-weight: 600; color: %" (level->color level)) ;; dropped, so a corrupt record stays visible; the warn below keeps
mstyles (str/ffmt "font-weight: 300; color: %" (level->color level)) ;; it noticeable. The normal `log!` path never reaches here because
ts (ct/format-inst (ct/now) "kk:mm:ss.SSSS") ;; `enabled?` already drops such records before `emit-log`.
header (str/concat "%c" (level->name level) " " ts " [" logger "] ") (if-not (valid-logger? logger)
message (str/concat header "%c" @message)] (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) (js/console.group message hstyles mstyles)
(doseq [[type n v] (get-special-props props)] (doseq [[type n v] (get-special-props props)]
(case type (case type
:js (js/console.log n v) :js (js/console.log n v)
:error (if (ex/error? v) :error (if (ex/error? v)
(js/console.error n (pr-str v)) (js/console.error n (pr-str v))
(js/console.error n v)))) (js/console.error n v))))
(when (ex/exception? cause) (when (ex/exception? cause)
(let [data (ex-data cause) (let [data (ex-data cause)
explain (or (:explain data) explain (or (:explain data)
(ex/explain data))] (ex/explain data))]
(when explain (when explain
(js/console.log "Explain:") (js/console.log "Explain:")
(js/console.log explain)) (js/console.log explain))
(when (and data (not explain)) (when (and data (not explain))
(js/console.log "Data:") (js/console.log "Data:")
(js/console.log (pp/pprint-str 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) #?(:clj (add-watch log-record ::default slf4j-log-handler)
:cljs (add-watch log-record ::default console-log-handler)) :cljs (add-watch log-record ::default console-log-handler))
(defmacro set-level! (defmacro set-level!
"A CLJS-only macro for set logging level to current (that matches the "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] ([level]
(when (:ns &env) (when (:ns &env)
`(.set ^js/Map loggers ~(str *ns*) (level->int ~level)))) `(.set ^js/Map loggers ~(str *ns*) (level->int ~level))))
@ -332,9 +393,16 @@
(defn setup! (defn setup!
[{:as config}] [{:as config}]
(run! (fn [[logger level]] (run! (fn [[logger level]]
(let [logger (if (keyword? logger) (name logger) logger) (let [logger (if (keyword? logger) (name logger) logger)]
level (level->int level)] (cond
(.set ^js/Map loggers logger level))) (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))) config)))
(defmacro raw! (defmacro raw!

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

@ -38,6 +38,48 @@
:immediate-suffix? true) :immediate-suffix? true)
"base-name 3"))) "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 (t/deftest test-get-prev-sibling
(let [parent-id (uuid/custom 1 1) (let [parent-id (uuid/custom 1 1)
child-a (uuid/custom 1 2) 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-0025-test]
[common-tests.files-migrations-0026-test] [common-tests.files-migrations-0026-test]
[common-tests.files-migrations-test] [common-tests.files-migrations-test]
[common-tests.files.helpers-test]
[common-tests.files.shapes-builder-test] [common-tests.files.shapes-builder-test]
[common-tests.files.validate-test] [common-tests.files.validate-test]
[common-tests.geom-align-test] [common-tests.geom-align-test]
@ -47,6 +48,7 @@
[common-tests.geom-shapes-tree-seq-test] [common-tests.geom-shapes-tree-seq-test]
[common-tests.geom-snap-test] [common-tests.geom-snap-test]
[common-tests.geom-test] [common-tests.geom-test]
[common-tests.logging-test]
[common-tests.logic.chained-propagation-test] [common-tests.logic.chained-propagation-test]
[common-tests.logic.comp-creation-test] [common-tests.logic.comp-creation-test]
[common-tests.logic.comp-detach-with-nested-test] [common-tests.logic.comp-detach-with-nested-test]
@ -100,6 +102,7 @@
'common-tests.data-test 'common-tests.data-test
'common-tests.files-changes-test 'common-tests.files-changes-test
'common-tests.files-builder-test 'common-tests.files-builder-test
'common-tests.files.helpers-test
'common-tests.files-migrations-0025-test 'common-tests.files-migrations-0025-test
'common-tests.files-migrations-0026-test 'common-tests.files-migrations-0026-test
'common-tests.files-migrations-test 'common-tests.files-migrations-test
@ -128,6 +131,7 @@
'common-tests.geom-shapes-tree-seq-test 'common-tests.geom-shapes-tree-seq-test
'common-tests.geom-snap-test 'common-tests.geom-snap-test
'common-tests.geom-test 'common-tests.geom-test
'common-tests.logging-test
'common-tests.logic.chained-propagation-test 'common-tests.logic.chained-propagation-test
'common-tests.logic.comp-creation-test 'common-tests.logic.comp-creation-test
'common-tests.logic.comp-detach-with-nested-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})) :timeout 5000}))
(rx/throw cause))) (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 (defn paste-from-clipboard
"Perform a `paste` operation using the Clipboard API." "Perform a `paste` operation using the Clipboard API."
([] (paste-from-clipboard nil)) ([] (paste-from-clipboard nil))
([{:keys [replace?]}] ([{:keys [replace?]}]
(ptk/reify ::paste-from-clipboard (ptk/reify ::paste-from-clipboard
ptk/WatchEvent ptk/WatchEvent
(watch [_ _ _] (watch [_ state _]
(->> (clipboard/from-navigator default-options) (if (page-ready? (dsh/lookup-page-objects state))
(rx/mapcat (create-paste-from-blob false (boolean replace?))) (->> (clipboard/from-navigator default-options)
(rx/take 1) (rx/mapcat (create-paste-from-blob false (boolean replace?)))
(rx/catch on-clipboard-permission-error)))))) (rx/take 1)
(rx/catch on-clipboard-permission-error))
(rx/empty))))))
(defn paste-from-event (defn paste-from-event
"Perform a `paste` operation from user emmited 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])))] is-editing? (and edit-id (= :text (get-in objects [edit-id :type])))]
;; Some paste events can be fired while we're editing a text ;; Some paste events can be fired while we're editing a text
;; we forbid that scenario so the default behaviour is executed ;; we forbid that scenario so the default behaviour is executed.
(if is-editing? ;; Pastes arriving before the page is loaded are ignored as well.
(if (or is-editing? (not (page-ready? objects)))
(rx/empty) (rx/empty)
(->> (clipboard/from-synthetic-clipboard-event event default-options) (->> (clipboard/from-synthetic-clipboard-event event default-options)
(rx/mapcat (create-paste-from-blob in-viewport? false)))))))) (rx/mapcat (create-paste-from-blob in-viewport? false))))))))
@ -516,11 +528,13 @@
(js/console.error "Clipboard error:" cause) (js/console.error "Clipboard error:" cause)
(rx/empty)))))] (rx/empty)))))]
(->> (clipboard/from-navigator default-options) (if (page-ready? (dsh/lookup-page-objects state))
(rx/mapcat #(.text %)) (->> (clipboard/from-navigator default-options)
(rx/map decode-entry) (rx/mapcat #(.text %))
(rx/take 1) (rx/map decode-entry)
(rx/catch on-error))))))) (rx/take 1)
(rx/catch on-error))
(rx/empty)))))))
(defn- selected-frame? [state] (defn- selected-frame? [state]
(let [selected (dsh/lookup-selected state) (let [selected (dsh/lookup-selected state)
@ -609,17 +623,19 @@
(cfeat/check-paste-features! features (:features pdata)) (cfeat/check-paste-features! features (:features pdata))
(case (:type pdata) (if (page-ready? (dsh/lookup-page-objects state))
:copied-shapes (case (:type pdata)
(if (= file-id (:file-id pdata)) :copied-shapes
(let [pdata (assoc pdata :images [])] (if (= file-id (:file-id pdata))
(rx/of (paste-shapes pdata))) (let [pdata (assoc pdata :images [])]
(->> (rx/from images) (rx/of (paste-shapes pdata)))
(rx/merge-map (partial upload-media file-id)) (->> (rx/from images)
(rx/reduce conj []) (rx/merge-map (partial upload-media file-id))
(rx/map #(assoc pdata :images %)) (rx/reduce conj [])
(rx/map paste-shapes))) (rx/map #(assoc pdata :images %))
nil)))))) (rx/map paste-shapes)))
nil)
(rx/empty)))))))
(defn- paste-transit-props (defn- paste-transit-props
[pdata] [pdata]
@ -768,6 +784,17 @@
target-index (cfh/get-position-on-parent page-objects replace-id)] target-index (cfh/get-position-on-parent page-objects replace-id)]
[parent-id delta target-index]) [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 ;; Paste next to selected frame, if selected is itself or of the same size as the copied
(and (selected-frame? state) (and (selected-frame? state)
(or (any-same-frame-from-selected? state (keys pobjects)) (or (any-same-frame-from-selected? state (keys pobjects))
@ -821,11 +848,6 @@
(count (:shapes selected-frame-obj)))] (count (:shapes selected-frame-obj)))]
[frame-id delta target-index]) [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 :else
(let [parent-id (:parent-id base) (let [parent-id (:parent-id base)
delta (if in-viewport? delta (if in-viewport?
@ -870,140 +892,141 @@
ptk/WatchEvent ptk/WatchEvent
(watch [it state _] (watch [it state _]
(let [file-id (:current-file-id 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) selected (:selected pdata)
(d/index-by :prev-id))
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. ;; Calculate position for the pasted elements
;; In that case we drop the pasted content at its position and [candidate-parent-id
;; delete it in the same transaction. delta
page-selected (dsh/lookup-selected state) index] (calculate-paste-position state objects selected position replace-id)
replace-id (when (and (:replace pdata) (= 1 (count page-selected)))
(first page-selected))
;; Calculate position for the pasted elements libraries (dsh/lookup-libraries state)
[candidate-parent-id ldata (dsh/lookup-file-data state file-id)
delta
index] (calculate-paste-position state objects selected position replace-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) index (if (= candidate-parent-id parent-id)
ldata (dsh/lookup-file-data state file-id) index
0)
[parent-id index (if index
frame-id] (ctn/find-valid-parent-and-frame-ids candidate-parent-id page-objects (vals objects) true libraries) index
(dec (count (dm/get-in page-objects [parent-id :shapes]))))
index (if (= candidate-parent-id parent-id) selected (if (and (ctl/flex-layout? page-objects parent-id) (not (ctl/reverse? page-objects parent-id)))
index (into (d/ordered-set) (reverse selected))
0) selected)
index (if index valid-file-ids (conj (set (keys libraries)) file-id)
index
(dec (count (dm/get-in page-objects [parent-id :shapes]))))
selected (if (and (ctl/flex-layout? page-objects parent-id) (not (ctl/reverse? page-objects parent-id))) objects (update-vals objects (partial process-shape valid-file-ids frame-id parent-id))
(into (d/ordered-set) (reverse selected))
selected)
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) ;; Adds a resize-parents operation so the groups are
(gslg/get-drop-cell frame-id all-objects position)) ;; 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) changes (if (some? replace-id)
(cll/generate-duplicate-changes all-objects page selected delta (second (cls/generate-delete-shapes changes #{replace-id} {}))
libraries ldata file-id {:variant-props variant-props}) changes)
(pcb/amend-changes (partial process-rchange media-idx))
(pcb/amend-changes (partial change-add-obj-index objects selected index)))
;; Adds a resize-parents operation so the groups are orig-shapes (map (d/getf all-objects) selected)
;; updated. We add all the new objects
changes (->> (:redo-changes changes)
(filter add-obj?)
(map :id)
(pcb/resize-parents changes))
changes (if (some? replace-id) children-after (-> (pcb/get-objects changes)
(second (cls/generate-delete-shapes changes #{replace-id} {})) (dm/get-in [parent-id :shapes])
changes) 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) changes (cond-> changes
(dm/get-in [parent-id :shapes]) (some? drop-cell)
set) (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 add-component-to-variant? (and
;; that are a direct child of the shape parent-id ;; Any of the shapes is a head
selected (into (d/ordered-set) (some ctk/instance-head? orig-shapes)
(comp ;; Any ancestor of the destination parent is a variant
(filter add-obj?) (->> (cfh/get-parents-with-self page-objects parent-id)
(map (comp :id :obj)) (some ctk/is-variant?)))
(filter #(contains? children-after %))) undo-id (js/Symbol)]
(:redo-changes changes))
changes (cond-> changes (rx/concat
(some? drop-cell) (->> (rx/from orig-shapes)
(pcb/update-shapes [parent-id] (rx/map (fn [shape]
#(ctl/add-children-to-cell % selected all-objects drop-cell))) (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 ;; NOTE: we don't emit the create-shape event all the time for
;; Any of the shapes is a head ;; avoid send a lot of events (that are not necessary); this
(some ctk/instance-head? orig-shapes) ;; decision is made explicitly by the responsible team.
;; Any ancestor of the destination parent is a variant (if (ctk/instance-head? shape)
(->> (cfh/get-parents-with-self page-objects parent-id) (ev/event {::ev/name "use-library-component"
(some ctk/is-variant?))) ::ev/origin origin
undo-id (js/Symbol)] :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/of (dwu/start-undo-transaction undo-id)
(->> (rx/from orig-shapes) (dch/commit-changes changes)
(rx/map (fn [shape] (dws/select-shapes selected)
(let [parent-type (cfh/get-shape-type all-objects (:parent-id shape)) (ptk/data-event :layout/update {:ids [frame-id]})
external-lib? (not= file-id (:component-file shape)) (dwu/commit-undo-transaction undo-id)
component (ctn/get-component-from-shape shape libraries) (when add-component-to-variant?
origin "workspace:paste"] (ev/event {::ev/name "add-component-to-variant"})))))
(rx/empty)))))))
;; 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"})))))))))
(defn- as-content [text] (defn- as-content [text]
(let [paragraphs (->> (str/lines 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) selected (dsh/lookup-selected state)
base (cfh/get-base-shape objects selected) 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)))) (cfh/frame-shape? (get objects (first selected))))
(empty? selected)) (empty? selected))
frame-id frame-id

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

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

18
frontend/src/debug.cljs
View File

@ -50,11 +50,25 @@
(l/set-level! :debug) (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 (defn ^:export set-logging
([level] ([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] ([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 ;; These events are excluded when we activate the :events flag
(def debug-exclude-events (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")))

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

@ -5,23 +5,53 @@
;; Copyright (c) KALEIDOS SUBSIDIARY SL ;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns frontend-tests.logic.pasting-in-containers-test (ns frontend-tests.logic.pasting-in-containers-test
(:require (:require
[app.common.geom.point :as gpt]
[app.common.test-helpers.components :as cthc] [app.common.test-helpers.components :as cthc]
[app.common.test-helpers.compositions :as ctho] [app.common.test-helpers.compositions :as ctho]
[app.common.test-helpers.files :as cthf] [app.common.test-helpers.files :as cthf]
[app.common.test-helpers.ids-map :as cthi] [app.common.test-helpers.ids-map :as cthi]
[app.common.test-helpers.shapes :as cths] [app.common.test-helpers.shapes :as cths]
[app.common.test-helpers.variants :as thv] [app.common.test-helpers.variants :as thv]
[app.common.transit :as transit]
[app.common.types.component :as ctk] [app.common.types.component :as ctk]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.main.data.workspace :as dw] [app.main.data.workspace :as dw]
[app.main.data.workspace.selection :as dws] [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] [cljs.test :as t :include-macros true]
[cuerdas.core :as str] [cuerdas.core :as str]
[frontend-tests.helpers.pages :as thp] [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 (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 ;; Related .penpot file: common/test/cases/remove-swap-slots.penpot
(defn- setup-file (defn- setup-file
@ -667,3 +697,402 @@
;;There was 3 components, now there are still 3 ;;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/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-texts-test]
[frontend-tests.data.workspace-thumbnails-test] [frontend-tests.data.workspace-thumbnails-test]
[frontend-tests.data.workspace-versions-test] [frontend-tests.data.workspace-versions-test]
[frontend-tests.debug-logging-test]
[frontend-tests.errors-governor-test] [frontend-tests.errors-governor-test]
[frontend-tests.errors-test] [frontend-tests.errors-test]
[frontend-tests.fonts-test] [frontend-tests.fonts-test]
@ -169,6 +170,7 @@
'frontend-tests.data.workspace-texts-test 'frontend-tests.data.workspace-texts-test
'frontend-tests.data.workspace-thumbnails-test 'frontend-tests.data.workspace-thumbnails-test
'frontend-tests.data.workspace-versions-test 'frontend-tests.data.workspace-versions-test
'frontend-tests.debug-logging-test
'frontend-tests.errors-governor-test 'frontend-tests.errors-governor-test
'frontend-tests.errors-test 'frontend-tests.errors-test
'frontend-tests.fonts-test 'frontend-tests.fonts-test