Files
logseq/src/main/frontend/handler/page.cljs

1003 lines
45 KiB
Clojure

(ns frontend.handler.page
"Provides util handler fns for pages"
(:require [cljs.reader :as reader]
[clojure.string :as string]
[clojure.walk :as walk]
[datascript.core :as d]
[frontend.commands :as commands]
[frontend.config :as config]
[frontend.date :as date]
[frontend.db :as db]
[frontend.db.conn :as conn]
[frontend.db.model :as model]
[frontend.db.utils :as db-utils]
[frontend.format.block :as block]
[frontend.fs :as fs]
[frontend.handler.common :as common-handler]
[frontend.handler.config :as config-handler]
[frontend.handler.editor :as editor-handler]
[frontend.handler.plugin :as plugin-handler]
[frontend.handler.notification :as notification]
[frontend.handler.file-based.recent :as recent-handler]
[frontend.handler.route :as route-handler]
[frontend.handler.ui :as ui-handler]
[frontend.handler.web.nfs :as web-nfs]
[frontend.mobile.util :as mobile-util]
[frontend.modules.outliner.core :as outliner-core]
[frontend.modules.outliner.file :as outliner-file]
[frontend.modules.outliner.tree :as outliner-tree]
[frontend.state :as state]
[frontend.util :as util]
[frontend.util.cursor :as cursor]
[frontend.util.fs :as fs-util]
[frontend.util.page-property :as page-property]
[frontend.util.page :as page-util]
[frontend.util.property-edit :as property-edit]
[frontend.util.url :as url-util]
[goog.functions :refer [debounce]]
[goog.object :as gobj]
[lambdaisland.glogi :as log]
[logseq.db.schema :as db-schema]
[logseq.graph-parser.block :as gp-block]
[logseq.graph-parser.config :as gp-config]
[logseq.graph-parser.property :as gp-property]
[logseq.graph-parser.text :as text]
[logseq.graph-parser.util :as gp-util]
[logseq.graph-parser.util.page-ref :as page-ref]
[promesa.core :as p]
[logseq.common.path :as path]
[medley.core :as medley]))
;; FIXME: add whiteboard
(defn- get-directory
[journal?]
(if journal?
(config/get-journals-directory)
(config/get-pages-directory)))
(defn- get-file-name
[journal? title]
(when-let [s (if journal?
(date/journal-title->default title)
;; legacy in org-mode format, don't escape slashes except bug reported
(gp-util/page-name-sanity (string/lower-case title)))]
;; Win10 file path has a length limit of 260 chars
(gp-util/safe-subs s 0 200)))
(defn- build-title [page]
;; Don't wrap `\"` anymore, as tiitle property is not effected by `,` now
;; The previous extract behavior isn't unwrapping the `'"` either. So no need
;; to maintain the compatibility.
(:block/original-name page))
(defn default-properties-block
([title format page]
(default-properties-block title format page {}))
([title format page properties]
(let [p (common-handler/get-page-default-properties title)
ps (merge p properties)
content (page-property/insert-properties format "" ps)
refs (gp-block/get-page-refs-from-properties properties
(db/get-db (state/get-current-repo))
(state/get-date-formatter)
(state/get-config))]
{:block/uuid (db/new-block-id)
:block/pre-block? true
:block/properties ps
:block/properties-order (keys ps)
:block/refs refs
:block/left page
:block/format format
:block/content content
:block/parent page
:block/page page})))
(defn- create-title-property?
[journal? page-name]
(and (not (config/db-based-graph? (state/get-current-repo)))
(not journal?)
(= (state/get-filename-format) :legacy) ;; reduce title computation
(fs-util/create-title-property? page-name)))
(defn- build-page-tx [repo format properties page journal? whiteboard?]
(when (:block/uuid page)
(let [page-entity [:block/uuid (:block/uuid page)]
title (util/get-page-original-name page)
create-title? (create-title-property? journal? title)
page (merge page
(when (seq properties) {:block/properties properties})
(when whiteboard? {:block/type "whiteboard"}))
page-empty? (db/page-empty? (state/get-current-repo) (:block/name page))]
(cond
(not page-empty?)
[page]
(and create-title?
(not whiteboard?))
(let [properties-block (default-properties-block (build-title page) format page-entity properties)]
[page
properties-block])
(and (seq properties)
(not whiteboard?)
(not (config/db-based-graph? (state/get-current-repo))))
[page (editor-handler/properties-block repo properties format page-entity)]
:else
[page]))))
(defn create!
"Create page.
:redirect? - when true, redirect to the created page, otherwise return sanitized page name.
:split-namespace? - when true, split hierarchical namespace into levels.
:create-first-block? - when true, create an empty block if the page is empty.
:uuid - when set, use this uuid instead of generating a new one."
([title]
(create! title {}))
([title {:keys [redirect? create-first-block? format properties split-namespace? journal? uuid whiteboard? rename?]
:or {redirect? true
create-first-block? true
rename? false
format nil
properties nil
split-namespace? true
uuid nil}}]
(let [title (-> (string/trim title)
(text/page-ref-un-brackets!)
;; remove `#` from tags
(string/replace #"^#+" ""))
title (gp-util/remove-boundary-slashes title)
page-name (util/page-name-sanity-lc title)
repo (state/get-current-repo)
with-uuid? (if (uuid? uuid) uuid true)] ;; FIXME: prettier validation
(when (or (db/page-empty? repo page-name) rename?)
(let [pages (if split-namespace?
(gp-util/split-namespace-pages title)
[title])
format (or format (state/get-preferred-format))
pages (map (fn [page]
;; only apply uuid to the deepest hierarchy of page to create if provided.
(-> (block/page-name->map page (if (= page title) with-uuid? true))
(assoc :block/format format)))
pages)
txs (->> pages
;; for namespace pages, only last page need properties
drop-last
(mapcat #(build-page-tx repo format nil % journal? false))
(remove nil?))
txs (map-indexed (fn [i page]
(if (zero? i)
page
(assoc page :block/namespace
[:block/uuid (:block/uuid (nth txs (dec i)))])))
txs)
last-txs (build-page-tx repo format properties (last pages) journal? whiteboard?)
last-txs (if (seq txs)
(update last-txs 0
(fn [p]
(assoc p :block/namespace [:block/uuid (:block/uuid (last txs))])))
last-txs)
txs (concat
(when (and rename? uuid)
(when-let [e (db/entity [:block/uuid uuid])]
[[:db/retract (:db/id e) :block/namespace]
[:db/retract (:db/id e) :block/refs]]))
txs
last-txs)]
(when (seq txs)
(db/transact! txs)))
(when create-first-block?
(when (or
(db/page-empty? repo (:db/id (db/entity [:block/name page-name])))
(create-title-property? journal? page-name))
(editor-handler/api-insert-new-block! "" {:page page-name}))))
(when redirect?
(route-handler/redirect-to-page! page-name))
page-name)))
(defn delete-file!
[repo page-name unlink-file?]
(let [file (db/get-page-file page-name)
file-path (:file/path file)]
;; delete file
(when-not (string/blank? file-path)
(db/transact! [[:db.fn/retractEntity [:file/path file-path]]])
(when unlink-file?
(-> (fs/unlink! repo (config/get-repo-fpath repo file-path) nil)
(p/catch (fn [error] (js/console.error error))))))))
(defn- compute-new-file-path
"Construct the full path given old full path and the file sanitized body.
Ext. included in the `old-path`."
[old-path new-file-name-body]
(let [result (string/split old-path "/")
ext (last (string/split (last result) "."))
new-file (str new-file-name-body "." ext)
parts (concat (butlast result) [new-file])]
(util/string-join-path parts)))
(defn rename-file!
"emit file-rename events to :file/rename-event-chan
force-fs? - when true, rename file event the db transact is failed."
([file new-file-name-body ok-handler]
(rename-file! file new-file-name-body ok-handler false))
([file new-file-name-body ok-handler force-fs?]
(let [repo (state/get-current-repo)
file (db/pull (:db/id file))
old-path (:file/path file)
new-path (compute-new-file-path old-path new-file-name-body)
transact #(db/transact! repo [{:db/id (:db/id file)
:file/path new-path}])]
;; update db
(if force-fs?
(try (transact) ;; capture error and continue FS rename if failed
(catch :default e
(log/error :rename-file e)))
(transact)) ;; interrupted if failed
(->
(p/let [_ (state/offer-file-rename-event-chan! {:repo repo
:old-path old-path
:new-path new-path})
_ (fs/rename! repo old-path new-path)]
(ok-handler))
(p/catch (fn [error]
(println "file rename failed: " error)))))))
(defn- replace-page-ref!
"Unsanitized names"
[content old-name new-name]
(let [[original-old-name original-new-name] (map string/trim [old-name new-name])
[old-ref new-ref] (map page-ref/->page-ref [old-name new-name])
[old-name new-name] (map #(if (string/includes? % "/")
(string/replace % "/" ".")
%)
[original-old-name original-new-name])
old-org-ref (and (= :org (state/get-preferred-format))
(:org-mode/insert-file-link? (state/get-config))
(re-find
(re-pattern
(util/format
"\\[\\[file:\\.*/.*%s\\.org\\]\\[(.*?)\\]\\]" old-name))
content))]
(-> (if old-org-ref
(let [[old-full-ref old-label] old-org-ref
new-label (if (= old-label original-old-name)
original-new-name
old-label)
new-full-ref (-> (string/replace old-full-ref old-name new-name)
(string/replace (str "[" old-label "]")
(str "[" new-label "]")))]
(string/replace content old-full-ref new-full-ref))
content)
(string/replace old-ref new-ref))))
(defn- replace-tag-ref!
[content old-name new-name]
(let [old-tag (util/format "#%s" old-name)
new-tag (if (re-find #"[\s\t]+" new-name)
(util/format "#[[%s]]" new-name)
(str "#" new-name))]
;; hash tag parsing rules https://github.com/logseq/mldoc/blob/701243eaf9b4157348f235670718f6ad19ebe7f8/test/test_markdown.ml#L631
;; Safari doesn't support look behind, don't use
;; TODO: parse via mldoc
(string/replace content
(re-pattern (str "(?i)(^|\\s)(" (util/escape-regex-chars old-tag) ")(?=[,\\.]*($|\\s))"))
;; case_insense^ ^lhs ^_grp2 look_ahead^ ^_grp3
(fn [[_match lhs _grp2 _grp3]]
(str lhs new-tag)))))
(defn- replace-property-ref!
[content old-name new-name format]
(let [new-name (keyword (string/replace (string/lower-case new-name) #"\s+" "-"))
org-format? (= :org format)
old-property (if org-format? (gp-property/colons-org old-name) (str old-name gp-property/colons))
new-property (if org-format? (gp-property/colons-org (name new-name)) (str (name new-name) gp-property/colons))]
(util/replace-ignore-case content old-property new-property)))
(defn- replace-old-page!
"Unsanitized names"
[content old-name new-name format]
(when (and (string? content) (string? old-name) (string? new-name))
(-> content
(replace-page-ref! old-name new-name)
(replace-tag-ref! old-name new-name)
(replace-property-ref! old-name new-name format))))
(defn- walk-replace-old-page!
"Unsanitized names"
[form old-name new-name format]
(walk/postwalk (fn [f]
(cond
(and (vector? f)
(contains? #{"Search" "Label"} (first f))
(string/starts-with? (second f) (str old-name "/")))
[(first f) (string/replace-first (second f)
(str old-name "/")
(str new-name "/"))]
(string? f)
(if (= f old-name)
new-name
(replace-old-page! f old-name new-name format))
(and (keyword f) (= (name f) old-name))
(keyword (string/replace (string/lower-case new-name) #"\s+" "-"))
:else
f))
form))
(defn favorited?
[page-name]
(let [favorites (->> (:favorites (state/get-config))
(filter string?)
(map string/lower-case)
(set))]
(contains? favorites page-name)))
(defn favorite-page!
[page-name]
(when-not (string/blank? page-name)
(let [favorites (->
(cons
page-name
(or (:favorites (state/get-config)) []))
(distinct)
(vec))]
(config-handler/set-config! :favorites favorites))))
(defn unfavorite-page!
[page-name]
(when-not (string/blank? page-name)
(let [old-favorites (:favorites (state/get-config))
new-favorites (->> old-favorites
(remove #(= (string/lower-case %) (string/lower-case page-name)))
(vec))]
(when-not (= old-favorites new-favorites)
(config-handler/set-config! :favorites new-favorites)))))
(defn toggle-favorite! []
;; NOTE: in journals or settings, current-page is nil
(when-let [page-name (state/get-current-page)]
(let [favorites (:favorites (state/sub-config))
favorited? (contains? (set (map string/lower-case favorites))
(string/lower-case page-name))]
(if favorited?
(unfavorite-page! page-name)
(favorite-page! page-name)))))
(defn db-refs->page
"Replace [[page name]] with page name"
[repo page-entity]
(when (config/db-based-graph? repo)
(let [refs (:block/_refs page-entity)
id-ref->page #(db-utils/special-id-ref->page % [page-entity])]
(when (seq refs)
(let [tx-data (keep (fn [{:block/keys [raw-content properties] :as ref}]
;; block content or properties
(let [content' (id-ref->page raw-content)
content-tx (when (not= raw-content content')
{:db/id (:db/id ref)
:block/content content'})
page-uuid (:block/uuid page-entity)
properties' (-> (medley/map-vals (fn [v]
(cond
(and (coll? v) (uuid? (first v)))
(vec (remove #{page-uuid} v))
(and (uuid? v) (= v page-uuid))
nil
(and (coll? v) (string? (first v)))
(mapv id-ref->page v)
(string? v)
(id-ref->page v)
:else
v)) properties)
(util/remove-nils-non-nested))
tx (merge
content-tx
(when (not= (seq properties) (seq properties'))
{:db/id (:db/id ref)
:block/properties properties'}))]
tx)) refs)]
tx-data)))))
(defn delete!
[page-name ok-handler & {:keys [delete-file?]
:or {delete-file? true}}]
(route-handler/redirect-to-home!)
(when page-name
(when-let [repo (state/get-current-repo)]
(let [page-name (util/page-name-sanity-lc page-name)
blocks (db/get-page-blocks-no-cache page-name)
truncate-blocks-tx-data (mapv
(fn [block]
[:db.fn/retractEntity [:block/uuid (:block/uuid block)]])
blocks)
page (db/entity [:block/name page-name])
_ (delete-file! repo page-name delete-file?)
;; if other page alias this pagename,
;; then just remove some attrs of this entity instead of retractEntity
delete-page-tx (cond
(contains? #{"property" "class"} (:block/type page))
nil
(not (:block/_namespace page))
(if (model/get-alias-source-page (state/get-current-repo) page-name)
(when-let [id (:db/id (db/entity [:block/name page-name]))]
(mapv (fn [attribute]
[:db/retract id attribute])
db-schema/retract-page-attributes))
(concat (db-refs->page repo page)
[[:db.fn/retractEntity [:block/name page-name]]]))
:else
nil)
tx-data (concat truncate-blocks-tx-data delete-page-tx)]
(util/pprint tx-data)
(db/transact! repo tx-data {:outliner-op :delete-page})
(unfavorite-page! page-name)
(when (fn? ok-handler) (ok-handler))
(ui-handler/re-render-root!)))))
(defn- rename-update-block-refs!
[refs from-id to-id]
(->> refs
(remove #{{:db/id from-id}})
(cons {:db/id to-id})
(distinct)
(vec)))
(defn- rename-update-refs!
"Unsanitized only"
[page old-original-name new-name]
;; update all pages which have references to this page
(let [repo (state/get-current-repo)
to-page (db/entity [:block/name (util/page-name-sanity-lc new-name)])
blocks (:block/_refs (db/entity (:db/id page)))
page-ids (->> (map (fn [b]
{:db/id (:db/id (:block/page b))}) blocks)
(set))
tx (->> (map (fn [{:block/keys [uuid content properties format] :as block}]
(let [content (let [content' (replace-old-page! content old-original-name new-name format)]
(when-not (= content' content)
content'))
properties (let [properties' (walk-replace-old-page! properties old-original-name new-name format)]
(when-not (= properties' properties)
properties'))]
(when (or content properties)
(util/remove-nils-non-nested
{:block/uuid uuid
:block/content content
:block/properties properties
:block/properties-order (when (seq properties)
(map first properties))
:block/refs (->> (rename-update-block-refs! (:block/refs block) (:db/id page) (:db/id to-page))
(map :db/id)
(set))})))) blocks)
(remove nil?))]
(db/transact! repo tx)
(doseq [page-id page-ids]
(outliner-file/sync-to-file page-id))))
(defn- rename-update-namespace!
"update :block/namespace of the renamed block"
[page old-original-name new-name]
(let [old-namespace? (text/namespace-page? old-original-name)
new-namespace? (text/namespace-page? new-name)
update-namespace! (fn [] (let [namespace (first (gp-util/split-last "/" new-name))]
(when namespace
(create! namespace {:redirect? false}) ;; create parent page if not exist, creation of namespace ref is handled in `create!`
(let [namespace-block (db/pull [:block/name (gp-util/page-name-sanity-lc namespace)])
repo (state/get-current-repo)
page-txs [{:db/id (:db/id page)
:block/namespace (:db/id namespace-block)}]]
(d/transact! (db/get-db repo false) page-txs)))))
remove-namespace! (fn []
(db/transact! [[:db/retract (:db/id page) :block/namespace]]))]
(when old-namespace?
(if new-namespace?
(update-namespace!)
(remove-namespace!)))
(when-not old-namespace?
(when new-namespace?
(update-namespace!)))))
(defn- rename-page-aux
"Only accepts unsanitized page names"
[old-name new-name redirect?]
(let [old-page-name (util/page-name-sanity-lc old-name)
new-file-name-body (fs-util/file-name-sanity new-name) ;; w/o file extension
new-page-name (util/page-name-sanity-lc new-name)
repo (state/get-current-repo)
page (db/pull [:block/name old-page-name])]
(when (and repo page)
(let [old-original-name (:block/original-name page)
file (:block/file page)
journal? (:block/journal? page)
properties-block (:data (outliner-tree/-get-down (outliner-core/block page)))
properties-content (:block/content properties-block)
properties-block-tx (when (and properties-block
properties-content
(string/includes? (util/page-name-sanity-lc properties-content)
old-page-name))
(let [front-matter? (and (property-edit/front-matter?-when-file-based properties-content)
(= :markdown (:block/format properties-block)))]
{:db/id (:db/id properties-block)
:block/content (property-edit/insert-property-when-file-based
repo
(:block/format properties-block)
properties-content
:title
new-name
front-matter?)}))
page-txs [{:db/id (:db/id page)
:block/uuid (:block/uuid page)
:block/name new-page-name
:block/original-name new-name}]
page-txs (if properties-block-tx (conj page-txs properties-block-tx) page-txs)]
(d/transact! (db/get-db repo false) page-txs)
(when (fs-util/create-title-property? new-page-name)
(page-property/add-property! new-page-name :title new-name))
(when (and file (not journal?))
(rename-file! file new-file-name-body (fn [] nil)))
(let [home (get (state/get-config) :default-home {})]
(when (= old-page-name (util/page-name-sanity-lc (get home :page "")))
(config-handler/set-config! :default-home (assoc home :page new-name))))
(rename-update-refs! page old-original-name new-name)
(rename-update-namespace! page old-original-name new-name)
(outliner-file/sync-to-file page))
;; Redirect to the newly renamed page
(when redirect?
(route-handler/redirect! {:to (if (model/whiteboard-page? page) :whiteboard :page)
:push false
:path-params {:name new-page-name}}))
(when (favorited? old-page-name)
(p/do!
(unfavorite-page! old-page-name)
(favorite-page! new-page-name)))
(recent-handler/update-or-add-renamed-page repo old-page-name new-page-name)
(ui-handler/re-render-root!))))
(defn- rename-nested-pages
"Unsanitized names only"
[old-ns-name new-ns-name]
(let [repo (state/get-current-repo)
nested-page-str (page-ref/->page-ref (util/page-name-sanity-lc old-ns-name))
ns-prefix-format-str (str page-ref/left-brackets "%s/")
ns-prefix (util/format ns-prefix-format-str (util/page-name-sanity-lc old-ns-name))
nested-pages (db/get-pages-by-name-partition repo nested-page-str)
nested-pages-ns (db/get-pages-by-name-partition repo ns-prefix)]
(when nested-pages
;; rename page "[[obsidian]] is a tool" to "[[logseq]] is a tool"
(doseq [{:block/keys [name original-name]} nested-pages]
(let [old-page-title (or original-name name)
new-page-title (string/replace
old-page-title
(page-ref/->page-ref old-ns-name)
(page-ref/->page-ref new-ns-name))]
(when (and old-page-title new-page-title)
(p/do!
(rename-page-aux old-page-title new-page-title false)
(println "Renamed " old-page-title " to " new-page-title))))))
(when nested-pages-ns
;; rename page "[[obsidian/page1]] is a tool" to "[[logseq/page1]] is a tool"
(doseq [{:block/keys [name original-name]} nested-pages-ns]
(let [old-page-title (or original-name name)
new-page-title (string/replace
old-page-title
(util/format ns-prefix-format-str old-ns-name)
(util/format ns-prefix-format-str new-ns-name))]
(when (and old-page-title new-page-title)
(p/do!
(rename-page-aux old-page-title new-page-title false)
(println "Renamed " old-page-title " to " new-page-title))))))))
(defn- rename-namespace-pages!
"Original names (unsanitized only)"
[repo old-name new-name]
(let [pages (db/get-namespace-pages repo old-name)
page (db/pull [:block/name (util/page-name-sanity-lc old-name)])
pages (cons page pages)]
(doseq [{:block/keys [name original-name]} pages]
(let [old-page-title (or original-name name)
;; only replace one time, for the case that the namespace is a sub-string of the sub-namespace page name
;; Example: has pages [[work]] [[work/worklog]],
;; we want to rename [[work/worklog]] to [[work1/worklog]] when rename [[work]] to [[work1]],
;; but don't rename [[work/worklog]] to [[work1/work1log]]
new-page-title (string/replace-first old-page-title old-name new-name)
redirect? (= name (:block/name page))]
(when (and old-page-title new-page-title)
(p/let [_ (rename-page-aux old-page-title new-page-title redirect?)]
(println "Renamed " old-page-title " to " new-page-title)))))))
(defn merge-pages!
"Only accepts sanitized page names"
[from-page-name to-page-name]
(when (and (db/page-exists? from-page-name)
(db/page-exists? to-page-name)
(not= from-page-name to-page-name))
(let [to-page (db/entity [:block/name to-page-name])
to-id (:db/id to-page)
from-page (db/entity [:block/name from-page-name])
from-id (:db/id from-page)
from-first-child (some->> (db/pull from-id)
(outliner-core/block)
(outliner-tree/-get-down)
(outliner-core/get-data))
to-last-direct-child-id (model/get-block-last-direct-child (db/get-db) to-id false)
repo (state/get-current-repo)
conn (conn/get-db repo false)
datoms (d/datoms @conn :avet :block/page from-id)
block-eids (mapv :e datoms)
blocks (db-utils/pull-many repo '[:db/id :block/page :block/refs :block/path-refs :block/left :block/parent] block-eids)
tx-data (map (fn [block]
(let [id (:db/id block)]
(cond->
{:db/id id
:block/page {:db/id to-id}
:block/refs (rename-update-block-refs! (:block/refs block) from-id to-id)}
(and from-first-child (= id (:db/id from-first-child)))
(assoc :block/left {:db/id (or to-last-direct-child-id to-id)})
(= (:block/parent block) {:db/id from-id})
(assoc :block/parent {:db/id to-id})))) blocks)]
(d/transact! conn tx-data)
(outliner-file/sync-to-file {:db/id to-id})
(rename-update-refs! from-page
(util/get-page-original-name from-page)
(util/get-page-original-name to-page))
(rename-update-namespace! from-page
(util/get-page-original-name from-page)
(util/get-page-original-name to-page)))
(delete! from-page-name nil)
(route-handler/redirect! {:to :page
:push false
:path-params {:name to-page-name}})))
;; FIXME:
(defn db-based-rename!
([old-name new-name]
(db-based-rename! old-name new-name true))
([old-name new-name redirect?]
(let [old-name (string/trim old-name)
new-name (string/trim new-name)
old-page-name (util/page-name-sanity-lc old-name)
page-e (db/entity [:block/name old-page-name])
new-page-name (util/page-name-sanity-lc new-name)
name-changed? (not= old-name new-name)]
(if (and old-name
new-name
(not (string/blank? new-name))
name-changed?)
(if (and (not= old-page-name new-page-name)
(db/entity [:block/name new-page-name]))
(when (string/blank? new-name)
(notification/show! "Merging pages is not supported yet." :info))
(create! new-page-name
{:rename? true
:uuid (:block/uuid page-e)
:redirect? redirect?
:create-first-block? false}))
(when (string/blank? new-name)
(notification/show! "Please use a valid name, empty name is not allowed!" :error)))
(ui-handler/re-render-root!))))
(defn file-based-rename!
"Accepts unsanitized page names"
([old-name new-name] (file-based-rename! old-name new-name true))
([old-name new-name redirect?]
(let [repo (state/get-current-repo)
old-name (string/trim old-name)
new-name (string/trim new-name)
old-page-name (util/page-name-sanity-lc old-name)
new-page-name (util/page-name-sanity-lc new-name)
name-changed? (not= old-name new-name)]
(if (and old-name
new-name
(not (string/blank? new-name))
name-changed?)
(do
(cond
(= old-page-name new-page-name)
(rename-page-aux old-name new-name redirect?)
(db/pull [:block/name new-page-name])
(merge-pages! old-page-name new-page-name)
:else
(rename-namespace-pages! repo old-name new-name))
(rename-nested-pages old-name new-name))
(when (string/blank? new-name)
(notification/show! "Please use a valid name, empty name is not allowed!" :error)))
(ui-handler/re-render-root!))))
(defn rename!
([old-name new-name] (rename! old-name new-name true))
([old-name new-name redirect?]
(let [f (if (config/db-based-graph? (state/get-current-repo))
db-based-rename!
file-based-rename!)]
(f old-name new-name redirect?))))
(defn- split-col-by-element
[col element]
(let [col (vec col)
idx (.indexOf col element)]
[(subvec col 0 (inc idx))
(subvec col (inc idx))]))
(defn reorder-favorites!
[{:keys [to up?]}]
(let [favorites (:favorites (state/get-config))
from (get @state/state :favorites/dragging)]
(when (and from to (not= from to))
(let [[prev next] (split-col-by-element favorites to)
[prev next] (mapv #(remove (fn [e] (= from e)) %) [prev next])
favorites (->>
(if up?
(concat (drop-last prev) [from (last prev)] next)
(concat prev [from] next))
(remove nil?)
distinct
vec)]
(config-handler/set-config! :favorites favorites)))))
(defn has-more-journals?
[]
(let [current-length (:journals-length @state/state)]
(< current-length (db/get-journals-length))))
(defn load-more-journals!
[]
(when (has-more-journals?)
(state/set-journals-length! (+ (:journals-length @state/state) 7))))
(defn update-public-attribute!
[page-name value]
(page-property/add-property! page-name :public value))
(defn get-page-ref-text
[page]
(let [edit-block-file-path (model/get-block-file-path (state/get-edit-block))
page-name (string/lower-case page)]
(if (and edit-block-file-path
(state/org-mode-file-link? (state/get-current-repo)))
(if-let [ref-file-path (:file/path (db/get-page-file page-name))]
(util/format "[[file:%s][%s]]"
(util/get-relative-path edit-block-file-path ref-file-path)
page)
(let [journal? (date/valid-journal-title? page)
ref-file-path (str
(if (or (util/electron?) (mobile-util/native-platform?))
(-> (config/get-repo-dir (state/get-current-repo))
js/decodeURI
(string/replace #"/+$" "")
(str "/"))
"")
(get-directory journal?)
"/"
(get-file-name journal? page)
".org")]
(create! page {:redirect? false})
(util/format "[[file:%s][%s]]"
(util/get-relative-path edit-block-file-path ref-file-path)
page)))
(page-ref/->page-ref page))))
(defn init-commands!
[]
(commands/init-commands! get-page-ref-text))
(def rebuild-slash-commands-list!
(debounce init-commands! 1500))
(defn template-exists?
[title]
(when title
(let [templates (keys (db/get-all-templates))]
(when (seq templates)
(let [templates (map string/lower-case templates)]
(contains? (set templates) (string/lower-case title)))))))
(defn ls-dir-files!
([ok-handler] (ls-dir-files! ok-handler nil))
([ok-handler opts]
(web-nfs/ls-dir-files-with-handler!
(fn [e]
(init-commands!)
(when ok-handler
(ok-handler e)))
opts)))
(defn get-all-pages
[repo]
(->> (db/get-all-pages repo)
(remove (fn [p]
(let [name (:block/name p)]
(or (util/uuid-string? name)
(gp-config/draw? name)
(db/built-in-pages-names (string/upper-case name))))))
(common-handler/fix-pages-timestamps)))
(defn get-filters
[page-name]
(let [properties (db/get-page-properties page-name)
properties-str (get properties :filters "{}")]
(try (reader/read-string properties-str)
(catch :default e
(log/error :syntax/filters e)))))
(defn save-filter!
[page-name filter-state]
(page-property/add-property! page-name :filters filter-state))
;; Editor
(defn page-not-exists-handler
[input id q current-pos]
(state/clear-editor-action!)
(if (state/org-mode-file-link? (state/get-current-repo))
(let [page-ref-text (get-page-ref-text q)
value (gobj/get input "value")
old-page-ref (page-ref/->page-ref q)
new-value (string/replace value
old-page-ref
page-ref-text)]
(state/set-edit-content! id new-value)
(let [new-pos (+ current-pos
(- (count page-ref-text)
(count old-page-ref))
2)]
(cursor/move-cursor-to input new-pos)))
(let [current-selected (util/get-selected-text)]
(cursor/move-cursor-forward input (+ 2 (count current-selected))))))
(defn on-chosen-handler
[input id _q pos format]
(let [current-pos (cursor/pos input)
edit-content (state/sub :editor/content :path-in-sub-atom id)
action (state/get-editor-action)
hashtag? (= action :page-search-hashtag)
q (or
(editor-handler/get-selected-text)
(when hashtag?
(gp-util/safe-subs edit-content pos current-pos))
(when (> (count edit-content) current-pos)
(gp-util/safe-subs edit-content pos current-pos)))]
(if hashtag?
(fn [chosen _click?]
(state/clear-editor-action!)
(let [wrapped? (= page-ref/left-brackets (gp-util/safe-subs edit-content (- pos 2) pos))
chosen (if (and (util/safe-re-find #"\s+" chosen) (not wrapped?))
(page-ref/->page-ref chosen)
chosen)
q (if (editor-handler/get-selected-text) "" q)
last-pattern (if wrapped?
q
(if (= \# (first q))
(subs q 1)
q))
last-pattern (str "#" (when wrapped? page-ref/left-brackets) last-pattern)]
(editor-handler/insert-command! id
(str "#" (when wrapped? page-ref/left-brackets) chosen)
format
{:last-pattern last-pattern
:end-pattern (when wrapped? page-ref/right-brackets)
:command :page-ref})))
(fn [chosen _click?]
(state/clear-editor-action!)
(let [page-ref-text (get-page-ref-text chosen)]
(editor-handler/insert-command! id
page-ref-text
format
{:last-pattern (str page-ref/left-brackets (if (editor-handler/get-selected-text) "" q))
:end-pattern page-ref/right-brackets
:postfix-fn (fn [s] (util/replace-first page-ref/right-brackets s ""))
:command :page-ref}))))))
(defn create-today-journal!
[]
(when-let [repo (state/get-current-repo)]
(when (and (state/enable-journals? repo)
(not (:graph/loading? @state/state))
(not (state/loading-files? repo))
(not (state/whiteboard-route?)))
(state/set-today! (date/today))
(when (or (config/db-based-graph? repo)
(config/local-file-based-graph? repo)
(and (= "local" repo) (not (mobile-util/native-platform?))))
(let [title (date/today)
today-page (util/page-name-sanity-lc title)
format (state/get-preferred-format repo)
template (state/get-default-journal-template)
create-f (fn []
(create! title {:redirect? false
:split-namespace? false
:create-first-block? (not template)
:journal? true})
(state/pub-event! [:journal/insert-template today-page])
(ui-handler/re-render-root!)
(plugin-handler/hook-plugin-app :today-journal-created {:title today-page}))]
(when (db/page-empty? repo today-page)
(if (config/db-based-graph? repo)
(create-f)
(p/let [file-name (date/journal-title->default title)
file-rpath (str (config/get-journals-directory) "/" file-name "."
(config/get-file-extension format))
repo-dir (config/get-repo-dir repo)
file-exists? (fs/file-exists? repo-dir file-rpath)
file-content (when file-exists?
(fs/read-file repo-dir file-rpath))]
(when (or (not file-exists?)
(and file-exists? (string/blank? file-content)))
(create-f))))))))))
(defn open-today-in-sidebar
[]
(when-let [page (db/entity [:block/name (util/page-name-sanity-lc (date/today))])]
(state/sidebar-add-block!
(state/get-current-repo)
(:db/id page)
:page)))
(defn open-file-in-default-app []
(if-let [file-rpath (and (util/electron?) (page-util/get-page-file-rpath))]
(let [repo-dir (config/get-repo-dir (state/get-current-repo))
file-fpath (path/path-join repo-dir file-rpath)]
(js/window.apis.openPath file-fpath))
(notification/show! "No file found" :warning)))
(defn copy-current-file
"FIXME: clarify usage, copy file or copy file path"
[]
(if-let [file-rpath (and (util/electron?) (page-util/get-page-file-rpath))]
(let [repo-dir (config/get-repo-dir (state/get-current-repo))
file-fpath (path/path-join repo-dir file-rpath)]
(util/copy-to-clipboard! file-fpath))
(notification/show! "No file found" :warning)))
(defn open-file-in-directory []
(if-let [file-rpath (and (util/electron?) (page-util/get-page-file-rpath))]
(let [repo-dir (config/get-repo-dir (state/get-current-repo))
file-fpath (path/path-join repo-dir file-rpath)]
(js/window.apis.showItemInFolder file-fpath))
(notification/show! "No file found" :warning)))
(defn copy-page-url
([] (copy-page-url (page-util/get-current-page-name)))
([page-name]
(if page-name
(util/copy-to-clipboard!
(url-util/get-logseq-graph-page-url nil (state/get-current-repo) page-name))
(notification/show! "No page found to copy" :warning))))