diff --git a/src/bean/grid.cljs b/src/bean/grid.cljs index 3f2d87d..550bfa9 100644 --- a/src/bean/grid.cljs +++ b/src/bean/grid.cljs @@ -1,5 +1,6 @@ (ns bean.grid (:require [bean.area :as area] + [bean.tables :as tables] [bean.code-errors :as code-errors] [bean.deps :as deps] [bean.errors :as errors] @@ -211,15 +212,19 @@ sheet)] (set-cell-style sheet* address :merged-with merge-with))) -;; TODO: when a cell is merged -;; if any of the cells is a label, make the merged cell a label also (defn merge-cells [sheet {:keys [start end] :as area}] - (let [addresses (area/area->addresses area)] - (if (some #(get-cell-style sheet % :merged-with) addresses) - sheet + (let [addresses (area/area->addresses area) + merged-already (map #(get-cell-style sheet % :merged-with) addresses) + all-merged-addresses (mapcat #(get-cell-style + sheet + (get-cell-style sheet % :merged-with) + :merged-addresses) merged-already)] + (if (every? #(get addresses %) all-merged-addresses) (-> (reduce #(merge-cell %1 %2 start) sheet addresses) (set-cell-style start :merged-until end) - (set-cell-style start :merged-addresses addresses))))) + (set-cell-style start :merged-addresses addresses) + (tables/merge-labels start addresses)) + sheet))) (defn unmerge-cells [sheet addresses] (->> addresses diff --git a/src/bean/tables.cljs b/src/bean/tables.cljs index fb01db8..60f5cd9 100644 --- a/src/bean/tables.cljs +++ b/src/bean/tables.cljs @@ -45,6 +45,22 @@ (defn get-table [sheet table-name] (get-in sheet [:tables table-name])) +(defn- get-label [sheet table-name rc] + (get-in sheet [:tables table-name :labels rc])) + +(defn merge-labels [sheet start addresses] + (if-let [table-name (cell-table start sheet)] + (let [is-label? (get-label sheet table-name start) + other-labels? (and (not is-label?) + (some #(get-label sheet table-name %) addresses)) + label (or is-label? other-labels?)] + (if label + (-> sheet + (remove-labels table-name addresses) + (add-label table-name start (:dirn label) (:color label))) + sheet)) + sheet)) + (defn- last-row [[r c] sheet] (+ r (dec (area/cell-h sheet [r c])))) diff --git a/test/bean/grid_test.cljs b/test/bean/grid_test.cljs index 0751c8b..586833b 100644 --- a/test/bean/grid_test.cljs +++ b/test/bean/grid_test.cljs @@ -338,4 +338,28 @@ :merged-until [1 2] :merged-addresses #{[0 0] [0 1] [0 2] [1 0] [1 1] [1 2]}})) (is (= (area/cell-h sheet [0 0]) 2)) - (is (= (area/cell-w sheet [0 0]) 3))))) + (is (= (area/cell-w sheet [0 0]) 3)))) + + (testing "Merges existing merged cells only if the full merged cell is in the area" + (let [sheet (-> (new-sheet (repeat 5 (repeat 5 "")) "") + eval-sheet + (grid/merge-cells {:start [0 0] :end [1 1]}) + (grid/merge-cells {:start [1 1] :end [1 2]}))] + (is (= (select-keys (get-in sheet [:grid 0 0 :style]) + [:merged-with :merged-until]) + {:merged-with [0 0] + :merged-until [1 1]})) + (is (= (select-keys (get-in (grid/merge-cells sheet {:start [0 0] :end [1 2]}) + [:grid 0 0 :style]) + [:merged-with :merged-until]) + {:merged-with [0 0] + :merged-until [1 2]})))) + + (testing "Merges labels into a single label" + (let [table-name "A table" + sheet (-> (new-sheet (repeat 5 (repeat 5 "")) "") + eval-sheet + (tables/make-table table-name {:start [0 0] :end [2 2]}) + (tables/add-label table-name [1 1] :top) + (grid/merge-cells {:start [0 1] :end [1 1]}))] + (is (= (get-in sheet [:tables table-name :labels]) {[0 1] {:dirn :top :color nil}})))))