| 1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939 |
- (ns frontend.handler.editor
- (:require [frontend.state :as state]
- [frontend.handler.common :as common-handler]
- [frontend.handler.route :as route-handler]
- [frontend.handler.git :as git-handler]
- [frontend.handler.ui :as ui-handler]
- [frontend.handler.repo :as repo-handler]
- [frontend.handler.notification :as notification]
- [frontend.handler.draw :as draw]
- [frontend.handler.expand :as expand]
- [frontend.format :as format]
- [frontend.format.block :as block]
- [frontend.image :as image]
- [cljs-time.core :as t]
- [cljs-time.coerce :as tc]
- [frontend.db :as db]
- [goog.object :as gobj]
- [goog.dom :as gdom]
- [goog.dom.classes :as gdom-classes]
- [clojure.string :as string]
- [frontend.util :as util :refer-macros [profile]]
- [frontend.config :as config]
- [dommy.core :as dom]
- [frontend.utf8 :as utf8]
- [frontend.fs :as fs]
- [promesa.core :as p]
- [dommy.core :as d]
- [frontend.diff :as diff]
- [frontend.search :as search]
- [frontend.handler.image :as image-handler]
- [frontend.commands :as commands
- :refer [*show-commands
- *matched-commands
- *slash-caret-pos
- *angle-bracket-caret-pos
- *matched-block-commands
- *show-block-commands]]
- [frontend.extensions.html-parser :as html-parser]
- [medley.core :as medley]
- [frontend.text :as text]
- [frontend.date :as date]
- [frontend.handler.repeated :as repeated]
- [clojure.core.async :as async]))
- ;; FIXME: should support multiple images concurrently uploading
- (defonce *image-uploading? (atom false))
- (defonce *image-uploading-process (atom 0))
- (defonce *selected-text (atom nil))
- (defn modified-time-tx
- [page file]
- (let [modified-at (tc/to-long (t/now))]
- [[:db/add (:db/id page) :page/last-modified-at modified-at]
- [:db/add (:db/id file) :file/last-modified-at modified-at]]))
- (defn- get-selection-and-format
- []
- (when-let [block (state/get-edit-block)]
- (when-let [id (:block/uuid block)]
- (when-let [edit-id (state/get-edit-input-id)]
- (when-let [input (gdom/getElement edit-id)]
- {:selection-start (gobj/get input "selectionStart")
- :selection-end (gobj/get input "selectionEnd")
- :format (:block/format block)
- :value (gobj/get input "value")
- :block block
- :edit-id edit-id
- :input input})))))
- (defn- format-text!
- [pattern-fn]
- (when-let [m (get-selection-and-format)]
- (let [{:keys [selection-start selection-end format value block edit-id input]} m
- empty-selection? (= selection-start selection-end)
- pattern (pattern-fn format)
- new-value (str
- (subs value 0 selection-start)
- pattern
- (subs value selection-start selection-end)
- pattern
- (subs value selection-end))]
- (state/set-edit-content! edit-id new-value)
- (when empty-selection?
- (util/cursor-move-back input (count pattern))))))
- (defn bold-format! []
- (format-text! config/get-bold))
- (defn italics-format! []
- (format-text! config/get-italic))
- (defn highlight-format! []
- (format-text! config/get-highlight))
- (defn html-link-format! []
- (when-let [m (get-selection-and-format)]
- (let [{:keys [selection-start selection-end format value block edit-id input]} m
- cur-pos (:pos (util/get-caret-pos input))
- empty-selection? (= selection-start selection-end)
- selection (subs value selection-start selection-end)
- selection-link? (and selection (or (util/starts-with? selection "http://")
- (util/starts-with? selection "https://")))
- [content forward-pos] (cond
- empty-selection?
- (config/get-empty-link-and-forward-pos format)
- selection-link?
- (config/with-default-link format selection)
- :else
- (config/with-default-label format selection))
- new-value (str
- (subs value 0 selection-start)
- content
- (subs value selection-end))
- cur-pos (or selection-start cur-pos)]
- (state/set-edit-content! edit-id new-value)
- (util/move-cursor-to input (+ cur-pos forward-pos)))))
- (defn focus-on-block!
- [block-id]
- (when block-id
- (route-handler/redirect! {:to :page
- :path-params {:name (str block-id)}})))
- (defn open-block-in-sidebar!
- [block-id]
- (when block-id
- (when-let [block (db/pull [:block/uuid block-id])]
- (state/sidebar-add-block!
- (state/get-current-repo)
- (:db/id block)
- :block
- block))))
- (defn reset-cursor-range!
- [node]
- (when node
- (state/set-cursor-range! (util/caret-range node))))
- (defn restore-cursor-pos!
- ([id markup]
- (restore-cursor-pos! id markup false))
- ([id markup dummy?]
- (when-let [node (gdom/getElement (str id))]
- (when-let [cursor-range (state/get-cursor-range)]
- (when-let [range (string/trim cursor-range)]
- (let [pos (inc (diff/find-position markup range))]
- (util/set-caret-pos! node pos)))))))
- (defn block-content-join-newlines
- [prefix value postfix]
- (str
- (if (or (= "" prefix)
- (= "\n" (last prefix)))
- ""
- "\n")
- (string/trim value)
- (if (= "\n" (first postfix))
- ""
- "\n")))
- (defn new-file-content
- [{:block/keys [content meta dummy?] :as block} file-content value]
- (let [utf8-content (utf8/encode file-content)
- prefix (utf8/substring utf8-content 0 (:start-pos meta))
- postfix (let [end-pos (if dummy?
- (:start-pos meta)
- (:end-pos meta))]
- (utf8/substring utf8-content end-pos))
- value (block-content-join-newlines prefix value postfix)]
- [(str prefix value postfix)
- value]))
- (defn get-block-new-value
- [{:block/keys [content meta dummy?] :as block} file-content value]
- (let [utf8-content (utf8/encode file-content)
- prefix (utf8/substring utf8-content 0 (:start-pos meta))
- postfix (let [end-pos (if dummy?
- (:start-pos meta)
- (:end-pos meta))]
- (utf8/substring utf8-content end-pos))]
- (block-content-join-newlines prefix value postfix)))
- (defn new-file-content-indent-outdent
- [{:block/keys [content meta dummy?] :as block} file-content value block-with-children-content last-child-end-pos indent-left?]
- (let [utf8-content (utf8/encode file-content)
- prefix (utf8/substring utf8-content 0 (:start-pos meta))
- last-child-end-pos (if (some? indent-left?) last-child-end-pos nil)
- end-pos (or
- last-child-end-pos
- (if dummy?
- (:start-pos meta)
- (:end-pos meta)))
- postfix (utf8/substring utf8-content end-pos)
- block-children-value (block-content-join-newlines prefix block-with-children-content postfix)]
- (str prefix block-children-value postfix)))
- (defn- with-block-meta
- [repo block]
- (if (:block/dummy? block)
- (if-let [page-id (:db/id (:block/page block))]
- (let [page-name (:page/name (db/entity repo page-id))
- end-pos (db/get-block-page-end-pos repo page-name)]
- (assoc block :block/meta {:start-pos end-pos
- :end-pos end-pos}))
- block)
- (if-let [meta (:block/meta (db/entity repo [:block/uuid (:block/uuid block)]))]
- (assoc block :block/meta meta)
- block)))
- (defn highlight-block!
- [block-uuid]
- (let [blocks (array-seq (js/document.getElementsByClassName (str block-uuid)))]
- (doseq [block blocks]
- (dom/add-class! block "block-highlight"))))
- (defn unhighlight-block!
- []
- (let [blocks (some->> (array-seq (js/document.getElementsByClassName "block-highlight"))
- (repeat 2)
- (apply concat))]
- (doseq [block blocks]
- (gdom-classes/remove block "block-highlight"))))
- (defn rebuild-blocks-meta
- [start-pos blocks]
- (let [last-start-pos (atom start-pos)]
- (mapv
- (fn [{:block/keys [uuid meta] :as block}]
- (let [old-start-pos (:start-pos meta)
- old-end-pos (:end-pos meta)
- new-end-pos (if old-end-pos
- (+ @last-start-pos (- old-end-pos old-start-pos)))
- new-meta {:start-pos @last-start-pos
- :end-pos new-end-pos}]
- (reset! last-start-pos new-end-pos)
- {:block/uuid uuid
- :block/meta new-meta}))
- blocks)))
- (defn rebuild-after-blocks
- [repo file before-end-pos new-end-pos]
- (let [file-id (:db/id file)
- after-blocks (db/get-file-after-blocks-meta repo file-id before-end-pos)]
- (rebuild-blocks-meta new-end-pos after-blocks)))
- (defn rebuild-after-blocks-indent-outdent
- [repo file block before-end-pos new-end-pos indent-left?]
- (let [file-id (:db/id file)
- after-blocks (db/get-file-after-blocks-meta repo file-id before-end-pos true)
- last-start-pos (atom new-end-pos)
- block-level (:block/level block)
- next-leq-level? (atom false)
- format (:block/format block)
- block-and-children-content (atom (:block/content block))
- last-child-end-pos (atom before-end-pos)
- after-blocks (mapv
- (fn [{:block/keys [uuid meta level content] :as block}]
- (let [old-start-pos (:start-pos meta)
- old-end-pos (:end-pos meta)]
- (when (<= level block-level)
- (reset! next-leq-level? true))
- (let [[new-content offset] (cond
- (and (not @next-leq-level?) (true? indent-left?))
- [(subs content 1) -1]
- (and (not @next-leq-level?) (false? indent-left?))
- [(str (config/get-block-pattern format) content) 1]
- :else
- [nil 0])
- new-end-pos (if old-end-pos
- (+ @last-start-pos
- (- old-end-pos old-start-pos)
- offset))
- new-meta {:start-pos @last-start-pos
- :end-pos new-end-pos}]
- (reset! last-start-pos new-end-pos)
- (when-not @next-leq-level?
- (do
- (reset! block-and-children-content (str @block-and-children-content new-content))
- (reset! last-child-end-pos old-end-pos)))
- (cond->
- {:block/uuid uuid
- :block/meta new-meta}
- (and (some? indent-left?) (not @next-leq-level?))
- (assoc :block/level (if indent-left? (dec level) (inc level)))
- (and new-content (not @next-leq-level?))
- (assoc :block/content new-content)))))
- after-blocks)]
- [after-blocks @block-and-children-content @last-child-end-pos]))
- (defn compute-retract-refs
- "Computes old references to be retracted."
- [eid {:block/keys [ref-pages ref-blocks]} old-ref-pages old-ref-blocks]
- (let [ref-pages-id (map #(:db/id (db/get-page (:page/name %))) ref-pages)
- retracted-pages (reduce (fn [done current]
- (if (some #(= (:db/id current) %) ref-pages-id)
- done
- (conj done (:db/id current))))
- [] old-ref-pages)
- ref-blocks-id (map #(:db/id (db/get-page (str (last %)))) ref-blocks)
- retracted-blocks (reduce (fn [done current]
- (if (some #(= (:db/id current) %) ref-blocks-id)
- done
- (conj done (:db/id current))))
- [] old-ref-blocks)]
- ;; removes retracted pages and blocks
- (into
- (mapv (fn [ref] [:db/retract eid :block/ref-pages ref]) retracted-pages)
- (mapv (fn [ref] [:db/retract eid :block/ref-blocks ref]) retracted-blocks))))
- (defn- rebuild-block-content
- "We'll create an empty heading if the first parsed ast element is not a paragraph, definition list or some hiccup."
- [content format]
- (let [content-without-level-spaces (text/remove-level-spaces content format)
- first-block (-> content-without-level-spaces
- (format/to-edn format)
- ffirst)]
- (if (or (block/heading-block? first-block)
- (block/paragraph-block? first-block)
- (block/hiccup-block? first-block)
- (block/definition-list-block? first-block))
- content
- (text/append-newline-after-level-spaces content format))))
- (defn- get-edit-input-id-with-block-id
- [block-id]
- (when-let [first-block (util/get-first-block-by-id block-id)]
- (string/replace (gobj/get first-block "id")
- "ls-block"
- "edit-block")))
- ;; id: block dom id, "ls-block-counter-uuid"
- (defn edit-block!
- ([block pos format id]
- (edit-block! block pos format id nil))
- ([block pos format id {:keys [custom-content custom-properties tail-len]
- :or {tail-len 0}}]
- (when-not config/publishing?
- (when-let [block-id (:block/uuid block)]
- (let [edit-input-id (if (uuid? id)
- (get-edit-input-id-with-block-id id)
- (str (subs id 0 (- (count id) 36)) block-id))
- block (or
- block
- (db/pull [:block/uuid block-id])
- ;; dummy?
- {:block/uuid block-id
- :block/content ""})
- {:block/keys [content properties]} block
- content (or custom-content content)
- content (string/trim (text/remove-level-spaces content format))
- properties (or custom-properties properties)
- content (if (and (seq properties) (text/properties-hidden? properties))
- (text/remove-properties! content)
- content)
- content-length (count content)
- text-range (cond
- (and (> tail-len 0) (>= (count content) tail-len))
- (subs content 0 (- (count content) tail-len))
- (or (= :max pos) (<= content-length pos))
- content
- :else
- (subs content 0 pos))]
- (state/set-editing! edit-input-id content block text-range))))))
- (defn edit-last-block-for-new-page!
- [last-block pos]
- (when-let [first-block (util/get-first-block-by-id (:block/uuid last-block))]
- (edit-block!
- last-block
- pos
- (:block/format last-block)
- (string/replace (gobj/get first-block "id")
- "ls-block"
- "edit-block"))))
- (defn save-block-if-changed!
- ([block value]
- (save-block-if-changed! block value nil))
- ([{:block/keys [uuid content meta file page dummy? format repo pre-block? content ref-pages ref-blocks] :as block}
- value
- {:keys [indent-left? custom-properties rebuild-content?]
- :or {rebuild-content? true
- custom-properties nil}}]
- (let [value value
- repo (or repo (state/get-current-repo))
- e (db/entity repo [:block/uuid uuid])
- block (assoc (with-block-meta repo block)
- :block/properties (:block/properties e))
- format (or format (state/get-preferred-format))
- page (db/entity repo (:db/id page))
- [old-properties new-properties] (when pre-block?
- [(:page/properties (db/entity (:db/id page)))
- (db/parse-properties value format)])
- page-tags (when-let [tags (:tags new-properties)]
- (util/->tags tags))
- page-alias (when-let [alias (:alias new-properties)]
- (map
- (fn [alias]
- {:page/name (string/lower-case alias)})
- (remove #{(:page/name page)} alias)))
- permalink-changed? (when (and pre-block? (:permalink old-properties))
- (not= (:permalink old-properties)
- (:permalink new-properties)))
- value (if permalink-changed?
- (db/add-properties! format value {:old_permalink (:permalink old-properties)})
- value)
- new-properties (if permalink-changed?
- (assoc new-properties :old_permalink (:permalink old-properties))
- new-properties)
- value (cond
- (some? custom-properties)
- (text/re-construct-block-properties block value custom-properties)
- (and (seq (:block/properties block))
- (text/properties-hidden? (:block/properties block)))
- (text/re-construct-block-properties block value (:block/properties block))
- :else
- value)]
- (cond
- (not= (string/trim content) (string/trim value)) ; block content changed
- (let [file (db/entity repo (:db/id file))]
- (cond
- ;; Page was referenced but no related file
- ;; TODO: replace with handler.page/create!
- (and page (not file))
- (let [format (name format)
- title (string/capitalize (:page/name page))
- journal-page? (date/valid-journal-title? title)
- path (str
- (if journal-page?
- config/default-journals-directory
- (config/get-pages-directory))
- "/"
- (if journal-page?
- (date/journal-title->default title)
- (-> (:page/name page)
- (util/page-name-sanity))) "."
- (if (= format "markdown") "md" format))
- file-path (str "/" path)
- dir (util/get-repo-dir repo)]
- (p/let [exists? (fs/file-exists? dir file-path)]
- (if exists?
- (notification/show!
- [:p.content
- (util/format "File %s already exists!" file-path)]
- :error)
- ;; create the file
- (let [content (str (util/default-content-with-title format
- (or (:page/original-name page)
- (:page/name page)))
- (text/remove-level-spaces value (keyword format)))]
- (p/let [_ (fs/create-if-not-exists dir file-path content)]
- (db/reset-file! repo path content)
- (git-handler/git-add repo path)
- (ui-handler/re-render-root!)
- ;; Continue to edit the last block
- (let [blocks (db/get-page-blocks repo (:page/name page))
- last-block (last blocks)]
- (edit-last-block-for-new-page! last-block :max)))))))
- (and file page)
- (let [file (db/entity repo (:db/id file))
- file-path (:file/path file)
- format (format/get-format file-path)
- file-content (db/get-file repo file-path)
- value (get-block-new-value block file-content value)
- value (if rebuild-content?
- (rebuild-block-content value format)
- value)
- block (assoc block :block/content value)
- {:keys [blocks pages start-pos end-pos]} (if pre-block?
- (let [new-end-pos (utf8/length (utf8/encode value))]
- {:blocks [(assoc-in block [:block/meta :end-pos] new-end-pos)]
- :pages []
- :start-pos 0
- :end-pos new-end-pos})
- (block/parse-block block format))
- block-retracted-attrs (when-not pre-block?
- (when-let [id (:db/id block)]
- [[:db/retract id :block/priority]
- [:db/retract id :block/deadline]
- [:db/retract id :block/deadline-ast]
- [:db/retract id :block/scheduled]
- [:db/retract id :block/scheduled-ast]
- [:db/retract id :block/marker]
- [:db/retract id :block/tags]
- [:db/retract id :block/repeated?]]))
- [after-blocks block-children-content new-end-pos] (rebuild-after-blocks-indent-outdent repo file block (:end-pos (:block/meta block)) end-pos indent-left?)
- retract-refs (compute-retract-refs (:db/id e) (first blocks) ref-pages ref-blocks)
- page-id (:db/id page)
- modified-time (let [modified-at (tc/to-long (t/now))]
- [[:db/add page-id :page/last-modified-at modified-at]
- [:db/add (:db/id file) :file/last-modified-at modified-at]])
- page-properties (when pre-block?
- (if (seq new-properties)
- [[:db/retract page-id :page/properties]
- {:db/id page-id
- :page/properties new-properties}]
- [[:db/retract page-id :page/properties]]))
- pages (if (seq page-tags)
- (let [tag-pages (map
- (fn [page]
- {:page/original-name page
- :page/name page})
- (map :tag/name page-tags))]
- (concat pages tag-pages))
- pages)
- page-tags (when (and pre-block? (seq page-tags))
- (if (seq page-tags)
- [[:db/retract page-id :page/tags]
- {:db/id page-id
- :page/tags page-tags}]
- [[:db/retract page-id :page/tags]]))
- page-alias (when (and pre-block? (seq page-alias))
- (if (seq page-alias)
- [[:db/retract page-id :page/alias]
- {:db/id page-id
- :page/alias page-alias}]
- [[:db/retract page-id :page/alias]]))]
- (profile
- "Save block: "
- (repo-handler/transact-react-and-alter-file!
- repo
- (concat
- pages
- block-retracted-attrs
- blocks
- retract-refs
- page-properties
- page-tags
- page-alias
- after-blocks
- modified-time)
- {:key :block/change
- :data (map (fn [block] (assoc block :block/page page)) blocks)}
- (let [new-content (new-file-content-indent-outdent block file-content value block-children-content new-end-pos indent-left?)]
- [[file-path new-content]])))
- (when (or (seq retract-refs) pre-block?)
- (ui-handler/re-render-root!))
- (repo-handler/push-if-auto-enabled! repo))
- :else
- nil))
- (seq (state/get-changed-files))
- (repo-handler/push-if-auto-enabled! repo)
- :else
- nil))))
- (defn insert-new-block-aux!
- [{:block/keys [uuid content meta file dummy? level repo page format properties collapsed?] :as block}
- value
- {:keys [create-new-block? ok-handler with-level? new-level current-page blocks-container-id]}]
- (let [value (or value "")
- block-page? (and current-page (util/uuid-string? current-page))
- block-self? (= uuid (and block-page? (medley/uuid current-page)))
- input (gdom/getElement (state/get-edit-input-id))
- pos (if new-level
- (dec (count value))
- (util/get-input-pos input))
- repo (or repo (state/get-current-repo))
- block-has-children? (seq (:block/children block))
- fst-block-text (subs value 0 pos)
- snd-block-text (string/triml (subs value pos))
- fst-block-text (string/trim (if with-level? fst-block-text (block/with-levels fst-block-text format block)))
- snd-block-text-level (cond
- new-level
- new-level
- (or block-self? block-has-children?)
- (inc level)
- :else
- level)
- snd-block-text (if (and snd-block-text
- (re-find (re-pattern (util/format "^[%s]+\\s+" (config/get-block-pattern format))) snd-block-text))
- snd-block-text
- (rebuild-block-content
- (str (config/default-empty-block format snd-block-text-level) " " snd-block-text)
- format))
- block (with-block-meta repo block)
- original-id (:block/uuid block)
- format (:block/format block)
- page (db/entity repo (:db/id page))
- file (db/entity repo (:db/id file))
- insert-block (fn [block file-path file-content]
- (let [value (if create-new-block?
- (str fst-block-text "\n" snd-block-text)
- value)
- value (text/re-construct-block-properties block value properties)
- value (rebuild-block-content value format)
- [new-content value] (new-file-content block file-content value)
- parse-result (block/parse-block (assoc block :block/content value) format)
- id-conflict? (some #(= original-id (:block/uuid %)) (next (:blocks parse-result)))
- {:keys [blocks pages start-pos end-pos]}
- (if id-conflict?
- (let [new-value (string/replace
- value
- (re-pattern (str "(?i):custom_id: " original-id))
- "")]
- (block/parse-block (assoc block :block/content new-value) format))
- parse-result)
- after-blocks (rebuild-after-blocks repo file (:end-pos meta) end-pos)
- transact-fn (fn []
- (repo-handler/transact-react-and-alter-file!
- repo
- (concat
- pages
- blocks
- after-blocks)
- {:key :block/change
- :data (map (fn [block] (assoc block :block/page page)) blocks)}
- [[file-path new-content]])
- (state/set-editor-op! nil))]
- ;; Replace with batch transactions
- (state/add-tx! transact-fn)
- (let [blocks (remove (fn [block]
- (nil? (:block/content block))) blocks)
- page-blocks-atom (db/get-page-blocks-cache-atom repo (:db/id page))
- first-block-id (:block/uuid (first blocks))
- [before-part after-part] (and page-blocks-atom
- (split-with
- #(not= first-block-id (:block/uuid %))
- @page-blocks-atom))
- after-part (rest after-part)
- blocks-container-id (and blocks-container-id
- (util/uuid-string? blocks-container-id)
- (medley/uuid blocks-container-id))]
- ;; update page blocks cache if exists
- (when page-blocks-atom
- (reset! page-blocks-atom (->> (concat before-part blocks after-part)
- (remove nil?))))
- ;; update block children cache if exists
- (when blocks-container-id
- (let [blocks-atom (db/get-block-blocks-cache-atom repo blocks-container-id)
- [before-part after-part] (and blocks-atom
- (split-with
- #(not= first-block-id (:block/uuid %))
- @blocks-atom))
- after-part (rest after-part)]
- (and blocks-atom
- (reset! blocks-atom (->> (concat before-part blocks after-part)
- (remove nil?))))))
- (when ok-handler
- (let [first-block (first blocks)
- last-block (last blocks)]
- (ok-handler [first-block last-block snd-block-text]))))))]
- (cond
- (and (not file) page)
- ;; TODO: replace with handler.page/create!
- (let [format (name format)
- title (string/capitalize (:page/name page))
- journal-page? (date/valid-journal-title? title)
- path (str
- (if journal-page?
- config/default-journals-directory
- (config/get-pages-directory))
- "/"
- (if journal-page?
- (date/journal-title->default title)
- (-> (:page/name page)
- (util/page-name-sanity)))
- "."
- (if (= format "markdown") "md" format))
- file-path (str "/" path)
- dir (util/get-repo-dir repo)]
- (p/let [exists? (fs/file-exists? dir file-path)]
- (if exists?
- (notification/show!
- [:p.content
- (util/format "File %s already exists!"
- file-path)]
- :error)
- ;; create the file
- (let [content (util/default-content-with-title format (or
- (:page/original-name page)
- (:page/name page)))]
- (p/let [_ (fs/create-if-not-exists dir file-path content)]
- (db/reset-file! repo path
- (str content
- (text/remove-level-spaces value (keyword format))
- "\n"
- snd-block-text))
- (git-handler/git-add repo path)
- (ui-handler/re-render-root!)
- ;; Continue to edit the last block
- (let [blocks (db/get-page-blocks repo (:page/name page))
- last-block (last blocks)]
- (edit-last-block-for-new-page! last-block 0))))))
- (state/set-editor-op! nil))
- file
- (let [file-path (:file/path file)
- file-content (db/get-file repo file-path)]
- (insert-block block file-path file-content))
- :else
- nil)))
- (defn clear-when-saved!
- []
- (state/set-editor-show-input nil)
- (state/set-editor-show-date-picker false)
- (state/set-editor-show-page-search false)
- (state/set-editor-show-block-search false)
- (state/set-editor-show-template-search false)
- (commands/restore-state true))
- (defn get-state
- [state]
- (let [[{:keys [on-hide block block-id block-parent-id dummy? format sidebar?]} id config] (:rum/args state)
- node (gdom/getElement id)
- value (gobj/get node "value")
- pos (gobj/get node "selectionStart")]
- {:config config
- :on-hide on-hide
- :dummy? dummy?
- :sidebar? sidebar?
- :format format
- :id id
- :block block
- :block-id block-id
- :block-parent-id block-parent-id
- :node node
- :value value
- :pos pos}))
- (defn- with-timetracking-properties
- [block value]
- (let [new-marker (first (re-find format/bare-marker-pattern (or value "")))
- new-marker (if new-marker (string/lower-case (string/trim new-marker)))
- properties (into {} (:block/properties block))]
- (if (and
- new-marker
- (not= new-marker (string/lower-case (or (:block/marker block) "")))
- (state/enable-timetracking?))
- (assoc properties new-marker (util/time-ms))
- properties)))
- (defn insert-new-block!
- [state]
- (when (and (not config/publishing?)
- ;; skip this operation if it's inserting
- (not= :insert (state/get-editor-op)))
- (state/set-editor-op! :insert)
- (let [{:keys [block value format id config]} (get-state state)
- block-id (:block/uuid block)
- block (or (db/pull [:block/uuid block-id])
- block)
- collapsed? (:block/collapsed? block)
- repo (or (:block/repo block) (state/get-current-repo))
- last-child (and collapsed?
- (last (db/get-block-and-children-no-cache repo (:block/uuid block))))
- last-child (when (not= (:block/uuid last-child)
- (:block/uuid block))
- last-child)
- new-block (or last-child block)
- new-value (if last-child (:block/content last-child) value)
- properties (with-timetracking-properties new-block new-value)]
- ;; save the current block and insert a new block
- (insert-new-block-aux!
- (assoc new-block :block/properties properties)
- new-value
- {:create-new-block? true
- :ok-handler
- (fn [[_first-block last-block _new-block-content]]
- (let [last-id (:block/uuid last-block)]
- (edit-block! last-block 0 format id)
- (clear-when-saved!)))
- :with-level? (if last-child true false)
- :new-level (and last-child (:block/level block))
- :blocks-container-id (:id config)
- :current-page (state/get-current-page)}))))
- (defn insert-new-block-without-save-previous!
- [config last-block]
- (let [format (:block/format last-block)
- id (:id config)
- new-level (if (util/uuid-string? id)
- (inc (:block/level (db/entity [:block/uuid (medley/uuid id)])))
- 2)]
- (insert-new-block-aux!
- last-block
- (:block/content last-block)
- {:create-new-block? true
- :ok-handler
- (fn [[_first-block last-block _new-block-content]]
- (js/setTimeout #(edit-last-block-for-new-page! last-block :max) 50))
- :with-level? true
- :new-level new-level
- :blocks-container-id (:id config)
- :current-page (state/get-current-page)})))
- (defn update-timestamps-content!
- [{:block/keys [repeated? scheduled-ast deadline-ast marker]} content]
- (if repeated?
- (let [content (some->> (filter repeated/repeated? [scheduled-ast deadline-ast])
- (map (fn [ts]
- [(repeated/timestamp->text ts)
- (repeated/next-timestamp-text ts)]))
- (reduce (fn [content [old new]]
- (string/replace content old new))
- content))]
- (when content
- (str (string/trimr content)
- "\n"
- (util/format "- %s -> DONE [%s]"
- marker
- (date/get-local-date-time-string)))))
- content))
- (defn- with-marker-time
- [block marker]
- (let [properties (:block/properties block)
- properties (into {} properties)]
- (if (state/enable-timetracking?)
- (assoc properties
- (string/lower-case marker)
- (util/time-ms))
- properties)))
- (defn check
- [{:block/keys [uuid marker content meta file dummy? repeated?] :as block}]
- (let [new-content (string/replace-first content marker "DONE")
- new-content (if repeated?
- (update-timestamps-content! block content)
- new-content)]
- (save-block-if-changed! block new-content
- {:custom-properties (with-marker-time block "DONE")})))
- (defn uncheck
- [{:block/keys [uuid marker content meta file dummy?] :as block}]
- (let [marker (if (= :now (state/get-preferred-workflow))
- "LATER"
- "TODO")
- new-content (string/replace-first content "DONE" marker)]
- (save-block-if-changed! block new-content
- {:custom-properties (with-marker-time block marker)})))
- (defn cycle-todo!
- []
- (when-let [block (state/get-edit-block)]
- (let [edit-input-id (state/get-edit-input-id)
- current-input (gdom/getElement edit-input-id)
- content (state/get-edit-content)
- [new-content marker] (cond
- (util/starts-with? content "TODO")
- [(string/replace-first content "TODO" "DOING") "DOING"]
- (util/starts-with? content "DOING")
- [(string/replace-first content "DOING" "DONE") "DONE"]
- (util/starts-with? content "LATER")
- [(string/replace-first content "LATER" "NOW") "NOW"]
- (util/starts-with? content "NOW")
- [(string/replace-first content "NOW" "DONE") "DONE"]
- (util/starts-with? content "DONE")
- [(string/replace-first content "DONE" "") nil]
- :else
- (let [marker (if (= :now (state/get-preferred-workflow))
- "LATER"
- "TODO")]
- [(str marker " " (string/triml content)) marker]))
- new-content (string/triml new-content)]
- (let [new-pos (commands/compute-pos-delta-when-change-marker
- current-input content new-content marker (util/get-input-pos current-input))]
- (state/set-edit-content! edit-input-id new-content)
- (util/set-caret-pos! current-input new-pos)))))
- (defn set-marker
- [{:block/keys [uuid marker content meta file dummy? properties] :as block} new-marker]
- (let [new-content (string/replace-first content marker new-marker)]
- (save-block-if-changed! block new-content
- (with-marker-time block marker))))
- (defn set-priority
- [{:block/keys [uuid marker priority content meta file dummy?] :as block} new-priority]
- (let [new-content (string/replace-first content
- (util/format "[#%s]" priority)
- (util/format "[#%s]" new-priority))]
- (save-block-if-changed! block new-content)))
- (defn- get-prev-block-non-collapsed
- [block]
- (let [id (gobj/get block "id")
- prefix (re-find #"ls-block-[\d]+" id)]
- (when-let [blocks (d/by-class "ls-block")]
- (when-let [index (.indexOf blocks block)]
- (loop [idx (dec index)]
- (when (>= idx 0)
- (let [block (nth blocks idx)
- collapsed? (= "none" (d/style block "display"))
- prefix-match? (util/starts-with? (gobj/get block "id") prefix)]
- (if (or collapsed?
- ;; might be embed blocks
- (not prefix-match?))
- (recur (dec idx))
- block))))))))
- (defn- get-next-block-non-collapsed
- [block]
- (let [id (gobj/get block "id")
- prefix (re-find #"ls-block-[\d]+" id)]
- (when-let [blocks (d/by-class "ls-block")]
- (when-let [index (.indexOf blocks block)]
- (loop [idx (inc index)]
- (when (>= (count blocks) idx)
- (when-let [block (util/nth-safe blocks idx)]
- (let [collapsed? (= "none" (d/style block "display"))
- prefix-match? (util/starts-with? (gobj/get block "id") prefix)]
- (if (or collapsed?
- ;; might be embed blocks
- (not prefix-match?))
- (recur (inc idx))
- block)))))))))
- (defn delete-block-aux!
- [{:block/keys [uuid meta content file repo ref-pages ref-blocks] :as block} dummy?]
- (when-not dummy?
- (let [repo (or repo (state/get-current-repo))
- block (db/pull repo '[*] [:block/uuid uuid])]
- (when block
- (let [file-path (:file/path (db/entity repo (:db/id file)))
- file-content (db/get-file repo file-path)
- after-blocks (rebuild-after-blocks repo file (:end-pos meta) (:start-pos meta))
- new-content (utf8/delete! file-content (:start-pos meta) (:end-pos meta))]
- (repo-handler/transact-react-and-alter-file!
- repo
- (concat
- [[:db.fn/retractEntity [:block/uuid uuid]]]
- after-blocks)
- {:key :block/change
- :data [block]}
- [[file-path new-content]])
- (when (or (seq ref-pages) (seq ref-blocks))
- (ui-handler/re-render-root!)))))))
- (defn delete-block!
- [state repo e]
- (let [{:keys [id block-id block-parent-id dummy? value pos format]} (get-state state)]
- (when block-id
- (when-let [page-id (:db/id (:block/page (db/entity [:block/uuid block-id])))]
- (let [page-blocks-count (db/get-page-blocks-count repo page-id)
- page (db/entity page-id)]
- (when (> page-blocks-count 1)
- (util/stop e)
- ;; delete block, edit previous block
- (let [block (db/pull [:block/uuid block-id])
- block-parent (gdom/getElement block-parent-id)
- sibling-block (get-prev-block-non-collapsed block-parent)]
- (delete-block-aux! block dummy?)
- (when (and repo sibling-block)
- (when-let [sibling-block-id (d/attr sibling-block "blockid")]
- (when-let [block (db/pull repo '[*] [:block/uuid (uuid sibling-block-id)])]
- (let [original-content (util/trim-safe (:block/content block))
- new-value (str original-content " " (string/triml value))
- tail-len (count (string/triml value))
- pos (max
- (if original-content
- (utf8/length (utf8/encode (text/remove-level-spaces original-content format)))
- 0)
- 0)]
- (edit-block! block pos format id
- {:custom-content new-value
- :tail-len tail-len}))))))))))))
- (defn delete-blocks!
- [repo block-uuids]
- (when (seq block-uuids)
- (let [current-page (state/get-current-page)
- top-block-id (and current-page
- (util/uuid-string? current-page)
- (medley/uuid current-page))
- top-block? (and top-block-id
- (= top-block-id (first block-uuids)))]
- (let [blocks (db/pull-many repo '[*] (mapv (fn [id]
- [:block/uuid id])
- block-uuids))
- page (db/entity repo (:db/id (:block/page (first blocks))))
- first-block (first blocks)
- last-block (last blocks)
- file (db/entity repo (:db/id (:block/file first-block)))
- file-path (:file/path file)
- file-content (db/get-file repo file-path)
- start-pos (:start-pos (:block/meta first-block))
- end-pos (:end-pos (:block/meta last-block))
- after-blocks (rebuild-after-blocks repo file end-pos start-pos)
- new-content (utf8/delete! file-content start-pos end-pos)
- retract-blocks-tx (mapv
- (fn [uuid]
- [:db.fn/retractEntity [:block/uuid uuid]])
- block-uuids)
- tx-data (concat
- retract-blocks-tx
- after-blocks
- [{:file/path file-path}])]
- (repo-handler/transact-react-and-alter-file!
- repo
- tx-data
- {:key :block/change
- :data blocks}
- [[file-path new-content]])
- (when top-block?
- (route-handler/redirect! {:to :page
- :path-params {:name (:page/name page)}})
- (ui-handler/re-render-root!))
- (repo-handler/push-if-auto-enabled! repo)))))
- (defn remove-block-property!
- [block-id key]
- (let [block-id (if (string? block-id) (uuid block-id) block-id)
- key (string/lower-case (str key))]
- (when-let [block (db/pull [:block/uuid block-id])]
- (let [{:block/keys [content properties]} block]
- (when (get properties key)
- (save-block-if-changed! block content
- {:custom-properties (dissoc properties key)}))))))
- (defn set-block-property!
- [block-id key value]
- (let [block-id (if (string? block-id) (uuid block-id) block-id)
- key (string/lower-case (str key))
- value (str value)]
- (when-let [block (db/pull [:block/uuid block-id])]
- (when-not (:block/pre-block? block)
- (let [{:block/keys [content properties]} block]
- (cond
- (and (get properties key)
- (= (string/trim (get properties key)) value))
- nil
- :else
- (let [properties (:block/properties block)
- properties' (if (seq properties)
- (assoc properties key value)
- {key value})]
- (save-block-if-changed! block content
- {:custom-properties properties'
- :rebuild-content? false}))))))))
- (defn set-block-timestamp!
- [block-id key value]
- (let [key (string/lower-case key)
- scheduled? (= key "scheduled")
- deadline? (= key "deadline")
- block-id (if (string? block-id) (uuid block-id) block-id)
- key (string/lower-case (str key))
- value (str value)]
- (when-let [block (db/pull [:block/uuid block-id])]
- (let [{:block/keys [content scheduled deadline format]} block
- content (or (when-let [edit-content (state/get-edit-content)]
- (block/with-levels edit-content format block))
- content)
- new-line (str (string/upper-case key) ": " value)
- new-content (cond
- ;; update
- (or
- (and deadline deadline?)
- (and scheduled scheduled?))
- (let [lines (string/split-lines content)
- body (map (fn [line]
- (if (string/starts-with? (string/lower-case line) key)
- new-line
- line))
- (rest lines))]
- (->> (cons (first lines) body)
- (string/join "\n")))
- ;; insert
- (or deadline? scheduled?)
- (let [[title body] (if (string/includes? content "\n")
- (util/split-first "\n" content)
- [content ""])]
- (str title "\n"
- new-line
- "\n" (util/trim-only-newlines body)))
- :else
- content)]
- (when (not= content new-content)
- (if-let [input-id (state/get-edit-input-id)]
- (state/set-edit-content! input-id new-content)
- (save-block-if-changed! block new-content)))))))
- (defn copy-block-ref!
- [block-id]
- (let [block (db/entity [:block/uuid block-id])]
- (when-not (:block/pre-block? block)
- (set-block-property! block-id "custom_id" (str block-id))))
- (util/copy-to-clipboard! (str block-id)))
- (defn clear-selection!
- [_e]
- (when (state/in-selection-mode?)
- (doseq [block (state/get-selection-blocks)]
- (dom/remove-class! block "selected")
- (dom/remove-class! block "noselect"))
- (state/clear-selection!))
- ;; (when e
- ;; (when-not (util/input? (gobj/get e "target"))
- ;; (util/clear-selection!)))
- )
- (defn clear-selection-blocks!
- []
- (when (state/in-selection-mode?)
- (doseq [block (state/get-selection-blocks)]
- (dom/remove-class! block "selected")
- (dom/remove-class! block "noselect"))
- (state/clear-selection-blocks!)))
- (defn select-all-blocks!
- []
- (when-let [current-input-id (state/get-edit-input-id)]
- (let [input (gdom/getElement current-input-id)
- blocks-container (util/rec-get-blocks-container input)
- blocks (dom/by-class blocks-container "ls-block")]
- (doseq [block blocks]
- (dom/add-class! block "selected noselect"))
- (state/set-selection-blocks! blocks))))
- (defn- get-selected-blocks-with-children
- []
- (when-let [blocks (seq (get @state/state :selection/blocks))]
- (mapcat (fn [block]
- (cons block
- (array-seq (dom/by-class block "ls-block"))))
- blocks)))
- (defn copy-selection-blocks
- []
- (when-let [blocks (seq (get-selected-blocks-with-children))]
- (let [repo (dom/attr (first blocks) "repo")
- ids (->> (distinct (map #(when-let [id (dom/attr % "blockid")]
- (uuid id)) blocks))
- (remove nil?))
- up? (state/selection-up?)
- content (some->> (db/get-blocks-contents repo ids)
- (map :block/content))
- content (if (false? up?) (reverse content) content)
- content (string/join "" content)]
- (when-not (string/blank? content)
- (common-handler/copy-to-clipboard-without-id-property! content)))))
- (defn cut-selection-blocks
- []
- (copy-selection-blocks)
- (when-let [blocks (seq (get-selected-blocks-with-children))]
- (let [repo (dom/attr (first blocks) "repo")
- ids (distinct (map #(uuid (dom/attr % "blockid")) blocks))]
- (delete-blocks! repo ids))))
- (defn- get-nearest-page
- []
- (when-let [block (state/get-edit-block)]
- (when-let [id (:block/uuid block)]
- (when-let [edit-id (state/get-edit-input-id)]
- (when-let [input (gdom/getElement edit-id)]
- (when-let [pos (util/get-input-pos input)]
- (let [value (gobj/get input "value")
- page-pattern #"\[\[([^\]]+)]]"
- block-pattern #"\(\(([^\)]+)\)\)"
- page-matches (util/re-pos page-pattern value)
- block-matches (util/re-pos block-pattern value)
- matches (->> (concat page-matches block-matches)
- (remove nil?))
- [_ page] (first (sort-by
- (fn [[start-pos content]]
- (let [end-pos (+ start-pos (count content))]
- (cond
- (< pos start-pos)
- (- pos start-pos)
- (> pos end-pos)
- (- end-pos pos)
- :else
- 0)))
- >
- matches))]
- (when page
- (subs page 2 (- (count page) 2))))))))))
- (defn follow-link-under-cursor!
- []
- (when-let [page (get-nearest-page)]
- (let [page-name (string/lower-case page)]
- (state/clear-edit!)
- (route-handler/redirect! {:to :page
- :path-params {:name page-name}}))))
- (defn open-link-in-sidebar!
- []
- (when-let [page (get-nearest-page)]
- (let [page-name (string/lower-case page)
- block? (util/uuid-string? page-name)]
- (when-let [page (db/get-page page-name)]
- (if block?
- (state/sidebar-add-block!
- (state/get-current-repo)
- (:db/id page)
- :block
- page)
- (state/sidebar-add-block!
- (state/get-current-repo)
- (:db/id page)
- :page
- {:page page}))))))
- (defn zoom-in! []
- (if-let [block (state/get-edit-block)]
- (when-let [id (:block/uuid block)]
- (route-handler/redirect! {:to :page
- :path-params {:name (str id)}}))
- (js/window.history.forward)))
- (defn zoom-out! []
- (when-let [page (state/get-current-page)]
- (let [block-id (and
- (string? page)
- (util/uuid-string? page)
- (medley/uuid page))
- repo (state/get-current-repo)
- block-parent (db/get-block-parent repo block-id)]
- (if-let [id (:block/uuid block-parent)]
- (route-handler/redirect! {:to :page
- :path-params {:name (str id)}})
- (let [page-id (-> (db/entity [:block/uuid block-id])
- :block/page
- :db/id)]
- (when-let [page-name (:page/name (db/entity repo page-id))]
- (route-handler/redirect! {:to :page
- :path-params {:name page-name}})))))))
- (defn cut-block!
- [block-id]
- (when-let [block (db/pull [:block/uuid block-id])]
- (let [content (:block/content block)]
- (common-handler/copy-to-clipboard-without-id-property! content)
- (delete-block-aux! block false))))
- (defonce select-start-block-state (atom nil))
- (defn clear-last-selected-block!
- []
- (let [first-block (state/pop-selection-block!)]
- (dom/remove-class! first-block "selected")
- (dom/remove-class! first-block "noselect")))
- (defn input-start-or-end?
- ([input]
- (input-start-or-end? input nil))
- ([input up?]
- (let [value (gobj/get input "value")
- start (gobj/get input "selectionStart")
- end (gobj/get input "selectionEnd")]
- (if (nil? up?)
- (or (= start 0) (= end (count value)))
- (or (and (= start 0) up?)
- (and (= end (count value)) (not up?)))))))
- (defn highlight-selection-area!
- [end-block]
- (when-let [start-block (:selection/start-block @state/state)]
- (clear-selection-blocks!)
- (let [blocks (util/get-nodes-between-two-nodes start-block end-block "ls-block")]
- (doseq [block blocks]
- (dom/add-class! block "selected noselect"))
- (state/set-selection-blocks! blocks))))
- (defn on-select-block
- [state e up?]
- (when (and
- (gobj/get e "shiftKey")
- (not (gobj/get e "altKey"))
- (or (state/in-selection-mode?)
- (when-let [input-id (state/get-edit-input-id)]
- (when-let [input (gdom/getElement input-id)]
- (input-start-or-end? input up?)))))
- (state/clear-edit!)
- (let [{:keys [id block-id block block-parent-id dummy? value pos format] :as block-state} @select-start-block-state
- element (gdom/getElement block-parent-id)
- selected-blocks (state/get-selection-blocks)
- selected-blocks-count (count selected-blocks)
- first-block (first selected-blocks)
- selection-up? (state/selection-up?)]
- (when block-id
- (util/stop e)
- (when-let [element (if-not (state/in-selection-mode?)
- element
- (let [f (if up? util/get-prev-block util/get-next-block)]
- (f first-block)))]
- (if (and (not (nil? selection-up?)) (not= up? selection-up?))
- (cond
- (>= selected-blocks-count 2) ; back to the start block
- (do
- (when (= 2 selected-blocks-count) (state/set-selection-up? nil))
- (clear-last-selected-block!))
- :else
- nil)
- (state/conj-selection-block! element up?)))))))
- (defn save-block!
- [{:keys [format block id repo dummy?] :as state} value]
- (when (or (:db/id (db/entity repo [:block/uuid (:block/uuid block)]))
- dummy?)
- (let [value (text/remove-level-spaces value format true)
- new-value (block/with-levels value format block)
- properties (with-timetracking-properties block value)]
- ;; FIXME: somehow frontend.components.editor's will-unmount event will loop forever
- ;; maybe we shouldn't save the block/file in "will-unmount" event?
- (save-block-if-changed! block new-value
- {:custom-properties properties}))))
- (defn on-up-down
- [state e up?]
- (let [{:keys [id block-id block block-parent-id dummy? value pos format] :as block-state} (get-state state)]
- (if (gobj/get e "shiftKey")
- (reset! select-start-block-state block-state)
- (let [element (gdom/getElement id)
- line-height (util/get-textarea-line-height element)]
- (when (and block-id
- (or (and up? (util/textarea-cursor-first-row? element line-height))
- (and (not up?) (util/textarea-cursor-end-row? element line-height))))
- (util/stop e)
- (let [f (if up? get-prev-block-non-collapsed get-next-block-non-collapsed)
- sibling-block (f (gdom/getElement block-parent-id))]
- (when sibling-block
- (when-let [sibling-block-id (d/attr sibling-block "blockid")]
- (let [state (get-state state)
- content (:block/content block)
- value (:value state)]
- (when (not= (-> content
- (text/remove-level-spaces format)
- text/remove-properties!
- string/trim)
- (string/trim value))
- (save-block! state (:value state))))
- (let [block (db/pull (state/get-current-repo) '[*] [:block/uuid (uuid sibling-block-id)])]
- (edit-block! block pos format id))))))))))
- (defn insert-command!
- [id command-output format {:keys [restore?]
- :or {restore? true}
- :as option}]
- (cond
- ;; replace string
- (string? command-output)
- (commands/insert! id command-output option)
- ;; steps
- (vector? command-output)
- (commands/handle-steps command-output format)
- :else
- nil)
- (when restore?
- (let [restore-slash-caret-pos? (if (= :editor/click-hidden-file-input
- (ffirst command-output))
- false
- true)]
- (commands/restore-state restore-slash-caret-pos?))))
- (defn upload-image
- [id files format uploading? drop?]
- (image/upload
- files
- (fn [file file-name file-type]
- (image-handler/request-presigned-url
- file file-name file-type
- uploading?
- (fn [signed-url]
- (insert-command! id
- (util/format "[[%s][%s]]"
- signed-url
- file-name)
- format
- {:last-pattern (if drop? "" commands/slash)
- :restore? false})
- (reset! *image-uploading-process 0))
- (fn [e]
- (let [process (* (/ (gobj/get e "loaded")
- (gobj/get e "total"))
- 100)]
- (reset! *image-uploading-process process)))))))
- ;; Editor should track some useful information, like editor modes.
- ;; For example:
- ;; 1. Which file format is it, markdown or org mode?
- ;; 2. Is it in the properties area? Then we can enable the ":" autopair
- (def autopair-map
- {"[" "]"
- "{" "}"
- "(" ")"
- "`" "`"
- "~" "~"
- "*" "*"
- ;; "_" "_"
- ;; ":" ":" ; TODO: only properties editing and org mode tag
- "^" "^"})
- (def reversed-autopair-map
- (zipmap (vals autopair-map)
- (keys autopair-map)))
- (def delete-map
- (assoc autopair-map
- "$" "$"
- ":" ":"))
- (def reversed-delete-map
- (zipmap (vals delete-map)
- (keys delete-map)))
- (defn autopair
- [input-id prefix format {:keys [restore?]
- :or {restore? true}
- :as option}]
- (let [value (get autopair-map prefix)
- selected (util/get-selected-text)
- postfix (str selected value)
- value (str prefix postfix)
- input (gdom/getElement input-id)]
- (when value
- (when-not (string/blank? selected) (reset! *selected-text selected))
- (let [[prefix pos] (commands/simple-replace! input-id value selected
- {:backward-pos (count postfix)
- :check-fn (fn [new-value prefix-pos]
- (when (>= prefix-pos 0)
- [(subs new-value prefix-pos (+ prefix-pos 2))
- (+ prefix-pos 2)]))})]
- (case prefix
- "[["
- (do
- (commands/handle-step [:editor/search-page])
- (reset! commands/*slash-caret-pos (util/get-caret-pos input)))
- "(("
- (do
- (commands/handle-step [:editor/search-block :reference])
- (reset! commands/*slash-caret-pos (util/get-caret-pos input)))
- nil)))))
- (defn surround-by?
- [input before after]
- (when input
- (let [value (gobj/get input "value")
- pos (util/get-input-pos input)
- start-pos (if (= :start before) 0 (- pos (count before)))
- end-pos (if (= :end after) (count value) (+ pos (count after)))]
- (when (>= (count value) end-pos)
- (= (cond
- (and (= :end after) (= :start before))
- ""
- (= :end after)
- before
- (= :start before)
- after
- :else
- (str before after))
- (subs value start-pos end-pos))))))
- (defn get-matched-pages
- [q]
- (let [block (state/get-edit-block)
- editing-page (and block
- (when-let [page-id (:db/id (:block/page block))]
- (:page/name (db/entity page-id))))]
- (let [pages (db/get-pages (state/get-current-repo))
- pages (if editing-page
- ;; To prevent self references
- (remove (fn [p] (= (string/lower-case p) editing-page)) pages)
- pages)]
- (filter
- (fn [page]
- (string/index-of
- (string/lower-case page)
- (string/lower-case q)))
- pages))))
- (defn get-matched-blocks
- [q]
- ;; remove current block
- (let [current-block (state/get-edit-block)]
- (remove
- (fn [h]
- (= (:block/uuid current-block)
- (:block/uuid h)))
- (search/search q 21))))
- (defn get-matched-templates
- [q]
- (search/template-search q))
- (defn get-matched-commands
- [input]
- (try
- (let [edit-content (gobj/get input "value")
- pos (util/get-input-pos input)
- last-slash-caret-pos (:pos @*slash-caret-pos)
- last-command (and last-slash-caret-pos (subs edit-content last-slash-caret-pos pos))]
- (when (> pos 0)
- (or
- (and (= \/ (util/nth-safe edit-content (dec pos)))
- (commands/commands-map))
- (and last-command
- (commands/get-matched-commands last-command)))))
- (catch js/Error e
- nil)))
- (defn get-matched-block-commands
- [input]
- (try
- (let [edit-content (gobj/get input "value")
- pos (util/get-input-pos input)
- last-command (subs edit-content
- (:pos @*angle-bracket-caret-pos)
- pos)]
- (when (> pos 0)
- (or
- (and (= \< (util/nth-safe edit-content (dec pos)))
- (commands/block-commands-map))
- (and last-command
- (commands/get-matched-commands
- last-command
- (commands/block-commands-map))))))
- (catch js/Error e
- nil)))
- (defn in-auto-complete?
- [input]
- (or @*show-commands
- @*show-block-commands
- (state/get-editor-show-input)
- (state/get-editor-show-page-search)
- (state/get-editor-show-block-search)
- (state/get-editor-show-template-search)
- (state/get-editor-show-date-picker)))
- (defn get-previous-input-char
- [input]
- (when-let [pos (util/get-input-pos input)]
- (let [value (gobj/get input "value")]
- (when (and (>= (count value) pos)
- (>= pos 1))
- (util/nth-safe value (- pos 1))))))
- (defn get-previous-input-chars
- [input length]
- (when-let [pos (util/get-input-pos input)]
- (let [value (gobj/get input "value")]
- (when (and (>= (count value) pos)
- (>= pos 1))
- (subs value (- pos length) pos)))))
- (defn get-current-input-char
- [input]
- (when-let [pos (util/get-input-pos input)]
- (let [value (gobj/get input "value")]
- (when (and (>= (count value) (inc pos))
- (>= pos 1))
- (util/nth-safe value pos)))))
- (defn- get-previous-block-level
- [current-id]
- (when-let [input (gdom/getElement current-id)]
- (when-let [prev-block (util/get-prev-block input)]
- (util/parse-int (d/attr prev-block "level")))))
- (defn adjust-block-level!
- [state direction]
- (state/set-editor-op! :indent-outdent)
- (let [{:keys [block block-parent-id value config]} (get-state state)
- start-level (:start-level config)
- format (:block/format block)
- block-pattern (config/get-block-pattern format)
- level (:block/level block)
- previous-level (or (get-previous-block-level block-parent-id) 1)
- [add? remove?] (case direction
- :left [false true]
- :right [true false]
- [(<= level previous-level)
- (and (> level previous-level)
- (> level 2))])
- final-level (cond
- add? (inc level)
- remove? (if (> level 2)
- (dec level)
- level)
- :else level)
- new-value (block/with-levels value format (assoc block :block/level final-level))]
- (when (and
- (not (and (= direction :left)
- (and
- (get config :id)
- (util/uuid-string? (get config :id)))
- (<= final-level start-level)))
- (<= (- final-level previous-level) 1))
- (save-block-if-changed! block new-value
- {:indent-left? (= direction :left)})))
- (state/set-editor-op! nil))
- (defn adjust-blocks-level!
- [blocks direction])
- (defn append-paste-doc!
- [format event]
- (let [[html text] (util/get-clipboard-as-html event)]
- (when-not (util/starts-with? (string/trim text) "http")
- (let [doc-text (html-parser/parse format html)]
- (when-not (string/blank? doc-text)
- (util/stop event)
- (state/append-current-edit-content! doc-text))))))
- (defn- block-and-children-content
- [block-children]
- (-> (map :block/content block-children)
- string/join))
- (defn move-up-down
- [e up?]
- (when-let [block-id (:block/uuid (state/get-edit-block))]
- (let [block-parent-id (state/get-editing-block-dom-id)
- block (db/entity [:block/uuid block-id])
- meta (:block/meta block)
- page (:block/page block)
- block-dom-node (gdom/getElement block-parent-id)
- prev-block (get-prev-block-non-collapsed block-dom-node)
- next-block (get-next-block-non-collapsed block-dom-node)
- repo (state/get-current-repo)
- move-upwards-to-parent? (and up? prev-block (< (d/attr prev-block "level") (:block/level block)))
- move-down-to-higher-level? (and (not up?) next-block (< (d/attr next-block "level") (:block/level block)))]
- (when-let [sibling-block (cond
- move-upwards-to-parent?
- prev-block
- move-down-to-higher-level?
- next-block
- :else
- (let [f (if up? util/get-prev-block-with-same-level util/get-next-block-with-same-level)]
- (f block-dom-node)))]
- (when-let [sibling-block-id (d/attr sibling-block "blockid")]
- (when-let [sibling-block (db/pull-block (medley/uuid sibling-block-id))]
- (let [sibling-meta (:block/meta sibling-block)
- hc1 (db/get-block-and-children-no-cache repo (:block/uuid block))
- hc2 (if (or move-upwards-to-parent? move-down-to-higher-level?)
- [sibling-block]
- (db/get-block-and-children-no-cache repo (:block/uuid sibling-block)))]
- ;; Same page and next to the other
- (when (and
- (= (:db/id (:block/page block))
- (:db/id (:block/page sibling-block)))
- (or
- (and up? (= (:end-pos (:block/meta (last hc2))) (:start-pos (:block/meta (first hc1)))))
- (and (not up?) (= (:end-pos (:block/meta (last hc1))) (:start-pos (:block/meta (first hc2)))))))
- (let [hc1-content (block-and-children-content hc1)
- hc2-content (block-and-children-content hc2)
- file (db/get-block-file (:block/uuid block))
- file-path (:file/path file)
- old-file-content (db/get-file file-path)
- [start-pos end-pos new-content blocks] (if up?
- [(:start-pos sibling-meta)
- (get-in (last hc1) [:block/meta :end-pos])
- (str hc1-content hc2-content)
- (concat hc1 hc2)]
- [(:start-pos meta)
- (get-in (last hc2) [:block/meta :end-pos])
- (str hc2-content hc1-content)
- (concat hc2 hc1)])]
- (when (and start-pos end-pos)
- (let [new-file-content (utf8/insert! old-file-content start-pos end-pos new-content)
- modified-time (modified-time-tx page file)
- blocks-meta (rebuild-blocks-meta start-pos blocks)]
- (profile
- (str "Move block " (if up? "up: " "down: "))
- (repo-handler/transact-react-and-alter-file!
- repo
- (concat
- blocks-meta
- modified-time)
- {:key :block/change
- :data (map (fn [block] (assoc block :block/page page)) blocks)}
- [[file-path new-file-content]])))))))))))))
- (defn expand!
- []
- (when-let [current-block (state/get-edit-block)]
- (expand/expand! current-block)
- (state/set-collapsed-state! (:block/uuid current-block)
- false)))
- (defn collapse!
- []
- (when-let [current-block (state/get-edit-block)]
- (expand/collapse! current-block)
- (state/set-collapsed-state! (:block/uuid current-block)
- true)))
- (defn cycle-collapse!
- [_state e]
- (when (and
- ;; not input, t
- (nil? (state/get-edit-input-id))
- (not (state/get-editor-show-input))
- (string/blank? (:search/q @state/state)))
- (util/stop e)
- (expand/cycle!)))
- (defn on-tab
- [direction]
- (fn [state e]
- (when-let [repo (state/get-current-repo)]
- (let [blocks (seq (state/get-selection-blocks))]
- (if (seq blocks)
- (let [ids (map (fn [block] (when-let [id (dom/attr block "blockid")]
- (medley/uuid id))) blocks)
- ids (->> (mapcat #(let [children (vec (db/get-block-children-ids repo %))]
- (cons % children)) ids)
- (distinct))
- blocks (db/pull-many '[*] (map (fn [id] [:block/uuid id]) ids))
- block (first blocks)
- format (:block/format block)
- start-pos (get-in block [:block/meta :start-pos])
- old-end-pos (get-in (last blocks) [:block/meta :end-pos])
- pattern (config/get-block-pattern format)
- last-start-pos (atom start-pos)
- blocks (doall
- (map (fn [block]
- (let [content (:block/content block)
- level (:block/level block)
- content' (if (= :left direction)
- (subs content 1)
- (str pattern content))
- end-pos (+ @last-start-pos (utf8/length (utf8/encode content')))
- block (assoc block
- :block/content content'
- :block/level (if (= direction :left)
- (dec level)
- (inc level))
- :block/meta (merge
- (:block/meta block)
- {:start-pos @last-start-pos
- :end-pos end-pos}))]
- (reset! last-start-pos end-pos)
- block))
- blocks))
- file-id (:db/id (:block/file block))
- file (db/entity file-id)
- page (:block/page block)
- after-blocks (rebuild-after-blocks repo file old-end-pos @last-start-pos)
- ;; _ (prn {:blocks (map (fn [h] (select-keys h [:block/content :block/meta])) blocks)
- ;; :after-blocks after-blocks
- ;; :last-start-pos @last-start-pos})
- file-path (:file/path file)
- file-content (db/get-file file-path)
- new-content (utf8/insert! file-content start-pos old-end-pos (apply str (map :block/content blocks)))
- modified-time (modified-time-tx page file)]
- (profile
- "Indent/outdent: "
- (repo-handler/transact-react-and-alter-file!
- repo
- (concat
- blocks
- after-blocks
- modified-time)
- {:key :block/change
- :data (map (fn [block] (assoc block :block/page page)) blocks)}
- [[file-path new-content]])))
- (cycle-collapse! state e))))))
- (defn bulk-make-todos
- [state e]
- (when-let [repo (state/get-current-repo)]
- (let [blocks (seq (state/get-selection-blocks))]
- (if (seq blocks)
- (let [ids (map (fn [block] (when-let [id (dom/attr block "blockid")]
- (medley/uuid id))) blocks)
- ids (->> (mapcat #(let [children (vec (db/get-block-children-ids repo %))]
- (cons % children)) ids)
- (distinct))
- blocks (db/pull-many '[*] (map (fn [id] [:block/uuid id]) ids))
- block (first blocks)
- format (:block/format block)
- start-pos (get-in block [:block/meta :start-pos])
- old-end-pos (get-in (last blocks) [:block/meta :end-pos])
- pattern (config/get-block-pattern format)
- last-start-pos (atom start-pos)
- blocks (doall
- (map (fn [block]
- (let [content (:block/content block)
- [prefix content] (if-let [col (util/split-first " " content)]
- col
- [content ""])
- level (:block/level block)
- new-marker (state/get-preferred-todo)
- content' (string/replace-first content
- format/marker-pattern
- (str new-marker " "))
- content' (str prefix " " content')
- end-pos (+ @last-start-pos (utf8/length (utf8/encode content')))
- block (assoc block
- :block/marker new-marker
- :block/content content'
- :block/meta (merge
- (:block/meta block)
- {:start-pos @last-start-pos
- :end-pos end-pos}))]
- (reset! last-start-pos end-pos)
- block))
- blocks))
- file-id (:db/id (:block/file block))
- file (db/entity file-id)
- page (:block/page block)
- after-blocks (rebuild-after-blocks repo file old-end-pos @last-start-pos)
- file-path (:file/path file)
- file-content (db/get-file file-path)
- new-content (utf8/insert! file-content start-pos old-end-pos (apply str (map :block/content blocks)))
- modified-time (modified-time-tx page file)]
- (profile
- "Indent/outdent: "
- (repo-handler/transact-react-and-alter-file!
- repo
- (concat
- blocks
- after-blocks
- modified-time)
- {:key :block/change
- :data (map (fn [block] (assoc block :block/page page)) blocks)}
- [[file-path new-content]])))
- (cycle-collapse! state e)))))
- (defn handle-command-input
- [command id format m pos]
- (case command
- :link
- (let [{:keys [link label]} m]
- (if (and (string/blank? link)
- (string/blank? label))
- nil
- (insert-command! id
- (util/format "[[%s][%s]]"
- (or link "")
- (or label ""))
- format
- {:last-pattern (str commands/slash "link")})))
- :draw
- (when-not (string/blank? (:title m))
- (let [file (draw/title->file-name (:title m))
- value (util/format
- "[[%s]]\n<iframe class=\"draw-iframe\" src=\"/draw?file=%s\" width=\"100%\" height=\"400\" frameborder=\"0\" allowfullscreen></iframe>"
- file
- file)]
- (insert-command! id
- value
- format
- {:last-pattern (str commands/slash "draw ")})
- (draw/create-draw-with-default-content
- file
- (fn []
- (let [input (gdom/getElement "download")]
- (.click input))))))
- nil)
- (state/set-editor-show-input nil)
- (when-let [saved-cursor (get @state/state :editor/last-saved-cursor)]
- (when-let [input (gdom/getElement id)]
- (.focus input)
- (util/move-cursor-to input saved-cursor))))
- (defn set-block-as-a-heading!
- [block-id value]
- (set-block-property! block-id "heading" value))
- ;; Should preserve the cursor too.
- (defn open-last-block!
- [journal?]
- (let [edit-id (state/get-edit-input-id)
- last-pos (state/get-edit-pos)
- block-id (when edit-id (subs edit-id (- (count edit-id) 36)))]
- (let [last-edit-block (first (array-seq (js/document.getElementsByClassName block-id)))
- first-block (first (array-seq (js/document.getElementsByClassName "ls-block")))
- node (or last-edit-block
- (and (not journal?) first-block))]
- (when node
- (let [block-id (and node (d/attr node "blockid"))
- edit-block-id (string/replace (gobj/get node "id") "ls-block" "edit-block")
- block-id (medley/uuid block-id)]
- (when-let [block (db/entity [:block/uuid block-id])]
- (edit-block! block
- (or (and last-edit-block last-pos)
- :max)
- (:block/format block)
- edit-block-id)))))))
- (defn get-search-q
- []
- (when-let [id (state/get-edit-input-id)]
- (when-let [input (gdom/getElement id)]
- (let [current-pos (:pos (util/get-caret-pos input))
- pos (:editor/last-saved-cursor @state/state)
- edit-content (state/sub [:editor/content id])]
- (or
- @*selected-text
- (util/safe-subs edit-content pos current-pos))))))
- (defn close-autocomplete-if-outside
- [input]
- (when (or (state/get-editor-show-page-search)
- (state/get-editor-show-page-search-hashtag)
- (state/get-editor-show-block-search))
- (when-let [q (get-search-q)]
- (let [value (gobj/get input "value")
- pos (:editor/last-saved-cursor @state/state)
- current-pos (:pos (util/get-caret-pos input))]
- (when (or (< current-pos pos)
- (string/includes? q "]")
- (string/includes? q ")"))
- (state/set-editor-show-block-search false)
- (state/set-editor-show-page-search false)
- (state/set-editor-show-page-search-hashtag false))))))
|