penpot/frontend/test/frontend_tests/util_text_clipboard_test.cljs
alonso.torres b3f7bbf119 ✨ Define Japanese text layout attributes
Add schemas, defaults and helpers for vertical writing, ruby, emphasis
and warichu. Keep readings and notes tied to their own characters when
copying styles, and preserve base text when pasting HTML ruby.

Cover the model, property copying, clipboard and library file builder.
2026-11-03 17:36:39 +01:00

334 lines
16 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 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.common.types.text :as txt]
[app.common.uuid :as uuid]
[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 "<meta charset=\"utf-8\">"
"<b style=\"font-weight:normal;\" id=\"docs-internal-guid-1a2b3c\">"
"<p dir=\"ltr\" style=\"line-height:1.38;margin-top:0pt;margin-bottom:0pt;\">"
"<span style=\"font-size:11pt;font-family:Arial,sans-serif;color:#000000;font-weight:400;font-style:normal;text-decoration:none;white-space:pre;white-space:pre-wrap;\">Hello </span>"
"<span style=\"font-size:11pt;font-family:Arial,sans-serif;color:#000000;font-weight:700;font-style:normal;text-decoration:none;white-space:pre;white-space:pre-wrap;\">bold</span>"
"<span style=\"font-size:11pt;font-family:Arial,sans-serif;color:#000000;font-weight:400;font-style:italic;text-decoration:none;white-space:pre;white-space:pre-wrap;\"> and italic</span>"
"</p><br>"
"<p dir=\"ltr\" style=\"line-height:1.38;margin-top:0pt;margin-bottom:0pt;\">"
"<span style=\"font-size:11pt;font-family:Arial,sans-serif;color:#000000;font-weight:400;white-space:pre-wrap;\">Second</span>"
"</p></b>"))
(def ^:private word-html
(str "<html xmlns:o=\"urn:schemas-microsoft-com:office:office\">"
"<head><style><!-- p.MsoNormal {margin:0cm;} --></style></head>"
"<body lang=EN-US><!--StartFragment-->"
"<p class=MsoNormal><span lang=EN-US>Plain <b>bold</b></span><o:p></o:p></p>\n"
"<p class=MsoNormal><o:p>&nbsp;</o:p></p>\n"
"<p class=MsoNormal><i><span lang=EN-US>italic</span></i><o:p></o:p></p>"
"<!--EndFragment--></body></html>"))
(def ^:private web-page-html
(str "<meta charset='utf-8'>"
"<h2 style=\"color: rgb(0, 0, 0); font-family: Georgia; font-size: 24px;\">Title</h2>"
"<p style=\"color: rgb(0, 0, 0); font-size: 16px; font-weight: 400;\">"
"Some <strong>strong</strong> and "
"<a href=\"https://example.com\" style=\"text-decoration: underline;\">a link</a>.</p>"
"<ul>\n <li>One</li>\n <li>Two</li>\n</ul>"))
(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 &nbsp; 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 "<span style=\"font-weight:600\">semi</span>"))))
(t/testing "light weights are ignored"
(t/is (= [(paragraph (run "light"))]
(html->fragment "<span style=\"font-weight:300\">light</span>")))))
(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 "<u><s>both</s></u>"))))
(t/testing "line-through alone is kept"
(t/is (= [(paragraph (run "gone" {:text-decoration "line-through"}))]
(html->fragment "<del>gone</del>"))))
(t/testing "text-transform is kept"
(t/is (= [(paragraph (run "loud" {:text-transform "uppercase"}))]
(html->fragment "<span style=\"text-transform:uppercase\">loud</span>")))))
(t/deftest whitespace
(t/testing "collapsible whitespace collapses and is trimmed at line ends"
(t/is (= [(paragraph (run "a b"))]
(html->fragment "<p> a \n b </p>"))))
(t/testing "&nbsp; is kept as a space"
(t/is (= [(paragraph (run "a b"))]
(html->fragment "<p>a&nbsp;&nbsp;b</p>"))))
(t/testing "pre keeps spaces and splits lines into paragraphs"
(t/is (= [(paragraph (run "line 1"))
(paragraph (run " line 2"))]
(html->fragment "<pre>line 1\n line 2</pre>")))))
(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<br>b"))))
(t/testing "runs of empty lines collapse into one"
(t/is (= [(paragraph (run "a")) (paragraph) (paragraph (run "b"))]
(html->fragment "<p>a</p><br><br><br><p>b</p>"))))
(t/testing "empty lines at both ends are dropped"
(t/is (= [(paragraph (run "a"))]
(html->fragment "<br><p>a</p><br><br>")))))
(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
"<table><tr><td>a</td><td> b</td></tr><tr><td>c</td><td>d</td></tr></table>")))))
(t/deftest ruby-keeps-the-base-text
(t/testing "the annotated text is pasted and the reading is dropped"
(t/is (= [(paragraph (run "漢字です"))]
(html->fragment "<p><ruby>漢字<rt>かんじ</rt></ruby>です</p>"))))
(t/testing "rb bases and rp fallback parentheses"
(t/is (= [(paragraph (run "漢字"))]
(html->fragment
(str "<ruby><rb>漢</rb><rp>(</rp><rt>かん</rt><rp>)</rp></ruby>"
"<ruby>字<rp>(</rp><rt>じ</rt><rp>)</rp></ruby>"))))))
(t/deftest hidden-content-is-skipped
(t/testing "style, script and display:none give no text"
(t/is (= [(paragraph (run "shown"))]
(html->fragment
"<style>p{color:red}</style><p>shown</p><script>x()</script><p style=\"display:none\">hidden</p>"))))
(t/testing "elements outside the allowlist are skipped with their text"
(t/is (= [(paragraph (run "kept"))]
(html->fragment
"<p>kept<my-widget>custom</my-widget><button>Buy</button><textarea>typed</textarea></p>"))))
(t/testing "HTML without text gives no fragment"
(t/is (nil? (html->fragment "<img src=\"x.png\">")))))
(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 "")))))
(t/deftest without-overrides
(t/testing "external HTML keeps its text and paragraphs but no emphasis"
(t/is (= [(paragraph (plain-run "Hello bold and italic"))
(paragraph)
(paragraph (plain-run "Second"))]
(clipboard/without-overrides (html->fragment google-docs-html)))))
(t/testing "empty paragraphs stay empty"
(t/is (= [(paragraph)]
(clipboard/without-overrides [(paragraph)])))))
;; --- Penpot payload
(def ^:private file-id (uuid/next))
(def ^:private team-id (uuid/next))
(defn- text-content [& spans]
{:type "root"
:children [{:type "paragraph-set"
:children [{:type "paragraph" :text-align "center" :children (vec spans)}]}]})
(def ^:private gradient-span
{:text "Ñandú 😀 \"<b>\""
:font-id "custom-6e2c1a5e-1c1e-4b54-9c64-2a8c5f1a4c11"
:font-family "Brand Sans"
:font-variant-id "bold"
:font-weight "700"
:font-style "italic"
:fills [{:fill-color-gradient {:type :linear :start-x 0 :start-y 0 :end-x 1 :end-y 1 :width 1
:stops [{:color "#ff0000" :opacity 1 :offset 0}
{:color "#0000ff" :opacity 1 :offset 1}]}
:fill-opacity 1}]})
(t/deftest payload-round-trip
(let [content (text-content gradient-span)
hidden (clipboard/payload->html content file-id team-id)]
(t/testing "the payload decodes back to the same content, file and team"
(t/is (= {:type :copied-text :version 1 :file-id file-id :team-id team-id :content content}
(clipboard/html->payload (str "<meta charset=\"utf-8\">" hidden "Hello")))))
(t/testing "it survives the markup browsers add around it"
(let [safari (-> hidden
(.replace "></span>" " style=\"color: rgb(0, 0, 0); font-size: medium;\"></span>"))]
(t/is (= content
(:content (clipboard/html->payload
(str "<head><meta charset=\"UTF-8\"></head>" safari "Hello")))))))))
(t/deftest payload-geometry-round-trip
(let [content (text-content gradient-span)
geometry {:origins [[{:x 12.5 :y 0.2 :box {:width 200 :height 40}}]]}
hidden (clipboard/payload->html content file-id team-id geometry)]
(t/testing "the payload keeps where the copied spans sat in their text box"
(t/is (= geometry (:geometry (clipboard/html->payload hidden)))))
(t/testing "the content stays as copied"
(t/is (= content (:content (clipboard/html->payload hidden)))))))
(t/deftest html-without-payload
(t/testing "HTML without a payload, or with a broken one, gives nil"
(t/is (nil? (clipboard/html->payload "<p>Hello</p>")))
(t/is (nil? (clipboard/html->payload "<span data-penpot-text=\"bm90IHRyYW5zaXQ=\"></span>")))
(t/is (nil? (clipboard/html->payload nil)))))
(defn- tampered-html
"Payload markup carrying `payload` as is, as a plugin could write it."
[{:keys [content file-id team-id geometry]}]
(clipboard/payload->html content file-id team-id geometry))
(def ^:private valid-payload
{:content (text-content gradient-span) :file-id file-id :team-id team-id})
(t/deftest invalid-payload
(t/testing "a valid payload is read"
(t/is (some? (clipboard/html->payload (tampered-html valid-payload)))))
(t/testing "a payload with a broken envelope is dropped"
(t/is (nil? (clipboard/html->payload (tampered-html (assoc valid-payload :file-id "file")))))
(t/is (nil? (clipboard/html->payload (tampered-html (assoc valid-payload :team-id 42))))))
(t/testing "a payload whose content a text shape cannot hold is dropped"
(t/is (nil? (clipboard/html->payload
(tampered-html (assoc-in valid-payload [:content :children 0 :children] [])))))
(t/is (nil? (clipboard/html->payload
(tampered-html (assoc valid-payload :content (text-content (assoc gradient-span :text 42)))))))
(t/is (nil? (clipboard/html->payload
(tampered-html (assoc valid-payload :content
(text-content (assoc gradient-span :fills [{:fill-color "red"}]))))))))
(t/testing "a payload with geometry that is not plain numbers is dropped"
(let [origin {:x 12.5 :y 0.2 :box {:width 200 :height 40}}]
(t/is (some? (clipboard/html->payload
(tampered-html (assoc valid-payload :geometry {:origins [[origin]]})))))
(t/is (nil? (clipboard/html->payload
(tampered-html (assoc valid-payload :geometry {:origins [[(assoc origin :x "12")]]})))))
(t/is (nil? (clipboard/html->payload
(tampered-html (assoc valid-payload :geometry {:origins [[(assoc origin :y ##NaN)]]})))))
(t/is (nil? (clipboard/html->payload
(tampered-html (assoc valid-payload :geometry {:origins [[(assoc-in origin [:box :width] nil)]]})))))
(t/is (nil? (clipboard/html->payload
(tampered-html (assoc valid-payload :geometry {:origins [[origin]] :extra 1}))))))))
(t/deftest oversized-payload
(t/testing "HTML over the paste size limit is not decoded"
(let [hidden (clipboard/payload->html (text-content gradient-span) file-id team-id)]
(t/is (nil? (clipboard/html->payload
(str hidden (apply str (repeat clipboard/max-paste-html-length "x")))))))))
;; --- Clean-up
(def ^:private image-fill
{:fill-image {:id (uuid/next) :width 10 :height 10 :mtype "image/png"} :fill-opacity 1})
(def ^:private red-fill
{:fill-color "#ff0000" :fill-opacity 1})
(defn- spans-of [content]
(-> content :children first :children first :children))
(t/deftest clean-content
(let [library-id (uuid/next)
typography {:typography-ref-file library-id :typography-ref-id (uuid/next)}
content (text-content (merge gradient-span typography)
{:text "img" :fills [image-fill red-fill]}
{:text "only img" :fills [image-fill]})
same {:valid-file-ids #{library-id} :same-team? true :same-file? true}]
(t/testing "in the same file nothing changes"
(t/is (= content (clipboard/clean-content content same))))
(t/testing "typographies from unreachable files are dropped"
(t/is (nil? (-> (clipboard/clean-content content (assoc same :valid-file-ids #{}))
(spans-of)
(first)
:typography-ref-id))))
(t/testing "custom fonts from another team become the default font, at the closest variant"
(let [span (first (spans-of (clipboard/clean-content content (assoc same :same-team? false))))]
(t/is (= {:font-id "sourcesanspro" :font-family "sourcesanspro"
:font-variant-id "bolditalic" :font-weight "700" :font-style "italic"}
(select-keys span [:font-id :font-family :font-variant-id :font-weight :font-style])))
(t/is (nil? (:typography-ref-id span)))))
(t/testing "builtin and google fonts stay in another team"
(let [content (text-content (assoc gradient-span :font-id "gfont-roboto" :font-family "Roboto"))]
(t/is (= content (clipboard/clean-content content (assoc same :same-team? false))))))
(t/testing "images from another file are dropped, leaving the default fill when nothing is left"
(t/is (= [(:fills gradient-span) [red-fill] (txt/get-default-text-fills)]
(map :fills (spans-of (clipboard/clean-content content (assoc same :same-file? false)))))))))
(t/deftest replace-custom-fonts
(t/testing "only custom fonts become the default font"
(let [content (text-content gradient-span (assoc gradient-span :font-id "gfont-roboto" :font-family "Roboto"))]
(t/is (= ["sourcesanspro" "gfont-roboto"]
(map :font-id (spans-of (clipboard/replace-custom-fonts content))))))))