|
@@ -370,6 +370,21 @@
|
|
|
|
|
|
;;; ### insert-blocks, delete-blocks, move-blocks
|
|
|
|
|
|
+(defn- fix-top-level-blocks
|
|
|
+ "Blocks with :block/level"
|
|
|
+ [blocks]
|
|
|
+ (loop [blocks blocks
|
|
|
+ last-top-level-block nil
|
|
|
+ result []]
|
|
|
+ (if-let [block (first blocks)]
|
|
|
+ (if (= 1 (:block/level block))
|
|
|
+ (let [block' (assoc block
|
|
|
+ :block/left {:db/id (:db/id last-top-level-block)}
|
|
|
+ :block/parent (:block/parent last-top-level-block))]
|
|
|
+ (recur (rest blocks) block (conj result block')))
|
|
|
+ (recur (rest blocks) last-top-level-block (conj result block)))
|
|
|
+ result)))
|
|
|
+
|
|
|
(defn- insert-blocks-aux
|
|
|
[blocks target-block {:keys [sibling? replace-empty-target? keep-uuid? move? outliner-op]}]
|
|
|
(let [block-uuids (map :block/uuid blocks)
|
|
@@ -454,6 +469,9 @@
|
|
|
(> (count blocks) 1)
|
|
|
(not move?)))
|
|
|
blocks' (blocks-with-level blocks)
|
|
|
+ blocks' (if (= outliner-op ::paste)
|
|
|
+ (fix-top-level-blocks blocks')
|
|
|
+ blocks')
|
|
|
insert-opts {:sibling? sibling?
|
|
|
:replace-empty-target? replace-empty-target?
|
|
|
:keep-uuid? keep-uuid?
|
|
@@ -479,7 +497,8 @@
|
|
|
next (if sibling?
|
|
|
(tree/-get-right target-node)
|
|
|
(tree/-get-down target-node))
|
|
|
- next-tx (when (and next (not (contains? (set (map :db/id blocks)) (:db/id (:data next)))))
|
|
|
+ next-tx (when (and next
|
|
|
+ (if move? (not (contains? (set (map :db/id blocks)) (:db/id (:data next)))) true))
|
|
|
(when-let [left (last (filter (fn [b] (= 1 (:block/level b))) tx))]
|
|
|
[{:block/uuid (tree/-get-id next)
|
|
|
:block/left (:db/id left)}]))
|
|
@@ -598,42 +617,53 @@
|
|
|
(swap! txs-state concat fix-non-consecutive-tx))))
|
|
|
{:tx-data @txs-state}))
|
|
|
|
|
|
+(defn- move-to-original-position?
|
|
|
+ [blocks target-block sibling?]
|
|
|
+ (let [non-consecutive-blocks (db-model/get-non-consecutive-blocks blocks)]
|
|
|
+ (and (empty? non-consecutive-blocks)
|
|
|
+ (= (:db/id (:block/left (first blocks))) (:db/id target-block))
|
|
|
+ (not= (= (:db/id (:block/parent (first blocks)))
|
|
|
+ (:db/id target-block))
|
|
|
+ sibling?))))
|
|
|
+
|
|
|
(defn move-blocks
|
|
|
"Move `blocks` to `target-block` as siblings or children."
|
|
|
[blocks target-block {:keys [sibling? outliner-op]}]
|
|
|
[:pre [(seq blocks)
|
|
|
(s/valid? ::block-map-or-entity target-block)]]
|
|
|
- (when (not (contains? (set (map :db/id blocks)) (:db/id target-block)))
|
|
|
- (let [parents (->> (db/get-block-parents (state/get-current-repo) (:block/uuid target-block))
|
|
|
- (map :db/id)
|
|
|
- (set))
|
|
|
- move-parents-to-child? (some parents (map :db/id blocks))]
|
|
|
- (when-not move-parents-to-child?
|
|
|
- (let [blocks (get-top-level-blocks blocks)
|
|
|
- first-block (first blocks)
|
|
|
- {:keys [tx-data]} (insert-blocks blocks target-block {:sibling? sibling?
|
|
|
- :outliner-op (or outliner-op :move-blocks)})]
|
|
|
- (when (seq tx-data)
|
|
|
- (let [first-block-page (:db/id (:block/page first-block))
|
|
|
- target-page (or (:db/id (:block/page target-block))
|
|
|
- (:db/id target-block))
|
|
|
- not-same-page? (not= first-block-page target-page)
|
|
|
- move-blocks-next-tx [(build-move-blocks-next-tx blocks)]
|
|
|
- children-page-tx (when not-same-page?
|
|
|
- (let [children-ids (mapcat #(db/get-block-children-ids (state/get-current-repo) (:block/uuid %)) blocks)]
|
|
|
- (map (fn [uuid] {:block/uuid uuid
|
|
|
- :block/page target-page}) children-ids)))
|
|
|
- fix-non-consecutive-tx (->> (fix-non-consecutive-blocks blocks target-block sibling?)
|
|
|
- (remove (fn [b]
|
|
|
- (contains? (set (map :db/id move-blocks-next-tx)) (:db/id b)))))
|
|
|
- full-tx (util/concat-without-nil tx-data move-blocks-next-tx children-page-tx fix-non-consecutive-tx)
|
|
|
- tx-meta (cond-> {:move-blocks (mapv :db/id blocks)
|
|
|
- :target (:db/id target-block)}
|
|
|
- not-same-page?
|
|
|
- (assoc :from-page first-block-page
|
|
|
- :target-page target-page))]
|
|
|
- {:tx-data full-tx
|
|
|
- :tx-meta tx-meta})))))))
|
|
|
+ (let [original-position? (move-to-original-position? blocks target-block sibling?)]
|
|
|
+ (when (and (not (contains? (set (map :db/id blocks)) (:db/id target-block)))
|
|
|
+ (not original-position?))
|
|
|
+ (let [parents (->> (db/get-block-parents (state/get-current-repo) (:block/uuid target-block))
|
|
|
+ (map :db/id)
|
|
|
+ (set))
|
|
|
+ move-parents-to-child? (some parents (map :db/id blocks))]
|
|
|
+ (when-not move-parents-to-child?
|
|
|
+ (let [blocks (get-top-level-blocks blocks)
|
|
|
+ first-block (first blocks)
|
|
|
+ {:keys [tx-data]} (insert-blocks blocks target-block {:sibling? sibling?
|
|
|
+ :outliner-op (or outliner-op :move-blocks)})]
|
|
|
+ (when (seq tx-data)
|
|
|
+ (let [first-block-page (:db/id (:block/page first-block))
|
|
|
+ target-page (or (:db/id (:block/page target-block))
|
|
|
+ (:db/id target-block))
|
|
|
+ not-same-page? (not= first-block-page target-page)
|
|
|
+ move-blocks-next-tx [(build-move-blocks-next-tx blocks)]
|
|
|
+ children-page-tx (when not-same-page?
|
|
|
+ (let [children-ids (mapcat #(db/get-block-children-ids (state/get-current-repo) (:block/uuid %)) blocks)]
|
|
|
+ (map (fn [uuid] {:block/uuid uuid
|
|
|
+ :block/page target-page}) children-ids)))
|
|
|
+ fix-non-consecutive-tx (->> (fix-non-consecutive-blocks blocks target-block sibling?)
|
|
|
+ (remove (fn [b]
|
|
|
+ (contains? (set (map :db/id move-blocks-next-tx)) (:db/id b)))))
|
|
|
+ full-tx (util/concat-without-nil tx-data move-blocks-next-tx children-page-tx fix-non-consecutive-tx)
|
|
|
+ tx-meta (cond-> {:move-blocks (mapv :db/id blocks)
|
|
|
+ :target (:db/id target-block)}
|
|
|
+ not-same-page?
|
|
|
+ (assoc :from-page first-block-page
|
|
|
+ :target-page target-page))]
|
|
|
+ {:tx-data full-tx
|
|
|
+ :tx-meta tx-meta}))))))))
|
|
|
|
|
|
(defn move-blocks-up-down
|
|
|
"Move blocks up/down."
|
|
@@ -681,51 +711,53 @@
|
|
|
"Indent or outdent `blocks`."
|
|
|
[blocks indent?]
|
|
|
{:pre [(seq blocks) (boolean? indent?)]}
|
|
|
- (let [first-block (db/entity (:db/id (first blocks)))
|
|
|
- left (db/entity (:db/id (:block/left first-block)))
|
|
|
- parent (:block/parent first-block)
|
|
|
- db (db/get-db)
|
|
|
- top-level-blocks (get-top-level-blocks blocks)
|
|
|
- concat-tx-fn (fn [& results]
|
|
|
- {:tx-data (->> (map :tx-data results)
|
|
|
- (apply util/concat-without-nil))
|
|
|
- :tx-meta (:tx-meta (first results))})
|
|
|
- opts {:outliner-op :indent-outdent-blocks}]
|
|
|
- (if indent?
|
|
|
- (when (and left (not (page-first-child? first-block)))
|
|
|
- (let [last-direct-child-id (db-model/get-block-last-direct-child db (:db/id left) false)
|
|
|
- blocks' (drop-while (fn [b]
|
|
|
- (= (:db/id (:block/parent b))
|
|
|
- (:db/id left)))
|
|
|
- top-level-blocks)]
|
|
|
- (when (seq blocks')
|
|
|
- (if last-direct-child-id
|
|
|
- (let [last-direct-child (db/entity last-direct-child-id)
|
|
|
- result (move-blocks blocks' last-direct-child (merge opts {:sibling? true}))
|
|
|
- ;; expand `left` if it's collapsed
|
|
|
- collapsed-tx (when (:block/collapsed? left)
|
|
|
- {:tx-data [{:db/id (:db/id left)
|
|
|
- :block/collapsed? false}]})]
|
|
|
- (concat-tx-fn result collapsed-tx))
|
|
|
- (move-blocks blocks' left (merge opts {:sibling? false}))))))
|
|
|
- (when (and parent (not (page-block? (db/entity (:db/id parent)))))
|
|
|
- (let [blocks' (take-while (fn [b]
|
|
|
- (not= (:db/id (:block/parent b))
|
|
|
- (:db/id (:block/parent parent))))
|
|
|
- top-level-blocks)
|
|
|
- result (move-blocks blocks' parent (merge opts {:sibling? true}))]
|
|
|
- (if (state/logical-outdenting?)
|
|
|
- result
|
|
|
- ;; direct outdenting (default behavior)
|
|
|
- (let [last-top-block (db/pull (:db/id (last blocks')))
|
|
|
- right-siblings (->> (get-right-siblings (block last-top-block))
|
|
|
- (map :data))]
|
|
|
- (if (seq right-siblings)
|
|
|
- (let [result2 (if-let [last-direct-child-id (db-model/get-block-last-direct-child db (:db/id last-top-block) false)]
|
|
|
- (move-blocks right-siblings (db/entity last-direct-child-id) (merge opts {:sibling? true}))
|
|
|
- (move-blocks right-siblings last-top-block (merge opts {:sibling? false})))]
|
|
|
- (concat-tx-fn result result2))
|
|
|
- result))))))))
|
|
|
+ (let [non-consecutive-blocks (db-model/get-non-consecutive-blocks blocks)]
|
|
|
+ (when (empty? non-consecutive-blocks)
|
|
|
+ (let [first-block (db/entity (:db/id (first blocks)))
|
|
|
+ left (db/entity (:db/id (:block/left first-block)))
|
|
|
+ parent (:block/parent first-block)
|
|
|
+ db (db/get-db)
|
|
|
+ top-level-blocks (get-top-level-blocks blocks)
|
|
|
+ concat-tx-fn (fn [& results]
|
|
|
+ {:tx-data (->> (map :tx-data results)
|
|
|
+ (apply util/concat-without-nil))
|
|
|
+ :tx-meta (:tx-meta (first results))})
|
|
|
+ opts {:outliner-op :indent-outdent-blocks}]
|
|
|
+ (if indent?
|
|
|
+ (when (and left (not (page-first-child? first-block)))
|
|
|
+ (let [last-direct-child-id (db-model/get-block-last-direct-child db (:db/id left) false)
|
|
|
+ blocks' (drop-while (fn [b]
|
|
|
+ (= (:db/id (:block/parent b))
|
|
|
+ (:db/id left)))
|
|
|
+ top-level-blocks)]
|
|
|
+ (when (seq blocks')
|
|
|
+ (if last-direct-child-id
|
|
|
+ (let [last-direct-child (db/entity last-direct-child-id)
|
|
|
+ result (move-blocks blocks' last-direct-child (merge opts {:sibling? true}))
|
|
|
+ ;; expand `left` if it's collapsed
|
|
|
+ collapsed-tx (when (:block/collapsed? left)
|
|
|
+ {:tx-data [{:db/id (:db/id left)
|
|
|
+ :block/collapsed? false}]})]
|
|
|
+ (concat-tx-fn result collapsed-tx))
|
|
|
+ (move-blocks blocks' left (merge opts {:sibling? false}))))))
|
|
|
+ (when (and parent (not (page-block? (db/entity (:db/id parent)))))
|
|
|
+ (let [blocks' (take-while (fn [b]
|
|
|
+ (not= (:db/id (:block/parent b))
|
|
|
+ (:db/id (:block/parent parent))))
|
|
|
+ top-level-blocks)
|
|
|
+ result (move-blocks blocks' parent (merge opts {:sibling? true}))]
|
|
|
+ (if (state/logical-outdenting?)
|
|
|
+ result
|
|
|
+ ;; direct outdenting (default behavior)
|
|
|
+ (let [last-top-block (db/pull (:db/id (last blocks')))
|
|
|
+ right-siblings (->> (get-right-siblings (block last-top-block))
|
|
|
+ (map :data))]
|
|
|
+ (if (seq right-siblings)
|
|
|
+ (let [result2 (if-let [last-direct-child-id (db-model/get-block-last-direct-child db (:db/id last-top-block) false)]
|
|
|
+ (move-blocks right-siblings (db/entity last-direct-child-id) (merge opts {:sibling? true}))
|
|
|
+ (move-blocks right-siblings last-top-block (merge opts {:sibling? false})))]
|
|
|
+ (concat-tx-fn result result2))
|
|
|
+ result))))))))))
|
|
|
|
|
|
;;; ### write-operations have side-effects (do transactions) ;;;;;;;;;;;;;;;;
|
|
|
|