From 783e0470becbbb1c434209a62aea471eed14c6f6 Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Wed, 22 Nov 2023 09:37:48 +0100 Subject: [PATCH] :sparkles: Add general improvements to copy paste Cleaning code and adding more safety checks --- common/src/app/common/text.cljc | 13 + frontend/src/app/main/data/workspace.cljs | 603 ++++++++++-------- .../src/app/main/data/workspace/changes.cljs | 4 +- .../src/app/main/data/workspace/texts.cljs | 2 +- frontend/src/app/main/errors.cljs | 30 +- frontend/src/app/main/store.cljs | 5 + .../app/main/ui/workspace/context_menu.cljs | 4 +- .../main/ui/workspace/viewport/actions.cljs | 13 +- frontend/src/app/util/object.cljs | 6 +- frontend/src/app/util/webapi.cljs | 55 +- frontend/translations/en.po | 7 + 11 files changed, 434 insertions(+), 308 deletions(-) diff --git a/common/src/app/common/text.cljc b/common/src/app/common/text.cljc index 554a7d7c0..d95500f7d 100644 --- a/common/src/app/common/text.cljc +++ b/common/src/app/common/text.cljc @@ -59,6 +59,19 @@ item)) root))) +(defn xform-nodes + "The same as transform but instead of receiving a funcion, receives + a transducer." + [xf root] + (let [rf (fn [_ v] v)] + (walk/postwalk + (fn [item] + (let [rf (xf rf)] + (if (map? item) + (d/nilv (rf nil item) item) + item))) + root))) + (defn node-seq ([root] (node-seq identity root)) ([match? root] diff --git a/frontend/src/app/main/data/workspace.cljs b/frontend/src/app/main/data/workspace.cljs index 9bb6c994d..1d3eb97f1 100644 --- a/frontend/src/app/main/data/workspace.cljs +++ b/frontend/src/app/main/data/workspace.cljs @@ -9,6 +9,8 @@ [app.common.attrs :as attrs] [app.common.data :as d] [app.common.data.macros :as dm] + [app.common.exceptions :as ex] + [app.common.features :as cfeat] [app.common.files.changes-builder :as pcb] [app.common.files.helpers :as cfh] [app.common.geom.align :as gal] @@ -17,6 +19,7 @@ [app.common.geom.rect :as grc] [app.common.geom.shapes :as gsh] [app.common.geom.shapes.grid-layout :as gslg] + [app.common.schema :as sm] [app.common.text :as txt] [app.common.transit :as t] [app.common.types.component :as ctk] @@ -77,6 +80,7 @@ [app.util.webapi :as wapi] [beicon.core :as rx] [cljs.spec.alpha :as s] + [clojure.set :as set] [cuerdas.core :as str] [potok.core :as ptk])) @@ -1531,60 +1535,47 @@ (assoc data :selected selected))) - ;; Retrieve all ids of selected shapes with corresponding - ;; children; this is needed because each shape should be - ;; processed one by one because of async events (data url - ;; fetching). - (collect-object-ids [objects res id] - (let [obj (get objects id)] - (reduce (partial collect-object-ids objects) - (assoc res id obj) - (:shapes obj)))) + (fetch-image [entry] + (let [url (cf/resolve-file-media entry)] + (->> (http/send! {:method :get + :uri url + :response-type :blob}) + (rx/map :body) + (rx/mapcat wapi/read-file-as-data-url) + (rx/map #(assoc entry :data %))))) ;; Prepare the shape object. Mainly needed for image shapes ;; for retrieve the image data and convert it to the ;; data-url. - (prepare-object [objects parent-frame-id {:keys [type] :as obj}] - (let [obj (maybe-translate obj objects parent-frame-id) + (prepare-object [objects parent-frame-id obj] + (let [obj (maybe-translate obj objects parent-frame-id) ;; Texts can have different fills for pieces of the text - fill-images-data (->> (or (:position-data obj) [obj]) - (map :fills) - (reduce into []) - (filter :fill-image) - (map :fill-image)) + imgdata (concat + (->> (or (:position-data obj) [obj]) + (mapcat :fills) + (keep :fill-image)) + (->> (:strokes obj) + (keep :stroke-image)) + (when (cfh/image-shape? obj) + [(:metadata obj)]))] - stroke-images-data (->> (:strokes obj) - (filter :stroke-image) - (map :stroke-image)) - images-data (concat - fill-images-data - stroke-images-data - (when (= type :image) - [(:metadata obj)]))] - - (if (> (count images-data) 0) - (->> (rx/from images-data) - (rx/mapcat (fn [image-data] - (let [url (cf/resolve-file-media image-data)] - (->> (http/send! {:method :get - :uri url - :response-type :blob}) - (rx/map :body) - (rx/mapcat wapi/read-file-as-data-url) - (rx/map #(assoc image-data :data %)))))) + (if (seq imgdata) + (->> (rx/from imgdata) + (rx/mapcat fetch-image) (rx/reduce conj []) - (rx/map - (fn [images] - (assoc obj ::data images)))) + (rx/map (fn [images] + (assoc obj ::images images)))) (rx/of obj)))) ;; Collects all the items together and split images into a ;; separated data structure for a more easy paste process. - (collect-data [res {:keys [id] :as item}] - (let [res (update res :objects assoc id (dissoc item ::data))] - (if (::data item) - (update res :images into (::data item)) - res))) + (collect-data [result {:keys [id ::images] :as item}] + (cond-> result + :always + (update :objects assoc id (dissoc item ::images)) + + (some? images) + (update :images into images))) (maybe-translate [shape objects parent-frame-id] (if (= parent-frame-id uuid/zero) @@ -1593,122 +1584,128 @@ (gsh/translate-to-frame shape frame)))) (on-copy-error [error] - (js/console.error "Clipboard blocked:" error) + (js/console.error "clipboard blocked:" error) (rx/empty))] (ptk/reify ::copy-selected ptk/WatchEvent (watch [_ state _] - (let [objects (wsh/lookup-page-objects state) - selected (->> (wsh/lookup-selected state) - (cfh/clean-loops objects)) - - parent-frame-id (cfh/common-parent-frame objects selected) - pdata (reduce (partial collect-object-ids objects) {} selected) - initial {:type :copied-shapes - :file-id (:current-file-id state) - :selected selected - :objects {} - :images #{}} - selected_text (.. js/window getSelection toString)] - - (if (not-empty selected_text) + (let [text (wapi/get-current-selected-text)] + (if-not (str/empty? text) (try - (wapi/write-to-clipboard selected_text) + (wapi/write-to-clipboard text) (catch :default e (on-copy-error e))) - (->> (rx/from (seq (vals pdata))) - (rx/merge-map (partial prepare-object objects parent-frame-id)) - (rx/reduce collect-data initial) - (rx/map (partial sort-selected state)) - (rx/map t/encode-str) - (rx/map wapi/write-to-clipboard) - (rx/catch on-copy-error) - (rx/ignore)))))))) -(declare paste-shape) -(declare paste-text) -(declare paste-image) -(declare paste-svg) + (let [objects (wsh/lookup-page-objects state) + selected (->> (wsh/lookup-selected state) + (cfh/clean-loops objects)) + features (features/get-team-enabled-features state) -(def paste - (ptk/reify ::paste - ptk/WatchEvent - (watch [_ _ _] - (try - (let [clipboard-str (wapi/read-from-clipboard) + file-id (:current-file-id state) + frame-id (cfh/common-parent-frame objects selected) + version (dm/get-in state [:workspace-data :version]) - paste-transit-str - (->> clipboard-str - (rx/filter t/transit?) - (rx/map t/decode-str) - (rx/filter #(= :copied-shapes (:type %))) - (rx/map #(select-keys % [:selected :objects])) - (rx/map paste-shape)) + initial {:type :copied-shapes + :features features + :version version + :file-id file-id + :selected selected + :objects {} + :images #{}} - paste-plain-text-str - (->> clipboard-str - (rx/filter (comp not empty?)) - (rx/map paste-text)) + shapes (->> (cfh/selected-with-children objects selected) + (keep (d/getf objects)))] - paste-image-str + (->> (rx/from shapes) + (rx/merge-map (partial prepare-object objects frame-id)) + (rx/reduce collect-data initial) + (rx/map (partial sort-selected state)) + (rx/map #(t/encode-str % {:type :json-verbose})) + (rx/map wapi/write-to-clipboard) + (rx/catch on-copy-error) + (rx/ignore))))))))) + +(declare ^:private paste-transit) +(declare ^:private paste-text) +(declare ^:private paste-image) +(declare ^:private paste-svg-text) +(declare ^:private paste-shapes) + +(defn paste-from-clipboard + "Perform a `paste` operation using the Clipboard API." + [] + (letfn [(decode-entry [entry] + (try + [:transit (t/decode-str entry)] + (catch :default _cause + [:text entry]))) + + (process-entry [[type data]] + (case type + :text + (if (str/empty? data) + (rx/empty) + (rx/of (paste-text data))) + + :transit + (rx/of (paste-transit data)))) + + (on-error [cause] + (let [data (ex-data cause)] + (if (:not-implemented data) + (rx/of (msg/warn (tr "errors.clipboard-not-implemented"))) + (js/console.error "Clipboard error:" cause)) + (rx/empty)))] + + (ptk/reify ::paste-from-clipboard + ptk/WatchEvent + (watch [_ _ _] + (->> (rx/concat + (->> (wapi/read-from-clipboard) + (rx/map decode-entry) + (rx/mapcat process-entry)) (->> (wapi/read-image-from-clipboard) - (rx/map paste-image))] + (rx/map paste-image))) + (rx/take 1) + (rx/catch on-error)))))) - (->> (rx/concat paste-transit-str - paste-plain-text-str - paste-image-str) - (rx/take 1) - (rx/catch - (fn [err] - (js/console.error "Clipboard error:" err) - (rx/empty))))) - (catch :default e - (let [data (ex-data e)] - (if (:not-implemented data) - (rx/of (msg/warn (tr "errors.clipboard-not-implemented"))) - (js/console.error "ERROR" e)))))))) (defn paste-from-event + "Perform a `paste` operation from user emmited event." [event in-viewport?] (ptk/reify ::paste-from-event ptk/WatchEvent (watch [_ state _] - (try - (let [objects (wsh/lookup-page-objects state) - paste-data (wapi/read-from-paste-event event) - image-data (wapi/extract-images paste-data) - text-data (wapi/extract-text paste-data) - decoded-data (and (t/transit? text-data) - (t/decode-str text-data)) + (let [objects (wsh/lookup-page-objects state) + edit-id (dm/get-in state [:workspace-local :edition]) + is-editing? (and edit-id (= :text (get-in objects [edit-id :type])))] - edit-id (get-in state [:workspace-local :edition]) - is-editing-text? (and edit-id (= :text (get-in objects [edit-id :type])))] - - ;; Some paste events can be fired while we're editing a text - ;; we forbid that scenario so the default behaviour is executed - (when-not is-editing-text? + ;; Some paste events can be fired while we're editing a text + ;; we forbid that scenario so the default behaviour is executed + (if is-editing? + (rx/empty) + (let [pdata (wapi/read-from-paste-event event) + image-data (some-> pdata wapi/extract-images) + text-data (some-> pdata wapi/extract-text) + transit-data (ex/ignoring (some-> text-data t/decode-str))] (cond (and (string? text-data) - (str/includes? text-data "> (rx/from image-data) + (rx/map paste-image)) - (coll? decoded-data) - (->> (rx/of decoded-data) - (rx/filter #(= :copied-shapes (:type %))) - (rx/map #(paste-shape % in-viewport?))) + (coll? transit-data) + (rx/of (paste-transit (assoc transit-data :in-viewport in-viewport?))) (string? text-data) (rx/of (paste-text text-data)) :else - (rx/empty)))) - - (catch :default err - (js/console.error "Clipboard error:" err)))))) + (rx/empty)))))))) (defn selected-frame? [state] (let [selected (wsh/lookup-selected state) @@ -1737,15 +1734,63 @@ (= (:width (:selrect (first (vals paste-obj)))) (:width (:selrect frame-obj))))) -(defn- paste-shape - [{selected :selected - paste-objects :objects ;; rename this because here comes only the clipboard shapes, - images :images ;; not the whole page tree of shapes. - :as data} - in-viewport?] - (letfn [;; Given a file-id and img (part generated by the - ;; copy-selected event), uploads the new media. - (upload-media [file-id imgpart] +(defn- check-paste-features! + "Function used for check feature compability between currently + enabled features set on the application with the provided featured + set by the paste data." + [enabled-features paste-features] + (let [not-supported (-> enabled-features + (set/difference paste-features) + ;; NOTE: we don't want to raise a feature-mismatch + ;; exception for features which don't require an + ;; explicit file migration process or has no real + ;; effect on file data structure + (set/difference cfeat/no-migration-features))] + + (when (seq not-supported) + (ex/raise :type :restriction + :code :missing-features-in-paste-content + :feature (first not-supported) + :hint (str/ffmt "expected features '%' not present in pasted content" + (str/join "," not-supported))))) + + (let [not-supported (set/difference enabled-features cfeat/supported-features)] + (when (seq not-supported) + (ex/raise :type :restriction + :code :paste-feature-not-supported + :feature (first not-supported) + :hint (str/ffmt "features '%' not supported in the application" + (str/join "," not-supported))))) + + (let [not-supported (-> paste-features + (set/difference enabled-features) + (set/difference cfeat/backend-only-features) + (set/difference cfeat/frontend-only-features))] + + (when (seq not-supported) + (ex/raise :type :restriction + :code :paste-feature-not-enabled + :feature (first not-supported) + :hint (str/ffmt "paste features '%' not enabled on the application" + (str/join "," not-supported)))))) + +(def ^:private schema:paste-data + (sm/define + [:map {:title "paste-data"} + [:type [:= :copied-shapes]] + [:features ::sm/set-of-strings] + [:version :int] + [:file-id ::sm/uuid] + [:selected ::sm/set-of-uuid] + [:objects + [:map-of ::sm/uuid :map]] + [:images [:set :map]] + [:position {:optional true} ::gpt/point]])) + +(defn- paste-transit + [{:keys [images] :as pdata}] + + (letfn [(upload-media [file-id imgpart] (->> (http/send! {:uri (:data imgpart) :response-type :blob :method :get}) @@ -1756,51 +1801,70 @@ :file-id file-id :content blob :is-local true})) - (rx/mapcat #(rp/cmd! :upload-file-media-object %)) - (rx/map (fn [media] - (assoc media :prev-id (:id imgpart)))))) + (rx/mapcat (partial rp/cmd! :upload-file-media-object)) + (rx/map #(assoc % :prev-id (:id imgpart)))))] - (translate-staled-media [mdata attribute media-idx] - (let [id (get-in mdata [attribute :id]) + (ptk/reify ::paste-transit + ptk/WatchEvent + (watch [_ state _] + (let [file-id (:current-file-id state) + features (features/get-team-enabled-features state)] + + (sm/validate! schema:paste-data pdata + {:hint "invalid paste data" + :code :invalid-paste-data}) + + (check-paste-features! features (:features pdata)) + (if (= file-id (:file-id pdata)) + (let [pdata (assoc pdata :images [])] + (rx/of (paste-shapes pdata))) + (->> (rx/from images) + (rx/merge-map (partial upload-media file-id)) + (rx/reduce conj []) + (rx/map #(assoc pdata :images %)) + (rx/map paste-shapes)))))))) + +(defn paste-shapes + [{in-viewport? :in-viewport :as pdata}] + (letfn [(translate-media [mdata media-idx attr-path] + (let [id (get-in mdata attr-path) mobj (get media-idx id)] (if mobj - (update mdata attribute #(assoc % - :id (:id mobj) - :path (:path mobj))) + (update-in mdata attr-path (fn [value] + (-> value + (assoc :id (:id mobj)) + (assoc :path (:path mobj))))) mdata))) + (add-obj? [chg] + (= (:type chg) :add-obj)) + ;; Analyze the rchange and replace staled media and ;; references to the new uploaded media-objects. - (process-rchange [media-idx item] + (process-rchange [media-idx change] (let [;; Texts can have different fills for pieces of the text - obj (:obj item) - fills (mapv #(translate-staled-media % :fill-image media-idx) (:fills obj)) - strokes (mapv #(translate-staled-media % :stroke-image media-idx) (:strokes obj)) - position-data (->> (:position-data obj) - (mapv (fn [p-data] - (let [fills (mapv #(translate-staled-media % :fill-image media-idx) (:fills p-data))] - (assoc p-data :fills fills))))) - content (txt/transform-nodes #(translate-staled-media % :fill-image media-idx) (:content obj))] + tr-fill-xf (map #(translate-media % media-idx [:fill-image :id])) + tr-stroke-xf (map #(translate-media % media-idx [:stroke-image :id]))] - (if (= (:type item) :add-obj) - (-> item - (update-in [:obj :metadata] - (fn [{:keys [id] :as mdata}] - (if-let [mobj (get media-idx id)] - (assoc mdata - :id (:id mobj) - :path (:path mobj)) - mdata))) - (assoc-in [:obj :fills] fills) - (assoc-in [:obj :strokes] strokes) - (assoc-in [:obj :content] content) - (cond-> - (> (count position-data) 0) (assoc-in [:obj :position-data] position-data))) - item))) + (if (add-obj? change) + (update change :obj (fn [obj] + (-> obj + (update :fills #(into [] tr-fill-xf %)) + (update :strokes #(into [] tr-stroke-xf %)) + (d/update-when :metadata translate-media media-idx [:id]) + (d/update-when :content + (fn [content] + (txt/xform-nodes tr-fill-xf content))) + (d/update-when :position-data + (fn [position-data] + (mapv (fn [pos-data] + (update pos-data :fills #(into [] tr-fill-xf %))) + position-data)))))) + change))) - (calculate-paste-position [state mouse-pos in-viewport?] + (calculate-paste-position [state pobjects selected position] (let [page-objects (wsh/lookup-page-objects state) - selected-objs (map #(get paste-objects %) selected) + selected-objs (map (d/getf pobjects) selected) first-selected-obj (first selected-objs) page-selected (wsh/lookup-selected state) wrapper (gsh/shapes->rect selected-objs) @@ -1809,12 +1873,12 @@ frame-object (get page-objects frame-id) base (cfh/get-base-shape page-objects page-selected) index (cfh/get-position-on-parent page-objects (:id base)) - tree-root (get-tree-root-shapes paste-objects) + tree-root (get-tree-root-shapes pobjects) only-one-root-shape? (and - (< 1 (count paste-objects)) + (< 1 (count pobjects)) (= 1 (count tree-root))) - all-objects (merge page-objects paste-objects) - comps-nesting-loop? (not (->> (keys paste-objects) + all-objects (merge page-objects pobjects) + comps-nesting-loop? (not (->> (keys pobjects) (map #(cfh/components-nesting-loop? all-objects % (:id base))) (every? nil?)))] @@ -1822,13 +1886,13 @@ comps-nesting-loop? ;; Avoid placing a shape as a direct or indirect child of itself, ;; or inside its main component if it's in a copy. - [uuid/zero uuid/zero (gpt/subtract mouse-pos orig-pos)] + [uuid/zero uuid/zero (gpt/subtract position orig-pos)] (selected-frame? state) - (if (or (any-same-frame-from-selected? state (keys paste-objects)) + (if (or (any-same-frame-from-selected? state (keys pobjects)) (and only-one-root-shape? - (frame-same-size? paste-objects (first tree-root)))) + (frame-same-size? pobjects (first tree-root)))) ;; Paste next to selected frame, if selected is itself or of the same size as the copied (let [selected-frame-obj (get page-objects (first page-selected)) parent-id (:parent-id base) @@ -1872,114 +1936,119 @@ [frame-id frame-id delta (dec (count (:shapes selected-frame-obj )))])) (empty? page-selected) - (let [frame-id (ctst/top-nested-frame page-objects mouse-pos) - delta (gpt/subtract mouse-pos orig-pos)] + (let [frame-id (ctst/top-nested-frame page-objects position) + delta (gpt/subtract position orig-pos)] [frame-id frame-id delta]) :else (let [frame-id (:frame-id base) parent-id (:parent-id base) delta (if in-viewport? - (gpt/subtract mouse-pos orig-pos) + (gpt/subtract position orig-pos) (gpt/subtract (gpt/point (:selrect base)) orig-pos))] [frame-id parent-id delta index])))) ;; Change the indexes of the pasted shapes - (change-add-obj-index [paste-objects selected index change] - (let [index (or index -1) ;; if there is no current element selected, we want the first (inc index) to be 0 + (change-add-obj-index [objects selected index change] + (let [;; if there is no current element selected, we want + ;; the first (inc index) to be 0 + index (d/nilv index -1) set-index (fn [[result index] id] [(assoc result id index) (inc index)]) + ;; FIXME: optimize ??? map-ids (->> selected - (map #(get-in paste-objects [% :id])) + (map #(get-in objects [% :id])) (reduce set-index [{} (inc index)]) first)] - (if (and (= :add-obj (:type change)) + + (if (and (add-obj? change) (contains? map-ids (:old-id change))) (assoc change :index (get map-ids (:old-id change))) change))) - ;; Proceed with the standard shape paste process. - (do-paste [it state mouse-pos media] - (let [libraries (wsh/get-libraries state) - file-id (:current-file-id state) - page (wsh/lookup-page state) - page-objects (:objects page) - media-idx (d/index-by :prev-id media) + (process-shape [file-id frame-id parent-id shape] + (cond-> shape + :always + (assoc :frame-id frame-id :parent-id parent-id) - ;; Calculate position for the pasted elements - [frame-id parent-id delta index] (calculate-paste-position state mouse-pos in-viewport?) + (and (or (cfh/group-shape? shape) + (cfh/bool-shape? shape)) + (nil? (:shapes shape))) + (assoc :shapes []) - ;; We don't want to change the structure of component copies - ;; If the parent-id or the frame-id are component-copies, we need to get the first not copy parent - parent-id (:id (ctn/get-first-not-copy-parent page-objects parent-id)) - frame-id (:id (ctn/get-first-not-copy-parent page-objects frame-id)) + (cfh/text-shape? shape) + (ctt/remove-external-typographies file-id)))] - process-shape - (fn [_ shape] - (let [assign-shapes? (and (or (cfh/group-shape? shape) - (cfh/bool-shape? shape)) - (nil? (:shapes shape)))] - (-> shape - (assoc :frame-id frame-id :parent-id parent-id) - (cond-> assign-shapes? - (assoc :shapes [])) - ;; if is a text, remove references to external typographies - (cond-> (= (:type shape) :text) - (ctt/remove-external-typographies file-id))))) - - paste-objects (->> paste-objects (d/mapm process-shape)) - - all-objects (merge (:objects page) paste-objects) - - library-data (wsh/get-file state file-id) - - changes (-> (dws/prepare-duplicate-changes all-objects page selected delta it libraries library-data file-id) - (pcb/amend-changes (partial process-rchange media-idx)) - (pcb/amend-changes (partial change-add-obj-index paste-objects selected index))) - - ;; Adds a resize-parents operation so the groups are updated. We add all the new objects - new-objects-ids (->> changes :redo-changes (filter #(= (:type %) :add-obj)) (mapv :id)) - - drop-cell - (when (ctl/grid-layout? all-objects parent-id) - (gslg/get-drop-cell frame-id all-objects mouse-pos)) - - changes (pcb/resize-parents changes new-objects-ids) - - selected (->> changes - :redo-changes - (filter #(= (:type %) :add-obj)) - (filter #(selected (:old-id %))) - (map #(get-in % [:obj :id])) - (into (d/ordered-set))) - - changes - (cond-> changes - (some? drop-cell) - (pcb/update-shapes [parent-id] - #(ctl/add-children-to-cell % selected all-objects drop-cell))) - - undo-id (js/Symbol)] - - (rx/of (dwu/start-undo-transaction undo-id) - (dch/commit-changes changes) - (dws/select-shapes selected) - (ptk/data-event :layout/update [frame-id]) - (dwu/commit-undo-transaction undo-id))))] - - (ptk/reify ::paste-shape + (ptk/reify ::paste-shapes ptk/WatchEvent (watch [it state _] - (let [file-id (:current-file-id state) - mouse-pos (deref ms/mouse-position)] - (if (= file-id (:file-id data)) - (do-paste it state mouse-pos []) - (->> (rx/from images) - (rx/merge-map (partial upload-media file-id)) - (rx/reduce conj []) - (rx/mapcat (partial do-paste it state mouse-pos))))))))) + (let [ + file-id (:current-file-id state) + page (wsh/lookup-page state) + + media-idx (->> (:media pdata) + (d/index-by :prev-id)) + + selected (:selected pdata) + objects (:objects pdata) + + position (deref ms/mouse-position) + + ;; Calculate position for the pasted elements + [frame-id + parent-id + delta + index] (calculate-paste-position state objects selected position) + + ;; We don't want to change the structure of component + ;; copies If the parent-id or the frame-id are + ;; component-copies, we need to get the first not copy + ;; parent + parent-id (:id (ctn/get-first-not-copy-parent (:objects page) parent-id)) + frame-id (:id (ctn/get-first-not-copy-parent (:objects page) frame-id)) + + objects (update-vals objects (partial process-shape file-id frame-id parent-id)) + all-objects (merge (:objects page) objects) + + libraries (wsh/get-libraries state) + ldata (wsh/get-file state file-id) + + drop-cell (when (ctl/grid-layout? all-objects parent-id) + (gslg/get-drop-cell frame-id all-objects position)) + + changes (-> (dws/prepare-duplicate-changes all-objects page selected delta it libraries ldata file-id) + (pcb/amend-changes (partial process-rchange media-idx)) + (pcb/amend-changes (partial change-add-obj-index objects selected index))) + + ;; Adds a resize-parents operation so the groups are + ;; updated. We add all the new objects + changes (->> (:redo-changes changes) + (filter add-obj?) + (map :id) + (pcb/resize-parents changes)) + + selected (into (d/ordered-set) + (comp + (filter add-obj?) + (filter #(contains? selected (:old-id %))) + (map :obj) + (map :id)) + (:redo-changes changes)) + + changes (cond-> changes + (some? drop-cell) + (pcb/update-shapes [parent-id] + #(ctl/add-children-to-cell % selected all-objects drop-cell))) + + undo-id (js/Symbol)] + + (rx/of (dwu/start-undo-transaction undo-id) + (dch/commit-changes changes) + (dws/select-shapes selected) + (ptk/data-event :layout/update [frame-id]) + (dwu/commit-undo-transaction undo-id))))))) (defn as-content [text] (let [paragraphs (->> (str/lines text) @@ -2004,7 +2073,7 @@ :else (deref ms/mouse-position))) -(defn paste-text +(defn- paste-text [text] (dm/assert! (string? text)) (ptk/reify ::paste-text @@ -2031,10 +2100,10 @@ (dwu/commit-undo-transaction undo-id)))))) ;; TODO: why not implement it in terms of upload-media-workspace? -(defn- paste-svg +(defn- paste-svg-text [text] (dm/assert! (string? text)) - (ptk/reify ::paste-svg + (ptk/reify ::paste-svg-text ptk/WatchEvent (watch [_ state _] (let [position (calculate-paste-position state) @@ -2044,14 +2113,14 @@ (defn- paste-image [image] - (ptk/reify ::paste-bin-impl + (ptk/reify ::paste-image ptk/WatchEvent (watch [_ state _] - (let [file-id (get-in state [:workspace-file :id]) + (let [file-id (dm/get-in state [:workspace-file :id]) position (calculate-paste-position state) - params {:file-id file-id - :blobs [image] - :position position}] + params {:file-id file-id + :blobs [image] + :position position}] (rx/of (dwm/upload-media-workspace params)))))) (defn toggle-distances-display [value] diff --git a/frontend/src/app/main/data/workspace/changes.cljs b/frontend/src/app/main/data/workspace/changes.cljs index 051449c5f..9968f9305 100644 --- a/frontend/src/app/main/data/workspace/changes.cljs +++ b/frontend/src/app/main/data/workspace/changes.cljs @@ -55,8 +55,8 @@ :or {reg-objects? false save-undo? true stack-undo? false ignore-remote? false ignore-touched false}}] (dm/assert! - "expected a valid set of uuid's" - (sm/check-set-of-uuid! ids)) + "expected a valid coll of uuid's" + (sm/check-coll-of-uuid! ids)) (dm/assert! (fn? update-fn)) diff --git a/frontend/src/app/main/data/workspace/texts.cljs b/frontend/src/app/main/data/workspace/texts.cljs index 543160edb..9f9988e21 100644 --- a/frontend/src/app/main/data/workspace/texts.cljs +++ b/frontend/src/app/main/data/workspace/texts.cljs @@ -427,7 +427,7 @@ shape))] - (let [ids (->> (keys props) (filter changed-text?))] + (let [ids (into #{} (filter changed-text?) (keys props))] (rx/of (dwu/start-undo-transaction undo-id) (dch/update-shapes ids update-fn {:reg-objects? true :stack-undo? true diff --git a/frontend/src/app/main/errors.cljs b/frontend/src/app/main/errors.cljs index f1a3b324b..c6a25644a 100644 --- a/frontend/src/app/main/errors.cljs +++ b/frontend/src/app/main/errors.cljs @@ -114,17 +114,29 @@ ;; the user perspective a error flash message should be visualized but ;; user can continue operate on the application. Can happen in backend ;; and frontend. + (defmethod ptk/handle-error :validation - [error] - (ts/schedule - #(st/emit! (msg/show {:content "Validation error" - :type :error - :timeout 3000}))) + [{:keys [code] :as error}] (print-group! "Validation Error" (fn [] (print-data! error) - (print-explain! error)))) + (print-explain! error))) + (cond + (= code :invalid-paste-data) + (let [message (tr "errors.paste-data-validation")] + (st/async-emit! + (msg/show {:content message + :type :error + :timeout 3000}))) + + :else + (let [message (tr "errors.generic-validation")] + (st/async-emit! + (msg/show {:content message + :type :error + :timeout 3000}))))) + ;; This is a pure frontend error that can be caused by an active @@ -232,6 +244,12 @@ (let [message (tr "errors.max-quote-reached" (:target error))] (st/emit! (modal/show {:type :alert :message message}))) + (or (= :paste-feature-not-enabled code) + (= :missing-features-in-paste-content code) + (= :paste-feature-not-supported code)) + (let [message (tr "errors.feature-not-supported" (:feature error))] + (st/emit! (modal/show {:type :alert :message message}))) + :else (ptk/handle-error {:type :server-error :data error}))) diff --git a/frontend/src/app/main/store.cljs b/frontend/src/app/main/store.cljs index 04f715300..906702b84 100644 --- a/frontend/src/app/main/store.cljs +++ b/frontend/src/app/main/store.cljs @@ -8,6 +8,7 @@ (:require [app.common.logging :as log] [app.util.object :as obj] + [app.util.timers :as tm] [beicon.core :as rx] [okulary.core :as l] [potok.core :as ptk])) @@ -86,6 +87,10 @@ (apply ptk/emit! state (cons event events)) nil)) +(defn async-emit! + [& params] + (tm/schedule #(apply emit! params))) + (defonce ongoing-tasks (l/atom #{})) (add-watch ongoing-tasks ::ongoing-tasks diff --git a/frontend/src/app/main/ui/workspace/context_menu.cljs b/frontend/src/app/main/ui/workspace/context_menu.cljs index 44f45c04a..d8ac33625 100644 --- a/frontend/src/app/main/ui/workspace/context_menu.cljs +++ b/frontend/src/app/main/ui/workspace/context_menu.cljs @@ -154,7 +154,7 @@ (let [do-copy #(st/emit! (dw/copy-selected)) do-cut #(st/emit! (dw/copy-selected) (dw/delete-selected)) - do-paste #(st/emit! dw/paste) + do-paste #(st/emit! (dw/paste-from-clipboard)) do-duplicate #(st/emit! (dw/duplicate-selected true))] [:* [:& menu-entry {:title (tr "workspace.shape.menu.copy") @@ -531,7 +531,7 @@ (mf/defc viewport-context-menu [] (let [focus (mf/deref refs/workspace-focus-selected) - do-paste #(st/emit! dw/paste) + do-paste #(st/emit! (dw/paste-from-clipboard)) do-hide-ui #(st/emit! (-> (dw/toggle-layout-flag :hide-ui) (vary-meta assoc ::ev/origin "workspace-context-menu"))) do-toggle-focus-mode #(st/emit! (dw/toggle-focus-mode))] diff --git a/frontend/src/app/main/ui/workspace/viewport/actions.cljs b/frontend/src/app/main/ui/workspace/viewport/actions.cljs index 2be3f84e8..c9a699db3 100644 --- a/frontend/src/app/main/ui/workspace/viewport/actions.cljs +++ b/frontend/src/app/main/ui/workspace/viewport/actions.cljs @@ -501,13 +501,16 @@ :blobs (seq files)}] (st/emit! (dwm/upload-media-workspace params)))))))) -(defn on-paste [disable-paste in-viewport? workspace-read-only?] - (mf/use-callback +(defn on-paste + [disable-paste in-viewport? workspace-read-only?] + (mf/use-fn (mf/deps workspace-read-only?) (fn [event] - ;; We disable the paste just after mouse-up of a middle button so when panning won't - ;; paste the content into the workspace + ;; We disable the paste just after mouse-up of a middle button so + ;; when panning won't paste the content into the workspace (let [tag-name (-> event dom/get-target dom/get-tag-name)] - (when (and (not (#{"INPUT" "TEXTAREA"} tag-name)) (not @disable-paste) (not workspace-read-only?)) + (when (and (not (#{"INPUT" "TEXTAREA"} tag-name)) + (not @disable-paste) + (not workspace-read-only?)) (st/emit! (dw/paste-from-event event @in-viewport?))))))) diff --git a/frontend/src/app/util/object.cljs b/frontend/src/app/util/object.cljs index bb5d24fcc..892e9e7fe 100644 --- a/frontend/src/app/util/object.cljs +++ b/frontend/src/app/util/object.cljs @@ -6,7 +6,7 @@ (ns app.util.object "A collection of helpers for work with javascript objects." - (:refer-clojure :exclude [set! new get get-in merge clone contains? array?]) + (:refer-clojure :exclude [set! new get get-in merge clone contains? array? into-array]) (:require [cuerdas.core :as str])) @@ -14,6 +14,10 @@ [o] (.isArray js/Array o)) +(defn into-array + [o] + (js/Array.from o)) + (defn create [] #js {}) (defn get diff --git a/frontend/src/app/util/webapi.cljs b/frontend/src/app/util/webapi.cljs index 039f287ac..97994f240 100644 --- a/frontend/src/app/util/webapi.cljs +++ b/frontend/src/app/util/webapi.cljs @@ -93,6 +93,10 @@ (create-blob content mtype))) +(defn get-current-selected-text + [] + (.. js/window getSelection toString)) + (defn write-to-clipboard [data] (assert (string? data) "`data` should be string") @@ -101,44 +105,47 @@ (defn read-from-clipboard [] - (let [cboard (unchecked-get js/navigator "clipboard")] - (if (.-readText ^js cboard) - (rx/from (.readText ^js cboard)) - (throw (ex-info "This browser does not implement read from clipboard protocol" - {:not-implemented true}))))) + (try + (let [cboard (unchecked-get js/navigator "clipboard")] + (if (.-readText ^js cboard) + (rx/from (.readText ^js cboard)) + (rx/throw (ex-info "This browser does not implement read from clipboard protocol" + {:not-implemented true})))) + (catch :default cause + (rx/throw cause)))) (defn read-image-from-clipboard [] - (let [cboard (unchecked-get js/navigator "clipboard") - read-item (fn [item] - (let [img-type (->> (.-types ^js item) - (d/seek #(str/starts-with? % "image/")))] - (if img-type - (rx/from (.getType ^js item img-type)) - (rx/empty))))] - (->> (rx/from (.read ^js cboard)) ;; Get a stream of item lists - (rx/mapcat identity) ;; Convert each item into an emission - (rx/switch-map read-item)))) + (try + (let [cboard (unchecked-get js/navigator "clipboard") + read-item (fn [item] + (let [img-type (->> (.-types ^js item) + (d/seek #(str/starts-with? % "image/")))] + (if img-type + (rx/from (.getType ^js item img-type)) + (rx/empty))))] + (->> (rx/from (.read ^js cboard)) ;; Get a stream of item lists + (rx/mapcat identity) ;; Convert each item into an emission + (rx/switch-map read-item))) + (catch :default cause + (rx/throw cause)))) (defn read-from-paste-event [event] (let [target (.-target ^js event)] - (when (and (not (.-isContentEditable target)) ;; ignore when pasting into - (not= (.-tagName target) "INPUT")) ;; an editable control + (when (and (not (.-isContentEditable ^js target)) ;; ignore when pasting into + (not= (.-tagName ^js target) "INPUT")) ;; an editable control (.. ^js event getBrowserEvent -clipboardData)))) (defn extract-text [clipboard-data] - (when clipboard-data - (.getData clipboard-data "text"))) + (.getData clipboard-data "text")) (defn extract-images + "Get image files from clipboard data. Returns a native js array." [clipboard-data] - (when clipboard-data - (let [file-list (-> (.-files ^js clipboard-data))] - (->> (range (.-length ^js file-list)) - (map #(.item ^js file-list %)) - (filter #(str/starts-with? (.-type %) "image/")))))) + (let [files (obj/into-array (.-files ^js clipboard-data))] + (.filter ^js files #(str/starts-with? (obj/get % "type") "image/")))) (defn create-canvas-element [width height] diff --git a/frontend/translations/en.po b/frontend/translations/en.po index 8ff5e68f4..ee120abc4 100644 --- a/frontend/translations/en.po +++ b/frontend/translations/en.po @@ -998,6 +998,13 @@ msgstr "Email or password is incorrect." msgid "errors.wrong-old-password" msgstr "Old password is incorrect" +msgid "errors.validation" +msgstr "Validation Error" + +msgid "errors.paste-data-validation" +msgstr "Invalid data in clipboard" + + #: src/app/main/ui/settings/feedback.cljs msgid "feedback.description" msgstr "Description"