mirror of
https://github.com/penpot/penpot.git
synced 2026-11-09 19:41:34 +00:00
dc61fb8ff3
Keep bounded content and selection history within each editing session. Group committed compositions and styled insertions, omit IME previews, and reset history when external content changes the editing baseline. Route keyboard, workspace menu and browser history input to the editor. Restore UTF-16 selections through a new WASM binding, preserving styles, readings and paragraph settings without reaching earlier canvas edits. Verify 1,587 frontend tests, 671 renderer tests and both WASM builds. Add four editable showcase examples and verify them after reopening. AI-assisted-by: GPT-6
1971 lines
83 KiB
Clojure
1971 lines
83 KiB
Clojure
;; 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 SUBSIDIARY SL
|
|
|
|
(ns app.main.data.workspace.texts
|
|
(:require
|
|
["@penpot/text-editor" :as editor.v2]
|
|
[app.common.attrs :as attrs]
|
|
[app.common.data :as d]
|
|
[app.common.data.macros :as dm]
|
|
[app.common.exceptions :as ex]
|
|
[app.common.files.changes-builder :as pcb]
|
|
[app.common.files.helpers :as cfh]
|
|
[app.common.geom.point :as gpt]
|
|
[app.common.geom.rect :as grc]
|
|
[app.common.geom.shapes :as gsh]
|
|
[app.common.math :as mth]
|
|
[app.common.render-wasm.api.select :as wselect]
|
|
[app.common.transit :as t]
|
|
[app.common.types.fills :as types.fills]
|
|
[app.common.types.modifiers :as ctm]
|
|
[app.common.types.shape.layout :as ctl]
|
|
[app.common.types.shape.text :as cts]
|
|
[app.common.types.text :as txt]
|
|
[app.common.types.text.cjk-layout :as cjk]
|
|
[app.common.uuid :as uuid]
|
|
[app.main.data.changes :as dch]
|
|
[app.main.data.helpers :as dsh]
|
|
[app.main.data.notifications :as ntf]
|
|
[app.main.data.workspace :as-alias dw]
|
|
[app.main.data.workspace.common :as dwc]
|
|
[app.main.data.workspace.modifiers :as dwm]
|
|
[app.main.data.workspace.pages :as-alias dwpg]
|
|
[app.main.data.workspace.reflow :as wrf]
|
|
[app.main.data.workspace.selection :as dws]
|
|
[app.main.data.workspace.shapes :as dwsh]
|
|
[app.main.data.workspace.texts-v3 :as dwt-v3]
|
|
[app.main.data.workspace.transforms :as dwt]
|
|
[app.main.data.workspace.undo :as dwu]
|
|
[app.main.data.workspace.wasm-text :as dwwt]
|
|
[app.main.features :as features]
|
|
[app.main.fonts :as fonts]
|
|
[app.main.router :as rt]
|
|
[app.main.store :as st]
|
|
[app.render-wasm.api :as wasm.api]
|
|
[app.render-wasm.api.fonts :as wasm.fonts]
|
|
[app.render-wasm.text-editor :as wasm.text-editor]
|
|
[app.render-wasm.text-paste :as text-paste]
|
|
[app.util.clipboard :as clipboard]
|
|
[app.util.text-editor :as ted]
|
|
[app.util.text.clipboard :as text-clipboard]
|
|
[app.util.text.content :as tc]
|
|
[app.util.text.content.styles :as styles]
|
|
[app.util.timers :as ts]
|
|
[beicon.v2.core :as rx]
|
|
[cuerdas.core :as str]
|
|
[potok.v2.core :as ptk]))
|
|
|
|
;; -- V2 Editor Helpers
|
|
|
|
(def ^function create-root-from-string editor.v2/createRootFromString)
|
|
(def ^function create-root-from-html editor.v2/createRootFromHTML)
|
|
(def ^function create-editor editor.v2/create)
|
|
(def ^function set-editor-root! editor.v2/setRoot)
|
|
(def ^function get-editor-root editor.v2/getRoot)
|
|
(def ^function is-empty? editor.v2/isEmpty)
|
|
(def ^function dispose! editor.v2/dispose)
|
|
|
|
(declare v2-update-text-shape-content)
|
|
(declare v2-update-text-editor-styles)
|
|
(declare v2-sync-wasm-text-layout)
|
|
|
|
(defn- bridge-to-measurement
|
|
"Marks `ids` pending until the text pipeline marks its own work:
|
|
`:text-measure` in the DOM renderer, `:text-resize` in wasm. Emits nothing."
|
|
[ids]
|
|
(wrf/bridge-pending ids #{:text-measure :text-resize} :text-bridge))
|
|
|
|
(defn- page-finalize?
|
|
[event]
|
|
(= ::dwpg/finalize-page (ptk/type event)))
|
|
|
|
(defn- text-work-stopper
|
|
[stream]
|
|
(rx/filter
|
|
(fn [event]
|
|
(or (= ::dw/finalize-workspace (ptk/type event))
|
|
(page-finalize? event)))
|
|
stream))
|
|
|
|
(defn initialize-text-reflow
|
|
"Tracks the texts the DOM pipeline still has to re-measure, so a reflow wait
|
|
covers the measurement that resizes them."
|
|
[]
|
|
(ptk/reify ::initialize-text-reflow
|
|
ptk/WatchEvent
|
|
(watch [_ _ stream]
|
|
(let [stopper (rx/filter (ptk/type? ::finalize-text-reflow) stream)
|
|
page-stopper (rx/filter page-finalize? stream)]
|
|
(->> stream
|
|
(rx/filter (ptk/type? :text/reflow))
|
|
(rx/map deref)
|
|
(rx/merge-map
|
|
(fn [{:keys [ids]}]
|
|
(->> (bridge-to-measurement ids)
|
|
(rx/take-until page-stopper))))
|
|
(rx/take-until stopper))))))
|
|
|
|
(defn finalize-text-reflow
|
|
[]
|
|
(ptk/data-event ::finalize-text-reflow))
|
|
|
|
(defn- resolve-text-ids
|
|
"Returns the text shapes an attribute change on `id` applies to: `id` itself
|
|
when it is a text, its text descendants when it is a group. These are the
|
|
shapes that get re-measured, and so the ones the reflow waits track."
|
|
[objects id]
|
|
(let [shape (get objects id)]
|
|
(cond
|
|
(cfh/text-shape? shape)
|
|
[id]
|
|
|
|
(cfh/group-shape? shape)
|
|
(into [] (filter #(cfh/text-shape? (get objects %))) (cfh/get-children-ids objects id))
|
|
|
|
:else
|
|
[])))
|
|
|
|
(defn- await-font-faces
|
|
"Waits for missing WASM faces, then resizes the affected texts."
|
|
[stream face-keys ids]
|
|
(let [resize-opts {:stack-undo? true :undo-transation? false}
|
|
resize-stream (->> (rx/from ids) (rx/map #(dwwt/resize-wasm-text % resize-opts)))]
|
|
(if (empty? face-keys)
|
|
resize-stream
|
|
(->> (rx/merge wasm.fonts/font-stored-stream
|
|
wasm.fonts/font-storage-failed-stream)
|
|
(rx/filter face-keys)
|
|
(rx/scan disj face-keys)
|
|
(rx/filter empty?)
|
|
(rx/take 1)
|
|
(rx/take-until (text-work-stopper stream))
|
|
(rx/observe-on :async)
|
|
(rx/mapcat (constantly resize-stream))
|
|
(wrf/with-pending :font ids)))))
|
|
|
|
(defn- pending-font-faces
|
|
[ids]
|
|
(let [objects (dsh/lookup-page-objects @st/state)]
|
|
(into #{}
|
|
(comp
|
|
(map #(get objects %))
|
|
(keep :content)
|
|
(mapcat wasm.fonts/get-content-fonts)
|
|
(map wasm.fonts/make-font-data)
|
|
(remove wasm.fonts/font-ready?)
|
|
(map wasm.fonts/font-data-key))
|
|
ids)))
|
|
|
|
(defn- await-font-resize
|
|
"Waits for missing font faces, then resizes `ids`."
|
|
[stream ids]
|
|
(if (empty? ids)
|
|
(rx/empty)
|
|
(->> (rx/of ::await-fonts)
|
|
(rx/mapcat
|
|
(fn [_]
|
|
(await-font-faces stream (pending-font-faces ids) ids))))))
|
|
|
|
(defn- await-html-font
|
|
"Keeps legacy DOM text pending while its new font is loading. The DOM
|
|
measurement also awaits this promise, so the font task bridges the state
|
|
update to the renderer commit without relying on a fixed settle delay."
|
|
[stream font-id font-variant-id ids]
|
|
(if (or (nil? font-id) (empty? ids))
|
|
(rx/empty)
|
|
(->> (rx/of ::load-font)
|
|
;; `ensure-loaded!` is intentionally invoked after `with-pending`
|
|
;; subscribes, so even an immediately settled promise cannot create a
|
|
;; gap before the task is visible to waiters.
|
|
(rx/mapcat (fn [_]
|
|
(rx/from (fonts/ensure-loaded! font-id font-variant-id))))
|
|
(rx/take-until (text-work-stopper stream))
|
|
(rx/mapcat (fn [_]
|
|
(st/emit! (dwsh/update-shapes
|
|
ids
|
|
#(dissoc % :position-data)
|
|
{:save-undo? false}))
|
|
(rx/empty)))
|
|
(wrf/with-pending :font ids))))
|
|
|
|
;; -- Content helpers
|
|
|
|
;; Style attrs typed as `::sm/text` in the content schema (see
|
|
;; app.common.types.shape.text/schema:content): when the key is present its
|
|
;; value must be a non-blank string, so an explicit nil fails backend
|
|
;; `validate-shape`. `:key` is likewise a plain `:string`.
|
|
(def ^:private non-nilable-style-attrs
|
|
#{:font-family :font-size :font-style :font-weight
|
|
:direction :text-direction :text-decoration :text-transform :key})
|
|
|
|
(defn- remove-nil-style-attrs
|
|
"Strip nil-valued non-nilable style attrs from every node in a content tree.
|
|
Repairs content already corrupted with e.g. nil :font-family/:font-weight/
|
|
:font-style (from an unloaded font) so it can pass the backend schema again."
|
|
[content]
|
|
(txt/transform-nodes
|
|
(fn [node]
|
|
(reduce (fn [node k]
|
|
(if (and (contains? node k) (nil? (get node k)))
|
|
(dissoc node k)
|
|
node))
|
|
node
|
|
non-nilable-style-attrs))
|
|
content))
|
|
|
|
(defn ensure-valid-text-content
|
|
"Repair structurally incomplete text :content to a canonical
|
|
root -> paragraph-set -> paragraph -> span tree. Returns the
|
|
content unchanged when it is already well-formed.
|
|
|
|
A `nil` content, a root with no :children, or a root with an empty
|
|
:children vector all fail the backend `validate-shape` schema
|
|
(children must contain at least one paragraph-set). This helper
|
|
is the defensive normalizer used by content-commit paths.
|
|
|
|
It also scrubs nil-valued non-nilable style attrs (e.g. nil
|
|
:font-family/:font-weight/:font-style left over from an unloaded font),
|
|
so already-corrupted content self-heals on the next commit."
|
|
[content]
|
|
(if (and (map? content)
|
|
(= "root" (:type content))
|
|
(or (nil? (:children content))
|
|
(empty? (:children content))))
|
|
(let [base (tc/v2-default-text-content)]
|
|
(d/txt-merge base (select-keys content txt/root-attrs)))
|
|
(remove-nil-style-attrs content)))
|
|
|
|
(defn- v2-content-has-text?
|
|
[content]
|
|
(boolean
|
|
(when content
|
|
(some (fn [node]
|
|
(not (str/blank? (:text node ""))))
|
|
(txt/node-seq txt/is-text-node? content)))))
|
|
|
|
;; -- Editor
|
|
|
|
(defn update-editor
|
|
[editor]
|
|
(ptk/reify ::update-editor
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(if (some? editor)
|
|
(assoc state :workspace-editor editor)
|
|
(dissoc state :workspace-editor)))))
|
|
|
|
(defn focus-editor
|
|
[]
|
|
(ptk/reify ::focus-editor
|
|
ptk/EffectEvent
|
|
(effect [_ _ _]
|
|
;; The focus is deferred, so we re-read the current editor at fire
|
|
;; time: the editor present now can be unmounted before the timeout
|
|
;; runs (e.g. switching renderer while editing a text), and focusing a
|
|
;; stale instance throws.
|
|
(ts/schedule
|
|
(fn []
|
|
(let [editor (:workspace-editor @st/state)
|
|
element (when editor (.-element editor))]
|
|
(cond
|
|
;; V1 (DraftEditor)
|
|
(and (some? editor) (.-focus editor))
|
|
(.focus ^js editor)
|
|
|
|
;; V2
|
|
(and element (.-focus element))
|
|
(.focus ^js element))))))))
|
|
|
|
(defn gen-name
|
|
[editor]
|
|
(when (some? editor)
|
|
(let [result
|
|
(-> (ted/get-editor-current-plain-text editor)
|
|
(txt/generate-shape-name))]
|
|
(when (not= result "") result))))
|
|
|
|
(defn update-editor-state
|
|
[{:keys [id] :as shape} editor-state]
|
|
(ptk/reify ::update-editor-state
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(if (some? editor-state)
|
|
(update state :workspace-editor-state assoc id editor-state)
|
|
(-> state
|
|
(update :workspace-editor-state dissoc id)
|
|
(update :workspace-new-text-shapes disj id))))))
|
|
|
|
(defn finalize-editor-state
|
|
[id update-name?]
|
|
(ptk/reify ::finalize-editor-state
|
|
ptk/WatchEvent
|
|
(watch [_ state _]
|
|
(when (dwc/initialized? state)
|
|
(let [objects (dsh/lookup-page-objects state)
|
|
shape (get objects id)
|
|
editor-state (get-in state [:workspace-editor-state id])
|
|
content (-> editor-state
|
|
(ted/get-editor-current-content))
|
|
name (gen-name editor-state)
|
|
|
|
new-shape? (contains? (:workspace-new-text-shapes state) id)]
|
|
(if (ted/content-has-text? content)
|
|
(if (features/active-feature? state "render-wasm/v1")
|
|
(let [content (d/merge (ted/export-content content)
|
|
(dissoc (:content shape) :children))
|
|
new-size (dwwt/get-wasm-text-new-size shape content)]
|
|
(rx/merge
|
|
(rx/of (update-editor-state shape nil))
|
|
(when (and (not= content (:content shape))
|
|
(some? (:current-page-id state))
|
|
(some? shape))
|
|
(rx/of
|
|
(dwsh/update-shapes
|
|
[id]
|
|
(fn [shape]
|
|
(-> shape
|
|
(assoc :content content)
|
|
(cond-> (and update-name? (some? name))
|
|
(assoc :name name))
|
|
(cond-> (some? new-size)
|
|
(gsh/transform-shape
|
|
(ctm/change-size shape (:width new-size) (:height new-size))))))
|
|
{:undo-group (when new-shape? id)})))))
|
|
|
|
(let [content (d/merge (ted/export-content content)
|
|
(dissoc (:content shape) :children))
|
|
modifiers (get-in state [:workspace-text-modifier id])]
|
|
(rx/merge
|
|
(rx/of (update-editor-state shape nil))
|
|
(when (and (not= content (:content shape))
|
|
(some? (:current-page-id state))
|
|
(some? shape))
|
|
(rx/of
|
|
(dwsh/update-shapes
|
|
[id]
|
|
(fn [shape]
|
|
(let [{:keys [width height position-data]} modifiers]
|
|
(-> shape
|
|
(assoc :content content)
|
|
(cond-> position-data
|
|
(assoc :position-data position-data))
|
|
(cond-> (and update-name? (some? name))
|
|
(assoc :name name))
|
|
(cond-> (or (some? width) (some? height))
|
|
(gsh/transform-shape (ctm/change-size shape width height))))))
|
|
{:undo-group (when new-shape? id)}))))))
|
|
|
|
(when (some? id)
|
|
(rx/of (dws/deselect-shape id)
|
|
(dwsh/delete-shapes #{id})))))))))
|
|
|
|
(defn initialize-editor-state
|
|
[{:keys [id name content] :as shape} decorator]
|
|
(ptk/reify ::initialize-editor-state
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(let [text-state (some->> content ted/import-content)
|
|
attrs (merge (txt/get-default-text-attrs)
|
|
(fonts/valid-default-font
|
|
(get-in state [:workspace-global :default-font])))
|
|
editor (cond-> (ted/create-editor-state text-state decorator)
|
|
(and (nil? content) (some? attrs))
|
|
(ted/update-editor-current-block-data attrs))]
|
|
(assoc-in state [:workspace-editor-state id] editor)))
|
|
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
;; We need to finalize editor on two main events: (1) when user
|
|
;; explicitly navigates to other section or page; (2) when user
|
|
;; leaves the editor.
|
|
(let [editor (dm/get-in state [:workspace-editor-state id])
|
|
update-name? (or (nil? content) (= name (gen-name editor)))]
|
|
(->> (rx/merge
|
|
(rx/filter (ptk/type? ::rt/navigate) stream)
|
|
(rx/filter #(= ::finalize-editor-state %) stream))
|
|
(rx/take 1)
|
|
(rx/map #(finalize-editor-state id update-name?)))))))
|
|
|
|
(defn select-all
|
|
"Select all content of the current editor. When not editor found this
|
|
event is noop."
|
|
[{:keys [id] :as shape}]
|
|
(ptk/reify ::editor-select-all
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(d/update-in-when state [:workspace-editor-state id] ted/editor-select-all))))
|
|
|
|
(defn cursor-to-end
|
|
[{:keys [id] :as shape}]
|
|
(ptk/reify ::cursor-to-end
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(d/update-in-when state [:workspace-editor-state id] ted/cursor-to-end))))
|
|
|
|
;; --- Helpers
|
|
|
|
(defn- to-new-fills
|
|
[data]
|
|
;; FIXME: maybe export this as a specific helper ?
|
|
(types.fills/create
|
|
(d/without-nils (select-keys data types.fills/fill-attrs))))
|
|
|
|
(defn- shape-current-values
|
|
[shape pred attrs]
|
|
(let [root (:content shape)
|
|
nodes (->> (txt/node-seq pred root)
|
|
(map (fn [node]
|
|
(if (txt/is-text-node? node)
|
|
(let [default-text-attrs
|
|
(txt/get-default-text-attrs)
|
|
|
|
fills
|
|
(cond
|
|
(types.fills/has-valid-fill-attrs? node)
|
|
(to-new-fills node)
|
|
|
|
(some? (:fills node))
|
|
(:fills node)
|
|
|
|
:else
|
|
(:fills default-text-attrs))]
|
|
|
|
(-> (merge default-text-attrs node)
|
|
(assoc :fills fills)))
|
|
node))))]
|
|
(attrs/get-attrs-multi nodes attrs)))
|
|
|
|
(defn current-root-values
|
|
[{:keys [attrs shape]}]
|
|
(shape-current-values shape txt/is-root-node? attrs))
|
|
|
|
(defn current-ruby-values
|
|
[{:keys [attrs shape]}]
|
|
(shape-current-values shape
|
|
#(and (txt/is-text-node? %) (cjk/ruby-span? %))
|
|
attrs))
|
|
|
|
(defn v3-current-text-values
|
|
[{:keys [editor-styles attrs]}]
|
|
(let [result (-> editor-styles
|
|
;; If we use dm/select-keys compilation fails
|
|
(select-keys attrs))
|
|
result (if (empty? result) txt/default-text-attrs result)]
|
|
result))
|
|
|
|
(defn v2-current-text-values
|
|
[{:keys [editor-instance attrs]}]
|
|
(let [result (-> (.-currentStyle editor-instance)
|
|
(styles/get-styles-from-style-declaration)
|
|
(select-keys attrs))
|
|
result (if (empty? result) txt/default-text-attrs result)]
|
|
result))
|
|
|
|
(defn v1-current-paragraph-values
|
|
[{:keys [editor-state attrs shape]}]
|
|
(if editor-state
|
|
(-> (ted/get-editor-current-block-data editor-state)
|
|
(select-keys attrs))
|
|
(shape-current-values shape txt/is-paragraph-node? attrs)))
|
|
|
|
(defn current-paragraph-values
|
|
[{:keys [editor-styles editor-state editor-instance attrs shape] :as options}]
|
|
(cond
|
|
(some? editor-styles) (merge (shape-current-values shape txt/is-paragraph-node? attrs)
|
|
(select-keys editor-styles attrs))
|
|
(some? editor-instance) (v2-current-text-values options)
|
|
(some? editor-state) (v1-current-paragraph-values options)
|
|
:else (shape-current-values shape txt/is-paragraph-node? attrs)))
|
|
|
|
(defn v1-current-text-values
|
|
[{:keys [editor-state attrs]}]
|
|
(let [result (-> (ted/get-editor-current-inline-styles editor-state)
|
|
(select-keys attrs))
|
|
result (if (empty? result)
|
|
(txt/get-default-text-attrs)
|
|
result)]
|
|
result))
|
|
|
|
(defn current-text-values
|
|
[{:keys [editor-styles editor-state editor-instance attrs shape] :as options}]
|
|
(cond
|
|
(some? editor-styles) (v3-current-text-values options)
|
|
(some? editor-instance) (v2-current-text-values options)
|
|
(some? editor-state) (v1-current-text-values options)
|
|
:else (shape-current-values shape txt/is-text-node? attrs)))
|
|
|
|
;; --- TEXT EDITION IMPL
|
|
|
|
(defn count-node-chars
|
|
([node]
|
|
(count-node-chars node false))
|
|
([node last?]
|
|
(case (:type node)
|
|
("root" "paragraph-set")
|
|
(apply + (concat (map count-node-chars (drop-last (:children node)))
|
|
(map #(count-node-chars % true) (take-last 1 (:children node)))))
|
|
|
|
"paragraph"
|
|
(+ (apply + (map count-node-chars (:children node))) (if last? 0 1))
|
|
|
|
(count (:text node)))))
|
|
|
|
(defn decorate-range-info
|
|
"Adds information about ranges inside the metadata of the text nodes.
|
|
Offsets run top-down so every node counts from its parent's start."
|
|
[content]
|
|
(letfn [(decorate-children [node]
|
|
(let [start (-> node meta (:start 0))]
|
|
(d/update-when
|
|
node
|
|
:children
|
|
(fn [children]
|
|
(->> children
|
|
(reduce (fn [[result start] child]
|
|
(let [end (+ start (count-node-chars child))
|
|
child (with-meta child {:start start :end end})]
|
|
[(conj result (decorate-children child)) end]))
|
|
[[] start])
|
|
(first))))))]
|
|
(decorate-children (with-meta content {:start 0 :end (count-node-chars content)}))))
|
|
|
|
(defn split-content-at
|
|
[content position]
|
|
(->> content
|
|
(txt/transform-nodes
|
|
(fn [node]
|
|
(and (txt/is-paragraph-node? node)
|
|
(< (-> node meta :start) position (-> node meta :end))))
|
|
(fn [node]
|
|
(letfn
|
|
[(process-node [child]
|
|
(let [start (-> child meta :start)
|
|
end (-> child meta :end)]
|
|
(if (< start position end)
|
|
[(-> child
|
|
(vary-meta assoc :end position)
|
|
(update :text subs 0 (- position start)))
|
|
(-> child
|
|
(vary-meta assoc :start position)
|
|
(update :text subs (- position start)))]
|
|
[child])))]
|
|
(-> node
|
|
(d/update-when :children #(into [] (mapcat process-node) %))))))))
|
|
|
|
(defn update-content-range
|
|
[content start end attrs]
|
|
(->> content
|
|
(txt/transform-nodes
|
|
(fn [node]
|
|
(and (txt/is-text-node? node)
|
|
(and (>= (-> node meta :start) start)
|
|
(<= (-> node meta :end) end))))
|
|
#(d/patch-object % attrs))))
|
|
|
|
(defn- overlapping-text-nodes
|
|
"Text nodes of a range-decorated content with characters in [start, end)."
|
|
[content start end]
|
|
(->> (txt/node-seq txt/is-text-node? content)
|
|
(filter (fn [node]
|
|
(let [{node-start :start node-end :end} (meta node)]
|
|
(and (< node-start end) (< start node-end)))))))
|
|
|
|
(defn- annotated-span-bounds
|
|
"The range [start, end) widened to cover every ruby or warichu span it
|
|
cuts, so a reading or note is never split between two spans."
|
|
[content start end]
|
|
(->> (overlapping-text-nodes content start end)
|
|
(filter cjk/annotated-span?)
|
|
(reduce (fn [[start end] node]
|
|
(let [{node-start :start node-end :end} (meta node)]
|
|
[(min start node-start) (max end node-end)]))
|
|
[start end])))
|
|
|
|
(defn single-span-range?
|
|
"True when the characters [start, end) of `content`, widened to whole ruby
|
|
and warichu spans, all belong to one text span."
|
|
[content start end]
|
|
(or (nil? content)
|
|
(let [content (decorate-range-info content)
|
|
[start end] (annotated-span-bounds content start end)]
|
|
(<= (count (overlapping-text-nodes content start end)) 1))))
|
|
|
|
(defn update-text-range-attrs
|
|
"Applies `attrs` to the characters [start, end) of a text shape. A range
|
|
that cuts a ruby or warichu span covers the whole span."
|
|
[shape start end attrs]
|
|
(let [content (decorate-range-info (:content shape))
|
|
[start end] (annotated-span-bounds content start end)
|
|
new-content (-> content
|
|
(split-content-at start)
|
|
(split-content-at end)
|
|
(update-content-range start end attrs))]
|
|
(assoc shape :content new-content)))
|
|
|
|
(defn update-text-range
|
|
[id start end attrs]
|
|
(ptk/reify ::update-text-range
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(let [objects (dsh/lookup-page-objects state)
|
|
shape (get objects id)
|
|
|
|
update-fn
|
|
(fn [shape]
|
|
(cond-> shape
|
|
(cfh/text-shape? shape)
|
|
(update-text-range-attrs start end attrs)))
|
|
|
|
shape-ids (cond (cfh/text-shape? shape) [id]
|
|
(cfh/group-shape? shape) (cfh/get-children-ids objects id))
|
|
text-ids (resolve-text-ids objects id)]
|
|
|
|
(rx/concat
|
|
(rx/of (dwsh/update-shapes shape-ids update-fn))
|
|
(cond
|
|
(features/active-feature? state "render-wasm/v1")
|
|
(->> (rx/from text-ids)
|
|
(rx/map dwwt/resize-wasm-text-debounce))
|
|
|
|
(contains? attrs :font-id)
|
|
(await-html-font stream (:font-id attrs) (:font-variant-id attrs) text-ids)
|
|
|
|
:else
|
|
(rx/empty)))))))
|
|
|
|
(defn update-root-attrs
|
|
[{:keys [id attrs]}]
|
|
(ptk/reify ::update-root-attrs
|
|
ptk/WatchEvent
|
|
(watch [_ state _]
|
|
(let [objects (dsh/lookup-page-objects state)
|
|
shape (get objects id)
|
|
|
|
update-fn
|
|
(fn [shape]
|
|
(if (some? (:content shape))
|
|
(txt/update-text-content shape txt/is-root-node? d/txt-merge attrs)
|
|
;; Shape has no :content yet (e.g. a brand-new text
|
|
;; shape that has never been edited). Seed the
|
|
;; canonical root/paragraph-set/paragraph/span tree
|
|
;; before applying the new root attrs; the
|
|
;; `validate-shape` schema requires :children to
|
|
;; contain at least one paragraph-set.
|
|
(assoc shape :content
|
|
(d/txt-merge (tc/v2-default-text-content) attrs))))
|
|
|
|
shape-ids
|
|
(cond (cfh/text-shape? shape) [id]
|
|
(cfh/group-shape? shape) (cfh/get-children-ids objects id))]
|
|
|
|
(rx/of (dwsh/update-shapes shape-ids update-fn))))))
|
|
|
|
(defn update-paragraph-attrs
|
|
[{:keys [id attrs]}]
|
|
(ptk/reify ::update-paragraph-attrs
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(d/update-in-when state [:workspace-editor-state id] ted/update-editor-current-block-data attrs))
|
|
|
|
ptk/WatchEvent
|
|
(watch [_ state _]
|
|
(when-not (some? (get-in state [:workspace-editor-state id]))
|
|
(let [objects (dsh/lookup-page-objects state)
|
|
shape (get objects id)
|
|
|
|
merge-fn (fn [node attrs]
|
|
(reduce-kv
|
|
(fn [node k v]
|
|
(if (nil? v)
|
|
(dissoc node k)
|
|
(assoc node k v)))
|
|
node
|
|
attrs))
|
|
|
|
update-fn #(txt/update-text-content % txt/is-paragraph-node? merge-fn attrs)
|
|
shape-ids (cond
|
|
(cfh/text-shape? shape) [id]
|
|
(cfh/group-shape? shape) (cfh/get-children-ids objects id))]
|
|
|
|
(rx/of (dwsh/update-shapes shape-ids update-fn)))))))
|
|
|
|
(defn update-text-attrs
|
|
[{:keys [id attrs]}]
|
|
(ptk/reify ::update-text-attrs
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(d/update-in-when state [:workspace-editor-state id] ted/update-editor-current-inline-styles attrs))
|
|
|
|
ptk/WatchEvent
|
|
(watch [_ state _]
|
|
(when-not (some? (get-in state [:workspace-editor-state id]))
|
|
(let [objects (dsh/lookup-page-objects state)
|
|
shape (get objects id)
|
|
wasm? (features/active-feature? state "render-wasm/v1")
|
|
update-node? (fn [node]
|
|
(or (txt/is-text-node? node)
|
|
(txt/is-paragraph-node? node)))
|
|
shape-ids (cond
|
|
(cfh/text-shape? shape) [id]
|
|
(cfh/group-shape? shape) (cfh/get-children-ids objects id))
|
|
;; Keep WASM editor cache in sync with merged :content so a following
|
|
;; `apply-styles-to-selection` in `update-attrs` does not read stale
|
|
;; `shape-text-contents` and overwrite per-run fills (e.g. line-height).
|
|
merge-shape
|
|
(fn [sh]
|
|
(let [updated-shape (txt/update-text-content sh update-node? d/txt-merge attrs)]
|
|
(when wasm?
|
|
(wasm.text-editor/cache-shape-text-content! (:id updated-shape) (:content updated-shape)))
|
|
updated-shape))]
|
|
(rx/of (dwsh/update-shapes shape-ids merge-shape)))))))
|
|
|
|
(defn update-ruby-presentation-attrs
|
|
[shape attrs]
|
|
(txt/update-text-content
|
|
shape
|
|
#(and (txt/is-text-node? %) (cjk/ruby-span? %))
|
|
d/txt-merge
|
|
attrs))
|
|
|
|
(defn update-all-ruby-presentation
|
|
"Apply ruby presentation `attrs` to the ruby spans of the text shapes in
|
|
`ids`, and of the texts inside the groups among them, in one update."
|
|
[ids attrs]
|
|
(ptk/reify ::update-all-ruby-presentation
|
|
ptk/WatchEvent
|
|
(watch [_ state _]
|
|
(let [objects (dsh/lookup-page-objects state)
|
|
wasm? (features/active-feature? state "render-wasm/v1")
|
|
shape-ids (into []
|
|
(comp (mapcat (fn [id]
|
|
(let [shape (get objects id)]
|
|
(cond
|
|
(cfh/text-shape? shape) [id]
|
|
(cfh/group-shape? shape) (cfh/get-children-ids objects id)))))
|
|
(distinct))
|
|
ids)
|
|
update-fn (fn [shape]
|
|
(let [updated-shape (update-ruby-presentation-attrs shape attrs)]
|
|
(when (and wasm? (cfh/text-shape? updated-shape))
|
|
(wasm.text-editor/cache-shape-text-content!
|
|
(:id updated-shape)
|
|
(:content updated-shape)))
|
|
updated-shape))
|
|
undo-id (js/Symbol)]
|
|
(rx/concat
|
|
(rx/of (dwu/start-undo-transaction undo-id)
|
|
(dwsh/update-shapes shape-ids update-fn))
|
|
(if wasm?
|
|
(rx/of (dwwt/resize-wasm-text-all shape-ids))
|
|
(rx/empty))
|
|
(rx/of (dwu/commit-undo-transaction undo-id)))))))
|
|
|
|
(defn migrate-node
|
|
[node]
|
|
(let [color-attrs (not-empty (select-keys node types.fills/fill-attrs))]
|
|
(cond-> node
|
|
(nil? (:fills node))
|
|
(assoc :fills (types.fills/create))
|
|
|
|
;; Migrate old colors and remove the old fromat
|
|
color-attrs
|
|
(-> (dissoc :fill-color :fill-opacity :fill-color-ref-id :fill-color-ref-file :fill-color-gradient)
|
|
(update :fills types.fills/update conj color-attrs))
|
|
|
|
;; We don't have the fills attribute. It's an old text without color
|
|
;; so need to be black
|
|
(and (nil? (:fills node)) (empty? color-attrs))
|
|
(assoc :fills (txt/get-default-text-fills)))))
|
|
|
|
(defn migrate-content
|
|
[content]
|
|
(txt/transform-nodes (some-fn txt/is-text-node? txt/is-paragraph-node?) migrate-node content))
|
|
|
|
(defn update-text-with-function
|
|
([id update-node-fn] (update-text-with-function id update-node-fn nil))
|
|
([id update-node-fn options]
|
|
(ptk/reify ::update-text-with-function
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
;; This is only called when `[:workspace-editor-state id]` is set, this property
|
|
;; keeps a Draft.js EditorState object.
|
|
(d/update-in-when state [:workspace-editor-state id] ted/update-editor-current-inline-styles-fn (comp update-node-fn migrate-node)))
|
|
|
|
ptk/WatchEvent
|
|
(watch [_ state _]
|
|
(when (or
|
|
(and (features/active-feature? state "text-editor/v2")
|
|
(nil? (:workspace-editor state)))
|
|
(and (not (features/active-feature? state "text-editor/v2"))
|
|
(nil? (get-in state [:workspace-editor-state id]))))
|
|
(let [page-id (or (get options :page-id)
|
|
(get state :current-page-id))
|
|
objects (dsh/lookup-page-objects state page-id)
|
|
shape (get objects id)
|
|
update-node? (some-fn txt/is-text-node? txt/is-paragraph-node?)
|
|
|
|
shape-ids
|
|
(cond
|
|
(cfh/text-shape? shape) [id]
|
|
(cfh/group-shape? shape) (cfh/get-children-ids objects id))
|
|
|
|
update-content
|
|
(fn [content]
|
|
(->> content
|
|
(migrate-content)
|
|
(txt/transform-nodes update-node? update-node-fn)))
|
|
|
|
update-shape
|
|
(fn [shape]
|
|
(-> shape
|
|
(dissoc :fills)
|
|
(d/update-when :content update-content)))]
|
|
|
|
(rx/concat (rx/of (dwsh/update-shapes shape-ids update-shape options))
|
|
(when (features/active-feature? state "text-editor-wasm/v1")
|
|
;; Transform each span so add-fill preserves its existing fills.
|
|
(let [result (wasm.api/apply-styles-to-selection
|
|
(comp update-node-fn migrate-node)
|
|
{:with-fills? true})]
|
|
(when result
|
|
(rx/of (v2-update-text-shape-content
|
|
(:shape-id result)
|
|
(:content result)
|
|
:update-name? true)
|
|
;; Refresh the panel now, not only after a reselect.
|
|
(dwt-v3/v3-update-text-editor-styles
|
|
(:shape-id result)
|
|
{:fills (:fills result)})))))))))
|
|
|
|
ptk/EffectEvent
|
|
(effect [_ state _]
|
|
(when (features/active-feature? state "text-editor/v2")
|
|
(when-let [instance (:workspace-editor state)]
|
|
(let [styles (some-> (editor.v2/getCurrentStyle instance)
|
|
(styles/get-styles-from-style-declaration :removed-mixed true)
|
|
((comp update-node-fn migrate-node))
|
|
(styles/attrs->styles))]
|
|
(editor.v2/applyStylesToSelection instance styles))))))))
|
|
|
|
;; --- RESIZE UTILS
|
|
|
|
(def start-edit-if-selected
|
|
(ptk/reify ::start-edit-if-selected
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(let [objects (dsh/lookup-page-objects state)
|
|
selected (->> state dsh/lookup-selected (mapv #(get objects %)))]
|
|
(cond-> state
|
|
(and (= 1 (count selected))
|
|
(= (-> selected first :type) :text))
|
|
(assoc-in [:workspace-local :edition] (-> selected first :id)))))))
|
|
|
|
(defn not-changed? [old-dim new-dim]
|
|
(> (mth/abs (- old-dim new-dim)) 0.1))
|
|
|
|
(defn commit-resize-text
|
|
[]
|
|
(ptk/reify ::commit-resize-text
|
|
ptk/WatchEvent
|
|
(watch [_ state _]
|
|
(let [props (::resize-text-debounce-props state)
|
|
objects (dsh/lookup-page-objects state)
|
|
undo-id (js/Symbol)]
|
|
|
|
(letfn [(changed-text? [id]
|
|
(let [shape (get objects id)
|
|
[new-width new-height] (get props id)]
|
|
(or (and (not-changed? (:width shape) new-width) (= (:grow-type shape) :auto-width))
|
|
(and (not-changed? (:height shape) new-height)
|
|
(or (= (:grow-type shape) :auto-height) (= (:grow-type shape) :auto-width))))))
|
|
|
|
(update-fn [{:keys [id selrect grow-type] :as shape}]
|
|
(let [{shape-width :width shape-height :height} selrect
|
|
[new-width new-height] (get props id)
|
|
|
|
shape
|
|
(cond-> shape
|
|
(and (or (not (ctl/any-layout-immediate-child? objects shape))
|
|
(not (ctl/fill-width? shape)))
|
|
(not-changed? shape-width new-width)
|
|
(= grow-type :auto-width))
|
|
(gsh/transform-shape (ctm/change-dimensions-modifiers shape :width new-width {:ignore-lock? true})))
|
|
|
|
shape
|
|
(cond-> shape
|
|
(and (or (not (ctl/any-layout-immediate-child? objects shape))
|
|
(not (ctl/fill-height? shape)))
|
|
(not-changed? shape-height new-height)
|
|
(or (= grow-type :auto-height) (= grow-type :auto-width)))
|
|
(gsh/transform-shape (ctm/change-dimensions-modifiers shape :height new-height {:ignore-lock? true})))]
|
|
|
|
shape))]
|
|
|
|
(let [ids (into #{} (filter changed-text?) (keys props))]
|
|
(rx/of (dwu/start-undo-transaction undo-id)
|
|
(dwsh/update-shapes ids update-fn {:with-objects? true
|
|
:reg-objects? true
|
|
:stack-undo? true
|
|
:ignore-touched true})
|
|
(ptk/data-event :layout/update {:ids ids})
|
|
(dwu/commit-undo-transaction undo-id))))))))
|
|
|
|
(defn resize-text
|
|
[id new-width new-height]
|
|
|
|
(let [cur-event (js/Symbol)
|
|
reflow-task (wrf/task :text-resize [id])]
|
|
(ptk/reify ::resize-text
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(-> state
|
|
(update ::resize-text-debounce-props (fnil assoc {}) id [new-width new-height])
|
|
(update ::resize-text-reflow-tasks (fnil conj []) reflow-task)
|
|
(cond-> (nil? (::resize-text-debounce-event state))
|
|
(assoc ::resize-text-debounce-event cur-event))))
|
|
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(wrf/start! reflow-task)
|
|
(if (= (::resize-text-debounce-event state) cur-event)
|
|
(let [stopper (->> stream (rx/filter (ptk/type? ::dw/finalize-workspace)))]
|
|
(rx/concat
|
|
(rx/merge
|
|
(->> stream
|
|
(rx/filter (ptk/type? ::resize-text))
|
|
(rx/debounce 50)
|
|
(rx/take 1)
|
|
(rx/map #(commit-resize-text))
|
|
(rx/take-until stopper))
|
|
(rx/of (resize-text id new-width new-height)))
|
|
(rx/of (fn [state]
|
|
(wrf/finish-tasks! (::resize-text-reflow-tasks state))
|
|
(dissoc state
|
|
::resize-text-debounce-props
|
|
::resize-text-reflow-tasks
|
|
::resize-text-debounce-event)))))
|
|
(rx/empty))))))
|
|
|
|
(defn save-default-font
|
|
[data]
|
|
(ptk/reify ::save-default-font
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(let [multiple? (->> data vals (d/seek #(= % :multiple)))
|
|
font (dissoc data :typography-ref-id :typography-ref-file)]
|
|
(cond-> state
|
|
(not multiple?)
|
|
(update :workspace-global assoc :default-font font))))))
|
|
|
|
(defn apply-text-modifier
|
|
[shape text-modifier]
|
|
|
|
(if (some? text-modifier)
|
|
(let [{:keys [width height position-data]} text-modifier
|
|
new-shape
|
|
(cond-> shape
|
|
(some? width)
|
|
(gsh/transform-shape (ctm/change-dimensions-modifiers shape :width width {:ignore-lock? true}))
|
|
|
|
(some? height)
|
|
(gsh/transform-shape (ctm/change-dimensions-modifiers shape :height height {:ignore-lock? true}))
|
|
|
|
(some? position-data)
|
|
(assoc :position-data position-data))
|
|
|
|
delta-move
|
|
(gpt/subtract (gpt/point (ctm/safe-size-rect new-shape))
|
|
(gpt/point (ctm/safe-size-rect shape)))
|
|
|
|
new-shape
|
|
(update new-shape :position-data gsh/move-position-data delta-move)]
|
|
|
|
new-shape)
|
|
shape))
|
|
|
|
(defn merge-live-text-dimensions
|
|
"Pick displayed width/height while editing auto-grow text.
|
|
|
|
Geometry commits are finalize-only (see `v2-update-text-shape-content`), so the
|
|
Design tab and edition outline read live WASM layout for growing axes:
|
|
- `:auto-width` → live width and height
|
|
- `:auto-height` → selrect width, live height
|
|
- `:fixed` → selrect for both
|
|
|
|
Nil or non-positive live axes fall back to the committed selrect so a missing
|
|
WASM measure never flashes `0`."
|
|
[grow-type {:keys [width height]} live]
|
|
(let [lw (when (map? live) (:width live))
|
|
lh (when (map? live) (:height live))]
|
|
{:width (if (and (= grow-type :auto-width) (number? lw) (pos? lw)) lw width)
|
|
:height (if (and (not= grow-type :fixed) (number? lh) (pos? lh)) lh height)}))
|
|
|
|
(defn shape-with-live-text-dimensions
|
|
"Display-only patch of shape selrect (and :width/:height) from live WASM text
|
|
layout. Does not write to the store. Returns `shape` unchanged when WASM is
|
|
unavailable or dimensions do not change."
|
|
[shape]
|
|
(let [selrect (:selrect shape)
|
|
live (when (wasm.api/initialized?)
|
|
(wasm.api/get-text-dimensions (:id shape)))
|
|
{:keys [width height]} (merge-live-text-dimensions (:grow-type shape) selrect live)]
|
|
(if (and (mth/close? width (:width selrect))
|
|
(mth/close? height (:height selrect)))
|
|
shape
|
|
(-> shape
|
|
(assoc :selrect (grc/make-rect (:x selrect) (:y selrect) width height))
|
|
(cond-> (contains? shape :width) (assoc :width width))
|
|
(cond-> (contains? shape :height) (assoc :height height))))))
|
|
|
|
(defn commit-update-text-modifier
|
|
[]
|
|
(ptk/reify ::commit-update-text-modifier
|
|
ptk/WatchEvent
|
|
(watch [_ state _]
|
|
(let [ids (::update-text-modifier-debounce-ids state)
|
|
modif-tree (dwm/create-modif-tree ids (ctm/reflow-modifiers))]
|
|
(rx/of (dwm/update-modifiers modif-tree false true))))))
|
|
|
|
(defn update-text-modifier
|
|
[id props]
|
|
|
|
(let [cur-event (js/Symbol)]
|
|
(ptk/reify ::update-text-modifier
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(-> state
|
|
(update-in [:workspace-text-modifier id] (fnil merge {}) props)
|
|
(update ::update-text-modifier-debounce-ids (fnil conj #{}) id)
|
|
(cond-> (nil? (::update-text-modifier-debounce-event state))
|
|
(assoc ::update-text-modifier-debounce-event cur-event))))
|
|
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(if (= (::update-text-modifier-debounce-event state) cur-event)
|
|
(let [stopper (->> stream (rx/filter (ptk/type? ::dw/finalize-workspace)))]
|
|
(rx/concat
|
|
(rx/merge
|
|
(->> stream
|
|
(rx/filter (ptk/type? ::update-text-modifier))
|
|
(rx/debounce 50)
|
|
(rx/take 1)
|
|
(rx/map #(commit-update-text-modifier))
|
|
(rx/take-until stopper))
|
|
(rx/of (update-text-modifier id props)))
|
|
(rx/of #(dissoc % ::update-text-modifier-debounce-event ::update-text-modifier-debounce-ids))))
|
|
(rx/empty))))))
|
|
|
|
(defn clean-text-modifier
|
|
[id]
|
|
(ptk/reify ::clean-text-modifier
|
|
ptk/WatchEvent
|
|
(watch [_ state _]
|
|
(let [current-value (dm/get-in state [:workspace-text-modifier id])]
|
|
;; We only dissocc the value when hasn't change after a time
|
|
(->> (rx/of (fn [state]
|
|
(cond-> state
|
|
(identical? (dm/get-in state [:workspace-text-modifier id]) current-value)
|
|
(update :workspace-text-modifier dissoc id))))
|
|
(rx/delay 100))))))
|
|
|
|
(defn remove-text-modifier
|
|
[id]
|
|
(ptk/reify ::remove-text-modifier
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(d/dissoc-in state [:workspace-text-modifier id]))
|
|
|
|
ptk/WatchEvent
|
|
(watch [_ _ _]
|
|
(rx/of (dwm/apply-modifiers {:stack-undo? true})))))
|
|
|
|
(defn commit-position-data
|
|
[]
|
|
(ptk/reify ::commit-position-data
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(let [ids (keys (::update-position-data state))]
|
|
(update state :workspace-text-modifier #(apply dissoc % ids))))
|
|
|
|
ptk/WatchEvent
|
|
(watch [_ state _]
|
|
(let [position-data (::update-position-data state)]
|
|
(rx/of (dwsh/update-shapes
|
|
(keys position-data)
|
|
(fn [shape]
|
|
(-> shape
|
|
(assoc :position-data (get position-data (:id shape)))))
|
|
{:stack-undo? true :reg-objects? false}))))))
|
|
|
|
(defn update-position-data
|
|
[id position-data]
|
|
|
|
(let [cur-event (js/Symbol)
|
|
reflow-task (wrf/task :text-position [id])]
|
|
(ptk/reify ::update-position-data
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(let [state (assoc-in state [:workspace-text-modifier id :position-data] position-data)]
|
|
(-> state
|
|
(update ::update-position-data-reflow-tasks (fnil conj []) reflow-task)
|
|
(cond-> (nil? (::update-position-data-debounce state))
|
|
(assoc ::update-position-data-debounce cur-event))
|
|
(cond-> (some? (::update-position-data-debounce state))
|
|
(assoc-in [::update-position-data id] position-data)))))
|
|
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(wrf/start! reflow-task)
|
|
(if (= (::update-position-data-debounce state) cur-event)
|
|
(let [stopper (text-work-stopper stream)]
|
|
(rx/concat
|
|
(rx/merge
|
|
(->> stream
|
|
(rx/filter (ptk/type? ::update-position-data))
|
|
(rx/debounce 50)
|
|
(rx/take 1)
|
|
(rx/map #(commit-position-data))
|
|
(rx/take-until stopper))
|
|
(rx/of (update-position-data id position-data)))
|
|
(rx/of (fn [state]
|
|
(wrf/finish-tasks! (::update-position-data-reflow-tasks state))
|
|
(dissoc state
|
|
::update-position-data-debounce
|
|
::update-position-data
|
|
::update-position-data-reflow-tasks)))))
|
|
(rx/empty))))))
|
|
|
|
(defn update-attrs
|
|
[id attrs]
|
|
(ptk/reify ::update-attrs
|
|
ptk/WatchEvent
|
|
(watch [_ state stream]
|
|
(let [text-editor-instance (:workspace-editor state)
|
|
objects (dsh/lookup-page-objects state)
|
|
text-ids (resolve-text-ids objects id)
|
|
|
|
wasm-editing?
|
|
(and (features/active-feature? state "text-editor-wasm/v1")
|
|
(= id (wasm.api/text-editor-get-active-shape-id)))
|
|
|
|
wasm-editing-selection?
|
|
(and wasm-editing? (wasm.api/text-editor-has-selection?))]
|
|
(if (and (features/active-feature? state "text-editor/v2")
|
|
(some? text-editor-instance))
|
|
(rx/empty)
|
|
(rx/concat
|
|
(let [attrs (select-keys attrs txt/root-attrs)]
|
|
(if-not (empty? attrs)
|
|
(rx/of (update-root-attrs {:id id :attrs attrs}))
|
|
(rx/empty)))
|
|
|
|
;; `:line-height` is stored on both the paragraph and its spans, and
|
|
;; the renderer takes the larger of the two.
|
|
(let [pattrs (if wasm-editing-selection?
|
|
(conj txt/paragraph-attrs :line-height)
|
|
txt/paragraph-attrs)
|
|
attrs (select-keys attrs pattrs)
|
|
result (when (and (seq attrs) wasm-editing?)
|
|
(wasm.api/apply-paragraph-attrs-to-selection attrs))]
|
|
(cond
|
|
(empty? attrs)
|
|
(rx/empty)
|
|
|
|
(some? result)
|
|
(rx/of (v2-update-text-shape-content
|
|
(:shape-id result) (:content result)
|
|
:update-name? true))
|
|
|
|
:else
|
|
(rx/of (update-paragraph-attrs {:id id :attrs attrs}))))
|
|
|
|
(let [attrs (select-keys attrs txt/text-node-attrs)]
|
|
(cond
|
|
(or (empty? attrs) wasm-editing-selection?)
|
|
(rx/empty)
|
|
|
|
;; Collapsed caret: stash a pending caret style for the next typed
|
|
;; character instead of restyling the whole shape.
|
|
wasm-editing?
|
|
(do
|
|
(wasm.text-editor/merge-pending-caret-styles! id attrs)
|
|
(rx/of (dwt-v3/v3-update-text-editor-styles id attrs)))
|
|
|
|
:else
|
|
(rx/of (update-text-attrs {:id id :attrs attrs}))))
|
|
|
|
(when (and (features/active-feature? state "text-editor/v2")
|
|
(not (features/active-feature? state "text-editor-wasm/v1")))
|
|
(rx/of (v2-update-text-editor-styles id attrs)))
|
|
|
|
(if (features/active-feature? state "render-wasm/v1")
|
|
(rx/concat
|
|
;; Apply style to selected spans and sync content
|
|
(let [has-selection? (wasm.api/text-editor-has-selection?)]
|
|
(when has-selection?
|
|
(let [span-attrs (select-keys attrs txt/text-node-attrs)]
|
|
(when (not (empty? span-attrs))
|
|
(let [result (wasm.api/apply-styles-to-selection span-attrs)]
|
|
(when result
|
|
(rx/of (v2-update-text-shape-content
|
|
(:shape-id result) (:content result)
|
|
:update-name? true))))))))
|
|
;; Resize (with delay for font-id changes). Only auto-height and
|
|
;; auto-width shapes have geometry to recompute.
|
|
(let [auto-ids (into [] (remove #(= :fixed (:grow-type (get objects %)))) text-ids)]
|
|
(if (contains? attrs :font-id)
|
|
;; The geometry depends on the font, so wait until wasm has it.
|
|
(await-font-resize stream auto-ids)
|
|
;; No font change: measurable right away.
|
|
(->> (rx/from auto-ids)
|
|
(rx/map dwwt/resize-wasm-text)))))
|
|
|
|
;; The legacy renderer re-measures these in the DOM on its own,
|
|
;; but font loading starts before that render commits.
|
|
(if (contains? attrs :font-id)
|
|
(await-html-font
|
|
stream
|
|
(:font-id attrs)
|
|
(:font-variant-id attrs)
|
|
text-ids)
|
|
(rx/empty)))))))
|
|
|
|
ptk/EffectEvent
|
|
(effect [_ state _]
|
|
(when (features/active-feature? state "text-editor/v2")
|
|
(when-let [instance (:workspace-editor state)]
|
|
(when (seq attrs)
|
|
;; DOM `getCurrentStyle` reflects one resolved style (e.g. caret color). Merging
|
|
;; it with sidebar `attrs` and applying to the whole selection collapses mixed
|
|
;; fills/fonts when the user only changes one property (e.g. line-height).
|
|
;; Apply only the explicit attributes from this action.
|
|
(let [styles (styles/attrs->styles attrs)]
|
|
(editor.v2/applyStylesToSelection instance styles))))))))
|
|
|
|
(defn update-all-attrs
|
|
[ids attrs]
|
|
(ptk/reify ::update-all-attrs
|
|
ptk/WatchEvent
|
|
(watch [_ _ _]
|
|
(let [undo-id (js/Symbol)]
|
|
(rx/concat
|
|
(rx/of (dwu/start-undo-transaction undo-id))
|
|
(->> (rx/from ids)
|
|
(rx/map #(update-attrs % attrs)))
|
|
(rx/of (dwu/commit-undo-transaction undo-id)))))))
|
|
|
|
(defn apply-typography
|
|
"A higher level event that has the resposability of to apply the
|
|
specified typography to the selected shapes."
|
|
([typography file-id]
|
|
(apply-typography nil typography file-id))
|
|
|
|
([ids typography file-id]
|
|
(assert (or (nil? ids) (and (set? ids) (every? uuid? ids))))
|
|
(ptk/reify ::apply-typography
|
|
ptk/WatchEvent
|
|
(watch [_ state _]
|
|
(let [editor-state (:workspace-editor-state state)
|
|
ids (d/nilv ids (dsh/lookup-selected state))
|
|
attrs (-> typography
|
|
(assoc :typography-ref-file file-id)
|
|
(assoc :typography-ref-id (:id typography))
|
|
(dissoc :id :name))
|
|
undo-id (js/Symbol)]
|
|
|
|
(rx/concat
|
|
(rx/of (dwu/start-undo-transaction undo-id))
|
|
(->> (rx/from (seq ids))
|
|
(rx/map (fn [id]
|
|
(let [editor (get editor-state id)]
|
|
(update-text-attrs {:id id :editor editor :attrs attrs})))))
|
|
(rx/of (dwu/commit-undo-transaction undo-id))))))))
|
|
|
|
(defn generate-typography-name
|
|
[{:keys [font-id font-variant-id] :as typography}]
|
|
(let [{:keys [name]} (fonts/get-font-data font-id)]
|
|
(assoc typography :name (str name " " (str/title font-variant-id)))))
|
|
|
|
;; -- Text Editor v2
|
|
|
|
(defn v2-update-text-editor-styles
|
|
[id new-styles]
|
|
(ptk/reify ::v2-update-text-editor-styles
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
;; `stylechange` can fire on every `selectionchange` while typing.
|
|
;; Avoid swapping the global store when the computed styles are unchanged,
|
|
;; otherwise we can end up in store->rerender->selectionchange loops.
|
|
(let [merged-styles (merge (txt/get-default-text-attrs)
|
|
(fonts/valid-default-font
|
|
(get-in state [:workspace-global :default-font]))
|
|
new-styles)
|
|
prev (get-in state [:workspace-v2-editor-state id])]
|
|
(if (= merged-styles prev)
|
|
state
|
|
(assoc-in state [:workspace-v2-editor-state id] merged-styles))))))
|
|
|
|
(defn v2-sync-wasm-text-layout
|
|
"Live-sync WASM text layout from the DOM editor without writing shape :content.
|
|
Intended to be called from Text Editor v2 `needslayout` events (coalesced)."
|
|
[id content]
|
|
(ptk/reify ::v2-sync-wasm-text-layout
|
|
ptk/WatchEvent
|
|
(watch [_ state _]
|
|
(let [objects (dsh/lookup-page-objects state)
|
|
shape (get objects id)]
|
|
(if-not (and (some? shape) (cfh/text-shape? shape))
|
|
(rx/empty)
|
|
(let [new-size (dwwt/get-wasm-text-new-size shape content)
|
|
modifiers (when (and (some? new-size)
|
|
(not= :fixed (:grow-type shape)))
|
|
(dwwt/resize-wasm-text-modifiers shape content))]
|
|
;; `get-wasm-text-new-size` has the side effect of syncing WASM's internal text
|
|
;; content/layout. Only non-fixed grow-types need geometry modifiers updates.
|
|
(if (some? modifiers)
|
|
(rx/of (dwm/set-wasm-modifiers modifiers))
|
|
(rx/empty))))))
|
|
|
|
ptk/EffectEvent
|
|
(effect [_ _ _]
|
|
;; While typing, v2 only commits shape :content on debounced `change`.
|
|
;; We still need to repaint the WASM canvas for live preview.
|
|
(wasm.api/request-render "text-editor-v2-needslayout"))))
|
|
|
|
(defn v2-update-text-shape-position-data
|
|
[shape-id position-data]
|
|
(ptk/reify ::v2-update-text-shape-position-data
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(update-in state [:workspace-text-modifier shape-id] {:position-data position-data}))))
|
|
|
|
(defn- add-geometry-undo-to-commit
|
|
"Adds geometry undo/redo to a commit so undo restores both content and geometry.
|
|
old-geom and final-geom are maps with :selrect :points and optionally :width :height."
|
|
[base objects id old-geom final-geom attrs]
|
|
(let [objects-with-old (update objects id #(merge % old-geom))
|
|
final-shape-fn (fn [shape] (merge shape final-geom))]
|
|
(-> base
|
|
(pcb/with-objects objects-with-old)
|
|
(pcb/update-shapes [id] final-shape-fn {:attrs attrs}))))
|
|
|
|
(defn- build-finalize-commit-changes
|
|
"Builds the commit changes for text finalization (content + geometry undo).
|
|
For auto-width text, include geometry so undo restores e.g. width.
|
|
Includes :name when update-name? so we can skip save-undo on the preceding
|
|
update-shapes for finalize without losing name undo."
|
|
[it state id {:keys [new-shape? content-has-text? content original-content
|
|
update-name? name resize-geom]}]
|
|
(let [page-id (:current-page-id state)
|
|
objects (dsh/lookup-page-objects state page-id)
|
|
shape* (get objects id)
|
|
base (-> (pcb/empty-changes it page-id)
|
|
(pcb/with-objects objects)
|
|
(pcb/set-text-content id content original-content)
|
|
(cond-> (and update-name? (some? name) (not= (:name shape*) name))
|
|
(pcb/update-shapes [id] (fn [s] (assoc s :name name)) {:attrs [:name]}))
|
|
(cond-> new-shape?
|
|
(-> (pcb/set-undo-group id)
|
|
(pcb/set-stack-undo? true))))
|
|
;; `resize-geom` is the post-resize geometry; `shape*` still holds the pre-resize selrect.
|
|
final-geom (or resize-geom (select-keys shape* [:selrect :points :width :height]))
|
|
geom-keys (if new-shape? [:selrect :points] [:selrect :points :width :height])
|
|
old-geom (when (and content-has-text? (not= :fixed (:grow-type shape*)))
|
|
(or (get-in state [:workspace-text-session-geom id])
|
|
(let [sr (:selrect shape*)
|
|
r (grc/make-rect (or (:x sr) 0) (or (:y sr) 0) 0.01 0.01)]
|
|
{:selrect r :points (grc/rect->points r)})))]
|
|
(if (some? old-geom)
|
|
(add-geometry-undo-to-commit base objects id
|
|
(select-keys old-geom geom-keys)
|
|
(select-keys final-geom geom-keys)
|
|
geom-keys)
|
|
base)))
|
|
|
|
(defn v2-update-text-shape-content
|
|
[id content & {:keys [update-name? name finalize? save-undo? original-content]
|
|
:or {update-name? false name nil finalize? false save-undo? true original-content nil}}]
|
|
;; Defensive: ensure the content we are about to commit has the
|
|
;; canonical root/paragraph-set/paragraph/span tree. The v2 editor
|
|
;; always produces well-formed content from `dom->cljs`, but legacy
|
|
;; producers (or programmatic API calls) can still pass a root with
|
|
;; empty :children, which would fail the backend `validate-shape`
|
|
;; schema.
|
|
(let [content (ensure-valid-text-content content)
|
|
original-content (ensure-valid-text-content original-content)]
|
|
(ptk/reify ::v2-update-text-shape-content
|
|
ptk/WatchEvent
|
|
(watch [it state _]
|
|
(if (features/active-feature? state "render-wasm/v1")
|
|
(let [;; v3 editor always passes :finalize? from keyword opts; when absent
|
|
;; that binds nil and :or defaults do not apply — coerce so undo flags
|
|
;; stay strict booleans for changes-builder schema validation.
|
|
finalize? (boolean finalize?)
|
|
objects (dsh/lookup-page-objects state)
|
|
shape (get objects id)
|
|
new-shape? (contains? (:workspace-new-text-shapes state) id)
|
|
prev-content (:content shape)
|
|
has-prev-content? (not (nil? (:prev-content shape)))
|
|
;; For existing shapes, capture geometry at session start once so
|
|
;; finalize can build a single undo entry. Stored in workspace state,
|
|
;; not in the shape, to avoid persisting session-only data.
|
|
session-start-geom (or (get-in state [:workspace-text-session-geom id])
|
|
(select-keys shape [:selrect :points :width :height]))
|
|
content-has-text? (v2-content-has-text? content)
|
|
prev-content-has-text? (v2-content-has-text? prev-content)
|
|
;; Only measure/resize the shape on finalize. While the user is
|
|
;; actively typing, the WASM editor already renders the growing text
|
|
;; (and the editor overlay measures it live), so a per-keystroke
|
|
;; resize is redundant and, going through the interactive-transform
|
|
;; modifier machinery, made auto-width typing very laggy.
|
|
new-size (when (and finalize? (not= :fixed (:grow-type shape)))
|
|
(dwwt/get-wasm-text-new-size shape content))
|
|
;; Also compute the resized geometry for the finalize commit; the
|
|
;; async `apply-wasm-modifiers` below never updates this `state`.
|
|
resize-modifiers (when (some? new-size)
|
|
(dwwt/resize-wasm-text-modifiers shape content))
|
|
resize-geom (when resize-modifiers
|
|
(-> (gsh/transform-shape shape (get-in resize-modifiers [id :modifiers]))
|
|
(select-keys [:selrect :points :width :height])))
|
|
;; New shapes: single undo on finalize only (no per-keystroke undo)
|
|
effective-save-undo? (if new-shape? finalize? save-undo?)
|
|
effective-stack-undo? (and new-shape? finalize?)
|
|
;; No save-undo on first update when finalizing: either build-finalize
|
|
;; holds undo (non-new), or we delete empty text and only delete-shapes
|
|
;; should record undo.
|
|
finalize-save-undo-first?
|
|
(if (and finalize? (or (not new-shape?) (not content-has-text?)))
|
|
false
|
|
effective-save-undo?)
|
|
|
|
;; Whether any content-changing edit happened this editing session.
|
|
session-touched? (some? (get-in state [:workspace-text-session-geom id]))
|
|
;; A finalize on an existing shape that wasn't edited must not create any undo entry
|
|
;; (exception being newly created shapes)
|
|
finalize-no-op? (and finalize?
|
|
(not new-shape?)
|
|
content-has-text?
|
|
(not session-touched?))]
|
|
|
|
(rx/concat
|
|
(rx/of
|
|
;; Store session-start geometry in workspace state once for existing shapes
|
|
(when (and (not new-shape?)
|
|
(nil? (get-in state [:workspace-text-session-geom id])))
|
|
(fn [s] (assoc-in s [:workspace-text-session-geom id] session-start-geom)))
|
|
(dwsh/update-shapes
|
|
[id]
|
|
(fn [shape]
|
|
(-> shape
|
|
(assoc :content content)
|
|
(cond-> (and (not new-shape?)
|
|
content-has-text?
|
|
has-prev-content?)
|
|
(dissoc :prev-content))
|
|
|
|
(cond-> (and (not new-shape?)
|
|
prev-content-has-text?
|
|
(not content-has-text?)
|
|
(not finalize?))
|
|
(assoc :prev-content prev-content))
|
|
|
|
(cond-> (and update-name? (some? name))
|
|
(assoc :name name))))
|
|
{:save-undo? finalize-save-undo-first?
|
|
:stack-undo? effective-stack-undo?
|
|
:undo-group (when new-shape? id)})
|
|
|
|
;; Push the auto-grow geometry to WASM/app state; the commit persists it via `resize-geom`.
|
|
;; Skipped for a no-op finalize: applying it would record an undo transaction.
|
|
(when (and (some? resize-modifiers) (not finalize-no-op?))
|
|
(dwm/apply-wasm-modifiers resize-modifiers {:undo-group (when new-shape? id)})))
|
|
|
|
(when finalize?
|
|
(rx/concat
|
|
(if (and (not content-has-text?) (some? id))
|
|
(rx/concat
|
|
(if (and (some? original-content) (v2-content-has-text? original-content))
|
|
(rx/of
|
|
(dwsh/update-shapes
|
|
[id]
|
|
(fn [s] (-> s (assoc :content original-content) (dissoc :prev-content)))
|
|
{:save-undo? false}))
|
|
(rx/empty))
|
|
(rx/of (dws/deselect-shape id)
|
|
(dwsh/delete-shapes #{id})))
|
|
(rx/empty))
|
|
(rx/concat
|
|
(if (and content-has-text? (not finalize-no-op?))
|
|
(rx/of
|
|
(dch/commit-changes
|
|
(build-finalize-commit-changes it state id
|
|
{:new-shape? new-shape?
|
|
:content-has-text? content-has-text?
|
|
:content content
|
|
;; Undo baseline for the finalize commit: restore the
|
|
;; content as it was right before this commit. For existing
|
|
;; shapes that's `prev-content`; using the (unset, nil)
|
|
;; `original-content` here wiped `:content` to nil on undo,
|
|
;; which emptied the shape and crashed the WASM editor's
|
|
;; select-all on 0 paragraphs. New shapes keep the previous
|
|
;; behavior (their create is bundled in the undo group).
|
|
:original-content (if new-shape? original-content prev-content)
|
|
:update-name? update-name?
|
|
:name name
|
|
:resize-geom resize-geom})))
|
|
(rx/empty))
|
|
(rx/of (dwt/finish-transform)
|
|
(fn [state]
|
|
(-> state
|
|
(update :workspace-new-text-shapes disj id)
|
|
(update :workspace-text-session-geom (fnil dissoc {}) id)))))))))
|
|
|
|
(let [modifiers (get-in state [:workspace-text-modifier id])
|
|
new-shape? (contains? (:workspace-new-text-shapes state) id)]
|
|
(rx/of
|
|
(dwsh/update-shapes [id]
|
|
(fn [shape]
|
|
(let [{:keys [width height position-data]} modifiers]
|
|
(-> shape
|
|
(assoc :content content)
|
|
(cond-> position-data
|
|
(assoc :position-data position-data))
|
|
(cond-> (and update-name? (some? name))
|
|
(assoc :name name))
|
|
(cond-> (or (some? width) (some? height))
|
|
(gsh/transform-shape (ctm/change-size shape width height))))))
|
|
{:undo-group (when new-shape? id)}))))))))
|
|
|
|
(defn- editor-content-update
|
|
"Event saving `content` from the WASM editor, renaming the shape after its text."
|
|
[shape-id content & {:keys [finalize?]}]
|
|
(let [text (txt/content->text content)
|
|
name (when (not= text "")
|
|
(txt/generate-shape-name text))]
|
|
(v2-update-text-shape-content shape-id content
|
|
:update-name? true
|
|
:name name
|
|
:finalize? finalize?)))
|
|
|
|
(defn- layout-item
|
|
"The ancestor of `shape` (or `shape` itself) that is a direct child of its board."
|
|
[objects shape]
|
|
(loop [item shape]
|
|
(let [parent-id (:parent-id item)]
|
|
(if (or (= parent-id (:frame-id shape))
|
|
(nil? (get objects parent-id)))
|
|
item
|
|
(recur (get objects parent-id))))))
|
|
|
|
(defn- v3-sync-text-layout
|
|
"Previews an auto-grow text's live size in its layout, so a fit-content parent
|
|
follows it while typing. Geometry is committed on finalize."
|
|
[id]
|
|
(ptk/reify ::v3-sync-text-layout
|
|
ptk/WatchEvent
|
|
(watch [_ state _]
|
|
(let [objects (dsh/lookup-page-objects state)
|
|
shape (get objects id)
|
|
preview? (and (cfh/text-shape? shape)
|
|
(not= :fixed (:grow-type shape))
|
|
(ctl/any-layout-descent? objects shape)
|
|
(not (ctl/position-absolute? (layout-item objects shape))))
|
|
size (when preview?
|
|
(dwwt/get-wasm-text-new-size shape))
|
|
previous (or (get-in state [::layout-preview id])
|
|
(select-keys (:selrect shape) [:width :height]))]
|
|
;; Modifiers are costly, so skip keystrokes that keep the size.
|
|
(if (and (some? size)
|
|
(not (and (mth/close? (:width size) (:width previous))
|
|
(mth/close? (:height size) (:height previous)))))
|
|
(rx/of #(assoc-in % [::layout-preview id] size)
|
|
(dwm/set-wasm-modifiers (dwwt/resize-wasm-text-modifiers shape)
|
|
:interactive? false))
|
|
(rx/empty))))))
|
|
|
|
(defn v3-stop-text-layout-preview
|
|
"Drops the layout preview of the text `id` and leaves interactive render mode."
|
|
[id]
|
|
(ptk/reify ::v3-stop-text-layout-preview
|
|
ptk/WatchEvent
|
|
(watch [_ state _]
|
|
(if (contains? (get state ::layout-preview) id)
|
|
(rx/of #(update % ::layout-preview dissoc id)
|
|
(dwm/clear-local-transform))
|
|
(rx/empty)))))
|
|
|
|
(defn v3-update-editor-content
|
|
"Commits `content` from the WASM editor to the text `shape-id` and, while
|
|
editing, previews its new size in the layout."
|
|
[shape-id content & {:keys [finalize?]}]
|
|
(let [update-event (editor-content-update shape-id content :finalize? finalize?)]
|
|
(if finalize?
|
|
update-event
|
|
(ptk/reify ::v3-update-editor-content
|
|
ptk/WatchEvent
|
|
(watch [_ _ _]
|
|
(rx/of update-event
|
|
(v3-sync-text-layout shape-id)))))))
|
|
|
|
(defn v3-sync-editor-content
|
|
"Event pushing the WASM editor content back into the shape, or nil when there is
|
|
nothing to sync. Every text edit commits through it, menu or keystroke alike."
|
|
[& {:keys [finalize?]}]
|
|
(when-let [{:keys [shape-id content]} (wasm.text-editor/text-editor-sync-content)]
|
|
(v3-update-editor-content shape-id content :finalize? finalize?)))
|
|
|
|
(defn v3-restore-history
|
|
[direction]
|
|
(ptk/reify ::v3-restore-history
|
|
ptk/WatchEvent
|
|
(watch [_ _ _]
|
|
(if-let [{:keys [shape-id content]} (wasm.api/restore-text-editor-history direction)]
|
|
(do
|
|
(wasm.api/request-render-preserving-target "text-editor-history")
|
|
(rx/of (v3-update-editor-content shape-id content)))
|
|
(rx/empty)))))
|
|
|
|
(defn v3-apply-pending-caret-styles
|
|
"Event saving an insertion made at `before` that consumed the pending caret style:
|
|
the inserted text gets that style as its own span. Nil when nothing changed."
|
|
[shape-id before]
|
|
(wasm.text-editor/with-history-edit
|
|
(fn []
|
|
(let [range (wasm.text-editor/typed-range before (wasm.text-editor/caret-position))]
|
|
;; Sync first so the cached content stays index-aligned with WASM.
|
|
(wasm.text-editor/text-editor-sync-content)
|
|
(if-let [{:keys [content]} (wasm.api/apply-pending-caret-styles! shape-id range)]
|
|
(v3-update-editor-content shape-id content)
|
|
(v3-sync-editor-content))))))
|
|
|
|
(defn- sync-editor-content-stream
|
|
"Stream of the sync event for `reason`, after asking WASM to repaint."
|
|
[reason]
|
|
(let [event (v3-sync-editor-content)]
|
|
(wasm.api/request-render-preserving-target reason)
|
|
(if (some? event)
|
|
(rx/of event)
|
|
(rx/empty))))
|
|
|
|
(defn editor-selection-clipboard-data
|
|
"Clipboard items for the WASM editor selection, or nil when nothing is selected.
|
|
The HTML also carries the styled content for pasting it in Penpot."
|
|
[state]
|
|
(when (and (wasm.text-editor/text-editor-has-focus?)
|
|
(wasm.text-editor/text-editor-has-selection?))
|
|
(let [text (wasm.text-editor/text-editor-export-selection)]
|
|
(when (seq text)
|
|
(let [shape-id (wasm.text-editor/text-editor-get-active-shape-id)
|
|
content (when (features/active-feature? state "text-editor-wasm/v1-html-paste")
|
|
(wasm.text-editor/selection-content shape-id))
|
|
geometry (when (some? content)
|
|
(wasm.text-editor/content-geometry shape-id content
|
|
(wasm.text-editor/selection-start)))
|
|
payload (when (some? content)
|
|
(text-clipboard/payload->html content
|
|
(:current-file-id state)
|
|
(:current-team-id state)
|
|
geometry))]
|
|
{"text/plain" text
|
|
"text/html" (clipboard/plain-text->html text payload)})))))
|
|
|
|
(defn- on-clipboard-error
|
|
[cause]
|
|
(if-let [message (clipboard/error-message cause)]
|
|
(rx/of (ntf/show {:content message
|
|
:type :toast
|
|
:level :warning
|
|
:timeout 5000}))
|
|
(do
|
|
(js/console.error "Clipboard error:" cause)
|
|
(rx/empty))))
|
|
|
|
(defn v3-copy-selection
|
|
"Copy the text editor selection to the system clipboard."
|
|
[]
|
|
(ptk/reify ::v3-copy-selection
|
|
ptk/WatchEvent
|
|
(watch [_ state _]
|
|
(if-let [data (editor-selection-clipboard-data state)]
|
|
(->> (rx/from (clipboard/to-clipboard-multi data))
|
|
(rx/ignore)
|
|
(rx/catch on-clipboard-error))
|
|
(rx/empty)))))
|
|
|
|
(defn v3-cut-selection
|
|
"Copy the text editor selection to the system clipboard and remove it."
|
|
[]
|
|
(ptk/reify ::v3-cut-selection
|
|
ptk/WatchEvent
|
|
(watch [_ state _]
|
|
(if-let [data (editor-selection-clipboard-data state)]
|
|
(->> (rx/from (clipboard/to-clipboard-multi data))
|
|
(rx/mapcat (fn [_]
|
|
;; Delete only once the text is safely on the clipboard,
|
|
;; so a refused clipboard cannot lose the selection.
|
|
(wasm.text-editor/text-editor-delete-backward)
|
|
(sync-editor-content-stream "text-cut")))
|
|
(rx/catch on-clipboard-error))
|
|
(rx/empty)))))
|
|
|
|
(defn payload-content
|
|
"The content of a Penpot text `payload` without what the current file cannot reach.
|
|
A payload without team counts as coming from the current team."
|
|
[state {:keys [content file-id team-id]}]
|
|
(let [current-file-id (:current-file-id state)]
|
|
(text-clipboard/clean-content
|
|
content
|
|
{:valid-file-ids (conj (set (keys (dsh/lookup-libraries state))) current-file-id)
|
|
:same-file? (= file-id current-file-id)
|
|
:same-team? (or (nil? team-id) (= team-id (:current-team-id state)))})))
|
|
|
|
(defn- decode-copied-shapes
|
|
"The copied shapes data in clipboard `text`, or nil when it holds something else."
|
|
[text]
|
|
(when (str/starts-with? (str/trim (or text "")) "{")
|
|
(let [data (ex/ignoring (t/decode-str text))]
|
|
(when (and (map? data)
|
|
(= :copied-shapes (:type data))
|
|
(map? (:objects data))
|
|
(set? (:selected data)))
|
|
data))))
|
|
|
|
(defn copied-text-geometry
|
|
"The geometry (see `text-editor/content-geometry`) of each selected text in
|
|
`objects` with gradient or image spans, by id, for a shape copy; nil when none."
|
|
[state objects selected]
|
|
(when (features/active-feature? state "text-editor-wasm/v1-html-paste")
|
|
(not-empty
|
|
(into {}
|
|
(keep (fn [id]
|
|
(let [{:keys [content] :as shape} (get objects id)]
|
|
(when (cfh/text-shape? shape)
|
|
(some->> (wasm.text-editor/content-geometry id content {:para 0 :offset 0})
|
|
(vector id))))))
|
|
selected))))
|
|
|
|
(defn- text-origins
|
|
"The span origins of `text` in `text-geometry`, nil for each span without one."
|
|
[text-geometry {:keys [id content]}]
|
|
(or (get-in text-geometry [id :origins])
|
|
(mapv #(mapv (constantly nil) (:children %))
|
|
(-> content :children first :children))))
|
|
|
|
(defn- pasteable-text?
|
|
"True when a copied text shape, which other apps or plugins may have written, can
|
|
be pasted into the text editor."
|
|
[{:keys [x y content]}]
|
|
(and (number? x) (number? y) (cts/valid-content? content)))
|
|
|
|
(defn- copied-shapes->payload
|
|
"A text payload joining the content of the copied text shapes, top to bottom and
|
|
left to right; nil when none of the copied shapes is a text or it is not valid."
|
|
[{:keys [objects selected file-id team-id text-geometry]}]
|
|
(let [texts (->> selected
|
|
(keep #(get objects %))
|
|
(filter cfh/text-shape?))]
|
|
(when (and (seq texts) (every? pasteable-text? texts))
|
|
(let [texts (sort-by (juxt :y :x) texts)
|
|
payload (cond-> {:file-id file-id
|
|
:team-id team-id
|
|
:content (assoc-in (:content (first texts))
|
|
[:children 0 :children]
|
|
(into [] (mapcat #(-> % :content :children first :children)) texts))}
|
|
(some? text-geometry)
|
|
(assoc :geometry {:origins (into [] (mapcat (partial text-origins text-geometry)) texts)}))]
|
|
(when (text-clipboard/valid-payload? payload)
|
|
payload)))))
|
|
|
|
(defn- penpot-paste
|
|
[state payload]
|
|
(let [content (payload-content state payload)]
|
|
{:penpot? true
|
|
:content content
|
|
:geometry (:geometry payload)
|
|
:fragment (text-paste/content->fragment content)}))
|
|
|
|
(defn- clipboard->paste
|
|
"What to paste for clipboard `html` and `text`, or nil: text and text shapes copied
|
|
in Penpot keep their styles; any other text takes the caret style."
|
|
[state html text]
|
|
(let [html-paste? (features/active-feature? state "text-editor-wasm/v1-html-paste")
|
|
payload (when html-paste? (text-clipboard/html->payload html))
|
|
shapes (when (and html-paste? (nil? payload)) (decode-copied-shapes text))]
|
|
(cond
|
|
(some? payload)
|
|
(penpot-paste state payload)
|
|
|
|
(some? shapes)
|
|
(some->> (copied-shapes->payload shapes) (penpot-paste state))
|
|
|
|
:else
|
|
(when-let [fragment (or (when (and html-paste? (< 0 (count html) text-clipboard/max-paste-html-length))
|
|
(some-> (text-clipboard/html->fragment html)
|
|
(text-clipboard/without-overrides)))
|
|
(text-clipboard/text->fragment text))]
|
|
{:penpot? false
|
|
:fragment fragment}))))
|
|
|
|
(defn- target-geometry
|
|
"Where the gradient and image spans of `pasted`, inserted at `start`, begin in `shape`
|
|
with `content`, laid over the box it gets once resized to its text; nil when none."
|
|
[{:keys [id grow-type]} content pasted start]
|
|
(when-let [geometry (wasm.text-editor/content-geometry id pasted start)]
|
|
(if (= :fixed grow-type)
|
|
geometry
|
|
;; Auto-sized boxes only fit their text when resized (for the editor, when it
|
|
;; closes), which drops the vertical-align offset in the measured origins.
|
|
(let [{:keys [width height]} (wasm.api/get-text-dimensions id)
|
|
fit (fn [{:keys [box] :as origin}]
|
|
(let [offset (case (some-> (:vertical-align content) name)
|
|
"center" (/ (- (:height box) height) 2)
|
|
"bottom" (- (:height box) height)
|
|
0)]
|
|
(-> origin
|
|
(update :y - offset)
|
|
(assoc :box {:width (if (= :auto-width grow-type) width (:width box))
|
|
:height height}))))]
|
|
(update geometry :origins (partial mapv (partial mapv #(some-> % fit))))))))
|
|
|
|
(defn- move-pasted-fills
|
|
"`content`, the shape's after restyling the paste, with the pasted gradients and
|
|
images keeping their place on their spans. Pushes the result to WASM."
|
|
[shape content {:keys [geometry] :as paste} start]
|
|
(let [pasted (:content paste)
|
|
target (when (some? geometry) (target-geometry shape content pasted start))]
|
|
(if (some? target)
|
|
(let [content (text-paste/move-span-fills content pasted start geometry target)]
|
|
(wasm.api/set-shape-text-content (:id shape) content)
|
|
content)
|
|
content)))
|
|
|
|
(defn move-new-text-fills
|
|
"Event moving the gradients and images of `payload`, just pasted on the canvas as the
|
|
text `id`, so they keep their place on their spans."
|
|
[id {:keys [geometry]}]
|
|
(ptk/reify ::move-new-text-fills
|
|
ptk/WatchEvent
|
|
(watch [_ state _]
|
|
(let [{:keys [content] :as shape} (dsh/lookup-shape state id)
|
|
start {:para 0 :offset 0}
|
|
target (when (and (some? shape) (some? geometry) (wasm.api/initialized?))
|
|
(wselect/use-shape id)
|
|
(wasm.api/set-shape-text-content id content)
|
|
(target-geometry shape content content start))]
|
|
(if (some? target)
|
|
(rx/of (dwsh/update-shapes
|
|
[id]
|
|
#(update % :content text-paste/move-span-fills content start geometry target)
|
|
{:attrs #{:content}}))
|
|
(rx/empty))))))
|
|
|
|
(defn- insert-fragment
|
|
"Insert the text of `fragment` at the caret and restyle it: with its own styles
|
|
or overrides, else with the pending caret style. Returns the event saving it."
|
|
[state {:keys [fragment penpot?] :as paste}]
|
|
(wasm.text-editor/with-history-edit
|
|
(fn []
|
|
(let [shape-id (wasm.text-editor/text-editor-get-active-shape-id)
|
|
start (wasm.text-editor/selection-start)
|
|
styled? (or penpot? (text-paste/styled? fragment))
|
|
pending? (some? (wasm.text-editor/get-pending-caret-styles shape-id))]
|
|
(when styled?
|
|
(wasm.text-editor/clear-pending-caret-styles!))
|
|
(wasm.text-editor/text-editor-insert-text (text-paste/fragment->text fragment))
|
|
(cond
|
|
(nil? start)
|
|
(v3-sync-editor-content)
|
|
|
|
styled?
|
|
(do
|
|
;; Sync first so the cached content stays index-aligned with WASM.
|
|
(wasm.text-editor/text-editor-sync-content)
|
|
(if-let [{:keys [content]} (wasm.api/apply-paste-styles shape-id fragment start penpot?)]
|
|
(let [shape (dsh/lookup-shape state shape-id)]
|
|
(v3-update-editor-content shape-id (move-pasted-fills shape content paste start)))
|
|
(v3-sync-editor-content)))
|
|
|
|
pending?
|
|
(v3-apply-pending-caret-styles shape-id start)
|
|
|
|
:else
|
|
(v3-sync-editor-content))))))
|
|
|
|
(defn v3-paste
|
|
"Paste clipboard `html` and `text` at the caret, replacing the selection."
|
|
[html text]
|
|
(ptk/reify ::v3-paste
|
|
ptk/WatchEvent
|
|
(watch [_ state _]
|
|
(if-let [paste (when (wasm.text-editor/text-editor-has-focus?)
|
|
(clipboard->paste state html text))]
|
|
(let [event (insert-fragment state paste)]
|
|
(wasm.api/request-render-preserving-target "text-paste")
|
|
(if (some? event) (rx/of event) (rx/empty)))
|
|
(rx/empty)))))
|
|
|
|
(defn v3-paste-text
|
|
"Paste the system clipboard at the caret, replacing the selection."
|
|
[]
|
|
(ptk/reify ::v3-paste-text
|
|
ptk/WatchEvent
|
|
(watch [_ _ _]
|
|
(if-not (wasm.text-editor/text-editor-has-focus?)
|
|
(rx/empty)
|
|
(->> (rx/from (clipboard/read-html-and-text))
|
|
(rx/map (fn [{:keys [html text]}] (v3-paste html text)))
|
|
(rx/catch on-clipboard-error))))))
|
|
|
|
(defn v3-select-all
|
|
"Select every character of the text being edited."
|
|
[]
|
|
(ptk/reify ::v3-select-all
|
|
ptk/EffectEvent
|
|
(effect [_ _ _]
|
|
(when (wasm.text-editor/text-editor-has-focus?)
|
|
(wasm.text-editor/clear-pending-caret-styles!)
|
|
(wasm.text-editor/text-editor-select-all)
|
|
(wasm.api/render-text-editor-overlay!)))))
|
|
|
|
(defn replace-layer-names-in-shapes
|
|
[ids search replacement]
|
|
(ptk/reify ::replace-layer-names-in-shapes
|
|
ptk/WatchEvent
|
|
(watch [_ _ _]
|
|
(let [undo-group (uuid/next)]
|
|
(rx/of
|
|
(dwsh/update-shapes
|
|
ids
|
|
(fn [shape] (update shape :name txt/replace-all-case-insensitive search replacement))
|
|
{:attrs #{:name} :undo-group undo-group}))))))
|
|
|
|
(defn replace-text-in-shapes
|
|
[ids search replacement]
|
|
(ptk/reify ::replace-text-in-shapes
|
|
ptk/WatchEvent
|
|
(watch [_ state _]
|
|
(let [undo-group (uuid/next)
|
|
update-event
|
|
(dwsh/update-shapes
|
|
ids
|
|
(fn [shape]
|
|
(if (and (= :text (:type shape)) (some? (:content shape)))
|
|
(let [new-content (txt/replace-text-in-content (:content shape) search replacement)
|
|
new-name (txt/generate-shape-name (txt/content->text new-content))]
|
|
(-> shape (assoc :content new-content) (assoc :name new-name)))
|
|
shape))
|
|
{:attrs #{:content :name} :undo-group undo-group})]
|
|
(rx/concat
|
|
(rx/of update-event)
|
|
(if (features/active-feature? state "render-wasm/v1")
|
|
(->> (rx/from ids)
|
|
(rx/map #(dwwt/resize-wasm-text-debounce % {:undo-group undo-group})))
|
|
(rx/empty)))))))
|
|
|
|
;; -- Text Editor v3
|
|
|
|
;; @see texts_v3.cljs
|