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

This commit is contained in:
Andrey Antukh 2026-04-16 10:59:36 +02:00
commit b5922d32ca
39 changed files with 635 additions and 324 deletions

View File

@ -24,11 +24,12 @@
- Fix text editor v1 focus [Taiga #13961](https://tree.taiga.io/project/penpot/issue/13961)
## 2.14.3 (Unreleased)
## 2.14.3
### :sparkles: New features & Enhancements
- Add webp export format to plugin types [Github #8870](https://github.com/penpot/penpot/pull/8870)
- Use shared singleton containers for React portals to reduce DOM growth [Github #8957](https://github.com/penpot/penpot/pull/8957)
### :bug: Bugs fixed
@ -41,6 +42,16 @@
- Fix path drawing preview passing shape instead of content to next-node
- Fix swapped arguments in CLJS PathData `-nth` with default
- Normalize PathData coordinates to safe integer bounds on read
- Fix RangeError from re-entrant error handling causing stack overflow [Github #8962](https://github.com/penpot/penpot/pull/8962)
- Fix builder bool styles and media validation [Github #8963](https://github.com/penpot/penpot/pull/8963)
- Fix "Move to" menu allowing same project as target when multiple files are selected
- Fix crash when index query param is duplicated in URL
- Fix wrong extremity point in path `calculate-extremities` for line-to segments
- Fix reversed args in DTCG shadow composite token conversion
- Fix `inside-layout?` passing shape id instead of shape to `frame-shape?`
- Fix wrong `mapcat` call in `collect-main-shapes`
- Fix stale accumulator in `get-children-in-instance` recursion
- Fix typo `:podition` in swap-shapes grid cell
## 2.14.2

View File

@ -446,6 +446,7 @@
(when (:create-welcome-file params)
(let [cfg (dissoc cfg ::db/conn)]
(wrk/submit! executor (create-welcome-file cfg profile)))))]
(cond
;; When profile is blocked, we just ignore it and return plain data
(:is-blocked profile)
@ -453,7 +454,8 @@
(l/wrn :hint "register attempt for already blocked profile"
:profile-id (str (:id profile))
:profile-email (:email profile))
(rph/with-meta {:email (:email profile)}
(rph/with-meta {:id (:id profile)
:email (:email profile)}
{::audit/replace-props props
::audit/context {:action "ignore-because-blocked"}
::audit/profile-id (:id profile)
@ -469,7 +471,9 @@
(:member-email invitation)))
(let [invitation (assoc invitation :member-id (:id profile))
token (tokens/generate cfg invitation)]
(-> {:invitation-token token}
(-> {:id (:id profile)
:email (:email profile)
:invitation-token token}
(rph/with-transform (session/create-fn cfg profile claims))
(rph/with-meta {::audit/replace-props props
::audit/context {:action "accept-invitation"}
@ -492,7 +496,8 @@
(when-not (eml/has-reports? conn (:email profile))
(send-email-verification! cfg profile))
(-> {:email (:email profile)}
(-> {:id (:id profile)
:email (:email profile)}
(rph/with-defer create-welcome-file-when-needed)
(rph/with-meta
{::audit/replace-props props
@ -519,7 +524,8 @@
{:id (:id profile)})
(send-email-verification! cfg profile))
(rph/with-meta {:email (:email profile)}
(rph/with-meta {:email (:email profile)
:id (:id profile)}
{::audit/replace-props (audit/profile->props profile)
::audit/context {:action action}
::audit/profile-id (:id profile)

View File

@ -487,62 +487,3 @@
b (+ (* bh 100) (* bv 10))]
(compare a b)))
(defn interpolate-color
[c1 c2 offset]
(cond
(<= offset (:offset c1)) (assoc c1 :offset offset)
(>= offset (:offset c2)) (assoc c2 :offset offset)
:else
(let [tr-offset (/ (- offset (:offset c1)) (- (:offset c2) (:offset c1)))
[r1 g1 b1] (hex->rgb (:color c1))
[r2 g2 b2] (hex->rgb (:color c2))
a1 (:opacity c1)
a2 (:opacity c2)
r (+ r1 (* (- r2 r1) tr-offset))
g (+ g1 (* (- g2 g1) tr-offset))
b (+ b1 (* (- b2 b1) tr-offset))
a (+ a1 (* (- a2 a1) tr-offset))]
{:color (rgb->hex [r g b])
:opacity a
:r r
:g g
:b b
:alpha a
:offset offset})))
(defn- offset-spread
[from to num]
(->> (range 0 num)
(map #(mth/precision (+ from (* (/ (- to from) (dec num)) %)) 2))))
(defn uniform-spread?
"Checks if the gradient stops are spread uniformly"
[stops]
(let [cs (count stops)
from (first stops)
to (last stops)
expect-vals (offset-spread (:offset from) (:offset to) cs)
calculate-expected
(fn [expected-offset stop]
(and (mth/close? (:offset stop) expected-offset)
(let [ec (interpolate-color from to expected-offset)]
(and (= (:color ec) (:color stop))
(= (:opacity ec) (:opacity stop))))))]
(->> (map calculate-expected expect-vals stops)
(every? true?))))
(defn uniform-spread
"Assign an uniform spread to the offset values for the gradient"
[from to num-stops]
(->> (offset-spread (:offset from) (:offset to) num-stops)
(mapv (fn [offset]
(interpolate-color from to offset)))))
(defn interpolate-gradient
[stops offset]
(let [idx (d/index-of-pred stops #(<= offset (:offset %)))
start (if (= idx 0) (first stops) (get stops (dec idx)))
end (if (nil? idx) (last stops) (get stops idx))]
(interpolate-color start end offset)))

View File

@ -5,7 +5,7 @@
;; Copyright (c) KALEIDOS INC
(ns app.common.data
"A collection if helpers for working with data structures and other
"A collection of helpers for working with data structures and other
data resources."
(:refer-clojure :exclude [read-string hash-map merge name update-vals
parse-double group-by iteration concat mapcat
@ -143,7 +143,7 @@
(oassoc-in o (cons k ks) v)))
(defn vec2
"Creates a optimized vector compatible type of length 2 backed
"Creates an optimized vector compatible type of length 2 backed
internally with MapEntry impl because it has faster access method
for its fields."
[o1 o2]
@ -252,13 +252,13 @@
([items] (enumerate items 0))
([items start]
(loop [idx start
items items
items (seq items)
res (transient [])]
(if (empty? items)
(persistent! res)
(if items
(recur (inc idx)
(rest items)
(conj! res [idx (first items)]))))))
(next items)
(conj! res [idx (first items)]))
(persistent! res)))))
(defn group-by
([kf coll] (group-by kf identity [] coll))
@ -291,15 +291,12 @@
(defn index-of-pred
[coll pred]
(loop [c (first coll)
coll (rest coll)
(loop [s (seq coll)
index 0]
(if (nil? c)
nil
(if (pred c)
(when s
(if (pred (first s))
index
(recur (first coll)
(rest coll)
(recur (next s)
(inc index))))))
(defn index-of
@ -377,7 +374,7 @@
(assoc object key nil)
(nil? value)
(dissoc object key value)
(dissoc object key)
:else
(assoc object key value)))
@ -396,7 +393,7 @@
(subvec v (inc index))))
(defn without-obj
"Clear collection from specified obj and without nil values."
"Return a vector with all elements equal to `o` removed."
[coll o]
(into [] (filter #(not= % o)) coll))
@ -404,7 +401,7 @@
(map vector col1 col2))
(defn zip-all
"Return a zip of both collections, extended to the lenght of the longest one,
"Return a zip of both collections, extended to the length of the longest one,
and padding the shorter one with nils as needed."
[col1 col2]
(let [diff (- (count col1) (count col2))]
@ -423,9 +420,9 @@
coll)))
(defn removev
"Returns a vector of the items in coll for which (fn item) returns logical false"
[fn coll]
(filterv (comp not fn) coll))
"Returns a vector of the items in coll for which (pred item) returns logical false"
[pred coll]
(filterv (comp not pred) coll))
(defn filterm
"Filter values of a map that satisfy a predicate"
@ -443,7 +440,7 @@
Optional parameters:
`pred?` A predicate that if not satisfied won't process the pair
`target?` A collection that will be used as seed to be stored
`target` A collection that will be used as seed to be stored
Example:
(map-perm vector [1 2 3 4]) => [[1 2] [1 3] [1 4] [2 3] [2 4] [3 4]]"
@ -602,12 +599,9 @@
(let [do-map
(fn [entry]
(let [[k v] (mfn entry)]
(cond
(or (vector? v) (map? v))
(if (or (vector? v) (map? v))
[k (deep-mapm mfn v)]
:else
(mfn [k v]))))]
[k v])))]
(cond
(map? m)
(into {} (map do-map) m)
@ -724,7 +718,7 @@
(defn nan?
[v]
#?(:cljs (js/isNaN v)
:clj (not= v v)))
:clj (and (number? v) (Double/isNaN v))))
(defn- impl-parse-integer
[v]
@ -788,7 +782,8 @@
(not (js/isNaN v))
(not (js/isNaN (parse-double v))))
:clj (not= (parse-double v :nan) :nan)))
:clj (and (string? v)
(not= (parse-double v :nan) :nan))))
(defn read-string
[v]
@ -958,7 +953,7 @@
(assoc diff key (map-diff v1 v2))
:else
(assoc diff key [(get m1 key) (get m2 key)]))))]
(assoc diff key [v1 v2]))))]
(->> keys
(reduce diff-attr {}))))
@ -1123,8 +1118,7 @@
([value {:keys [precision] :or {precision 2}}]
(let [value (if (string? value) (parse-double value) value)]
(when (num? value)
(let [value (format-precision value precision)]
(str value))))))
(format-precision value precision)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Util protocols
@ -1152,20 +1146,20 @@
"Wrapper around subvec so it doesn't throw an exception but returns nil instead"
([v start]
(when (and (some? v)
(> start 0) (< start (count v)))
(>= start 0) (< start (count v)))
(subvec v start)))
([v start end]
(let [size (count v)]
(when (and (some? v)
(>= start 0) (< start size)
(>= end 0) (<= start end) (<= end size))
(subvec v start end)))))
(when (some? v)
(let [size (count v)]
(when (and (>= start 0) (< start size)
(>= end 0) (<= start end) (<= end size))
(subvec v start end))))))
(defn append-class
[class current-class]
(str (if (some? class) (str class " ") "")
current-class))
(if (seq class)
(str class " " current-class)
current-class))
(defn nth-index-of*
"Finds the nth occurrence of `char` in `string`, searching either forward or backward.
@ -1201,4 +1195,4 @@
"Returns the index of the nth occurrence of `char` in `string`, searching right to left.
Returns nil if fewer than n occurrences exist."
[string char n]
(nth-index-of* string char n :backward))
(nth-index-of* string char n :backward))

