mirror of
https://github.com/logseq/logseq.git
synced 2026-04-24 14:14:55 +00:00
452 lines
19 KiB
Clojure
452 lines
19 KiB
Clojure
(ns frontend.handler.whiteboard
|
|
"Whiteboard related handlers"
|
|
(:require [datascript.core :as d]
|
|
[dommy.core :as dom]
|
|
[frontend.db :as db]
|
|
[frontend.db.model :as model]
|
|
[frontend.db.utils :as db-utils]
|
|
[frontend.handler.editor :as editor-handler]
|
|
[frontend.handler.route :as route-handler]
|
|
[frontend.modules.editor.undo-redo :as history]
|
|
[frontend.modules.outliner.core :as outliner]
|
|
[frontend.modules.outliner.file :as outliner-file]
|
|
[frontend.state :as state]
|
|
[frontend.config :as config]
|
|
[frontend.storage :as storage]
|
|
[frontend.util :as util]
|
|
[logseq.graph-parser.util :as gp-util]
|
|
[logseq.graph-parser.whiteboard :as gp-whiteboard]
|
|
[promesa.core :as p]
|
|
[goog.object :as gobj]
|
|
[clojure.set :as set]
|
|
[clojure.string :as string]
|
|
[cljs-bean.core :as bean]))
|
|
|
|
(defn js->clj-keywordize
|
|
[obj]
|
|
(js->clj obj :keywordize-keys true))
|
|
|
|
(defn shape->block [shape page-name]
|
|
(let [properties {:ls-type :whiteboard-shape
|
|
:logseq.tldraw.shape shape}
|
|
block {:block/page {:block/name (util/page-name-sanity-lc page-name)}
|
|
:block/parent {:block/name page-name}
|
|
:block/properties properties}
|
|
additional-props (gp-whiteboard/with-whiteboard-block-props block page-name)]
|
|
(merge block additional-props)))
|
|
|
|
(defn- get-whiteboard-clj [page-name]
|
|
(when (model/page-exists? page-name)
|
|
(let [page-block (model/get-page page-name)
|
|
;; fixme: can we use cache?
|
|
blocks (model/get-page-blocks-no-cache page-name)]
|
|
[page-block blocks])))
|
|
|
|
(defn- build-shapes
|
|
[page-block blocks]
|
|
(let [shapes-index (get-in page-block [:block/properties :logseq.tldraw.page :shapes-index])
|
|
shape-id->index (zipmap shapes-index (range 0 (count shapes-index)))]
|
|
(->> blocks
|
|
(map (fn [block]
|
|
(assoc block :index (get shape-id->index (str (:block/uuid block)) 0))))
|
|
(filter gp-whiteboard/shape-block?)
|
|
(map gp-whiteboard/block->shape)
|
|
(sort-by :index))))
|
|
|
|
(defn- whiteboard-clj->tldr [page-block blocks]
|
|
(let [id (str (:block/uuid page-block))
|
|
shapes (build-shapes page-block blocks)
|
|
tldr-page (gp-whiteboard/page-block->tldr-page page-block)
|
|
assets (:assets tldr-page)
|
|
tldr-page (dissoc tldr-page :assets)]
|
|
(clj->js {:currentPageId id
|
|
:assets (or assets #js[])
|
|
:selectedIds #js[]
|
|
:pages [(merge tldr-page
|
|
{:id id
|
|
:name (:block/name page-block)
|
|
:shapes shapes})]})))
|
|
|
|
(defn build-page-block
|
|
[page-name tldraw-page assets shapes-index]
|
|
(let [page-entity (model/get-page page-name)
|
|
get-k #(gobj/get tldraw-page %)]
|
|
{:block/name page-name
|
|
:block/type "whiteboard"
|
|
:block/properties {:ls-type :whiteboard-page
|
|
:logseq.tldraw.page {:id (get-k "id")
|
|
:name (get-k "name")
|
|
:bindings (js->clj-keywordize (get-k "bindings"))
|
|
:nonce (get-k "nonce")
|
|
:assets (js->clj-keywordize assets)
|
|
:shapes-index shapes-index}}
|
|
:block/updated-at (util/time-ms)
|
|
:block/created-at (or (:block/created-at page-entity)
|
|
(util/time-ms))}))
|
|
|
|
(defn- compute-tx
|
|
[^js app ^js tl-page new-id-nonces db-id-nonces page-name replace?]
|
|
(let [assets (js->clj-keywordize (.getCleanUpAssets app))
|
|
new-shapes (.-shapes tl-page)
|
|
shapes-index (map #(gobj/get % "id") new-shapes)
|
|
shape-id->index (zipmap shapes-index (range (.-length new-shapes)))
|
|
upsert-shapes (->> (set/difference new-id-nonces db-id-nonces)
|
|
(map (fn [{:keys [id]}]
|
|
(-> (.-serialized ^js (.getShapeById tl-page id))
|
|
js->clj-keywordize
|
|
(assoc :index (get shape-id->index id)))))
|
|
(set))
|
|
old-ids (set (map :id db-id-nonces))
|
|
new-ids (set (map :id new-id-nonces))
|
|
created-ids (->> (set/difference new-ids old-ids)
|
|
(remove string/blank?)
|
|
(set))
|
|
created-shapes (set (filter #(created-ids (:id %)) upsert-shapes))
|
|
deleted-ids (->> (set/difference old-ids new-ids)
|
|
(remove string/blank?))
|
|
repo (state/get-current-repo)
|
|
deleted-shapes (when (seq deleted-ids)
|
|
(->> (db/pull-many repo '[*] (mapv (fn [id] [:block/uuid (uuid id)]) deleted-ids))
|
|
(map (fn [b]
|
|
(get-in b [:block/properties :logseq.tldraw.shape])))))
|
|
deleted-shapes-tx (mapv (fn [id] [:db/retractEntity [:block/uuid (uuid id)]]) deleted-ids)
|
|
with-timestamps (fn [block]
|
|
(if (contains? created-ids (str (:block/uuid block)))
|
|
(assoc block :block/updated-at (util/time-ms))
|
|
(outliner/block-with-timestamps block)))
|
|
changed-shapes (set/difference upsert-shapes created-shapes)
|
|
prev-changed-blocks (when (seq changed-shapes)
|
|
(db/pull-many repo '[*] (mapv (fn [shape]
|
|
[:block/uuid (uuid (:id shape))]) changed-shapes)))]
|
|
{:page-block (build-page-block page-name tl-page assets shapes-index)
|
|
:upserted-blocks (->> upsert-shapes
|
|
(map #(shape->block % page-name))
|
|
(map with-timestamps))
|
|
:delete-blocks deleted-shapes-tx
|
|
:metadata {:whiteboard/transact? (not replace?)
|
|
:replace? replace?
|
|
:data {:page-name page-name
|
|
:deleted-shapes deleted-shapes
|
|
:new-shapes created-shapes
|
|
:changed-shapes changed-shapes
|
|
:prev-changed-blocks prev-changed-blocks}}}))
|
|
|
|
(defonce *last-shapes-nonce (atom {}))
|
|
(defn transact-tldr-delta! [page-name ^js app replace?]
|
|
(let [tl-page ^js (second (first (.-pages app)))
|
|
shapes (.-shapes ^js tl-page)
|
|
page-block (model/get-page page-name)
|
|
prev-shapes-index (get-in page-block [:block/properties :logseq.tldraw.page :shapes-index])
|
|
shape-id->prev-index (zipmap prev-shapes-index (range (count prev-shapes-index)))
|
|
new-id-nonces (set (map-indexed (fn [idx shape]
|
|
(let [id (.-id shape)]
|
|
{:id id
|
|
:nonce (if (= idx (get shape-id->prev-index id))
|
|
(.-nonce shape)
|
|
(js/Date.now))})) shapes))
|
|
repo (state/get-current-repo)
|
|
db-id-nonces (or
|
|
(get-in @*last-shapes-nonce [repo page-name])
|
|
(set (->> (model/get-whiteboard-id-nonces repo page-name)
|
|
(map #(update % :id str)))))
|
|
{:keys [page-block upserted-blocks delete-blocks metadata]}
|
|
(compute-tx app tl-page new-id-nonces db-id-nonces page-name replace?)
|
|
tx-data (concat delete-blocks [page-block] upserted-blocks)
|
|
new-shapes (get-in metadata [:data :new-shapes])
|
|
metadata' (cond
|
|
;; group
|
|
(some #(= "group" (:type %)) new-shapes)
|
|
(assoc metadata :whiteboard/op :group)
|
|
|
|
;; ungroup
|
|
(some #(= "group" (:type %)) (get-in metadata [:data :deleted-shapes]))
|
|
(assoc metadata :whiteboard/op :un-group)
|
|
|
|
;; arrow
|
|
(some #(and (= "line" (:type %))
|
|
(= "arrow " (:end (:decorations %)))) new-shapes)
|
|
|
|
(assoc metadata :whiteboard/op :new-arrow)
|
|
:else
|
|
metadata)
|
|
metadata' (if (seq (concat upserted-blocks delete-blocks))
|
|
metadata'
|
|
(assoc metadata :undo? true))]
|
|
(swap! *last-shapes-nonce assoc-in [repo page-name] new-id-nonces)
|
|
(if (contains? #{:new-arrow} (:whiteboard/op metadata'))
|
|
(state/set-state! :whiteboard/pending-tx-data
|
|
{:tx-data tx-data
|
|
:metadata metadata'})
|
|
(let [pending-tx-data (:whiteboard/pending-tx-data @state/state)
|
|
tx-data' (concat (:tx-data pending-tx-data) tx-data)
|
|
metadata'' (merge metadata' (:metadata pending-tx-data))]
|
|
(state/set-state! :whiteboard/pending-tx-data {})
|
|
(db-utils/transact! repo tx-data' metadata'')))))
|
|
|
|
(defn get-default-new-whiteboard-tx
|
|
[page-name id]
|
|
[#:block{:name (util/page-name-sanity-lc page-name),
|
|
:type "whiteboard",
|
|
:properties
|
|
{:ls-type :whiteboard-page,
|
|
:logseq.tldraw.page
|
|
{:id id,
|
|
:name page-name,
|
|
:ls-type :whiteboard-page,
|
|
:bindings {},
|
|
:nonce 1,
|
|
:assets []}},
|
|
:updated-at (util/time-ms),
|
|
:created-at (util/time-ms)}])
|
|
|
|
(defn get-whiteboard-entity [page-name]
|
|
(db-utils/entity [:block/name (util/page-name-sanity-lc page-name)]))
|
|
|
|
(defn create-new-whiteboard-page!
|
|
([]
|
|
(create-new-whiteboard-page! nil))
|
|
([name]
|
|
(let [uuid (or (and name (parse-uuid name)) (d/squuid))
|
|
name (or name (str uuid))]
|
|
(db/transact! (get-default-new-whiteboard-tx name (str uuid)))
|
|
(let [entity (get-whiteboard-entity name)
|
|
tx (assoc (select-keys entity [:db/id])
|
|
:block/uuid uuid)]
|
|
(db-utils/transact! [tx])
|
|
(let [page-entity (get-whiteboard-entity name)]
|
|
(when (and page-entity (nil? (:block/file page-entity)))
|
|
(outliner-file/sync-to-file page-entity)))))))
|
|
|
|
(defn create-new-whiteboard-and-redirect!
|
|
([]
|
|
(create-new-whiteboard-and-redirect! (str (d/squuid))))
|
|
([name]
|
|
(when-not config/publishing?
|
|
(create-new-whiteboard-page! name)
|
|
(route-handler/redirect-to-whiteboard! name))))
|
|
|
|
(defn ->logseq-portal-shape
|
|
[block-id point]
|
|
{:blockType (if (parse-uuid (str block-id)) "B" "P")
|
|
:id (str (d/squuid))
|
|
:compact false
|
|
:pageId (str block-id)
|
|
:point point
|
|
:size [400, 0]
|
|
:type "logseq-portal"})
|
|
|
|
(defn add-new-block-portal-shape!
|
|
"Given the block uuid, add a new shape to the referenced block.
|
|
By default it will be placed next to the given shape id"
|
|
[block-uuid source-shape & {:keys [link? bottom?]}]
|
|
(when-let [app (state/active-tldraw-app)]
|
|
(let [^js api (.-api app)
|
|
point (-> (.getShapeById app source-shape)
|
|
(.-bounds)
|
|
((fn [bounds] (if bottom?
|
|
[(.-minX bounds) (+ 64 (.-maxY bounds))]
|
|
[(+ 64 (.-maxX bounds)) (.-minY bounds)]))))
|
|
shape (->logseq-portal-shape block-uuid point)]
|
|
(when (uuid? block-uuid) (editor-handler/set-blocks-id! [block-uuid]))
|
|
(.createShapes api (clj->js shape))
|
|
(when link?
|
|
(.createNewLineBinding api source-shape (:id shape))))))
|
|
|
|
(defn page-name->tldr!
|
|
([page-name]
|
|
(clj->js
|
|
(if page-name
|
|
(if-let [[page-block blocks] (get-whiteboard-clj page-name)]
|
|
(whiteboard-clj->tldr page-block blocks)
|
|
(create-new-whiteboard-page! page-name))
|
|
(create-new-whiteboard-page! nil)))))
|
|
|
|
(defn- get-whiteboard-blocks
|
|
"Given a page, return all the logseq blocks (exclude all shapes)"
|
|
[page-name]
|
|
(let [blocks (model/get-page-blocks-no-cache page-name)]
|
|
(remove gp-whiteboard/shape-block? blocks)))
|
|
|
|
(defn- get-last-root-block
|
|
"Get the last root Logseq block in the page. Main purpose is to calculate the new :block/left id"
|
|
[page-name]
|
|
(let [page-id (:db/id (model/get-page page-name))
|
|
blocks (get-whiteboard-blocks page-name)
|
|
root-blocks (filter (fn [block] (= page-id (:db/id (:block/parent block)))) blocks)
|
|
root-block-left-ids (->> root-blocks
|
|
(map (fn [block] (get-in block [:block/left :db/id] nil)))
|
|
(remove nil?)
|
|
(set))
|
|
blocks-with-no-next (remove #(root-block-left-ids (:db/id %)) root-blocks)]
|
|
(when (seq blocks-with-no-next) (first blocks-with-no-next))))
|
|
|
|
(defn add-new-block!
|
|
[page-name content]
|
|
(let [uuid (d/squuid)
|
|
page-entity (model/get-page page-name)
|
|
last-root-block (or (get-last-root-block page-name) page-entity)
|
|
tx {:block/left (select-keys last-root-block [:db/id])
|
|
:block/uuid uuid
|
|
:block/content (or content "")
|
|
:block/format :markdown ;; fixme to support org?
|
|
:block/page {:block/name (util/page-name-sanity-lc page-name)
|
|
:block/original-name page-name}
|
|
:block/parent {:block/name page-name}}]
|
|
(db-utils/transact! [tx])
|
|
uuid))
|
|
|
|
(defn inside-portal?
|
|
[target]
|
|
(some? (dom/closest target ".tl-logseq-cp-container")))
|
|
|
|
(defn closest-shape
|
|
[target]
|
|
(when-let [shape-el (dom/closest target "[data-shape-id]")]
|
|
(.getAttribute shape-el "data-shape-id")))
|
|
|
|
(defn get-onboard-whiteboard-edn
|
|
[]
|
|
(p/let [^js res (js/fetch "./whiteboard/onboarding.edn") ;; do we need to cache it?
|
|
text (.text res)
|
|
edn (gp-util/safe-read-string text)]
|
|
edn))
|
|
|
|
(defn clone-whiteboard-from-edn
|
|
"Given a tldr, clone the whiteboard page into current active whiteboard"
|
|
([edn]
|
|
(when-let [app (state/active-tldraw-app)]
|
|
(clone-whiteboard-from-edn edn (.-api app))))
|
|
([{:keys [pages blocks]} api]
|
|
(let [page-block (first pages)
|
|
;; FIXME: should also clone normal blocks
|
|
shapes (build-shapes page-block blocks)
|
|
tldr-page (gp-whiteboard/page-block->tldr-page page-block)
|
|
assets (:assets tldr-page)
|
|
bindings (:bindings tldr-page)]
|
|
(.cloneShapesIntoCurrentPage ^js api (clj->js {:shapes shapes
|
|
:assets assets
|
|
:bindings bindings})))))
|
|
(defn should-populate-onboarding-whiteboard?
|
|
"When there is not whiteboard, or there is only whiteboard that is the given page name, we should populate the onboarding whiteboard"
|
|
[page-name]
|
|
(let [whiteboards (model/get-all-whiteboards (state/get-current-repo))]
|
|
(and (or (empty? whiteboards)
|
|
(and
|
|
(= 1 (count whiteboards))
|
|
(= page-name (:block/name (first whiteboards)))))
|
|
(not (state/get-onboarding-whiteboard?)))))
|
|
|
|
(defn populate-onboarding-whiteboard
|
|
[api]
|
|
(when (some? api)
|
|
(-> (p/let [edn (get-onboard-whiteboard-edn)]
|
|
(clone-whiteboard-from-edn edn api)
|
|
(state/set-onboarding-whiteboard! true))
|
|
(p/catch
|
|
(fn [e] (js/console.warn "Failed to populate onboarding whiteboard" e))))))
|
|
|
|
(defn- delete-shapes!
|
|
[^js api shapes]
|
|
(apply (.-deleteShapes api) (map :id shapes)))
|
|
|
|
(defn- create-shapes!
|
|
[^js api shapes]
|
|
(apply (.-createShapes api) (bean/->js shapes)))
|
|
|
|
(defn- update-shapes!
|
|
[^js api shapes]
|
|
(apply (.-updateShapes api) (bean/->js shapes)))
|
|
|
|
(defn- select-shapes
|
|
[^js api ids]
|
|
(apply (.-selectShapes api) ids))
|
|
|
|
(defn update-bindings!
|
|
[^js tl-page page-name]
|
|
(when-let [page (db/entity [:block/name page-name])]
|
|
(let [bindings (get-in page [:block/properties :logseq.tldraw.page :bindings])]
|
|
(when (seq bindings)
|
|
(.updateBindings tl-page (bean/->js bindings))))))
|
|
|
|
(defn update-shapes-index!
|
|
[^js tl-page page-name]
|
|
(when-let [page (db/entity [:block/name page-name])]
|
|
(let [shapes-index (get-in page [:block/properties :logseq.tldraw.page :shapes-index])]
|
|
(when (seq shapes-index)
|
|
(.updateShapesIndex tl-page (bean/->js shapes-index))))))
|
|
|
|
(defn undo!
|
|
[{:keys [tx-meta]}]
|
|
(history/pause-listener!)
|
|
(try
|
|
(when-let [app (state/active-tldraw-app)]
|
|
(let [{:keys [page-name deleted-shapes new-shapes changed-shapes prev-changed-blocks]} (:data tx-meta)
|
|
whiteboard-op (:whiteboard/op tx-meta)
|
|
^js api (.-api app)
|
|
tl-page ^js (second (first (.-pages app)))]
|
|
(when api
|
|
(update-bindings! tl-page page-name)
|
|
(update-shapes-index! tl-page page-name)
|
|
(case whiteboard-op
|
|
:group
|
|
(do
|
|
(select-shapes api (map :id new-shapes))
|
|
(.unGroup api))
|
|
:un-group
|
|
(do
|
|
(select-shapes api (mapcat :children deleted-shapes))
|
|
(.doGroup api))
|
|
(do
|
|
(when (seq deleted-shapes)
|
|
(create-shapes! api deleted-shapes))
|
|
(when (seq new-shapes)
|
|
(delete-shapes! api new-shapes))
|
|
(when (seq changed-shapes)
|
|
(let [prev-shapes (map (fn [b] (get-in b [:block/properties :logseq.tldraw.shape]))
|
|
prev-changed-blocks)]
|
|
(update-shapes! api prev-shapes))))))))
|
|
(catch :default e
|
|
(js/console.error e)))
|
|
(history/resume-listener!))
|
|
|
|
(defn redo!
|
|
[{:keys [tx-meta]}]
|
|
(history/pause-listener!)
|
|
(try
|
|
(when-let [app (state/active-tldraw-app)]
|
|
(let [{:keys [page-name deleted-shapes new-shapes changed-shapes]} (:data tx-meta)
|
|
whiteboard-op (:whiteboard/op tx-meta)
|
|
^js api (.-api app)
|
|
tl-page ^js (second (first (.-pages app)))]
|
|
(when api
|
|
(update-bindings! tl-page page-name)
|
|
(update-shapes-index! tl-page page-name)
|
|
(case whiteboard-op
|
|
:group
|
|
(do
|
|
(select-shapes api (mapcat :children new-shapes))
|
|
(.doGroup api))
|
|
:un-group
|
|
(do
|
|
(select-shapes api (map :id deleted-shapes))
|
|
(.unGroup api))
|
|
(do
|
|
(when (seq deleted-shapes)
|
|
(delete-shapes! api deleted-shapes))
|
|
(when (seq new-shapes)
|
|
(create-shapes! api new-shapes))
|
|
(when (seq changed-shapes)
|
|
(update-shapes! api changed-shapes)))))))
|
|
(catch :default e
|
|
(js/console.error e)))
|
|
(history/resume-listener!))
|
|
|
|
(defn onboarding-show
|
|
[]
|
|
(when (not (or (state/sub :whiteboard/onboarding-tour?)
|
|
(config/demo-graph?)
|
|
(util/mobile?)))
|
|
(state/pub-event! [:whiteboard/onboarding])
|
|
(state/set-state! [:whiteboard/onboarding-tour?] true)
|
|
(storage/set :whiteboard-onboarding-tour? true)))
|