From 7c039231f79022f26b252776817c41fa61476aa3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bel=C3=A9n=20Albeza?= Date: Fri, 2 Oct 2026 15:07:12 +0200 Subject: [PATCH] :tada: Implement paste of basic HTML formatting (v3) (#12050) * :sparkles: Add rich HTML paste to the v3 text editor Pasting HTML into the v3 text editor keeps bold, italic, decoration and text-transform, and drops fonts, colors and links. Gated behind text-editor-wasm/v1-html-paste. Refs #10465 AI-assisted-by: claude-opus-5-5 * :sparkles: Paste HTML on the canvas as a styled text shape With v3 HTML paste on, pasting HTML on the canvas creates a text shape with the same emphasis. Clipboard options are now read at paste time. Refs #10465 AI-assisted-by: claude-opus-5-5 --- common/src/app/common/features.cljc | 3 + .../app/main/data/workspace/clipboard.cljs | 32 ++- .../ui/workspace/shapes/text/v3_editor.cljs | 69 ++++- frontend/src/app/render_wasm/api.cljs | 13 + frontend/src/app/render_wasm/text_editor.cljs | 2 +- frontend/src/app/render_wasm/text_paste.cljs | 92 +++++++ frontend/src/app/util/text/clipboard.cljs | 254 ++++++++++++++++++ .../render_wasm/text_paste_test.cljs | 146 ++++++++++ frontend/test/frontend_tests/runner.cljs | 4 + .../util_text_clipboard_test.cljs | 165 ++++++++++++ 10 files changed, 756 insertions(+), 24 deletions(-) create mode 100644 frontend/src/app/render_wasm/text_paste.cljs create mode 100644 frontend/src/app/util/text/clipboard.cljs create mode 100644 frontend/test/frontend_tests/render_wasm/text_paste_test.cljs create mode 100644 frontend/test/frontend_tests/util_text_clipboard_test.cljs diff --git a/common/src/app/common/features.cljc b/common/src/app/common/features.cljc index c29b99aee3..281ed4c9bb 100644 --- a/common/src/app/common/features.cljc +++ b/common/src/app/common/features.cljc @@ -56,6 +56,7 @@ "text-editor/v2-html-paste" "text-editor/v2" "text-editor-wasm/v1" + "text-editor-wasm/v1-html-paste" "render-wasm/v1" "variants/v1"}) @@ -81,6 +82,7 @@ "text-editor/v2-html-paste" "text-editor/v2" "text-editor-wasm/v1" + "text-editor-wasm/v1-html-paste" "tokens/numeric-input" "render-wasm/v1"}) @@ -131,6 +133,7 @@ :feature-text-editor-v2 "text-editor/v2" :feature-text-editor-v2-html-paste "text-editor/v2-html-paste" :feature-text-editor-wasm "text-editor-wasm/v1" + :feature-text-editor-wasm-html-paste "text-editor-wasm/v1-html-paste" :feature-render-wasm "render-wasm/v1" :feature-variants "variants/v1" :feature-token-input "tokens/numeric-input" diff --git a/frontend/src/app/main/data/workspace/clipboard.cljs b/frontend/src/app/main/data/workspace/clipboard.cljs index 7145bd3ad5..fabf3e3fed 100644 --- a/frontend/src/app/main/data/workspace/clipboard.cljs +++ b/frontend/src/app/main/data/workspace/clipboard.cljs @@ -53,12 +53,14 @@ [app.main.router :as rt] [app.main.store :as st] [app.main.streams :as ms] + [app.render-wasm.text-paste :as text-paste] [app.util.clipboard :as clipboard] [app.util.code-gen.markup-svg :as svg] [app.util.code-gen.style-css :as css] [app.util.globals :as ug] [app.util.http :as http] [app.util.i18n :as i18n :refer [tr]] + [app.util.text.clipboard :as text-clipboard] [app.util.text.content :as tc] [app.util.webapi :as wapi] [beicon.v2.core :as rx] @@ -261,9 +263,15 @@ (declare ^:private paste-svg-text) (declare ^:private paste-shapes) -(def ^:private default-options +(defn- v3-html-paste? + [state] + (and (features/active-feature? state "text-editor-wasm/v1") + (features/active-feature? state "text-editor-wasm/v1-html-paste"))) + +(defn- clipboard-options + [state] #js {:decodeTransit t/decode-str - :allowHTMLPaste (features/active-feature? @st/state "text-editor/v2-html-paste")}) + :allowHTMLPaste (v3-html-paste? state)}) (defn- create-paste-from-blob [in-viewport? replace?] @@ -328,7 +336,7 @@ ptk/WatchEvent (watch [_ state _] (if (page-ready? (dsh/lookup-page-objects state)) - (->> (clipboard/from-navigator default-options) + (->> (clipboard/from-navigator (clipboard-options state)) (rx/mapcat (create-paste-from-blob false (boolean replace?))) (rx/take 1) (rx/catch on-clipboard-permission-error)) @@ -349,7 +357,7 @@ ;; Pastes arriving before the page is loaded are ignored as well. (if (or is-editing? (not (page-ready? objects))) (rx/empty) - (->> (clipboard/from-synthetic-clipboard-event event default-options) + (->> (clipboard/from-synthetic-clipboard-event event (clipboard-options state)) (rx/mapcat (create-paste-from-blob in-viewport? false)))))))) (defn copy-selected-svg @@ -529,7 +537,7 @@ (rx/empty)))))] (if (page-ready? (dsh/lookup-page-objects state)) - (->> (clipboard/from-navigator default-options) + (->> (clipboard/from-navigator (clipboard-options state)) (rx/mapcat #(.text %)) (rx/map decode-entry) (rx/take 1) @@ -1057,11 +1065,15 @@ (ptk/reify ::paste-html-text ptk/WatchEvent (watch [_ state _] - (let [style (deref refs/workspace-clipboard-style) - root (dwtxt/create-root-from-html html style (features/active-feature? @st/state "text-editor/v2-html-paste")) - text (.-textContent root) - content (tc/dom->cljs root)] - (when (types.text/valid-content? content) + (let [[text content] + (if (v3-html-paste? state) + (when-let [fragment (text-clipboard/html->fragment html)] + [(text-paste/fragment->text fragment) + (text-paste/fragment->content fragment (txt/get-default-text-attrs))]) + (let [style (deref refs/workspace-clipboard-style) + root (dwtxt/create-root-from-html html style (features/active-feature? @st/state "text-editor/v2-html-paste"))] + [(.-textContent root) (tc/dom->cljs root)]))] + (when (and (some? content) (types.text/valid-content? content)) (let [id (uuid/next) width (max 8 (min (* 7 (count text)) 700)) height 16 diff --git a/frontend/src/app/main/ui/workspace/shapes/text/v3_editor.cljs b/frontend/src/app/main/ui/workspace/shapes/text/v3_editor.cljs index 1c95406ef5..8ed1cb50fe 100644 --- a/frontend/src/app/main/ui/workspace/shapes/text/v3_editor.cljs +++ b/frontend/src/app/main/ui/workspace/shapes/text/v3_editor.cljs @@ -15,14 +15,17 @@ [app.main.data.workspace :as dw] [app.main.data.workspace.texts :as dwt] [app.main.data.workspace.undo :as dwu] + [app.main.features :as features] [app.main.refs :as refs] [app.main.store :as st] [app.main.ui.css-cursors :as cur] [app.render-wasm.api :as wasm.api] [app.render-wasm.text-editor :as text-editor] + [app.render-wasm.text-paste :as text-paste] [app.util.clipboard :as clipboard] [app.util.dom :as dom] [app.util.keyboard :as kbd] + [app.util.text.clipboard :as text-clipboard] [app.util.timers :as ts] [cuerdas.core :as str] [rumext.v2 :as mf])) @@ -78,6 +81,16 @@ {:start-para (:para after) :start-offset (:offset after) :end-para (:para before) :end-offset (:offset before)}))) +(defn- commit-restyled-content + "Save `content` restyled after an insertion, renaming the shape after its text." + [shape-id content] + (let [text (txt/content->text content) + name (when (not= text "") (txt/generate-shape-name text))] + (st/emit! (dwt/v2-update-text-shape-content + shape-id content + :update-name? true + :name name)))) + (defn- sync-with-pending-caret-styles! "Commit an insertion that consumed a pending caret style: sync the new text, then restyle the just-typed `range` into its own span. `before` is the @@ -87,12 +100,43 @@ ;; Sync first so the cached content stays index-aligned with WASM. (text-editor/text-editor-sync-content) (if-let [{:keys [content]} (wasm.api/apply-pending-caret-styles! shape-id range)] - (let [text (txt/content->text content) - name (when (not= text "") (txt/generate-shape-name text))] - (st/emit! (dwt/v2-update-text-shape-content - shape-id content - :update-name? true - :name name))) + (commit-restyled-content shape-id content) + (sync-wasm-text-editor-content!)))) + +;; Bigger HTML is pasted as plain text rather than walked. +(def ^:private max-paste-html-length 1000000) + +(defn- clipboard->fragment + "The paste fragment for `data`: its HTML when allowed and it has text, else its plain text." + [^js data html-paste?] + (let [html (when html-paste? (.getData data "text/html"))] + (or (when (< 0 (count html) max-paste-html-length) + (text-clipboard/html->fragment html)) + (text-clipboard/text->fragment (.getData data "text/plain"))))) + +(defn- selection-start + "Start of the WASM selection as {:para :offset}: where pasted text goes." + [] + (when-let [{:keys [anchor-para anchor-offset focus-para focus-offset]} + (text-editor/text-editor-get-selection)] + (if (or (< anchor-para focus-para) + (and (= anchor-para focus-para) (<= anchor-offset focus-offset))) + {:para anchor-para :offset anchor-offset} + {:para focus-para :offset focus-offset}))) + +(defn- paste-fragment + "Insert the text of `fragment`, then restyle it with the fragment overrides." + [fragment] + (let [shape-id (text-editor/text-editor-get-active-shape-id) + start (selection-start)] + (text-editor/text-editor-insert-text (text-paste/fragment->text fragment)) + (if (and (some? start) (text-paste/styled? fragment)) + (do + ;; Sync first so the cached content stays index-aligned with WASM. + (text-editor/text-editor-sync-content) + (if-let [{:keys [content]} (wasm.api/apply-paste-styles shape-id fragment start)] + (commit-restyled-content shape-id content) + (sync-wasm-text-editor-content!))) (sync-wasm-text-editor-content!)))) (defn- reset-input-node @@ -273,13 +317,12 @@ (dom/prevent-default event) ;; Pasted text keeps the surrounding style; drop any pending caret style. (text-editor/clear-pending-caret-styles!) - (let [clipboard-data (.-clipboardData event) - text (.getData clipboard-data "text/plain")] - (when (and text (seq text)) - (text-editor/text-editor-insert-text text) - (sync-wasm-text-editor-content!) - (wasm.api/request-render-preserving-target "text-paste")) - (reset-input-node (mf/ref-val contenteditable-ref))))) + (when-let [fragment (some-> (.-clipboardData event) + (clipboard->fragment + (features/active-feature? @st/state "text-editor-wasm/v1-html-paste")))] + (paste-fragment fragment) + (wasm.api/request-render-preserving-target "text-paste")) + (reset-input-node (mf/ref-val contenteditable-ref)))) on-copy (mf/use-fn diff --git a/frontend/src/app/render_wasm/api.cljs b/frontend/src/app/render_wasm/api.cljs index d9340bc5c5..59ad963352 100644 --- a/frontend/src/app/render_wasm/api.cljs +++ b/frontend/src/app/render_wasm/api.cljs @@ -51,6 +51,7 @@ [app.render-wasm.performance :as perf] [app.render-wasm.rulers-state :as rulers-state] [app.render-wasm.text-editor :as text-editor] + [app.render-wasm.text-paste :as text-paste] [app.util.debug :as dbg] [app.util.dom :as dom] [app.util.functions :as fns] @@ -805,6 +806,18 @@ (request-render "apply-pending-caret-styles") result))) +(defn apply-paste-styles + "Restyle the text just pasted at `start` with the overrides of `fragment`; + returns {:shape-id :content}, or nil when the shape has no cached content." + [shape-id fragment start] + (when-let [content (text-editor/get-cached-content shape-id)] + (let [content (text-paste/apply-fragment-styles content fragment start)] + (wselect/use-shape shape-id) + (set-shape-text-content shape-id content) + (request-render "apply-paste-styles") + {:shape-id shape-id + :content content}))) + (defn set-parent-id [id] (let [buffer (uuid/get-u32 id)] diff --git a/frontend/src/app/render_wasm/text_editor.cljs b/frontend/src/app/render_wasm/text_editor.cljs index 2f60004eac..ed82300c09 100644 --- a/frontend/src/app/render_wasm/text_editor.cljs +++ b/frontend/src/app/render_wasm/text_editor.cljs @@ -739,7 +739,7 @@ (= 1 (count fills-set)) (first fills-set) :else :multiple))) -(defn- apply-styles-over-range +(defn apply-styles-over-range "Apply `styles` (attrs map or per-span fn) to the char range of `content`, splitting spans." [content {:keys [start-para start-offset end-para end-offset]} styles] (let [paragraph-set (first (:children content)) diff --git a/frontend/src/app/render_wasm/text_paste.cljs b/frontend/src/app/render_wasm/text_paste.cljs new file mode 100644 index 0000000000..afb72674f6 --- /dev/null +++ b/frontend/src/app/render_wasm/text_paste.cljs @@ -0,0 +1,92 @@ +;; 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.render-wasm.text-paste + "Restyles the text WASM just inserted from a paste fragment (see + `app.util.text.clipboard`) with each run's overrides." + (:require + [app.main.fonts :as fonts] + [app.render-wasm.text-editor :as text-editor] + [cuerdas.core :as str])) + +(defn fragment->text + [fragment] + (->> fragment + (map (fn [paragraph] (str/join (map :text (:children paragraph))))) + (str/join "\n"))) + +(defn styled? + [fragment] + (some (fn [paragraph] (some (comp seq :attrs) (:children paragraph))) fragment)) + +(defn- styled-ranges + "The content range of every run with overrides, for a fragment inserted at + `start` (`{:para :offset}`, offsets in UTF-16 units like WASM's)." + [fragment {:keys [para offset]}] + (for [[idx paragraph] (map-indexed vector fragment) + :let [para-idx (+ para idx) + runs (:children paragraph) + starts (reductions + (if (zero? idx) offset 0) + (map (comp count :text) runs))] + [run run-start] (map vector runs starts) + :when (seq (:attrs run))] + {:attrs (:attrs run) + :range {:start-para para-idx + :start-offset run-start + :end-para para-idx + :end-offset (+ run-start (count (:text run)))}})) + +(defn- target-weight + "The weight for `span` given a weight override. \"400\" means not bold, so it + only unbolds: a span below bold keeps its own weight." + [span font-weight] + (let [current (or (:font-weight span) "400")] + (if (and (= font-weight "400") (< (js/parseInt current 10) 600)) + current + (or font-weight current)))) + +(defn- resolve-overrides + "`span` with `overrides`, weight and italic resolved to a variant its font has. + A changed span leaves its typography, which it no longer matches." + [span {:keys [font-weight font-style] :as overrides}] + (let [variant (when (or font-weight font-style) + (some-> (fonts/get-font-data (:font-id span)) + (fonts/find-closest-variant + (target-weight span font-weight) + (or font-style (:font-style span) "normal")))) + result (cond-> (merge span (select-keys overrides [:text-decoration :text-transform])) + (some? variant) + (assoc :font-weight (:weight variant) + :font-style (:style variant) + :font-variant-id (:id variant)))] + (if (= result span) + span + (dissoc result :typography-ref-id :typography-ref-file)))) + +(defn fragment->content + "Penpot content for `fragment`, with `base` as the style its overrides go over." + [fragment base] + {:type "root" + :children + [{:type "paragraph-set" + :children + (mapv (fn [{:keys [children]}] + (merge base + {:type "paragraph" + :children (if (seq children) + (mapv (fn [{:keys [text attrs]}] + (resolve-overrides (assoc base :text text) attrs)) + children) + [(assoc base :text "")])})) + fragment)}]}) + +(defn apply-fragment-styles + "Restyles the `fragment` text WASM inserted at `start` in `content`." + [content fragment start] + (reduce (fn [content {:keys [range attrs]}] + (text-editor/apply-styles-over-range content range #(resolve-overrides % attrs))) + content + (styled-ranges fragment start))) diff --git a/frontend/src/app/util/text/clipboard.cljs b/frontend/src/app/util/text/clipboard.cljs new file mode 100644 index 0000000000..963f49b688 --- /dev/null +++ b/frontend/src/app/util/text/clipboard.cljs @@ -0,0 +1,254 @@ +;; 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.util.text.clipboard + "Reads clipboard data into paste fragments: `[{:attrs {} :children [{:text :attrs}]}]`, + where run attrs are emphasis overrides laid over the style at the caret." + (:require + [cuerdas.core :as str])) + +(def ^:private block-tags + #{"ADDRESS" "ARTICLE" "ASIDE" "BLOCKQUOTE" "CAPTION" "DD" "DETAILS" "DIV" "DL" + "DT" "FIELDSET" "FIGCAPTION" "FIGURE" "FOOTER" "FORM" "H1" "H2" "H3" "H4" + "H5" "H6" "HEADER" "HR" "LI" "MAIN" "NAV" "OL" "P" "PRE" "SECTION" + "SUMMARY" "TABLE" "TBODY" "TFOOT" "THEAD" "TR" "UL"}) + +;; Elements whose text is read; any other element is skipped with its children. +;; `O:P` is Word's paragraph filler, which marks its empty lines. +(def ^:private allowed-tags + (into block-tags + #{"A" "ABBR" "B" "BDI" "BDO" "BIG" "BR" "CENTER" "CITE" "CODE" "DATA" + "DEL" "DFN" "EM" "FONT" "I" "INS" "KBD" "LABEL" "MARK" "O:P" "Q" "S" + "SAMP" "SMALL" "SPAN" "STRIKE" "STRONG" "SUB" "SUP" "TD" "TH" "TIME" + "TT" "U" "VAR" "WBR"})) + +(def ^:private bold-tags #{"B" "STRONG" "TH" "H1" "H2" "H3" "H4" "H5" "H6"}) +(def ^:private italic-tags #{"I" "EM" "CITE" "VAR" "DFN"}) +(def ^:private underline-tags #{"U" "INS"}) +(def ^:private strike-tags #{"S" "STRIKE" "DEL"}) +(def ^:private cell-tags #{"TD" "TH"}) + +(defn- style-value + [^js element property] + (some-> (.-style element) (.getPropertyValue property) str/lower)) + +(defn- parse-bold + "True/false for a CSS font-weight, nil when it says nothing." + [weight] + (cond + (empty? weight) nil + (#{"bold" "bolder"} weight) true + (#{"normal" "lighter"} weight) false + :else (let [n (js/parseInt weight 10)] + (when-not (js/isNaN n) (>= n 600))))) + +(defn- parse-italic + [font-style] + (cond + (empty? font-style) nil + (or (= font-style "italic") (str/starts-with? font-style "oblique")) true + (= font-style "normal") false + :else nil)) + +(defn- display-block? + [display] + (some #(str/starts-with? display %) ["block" "list-item" "table" "flex" "grid"])) + +(defn- element-state + "The emphasis state inside `element`, or nil when hidden. Inline styles win over + tags, so Google Docs' `` wrapper is not bold." + [state ^js element tag] + (let [display (or (style-value element "display") "") + weight (parse-bold (style-value element "font-weight")) + italic (parse-italic (style-value element "font-style")) + decoration (str (style-value element "text-decoration-line") " " + (style-value element "text-decoration")) + transform (style-value element "text-transform") + space (style-value element "white-space")] + (when-not (= display "none") + (cond-> state + (contains? bold-tags tag) (assoc :bold? true) + (some? weight) (assoc :bold? weight) + (contains? italic-tags tag) (assoc :italic? true) + (some? italic) (assoc :italic? italic) + (contains? underline-tags tag) (assoc :underline? true) + (str/includes? decoration "underline") (assoc :underline? true) + (contains? strike-tags tag) (assoc :strike? true) + (str/includes? decoration "line-through") (assoc :strike? true) + (= tag "A") (assoc :link? true) + (= tag "PRE") (assoc :pre? true) + (seq space) (assoc :pre? (str/starts-with? space "pre")) + (= transform "none") (dissoc :transform) + (#{"uppercase" "lowercase" "capitalize"} transform) (assoc :transform transform))))) + +(defn- block-element? + [^js element tag] + (let [display (or (style-value element "display") "")] + (if (seq display) + (display-block? display) + (contains? block-tags tag)))) + +(defn- state->attrs + "Penpot text attrs for an emphasis state, with every attr set so the source + replaces the caret's emphasis. Link underlines go with the link." + [{:keys [bold? italic? underline? strike? link? transform]}] + (let [underline? (and underline? (not link?))] + {:font-weight (if bold? "700" "400") + :font-style (if italic? "italic" "normal") + :text-decoration (cond underline? "underline" strike? "line-through" :else "none") + :text-transform (or transform "none")})) + +;; --- Fragment builder +;; +;; `:runs` is the paragraph being built; `:space?` is true when the next +;; collapsible space would be dropped (paragraph start or after a space). + +(def ^:private empty-builder + {:paragraphs [] :runs [] :space? true}) + +(defn- trim-trailing-space + [runs] + (let [idx (dec (count runs)) + run (get runs idx)] + (if (and run (not (:pre? run))) + (update runs idx update :text str/rtrim " ") + runs))) + +(defn- close-paragraph + [{:keys [runs] :as builder}] + (-> builder + (update :paragraphs conj (trim-trailing-space runs)) + (assoc :runs [] :space? true))) + +(defn- soft-break + "Ends the paragraph at a block boundary, unless nothing was written yet." + [{:keys [runs] :as builder}] + (if (some #(seq (:text %)) runs) + (close-paragraph builder) + (assoc builder :runs []))) + +(defn- add-run + [builder text attrs pre?] + (update builder :runs conj {:text text :attrs attrs :pre? pre?})) + +(defn- add-collapsible-text + [{:keys [space?] :as builder} text attrs] + (let [text (cond-> (str/replace text #"[ \t\n\r\f]+" " ") + space? (str/ltrim " "))] + (if (empty? text) + builder + (-> builder + (add-run text attrs false) + (assoc :space? (str/ends-with? text " ")))))) + +(defn- add-pre-text + [builder text attrs] + (let [lines (.split (str/replace text "\r" "") "\n")] + (reduce (fn [builder [idx line]] + (cond-> builder + (pos? idx) (close-paragraph) + (seq line) (add-run line attrs true) + :always (assoc :space? false))) + builder + (map-indexed vector lines)))) + +(defn- add-text + [builder text state] + (let [attrs (state->attrs state)] + (if (:pre? state) + (add-pre-text builder text attrs) + (add-collapsible-text builder text attrs)))) + +(defn- walk-node + [builder ^js node state] + (case (.-nodeType node) + 3 (add-text builder (.-nodeValue node) state) + 1 (let [tag (str/upper (.-tagName node))] + (if-not (contains? allowed-tags tag) + builder + (if-let [state (element-state state node tag)] + (if (= tag "BR") + (close-paragraph builder) + (let [block? (block-element? node tag) + ;; Cells of a row are joined by a tab. + cell? (and (contains? cell-tags tag) + (some? (.-previousElementSibling node))) + builder (cond-> builder + block? (soft-break) + cell? (-> (add-run "\t" (state->attrs state) true) + (assoc :space? true))) + builder (reduce #(walk-node %1 %2 state) + builder + (array-seq (.-childNodes node)))] + (cond-> builder block? (soft-break)))) + builder))) + builder)) + +;; --- Normalizing + +(defn- merge-runs + "Joins neighbouring runs that share attrs and drops empty ones." + [runs] + (reduce (fn [acc {:keys [text attrs]}] + (let [prev (peek acc)] + (cond + (empty? text) acc + (= (:attrs prev) attrs) (conj (pop acc) (update prev :text str text)) + :else (conj acc {:text text :attrs attrs})))) + [] + runs)) + +(defn- runs->paragraph + [runs] + (let [runs (->> runs + (map #(update % :text str/replace " " " ")) + (merge-runs))] + {:attrs {} + :children (if (every? #(str/blank? (:text %)) runs) [] runs)})) + +(defn- empty-paragraph? + [paragraph] + (empty? (:children paragraph))) + +(defn- normalize-paragraphs + "Drops empty paragraphs at both ends and keeps at most one in a row." + [paragraphs] + (let [paragraphs (->> paragraphs + (drop-while empty-paragraph?) + (reverse) + (drop-while empty-paragraph?) + (reverse))] + (->> paragraphs + (partition-by empty-paragraph?) + (mapcat #(if (empty-paragraph? (first %)) [(first %)] %)) + (vec)))) + +(defn document->fragment + "The paste fragment for a parsed HTML document, or nil when it has no text." + [^js document] + (let [paragraphs (->> (array-seq (.-childNodes (.-body document))) + (reduce #(walk-node %1 %2 {}) empty-builder) + (soft-break) + :paragraphs + (map runs->paragraph) + (normalize-paragraphs))] + (when (seq paragraphs) + paragraphs))) + +(defn html->fragment + [html] + (-> (js/DOMParser.) + (.parseFromString html "text/html") + (document->fragment))) + +(defn text->fragment + "The paste fragment for plain text, one paragraph per line, or nil when empty." + [text] + (when (seq text) + (mapv (fn [line] + {:attrs {} + :children (if (empty? line) [] [{:text line :attrs {}}])}) + (.split (str/replace text "\r" "") "\n")))) diff --git a/frontend/test/frontend_tests/render_wasm/text_paste_test.cljs b/frontend/test/frontend_tests/render_wasm/text_paste_test.cljs new file mode 100644 index 0000000000..7394d031a4 --- /dev/null +++ b/frontend/test/frontend_tests/render_wasm/text_paste_test.cljs @@ -0,0 +1,146 @@ +;; 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 frontend-tests.render-wasm.text-paste-test + "Restyling pasted text. Test content already holds the pasted text in the + style of the span it went into, as after `text-editor-sync-content`." + (:require + [app.render-wasm.text-paste :as text-paste] + [cljs.test :as t :include-macros true])) + +(def ^:private regular + {:font-id "sourcesanspro" :font-variant-id "regular" + :font-weight "400" :font-style "normal"}) + +(defn- span + ([text] (span text {})) + ([text attrs] (merge regular attrs {:text text}))) + +(defn- content [& paragraphs] + {:type "root" + :children [{:type "paragraph-set" + :children (mapv (fn [spans] {:type "paragraph" :children spans}) + paragraphs)}]}) + +(defn- spans-of [content] + (mapv :children (-> content :children first :children))) + +(defn- fragment-paragraph [& runs] + {:attrs {} :children (vec runs)}) + +(defn- run + ([text] (run text {})) + ([text attrs] {:text text :attrs attrs})) + +(def ^:private bold-variant + {:font-weight "700" :font-style "normal" :font-variant-id "bold"}) + +(t/deftest fragment->text + (t/testing "paragraphs are joined by newlines" + (t/is (= "ab\n\nc" + (text-paste/fragment->text + [(fragment-paragraph (run "a") (run "b")) + (fragment-paragraph) + (fragment-paragraph (run "c"))]))))) + +(t/deftest bold-run-resolves-to-a-font-variant + (t/testing "a bold run inside a paragraph gets the bold variant of the span's font" + (let [pasted (content [(span "Hello big world")]) + fragment [(fragment-paragraph (run "big " {:font-weight "700"}))] + result (text-paste/apply-fragment-styles pasted fragment {:para 0 :offset 6})] + (t/is (= [[(span "Hello ") (span "big " bold-variant) (span "world")]] + (spans-of result)))))) + +(t/deftest italic-run-keeps-the-span-weight + (t/testing "italic over a bold span picks the bold italic variant" + (let [pasted (content [(span "x" bold-variant)]) + fragment [(fragment-paragraph (run "x" {:font-style "italic"}))] + result (text-paste/apply-fragment-styles pasted fragment {:para 0 :offset 0})] + (t/is (= [[(span "x" {:font-weight "700" :font-style "italic" + :font-variant-id "bolditalic"})]] + (spans-of result)))))) + +(t/deftest html-emphasis-replaces-the-caret-emphasis + (let [no-emphasis {:font-weight "400" :font-style "normal" + :text-decoration "none" :text-transform "none"}] + (t/testing "plain source text pasted into bold, underlined text comes out plain" + (let [pasted (content [(span "aXb" (assoc bold-variant :text-decoration "underline"))]) + fragment [(fragment-paragraph (run "X" no-emphasis))] + result (text-paste/apply-fragment-styles pasted fragment {:para 0 :offset 1})] + (t/is (= [[(span "a" (assoc bold-variant :text-decoration "underline")) + (span "X" {:text-decoration "none" :text-transform "none"}) + (span "b" (assoc bold-variant :text-decoration "underline"))]] + (spans-of result))))) + + (t/testing "not bold leaves a light weight as it is" + (let [light {:font-weight "300" :font-style "normal" :font-variant-id "300"} + pasted (content [(span "X" light)]) + fragment [(fragment-paragraph (run "X" no-emphasis))] + result (text-paste/apply-fragment-styles pasted fragment {:para 0 :offset 0})] + (t/is (= [[(span "X" (assoc light :text-decoration "none" :text-transform "none"))]] + (spans-of result))))))) + +(t/deftest unknown-font-keeps-its-weight + (t/testing "a font we have no data for cannot resolve a variant, so it stays" + (let [unknown (span "x" {:font-id "missing-font"}) + fragment [(fragment-paragraph (run "x" {:font-weight "700"}))] + result (text-paste/apply-fragment-styles (content [unknown]) fragment {:para 0 :offset 0})] + (t/is (= [[unknown]] (spans-of result)))))) + +(t/deftest typography-link + (let [linked {:typography-ref-id "typo-id" :typography-ref-file "file-id"}] + (t/testing "a span changed by the paste leaves its typography" + (let [fragment [(fragment-paragraph (run "x" {:text-decoration "underline"}))] + result (text-paste/apply-fragment-styles + (content [(span "x" linked)]) fragment {:para 0 :offset 0})] + (t/is (= [[(span "x" {:text-decoration "underline"})]] + (spans-of result))))) + + (t/testing "a span the paste leaves as it was keeps its typography" + (let [already (span "x" (merge bold-variant linked)) + fragment [(fragment-paragraph (run "x" {:font-weight "700"}))] + result (text-paste/apply-fragment-styles (content [already]) fragment {:para 0 :offset 0})] + (t/is (= [[already]] (spans-of result))))))) + +(t/deftest ranges-across-paragraphs + (t/testing "runs after the first paragraph start at offset 0 of their paragraph" + (let [pasted (content [(span "abX")] [(span "Ycd")]) + fragment [(fragment-paragraph (run "X" {:font-weight "700"})) + (fragment-paragraph (run "Y" {:font-weight "700"}))] + result (text-paste/apply-fragment-styles pasted fragment {:para 0 :offset 2})] + (t/is (= [[(span "ab") (span "X" bold-variant)] + [(span "Y" bold-variant) (span "cd")]] + (spans-of result)))))) + +(t/deftest ranges-count-utf16-units + (t/testing "an emoji in the fragment moves later runs by its two UTF-16 units" + (let [pasted (content [(span "😀b")]) + fragment [(fragment-paragraph (run "😀") (run "b" {:font-weight "700"}))] + result (text-paste/apply-fragment-styles pasted fragment {:para 0 :offset 0})] + (t/is (= [[(span "😀") (span "b" bold-variant)]] + (spans-of result))))) + + (t/testing "a paste after an emoji starts at the UTF-16 offset WASM reports" + (let [pasted (content [(span "😀Xb")]) + fragment [(fragment-paragraph (run "X" {:font-weight "700"}))] + result (text-paste/apply-fragment-styles pasted fragment {:para 0 :offset 2})] + (t/is (= [[(span "😀") (span "X" bold-variant) (span "b")]] + (spans-of result)))))) + +(t/deftest fragment->content + (t/testing "runs become spans over the base style, and empty paragraphs keep one empty span" + (let [result (text-paste/fragment->content + [(fragment-paragraph (run "Hello ") (run "bold" {:font-weight "700"})) + (fragment-paragraph)] + regular)] + (t/is (= [[(span "Hello ") (span "bold" bold-variant)] + [(span "")]] + (spans-of result))))) + + (t/testing "paragraphs carry the base style" + (let [result (text-paste/fragment->content [(fragment-paragraph (run "x"))] regular)] + (t/is (= (assoc regular :type "paragraph") + (dissoc (-> result :children first :children first) :children)))))) diff --git a/frontend/test/frontend_tests/runner.cljs b/frontend/test/frontend_tests/runner.cljs index 349cdfd029..6c0c436df0 100644 --- a/frontend/test/frontend_tests/runner.cljs +++ b/frontend/test/frontend_tests/runner.cljs @@ -85,6 +85,7 @@ [frontend-tests.render-wasm.serialization-test] [frontend-tests.render-wasm.text-editor-apply-styles-test] [frontend-tests.render-wasm.text-editor-caret-color-test] + [frontend-tests.render-wasm.text-paste-test] [frontend-tests.router-test] [frontend-tests.svg-fills-test] [frontend-tests.svg-filters-test] @@ -123,6 +124,7 @@ [frontend-tests.util-queue-test] [frontend-tests.util-range-tree-test] [frontend-tests.util-simple-math-test] + [frontend-tests.util-text-clipboard-test] [frontend-tests.util-text-editor-test] [frontend-tests.util-webapi-test] [frontend-tests.util-zip-test] @@ -222,6 +224,7 @@ 'frontend-tests.render-wasm.serialization-test 'frontend-tests.render-wasm.text-editor-apply-styles-test 'frontend-tests.render-wasm.text-editor-caret-color-test + 'frontend-tests.render-wasm.text-paste-test 'frontend-tests.router-test 'frontend-tests.svg-fills-test 'frontend-tests.svg-filters-test @@ -261,6 +264,7 @@ 'frontend-tests.util-queue-test 'frontend-tests.util-range-tree-test 'frontend-tests.util-simple-math-test + 'frontend-tests.util-text-clipboard-test 'frontend-tests.util-text-editor-test 'frontend-tests.util-webapi-test 'frontend-tests.util.dom.dnd-test diff --git a/frontend/test/frontend_tests/util_text_clipboard_test.cljs b/frontend/test/frontend_tests/util_text_clipboard_test.cljs new file mode 100644 index 0000000000..a8f65d6e4f --- /dev/null +++ b/frontend/test/frontend_tests/util_text_clipboard_test.cljs @@ -0,0 +1,165 @@ +;; 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 frontend-tests.util-text-clipboard-test + "Clipboard HTML and plain text read into paste fragments. Only emphasis + survives; the documents come from jsdom since the runner has no DOM." + (:require + ["jsdom" :refer [JSDOM]] + [app.util.text.clipboard :as clipboard] + [cljs.test :as t :include-macros true])) + +(defn- html->fragment + [html] + (let [window (.-window (JSDOM. "")) + parser (new (.-DOMParser window))] + (clipboard/document->fragment (.parseFromString parser html "text/html")))) + +(defn- paragraph [& runs] + {:attrs {} :children (vec runs)}) + +;; HTML runs carry every emphasis attr, so the source decides it. +(def ^:private no-emphasis + {:font-weight "400" :font-style "normal" :text-decoration "none" :text-transform "none"}) + +(defn- run + ([text] (run text {})) + ([text attrs] {:text text :attrs (merge no-emphasis attrs)})) + +(defn- plain-run + [text] + {:text text :attrs {}}) + +(def ^:private bold {:font-weight "700"}) +(def ^:private italic {:font-style "italic"}) + +(def ^:private google-docs-html + (str "" + "" + "

" + "Hello " + "bold" + " and italic" + "


" + "

" + "Second" + "

")) + +(def ^:private word-html + (str "" + "" + "" + "

Plain bold

\n" + "

 

\n" + "

italic

" + "")) + +(def ^:private web-page-html + (str "" + "

Title

" + "

" + "Some strong and " + "a link.

" + "")) + +(t/deftest google-docs-keeps-emphasis + (t/testing "the font-weight:normal wrapper does not make the whole paste bold" + (t/is (= [(paragraph (run "Hello ") (run "bold" bold) (run " and italic" italic)) + (paragraph) + (paragraph (run "Second"))] + (html->fragment google-docs-html))))) + +(t/deftest word-keeps-emphasis + (t/testing "Word markup and its empty   paragraphs map to plain paragraphs" + (t/is (= [(paragraph (run "Plain ") (run "bold" bold)) + (paragraph) + (paragraph (run "italic" italic))] + (html->fragment word-html))))) + +(t/deftest web-page-drops-fonts-colors-links-and-list-markers + (t/testing "headings are bold, links lose their underline, list items become paragraphs" + (t/is (= [(paragraph (run "Title" bold)) + (paragraph (run "Some ") (run "strong" bold) (run " and a link.")) + (paragraph (run "One")) + (paragraph (run "Two"))] + (html->fragment web-page-html))))) + +(t/deftest font-weight-threshold + (t/testing "600 and above is bold" + (t/is (= [(paragraph (run "semi" bold))] + (html->fragment "semi")))) + + (t/testing "light weights are ignored" + (t/is (= [(paragraph (run "light"))] + (html->fragment "light"))))) + +(t/deftest decoration-and-transform + (t/testing "underline wins over line-through, as a span holds one decoration" + (t/is (= [(paragraph (run "both" {:text-decoration "underline"}))] + (html->fragment "both")))) + + (t/testing "line-through alone is kept" + (t/is (= [(paragraph (run "gone" {:text-decoration "line-through"}))] + (html->fragment "gone")))) + + (t/testing "text-transform is kept" + (t/is (= [(paragraph (run "loud" {:text-transform "uppercase"}))] + (html->fragment "loud"))))) + +(t/deftest whitespace + (t/testing "collapsible whitespace collapses and is trimmed at line ends" + (t/is (= [(paragraph (run "a b"))] + (html->fragment "

a \n b

")))) + + (t/testing "  is kept as a space" + (t/is (= [(paragraph (run "a b"))] + (html->fragment "

a  b

")))) + + (t/testing "pre keeps spaces and splits lines into paragraphs" + (t/is (= [(paragraph (run "line 1")) + (paragraph (run " line 2"))] + (html->fragment "
line 1\n  line 2
"))))) + +(t/deftest line-breaks-and-empty-paragraphs + (t/testing "br starts a new paragraph" + (t/is (= [(paragraph (run "a")) (paragraph (run "b"))] + (html->fragment "a
b")))) + + (t/testing "runs of empty lines collapse into one" + (t/is (= [(paragraph (run "a")) (paragraph) (paragraph (run "b"))] + (html->fragment "

a




b

")))) + + (t/testing "empty lines at both ends are dropped" + (t/is (= [(paragraph (run "a"))] + (html->fragment "

a



"))))) + +(t/deftest tables + (t/testing "each row is a paragraph with its cells joined by a tab" + (t/is (= [(paragraph (run "a\tb")) (paragraph (run "c\td"))] + (html->fragment + "
a b
cd
"))))) + +(t/deftest hidden-content-is-skipped + (t/testing "style, script and display:none give no text" + (t/is (= [(paragraph (run "shown"))] + (html->fragment + "

shown

hidden

")))) + + (t/testing "elements outside the allowlist are skipped with their text" + (t/is (= [(paragraph (run "kept"))] + (html->fragment + "

keptcustom

")))) + + (t/testing "HTML without text gives no fragment" + (t/is (nil? (html->fragment ""))))) + +(t/deftest plain-text + (t/testing "each line is a paragraph and CRLF counts as one break" + (t/is (= [(paragraph (plain-run "a")) (paragraph) (paragraph (plain-run "b"))] + (clipboard/text->fragment "a\r\n\r\nb")))) + + (t/testing "empty text gives no fragment" + (t/is (nil? (clipboard/text->fragment "")))))