diff --git a/shadow-cljs.edn b/shadow-cljs.edn index 3bc70ad..34ecee0 100644 --- a/shadow-cljs.edn +++ b/shadow-cljs.edn @@ -11,6 +11,7 @@ [re-frame "1.4.2"] [re-pressed "0.3.2"] [metosin/malli "0.13.0"] + [org.clj-commons/hickory "0.7.4"] [com.github.pkpkpk/cljs-node-io "2.0.332"] ^:dev [day8.re-frame/re-frame-10x "1.9.3"]] diff --git a/src/bean/grid.cljs b/src/bean/grid.cljs index 992c2de..4a2d184 100644 --- a/src/bean/grid.cljs +++ b/src/bean/grid.cljs @@ -224,7 +224,8 @@ depgraph* (cond-> depgraph content-changed? (deps/update-depgraph [:cell address] cell cell*)) - sheet* (merge sheet {:grid grid* :depgraph depgraph*}) + sheet* (merge (frames/expand-frames sheet address) + {:grid grid* :depgraph depgraph*}) other-spillers (-> (interested-spillers updated-addrs grid) (disj address)) deps-to-reval (concat @@ -246,10 +247,10 @@ (reduce (fn [sheet* _] (reduce #(eval-cell %2 %1) sheet* addresses)) sheet (range 3)))) -(defn update-cell [address sheet content] +(defn update-cell-content [address sheet content] (if (= (:content (util/get-cell (:grid sheet) address)) content "") sheet - (eval-sheet-a-few-times (eval-cell address (frames/expand-frames sheet address) content)))) + (eval-sheet-a-few-times (eval-cell address sheet content)))) (defn- merge-cell [sheet address merge-with] (let [sheet* (if (not= merge-with address) @@ -292,6 +293,26 @@ (reduce #(unset-cell-style %1 %2 :merged-until) sheet* merged-addresses)))) sheet))) +;; untested and slightly weird interface, exists for pasting +;; many cells and handling merged cells etc. +(defn update-cells-bulk [sheet start addressed-attrs] + (->> addressed-attrs + (map #(do [(offset (first %) start) (second %)])) + (reduce + (fn [sheet* [address attrs]] + (let [existing-cell (util/get-cell (:grid sheet*) address) + new-cell (-> existing-cell + (assoc :content (:content attrs)) + (assoc :style (merge (:style existing-cell) (:style attrs)))) + new-sheet (eval-cell address sheet* new-cell true)] + (if (:merge-until attrs) + (merge-cells new-sheet + {:start address + :end (offset (:merge-until attrs) start)}) + new-sheet))) + (unmerge-cells sheet (map #(offset % start) (keys addressed-attrs)))) + eval-sheet-a-few-times)) + (defn eval-named ([name {:keys [bindings] :as sheet}] (if-let [value (bindings name)] diff --git a/src/bean/ui/events.cljs b/src/bean/ui/events.cljs index 07df454..745ebbf 100644 --- a/src/bean/ui/events.cljs +++ b/src/bean/ui/events.cljs @@ -39,7 +39,14 @@ (rf/reg-event-db ::update-cell (fn update-cell [db [_ address content]] - (update-in db [:sheet] #(grid/update-cell address % content)))) + (update-in db [:sheet] #(grid/update-cell-content address % content)))) + +(rf/reg-event-db + ::paste-addressed-cells + (fn paste-addressed-cells [db [_ addressed-cells]] + (update-in db [:sheet] #(grid/update-cells-bulk % + (:start (get-in db [:ui :grid :selection])) + addressed-cells)))) (rf/reg-event-fx ::merge-cells diff --git a/src/bean/ui/paste.cljs b/src/bean/ui/paste.cljs new file mode 100644 index 0000000..a445fea --- /dev/null +++ b/src/bean/ui/paste.cljs @@ -0,0 +1,95 @@ +(ns bean.ui.paste + (:require [bean.ui.util :as util] + [clojure.string :as string] + [hickory.core :as hickory] + [hickory.convert :as hc] + [hickory.select :as hs])) + +(def sample "\n\n\n\n\n\n\n\n\n\n\n
\n\n\n\n\n\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n\n
Season\n nameEpisodes
Last aired
Indigo League82
Adventures in the Orange\n Islands36
\n\n\n\n\n") +(def sample2 "
January 28, 1999October 7, 1999
3The Johto Journeys41October 14, 1999July 27, 2000
4Johto League Champions52August 3, 2000August 2, 2001
5Master Quest65August 9, 2001November 14, 2002
6Advanced40November 21, 2002August 28, 2003
7Advanced Challenge52September 4, 2003September 2, 2004
8Advanced Battle53September 9, 2004September 29, 2005
9Battle Frontier47October 6, 2005Septembe
") +(def sample3 "
fwefwe
fwefwef
fwefwe
") +(def sample4 "
September 4, 2003September 2, 2004
8Advanced Battle53September 9, 2004September 29, 2005
9Battle FrontierBattle Frontierfwfwefwef47October 6, 2005September 14, 2006
10Diamond and Pearl52September 28, 2006October 25, 2007
") + +(defn inner-text [hiccup-form] + (-> (map + #(cond + (vector? %) (inner-text %) + (string? %) % + :else "") + hiccup-form) + string/join + ;; Dealing with some weird unicode whitespace + ;; that some of the excel sheets had. + ;; They break rendering and in some cases the parser. + (string/replace + #"\u000C|\u000D|\u0020|\u0085|\u00A0|\u1680|\u2000|\u2001|\u2002|\u2003|\u2004|\u2005|\u2006|\u2007|\u2008|\u2009|\u200A|\u2028|\u2029|\u202F|\u205F|3000|\n" + " ") + (string/replace " " " ") + ;; Fixing special characters escaped by hickory so they're displayed normally. + ;; There should be a better way to not url-encode strings in the first place. + (string/replace "&" "&") + (string/replace " " " ") + (string/replace "<" "<") + (string/replace ">" ">") + (string/replace """ "\""))) + +(defn hiccup-cell->cell [cell merge-until] + {:content (or (inner-text cell) "") + :style (when (or (= (first cell) :th) + (re-find #"bold" (or (:style (second cell)) ""))) + {:bold true}) + ;; this is a weird place to sneak "merge"-ing cells but + ;; passing it in from here for now to the grid so I can do everything in the + ;; in the same function. + :merge-until merge-until}) + +(defn hickory-table->cells [hickory-table] + (loop [hiccup-cells (->> + (hs/select (hs/child (hs/tag :tr)) hickory-table) + (mapv #(hs/select (hs/child (hs/or (hs/tag :td) (hs/tag :th))) %)) + (util/map-on-matrix-addressed (fn [idx cell] [idx (hc/hickory-to-hiccup cell)])) + (mapcat identity) + (sort-by first)) + occupieds #{} + cells {}] + (let [[idx hiccup-cell] (first hiccup-cells) + [_ {:keys [colspan rowspan]}] hiccup-cell + rowspan (and rowspan (js/parseInt rowspan)) + colspan (and colspan (js/parseInt colspan)) + [r c] (loop [idx* idx] + (if (get occupieds idx*) + (recur [(first idx*) (inc (second idx*))]) + idx*)) + merge-until [(+ r (if (pos-int? rowspan) (dec rowspan) 0)) + (+ c (if (pos-int? colspan) (dec colspan) 0))] + got-occupied (mapcat identity (util/addresses-matrix [r c] merge-until))] + (if (empty? hiccup-cells) + cells + (recur + (rest hiccup-cells) + (into occupieds got-occupied) + (assoc cells [r c] (hiccup-cell->cell hiccup-cell (when (not= merge-until [r c]) merge-until)))))))) + +(defn plain-text->cells [text] + (->> (string/split text "\n") + (map #(string/split % "\t")) + (map (partial map #(do {:content %}))) + (util/map-on-matrix-addressed (fn [idx cell] [idx cell])) + (mapcat identity))) + +(defn text->hickory-table [pasted-text] + (->> pasted-text + hickory/parse-fragment + (map hickory/as-hickory) + (map #(hs/select (hs/tag "table") %)) + (some not-empty) + first)) + +(defn parse-table [e] + (when-let [table (text->hickory-table + (.getData (.-clipboardData e) "text/html"))] + (hickory-table->cells table))) + +(defn parse-plaintext [e] + (plain-text->cells + (.getData (.-clipboardData e) "text"))) diff --git a/src/bean/ui/util.cljs b/src/bean/ui/util.cljs index 340cb07..88fc738 100644 --- a/src/bean/ui/util.cljs +++ b/src/bean/ui/util.cljs @@ -23,6 +23,8 @@ (map name) (str/join " "))) +(def map-on-matrix util/map-on-matrix) +(def addresses-matrix util/addresses-matrix) (def map-on-matrix-addressed util/map-on-matrix-addressed) (defn color-int->hex [color] diff --git a/src/bean/ui/views/sheet.cljs b/src/bean/ui/views/sheet.cljs index f71b79a..6504538 100644 --- a/src/bean/ui/views/sheet.cljs +++ b/src/bean/ui/views/sheet.cljs @@ -2,6 +2,7 @@ (:require [bean.area :as area] [bean.grid :as grid] [bean.frames :as frames] + [bean.ui.paste :as paste] [bean.ui.events :as events] [bean.ui.styles :as styles] [bean.ui.subs :as subs] @@ -833,3 +834,12 @@ [:div {:id :grid-container} [canvas pixi-app*] [cell-input pixi-app*]]]) + +(defn handle-paste [e] + (.preventDefault e) + (if-let [pasted-table (paste/parse-table e)] + (rf/dispatch [::events/paste-addressed-cells pasted-table]) + (rf/dispatch [::events/paste-addressed-cells (paste/parse-plaintext e)]))) + +(.addEventListener js/window "paste" handle-paste) +;; (.removeEventListener js/window "paste" handle-paste) diff --git a/test/bean/frames_test.cljs b/test/bean/frames_test.cljs index 602ca64..b7add81 100644 --- a/test/bean/frames_test.cljs +++ b/test/bean/frames_test.cljs @@ -93,7 +93,7 @@ sheet (as-> (new-sheet) sheet (frames/make-frame sheet frame-name {:start [0 0] :end [2 2]}) (frames/add-label sheet frame-name [0 0] :top) - (grid/update-cell [0 0] sheet "A label") + (grid/update-cell-content [0 0] sheet "A label") (frames/mark-skipped sheet frame-name [[2 0]]))] (is (= (frames/label-name->cells sheet frame-name "A label") #{[1 0]})))))