🎉 Allow copy&paste from inkscape.

frontend/src/app/main/data/workspace.cljs

@@ -31,6 +31,7 @@
    [app.main.data.workspace.persistence :as dwp]
    [app.main.data.workspace.selection :as dws]
    [app.main.data.workspace.transforms :as dwt]
+   [app.main.data.workspace.svg-upload :as svg]
    [app.main.repo :as rp]
    [app.main.store :as st]
    [app.main.streams :as ms]
@@ -1372,6 +1373,7 @@
 (declare paste-shape)
 (declare paste-text)
 (declare paste-image)
+(declare paste-svg)
 
 (def paste
   (ptk/reify ::paste
@@ -1428,6 +1430,10 @@
               is-editing-text? (and edit-id (= :text (get-in objects [edit-id :type])))]
 
           (cond
+            (and (string? text-data)
+                 (str/includes? text-data "<svg"))
+            (rx/of (paste-svg text-data))
+
             (seq image-data)
             (rx/from (map paste-image image-data))
 
@@ -1599,7 +1605,8 @@
     {:type "root"
      :children [{:type "paragraph-set" :children paragraphs}]}))
 
-(defn paste-text [text]
+(defn paste-text
+  [text]
   (s/assert string? text)
   (ptk/reify ::paste-text
     ptk/WatchEvent
@@ -1627,6 +1634,16 @@
                (dwc/add-shape shape)
                (dwc/commit-undo-transaction))))))
 
+(defn- paste-svg
+  [text]
+  (s/assert string? text)
+  (ptk/reify ::paste-svg
+    ptk/WatchEvent
+    (watch [_ state stream]
+      (let [position (deref ms/mouse-position)
+            file-id  (:current-file-id state)]
+        (->> (dwp/parse-svg ["svg" text])
+             (rx/map #(svg/svg-uploaded % file-id position)))))))
 
 (defn- paste-image
   [image]
@@ -1635,8 +1652,9 @@
     (watch [_ state stream]
       (let [file-id (get-in state [:workspace-file :id])
             params  {:file-id file-id
-                     :data [image]}]
+                     :blobs [image]
-        (rx/of (dwp/upload-media-workspace params @ms/mouse-position))))))
+                     :position @ms/mouse-position}]
+        (rx/of (dwp/upload-media-workspace params))))))
 
 (defn toggle-distances-display [value]
   (ptk/reify ::toggle-distances-display

frontend/src/app/main/data/workspace/common.cljs

@@ -800,7 +800,8 @@
                       (gsh/setup-selrect))]
         (rx/of (add-shape shape))))))
 