View File

@ -356,7 +356,7 @@
:code :empty-children
:hint "expected a group with at least one shape for creating a bool"))
(let [head (if (= type :difference)
(let [head (if (= (:bool-type bool-shape) :difference)
(first children)
(last children))
fills (if (and (contains? head :svg-attrs) (empty? (:fills head)))
@ -364,7 +364,7 @@
(get head :fills))]
(-> bool-shape
(assoc :fills fills)
(assoc :stroks (get head :strokes))))))
(assoc :strokes (get head :strokes))))))
(defn add-bool
[state params]
@ -576,7 +576,7 @@
{:keys [id width height name]}
(-> params
(update :id default-uuid)
(check-add-file-media params))]
(check-add-file-media))]
(-> state
(update ::blobs assoc media-id blob)

View File

@ -439,7 +439,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- without-obj
"Clear collection from specified obj and without nil values."
"Return a vector with all elements equal to `o` removed."
[coll o]
(into [] (filter #(not= % o)) coll))

View File

@ -720,8 +720,10 @@
(defn- offset-spread
[from to num]
(->> (range 0 num)
(map #(mth/precision (+ from (* (/ (- to from) (dec num)) %)) 2))))
(if (<= num 1)
[from]
(->> (range 0 num)
(map #(mth/precision (+ from (* (/ (- to from) (dec num)) %)) 2)))))
(defn uniform-spread?
"Checks if the gradient stops are spread uniformly"
@ -750,6 +752,9 @@
(defn interpolate-gradient
[stops offset]
(let [idx (d/index-of-pred stops #(<= offset (:offset %)))
start (if (= idx 0) (first stops) (get stops (dec idx)))
start (cond
(nil? idx) (last stops)
(= idx 0) (first stops)
:else (get stops (dec idx)))
end (if (nil? idx) (last stops) (get stops idx))]
(interpolate-color start end offset)))

View File

@ -106,8 +106,9 @@
(let [shape (get objects id)]
(if (and (ctk/instance-head? shape) (seq children))
children
(into (conj children shape)
(mapcat #(get-children-rec children %) (:shapes shape))))))]
(let [children' (conj children shape)]
(into children'
(mapcat #(get-children-rec children' %) (:shapes shape)))))))]
(get-children-rec [] id)))
(defn get-component-shape
@ -440,7 +441,7 @@
(if (ctk/main-instance? shape)
[shape]
(if-let [children (cfh/get-children objects (:id shape))]
(mapcat collect-main-shapes children objects)
(mapcat #(collect-main-shapes % objects) children)
[])))
(defn get-component-from-shape

View File

@ -380,7 +380,7 @@
nil))
(-nth [_ i default]
(if (d/in-range? i size)
(if (d/in-range? size i)
(read-fill dbuffer mbuffer i)
default))

View File

@ -278,7 +278,7 @@
(set! (.-cache this) (c/-assoc cache k v))
v)
(do
(set! (.-cache this) (assoc cache key nil))
(set! (.-cache this) (assoc cache k nil))
nil))))
(-lookup [this k not-found]

View File

@ -812,7 +812,7 @@
:line-to
(recur (cond-> points
(and from-p to-p)
(-> (conj! move-p)
(-> (conj! from-p)
(conj! to-p)))
(not-empty (subvec content 1))
to-p

View File

@ -262,7 +262,7 @@
(or (nil? current) (= current-id parent-id))
false
(cfh/frame-shape? current-id)
(cfh/frame-shape? current)
(:layout current)
:else
@ -1439,7 +1439,7 @@
(update-in [:layout-grid-cells id-from]
assoc
:shapes (:shapes cell-to)
:podition (:position cell-to))
:position (:position cell-to))
(update-in [:layout-grid-cells id-to]
assoc
:shapes (:shapes cell-from)

View File

@ -346,7 +346,6 @@
(def typography-keys (set/union font-family-keys
font-size-keys
font-weight-keys
font-weight-keys
letter-spacing-keys
line-height-keys
text-case-keys

View File

@ -1637,7 +1637,7 @@ Will return a value that matches this schema:
[value]
(let [process-shadow (fn [shadow]
(if (map? shadow)
(let [legacy-shadow-type (get "type" shadow)]
(let [legacy-shadow-type (get shadow "type")]
(-> shadow
(set/rename-keys {"x" :offset-x
"offsetX" :offset-x

View File

@ -9,91 +9,8 @@
#?(:cljs [goog.color :as gcolors])
[app.common.colors :as c]
[app.common.math :as mth]
[app.common.types.color :as colors]
[clojure.test :as t]))
(t/deftest valid-hex-color
(t/is (false? (colors/valid-hex-color? nil)))
(t/is (false? (colors/valid-hex-color? "")))
(t/is (false? (colors/valid-hex-color? "#")))
(t/is (false? (colors/valid-hex-color? "#qqqqqq")))
(t/is (true? (colors/valid-hex-color? "#aaa")))
(t/is (false? (colors/valid-hex-color? "#aaaa")))
(t/is (true? (colors/valid-hex-color? "#fabada"))))
(t/deftest valid-rgb-color
(t/is (false? (colors/valid-rgb-color? nil)))
(t/is (false? (colors/valid-rgb-color? "")))
(t/is (false? (colors/valid-rgb-color? "()")))
(t/is (true? (colors/valid-rgb-color? "(255, 30, 30)")))
(t/is (true? (colors/valid-rgb-color? "rgb(255, 30, 30)"))))
(t/deftest rgb-to-str
(t/is (= "rgb(1,2,3)" (colors/rgb->str [1 2 3])))
(t/is (= "rgba(1,2,3,4)" (colors/rgb->str [1 2 3 4]))))
(t/deftest rgb-to-hsv
;; (prn (colors/rgb->hsv [1 2 3]))
;; (prn (gcolors/rgbToHsv 1 2 3))
(t/is (= [210.0 0.6666666666666666 3.0] (colors/rgb->hsv [1.0 2.0 3.0])))
#?(:cljs (t/is (= (colors/rgb->hsv [1 2 3]) (vec (gcolors/rgbToHsv 1 2 3))))))
(t/deftest hsv-to-rgb
(t/is (= [1 2 3]
(colors/hsv->rgb [210 0.6666666666666666 3])))
#?(:cljs
(t/is (= (colors/hsv->rgb [210 0.6666666666666666 3])
(vec (gcolors/hsvToRgb 210 0.6666666666666666 3))))))
(t/deftest rgb-to-hex
(t/is (= "#010203" (colors/rgb->hex [1 2 3]))))
(t/deftest hex-to-rgb
(t/is (= [0 0 0] (colors/hex->rgb "#kkk")))
(t/is (= [1 2 3] (colors/hex->rgb "#010203"))))
(t/deftest format-hsla
(t/is (= "210, 50%, 0.78%, 1" (colors/format-hsla [210.0 0.5 0.00784313725490196 1])))
(t/is (= "220, 5%, 30%, 0.8" (colors/format-hsla [220.0 0.05 0.3 0.8]))))
(t/deftest format-rgba
(t/is (= "210, 199, 12, 0.08" (colors/format-rgba [210 199 12 0.08])))
(t/is (= "210, 199, 12, 1" (colors/format-rgba [210 199 12 1]))))
(t/deftest rgb-to-hsl
(t/is (= [210.0 0.5 0.00784313725490196] (colors/rgb->hsl [1 2 3])))
#?(:cljs (t/is (= (colors/rgb->hsl [1 2 3])
(vec (gcolors/rgbToHsl 1 2 3))))))
(t/deftest hsl-to-rgb
(t/is (= [1 2 3] (colors/hsl->rgb [210.0 0.5 0.00784313725490196])))
(t/is (= [210.0 0.5 0.00784313725490196] (colors/rgb->hsl [1 2 3])))
#?(:cljs (t/is (= (colors/hsl->rgb [210 0.5 0.00784313725490196])
(vec (gcolors/hslToRgb 210 0.5 0.00784313725490196))))))
(t/deftest expand-hex
(t/is (= "aaaaaa" (colors/expand-hex "a")))
(t/is (= "aaaaaa" (colors/expand-hex "aa")))
(t/is (= "aaaaaa" (colors/expand-hex "aaa")))
(t/is (= "aaaa" (colors/expand-hex "aaaa"))))
(t/deftest prepend-hash
(t/is "#aaa" (colors/prepend-hash "aaa"))
(t/is "#aaa" (colors/prepend-hash "#aaa")))
(t/deftest remove-hash
(t/is "aaa" (colors/remove-hash "aaa"))
(t/is "aaa" (colors/remove-hash "#aaa")))
(t/deftest color-string-pred
(t/is (true? (colors/color-string? "#aaa")))
(t/is (true? (colors/color-string? "(10,10,10)")))
(t/is (true? (colors/color-string? "rgb(10,10,10)")))
(t/is (true? (colors/color-string? "magenta")))
(t/is (false? (colors/color-string? nil)))
(t/is (false? (colors/color-string? "")))
(t/is (false? (colors/color-string? "kkkkkk"))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; app.common.colors tests
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -387,55 +304,3 @@
(t/is (= 0.25 (c/reduce-range 0.3 4)))
(t/is (= 0.0 (c/reduce-range 0.0 10))))
;; --- Gradient helpers
(t/deftest ac-interpolate-color
(let [c1 {:color "#000000" :opacity 0.0 :offset 0.0}
c2 {:color "#ffffff" :opacity 1.0 :offset 1.0}]
;; At c1's offset → c1 with updated offset
(let [result (c/interpolate-color c1 c2 0.0)]
(t/is (= "#000000" (:color result)))
(t/is (= 0.0 (:opacity result))))
;; At c2's offset → c2 with updated offset
(let [result (c/interpolate-color c1 c2 1.0)]
(t/is (= "#ffffff" (:color result)))
(t/is (= 1.0 (:opacity result))))
;; At midpoint → gray
(let [result (c/interpolate-color c1 c2 0.5)]
(t/is (= "#7f7f7f" (:color result)))
(t/is (mth/close? (:opacity result) 0.5)))))
(t/deftest ac-uniform-spread
(let [c1 {:color "#000000" :opacity 0.0 :offset 0.0}
c2 {:color "#ffffff" :opacity 1.0 :offset 1.0}
stops (c/uniform-spread c1 c2 3)]
(t/is (= 3 (count stops)))
(t/is (= 0.0 (:offset (first stops))))
(t/is (mth/close? 0.5 (:offset (second stops))))
(t/is (= 1.0 (:offset (last stops))))))
(t/deftest ac-uniform-spread?
(let [c1 {:color "#000000" :opacity 0.0 :offset 0.0}
c2 {:color "#ffffff" :opacity 1.0 :offset 1.0}
stops (c/uniform-spread c1 c2 3)]
;; A uniformly spread result should pass the predicate
(t/is (true? (c/uniform-spread? stops))))
;; Manual non-uniform stops should not pass
(let [stops [{:color "#000000" :opacity 0.0 :offset 0.0}
{:color "#888888" :opacity 0.5 :offset 0.3}
{:color "#ffffff" :opacity 1.0 :offset 1.0}]]
(t/is (false? (c/uniform-spread? stops)))))
(t/deftest ac-interpolate-gradient
(let [stops [{:color "#000000" :opacity 0.0 :offset 0.0}
{:color "#ffffff" :opacity 1.0 :offset 1.0}]]
;; At start
(let [result (c/interpolate-gradient stops 0.0)]
(t/is (= "#000000" (:color result))))
;; At end
(let [result (c/interpolate-gradient stops 1.0)]
(t/is (= "#ffffff" (:color result))))
;; In the middle
(let [result (c/interpolate-gradient stops 0.5)]
(t/is (= "#7f7f7f" (:color result))))))

View File

@ -349,6 +349,8 @@
(t/is (= [2 3] (d/safe-subvec [1 2 3 4] 1 3)))
;; single arg — from index to end
(t/is (= [2 3 4] (d/safe-subvec [1 2 3 4] 1)))
;; start=0 returns the full vector
(t/is (= [1 2 3 4] (d/safe-subvec [1 2 3 4] 0)))
;; out-of-range returns nil
(t/is (nil? (d/safe-subvec [1 2 3] 5)))
(t/is (nil? (d/safe-subvec [1 2 3] 0 5)))
@ -396,12 +398,19 @@
(t/is (= 0 (d/index-of-pred [1 2 3] odd?)))
(t/is (= 1 (d/index-of-pred [2 3 4] odd?)))
(t/is (nil? (d/index-of-pred [2 4 6] odd?)))
(t/is (nil? (d/index-of-pred [] odd?))))
(t/is (nil? (d/index-of-pred [] odd?)))
;; works correctly when collection contains nil elements
(t/is (= 2 (d/index-of-pred [nil nil 3] some?)))
(t/is (= 0 (d/index-of-pred [nil 1 2] nil?)))
;; works correctly when collection contains false elements
(t/is (= 1 (d/index-of-pred [false true false] true?))))
(t/deftest index-of-test
(t/is (= 0 (d/index-of [:a :b :c] :a)))
(t/is (= 2 (d/index-of [:a :b :c] :c)))
(t/is (nil? (d/index-of [:a :b :c] :z))))
(t/is (nil? (d/index-of [:a :b :c] :z)))
;; works when searching for nil in a collection
(t/is (= 1 (d/index-of [:a nil :c] nil))))
(t/deftest replace-by-id-test
(let [items [{:id 1 :v "a"} {:id 2 :v "b"} {:id 3 :v "c"}]
@ -469,6 +478,8 @@
(t/is (= {:a {:x 10 :y 2}} (d/patch-object {:a {:x 1 :y 2}} {:a {:x 10}})))
;; nested nil removes nested key
(t/is (= {:a {:y 2}} (d/patch-object {:a {:x 1 :y 2}} {:a {:x nil}})))
;; nil value removes only the specified key, not other keys
(t/is (= {nil 0 :b 2} (d/patch-object {nil 0 :a 1 :b 2} {:a nil})))
;; transducer arity (1-arg returns a fn)
(let [f (d/patch-object {:a 99})]
(t/is (= {:a 99 :b 2} (f {:a 1 :b 2})))))
@ -560,33 +571,33 @@
(into [] (d/distinct-xf :id) [{:id 1 :v "a"} {:id 2 :v "x"} {:id 2 :v "b"}]))))
(t/deftest deep-mapm-test
;; Note: mfn is called twice on leaf entries (once initially, once again
;; after checking if the value is a map/vector), so a doubling fn applied
;; to value 1 gives 1*2*2=4.
(t/is (= {:a 4 :b {:c 8}}
;; mfn is applied once per entry
(t/is (= {:a 2 :b {:c 4}}
(d/deep-mapm (fn [[k v]] [k (if (number? v) (* v 2) v)])
{:a 1 :b {:c 2}})))
;; Keyword renaming: keys are also transformed — and applied twice.
;; Use an idempotent key transformation (uppercase once = uppercase twice).
;; Keyword renaming: keys are transformed once per entry
(let [result (d/deep-mapm (fn [[k v]] [(keyword (str (name k) "!")) v])
{:a 1})]
(t/is (contains? result (keyword "a!!")))))
(t/is (contains? result (keyword "a!"))))
;; Vectors inside maps are recursed into
(t/is (= {:items [{:x 10}]}
(d/deep-mapm (fn [[k v]] [k (if (number? v) (* v 10) v)])
{:items [{:x 1}]})))
;; Plain scalar at top level map
(t/is (= {:a "hello"} (d/deep-mapm identity {:a "hello"}))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Numeric helpers
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(t/deftest nan-test
;; Note: nan? behaves differently per platform:
;; - CLJS: uses js/isNaN, returns true for ##NaN
;; - CLJ: uses (not= v v); Clojure's = uses .equals on doubles,
;; so (= ##NaN ##NaN) is true and nan? returns false for ##NaN.
;; Either way, nan? returns false for regular numbers and nil.
(t/is (d/nan? ##NaN))
(t/is (not (d/nan? 0)))
(t/is (not (d/nan? 1)))
(t/is (not (d/nan? nil)))
;; Platform-specific: JS nan? correctly detects NaN
#?(:cljs (t/is (d/nan? ##NaN))))
;; CLJS js/isNaN coerces non-numbers; JVM Double/isNaN is number-only
#?(:cljs (t/is (d/nan? "hello")))
#?(:clj (t/is (not (d/nan? "hello")))))
(t/deftest safe-plus-test
(t/is (= 5 (d/safe+ 3 2)))
@ -630,18 +641,13 @@
(t/is (nil? (d/parse-uuid nil))))
(t/deftest coalesce-str-test
;; On JVM: nan? uses (not= v v), which is false for all normal values.
;; On CLJS: nan? uses js/isNaN, which is true for non-numeric strings.
;; coalesce-str returns default when value is nil or nan?.
(t/is (= "default" (d/coalesce-str nil "default")))
;; Numbers always stringify on both platforms
(t/is (= "42" (d/coalesce-str 42 "default")))
;; ##NaN: nan? is true in CLJS, returns default;
;; nan? is false in CLJ, so str(##NaN)="NaN" is returned.
#?(:cljs (t/is (= "default" (d/coalesce-str ##NaN "default"))))
#?(:clj (t/is (= "NaN" (d/coalesce-str ##NaN "default"))))
;; ##NaN returns default on both platforms now that nan? is fixed on JVM
(t/is (= "default" (d/coalesce-str ##NaN "default")))
;; Strings: in CLJS js/isNaN("hello")=true so "default" is returned;
;; in CLJ nan? is false so (str "hello")="hello" is returned.
;; in CLJ nan? is false for strings so (str "hello")="hello" is returned.
#?(:cljs (t/is (= "default" (d/coalesce-str "hello" "default"))))
#?(:clj (t/is (= "hello" (d/coalesce-str "hello" "default")))))
@ -803,7 +809,8 @@
(t/deftest append-class-test
(t/is (= "foo bar" (d/append-class "foo" "bar")))
(t/is (= "bar" (d/append-class nil "bar")))
(t/is (= " bar" (d/append-class "" "bar"))))
;; empty string is treated like nil — no leading space
(t/is (= "bar" (d/append-class "" "bar"))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Additional helpers (5th batch)
@ -852,6 +859,9 @@
(t/is (d/num-string? "-7"))
(t/is (not (d/num-string? "hello")))
(t/is (not (d/num-string? nil)))
;; non-string types always return false
(t/is (not (d/num-string? 42)))
(t/is (not (d/num-string? :keyword)))
;; In CLJS, js/isNaN("") → false (empty string coerces to 0), so "" is numeric
#?(:clj (t/is (not (d/num-string? ""))))
#?(:cljs (t/is (d/num-string? ""))))

View File

@ -0,0 +1,72 @@
;; 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
(ns common-tests.files-builder-test
(:require
[app.common.files.builder :as fb]
[app.common.uuid :as uuid]
[clojure.test :as t]))
(defn- stroke
[color]
[{:stroke-style :solid
:stroke-alignment :inner
:stroke-width 1
:stroke-color color
:stroke-opacity 1}])
(t/deftest add-bool-uses-difference-head-style
(let [file-id (uuid/next)
page-id (uuid/next)
group-id (uuid/next)
child-a (uuid/next)
child-b (uuid/next)
state (-> (fb/create-state)
(fb/add-file {:id file-id :name "Test file"})
(fb/add-page {:id page-id :name "Page 1"})
(fb/add-group {:id group-id :name "Group A"})
(fb/add-shape {:id child-a
:type :rect
:name "A"
:x 0
:y 0
:width 10
:height 10
:strokes (stroke "#ff0000")})
(fb/add-shape {:id child-b
:type :rect
:name "B"
:x 20
:y 0
:width 10
:height 10
:strokes (stroke "#00ff00")})
(fb/close-group)
(fb/add-bool {:group-id group-id
:type :difference}))
bool (fb/get-shape state group-id)]
(t/is (= :bool (:type bool)))
(t/is (= (stroke "#ff0000") (:strokes bool)))))
(t/deftest add-file-media-validates-and-persists-media
(let [file-id (uuid/next)
page-id (uuid/next)
image-id (uuid/next)
state (-> (fb/create-state)
(fb/add-file {:id file-id :name "Test file"})
(fb/add-page {:id page-id :name "Page 1"})
(fb/add-file-media {:id image-id
:name "Image"
:width 128
:height 64}
(fb/map->BlobWrapper {:mtype "image/png"
:size 42
:blob nil})))
media (get-in state [::fb/file-media image-id])]
(t/is (= image-id (::fb/last-id state)))
(t/is (= "Image" (:name media)))
(t/is (= 128 (:width media)))
(t/is (= 64 (:height media)))))

View File

@ -11,6 +11,7 @@
[common-tests.buffer-test]
[common-tests.colors-test]
[common-tests.data-test]
[common-tests.files-builder-test]
[common-tests.files-changes-test]
[common-tests.files-migrations-test]
[common-tests.geom-align-test]
@ -58,6 +59,7 @@
[common-tests.text-test]
[common-tests.time-test]
[common-tests.types.absorb-assets-test]
[common-tests.types.color-test]
[common-tests.types.components-test]
[common-tests.types.container-test]
[common-tests.types.fill-test]
@ -88,6 +90,7 @@
'common-tests.data-test
#?(:clj 'common-tests.fressian-test)
'common-tests.files-changes-test
'common-tests.files-builder-test
'common-tests.files-migrations-test
'common-tests.geom-align-test
'common-tests.geom-bounds-map-test
@ -134,6 +137,7 @@
'common-tests.text-test
'common-tests.time-test
'common-tests.types.absorb-assets-test
'common-tests.types.color-test
'common-tests.types.components-test
'common-tests.types.container-test
'common-tests.types.fill-test

View File

@ -0,0 +1,166 @@
;; 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
(ns common-tests.types.color-test
(:require
[app.common.math :as mth]
[app.common.types.color :as colors]
[clojure.test :as t]))
;; --- Predicates
(t/deftest valid-hex-color
(t/is (false? (colors/valid-hex-color? nil)))
(t/is (false? (colors/valid-hex-color? "")))
(t/is (false? (colors/valid-hex-color? "#")))
(t/is (false? (colors/valid-hex-color? "#qqqqqq")))
(t/is (true? (colors/valid-hex-color? "#aaa")))
(t/is (false? (colors/valid-hex-color? "#aaaa")))
(t/is (true? (colors/valid-hex-color? "#fabada"))))
(t/deftest valid-rgb-color
(t/is (false? (colors/valid-rgb-color? nil)))
(t/is (false? (colors/valid-rgb-color? "")))
(t/is (false? (colors/valid-rgb-color? "()")))
(t/is (true? (colors/valid-rgb-color? "(255, 30, 30)")))
(t/is (true? (colors/valid-rgb-color? "rgb(255, 30, 30)"))))
;; --- Conversions
(t/deftest rgb-to-str
(t/is (= "rgb(1,2,3)" (colors/rgb->str [1 2 3])))
(t/is (= "rgba(1,2,3,4)" (colors/rgb->str [1 2 3 4]))))
(t/deftest rgb-to-hsv
(t/is (= [210.0 0.6666666666666666 3.0] (colors/rgb->hsv [1.0 2.0 3.0]))))
(t/deftest hsv-to-rgb
(t/is (= [1 2 3]
(colors/hsv->rgb [210 0.6666666666666666 3]))))
(t/deftest rgb-to-hex
(t/is (= "#010203" (colors/rgb->hex [1 2 3]))))
(t/deftest hex-to-rgb
(t/is (= [0 0 0] (colors/hex->rgb "#kkk")))
(t/is (= [1 2 3] (colors/hex->rgb "#010203"))))
(t/deftest format-hsla
(t/is (= "210, 50%, 0.78%, 1" (colors/format-hsla [210.0 0.5 0.00784313725490196 1])))
(t/is (= "220, 5%, 30%, 0.8" (colors/format-hsla [220.0 0.05 0.3 0.8]))))
(t/deftest format-rgba
(t/is (= "210, 199, 12, 0.08" (colors/format-rgba [210 199 12 0.08])))
(t/is (= "210, 199, 12, 1" (colors/format-rgba [210 199 12 1]))))
(t/deftest rgb-to-hsl
(t/is (= [210.0 0.5 0.00784313725490196] (colors/rgb->hsl [1 2 3]))))
(t/deftest hsl-to-rgb
(t/is (= [1 2 3] (colors/hsl->rgb [210.0 0.5 0.00784313725490196])))
(t/is (= [210.0 0.5 0.00784313725490196] (colors/rgb->hsl [1 2 3]))))
(t/deftest expand-hex
(t/is (= "aaaaaa" (colors/expand-hex "a")))
(t/is (= "aaaaaa" (colors/expand-hex "aa")))
(t/is (= "aaaaaa" (colors/expand-hex "aaa")))
(t/is (= "aaaa" (colors/expand-hex "aaaa"))))
(t/deftest prepend-hash
(t/is "#aaa" (colors/prepend-hash "aaa"))
(t/is "#aaa" (colors/prepend-hash "#aaa")))
(t/deftest remove-hash
(t/is "aaa" (colors/remove-hash "aaa"))
(t/is "aaa" (colors/remove-hash "#aaa")))
(t/deftest color-string-pred
(t/is (true? (colors/color-string? "#aaa")))
(t/is (true? (colors/color-string? "(10,10,10)")))
(t/is (true? (colors/color-string? "rgb(10,10,10)")))
(t/is (true? (colors/color-string? "magenta")))
(t/is (false? (colors/color-string? nil)))
(t/is (false? (colors/color-string? "")))
(t/is (false? (colors/color-string? "kkkkkk"))))
;; --- Gradient helpers
(t/deftest interpolate-color
(t/testing "at c1 offset returns c1 color"
(let [c1 {:color "#000000" :opacity 0.0 :offset 0.0}
c2 {:color "#ffffff" :opacity 1.0 :offset 1.0}
result (colors/interpolate-color c1 c2 0.0)]
(t/is (= "#000000" (:color result)))
(t/is (= 0.0 (:opacity result)))))
(t/testing "at c2 offset returns c2 color"
(let [c1 {:color "#000000" :opacity 0.0 :offset 0.0}
c2 {:color "#ffffff" :opacity 1.0 :offset 1.0}
result (colors/interpolate-color c1 c2 1.0)]
(t/is (= "#ffffff" (:color result)))
(t/is (= 1.0 (:opacity result)))))
(t/testing "at midpoint returns interpolated gray"
(let [c1 {:color "#000000" :opacity 0.0 :offset 0.0}
c2 {:color "#ffffff" :opacity 1.0 :offset 1.0}
result (colors/interpolate-color c1 c2 0.5)]
(t/is (= "#7f7f7f" (:color result)))
(t/is (mth/close? (:opacity result) 0.5)))))
(t/deftest uniform-spread
(t/testing "produces correct count and offsets"
(let [c1 {:color "#000000" :opacity 0.0 :offset 0.0}
c2 {:color "#ffffff" :opacity 1.0 :offset 1.0}
stops (colors/uniform-spread c1 c2 3)]
(t/is (= 3 (count stops)))
(t/is (= 0.0 (:offset (first stops))))
(t/is (mth/close? 0.5 (:offset (second stops))))
(t/is (= 1.0 (:offset (last stops))))))
(t/testing "single stop returns a vector of one element (no division by zero)"
(let [c1 {:color "#ff0000" :opacity 1.0 :offset 0.0}
stops (colors/uniform-spread c1 c1 1)]
(t/is (= 1 (count stops))))))
(t/deftest uniform-spread?
(t/testing "uniformly spread stops are detected as uniform"
(let [c1 {:color "#000000" :opacity 0.0 :offset 0.0}
c2 {:color "#ffffff" :opacity 1.0 :offset 1.0}
stops (colors/uniform-spread c1 c2 3)]
(t/is (true? (colors/uniform-spread? stops)))))
(t/testing "two-stop gradient is uniform by definition"
(let [stops [{:color "#ff0000" :opacity 1.0 :offset 0.0}
{:color "#0000ff" :opacity 1.0 :offset 1.0}]]
(t/is (true? (colors/uniform-spread? stops)))))
(t/testing "stops with wrong offset are not uniform"
(let [stops [{:color "#000000" :opacity 0.0 :offset 0.0}
{:color "#888888" :opacity 0.5 :offset 0.3}
{:color "#ffffff" :opacity 1.0 :offset 1.0}]]
(t/is (false? (colors/uniform-spread? stops)))))
(t/testing "stops with correct offset but wrong color are not uniform"
(let [stops [{:color "#000000" :opacity 0.0 :offset 0.0}
{:color "#aaaaaa" :opacity 0.5 :offset 0.5}
{:color "#ffffff" :opacity 1.0 :offset 1.0}]]
(t/is (false? (colors/uniform-spread? stops))))))
(t/deftest interpolate-gradient
(t/testing "at start offset returns first stop color"
(let [stops [{:color "#000000" :opacity 0.0 :offset 0.0}
{:color "#ffffff" :opacity 1.0 :offset 1.0}]
result (colors/interpolate-gradient stops 0.0)]
(t/is (= "#000000" (:color result)))))
(t/testing "at end offset returns last stop color"
(let [stops [{:color "#000000" :opacity 0.0 :offset 0.0}
{:color "#ffffff" :opacity 1.0 :offset 1.0}]
result (colors/interpolate-gradient stops 1.0)]
(t/is (= "#ffffff" (:color result)))))
(t/testing "at midpoint returns interpolated gray"
(let [stops [{:color "#000000" :opacity 0.0 :offset 0.0}
{:color "#ffffff" :opacity 1.0 :offset 1.0}]
result (colors/interpolate-gradient stops 0.5)]
(t/is (= "#7f7f7f" (:color result)))))
(t/testing "offset beyond last stop returns last stop color (nil idx guard)"
(let [stops [{:color "#000000" :opacity 0.0 :offset 0.0}
{:color "#ffffff" :opacity 1.0 :offset 0.5}]
result (colors/interpolate-gradient stops 1.0)]
(t/is (= "#ffffff" (:color result))))))

View File

@ -207,3 +207,18 @@
fill1 (nth fills1 1)]
(t/is (nil? fill1))
(t/is (equivalent-fill? fill0 sample-fill-6))))
(t/deftest indexed-access-with-default
(t/testing "nth with default returns fill for valid index"
;; Regression: CLJS -nth with default had reversed d/in-range? args,
;; so it always fell through to the default even for valid indices.
(let [fills (types.fills/from-plain [sample-fill-6])
sentinel ::not-found
result (nth fills 0 sentinel)]
(t/is (not= sentinel result))
(t/is (equivalent-fill? result sample-fill-6))))
(t/testing "nth with default returns default for out-of-range index"
(let [fills (types.fills/from-plain [sample-fill-6])
sentinel ::not-found]
(t/is (= sentinel (nth fills 1 sentinel)))
(t/is (= sentinel (nth fills -1 sentinel))))))

View File

@ -973,6 +973,31 @@
(t/is (mth/close? 10.0 (:x2 rect) 0.1))
(t/is (mth/close? 10.0 (:y2 rect) 0.1))))
(t/deftest segment-content->selrect-multi-line
;; Regression: calculate-extremities used move-p instead of from-p in
;; the :line-to branch. For a subpath with multiple consecutive line-to
;; commands, the selrect must still match the reference implementation.
(let [;; A subpath that starts away from the origin and has three
;; line-to segments so that move-p diverges from from-p for the
;; later segments.
segments [{:command :move-to :params {:x 5.0 :y 5.0}}
{:command :line-to :params {:x 15.0 :y 0.0}}
{:command :line-to :params {:x 20.0 :y 8.0}}
{:command :line-to :params {:x 10.0 :y 12.0}}]
content (path/content segments)
rect (path.segment/content->selrect content)
ref-pts (calculate-extremities segments)]
;; Bounding box must enclose all four vertices exactly.
(t/is (some? rect))
(t/is (mth/close? 5.0 (:x1 rect) 0.1))
(t/is (mth/close? 0.0 (:y1 rect) 0.1))
(t/is (mth/close? 20.0 (:x2 rect) 0.1))
(t/is (mth/close? 12.0 (:y2 rect) 0.1))
;; Must agree with the reference implementation.
(t/is (= ref-pts (calculate-extremities content)))))
(t/deftest segment-content-center
(let [content (path/content sample-content-square)
center (path.segment/content-center content)]

View File

@ -186,13 +186,9 @@
flex (make-flex-frame :parent-id root-id)
child (make-shape :parent-id (:id flex))]
;; Note: inside-layout? calls (cfh/frame-shape? current-id) with a UUID id,
;; but frame-shape? checks (:type uuid) which is nil for a UUID value.
;; The function therefore always returns false regardless of structure.
;; These tests document the actual (not the intended) behavior.
(t/testing "returns false when child is under a flex frame"
(t/testing "returns true when child is under a flex frame"
(let [objects {root-id root (:id flex) flex (:id child) child}]
(t/is (not (layout/inside-layout? objects child)))))
(t/is (layout/inside-layout? objects child))))
(t/testing "returns false for root shape"
(let [objects {root-id root (:id flex) flex (:id child) child}]

View File

@ -1930,7 +1930,7 @@
(let [token (ctob/get-token-by-name lib "shadow-test" "test.shadow-with-type")]
(t/is (some? token))
(t/is (= :shadow (:type token)))
(t/is (= [{:offset-x "0", :offset-y "4px", :blur "8px", :spread "0", :color "rgba(0,0,0,0.2)", :inset false}]
(t/is (= [{:offset-x "0", :offset-y "4px", :blur "8px", :spread "0", :color "rgba(0,0,0,0.2)", :inset true}]
(:value token)))))
(t/testing "shadow token with description"

View File

@ -203,6 +203,11 @@
(let [f (obj/get global "externalContextInfo")]
(when (fn? f) (f))))
(defn external-notify-register-success
[profile-id]
(let [f (obj/get global "externalNotifyRegisterSuccess")]
(when (fn? f) (f (str profile-id)))))
(defn initialize-external-context-info
[]
(let [f (obj/get global "initializeExternalConfigInfo")]

View File

@ -204,7 +204,7 @@
(watch [_ state _]
(let [route (:route state)
qparams (:query-params route)
index (some-> (:index qparams) parse-long)
index (some-> (rt/get-query-param qparams :index) parse-long)
frame-id (some-> (:frame-id qparams) uuid/parse)]
(rx/merge
(rx/of (case (:zoom qparams)
@ -301,7 +301,7 @@
(update [_ state]
(let [params (rt/get-params state)
page-id (some-> (:page-id params) uuid/parse)
index (some-> (:index params) parse-long)
index (some-> (rt/get-query-param params :index) parse-long)
frames (dm/get-in state [:viewer :pages page-id :frames])
index (min (or index 0) (max 0 (dec (count frames))))
@ -325,7 +325,7 @@
(let [params (rt/get-params state)
page-id (some-> (:page-id params) uuid/parse)
index (some-> (:index params) parse-long)
index (some-> (rt/get-query-param params :index) parse-long)
frames (dm/get-in state [:viewer :pages page-id :frames])
index (min (or index 0) (max 0 (dec (count frames))))
@ -399,7 +399,7 @@
ptk/WatchEvent
(watch [_ state _]
(let [params (rt/get-params state)
index (some-> params :index parse-long)]
index (some-> (rt/get-query-param params :index) parse-long)]
(when (pos? index)
(rx/of
(dcmt/close-thread)
@ -415,7 +415,7 @@
ptk/WatchEvent
(watch [_ state _]
(let [params (rt/get-params state)
index (some-> params :index parse-long)
index (some-> (rt/get-query-param params :index) parse-long)
page-id (some-> params :page-id uuid/parse)
total (count (get-in state [:viewer :pages page-id :frames]))]
@ -530,7 +530,7 @@
(let [route (:route state)
qparams (:query-params route)
page-id (some-> (:page-id qparams) uuid/parse)
index (some-> (:index qparams) parse-long)
index (some-> (rt/get-query-param qparams :index) parse-long)
frames (get-in state [:viewer :pages page-id :frames])
frame (get frames index)]
(cond-> state
@ -744,7 +744,7 @@
(let [route (:route state)
qparams (:query-params route)
page-id (some-> (:page-id qparams) uuid/parse)
index (some-> (:index qparams) parse-long)
index (some-> (rt/get-query-param qparams :index) parse-long)
objects (get-in state [:viewer :pages page-id :objects])
frame-id (get-in state [:viewer :pages page-id :frames index :id])

View File

@ -43,6 +43,12 @@
[_]
false)
;; Re-entrancy guard: prevents on-error from calling itself recursively.
;; If an error occurs while we are already handling an error (e.g. the
;; notification emit itself throws), we log it and bail out immediately
;; instead of recursing until the call-stack overflows.
(def ^:private handling-error? (volatile! false))
;; --- Stale-asset error detection and auto-reload
;;
;; When the browser loads JS modules from different builds (e.g. shared.js from
@ -90,12 +96,24 @@
(assoc ::trace (.-stack cause)))))
(defn on-error
"A general purpose error handler."
"A general purpose error handler.
Protected by a re-entrancy guard: if an error is raised while this
function is already on the call stack (e.g. the notification emit
itself fails), we print it to the console and return immediately
instead of recursing until the call-stack is exhausted."
[error]
(if (map? error)
(ptk/handle-error error)
(let [data (exception->error-data error)]
(ptk/handle-error data))))
(if @handling-error?
(.error js/console "[on-error] re-entrant call suppressed" error)
(do
(vreset! handling-error? true)
(try
(if (map? error)
(ptk/handle-error error)
(let [data (exception->error-data error)]
(ptk/handle-error data)))
(finally
(vreset! handling-error? false))))))
;; Inject dependency to remove circular dependency
(set! app.main.worker/on-error on-error)
@ -148,7 +166,14 @@
:report report}))))
(defn flash
"Show error notification banner and emit error report"
"Show error notification banner and emit error report.
The notification is scheduled asynchronously (via tm/schedule) to
avoid pushing a new event into the potok store while the store's own
error-handling pipeline is still on the call stack. Emitting
synchronously from inside an error handler creates a re-entrant
event-processing cycle that can exhaust the JS call stack
(RangeError: Maximum call stack size exceeded)."
[& {:keys [type hint cause] :or {type :handled}}]
(when (ex/exception? cause)
(when-let [event-name (case type
@ -160,11 +185,12 @@
:report report
:hint (ex/get-hint cause)))))
(st/emit!
(ntf/show {:content (or ^boolean hint (tr "errors.generic"))
:type :toast
:level :error
:timeout 5000})))
(ts/schedule
#(st/emit!
(ntf/show {:content (or ^boolean hint (tr "errors.generic"))
:type :toast
:level :error
:timeout 5000}))))
(defmethod ptk/handle-error :network
[error]

View File

@ -136,6 +136,16 @@
[state]
(dm/get-in state [:route :params :query]))
(defn get-query-param
"Safely extracts a scalar value for a query param key from a params
map. When the same key appears multiple times in a URL,
query-string->map returns a vector for that key; this function
always returns a single (last) element in that case, so downstream
consumers such as parse-long always receive a plain string or nil."
[params k]
(let [v (get params k)]
(if (sequential? v) (peek v) v)))
(defn nav-back
[]
(ptk/reify ::nav-back

View File

@ -277,7 +277,7 @@
:viewer
(let [params (get params :query)
index (some-> (:index params) parse-long)
index (some-> (rt/get-query-param params :index) parse-long)
share-id (some-> (:share-id params) uuid/parse*)
section (or (some-> (:section params) keyword)
:interactions)

View File

@ -276,6 +276,7 @@
(mf/use-fn
(mf/deps on-success-callback)
(fn [params]
(cf/external-notify-register-success (:id params))
(if (fn? on-success-callback)
(on-success-callback (:email params))

View File

@ -6,6 +6,7 @@
(ns app.main.ui.auth.verify-token
(:require
[app.config :as cf]
[app.main.data.auth :as da]
[app.main.data.common :as dcm]
[app.main.data.notifications :as ntf]
@ -25,6 +26,7 @@
(defmethod handle-token :verify-email
[data]
(cf/external-notify-register-success (:profile-id data))
(let [msg (tr "dashboard.notifications.email-verified-successfully")]
(ts/schedule 1000 #(st/emit! (ntf/success msg)))
(st/emit! (da/login-from-token data))))

View File

@ -78,7 +78,8 @@
current-team (get teams current-team-id)
other-teams (remove #(= (:id %) current-team-id) (vals teams))
current-projects (remove #(= (:id %) (:project-id file))
file-project-ids (into #{} (map :project-id) files)
current-projects (remove #(contains? file-project-ids (:id %))
(:projects current-team))
on-new-tab

View File

@ -160,7 +160,7 @@
tooltip-ref (mf/use-ref nil)
container (hooks/use-portal-container)
container (hooks/use-portal-container :tooltip)
id
(d/nilv id internal-id)

View File

@ -380,17 +380,35 @@
state))
(defn- get-or-create-portal-container
"Returns the singleton container div for the given category, creating
and appending it to document.body on first access."
[category]
(let [body (dom/get-body)
id (str "portal-container-" category)]
(or (dom/query body (str "#" id))
(let [container (dom/create-element "div")]
(dom/set-attribute! container "id" id)
(dom/append-child! body container)
container))))
(defn use-portal-container
"Creates a dedicated div container for React portals. The container
is appended to document.body on mount and removed on cleanup, preventing
removeChild race conditions when multiple portals target the same body."
[]
(let [container (mf/use-memo #(dom/create-element "div"))]
(mf/with-effect []
(let [body (dom/get-body)]
(dom/append-child! body container)
#(dom/remove-child! body container)))
container))
"Returns a shared singleton container div for React portals, identified
by a logical category. Available categories:
:modal — modal dialogs
:popup — popups, dropdowns, context menus
:tooltip — tooltips
:default — general portal use (default)
All portals in the same category share one <div> on document.body,
keeping the DOM clean and avoiding removeChild race conditions."
([]
(use-portal-container :default))
([category]
(let [category (name category)]
(mf/with-memo [category]
(get-or-create-portal-container category)))))
(defn use-dynamic-grid-item-width
([] (use-dynamic-grid-item-width nil))

View File

@ -84,7 +84,7 @@
(mf/defc modal-container*
{::mf/props :obj}
[]
(let [container (hooks/use-portal-container)]
(let [container (hooks/use-portal-container :modal)]
(when-let [modal (mf/deref ref:modal)]
(mf/portal
(mf/html [:> modal-wrapper* {:data modal :key (dm/str (:id modal))}])

View File

@ -517,7 +517,7 @@
dropdown-direction-change* (mf/use-ref 0)
top (+ (get-in mdata [:position :y]) 5)
left (+ (get-in mdata [:position :x]) 5)
container (hooks/use-portal-container)]
container (hooks/use-portal-container :popup)]
(mf/use-effect
(mf/deps is-open?)

View File

@ -36,7 +36,7 @@
dropdown-direction-change* (mf/use-ref 0)
top (+ (get-in mdata [:position :y]) 5)
left (+ (get-in mdata [:position :x]) 5)
container (hooks/use-portal-container)
container (hooks/use-portal-container :popup)
delete-node (mf/use-fn
(mf/deps mdata)

View File

@ -114,7 +114,7 @@
:is-open? true
:rect rect))))))
container (hooks/use-portal-container)]
container (hooks/use-portal-container :popup)]
[:div {:on-click on-open-dropdown
:disabled (not can-edit?)

View File

@ -0,0 +1,136 @@
;; 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
(ns frontend-tests.main-errors-test
"Unit tests for app.main.errors.
Tests cover:
- stale-asset-error? pure predicate
- exception->error-data pure transformer
- on-error re-entrancy guard prevents recursive invocations
- flash schedules async emit ntf/show is not emitted synchronously"
(:require
[app.main.errors :as errors]
[cljs.test :as t :include-macros true]
[potok.v2.core :as ptk]))
;; ---------------------------------------------------------------------------
;; stale-asset-error?
;; ---------------------------------------------------------------------------
(t/deftest stale-asset-error-nil
(t/testing "nil cause returns nil/falsy"
(t/is (not (errors/stale-asset-error? nil)))))
(t/deftest stale-asset-error-keyword-cst-undefined
(t/testing "error with $cljs$cst$ and 'is undefined' is recognised"
(let [err (js/Error. "foo$cljs$cst$bar is undefined")]
(t/is (true? (boolean (errors/stale-asset-error? err)))))))
(t/deftest stale-asset-error-keyword-cst-null
(t/testing "error with $cljs$cst$ and 'is null' is recognised"
(let [err (js/Error. "foo$cljs$cst$bar is null")]
(t/is (true? (boolean (errors/stale-asset-error? err)))))))
(t/deftest stale-asset-error-protocol-dispatch-undefined
(t/testing "error with $cljs$core$I and 'Cannot read properties of undefined' is recognised"
(let [err (js/Error. "Cannot read properties of undefined (reading '$cljs$core$IFn$_invoke$arity$1$')")]
(t/is (true? (boolean (errors/stale-asset-error? err)))))))
(t/deftest stale-asset-error-not-a-function
(t/testing "error with $cljs$cst$ and 'is not a function' is recognised"
(let [err (js/Error. "foo$cljs$cst$bar is not a function")]
(t/is (true? (boolean (errors/stale-asset-error? err)))))))
(t/deftest stale-asset-error-unrelated-message
(t/testing "ordinary error without stale-asset signature is NOT recognised"
(let [err (js/Error. "Cannot read properties of undefined (reading 'foo')")]
(t/is (not (errors/stale-asset-error? err))))))
(t/deftest stale-asset-error-only-cst-no-undefined
(t/testing "error with $cljs$cst$ but no undefined/null/not-a-function keyword is not recognised"
(let [err (js/Error. "foo$cljs$cst$bar exploded")]
(t/is (not (errors/stale-asset-error? err))))))
;; ---------------------------------------------------------------------------
;; exception->error-data
;; ---------------------------------------------------------------------------
(t/deftest exception->error-data-plain-error
(t/testing "plain JS Error is converted to a data map with :hint and ::instance"
(let [err (js/Error. "something went wrong")
data (errors/exception->error-data err)]
(t/is (= "something went wrong" (:hint data)))
(t/is (identical? err (::errors/instance data))))))
(t/deftest exception->error-data-ex-info
(t/testing "ex-info error preserves existing :hint and attaches ::instance"
(let [err (ex-info "original" {:hint "my-hint" :type :network})
data (errors/exception->error-data err)]
(t/is (= "my-hint" (:hint data)))
(t/is (= :network (:type data)))
(t/is (identical? err (::errors/instance data))))))
(t/deftest exception->error-data-ex-info-no-hint
(t/testing "ex-info without :hint falls back to ex-message"
(let [err (ex-info "fallback message" {:type :validation})
data (errors/exception->error-data err)]
(t/is (= "fallback message" (:hint data))))))
;; ---------------------------------------------------------------------------
;; on-error dispatches to ptk/handle-error
;;
;; We use a dedicated test-only error type so we can add/remove a
;; defmethod without touching the real handlers.
;; ---------------------------------------------------------------------------
(def ^:private test-handled (atom nil))
(defmethod ptk/handle-error ::test-dispatch
[err]
(reset! test-handled err))
(t/deftest on-error-dispatches-map-error
(t/testing "on-error dispatches a map error to ptk/handle-error using its :type"
(reset! test-handled nil)
(errors/on-error {:type ::test-dispatch :hint "hello"})
(t/is (= ::test-dispatch (:type @test-handled)))
(t/is (= "hello" (:hint @test-handled)))))
(t/deftest on-error-wraps-exception-then-dispatches
(t/testing "on-error wraps a JS Error into error-data before dispatching"
(reset! test-handled nil)
(let [err (ex-info "wrapped" {:type ::test-dispatch})]
(errors/on-error err)
(t/is (= ::test-dispatch (:type @test-handled)))
(t/is (identical? err (::errors/instance @test-handled))))))
;; ---------------------------------------------------------------------------
;; on-error re-entrancy guard
;;
;; The guard is implemented via the `handling-error?` volatile inside
;; app.main.errors. We can verify its effect by registering a
;; handle-error method that itself calls on-error and checking that
;; only one invocation gets through.
;; ---------------------------------------------------------------------------
(def ^:private reentrant-call-count (atom 0))
(defmethod ptk/handle-error ::test-reentrant
[_err]
(swap! reentrant-call-count inc)
;; Simulate a secondary error inside the error handler
;; (e.g. the notification emit itself throws).
;; Without the re-entrancy guard this would recurse indefinitely.
(when (= 1 @reentrant-call-count)
(errors/on-error {:type ::test-reentrant :hint "secondary"})))
(t/deftest on-error-reentrancy-guard-prevents-recursion
(t/testing "a second on-error call while handling an error is suppressed by the guard"
(reset! reentrant-call-count 0)
(errors/on-error {:type ::test-reentrant :hint "first"})
;; The guard must have allowed only the first invocation through.
(t/is (= 1 @reentrant-call-count))))

View File

@ -14,6 +14,7 @@
[frontend-tests.logic.frame-guides-test]
[frontend-tests.logic.groups-test]
[frontend-tests.logic.pasting-in-containers-test]
[frontend-tests.main-errors-test]
[frontend-tests.plugins.context-shapes-test]
[frontend-tests.svg-fills-test]
[frontend-tests.tokens.import-export-test]
@ -41,6 +42,7 @@
(t/run-tests
'frontend-tests.basic-shapes-test
'frontend-tests.data.repo-test
'frontend-tests.main-errors-test
'frontend-tests.data.viewer-test
'frontend-tests.data.workspace-colors-test
'frontend-tests.data.workspace-texts-test