-(defn image-uploaded [image x y]
+(defn image-uploaded
+  [image {:keys [x y]}]
   (ptk/reify ::image-uploaded
     ptk/WatchEvent
     (watch [_ state stream]

frontend/src/app/main/data/workspace/persistence.cljs

@@ -376,21 +376,6 @@
 
 ;; --- Upload File Media objects
 
-(s/def ::local? ::us/boolean)
-(s/def ::data ::di/blobs)
-(s/def ::name ::us/string)
-(s/def ::uri  ::us/string)
-(s/def ::uris (s/coll-of ::uri))
-(s/def ::mtype ::us/string)
-
-(s/def ::upload-media-objects
-  (s/and
-   (s/keys :req-un [::file-id ::local?]
-           :opt-in [::name ::data ::uris ::mtype])
-   (fn [props]
-     (or (contains? props :data)
-         (contains? props :uris)))))
-
 (defn parse-svg
   [[name text]]
   (->> (rp/query! :parse-svg {:data text})
@@ -402,46 +387,48 @@
                  (or name (uu/uri-name uri))
                  (:body %)))))
 
-(defn- handle-upload-error [on-error stream]
+(defn- handle-upload-error
-  (->> stream
+  "Generic error handler for all upload methods."
-       (rx/catch
+  [on-error stream]
-           (fn on-error* [error]
+  (letfn [(on-error* [error]
-             (if (ex/ex-info? error)
+            (if (ex/ex-info? error)
-               (on-error* (ex-data error))
+              (on-error* (ex-data error))
-               (cond
+              (cond
-                 (= (:code error) :invalid-svg-file)
+                (= (:code error) :invalid-svg-file)
-                 (rx/of (dm/error (tr "errors.media-type-not-allowed")))
+                (rx/of (dm/error (tr "errors.media-type-not-allowed")))
 
-                 (= (:code error) :media-type-not-allowed)
+                (= (:code error) :media-type-not-allowed)
-                 (rx/of (dm/error (tr "errors.media-type-not-allowed")))
+                (rx/of (dm/error (tr "errors.media-type-not-allowed")))
 
-                 (= (:code error) :ubable-to-access-to-url)
+                (= (:code error) :ubable-to-access-to-url)
-                 (rx/of (dm/error (tr "errors.media-type-not-allowed")))
+                (rx/of (dm/error (tr "errors.media-type-not-allowed")))
 
-                 (= (:code error) :invalid-image)
+                (= (:code error) :invalid-image)
-                 (rx/of (dm/error (tr "errors.media-type-not-allowed")))
+                (rx/of (dm/error (tr "errors.media-type-not-allowed")))
 
-                 (= (:code error) :media-too-large)
+                (= (:code error) :media-too-large)
-                 (rx/of (dm/error (tr "errors.media-too-large")))
+                (rx/of (dm/error (tr "errors.media-too-large")))
 
-                 (= (:code error) :media-type-mismatch)
+                (= (:code error) :media-type-mismatch)
-                 (rx/of (dm/error (tr "errors.media-type-mismatch")))
+                (rx/of (dm/error (tr "errors.media-type-mismatch")))
 
-                 (= (:code error) :unable-to-optimize)
+                (= (:code error) :unable-to-optimize)
-                 (rx/of (dm/error (:hint error)))
+                (rx/of (dm/error (:hint error)))
 
-                 (fn? on-error)
+                (fn? on-error)
-                 (on-error error)
+                (on-error error)
 
-                 :else
+                :else
-                 (rx/throw error)))))))
+                (rx/throw error))))]
+    (rx/catch on-error* stream)))
 
-(defn- upload-uris [file-id local? name uris mtype on-image on-svg]
+(defn- process-uris
+  [{:keys [file-id local? name uris mtype on-image on-svg]}]
   (letfn [(svg-url? [url]
             (or (and mtype (= mtype "image/svg+xml"))
                 (str/ends-with? url ".svg")))
 
-          (prepare-uri [uri]
+          (prepare [uri]
             {:file-id file-id
              :is-local local?
              :name (or name (uu/uri-name uri))
@@ -449,7 +436,7 @@
     (rx/merge
      (->> (rx/from uris)
           (rx/filter (comp not svg-url?))
-          (rx/map prepare-uri)
+          (rx/map prepare)
           (rx/mapcat #(rp/mutation! :create-file-media-object-from-url %))
           (rx/do on-image))
 
@@ -459,81 +446,91 @@
           (rx/merge-map parse-svg)
           (rx/do on-svg)))))
 
-(defn- upload-data [file-id local? name data force-media on-image on-svg]
+(defn- process-blobs
-  (let [svg-blob? (fn [blob]
+  [{:keys [file-id local? name blobs force-media on-image on-svg]}]
-                    (and (not force-media)
+  (letfn [(svg-blob? [blob]
-                         (= (.-type blob) "image/svg+xml")))
+            (and (not force-media)
-        prepare-file
+                 (= (.-type blob) "image/svg+xml")))
-        (fn [blob]
-          (let [name (or name (if (di/file? blob) (.-name blob) "blob"))]
-            {:file-id file-id
-             :name name
-             :is-local local?
-             :content blob}))
 
-        extract-content
+          (prepare-blob [blob]
-        (fn [blob]
+            (let [name (or name (if (di/file? blob) (.-name blob) "blob"))]
-          (let [name (or name (.-name blob))]
+              {:file-id file-id
-            (-> (.text blob)
+               :name name
-                (p/then #(vector name %)))))
+               :is-local local?
+               :content blob}))
+
+          (extract-content [blob]
+            (let [name (or name (.-name blob))]
+              (-> (.text ^js blob)
+                  (p/then #(vector name %)))))]
 
-        file-stream (->> (rx/from data)
-                         (rx/map di/validate-file))]
     (rx/merge
-     (->> file-stream
+     (->> (rx/from blobs)
+          (rx/map di/validate-file)
           (rx/filter (comp not svg-blob?))
-          (rx/map prepare-file)
+          (rx/map prepare-blob)
           (rx/mapcat #(rp/mutation! :upload-file-media-object %))
           (rx/do on-image))
 
-     (->> file-stream
+     (->> (rx/from blobs)
+          (rx/map di/validate-file)
           (rx/filter svg-blob?)
           (rx/merge-map extract-content)
           (rx/merge-map parse-svg)
           (rx/do on-svg)))))
 
-(defn- upload-media-objects
+(s/def ::local? ::us/boolean)
-  [{:keys [file-id local? data name uris mtype svg-as-images] :as params}]
+(s/def ::blobs ::di/blobs)
-  (us/assert ::upload-media-objects params)
+(s/def ::name ::us/string)
-  (ptk/reify ::upload-media-objects
+(s/def ::uris (s/coll-of ::us/string))
+(s/def ::mtype ::us/string)
+
+(s/def ::process-media-objects
+  (s/and
+   (s/keys :req-un [::file-id ::local?]
+           :opt-in [::name ::data ::uris ::mtype])
+   (fn [props]
+     (or (contains? props :blobs)
+         (contains? props :uris)))))
+
+(defn- process-media-objects
+  [{:keys [uris on-error] :as params}]
+  (us/assert ::process-media-objects params)
+  (ptk/reify ::process-media-objects
     ptk/WatchEvent
     (watch [_ state stream]
-      (let [{:keys [on-image on-svg on-error]
+      (rx/concat
-             :or {on-image identity
+       (rx/of (dm/show {:content (tr "media.loading")
-                  on-svg   identity}} (meta params)]
+                        :type :info
-        (rx/concat
+                        :timeout nil
-         (rx/of (dm/show {:content (tr "media.loading")
+                        :tag :media-loading}))
-                          :type :info
+       (->> (if (seq uris)
-                          :timeout nil
+              ;; Media objects is a list of URL's pointing to the path
-                          :tag :media-loading}))
+              (process-uris params)
-         (->> (if (seq uris)
+              ;; Media objects are blob of data to be upload
-                ;; Media objects is a list of URL's pointing to the path
+              (process-blobs params))
-                (upload-uris file-id local? name uris mtype on-image on-svg)
+
-                ;; Media objects are blob of data to be upload
+            ;; Every stream has its own sideffect. We need to ignore the result
-                (upload-data file-id local? name data svg-as-images on-image on-svg))
+            (rx/ignore)
-              ;; Every stream has its own sideffect. We need to ignore the result
+            (handle-upload-error on-error)
-              (rx/ignore)
+            (rx/finalize (st/emitf (dm/hide-tag :media-loading))))))))
-              (handle-upload-error on-error)
-              (rx/finalize (st/emitf (dm/hide-tag :media-loading)))))))))
 
 (defn upload-media-asset
   [params]
-  (let [params (-> params
+  (let [params (assoc params
-                   (assoc :svg-as-images true)
+                      :force-media true
-                   (assoc :local? false)
+                      :local? false
-                   (with-meta {:on-image #(st/emit! (dwl/add-media %))}))]
+                      :on-image #(st/emit! (dwl/add-media %)))]
-    (upload-media-objects params)))
+    (process-media-objects params)))
 
 (defn upload-media-workspace
-  [params position]
+  [{:keys [position file-id] :as params}]
-  (let [{:keys [x y]} position
+  (let [params (assoc params
-        mdata  {:on-image #(st/emit! (dwc/image-uploaded % x y))
+                      :local? true
-                :on-svg   #(st/emit! (svg/svg-uploaded % (:file-id params) x y))}
+                      :on-image #(st/emit! (dwc/image-uploaded % position))
+                      :on-svg   #(st/emit! (svg/svg-uploaded % file-id position)))]
 
-        params (-> (assoc params :local? true)
+    (process-media-objects params)))
-                   (with-meta mdata))]
-
-    (upload-media-objects params)))
 
 
 ;; --- Upload File Media objects

frontend/src/app/main/data/workspace/svg_upload.cljs

@@ -211,7 +211,7 @@
 
 (defn create-rect-shape [name frame-id svg-data {:keys [attrs] :as data}]
   (let [svg-transform (usvg/parse-transform (:transform attrs))
-        transform (->> svg-transform 
+        transform (->> svg-transform
                        (gmt/transform-in (gpt/point svg-data)))
 
         rect (->> (select-keys attrs [:x :y :width :height])
@@ -239,7 +239,7 @@
 
 (defn create-circle-shape [name frame-id svg-data {:keys [attrs] :as data}]
   (let [svg-transform (usvg/parse-transform (:transform attrs))
-        transform (->> svg-transform 
+        transform (->> svg-transform
                        (gmt/transform-in (gpt/point svg-data)))
 
         circle (->> (select-keys attrs [:r :ry :rx :cx :cy])
@@ -273,7 +273,7 @@
 
 (defn create-image-shape [name frame-id svg-data {:keys [attrs] :as data}]
   (let [svg-transform (usvg/parse-transform (:transform attrs))
-        transform (->> svg-transform 
+        transform (->> svg-transform
                        (gmt/transform-in (gpt/point svg-data)))
 
         image-url (:xlink:href attrs)
@@ -327,7 +327,7 @@
                              (update :attrs usvg/add-transform disp-matrix)
                              (assoc :content [use-data]))]
         (parse-svg-element frame-id svg-data element-data unames))
-      
+
       ;; SVG graphic elements
       ;; :circle :ellipse :image :line :path :polygon :polyline :rect :text :use
       (let [shape (-> (case tag
@@ -381,42 +381,42 @@
 
 (declare create-svg-shapes)
 
-(defn svg-uploaded [svg-data file-id x y]
+(defn svg-uploaded
+  [svg-data file-id position]
   (ptk/reify ::svg-uploaded
     ptk/WatchEvent
     (watch [_ state stream]
-      (let [images-to-upload (-> svg-data (usvg/collect-images))
+      ;; Once the SVG is uploaded, we need to extract all the bitmap
+      ;; images and upload them separatelly, then proceed to create
+      ;; all shapes.
+      (->> (rx/from (usvg/collect-images svg-data))
+           (rx/map (fn [uri]
+                     (d/merge
+                      {:file-id file-id
+                       :is-local true
+                       :url uri}
 
-            prepare-uri
+                      (if (str/starts-with? uri "data:")
-            (fn [uri]
+                        {:name "image"
-              (merge
+                         :content (uu/data-uri->blob uri)}
-               {:file-id file-id
+                        {:name (uu/uri-name uri)}))))
-                :is-local true
+           (rx/mapcat (fn [uri-data]
-                :url uri}
+                        (->> (rp/mutation! (if (contains? uri-data :content)
+                                             :upload-file-media-object
+                                             :create-file-media-object-from-url) uri-data)
+                             (rx/map #(vector (:url uri-data) %)))))
+           (rx/reduce (fn [acc [url image]] (assoc acc url image)) {})
+           (rx/map #(create-svg-shapes (assoc svg-data :image-data %) position))))))
 
-               (if (str/starts-with? uri "data:")
+(defn create-svg-shapes
-                 {:name "image"
+  [svg-data {:keys [x y] :as position}]
-                  :content (uu/data-uri->blob uri)}
-                 {:name (uu/uri-name uri)})))]
-
-        (->> (rx/from images-to-upload)
-             (rx/map prepare-uri)
-             (rx/mapcat (fn [uri-data]
-                          (->> (rp/mutation! (if (contains? uri-data :content)
-                                               :upload-file-media-object
-                                               :create-file-media-object-from-url) uri-data)
-                               (rx/map #(vector (:url uri-data) %)))))
-             (rx/reduce (fn [acc [url image]] (assoc acc url image)) {})
-             (rx/map #(create-svg-shapes (assoc svg-data :image-data %) x y)))))))
-
-(defn create-svg-shapes [svg-data x y]
   (ptk/reify ::create-svg-shapes
     ptk/WatchEvent
     (watch [_ state stream]
       (try
         (let [page-id (:current-page-id state)
               objects (dwc/lookup-page-objects state page-id)
-              frame-id (cp/frame-id-by-position objects {:x x :y y})
+              frame-id (cp/frame-id-by-position objects position)
               selected (get-in state [:workspace-local :selected])
 
               [vb-x vb-y vb-width vb-height] (svg-dimensions svg-data)

frontend/src/app/main/ui/workspace/left_toolbar.cljs

@@ -33,14 +33,16 @@
         (mf/use-callback
          (mf/deps file)
          (fn [blobs]
-           (let [params {:file-id (:id file)
+           ;; We don't want to add a ref because that redraws the component
-                         :data (seq blobs)}
+           ;; for everychange. Better direct access on the callback
-                 ;; We don't want to add a ref because that redraws the component
+           ;; vbox (get-in @st/state [:workspace-local :vbox])
-                 ;; for everychange. Better direct access on the callback
+           (let [vbox   (:vbox @refs/workspace-local)
-                 vbox (get-in @st/state [:workspace-local :vbox])
+                 x      (mth/round (+ (:x vbox) (/ (:width vbox) 2)))
-                 x (mth/round (+ (:x vbox) (/ (:width vbox) 2)))
+                 y      (mth/round (+ (:y vbox) (/ (:height vbox) 2)))
-                 y (mth/round (+ (:y vbox) (/ (:height vbox) 2)))]
+                 params {:file-id (:id file)
-             (st/emit! (dw/upload-media-workspace params (gpt/point x y))))))]
+                         :blobs (seq blobs)
+                         :position (gpt/point x y)}]
+             (st/emit! (dw/upload-media-workspace params)))))]
 
        [:li.tooltip.tooltip-right
         {:alt (tr "workspace.toolbar.image")

frontend/src/app/main/ui/workspace/sidebar/assets.cljs

@@ -152,18 +152,12 @@
            (st/emitf (dwl/set-assets-box-open file-id :graphics true))
            (dom/click (mf/ref-val input-ref))))
 
-        on-media-uploaded
-        (mf/use-callback
-         (mf/deps file-id)
-         (fn [data]
-           (st/emit! (dwl/add-media data))))
-
         on-selected
         (mf/use-callback
          (mf/deps file-id)
          (fn [blobs]
            (let [params {:file-id file-id
-                         :data (seq blobs)}]
+                         :blobs (seq blobs)}]
              (st/emit! (dw/upload-media-asset params)))))
 
         on-delete

frontend/src/app/main/ui/workspace/viewport/actions.cljs

@@ -389,8 +389,8 @@
 
 (defn on-image-uploaded []
  (mf/use-callback
-  (fn [image {:keys [x y]}]
+  (fn [image position]
-    (st/emit! (dw/image-uploaded image x y)))))
+    (st/emit! (dw/image-uploaded image position)))))
 
 (defn on-drop [file viewport-ref zoom]
   (let [on-image-uploaded (on-image-uploaded)]
@@ -427,21 +427,23 @@
            (dnd/has-type? event "text/uri-list")
            (let [data  (dnd/get-data event "text/uri-list")
                  lines (str/lines data)
-                 urls  (filter #(and (not (str/blank? %))
+                 uris  (filter #(and (not (str/blank? %))
                                      (not (str/starts-with? % "#")))
                                lines)
                  params {:file-id (:id file)
-                         :uris urls}]
+                         :position viewport-coord
-             (st/emit! (dw/upload-media-workspace params viewport-coord)))
+                         :uris uris}]
+             (st/emit! (dw/upload-media-workspace params)))
 
            ;; Will trigger when the user drags an SVG asset from the assets panel
            (and (dnd/has-type? event "text/asset-id") (= asset-type "image/svg+xml"))
            (let [path (cfg/resolve-file-media {:id asset-id})
                  params {:file-id (:id file)
+                         :position viewport-coord
                          :uris [path]
                          :name asset-name
                          :mtype asset-type}]
-             (st/emit! (dw/upload-media-workspace params viewport-coord)))
+             (st/emit! (dw/upload-media-workspace params)))
 
            ;; Will trigger when the user drags an image from the assets SVG
            (dnd/has-type? event "text/asset-id")
@@ -458,8 +460,9 @@
            :else
            (let [files  (dnd/get-files event)
                  params {:file-id (:id file)
-                         :data (seq files)}]
+                         :position viewport-coord
-             (st/emit! (dw/upload-media-workspace params viewport-coord)))))))))
+                         :blobs (seq files)}]
+             (st/emit! (dw/upload-media-workspace params)))))))))
 
 (defn on-paste [disable-paste in-viewport?]
  (mf/use-callback