editor.cljs 117 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016
  1. (ns frontend.handler.editor
  2. (:require [frontend.state :as state]
  3. [clojure.walk :as w]
  4. [lambdaisland.glogi :as log]
  5. [frontend.db.model :as db-model]
  6. [frontend.db.utils :as db-utils]
  7. [frontend.db-schema :as db-schema]
  8. [frontend.handler.common :as common-handler]
  9. [frontend.handler.route :as route-handler]
  10. [frontend.handler.ui :as ui-handler]
  11. [frontend.handler.repo :as repo-handler]
  12. [frontend.handler.notification :as notification]
  13. [frontend.handler.block :as block-handler]
  14. [frontend.format.mldoc :as mldoc]
  15. [frontend.format :as format]
  16. [frontend.format.block :as block]
  17. [frontend.image :as image]
  18. [frontend.db :as db]
  19. [goog.object :as gobj]
  20. [goog.dom :as gdom]
  21. [goog.dom.classes :as gdom-classes]
  22. [clojure.string :as string]
  23. [clojure.set :as set]
  24. [clojure.zip :as zip]
  25. [frontend.util :as util :refer-macros [profile]]
  26. [frontend.util.cursor :as cursor]
  27. [frontend.config :as config]
  28. [dommy.core :as dom]
  29. [frontend.utf8 :as utf8]
  30. [frontend.fs :as fs]
  31. [promesa.core :as p]
  32. [frontend.diff :as diff]
  33. [frontend.search :as search]
  34. [frontend.handler.image :as image-handler]
  35. [frontend.commands :as commands
  36. :refer [*show-commands
  37. *slash-caret-pos
  38. *angle-bracket-caret-pos
  39. *show-block-commands]]
  40. [frontend.extensions.html-parser :as html-parser]
  41. [medley.core :as medley]
  42. [frontend.text :as text]
  43. [frontend.util.property :as property]
  44. [frontend.date :as date]
  45. [frontend.handler.repeated :as repeated]
  46. [frontend.template :as template]
  47. [clojure.core.async :as async]
  48. [lambdaisland.glogi :as log]
  49. [cljs.core.match :refer-macros [match]]
  50. [frontend.modules.outliner.core :as outliner-core]
  51. [frontend.db.outliner :as outliner-db]
  52. [frontend.modules.outliner.tree :as tree]
  53. [frontend.debug :as debug]
  54. [datascript.core :as d]
  55. [frontend.util.marker :as marker]))
  56. ;; FIXME: should support multiple images concurrently uploading
  57. (defonce *asset-pending-file (atom nil))
  58. (defonce *asset-uploading? (atom false))
  59. (defonce *asset-uploading-process (atom 0))
  60. (defonce *selected-text (atom nil))
  61. (defn- get-selection-and-format
  62. []
  63. (when-let [block (state/get-edit-block)]
  64. (when-let [id (:block/uuid block)]
  65. (when-let [edit-id (state/get-edit-input-id)]
  66. (when-let [input (gdom/getElement edit-id)]
  67. {:selection-start (gobj/get input "selectionStart")
  68. :selection-end (gobj/get input "selectionEnd")
  69. :format (:block/format block)
  70. :value (gobj/get input "value")
  71. :block block
  72. :edit-id edit-id
  73. :input input})))))
  74. (defn- format-text!
  75. [pattern-fn]
  76. (when-let [m (get-selection-and-format)]
  77. (let [{:keys [selection-start selection-end format value block edit-id input]} m
  78. empty-selection? (= selection-start selection-end)
  79. pattern (pattern-fn format)
  80. pattern-count (count pattern)
  81. pattern-prefix (subs value (max 0 (- selection-start pattern-count)) selection-start)
  82. pattern-suffix (subs value selection-end (min (count value) (+ selection-end pattern-count)))
  83. already-wrapped? (= pattern pattern-prefix pattern-suffix)
  84. prefix (if already-wrapped?
  85. (subs value 0 (- selection-start pattern-count))
  86. (subs value 0 selection-start))
  87. postfix (if already-wrapped?
  88. (subs value (+ selection-end pattern-count))
  89. (subs value selection-end))
  90. inner-value (cond-> (subs value selection-start selection-end)
  91. (not already-wrapped?) (#(str pattern % pattern)))
  92. new-value (str prefix inner-value postfix)]
  93. (state/set-edit-content! edit-id new-value)
  94. (cond
  95. already-wrapped? (cursor/set-selection-to input (- selection-start pattern-count) (- selection-end pattern-count))
  96. empty-selection? (cursor/move-cursor-to input (+ selection-end pattern-count))
  97. :else (cursor/set-selection-to input (+ selection-start pattern-count) (+ selection-end pattern-count))))))
  98. (defn bold-format! []
  99. (format-text! config/get-bold))
  100. (defn italics-format! []
  101. (format-text! config/get-italic))
  102. (defn highlight-format! []
  103. (format-text! config/get-highlight))
  104. (defn strike-through-format! []
  105. (format-text! config/get-strike-through))
  106. (defn html-link-format! []
  107. (when-let [m (get-selection-and-format)]
  108. (let [{:keys [selection-start selection-end format value block edit-id input]} m
  109. cur-pos (cursor/pos input)
  110. empty-selection? (= selection-start selection-end)
  111. selection (subs value selection-start selection-end)
  112. selection-link? (and selection (or (util/starts-with? selection "http://")
  113. (util/starts-with? selection "https://")))
  114. [content forward-pos] (cond
  115. empty-selection?
  116. (config/get-empty-link-and-forward-pos format)
  117. selection-link?
  118. (config/with-default-link format selection)
  119. :else
  120. (config/with-default-label format selection))
  121. new-value (str
  122. (subs value 0 selection-start)
  123. content
  124. (subs value selection-end))
  125. cur-pos (or selection-start cur-pos)]
  126. (state/set-edit-content! edit-id new-value)
  127. (cursor/move-cursor-to input (+ cur-pos forward-pos)))))
  128. (defn open-block-in-sidebar!
  129. [block-id]
  130. (when block-id
  131. (when-let [block (db/pull [:block/uuid block-id])]
  132. (state/sidebar-add-block!
  133. (state/get-current-repo)
  134. (:db/id block)
  135. :block
  136. block))))
  137. (defn reset-cursor-range!
  138. [node]
  139. (when node
  140. (state/set-cursor-range! (util/caret-range node))))
  141. (defn restore-cursor-pos!
  142. [id markup]
  143. (when-let [node (gdom/getElement (str id))]
  144. (when-let [cursor-range (state/get-cursor-range)]
  145. (when-let [range cursor-range]
  146. (let [pos (diff/find-position markup range)]
  147. (cursor/move-cursor-to node pos))))))
  148. (defn highlight-block!
  149. [block-uuid]
  150. (let [blocks (array-seq (js/document.getElementsByClassName (str block-uuid)))]
  151. (doseq [block blocks]
  152. (dom/add-class! block "block-highlight"))))
  153. (defn unhighlight-blocks!
  154. []
  155. (let [blocks (some->> (array-seq (js/document.getElementsByClassName "block-highlight"))
  156. (repeat 2)
  157. (apply concat))]
  158. (doseq [block blocks]
  159. (gdom-classes/remove block "block-highlight"))))
  160. ;; FIXME: children' :block/path-ref-pages
  161. (defn compute-retract-refs
  162. "Computes old references to be retracted."
  163. [eid {:block/keys [refs]} old-refs]
  164. ;; TODO:
  165. )
  166. (defn- get-edit-input-id-with-block-id
  167. [block-id]
  168. (when-let [first-block (util/get-first-block-by-id block-id)]
  169. (string/replace (gobj/get first-block "id")
  170. "ls-block"
  171. "edit-block")))
  172. (defn clear-selection!
  173. [_e]
  174. (util/select-unhighlight! (dom/by-class "selected"))
  175. (state/clear-selection!))
  176. (defn- text-range-by-lst-fst-line [content [direction pos]]
  177. (case direction
  178. :up
  179. (let [last-new-line (or (string/last-index-of content \newline) -1)
  180. end (+ last-new-line pos 1)]
  181. (subs content 0 end))
  182. :down
  183. (-> (string/split-lines content)
  184. first
  185. (or "")
  186. (subs 0 pos))))
  187. ;; id: block dom id, "ls-block-counter-uuid"
  188. (defn edit-block!
  189. ([block pos format id]
  190. (edit-block! block pos format id nil))
  191. ([block pos format id {:keys [custom-content tail-len move-cursor?]
  192. :or {tail-len 0
  193. move-cursor? true}}]
  194. (when-not config/publishing?
  195. (when-let [block-id (:block/uuid block)]
  196. (let [block (or (db/pull [:block/uuid block-id]) block)
  197. edit-input-id (if (uuid? id)
  198. (get-edit-input-id-with-block-id id)
  199. (str (subs id 0 (- (count id) 36)) block-id))
  200. content (or custom-content (:block/content block) "")
  201. content-length (count content)
  202. text-range (cond
  203. (vector? pos)
  204. (text-range-by-lst-fst-line content pos)
  205. (and (> tail-len 0) (>= (count content) tail-len))
  206. (subs content 0 (- (count content) tail-len))
  207. (or (= :max pos) (<= content-length pos))
  208. content
  209. :else
  210. (subs content 0 pos))
  211. content (property/remove-built-in-properties (:block/format block)
  212. content)]
  213. (clear-selection! nil)
  214. (state/set-editing! edit-input-id content block text-range move-cursor?))))))
  215. (defn edit-last-block-for-new-page!
  216. [last-block pos]
  217. (when-let [first-block (util/get-first-block-by-id (:block/uuid last-block))]
  218. (edit-block!
  219. last-block
  220. pos
  221. (:block/format last-block)
  222. (string/replace (gobj/get first-block "id")
  223. "ls-block"
  224. "edit-block"))))
  225. (defn- another-block-with-same-id-exists?
  226. [current-id block-id]
  227. (and (string? block-id)
  228. (util/uuid-string? block-id)
  229. (not= current-id (cljs.core/uuid block-id))
  230. (db/entity [:block/uuid (cljs.core/uuid block-id)])))
  231. (defn- attach-page-properties-if-exists!
  232. [block]
  233. (if (and (:block/pre-block? block)
  234. (seq (:block/properties block)))
  235. (let [page-properties (:block/properties block)
  236. str->page (fn [n] (block/page-name->map n true))
  237. refs (->> page-properties
  238. (filter (fn [[_ v]] (coll? v)))
  239. (vals)
  240. (apply concat)
  241. (set)
  242. (map str->page)
  243. (concat (:block/refs block))
  244. (util/distinct-by :block/name))
  245. {:keys [tags alias]} page-properties
  246. page-tx (let [id (:db/id (:block/page block))
  247. retract-attributes (mapv (fn [attribute]
  248. [:db/retract id attribute])
  249. [:block/properties :block/tags :block/alias])
  250. tx (cond-> {:db/id id
  251. :block/properties page-properties}
  252. (seq tags)
  253. (assoc :block/tags (map str->page tags))
  254. (seq alias)
  255. (assoc :block/alias (map str->page alias)))]
  256. (conj retract-attributes tx))]
  257. (assoc block
  258. :block/refs refs
  259. :db/other-tx page-tx))
  260. block))
  261. (defn- remove-non-existed-refs!
  262. [refs]
  263. (remove (fn [x] (and (vector? x)
  264. (= :block/uuid (first x))
  265. (nil? (db/entity x)))) refs))
  266. (defn- wrap-parse-block
  267. [{:block/keys [content format parent left page uuid pre-block?] :as block}]
  268. (let [block (or (and (:db/id block) (db/pull (:db/id block))) block)
  269. properties (:block/properties block)
  270. real-content (:block/content block)
  271. content (if (and (seq properties) real-content (not= real-content content))
  272. (property/with-built-in-properties properties content format)
  273. content)
  274. first-block? (= left page)
  275. ast (mldoc/->edn (string/trim content) (mldoc/default-config format))
  276. first-elem-type (first (ffirst ast))
  277. properties? (contains? #{"Property_Drawer" "Properties"} first-elem-type)
  278. top-level? (= parent page)
  279. markdown-heading? (and (= format :markdown)
  280. (= "Heading" first-elem-type))
  281. block-with-title? (mldoc/block-with-title? first-elem-type)
  282. content (string/triml content)
  283. content (string/replace content (util/format "((%s))" (str uuid)) "")
  284. [content content'] (cond
  285. (and first-block? properties?)
  286. [content content]
  287. (and markdown-heading? top-level?)
  288. [content content]
  289. markdown-heading?
  290. (let [content (string/replace content #"^#+\s+" "")]
  291. [content (str (config/get-block-pattern format) " " content)])
  292. :else
  293. (let [content' (str (config/get-block-pattern format) (if block-with-title? " " "\n") content)]
  294. [content content']))
  295. block (assoc block :block/content content')
  296. block (apply dissoc block (remove #{:block/pre-block?} db-schema/retract-attributes))
  297. block (block/parse-block block)
  298. block (if (and first-block? (:block/pre-block? block))
  299. block
  300. (dissoc block :block/pre-block?))
  301. block (update block :block/refs remove-non-existed-refs!)
  302. block (attach-page-properties-if-exists! block)
  303. new-properties (merge
  304. (select-keys properties property/built-in-properties)
  305. (:block/properties block))]
  306. (-> block
  307. (dissoc :block/top?
  308. :block/block-refs-count)
  309. (assoc :block/content content
  310. :block/properties new-properties))))
  311. (defn- save-block-inner!
  312. [repo block value {:keys [refresh?]
  313. :or {refresh? true}}]
  314. (let [block (assoc block :block/content value)
  315. block (apply dissoc block db-schema/retract-attributes)]
  316. (profile
  317. "Save block: "
  318. (let [block (wrap-parse-block block)]
  319. (-> (outliner-core/block block)
  320. (outliner-core/save-node))
  321. (when refresh?
  322. (let [opts {:key :block/change
  323. :data [block]}]
  324. (db/refresh! repo opts)))))
  325. (repo-handler/push-if-auto-enabled! repo)))
  326. (defn save-block-if-changed!
  327. ([block value]
  328. (save-block-if-changed! block value nil))
  329. ([block value
  330. {:keys [force?]
  331. :as opts}]
  332. (let [{:block/keys [uuid file page format repo content properties]} block
  333. repo (or repo (state/get-current-repo))
  334. e (db/entity repo [:block/uuid uuid])
  335. format (or format (state/get-preferred-format))
  336. page (db/entity repo (:db/id page))
  337. block-id (when (map? properties) (get properties :id))
  338. content (property/remove-built-in-properties format content)]
  339. (cond
  340. (another-block-with-same-id-exists? uuid block-id)
  341. (notification/show!
  342. [:p.content
  343. (util/format "Block with the id % already exists!" block-id)]
  344. :error)
  345. force?
  346. (save-block-inner! repo block value opts)
  347. :else
  348. (let [content-changed? (not= (string/trim content) (string/trim value))]
  349. (when (and content-changed? page)
  350. (save-block-inner! repo block value opts)))))))
  351. (defn- compute-fst-snd-block-text
  352. [value pos]
  353. (let [fst-block-text (subs value 0 pos)
  354. snd-block-text (string/triml (subs value pos))]
  355. [fst-block-text snd-block-text]))
  356. (defn outliner-insert-block!
  357. [config current-block new-block sibling?]
  358. (let [ref-top-block? (and (:ref? config)
  359. (not (:ref-child? config)))
  360. skip-save-current-block? (:skip-save-current-block? config)
  361. [current-node new-node]
  362. (mapv outliner-core/block [current-block new-block])
  363. has-children? (db/has-children? (state/get-current-repo)
  364. (tree/-get-id current-node))
  365. sibling? (cond
  366. ref-top-block?
  367. false
  368. (boolean? sibling?)
  369. sibling?
  370. (:collapsed (:block/properties current-block))
  371. true
  372. :else
  373. (not has-children?))]
  374. (let [*blocks (atom [current-node])]
  375. (when-not skip-save-current-block?
  376. (outliner-core/save-node current-node))
  377. (outliner-core/insert-node new-node current-node sibling? {:blocks-atom *blocks
  378. :skip-transact? false})
  379. {:blocks @*blocks
  380. :sibling? sibling?})))
  381. (defn- block-self-alone-when-insert?
  382. [config uuid]
  383. (let [current-page (state/get-current-page)
  384. block-id (or
  385. (and (:id config)
  386. (util/uuid-string? (:id config))
  387. (:id config))
  388. (and current-page
  389. (util/uuid-string? current-page)
  390. current-page))]
  391. (= uuid (and block-id (medley/uuid block-id)))))
  392. ;; FIXME: painful
  393. (defn update-cache-for-block-insert!
  394. "Currently, this only affects current editor container to improve the performance."
  395. [repo config {:block/keys [page uuid] :as block} blocks]
  396. (let [blocks (map :data blocks)
  397. [first-block last-block right-block] blocks
  398. child? (= (first (:block/parent last-block))
  399. (:block/uuid first-block))
  400. blocks-container-id (when-let [id (:id config)]
  401. (and (util/uuid-string? id) (medley/uuid id)))]
  402. (let [new-last-block (let [first-block-id {:db/id (:db/id first-block)}]
  403. (assoc last-block
  404. :block/left first-block-id
  405. :block/parent (if child?
  406. first-block-id
  407. ;; sibling
  408. (:block/parent first-block))))
  409. blocks [first-block new-last-block]
  410. blocks-atom (if blocks-container-id
  411. (db/get-block-blocks-cache-atom repo blocks-container-id)
  412. (db/get-page-blocks-cache-atom repo (:db/id page)))
  413. [before-part after-part] (and blocks-atom
  414. (split-with
  415. #(not= uuid (:block/uuid %))
  416. @blocks-atom))
  417. after-part (rest after-part)
  418. blocks (concat before-part blocks after-part)
  419. blocks (if right-block
  420. (map (fn [block]
  421. (if (= (:block/uuid right-block) (:block/uuid block))
  422. (assoc block :block/left (:block/left right-block))
  423. block)) blocks)
  424. blocks)]
  425. (when blocks-atom
  426. (reset! blocks-atom blocks)))))
  427. (defn insert-new-block-before-block-aux!
  428. [config
  429. {:block/keys [uuid content repo format page]
  430. db-id :db/id
  431. :as block}
  432. value
  433. {:keys [ok-handler]
  434. :as opts}]
  435. (let [input (gdom/getElement (state/get-edit-input-id))
  436. pos (cursor/pos input)
  437. repo (or repo (state/get-current-repo))
  438. [fst-block-text snd-block-text] (compute-fst-snd-block-text value pos)
  439. current-block (assoc block :block/content snd-block-text)
  440. current-block (apply dissoc current-block db-schema/retract-attributes)
  441. current-block (wrap-parse-block current-block)
  442. new-m {:block/uuid (db/new-block-id)
  443. :block/content fst-block-text}
  444. prev-block (-> (merge (select-keys block [:block/parent :block/left :block/format
  445. :block/page :block/file :block/journal?]) new-m)
  446. (wrap-parse-block))
  447. left-block (db/pull (:db/id (:block/left block)))
  448. _ (outliner-core/save-node (outliner-core/block current-block))
  449. sibling? (not= (:db/id left-block) (:db/id (:block/parent block)))
  450. {:keys [sibling? blocks]} (profile
  451. "outliner insert block"
  452. (outliner-insert-block! config left-block prev-block sibling?))]
  453. (db/refresh! repo {:key :block/insert :data [prev-block left-block current-block]})
  454. (profile "ok handler" (ok-handler prev-block))))
  455. (defn insert-new-block-aux!
  456. [config
  457. {:block/keys [uuid content repo format page]
  458. db-id :db/id
  459. :as block}
  460. value
  461. {:keys [ok-handler]
  462. :as opts}]
  463. (let [block-self? (block-self-alone-when-insert? config uuid)
  464. input (gdom/getElement (state/get-edit-input-id))
  465. pos (cursor/pos input)
  466. repo (or repo (state/get-current-repo))
  467. [fst-block-text snd-block-text] (compute-fst-snd-block-text value pos)
  468. current-block (assoc block :block/content fst-block-text)
  469. current-block (apply dissoc current-block db-schema/retract-attributes)
  470. current-block (wrap-parse-block current-block)
  471. zooming? (when-let [id (:id config)]
  472. (and (string? id) (util/uuid-string? id)))
  473. new-m {:block/uuid (db/new-block-id)
  474. :block/content snd-block-text}
  475. next-block (-> (merge (select-keys block [:block/parent :block/left :block/format
  476. :block/page :block/file :block/journal?]) new-m)
  477. (wrap-parse-block))
  478. sibling? (when block-self? false)
  479. {:keys [sibling? blocks]} (profile
  480. "outliner insert block"
  481. (outliner-insert-block! config current-block next-block sibling?))
  482. refresh-fn (fn []
  483. (let [opts {:key :block/insert
  484. :data [current-block next-block]}]
  485. (db/refresh! repo opts)))]
  486. (do
  487. (if (or (:ref? config)
  488. (not sibling?)
  489. zooming?)
  490. (refresh-fn)
  491. (do
  492. (profile "update cache " (update-cache-for-block-insert! repo config block blocks))
  493. (state/add-tx! refresh-fn)))
  494. ;; WORKAROUND: The block won't refresh itself even if the content is empty.
  495. (when block-self?
  496. (gobj/set input "value" ""))
  497. (profile "ok handler" (ok-handler next-block)))))
  498. (defn clear-when-saved!
  499. []
  500. (state/set-editor-show-input! nil)
  501. (state/set-editor-show-date-picker! false)
  502. (state/set-editor-show-page-search! false)
  503. (state/set-editor-show-block-search! false)
  504. (state/set-editor-show-template-search! false)
  505. (commands/restore-state true))
  506. (defn get-state
  507. []
  508. (let [[{:keys [on-hide block block-id block-parent-id format sidebar?]} id config] (state/get-editor-args)
  509. node (gdom/getElement id)]
  510. (when node
  511. (let [value (gobj/get node "value")
  512. pos (gobj/get node "selectionStart")]
  513. {:config config
  514. :on-hide on-hide
  515. :sidebar? sidebar?
  516. :format format
  517. :id id
  518. :block (or (db/pull [:block/uuid (:block/uuid block)]) block)
  519. :block-id block-id
  520. :block-parent-id block-parent-id
  521. :node node
  522. :value value
  523. :pos pos}))))
  524. (defn- with-timetracking-properties
  525. [block value]
  526. (let [new-marker (first (util/safe-re-find marker/bare-marker-pattern (or value "")))
  527. new-marker (if new-marker (string/lower-case (string/trim new-marker)))
  528. new-marker? (and
  529. new-marker
  530. (not= new-marker (string/lower-case (or (:block/marker block) "")))
  531. (state/enable-timetracking?))
  532. ts (util/time-ms)
  533. properties (if new-marker?
  534. (assoc (:block/properties block) new-marker ts)
  535. (:block/properties block))
  536. value (or
  537. (when new-marker?
  538. (property/insert-property (:block/format block)
  539. value
  540. new-marker
  541. ts))
  542. value)]
  543. [properties value]))
  544. (defn insert-new-block!
  545. ([state]
  546. (insert-new-block! state nil))
  547. ([state block-value]
  548. (when (and (not config/publishing?)
  549. (not= :insert (state/get-editor-op)))
  550. (state/set-editor-op! :insert)
  551. (when-let [state (get-state)]
  552. (let [{:keys [block value format id config]} state
  553. value (if (string? block-value) block-value value)
  554. block-id (:block/uuid block)
  555. block (or (db/pull [:block/uuid block-id])
  556. block)
  557. repo (or (:block/repo block) (state/get-current-repo))
  558. [properties value] (with-timetracking-properties block value)
  559. block-self? (block-self-alone-when-insert? config block-id)
  560. input (gdom/getElement (state/get-edit-input-id))
  561. pos (cursor/pos input)
  562. repo (or repo (state/get-current-repo))
  563. [fst-block-text snd-block-text] (compute-fst-snd-block-text value pos)
  564. insert-fn (match (mapv boolean [block-self? (seq fst-block-text) (seq snd-block-text)])
  565. [true _ _] insert-new-block-aux!
  566. [_ false true] insert-new-block-before-block-aux!
  567. [_ _ _] insert-new-block-aux!)]
  568. (insert-fn
  569. config
  570. (assoc block :block/properties properties)
  571. value
  572. {:ok-handler
  573. (fn [last-block]
  574. (edit-block! last-block 0 format id)
  575. (clear-when-saved!))}))))
  576. (state/set-editor-op! nil)))
  577. (defn api-insert-new-block!
  578. [content {:keys [page block-uuid sibling? before? properties]
  579. :or {sibling? false
  580. before? false}}]
  581. (when (or page block-uuid)
  582. (let [before? (if page false before?)
  583. sibling? (if before? true (if page false sibling?))
  584. block (if page
  585. (db/entity [:block/name (string/lower-case page)])
  586. (db/entity [:block/uuid block-uuid]))]
  587. (when block
  588. (let [repo (state/get-current-repo)
  589. last-block (when (not sibling?)
  590. (let [children (:block/_parent block)
  591. blocks (db/sort-by-left children block)
  592. last-block-id (:db/id (last blocks))]
  593. (when last-block-id
  594. (db/pull last-block-id))))
  595. new-block (-> (select-keys block [:block/page :block/file :block/journal?
  596. :block/journal-day])
  597. (assoc :block/content content
  598. :block/format (or
  599. (:block/format block)
  600. (db/get-page-format (:db/id block))
  601. :markdown))
  602. (wrap-parse-block)
  603. (assoc :block/uuid (db/new-block-id)))
  604. new-block (if (:block/page new-block)
  605. (assoc new-block :block/page (:db/id (:block/page new-block)))
  606. (assoc new-block :block/page (:db/id block)))
  607. new-block (if-let [db-id (:db/id (:block/file block))]
  608. (assoc new-block :block/file db-id)
  609. new-block)
  610. new-block (if (and (map? properties) (seq properties))
  611. (update new-block :block/properties (fn [m] (merge m properties)))
  612. new-block)]
  613. (let [[block-m sibling?] (cond
  614. before?
  615. (let [block (db/pull (:db/id (:block/left block)))
  616. sibling? (if (:block/name block) false sibling?)]
  617. [block sibling?])
  618. sibling?
  619. [(db/pull (:db/id block)) sibling?]
  620. last-block
  621. [last-block true]
  622. block
  623. [(db/pull (:db/id block)) sibling?]
  624. ;; FIXME: assert
  625. :else
  626. nil)]
  627. (when block-m
  628. (outliner-insert-block! {:skip-save-current-block? true} block-m new-block sibling?)
  629. (ui-handler/re-render-root!))))))))
  630. (defn insert-first-page-block-if-not-exists!
  631. [page-name]
  632. (when (string? page-name)
  633. (when-let [page (db/entity [:block/name (string/lower-case page-name)])]
  634. (when (db/page-empty? (state/get-current-repo) (:db/id page))
  635. (api-insert-new-block! "" {:page page-name})))))
  636. (defn update-timestamps-content!
  637. [{:block/keys [repeated? marker format] :as block} content]
  638. (if repeated?
  639. (let [scheduled-ast (block-handler/get-scheduled-ast block)
  640. deadline-ast (block-handler/get-deadline-ast block)
  641. content (some->> (filter repeated/repeated? [scheduled-ast deadline-ast])
  642. (map (fn [ts]
  643. [(repeated/timestamp->text ts)
  644. (repeated/next-timestamp-text ts)]))
  645. (reduce (fn [content [old new]]
  646. (string/replace content old new))
  647. content))]
  648. (when content
  649. (str (string/trimr content)
  650. "\n"
  651. (util/format (str "*" " %s -> DONE [%s]")
  652. marker
  653. (date/get-local-date-time-string)))))
  654. content))
  655. (defn- with-marker-time
  656. [content format marker]
  657. (if (state/enable-timetracking?)
  658. (let [marker (string/lower-case marker)]
  659. (property/insert-property format content marker (util/time-ms)))
  660. content))
  661. (defn check
  662. [{:block/keys [uuid marker content format repeated?] :as block}]
  663. (let [new-content (string/replace-first content marker "DONE")
  664. new-content (->
  665. (if repeated?
  666. (update-timestamps-content! block content)
  667. new-content)
  668. (with-marker-time format "DONE"))]
  669. (save-block-if-changed! block new-content)))
  670. (defn uncheck
  671. [{:block/keys [uuid marker content format] :as block}]
  672. (let [marker (if (= :now (state/get-preferred-workflow))
  673. "LATER"
  674. "TODO")
  675. new-content (-> (string/replace-first content "DONE" marker)
  676. (with-marker-time format marker))]
  677. (save-block-if-changed! block new-content)))
  678. (defn cycle-todo!
  679. []
  680. (when-let [block (state/get-edit-block)]
  681. (let [edit-input-id (state/get-edit-input-id)
  682. current-input (gdom/getElement edit-input-id)
  683. content (state/get-edit-content)
  684. format (or (db/get-page-format (state/get-current-page))
  685. (state/get-preferred-format))
  686. [new-content marker] (marker/cycle-marker content format (state/get-preferred-workflow))
  687. new-content (string/triml new-content)]
  688. (let [new-pos (commands/compute-pos-delta-when-change-marker
  689. current-input content new-content marker (cursor/pos current-input))]
  690. (state/set-edit-content! edit-input-id new-content)
  691. (cursor/move-cursor-to current-input new-pos)))))
  692. (defn set-marker
  693. [{:block/keys [uuid marker content format properties] :as block} new-marker]
  694. (let [new-content (-> (string/replace-first content (re-pattern (str "^" marker)) new-marker)
  695. (with-marker-time format new-marker))]
  696. (save-block-if-changed! block new-content)))
  697. (defn set-priority
  698. [{:block/keys [uuid marker priority content] :as block} new-priority]
  699. (let [new-content (string/replace-first content
  700. (util/format "[#%s]" priority)
  701. (util/format "[#%s]" new-priority))]
  702. (save-block-if-changed! block new-content)))
  703. (defn delete-block-aux!
  704. [{:block/keys [uuid content repo refs] :as block} children?]
  705. (let [repo (or repo (state/get-current-repo))
  706. block (db/pull repo '[*] [:block/uuid uuid])]
  707. (when block
  708. (->
  709. (outliner-core/block block)
  710. (outliner-core/delete-node children?))
  711. (db/refresh! repo {:key :block/change :data [block]}))))
  712. (defn delete-block!
  713. ([repo e]
  714. (delete-block! repo e true))
  715. ([repo e delete-children?]
  716. (state/set-editor-op! :delete)
  717. (let [{:keys [id block-id block-parent-id value format]} (get-state)]
  718. (when block-id
  719. (let [page-id (:db/id (:block/page (db/entity [:block/uuid block-id])))
  720. page-blocks-count (and page-id (db/get-page-blocks-count repo page-id))]
  721. (when (> page-blocks-count 1)
  722. (let [block (db/entity [:block/uuid block-id])
  723. has-children? (seq (:block/_parent block))
  724. block (db/pull (:db/id block))
  725. left (tree/-get-left (outliner-core/block block))
  726. left-has-children? (and left
  727. (when-let [block-id (:block/uuid (:data left))]
  728. (let [block (db/entity [:block/uuid block-id])]
  729. (seq (:block/_parent block)))))]
  730. (when-not (and has-children? left-has-children?)
  731. (let [block-parent (gdom/getElement block-parent-id)
  732. sibling-block (util/get-prev-block-non-collapsed block-parent)]
  733. (delete-block-aux! block delete-children?)
  734. (when (and repo sibling-block)
  735. (when-let [sibling-block-id (dom/attr sibling-block "blockid")]
  736. (when-let [block (db/pull repo '[*] [:block/uuid (uuid sibling-block-id)])]
  737. (let [original-content (util/trim-safe (:block/content block))
  738. new-value (str original-content " " (string/triml value))
  739. tail-len (count (string/triml value))
  740. pos (max
  741. (if original-content
  742. (utf8/length (utf8/encode original-content))
  743. 0)
  744. 0)]
  745. (edit-block! block pos format id
  746. {:custom-content new-value
  747. :tail-len tail-len
  748. :move-cursor? false}))))))))))))
  749. (state/set-editor-op! nil)))
  750. (defn- get-end-block-parent
  751. [end-block blocks]
  752. (if-let [parent (let [id (:db/id (:block/parent end-block))]
  753. (some (fn [block] (when (= (:db/id block) id) block)) blocks))]
  754. (recur parent blocks)
  755. end-block))
  756. (defn- get-top-level-end-node
  757. [blocks]
  758. (let [end-block (last blocks)
  759. end-block-parent (get-end-block-parent end-block blocks)]
  760. (outliner-core/block end-block-parent)))
  761. (defn- reorder-blocks
  762. [blocks]
  763. (if (<= (count blocks) 1)
  764. blocks
  765. (let [[f s & others] blocks]
  766. (if (= (or (:block/left s)
  767. (:block/parent s))
  768. {:db/id (:db/id f)})
  769. blocks
  770. (reverse blocks)))))
  771. (defn delete-blocks!
  772. [repo block-uuids]
  773. (when (seq block-uuids)
  774. (let [lookup-refs (map (fn [id] [:block/uuid id]) block-uuids)
  775. blocks (db/pull-many repo '[*] lookup-refs)
  776. blocks (reorder-blocks blocks)
  777. start-node (outliner-core/block (first blocks))
  778. end-node (get-top-level-end-node blocks)]
  779. (if (= start-node end-node)
  780. (delete-block-aux! (first blocks) true)
  781. (when (outliner-core/delete-nodes start-node end-node lookup-refs)
  782. (let [opts {:key :block/change
  783. :data blocks}]
  784. (db/refresh! repo opts)
  785. (ui-handler/re-render-root!)))))))
  786. (defn- block-property-aux!
  787. [block-id key value]
  788. (let [block-id (if (string? block-id) (uuid block-id) block-id)
  789. repo (state/get-current-repo)]
  790. (when repo
  791. (when-let [block (db/entity [:block/uuid block-id])]
  792. (let [format (:block/format block)
  793. content (:block/content block)
  794. properties (:block/properties block)
  795. properties (if (nil? value)
  796. (dissoc properties key)
  797. (assoc properties key value))
  798. content (if (nil? value)
  799. (property/remove-property format key content)
  800. (property/insert-property format content key value))
  801. block (outliner-core/block {:block/uuid block-id
  802. :block/properties properties
  803. :block/content content})]
  804. (outliner-core/save-node block)
  805. ;; update editing input content
  806. (when-let [editing-block (state/get-edit-block)]
  807. (and (= (:block/uuid editing-block) block-id)
  808. (state/set-edit-content! (state/get-edit-input-id) content))))))))
  809. (defn remove-block-property!
  810. [block-id key]
  811. (let [key (keyword key)]
  812. (block-property-aux! block-id key nil))
  813. (db/refresh! (state/get-current-repo)
  814. {:key :block/change
  815. :data [(db/pull [:block/uuid block-id])]}))
  816. (defn set-block-property!
  817. [block-id key value]
  818. (let [key (keyword key)]
  819. (block-property-aux! block-id key value))
  820. (db/refresh! (state/get-current-repo)
  821. {:key :block/change
  822. :data [(db/pull [:block/uuid block-id])]}))
  823. (defn set-block-timestamp!
  824. [block-id key value]
  825. (let [key (string/lower-case key)
  826. block-id (if (string? block-id) (uuid block-id) block-id)
  827. key (string/lower-case (str key))
  828. value (str value)]
  829. (when-let [block (db/pull [:block/uuid block-id])]
  830. (let [{:block/keys [content scheduled deadline format]} block
  831. content (or (state/get-edit-content) content)
  832. new-line (str (string/upper-case key) ": " value)
  833. new-content (let [lines (string/split-lines content)
  834. new-lines (map (fn [line]
  835. (if (string/starts-with? (string/lower-case line) key)
  836. new-line
  837. line))
  838. lines)
  839. new-lines (if (not= lines new-lines)
  840. new-lines
  841. (cons (first new-lines) ;; title
  842. (cons
  843. new-line
  844. (rest new-lines))))]
  845. (string/join "\n" new-lines))]
  846. (when (not= content new-content)
  847. (if-let [input-id (state/get-edit-input-id)]
  848. (state/set-edit-content! input-id new-content)
  849. (save-block-if-changed! block new-content)))))))
  850. (defn copy-block-ref!
  851. ([block-id] (copy-block-ref! block-id #(str %)))
  852. ([block-id tap-clipboard]
  853. (let [block (db/entity [:block/uuid block-id])]
  854. (when-not (:block/pre-block? block)
  855. (set-block-property! block-id "id" (str block-id))))
  856. (util/copy-to-clipboard! (tap-clipboard block-id))))
  857. (defn select-block!
  858. [block-uuid]
  859. (when-let [block (-> (str block-uuid)
  860. (js/document.getElementsByClassName)
  861. first)]
  862. (state/exit-editing-and-set-selected-blocks! [block])))
  863. (defn- get-selected-blocks-with-children
  864. []
  865. (when-let [blocks (seq (state/get-selection-blocks))]
  866. (->> (mapcat (fn [block]
  867. (cons block
  868. (array-seq (dom/by-class block "ls-block"))))
  869. blocks)
  870. distinct)))
  871. (defn- blocks-with-level
  872. [blocks]
  873. (let [level-blocks (mapv #(assoc % :level 1) blocks)
  874. level-blocks-map (into {} (mapv (fn [b] [(:db/id b) b]) level-blocks))
  875. [level-blocks-map _]
  876. (reduce (fn [[r state] [id block]]
  877. (if-let [parent-level (get-in state [(:db/id (:block/parent block)) :level])]
  878. [(conj r [id (assoc block :level (inc parent-level))])
  879. (assoc-in state [(:db/id block) :level] (inc parent-level))]
  880. [(conj r [id block])
  881. state]))
  882. [{} level-blocks-map] level-blocks-map)]
  883. level-blocks-map))
  884. (defn- blocks-vec->tree
  885. [blocks]
  886. (let [loc (reduce (fn [loc {:keys [level] :as block}]
  887. (let [loc*
  888. (loop [loc (zip/vector-zip (zip/root loc))
  889. level level]
  890. (if (> level 1)
  891. (if-let [down (zip/rightmost (zip/down loc))]
  892. (let [down-node (zip/node down)]
  893. (if (or (and (vector? down-node)
  894. (>= (:level (first down-node)) (:level block)))
  895. (>= (:level down-node) (:level block)))
  896. down
  897. (recur down (dec level))))
  898. loc)
  899. loc))
  900. loc**
  901. (if (vector? (zip/node loc*))
  902. (zip/append-child loc* block)
  903. (-> loc*
  904. zip/up
  905. (zip/append-child [block])))]
  906. loc**)) (zip/vector-zip []) blocks)]
  907. (clojure.walk/postwalk (fn [e] (if (map? e) (dissoc e :level) e)) (zip/root loc))))
  908. (defn- compose-copied-blocks-contents-&-block-tree
  909. [repo block-ids]
  910. (let [blocks (db-utils/pull-many repo '[*] (mapv (fn [id] [:block/uuid id]) block-ids))
  911. blocks* (flatten
  912. (mapv (fn [b] (if (:collapsed (:block/properties b))
  913. (vec (tree/sort-blocks (db/get-block-children repo (:block/uuid b)) b))
  914. [b])) blocks))
  915. block-ids* (mapv :block/uuid blocks*)
  916. unordered? (:block/unordered (first blocks*))
  917. format (:block/format (first blocks*))
  918. level-blocks-map (blocks-with-level blocks*)
  919. level-blocks-uuid-map (into {} (mapv (fn [b] [(:block/uuid b) b]) (vals level-blocks-map)))
  920. level-blocks (mapv (fn [uuid] (get level-blocks-uuid-map uuid)) block-ids*)
  921. tree (blocks-vec->tree level-blocks)
  922. contents
  923. (mapv (fn [block]
  924. (let [header
  925. (if (and unordered? (= format :markdown))
  926. (str (string/join (repeat (- (:level block) 1) " ")) "-")
  927. (let [header-char (if (= format :markdown) "#" "*")
  928. init-char (if (= format :markdown) "##" "*")]
  929. (str (string/join (repeat (:level block) header-char)) init-char)))]
  930. (str header " " (:block/content block) "\n")))
  931. level-blocks)
  932. content-without-properties
  933. (mapv
  934. (fn [content]
  935. (let [ast (mldoc/->edn content (mldoc/default-config format))
  936. properties-loc
  937. (->> ast
  938. (filterv (fn [[[type _] loc]] (= type "Property_Drawer")))
  939. (mapv second)
  940. first)]
  941. (if properties-loc
  942. (utf8/delete! content (:start_pos properties-loc) (:end_pos properties-loc))
  943. content)))
  944. contents)]
  945. [(string/join content-without-properties) tree]))
  946. (defn copy-selection-blocks
  947. []
  948. (when-let [blocks (seq (get-selected-blocks-with-children))]
  949. (let [repo (dom/attr (first blocks) "repo")
  950. ids (->> (distinct (map #(when-let [id (dom/attr % "blockid")]
  951. (uuid id)) blocks))
  952. (remove nil?))
  953. [content tree] (compose-copied-blocks-contents-&-block-tree repo ids)
  954. block (db/pull [:block/uuid (first ids)])]
  955. (common-handler/copy-to-clipboard-without-id-property! (:block/format block) content)
  956. (state/set-copied-blocks content tree)
  957. (notification/show! "Copied!" :success))))
  958. (defn cut-selection-blocks
  959. [copy?]
  960. (when copy? (copy-selection-blocks))
  961. (when-let [blocks (seq (get-selected-blocks-with-children))]
  962. ;; remove embeds and references
  963. (let [blocks (remove (fn [block] (= "true" (dom/attr block "data-transclude"))) blocks)]
  964. (when (seq blocks)
  965. (let [repo (dom/attr (first blocks) "repo")
  966. ids (distinct (map #(uuid (dom/attr % "blockid")) blocks))]
  967. (delete-blocks! repo ids))))))
  968. (defn- get-nearest-page
  969. []
  970. (when-let [block (state/get-edit-block)]
  971. (when-let [id (:block/uuid block)]
  972. (when-let [edit-id (state/get-edit-input-id)]
  973. (when-let [input (gdom/getElement edit-id)]
  974. (when-let [pos (cursor/pos input)]
  975. (let [value (gobj/get input "value")
  976. page-pattern #"\[\[([^\]]+)]]"
  977. block-pattern #"\(\(([^\)]+)\)\)"
  978. page-matches (util/re-pos page-pattern value)
  979. block-matches (util/re-pos block-pattern value)
  980. matches (->> (concat page-matches block-matches)
  981. (remove nil?))
  982. [_ page] (first (sort-by
  983. (fn [[start-pos content]]
  984. (let [end-pos (+ start-pos (count content))]
  985. (cond
  986. (< pos start-pos)
  987. (- pos start-pos)
  988. (> pos end-pos)
  989. (- end-pos pos)
  990. :else
  991. 0)))
  992. >
  993. matches))]
  994. (when page
  995. (subs page 2 (- (count page) 2))))))))))
  996. (defn follow-link-under-cursor!
  997. []
  998. (when-let [page (get-nearest-page)]
  999. (let [page-name (string/lower-case page)]
  1000. (state/clear-edit!)
  1001. (route-handler/redirect! {:to :page
  1002. :path-params {:name page-name}}))))
  1003. (defn open-link-in-sidebar!
  1004. []
  1005. (when-let [page (get-nearest-page)]
  1006. (let [page-name (string/lower-case page)
  1007. block? (util/uuid-string? page-name)]
  1008. (when-let [page (db/get-page page-name)]
  1009. (if block?
  1010. (state/sidebar-add-block!
  1011. (state/get-current-repo)
  1012. (:db/id page)
  1013. :block
  1014. page)
  1015. (state/sidebar-add-block!
  1016. (state/get-current-repo)
  1017. (:db/id page)
  1018. :page
  1019. {:page page}))))))
  1020. (defn zoom-in! []
  1021. (if (state/editing?)
  1022. (when-let [id (some-> (state/get-edit-block)
  1023. :block/uuid
  1024. ((fn [id] [:block/uuid id]))
  1025. db/entity
  1026. :block/uuid)]
  1027. (let [pos (state/get-edit-pos)]
  1028. (route-handler/redirect! {:to :page
  1029. :path-params {:name (str id)}})
  1030. (edit-block! {:block/uuid id} pos nil id)))
  1031. (js/window.history.forward)))
  1032. (defn zoom-out!
  1033. []
  1034. (if (state/editing?)
  1035. (let [page (state/get-current-page)
  1036. block-id (and
  1037. (string? page)
  1038. (util/uuid-string? page)
  1039. (medley/uuid page))]
  1040. (when block-id
  1041. (let [block-parent (db/get-block-parent block-id)]
  1042. (if-let [id (and
  1043. (nil? (:block/name block-parent))
  1044. (:block/uuid block-parent))]
  1045. (do
  1046. (route-handler/redirect! {:to :page
  1047. :path-params {:name (str id)}})
  1048. (edit-block! {:block/uuid block-id} :max nil block-id))
  1049. (let [page-id (some-> (db/entity [:block/uuid block-id])
  1050. :block/page
  1051. :db/id)]
  1052. (when-let [page-name (:block/name (db/entity page-id))]
  1053. (route-handler/redirect! {:to :page
  1054. :path-params {:name page-name}})
  1055. (edit-block! {:block/uuid block-id} :max nil block-id)))))))
  1056. (js/window.history.back)))
  1057. (defn cut-block!
  1058. [block-id]
  1059. (when-let [block (db/pull [:block/uuid block-id])]
  1060. (let [content (:block/content block)]
  1061. (common-handler/copy-to-clipboard-without-id-property! (:block/format block) content)
  1062. (delete-block-aux! block true))))
  1063. (defn clear-last-selected-block!
  1064. []
  1065. (let [block (state/drop-last-selection-block!)]
  1066. (util/select-unhighlight! [block])))
  1067. (defn input-start-or-end?
  1068. ([input]
  1069. (input-start-or-end? input nil))
  1070. ([input up?]
  1071. (let [value (gobj/get input "value")
  1072. start (gobj/get input "selectionStart")
  1073. end (gobj/get input "selectionEnd")]
  1074. (if (nil? up?)
  1075. (or (= start 0) (= end (count value)))
  1076. (or (and (= start 0) up?)
  1077. (and (= end (count value)) (not up?)))))))
  1078. (defn highlight-selection-area!
  1079. [end-block]
  1080. (when-let [start-block (state/get-selection-start-block)]
  1081. (let [blocks (util/get-nodes-between-two-nodes start-block end-block "ls-block")
  1082. direction (util/get-direction-between-two-nodes start-block end-block "ls-block")
  1083. blocks (if (= :up direction)
  1084. (reverse blocks)
  1085. blocks)]
  1086. (state/exit-editing-and-set-selected-blocks! blocks direction))))
  1087. (defn on-select-block
  1088. [direction]
  1089. (fn [e]
  1090. (cond
  1091. ;; when editing, quit editing and select current block
  1092. (state/editing?)
  1093. (state/exit-editing-and-set-selected-blocks! [(gdom/getElement (state/get-editing-block-dom-id))])
  1094. ;; when selection and one block selected, select next block
  1095. (and (state/selection?) (== 1 (count (state/get-selection-blocks))))
  1096. (let [f (if (= :up direction) util/get-prev-block-non-collapsed util/get-next-block-non-collapsed-skip)
  1097. element (f (first (state/get-selection-blocks)))]
  1098. (when element
  1099. (state/conj-selection-block! element direction)))
  1100. ;; if same direction, keep conj on same direction
  1101. (and (state/selection?) (= direction (state/get-selection-direction)))
  1102. (let [f (if (= :up direction) util/get-prev-block-non-collapsed util/get-next-block-non-collapsed-skip)
  1103. first-last (if (= :up direction) first last)
  1104. element (f (first-last (state/get-selection-blocks)))]
  1105. (when element
  1106. (state/conj-selection-block! element direction)))
  1107. ;; if different direction, keep clear until one left
  1108. (state/selection?)
  1109. (clear-last-selected-block!))))
  1110. (defn save-block-aux!
  1111. [block value format opts]
  1112. (let [value (string/trim value)
  1113. [properties value] (with-timetracking-properties block value)]
  1114. ;; FIXME: somehow frontend.components.editor's will-unmount event will loop forever
  1115. ;; maybe we shouldn't save the block/file in "will-unmount" event?
  1116. (save-block-if-changed! block value
  1117. (merge
  1118. {:init-properties properties}
  1119. opts))))
  1120. (defn save-block!
  1121. ([repo block-or-uuid content]
  1122. (let [block (if (or (uuid? block-or-uuid)
  1123. (string? block-or-uuid))
  1124. (db-model/query-block-by-uuid block-or-uuid) block-or-uuid)
  1125. format (:block/format block)]
  1126. (save-block! {:block block :repo repo :format format} content)))
  1127. ([{:keys [format block repo] :as state} value]
  1128. (when (:db/id (db/entity repo [:block/uuid (:block/uuid block)]))
  1129. (save-block-aux! block value format {}))))
  1130. (defn save-current-block!
  1131. ([]
  1132. (save-current-block! {}))
  1133. ([{:keys [force?] :as opts}]
  1134. ;; non English input method
  1135. (when-not (state/editor-in-composition?)
  1136. (when-let [repo (state/get-current-repo)]
  1137. (when (and (not @commands/*show-commands)
  1138. (not @commands/*show-block-commands)
  1139. (not (state/get-editor-show-page-search?))
  1140. (not (state/get-editor-show-page-search-hashtag?))
  1141. (not (state/get-editor-show-block-search?))
  1142. (not (state/get-editor-show-date-picker?))
  1143. (not (state/get-editor-show-template-search?))
  1144. (not (state/get-editor-show-input)))
  1145. (try
  1146. (let [input-id (state/get-edit-input-id)
  1147. block (state/get-edit-block)
  1148. db-block (when-let [block-id (:block/uuid block)]
  1149. (db/pull [:block/uuid block-id]))
  1150. elem (and input-id (gdom/getElement input-id))
  1151. db-content (:block/content db-block)
  1152. db-content-without-heading (and db-content
  1153. (util/safe-subs db-content (:block/level db-block)))
  1154. value (and elem (gobj/get elem "value"))]
  1155. (cond
  1156. force?
  1157. (save-block-aux! db-block value (:block/format db-block) opts)
  1158. (and block value db-content-without-heading
  1159. (or
  1160. (not= (string/trim db-content-without-heading)
  1161. (string/trim value))))
  1162. (save-block-aux! db-block value (:block/format db-block) opts)))
  1163. (catch js/Error error
  1164. (log/error :save-block-failed error))))))))
  1165. (defn- clean-content!
  1166. [format content]
  1167. (->> (text/remove-level-spaces content format)
  1168. (property/remove-properties format)
  1169. string/trim))
  1170. (defn insert-command!
  1171. [id command-output format {:keys [restore?]
  1172. :or {restore? true}
  1173. :as option}]
  1174. (cond
  1175. ;; replace string
  1176. (string? command-output)
  1177. (commands/insert! id command-output option)
  1178. ;; steps
  1179. (vector? command-output)
  1180. (commands/handle-steps command-output format)
  1181. (fn? command-output)
  1182. (let [s (command-output)]
  1183. (commands/insert! id s option))
  1184. :else
  1185. nil)
  1186. (when restore?
  1187. (let [restore-slash-caret-pos? (if (and
  1188. (seq? command-output)
  1189. (= :editor/click-hidden-file-input
  1190. (ffirst command-output)))
  1191. false
  1192. true)]
  1193. (commands/restore-state restore-slash-caret-pos?))))
  1194. (defn- get-asset-file-link
  1195. [format url file-name image?]
  1196. (case (keyword format)
  1197. :markdown (util/format (str (when image? "!") "[%s](%s)") file-name url)
  1198. :org (if image?
  1199. (util/format "[[%s]]" url)
  1200. (util/format "[[%s][%s]]" url file-name))
  1201. nil))
  1202. (defn- get-asset-link
  1203. [url]
  1204. (str "/" url))
  1205. (defn ensure-assets-dir!
  1206. [repo]
  1207. (let [repo-dir (config/get-repo-dir repo)
  1208. assets-dir "assets"]
  1209. (p/then
  1210. (fs/mkdir-if-not-exists (str repo-dir "/" assets-dir))
  1211. (fn [] [repo-dir assets-dir]))))
  1212. (defn save-assets!
  1213. ([{block-id :block/uuid} repo files]
  1214. (p/let [[repo-dir assets-dir] (ensure-assets-dir! repo)]
  1215. (save-assets! repo repo-dir assets-dir files
  1216. (fn [index file-base]
  1217. ;; TODO: maybe there're other chars we need to handle?
  1218. (let [file-base (-> file-base
  1219. (string/replace " " "_")
  1220. (string/replace "%" "_")
  1221. (string/replace "/" "_"))
  1222. file-name (str file-base "_" (.now js/Date) "_" index)]
  1223. (string/replace file-name #"_+" "_"))))))
  1224. ([repo dir path files gen-filename]
  1225. (p/all
  1226. (for [[index ^js file] (map-indexed vector files)]
  1227. (do
  1228. ;; WARN file name maybe fully qualified path when paste file
  1229. (let [file-name (util/node-path.basename (.-name file))
  1230. [file-base ext] (if file-name
  1231. (let [last-dot-index (string/last-index-of file-name ".")]
  1232. [(subs file-name 0 last-dot-index)
  1233. (subs file-name last-dot-index)])
  1234. ["" ""])
  1235. filename (str (gen-filename index file-base) ext)
  1236. filename (str path "/" filename)]
  1237. ;(js/console.debug "Write asset #" dir filename file)
  1238. (if (util/electron?)
  1239. (let [from (.-path file)]
  1240. (p/then (js/window.apis.copyFileToAssets dir filename from)
  1241. #(p/resolved [filename (if (string? %) (js/File. #js[] %) file) (.join util/node-path dir filename)])))
  1242. (p/then (fs/write-file! repo dir filename (.stream file) nil)
  1243. #(p/resolved [filename file])))))))))
  1244. (defonce *assets-url-cache (atom {}))
  1245. (defn make-asset-url
  1246. [path] ;; path start with "/assets" or compatible for "../assets"
  1247. (let [repo-dir (config/get-repo-dir (state/get-current-repo))
  1248. path (string/replace path "../" "/")]
  1249. (if (util/electron?)
  1250. (str "assets://" repo-dir path)
  1251. (let [handle-path (str "handle" repo-dir path)
  1252. cached-url (get @*assets-url-cache (keyword handle-path))]
  1253. (if cached-url
  1254. (p/resolved cached-url)
  1255. (p/let [handle (frontend.idb/get-item handle-path)
  1256. file (and handle (.getFile handle))]
  1257. (when file
  1258. (p/let [url (js/URL.createObjectURL file)]
  1259. (swap! *assets-url-cache assoc (keyword handle-path) url)
  1260. url))))))))
  1261. (defn delete-asset-of-block!
  1262. [{:keys [repo href title full-text block-id local? delete-local?] :as opts}]
  1263. (let [block (db-model/query-block-by-uuid block-id)
  1264. _ (or block (throw (str block-id " not exists")))
  1265. format (:block/format block)
  1266. text (:block/content block)
  1267. content (string/replace text full-text "")]
  1268. (save-block! repo block content)
  1269. (when (and local? delete-local?)
  1270. ;; FIXME: should be relative to current block page path
  1271. (when-let [href (if (util/electron?) href (second (re-find #"\((.+)\)$" full-text)))]
  1272. (fs/unlink! (config/get-repo-path
  1273. repo (-> href
  1274. (string/replace #"^../" "/")
  1275. (string/replace #"^assets://" ""))) nil)))))
  1276. ;; assets/journals_2021_02_03_1612350230540_0.png
  1277. (defn resolve-relative-path
  1278. [file-path]
  1279. (if-let [current-file (or (some-> (state/get-edit-block)
  1280. :block/file
  1281. :db/id
  1282. (db/entity)
  1283. :file/path)
  1284. ;; fix dummy file path of page
  1285. (and (util/electron?)
  1286. (util/node-path.join
  1287. (config/get-repo-dir (state/get-current-repo))
  1288. (config/get-pages-directory) "_.md")))]
  1289. (util/get-relative-path current-file file-path)
  1290. file-path))
  1291. (defn upload-asset
  1292. [id ^js files format uploading? drop-or-paste?]
  1293. (let [repo (state/get-current-repo)
  1294. block (state/get-edit-block)]
  1295. (if (config/local-db? repo)
  1296. (-> (save-assets! block repo (js->clj files))
  1297. (p/then
  1298. (fn [res]
  1299. (when-let [[asset-file-name file full-file-path] (and (seq res) (first res))]
  1300. (let [image? (util/ext-of-image? asset-file-name)]
  1301. (insert-command!
  1302. id
  1303. (get-asset-file-link format (resolve-relative-path (or full-file-path asset-file-name))
  1304. (if file (.-name file) (if image? "image" "asset"))
  1305. image?)
  1306. format
  1307. {:last-pattern (if drop-or-paste? "" commands/slash)
  1308. :restore? true})))))
  1309. (p/finally
  1310. (fn []
  1311. (reset! uploading? false)
  1312. (reset! *asset-uploading? false)
  1313. (reset! *asset-uploading-process 0))))
  1314. (image/upload
  1315. files
  1316. (fn [file file-name file-type]
  1317. (image-handler/request-presigned-url
  1318. file file-name file-type
  1319. uploading?
  1320. (fn [signed-url]
  1321. (insert-command! id
  1322. (get-asset-file-link format signed-url file-name true)
  1323. format
  1324. {:last-pattern (if drop-or-paste? "" commands/slash)
  1325. :restore? true})
  1326. (reset! *asset-uploading? false)
  1327. (reset! *asset-uploading-process 0))
  1328. (fn [e]
  1329. (let [process (* (/ (gobj/get e "loaded")
  1330. (gobj/get e "total"))
  1331. 100)]
  1332. (reset! *asset-uploading? false)
  1333. (reset! *asset-uploading-process process)))))))))
  1334. (defn set-asset-pending-file [file]
  1335. (reset! *asset-pending-file file))
  1336. ;; Editor should track some useful information, like editor modes.
  1337. ;; For example:
  1338. ;; 1. Which file format is it, markdown or org mode?
  1339. ;; 2. Is it in the properties area? Then we can enable the ":" autopair
  1340. (def autopair-map
  1341. {"[" "]"
  1342. "{" "}"
  1343. "(" ")"
  1344. "`" "`"
  1345. "~" "~"
  1346. "*" "*"
  1347. ;; "_" "_"
  1348. ;; ":" ":" ; TODO: only properties editing and org mode tag
  1349. ;; "^" "^"
  1350. })
  1351. (def reversed-autopair-map
  1352. (zipmap (vals autopair-map)
  1353. (keys autopair-map)))
  1354. (def delete-map
  1355. (assoc autopair-map
  1356. "$" "$"
  1357. ":" ":"))
  1358. (def reversed-delete-map
  1359. (zipmap (vals delete-map)
  1360. (keys delete-map)))
  1361. (defn autopair
  1362. [input-id prefix format {:keys [restore?]
  1363. :or {restore? true}
  1364. :as option}]
  1365. (let [value (get autopair-map prefix)
  1366. selected (util/get-selected-text)
  1367. postfix (str selected value)
  1368. value (str prefix postfix)
  1369. input (gdom/getElement input-id)]
  1370. (when value
  1371. (when-not (string/blank? selected) (reset! *selected-text selected))
  1372. (let [[prefix pos] (commands/simple-replace! input-id value selected
  1373. {:backward-pos (count postfix)
  1374. :check-fn (fn [new-value prefix-pos]
  1375. (when (>= prefix-pos 0)
  1376. [(subs new-value prefix-pos (+ prefix-pos 2))
  1377. (+ prefix-pos 2)]))})]
  1378. (case prefix
  1379. "[["
  1380. (do
  1381. (commands/handle-step [:editor/search-page])
  1382. (reset! commands/*slash-caret-pos (cursor/get-caret-pos input)))
  1383. "(("
  1384. (do
  1385. (commands/handle-step [:editor/search-block :reference])
  1386. (reset! commands/*slash-caret-pos (cursor/get-caret-pos input)))
  1387. nil)))))
  1388. (defn surround-by?
  1389. [input before after]
  1390. (when input
  1391. (let [value (gobj/get input "value")
  1392. pos (cursor/pos input)
  1393. start-pos (if (= :start before) 0 (- pos (count before)))
  1394. end-pos (if (= :end after) (count value) (+ pos (count after)))]
  1395. (when (>= (count value) end-pos)
  1396. (= (cond
  1397. (and (= :end after) (= :start before))
  1398. ""
  1399. (= :end after)
  1400. before
  1401. (= :start before)
  1402. after
  1403. :else
  1404. (str before after))
  1405. (subs value start-pos end-pos))))))
  1406. (defn get-matched-pages
  1407. [q]
  1408. (let [block (state/get-edit-block)
  1409. editing-page (and block
  1410. (when-let [page-id (:db/id (:block/page block))]
  1411. (:block/name (db/entity page-id))))]
  1412. (let [pages (search/page-search q 20)]
  1413. (if editing-page
  1414. ;; To prevent self references
  1415. (remove (fn [p] (= (string/lower-case p) editing-page)) pages)
  1416. pages))))
  1417. (defn get-matched-blocks
  1418. [q block-id]
  1419. ;; remove current block
  1420. (let [current-block (state/get-edit-block)
  1421. block-parents (set (->> (db/get-block-parents (state/get-current-repo)
  1422. block-id
  1423. 99)
  1424. (map (comp str :block/uuid))))
  1425. current-and-parents (set/union #{(str (:block/uuid current-block))} block-parents)]
  1426. (p/let [result (search/block-search (state/get-current-repo) q {:limit 20})]
  1427. (remove
  1428. (fn [h]
  1429. (contains? current-and-parents (:block/uuid h)))
  1430. result))))
  1431. (defn get-matched-templates
  1432. [q]
  1433. (search/template-search q))
  1434. (defn get-matched-commands
  1435. [input]
  1436. (try
  1437. (let [edit-content (or (gobj/get input "value") "")
  1438. pos (cursor/pos input)
  1439. last-slash-caret-pos (:pos @*slash-caret-pos)
  1440. last-command (and last-slash-caret-pos (subs edit-content last-slash-caret-pos pos))]
  1441. (when (> pos 0)
  1442. (or
  1443. (and (= \/ (util/nth-safe edit-content (dec pos)))
  1444. @commands/*initial-commands)
  1445. (and last-command
  1446. (commands/get-matched-commands last-command)))))
  1447. (catch js/Error e
  1448. (js/console.error e)
  1449. nil)))
  1450. (defn get-matched-block-commands
  1451. [input]
  1452. (try
  1453. (let [edit-content (gobj/get input "value")
  1454. pos (cursor/pos input)
  1455. last-command (subs edit-content
  1456. (:pos @*angle-bracket-caret-pos)
  1457. pos)]
  1458. (when (> pos 0)
  1459. (or
  1460. (and (= \< (util/nth-safe edit-content (dec pos)))
  1461. (commands/block-commands-map))
  1462. (and last-command
  1463. (commands/get-matched-commands
  1464. last-command
  1465. (commands/block-commands-map))))))
  1466. (catch js/Error e
  1467. nil)))
  1468. (defn auto-complete?
  1469. []
  1470. (or @*show-commands
  1471. @*show-block-commands
  1472. @*asset-uploading?
  1473. (= (gdom/getElement "search-field")
  1474. (.-activeElement js/document))
  1475. (state/get-editor-show-input)
  1476. (state/get-editor-show-page-search?)
  1477. (state/get-editor-show-block-search?)
  1478. (state/get-editor-show-template-search?)
  1479. (state/get-editor-show-date-picker?)))
  1480. (defn get-previous-input-char
  1481. [input]
  1482. (when-let [pos (cursor/pos input)]
  1483. (let [value (gobj/get input "value")]
  1484. (when (and (>= (count value) pos)
  1485. (>= pos 1))
  1486. (util/nth-safe value (- pos 1))))))
  1487. (defn get-previous-input-chars
  1488. [input length]
  1489. (when-let [pos (cursor/pos input)]
  1490. (let [value (gobj/get input "value")]
  1491. (when (and (>= (count value) pos)
  1492. (>= pos 1))
  1493. (subs value (- pos length) pos)))))
  1494. (defn get-current-input-char
  1495. [input]
  1496. (when-let [pos (cursor/pos input)]
  1497. (let [value (gobj/get input "value")]
  1498. (when (and (>= (count value) (inc pos))
  1499. (>= pos 1))
  1500. (util/nth-safe value pos)))))
  1501. (defn append-paste-doc!
  1502. [format event]
  1503. (let [[html text] (util/get-clipboard-as-html event)]
  1504. (when-not (util/starts-with? (string/trim text) "http")
  1505. (let [doc-text (html-parser/parse format html)]
  1506. (when-not (string/blank? doc-text)
  1507. (util/stop event)
  1508. (state/append-current-edit-content! doc-text))))))
  1509. (defn- block-and-children-content
  1510. [block-children]
  1511. (-> (map :block/content block-children)
  1512. string/join))
  1513. (defn move-up-down
  1514. [up?]
  1515. (fn [e]
  1516. (when-let [block-id (:block/uuid (state/get-edit-block))]
  1517. (when-let [block (db/pull [:block/uuid block-id])]
  1518. (outliner-core/move-node (outliner-core/block block) up?)
  1519. (when-let [repo (state/get-current-repo)]
  1520. (let [opts {:key :block/change
  1521. :data [block]}]
  1522. (db/refresh! repo opts)))
  1523. (when-let [block-node (util/get-first-block-by-id block-id)]
  1524. (.scrollIntoView block-node #js {:behavior "smooth" :block "center"}))))))
  1525. ;; selections
  1526. (defn on-tab
  1527. "direction = :left|:right, only indent or outdent when blocks are siblings"
  1528. [direction]
  1529. (when-let [repo (state/get-current-repo)]
  1530. (let [blocks-dom-nodes (state/get-selection-blocks)
  1531. blocks (seq blocks-dom-nodes)]
  1532. (cond
  1533. (seq blocks)
  1534. (do
  1535. (let [lookup-refs (->> (map (fn [block] (when-let [id (dom/attr block "blockid")]
  1536. [:block/uuid (medley/uuid id)])) blocks)
  1537. (remove nil?))
  1538. blocks (db/pull-many repo '[*] lookup-refs)
  1539. blocks (reorder-blocks blocks)
  1540. end-node (get-top-level-end-node blocks)
  1541. end-node-parent (tree/-get-parent end-node)
  1542. top-level-nodes (->> (filter #(= (get-in end-node-parent [:data :db/id])
  1543. (get-in % [:block/parent :db/id])) blocks)
  1544. (map outliner-core/block))]
  1545. (outliner-core/indent-outdent-nodes top-level-nodes (= direction :right))
  1546. (let [opts {:key :block/change
  1547. :data blocks}]
  1548. (db/refresh! repo opts)
  1549. (let [blocks (doall
  1550. (map
  1551. (fn [block]
  1552. (when-let [id (gobj/get block "id")]
  1553. (when-let [block (gdom/getElement id)]
  1554. (dom/add-class! block "selected noselect")
  1555. block)))
  1556. blocks-dom-nodes))]
  1557. (state/set-selection-blocks! blocks)))))))))
  1558. (defn- get-link
  1559. [format link label]
  1560. (let [link (or link "")
  1561. label (or label "")]
  1562. (case (keyword format)
  1563. :markdown (util/format "[%s](%s)" label link)
  1564. :org (util/format "[[%s][%s]]" link label)
  1565. nil)))
  1566. (defn handle-command-input
  1567. [command id format m pos]
  1568. (case command
  1569. :link
  1570. (let [{:keys [link label]} m]
  1571. (if (and (string/blank? link)
  1572. (string/blank? label))
  1573. nil
  1574. (insert-command! id
  1575. (get-link format link label)
  1576. format
  1577. {:last-pattern (str commands/slash "link")})))
  1578. nil)
  1579. (state/set-editor-show-input! nil)
  1580. (when-let [saved-cursor (get @state/state :editor/last-saved-cursor)]
  1581. (when-let [input (gdom/getElement id)]
  1582. (.focus input)
  1583. (cursor/move-cursor-to input saved-cursor))))
  1584. (defn get-search-q
  1585. []
  1586. (when-let [id (state/get-edit-input-id)]
  1587. (when-let [input (gdom/getElement id)]
  1588. (let [current-pos (cursor/pos input)
  1589. pos (:editor/last-saved-cursor @state/state)
  1590. edit-content (or (state/sub [:editor/content id]) "")]
  1591. (or
  1592. @*selected-text
  1593. (util/safe-subs edit-content pos current-pos))))))
  1594. (defn close-autocomplete-if-outside
  1595. [input]
  1596. (when (and input
  1597. (or (state/get-editor-show-page-search?)
  1598. (state/get-editor-show-page-search-hashtag?)
  1599. (state/get-editor-show-block-search?)))
  1600. (when-let [q (get-search-q)]
  1601. (let [value (gobj/get input "value")
  1602. pos (:editor/last-saved-cursor @state/state)
  1603. current-pos (cursor/pos input)]
  1604. (when (or (< current-pos pos)
  1605. (string/includes? q "]")
  1606. (string/includes? q ")"))
  1607. (state/set-editor-show-block-search! false)
  1608. (state/set-editor-show-page-search! false)
  1609. (state/set-editor-show-page-search-hashtag! false))))))
  1610. (defn save!
  1611. []
  1612. (when-let [repo (state/get-current-repo)]
  1613. (save-current-block!)
  1614. (when (string/starts-with? repo "https://") ; git repo
  1615. (repo-handler/auto-push!))))
  1616. (defn resize-image!
  1617. [block-id metadata full_text size]
  1618. (let [new-meta (merge metadata size)
  1619. image-part (first (string/split full_text #"\{"))
  1620. new-full-text (str image-part (pr-str new-meta))
  1621. block (db/pull [:block/uuid block-id])
  1622. value (:block/content block)
  1623. new-value (string/replace value full_text new-full-text)]
  1624. (save-block-aux! block new-value (:block/format block) {})))
  1625. (defn- mark-last-input-time!
  1626. [repo]
  1627. (when repo
  1628. (state/set-editor-last-input-time! repo (util/time-ms))
  1629. (db/clear-repo-persistent-job! repo)))
  1630. (defonce *auto-save-timeout (atom nil))
  1631. (defn edit-box-on-change!
  1632. [e block id]
  1633. (let [value (util/evalue e)
  1634. repo (or (:block/repo block)
  1635. (state/get-current-repo))]
  1636. (state/set-edit-content! id value false)
  1637. (when @*auto-save-timeout
  1638. (js/clearTimeout @*auto-save-timeout))
  1639. (mark-last-input-time! repo)
  1640. (reset! *auto-save-timeout
  1641. (js/setTimeout
  1642. (fn []
  1643. (when (state/input-idle? repo)
  1644. (state/set-editor-op! :auto-save)
  1645. (save-current-block! {})
  1646. (state/set-editor-op! nil)))
  1647. 500))))
  1648. (defn handle-last-input []
  1649. (let [input (state/get-input)
  1650. pos (cursor/pos input)
  1651. last-input-char (util/nth-safe (.-value input) (dec pos))]
  1652. (case last-input-char
  1653. "/"
  1654. ;; TODO: is it cross-browser compatible?
  1655. ;; (not= (gobj/get native-e "inputType") "insertFromPaste")
  1656. (when (seq (get-matched-commands input))
  1657. (reset! commands/*slash-caret-pos (cursor/get-caret-pos input))
  1658. (reset! commands/*show-commands true))
  1659. "<"
  1660. (when (seq (get-matched-block-commands input))
  1661. (reset! commands/*angle-bracket-caret-pos (cursor/get-caret-pos input))
  1662. (reset! commands/*show-block-commands true))
  1663. nil)))
  1664. (defn block-on-chosen-handler
  1665. [input id q format]
  1666. (fn [chosen _click?]
  1667. (state/set-editor-show-block-search! false)
  1668. (let [uuid-string (str (:block/uuid chosen))]
  1669. ;; block reference
  1670. (insert-command! id
  1671. (util/format "((%s))" uuid-string)
  1672. format
  1673. {:last-pattern (str "((" (if @*selected-text "" q))
  1674. :postfix-fn (fn [s] (util/replace-first "))" s ""))})
  1675. ;; Save it so it'll be parsed correctly in the future
  1676. (set-block-property! (:block/uuid chosen)
  1677. :id
  1678. uuid-string)
  1679. (when-let [input (gdom/getElement id)]
  1680. (.focus input)))))
  1681. (defn block-non-exist-handler
  1682. [input]
  1683. (fn []
  1684. (state/set-editor-show-block-search! false)
  1685. (cursor/move-cursor-forward input 2)))
  1686. (defn get-block-tree-insert-pos-after-target
  1687. "return [target-block sibling? delete-editing-block? editing-block]"
  1688. ([target-block-id sibling?]
  1689. (get-block-tree-insert-pos-after-target target-block-id sibling? nil))
  1690. ([target-block-id sibling? editing-block]
  1691. (when-let [target-block (db/pull target-block-id)]
  1692. [target-block sibling? false (or editing-block target-block)])))
  1693. (defn- get-block-tree-insert-pos-at-point
  1694. "return [target-block sibling? delete-editing-block? editing-block]"
  1695. []
  1696. (when-let [editing-block (db/pull (:db/id (state/get-edit-block)))]
  1697. (let [input (gdom/getElement (state/get-edit-input-id))
  1698. pos (cursor/pos input)
  1699. value (:value (get-state))
  1700. [fst-block-text snd-block-text] (compute-fst-snd-block-text value pos)
  1701. parent (:db/id (:block/parent editing-block))
  1702. parent-block (db/pull parent)
  1703. left (:db/id (:block/left editing-block))
  1704. left-block (db/pull left)
  1705. [_ _ config] (state/get-editor-args)
  1706. block-id (:block/uuid editing-block)
  1707. block-self? (block-self-alone-when-insert? config block-id)
  1708. has-children? (db/has-children? (state/get-current-repo)
  1709. (:block/uuid editing-block))
  1710. collapsed? (:collapsed (:block/properties editing-block))]
  1711. (conj (match (mapv boolean [(seq fst-block-text) (seq snd-block-text)
  1712. block-self? has-children? (= parent left) collapsed?])
  1713. ;; when zoom at editing-block
  1714. [_ _ true _ _ _]
  1715. [editing-block false false]
  1716. ;; insert after editing-block
  1717. [true _ false true _ false]
  1718. [editing-block false false]
  1719. [true _ false true _ true]
  1720. [editing-block true false]
  1721. [true _ false false _ _]
  1722. [editing-block true false]
  1723. [false false false true _ false]
  1724. [editing-block false false]
  1725. [false false false true _ true]
  1726. [editing-block true false]
  1727. [false false false false _ _]
  1728. [editing-block true true]
  1729. ;; insert before editing-block
  1730. [false true false _ true _]
  1731. [parent-block false false]
  1732. [false true false _ false _]
  1733. [left-block true false])
  1734. editing-block))))
  1735. (defn- paste-block-tree-at-point-edit-aux
  1736. [uuid file page exclude-properties format content-update-fn]
  1737. (fn [block]
  1738. (outliner-core/block
  1739. (let [[new-content new-title]
  1740. (if content-update-fn
  1741. (let [new-content (content-update-fn (:block/content block))
  1742. new-title (or (->> (mldoc/->edn
  1743. (str (case format
  1744. :markdown "- "
  1745. :org "* ")
  1746. (if (seq (:block/title block)) "" "\n")
  1747. new-content)
  1748. (mldoc/default-config format))
  1749. (ffirst)
  1750. (second)
  1751. (:title))
  1752. (:block/title block))]
  1753. [new-content new-title])
  1754. [(:block/content block) (:block/title block)])
  1755. new-content
  1756. (->> new-content
  1757. (property/remove-property format "id")
  1758. (property/remove-property format "custom_id"))
  1759. m (merge (dissoc block
  1760. :block/pre-block?
  1761. :block/uuid
  1762. :db/id
  1763. :block/left
  1764. :block/parent
  1765. :block/file)
  1766. {:block/uuid uuid
  1767. :block/page (select-keys page [:db/id])
  1768. :block/format format
  1769. :block/properties (apply dissoc (:block/properties block)
  1770. (concat [:id :custom_id :custom-id]
  1771. exclude-properties))
  1772. :block/meta (dissoc (:block/meta block) :start-pos :end-pos)
  1773. :block/content new-content
  1774. :block/title new-title
  1775. :block/path-refs (->> (cons (:db/id page) (:block/path-refs block))
  1776. (remove nil?))})]
  1777. (if file
  1778. (assoc m :block/file (select-keys file [:db/id]))
  1779. m)))))
  1780. (defn paste-block-vec-tree-at-target
  1781. ([tree exclude-properties]
  1782. (paste-block-vec-tree-at-target tree exclude-properties nil nil nil))
  1783. ([tree exclude-properties content-update-fn]
  1784. (paste-block-vec-tree-at-target tree exclude-properties content-update-fn nil nil))
  1785. ([tree exclude-properties content-update-fn get-pos-fn page-block]
  1786. (let [repo (state/get-current-repo)
  1787. page (or page-block
  1788. (:block/page (db/entity (:db/id (state/get-edit-block)))))
  1789. file (:block/file page)]
  1790. (when-let [[target-block sibling? delete-editing-block? editing-block]
  1791. ((or get-pos-fn get-block-tree-insert-pos-at-point))]
  1792. (let [target-block (outliner-core/block target-block)
  1793. editing-block (outliner-core/block editing-block)
  1794. format (or (:block/format target-block) (state/get-preferred-format))
  1795. new-block-uuids (atom #{})
  1796. metadata-replaced-blocks
  1797. (zip/root
  1798. (loop [loc (zip/vector-zip tree)]
  1799. (if (zip/end? loc)
  1800. loc
  1801. (if (vector? (zip/node loc))
  1802. (recur (zip/next loc))
  1803. (let [uuid (random-uuid)]
  1804. (swap! new-block-uuids (fn [acc uuid] (conj acc uuid)) uuid)
  1805. (recur (zip/next (zip/edit
  1806. loc
  1807. (paste-block-tree-at-point-edit-aux
  1808. uuid file page exclude-properties format content-update-fn)))))))))
  1809. _ (outliner-core/save-node editing-block)
  1810. _ (outliner-core/insert-nodes metadata-replaced-blocks target-block sibling?)
  1811. _ (when delete-editing-block?
  1812. (when-let [id (:db/id (outliner-core/get-data editing-block))]
  1813. (outliner-core/delete-node (outliner-core/block (db/pull id)) true)))
  1814. new-blocks (db/pull-many repo '[*] (map (fn [id] [:block/uuid id]) @new-block-uuids))]
  1815. (db/refresh! repo {:key :block/insert :data new-blocks})
  1816. (last metadata-replaced-blocks))))))
  1817. (defn- tree->vec-tree
  1818. "tree:
  1819. [
  1820. {
  1821. :content 'this is a block',
  1822. :properties {\"key\" \"value\" \"key2\" \"value2\"},
  1823. :children [
  1824. { :content 'this is child block' }
  1825. ]
  1826. },
  1827. {
  1828. :content 'this is sibling block'
  1829. }
  1830. ]"
  1831. [tree]
  1832. (into []
  1833. (mapcat
  1834. (fn [e]
  1835. (let [e* (select-keys e [:content :properties])]
  1836. (if-let [children (:children e)]
  1837. [e* (tree->vec-tree (:children e))]
  1838. [e*])))
  1839. tree)))
  1840. (defn- vec-tree->vec-block-tree
  1841. [tree format]
  1842. (let [loc (zip/vector-zip tree)]
  1843. (loop [loc loc]
  1844. (if (zip/end? loc)
  1845. (zip/root loc)
  1846. (let [node (zip/node loc)]
  1847. (if (vector? node)
  1848. (recur (zip/next loc))
  1849. (let [content (:content node)
  1850. props (into [] (:properties node))
  1851. content* (str "- "
  1852. (property/insert-properties format content props))
  1853. ast (mldoc/->edn content* (mldoc/default-config format))
  1854. blocks (block/extract-blocks ast content* true format)
  1855. fst-block (first blocks)]
  1856. (assert fst-block "fst-block shouldn't be nil")
  1857. (recur (zip/next (zip/replace loc fst-block))))))))))
  1858. (defn paste-block-tree-after-target
  1859. [target-block-id sibling? tree format]
  1860. (let [vec-tree (tree->vec-tree tree)
  1861. block-tree (vec-tree->vec-block-tree vec-tree format)
  1862. target-block (db/pull target-block-id)
  1863. page-block (if (:block/name target-block) target-block
  1864. (db/entity (:db/id (:block/page (db/pull target-block-id)))))
  1865. ;; sibling? = false, when target-block is a page-block
  1866. sibling? (if (= target-block-id (:db/id page-block))
  1867. false
  1868. sibling?)]
  1869. (paste-block-vec-tree-at-target
  1870. block-tree [] nil
  1871. #(get-block-tree-insert-pos-after-target target-block-id sibling?)
  1872. page-block)))
  1873. (defn template-on-chosen-handler
  1874. [_input id _q format _edit-block _edit-content]
  1875. (fn [[_template db-id] _click?]
  1876. (let [repo (state/get-current-repo)
  1877. block (db/entity db-id)
  1878. block-uuid (:block/uuid block)
  1879. template-including-parent? (not (false? (:template-including-parent (:block/properties block))))
  1880. blocks (if template-including-parent? (db/get-block-and-children repo block-uuid) (db/get-block-children repo block-uuid))
  1881. level-blocks (vals (blocks-with-level blocks))
  1882. grouped-blocks (group-by #(= db-id (:db/id %)) level-blocks)
  1883. root-block (or (first (get grouped-blocks true)) (assoc (db/pull db-id) :level 1))
  1884. blocks-exclude-root (get grouped-blocks false)
  1885. sorted-blocks (tree/sort-blocks blocks-exclude-root root-block)
  1886. result-blocks (if template-including-parent? sorted-blocks (drop 1 sorted-blocks))
  1887. tree (blocks-vec->tree result-blocks)]
  1888. (insert-command! id "" format {})
  1889. (let [last-block (paste-block-vec-tree-at-target tree [:template :template-including-parent]
  1890. (fn [content]
  1891. (->> content
  1892. (property/remove-property format "template")
  1893. (property/remove-property format "template-including-parent")
  1894. template/resolve-dynamic-template!)))]
  1895. (clear-when-saved!)
  1896. (db/refresh! repo {:key :block/insert :data [(db/pull db-id)]})
  1897. ;; FIXME:
  1898. ;; (js/setTimeout
  1899. ;; #(edit-block! {:block/uuid (:block/uuid last-block)} :max nil (:block/uuid last-block))
  1900. ;; 100)
  1901. ))
  1902. (when-let [input (gdom/getElement id)]
  1903. (.focus input))))
  1904. (defn parent-is-page?
  1905. [{{:block/keys [parent page]} :data :as node}]
  1906. {:pre [(tree/satisfied-inode? node)]}
  1907. (= parent page))
  1908. (defn outdent-on-enter
  1909. [node]
  1910. (when-not (parent-is-page? node)
  1911. (let [parent-node (tree/-get-parent node)]
  1912. (outliner-core/move-subtree node parent-node true)))
  1913. (let [repo (state/get-current-repo)]
  1914. (db/refresh! repo {:key :block/change :data [(:data node)]})))
  1915. (defn- last-top-level-child?
  1916. [{:keys [id config]} current-node]
  1917. (when id
  1918. (when-let [entity (if (util/uuid-string? (str id))
  1919. (db/entity [:block/uuid (uuid id)])
  1920. (db/entity [:block/name (string/lower-case id)]))]
  1921. (= (:block/uuid entity) (tree/-get-parent-id current-node)))))
  1922. (defn- keydown-new-block
  1923. [state]
  1924. (when-not (auto-complete?)
  1925. (let [{:keys [block config]} (get-state)]
  1926. (when (and block
  1927. (not (:custom-query? config)))
  1928. (let [content (state/get-edit-content)
  1929. current-node (outliner-core/block block)
  1930. has-right? (-> (tree/-get-right current-node)
  1931. (tree/satisfied-inode?))]
  1932. (if (and
  1933. (string/blank? content)
  1934. (not has-right?)
  1935. (not (last-top-level-child? config current-node)))
  1936. (outdent-on-enter current-node)
  1937. (profile
  1938. "Insert block"
  1939. (insert-new-block! state))))))))
  1940. (defn- keydown-new-line
  1941. []
  1942. (when-not (auto-complete?)
  1943. (let [^js input (state/get-input)
  1944. selected-start (gobj/get input "selectionStart")
  1945. selected-end (gobj/get input "selectionEnd")
  1946. value (.-value input)
  1947. s1 (subs value 0 selected-start)
  1948. s2 (subs value selected-end)]
  1949. (state/set-edit-content! (state/get-edit-input-id)
  1950. (str s1 "\n" s2))
  1951. (cursor/move-cursor-to input (inc selected-start)))))
  1952. (defn keydown-new-block-handler [state e]
  1953. (if (state/get-new-block-toggle?)
  1954. (keydown-new-line)
  1955. (do
  1956. (.preventDefault e)
  1957. (keydown-new-block state))))
  1958. (defn keydown-new-line-handler [state e]
  1959. (if (state/get-new-block-toggle?)
  1960. (keydown-new-block state)
  1961. (do
  1962. (.preventDefault e)
  1963. (keydown-new-line))))
  1964. (defn- select-first-last
  1965. "Select first or last block in viewpoint"
  1966. [direction]
  1967. (let [f (case direction :up last :down first)
  1968. block (->> (util/get-blocks-noncollapse)
  1969. (f))]
  1970. (when block
  1971. (.scrollIntoView block #js {:behavior "smooth" :block "center"})
  1972. (state/exit-editing-and-set-selected-blocks! [block]))))
  1973. (defn- select-up-down [direction]
  1974. (let [selected (first (state/get-selection-blocks))
  1975. f (case direction
  1976. :up util/get-prev-block-non-collapsed
  1977. :down util/get-next-block-non-collapsed)
  1978. sibling-block (f selected)]
  1979. (when (and sibling-block (dom/attr sibling-block "blockid"))
  1980. (.scrollIntoView sibling-block #js {:behavior "smooth" :block "center"})
  1981. (state/exit-editing-and-set-selected-blocks! [sibling-block]))))
  1982. (defn- move-cross-boundrary-up-down
  1983. [direction]
  1984. (let [input (state/get-input)
  1985. line-pos (util/get-first-or-last-line-pos input)
  1986. repo (state/get-current-repo)
  1987. f (case direction
  1988. :up util/get-prev-block-non-collapsed
  1989. :down util/get-next-block-non-collapsed)
  1990. sibling-block (f (gdom/getElement (state/get-editing-block-dom-id)))
  1991. {:block/keys [uuid content format]} (state/get-edit-block)]
  1992. (when sibling-block
  1993. (when-let [sibling-block-id (dom/attr sibling-block "blockid")]
  1994. (let [value (state/get-edit-content)]
  1995. (when (not= (clean-content! format content)
  1996. (string/trim value))
  1997. (save-block! repo uuid value)))
  1998. (let [new-id (cljs.core/uuid sibling-block-id)
  1999. block (db/pull repo '[*] [:block/uuid new-id])]
  2000. (edit-block! block
  2001. [direction line-pos]
  2002. format
  2003. new-id))))))
  2004. (defn keydown-up-down-handler
  2005. [direction]
  2006. (let [input (state/get-input)
  2007. selected-start (.-selectionStart input)
  2008. selected-end (.-selectionEnd input)
  2009. up? (= direction :up)
  2010. down? (= direction :down)]
  2011. (cond
  2012. (not= selected-start selected-end)
  2013. (if up?
  2014. (cursor/move-cursor-to input selected-start)
  2015. (cursor/move-cursor-to input selected-end))
  2016. (or (and up? (cursor/textarea-cursor-first-row? input))
  2017. (and down? (cursor/textarea-cursor-last-row? input)))
  2018. (move-cross-boundrary-up-down direction)
  2019. :else
  2020. (if up?
  2021. (cursor/move-cursor-up input)
  2022. (cursor/move-cursor-down input)))))
  2023. (defn- move-to-block-when-cross-boundrary
  2024. [direction]
  2025. (let [up? (= :left direction)
  2026. pos (if up? :max 0)
  2027. {:block/keys [format uuid] :as block} (state/get-edit-block)
  2028. id (state/get-edit-input-id)
  2029. repo (state/get-current-repo)]
  2030. (let [f (if up? util/get-prev-block-non-collapsed util/get-next-block-non-collapsed)
  2031. sibling-block (f (gdom/getElement (state/get-editing-block-dom-id)))]
  2032. (when sibling-block
  2033. (when-let [sibling-block-id (dom/attr sibling-block "blockid")]
  2034. (let [content (:block/content block)
  2035. value (state/get-edit-content)]
  2036. (when (not= (clean-content! format content)
  2037. (string/trim value))
  2038. (save-block! repo uuid value)))
  2039. (let [block (db/pull repo '[*] [:block/uuid (cljs.core/uuid sibling-block-id)])]
  2040. (edit-block! block pos format id)))))))
  2041. (defn keydown-arrow-handler
  2042. [direction]
  2043. (let [input (state/get-input)
  2044. element js/document.activeElement
  2045. selected-start (.-selectionStart input)
  2046. selected-end (.-selectionEnd input)
  2047. left? (= direction :left)
  2048. right? (= direction :right)]
  2049. (when (= input element)
  2050. (cond
  2051. (not= selected-start selected-end)
  2052. (if left?
  2053. (cursor/move-cursor-to input selected-start)
  2054. (cursor/move-cursor-to input selected-end))
  2055. (or (and left? (cursor/start? input))
  2056. (and right? (cursor/end? input)))
  2057. (move-to-block-when-cross-boundrary direction)
  2058. :else
  2059. (if left?
  2060. (cursor/move-cursor-backward input)
  2061. (cursor/move-cursor-forward input))))))
  2062. (defn- delete-and-update [^js input start end]
  2063. (.setRangeText input "" start end)
  2064. (state/set-edit-content! (state/get-edit-input-id) (.-value input)))
  2065. (defn- delete-concat [current-block]
  2066. (let [input-id (state/get-edit-input-id)
  2067. ^js input (state/get-input)
  2068. current-pos (cursor/pos input)
  2069. value (gobj/get input "value")
  2070. repo (state/get-current-repo)
  2071. right (outliner-core/get-right-node (outliner-core/block current-block))
  2072. current-block-has-children? (db/has-children? repo (:block/uuid current-block))
  2073. collapsed? (:collapsed (:block/properties current-block))
  2074. first-child (:data (tree/-get-down (outliner-core/block current-block)))
  2075. next-block (if (or collapsed? (not current-block-has-children?))
  2076. (:data right)
  2077. first-child)]
  2078. (cond
  2079. (and collapsed? right (db/has-children? repo (tree/-get-id right)))
  2080. nil
  2081. (and (not collapsed?) first-child (db/has-children? repo (:block/uuid first-child)))
  2082. nil
  2083. :else
  2084. (do
  2085. (delete-block-aux! next-block false)
  2086. (state/set-edit-content! input-id (str value "" (:block/content next-block)))
  2087. (cursor/move-cursor-to input current-pos)))))
  2088. (defn keydown-delete-handler
  2089. [e]
  2090. (let [^js input (state/get-input)
  2091. current-pos (cursor/pos input)
  2092. value (gobj/get input "value")
  2093. end? (= current-pos (count value))
  2094. current-block (state/get-edit-block)
  2095. selected-start (gobj/get input "selectionStart")
  2096. selected-end (gobj/get input "selectionEnd")]
  2097. (when current-block
  2098. (cond
  2099. (not= selected-start selected-end)
  2100. (delete-and-update input selected-start selected-end)
  2101. (and end? current-block)
  2102. (delete-concat current-block)
  2103. :else
  2104. (delete-and-update input current-pos (inc current-pos))))))
  2105. (defn keydown-backspace-handler
  2106. [cut? e]
  2107. (let [^js input (state/get-input)
  2108. id (state/get-edit-input-id)
  2109. current-pos (cursor/pos input)
  2110. value (gobj/get input "value")
  2111. deleted (and (> current-pos 0)
  2112. (util/nth-safe value (dec current-pos)))
  2113. selected-start (gobj/get input "selectionStart")
  2114. selected-end (gobj/get input "selectionEnd")
  2115. block-id (:block/uuid (state/get-edit-block))
  2116. page (state/get-current-page)
  2117. repo (state/get-current-repo)]
  2118. (mark-last-input-time! repo)
  2119. (cond
  2120. (not= selected-start selected-end)
  2121. (do
  2122. (util/stop e)
  2123. (when cut?
  2124. (js/document.execCommand "copy"))
  2125. (delete-and-update input selected-start selected-end))
  2126. (and (zero? current-pos)
  2127. ;; not the top block in a block page
  2128. (not (and page
  2129. (util/uuid-string? page)
  2130. (= (medley/uuid page) block-id))))
  2131. (do
  2132. (util/stop e)
  2133. (delete-block! repo e false))
  2134. (and (> current-pos 1)
  2135. (= (util/nth-safe value (dec current-pos)) commands/slash))
  2136. (do
  2137. (util/stop e)
  2138. (reset! *slash-caret-pos nil)
  2139. (reset! *show-commands false)
  2140. (delete-and-update input (dec current-pos) current-pos))
  2141. (and (> current-pos 1)
  2142. (= (util/nth-safe value (dec current-pos)) commands/angle-bracket))
  2143. (do
  2144. (util/stop e)
  2145. (reset! *angle-bracket-caret-pos nil)
  2146. (reset! *show-block-commands false)
  2147. (delete-and-update input (dec current-pos) current-pos))
  2148. ;; pair
  2149. (and
  2150. deleted
  2151. (contains?
  2152. (set (keys delete-map))
  2153. deleted)
  2154. (>= (count value) (inc current-pos))
  2155. (= (util/nth-safe value current-pos)
  2156. (get delete-map deleted)))
  2157. (do
  2158. (util/stop e)
  2159. (commands/delete-pair! id)
  2160. (cond
  2161. (and (= deleted "[") (state/get-editor-show-page-search?))
  2162. (state/set-editor-show-page-search! false)
  2163. (and (= deleted "(") (state/get-editor-show-block-search?))
  2164. (state/set-editor-show-block-search! false)
  2165. :else
  2166. nil))
  2167. ;; deleting hashtag
  2168. (and (= deleted "#") (state/get-editor-show-page-search-hashtag?))
  2169. (do
  2170. (state/set-editor-show-page-search-hashtag! false)
  2171. (delete-and-update input (dec current-pos) current-pos))
  2172. ;; just delete
  2173. :else
  2174. (do
  2175. (util/stop e)
  2176. (delete-and-update input (dec current-pos) current-pos)))))
  2177. (defn indent-outdent
  2178. [indent?]
  2179. (state/set-editor-op! :indent-outdent)
  2180. (let [{:keys [block]} (get-state)]
  2181. (when block
  2182. (let [current-node (outliner-core/block block)]
  2183. (outliner-core/indent-outdent-nodes [current-node] indent?)
  2184. (let [repo (state/get-current-repo)]
  2185. (db/refresh! repo
  2186. {:key :block/change :data [(:data current-node)]}))))
  2187. (state/set-editor-op! :nil)))
  2188. (defn keydown-tab-handler
  2189. [direction]
  2190. (fn [e]
  2191. (cond
  2192. (state/editing?)
  2193. (let [input (state/get-input)
  2194. pos (cursor/pos input)]
  2195. (when (and (not (state/get-editor-show-input))
  2196. (not (state/get-editor-show-date-picker?))
  2197. (not (state/get-editor-show-template-search?)))
  2198. (util/stop e)
  2199. (indent-outdent (not (= :left direction)))
  2200. (and input pos
  2201. (when-let [input (state/get-input)]
  2202. (cursor/move-cursor-to input pos)))))
  2203. (state/selection?)
  2204. (do
  2205. (util/stop e)
  2206. (on-tab direction))
  2207. :else nil)))
  2208. (defn keydown-not-matched-handler
  2209. [format]
  2210. (fn [e key-code]
  2211. (let [input-id (state/get-edit-input-id)
  2212. input (state/get-input)
  2213. key (gobj/get e "key")
  2214. value (gobj/get input "value")
  2215. ctrlKey (gobj/get e "ctrlKey")
  2216. metaKey (gobj/get e "metaKey")
  2217. pos (cursor/pos input)]
  2218. (cond
  2219. (or ctrlKey metaKey)
  2220. nil
  2221. (and (= key "#")
  2222. (and
  2223. (> pos 0)
  2224. (= "#" (util/nth-safe value (dec pos)))))
  2225. (state/set-editor-show-page-search-hashtag! false)
  2226. (and
  2227. (contains? (set/difference (set (keys reversed-autopair-map))
  2228. #{"`"})
  2229. key)
  2230. (= (get-current-input-char input) key))
  2231. (do
  2232. (util/stop e)
  2233. (cursor/move-cursor-forward input))
  2234. (contains? (set (keys autopair-map)) key)
  2235. (do
  2236. (util/stop e)
  2237. (autopair input-id key format nil)
  2238. (cond
  2239. (surround-by? input "[[" "]]")
  2240. (do
  2241. (commands/handle-step [:editor/search-page])
  2242. (reset! commands/*slash-caret-pos (cursor/get-caret-pos input)))
  2243. (surround-by? input "((" "))")
  2244. (do
  2245. (commands/handle-step [:editor/search-block :reference])
  2246. (reset! commands/*slash-caret-pos (cursor/get-caret-pos input)))
  2247. :else
  2248. nil))
  2249. (or
  2250. (surround-by? input "#" " ")
  2251. (surround-by? input "#" :end)
  2252. (= key "#"))
  2253. (do
  2254. (commands/handle-step [:editor/search-page-hashtag])
  2255. (state/set-last-pos! (cursor/pos input))
  2256. (reset! commands/*slash-caret-pos (cursor/get-caret-pos input)))
  2257. (let [sym "$"]
  2258. (and (= key sym)
  2259. (>= (count value) 1)
  2260. (> pos 0)
  2261. (= (nth value (dec pos)) sym)
  2262. (if (> (count value) pos)
  2263. (not= (nth value pos) sym)
  2264. true)))
  2265. (commands/simple-insert! input-id "$$" {:backward-pos 2})
  2266. (let [sym "^"]
  2267. (and (= key sym)
  2268. (>= (count value) 1)
  2269. (> pos 0)
  2270. (= (nth value (dec pos)) sym)
  2271. (if (> (count value) pos)
  2272. (not= (nth value pos) sym)
  2273. true)))
  2274. (commands/simple-insert! input-id "^^" {:backward-pos 2})
  2275. :else
  2276. nil))))
  2277. ;; key up
  2278. (defn keyup-handler
  2279. [state input input-id search-timeout]
  2280. (fn [e key-code]
  2281. (let [k (gobj/get e "key")
  2282. format (:format (get-state))
  2283. current-pos (cursor/pos input)
  2284. value (gobj/get input "value")
  2285. c (util/nth-safe value (dec current-pos))]
  2286. (when-not (state/get-editor-show-input)
  2287. (when (and (= "【" c (util/nth-safe value (dec (dec current-pos))))
  2288. (> current-pos 0))
  2289. (commands/handle-step [:editor/input "[[]]" {:last-pattern "【【"
  2290. :backward-pos 2}])
  2291. (commands/handle-step [:editor/search-page])
  2292. (reset! commands/*slash-caret-pos (cursor/get-caret-pos input)))
  2293. (when (and (= "(" c (util/nth-safe value (dec (dec current-pos))))
  2294. (> current-pos 0))
  2295. (commands/handle-step [:editor/input "(())" {:last-pattern "(("
  2296. :backward-pos 2}])
  2297. (commands/handle-step [:editor/search-block :reference])
  2298. (reset! commands/*slash-caret-pos (cursor/get-caret-pos input)))
  2299. (when (and (= "〈" c)
  2300. (= "《" (util/nth-safe value (dec (dec current-pos))))
  2301. (> current-pos 0))
  2302. (commands/handle-step [:editor/input "<" {:last-pattern "《〈"
  2303. :backward-pos 0}])
  2304. (reset! commands/*angle-bracket-caret-pos (cursor/get-caret-pos input))
  2305. (reset! commands/*show-block-commands true))
  2306. (when (= c " ")
  2307. (when (or (= (util/nth-safe value (dec (dec current-pos))) "#")
  2308. (not (state/get-editor-show-page-search?))
  2309. (and (state/get-editor-show-page-search?)
  2310. (not= (util/nth-safe value current-pos) "]")))
  2311. (state/set-editor-show-page-search-hashtag! false)))
  2312. (when (and @*show-commands (not= key-code 191)) ; not /
  2313. (let [matched-commands (get-matched-commands input)]
  2314. (if (seq matched-commands)
  2315. (do
  2316. (reset! *show-commands true)
  2317. (reset! commands/*matched-commands matched-commands))
  2318. (reset! *show-commands false))))
  2319. (when (and @*show-block-commands (not= key-code 188)) ; not <
  2320. (let [matched-block-commands (get-matched-block-commands input)]
  2321. (if (seq matched-block-commands)
  2322. (cond
  2323. (= key-code 9) ;tab
  2324. (when @*show-block-commands
  2325. (util/stop e)
  2326. (insert-command! input-id
  2327. (last (first matched-block-commands))
  2328. format
  2329. {:last-pattern commands/angle-bracket}))
  2330. :else
  2331. (reset! commands/*matched-block-commands matched-block-commands))
  2332. (reset! *show-block-commands false))))
  2333. (when (nil? @search-timeout)
  2334. (close-autocomplete-if-outside input))))))
  2335. (defn editor-on-click!
  2336. [id]
  2337. (fn [_e]
  2338. (let [input (gdom/getElement id)]
  2339. (close-autocomplete-if-outside input))))
  2340. (defn editor-on-change!
  2341. [block id search-timeout]
  2342. (fn [e]
  2343. (if (state/sub :editor/show-block-search?)
  2344. (let [blocks-count (or (db/blocks-count) 0)
  2345. timeout (if (> blocks-count 2000) 300 100)]
  2346. (when @search-timeout
  2347. (js/clearTimeout @search-timeout))
  2348. (reset! search-timeout
  2349. (js/setTimeout
  2350. #(edit-box-on-change! e block id)
  2351. timeout)))
  2352. (edit-box-on-change! e block id))))
  2353. (defn- get-current-page-format
  2354. []
  2355. (when-let [page (state/get-current-page)]
  2356. (db/get-page-format page)))
  2357. (defn blocks->tree-by-level
  2358. [blocks]
  2359. (let [min-level (apply min (mapv :block/level blocks))
  2360. prefix-level (if (> min-level 1) (- min-level 1) 0)]
  2361. (->> blocks
  2362. (mapv #(assoc % :level (- (:block/level %) prefix-level)))
  2363. (blocks-vec->tree))))
  2364. (defn- paste-text-parseable
  2365. [format text]
  2366. (let [tree (->>
  2367. (block/extract-blocks
  2368. (mldoc/->edn text (mldoc/default-config format)) text true format))
  2369. min-level (apply min (mapv :block/level tree))
  2370. prefix-level (if (> min-level 1) (- min-level 1) 0)
  2371. tree* (->> tree
  2372. (mapv #(assoc % :level (- (:block/level %) prefix-level)))
  2373. (blocks-vec->tree))]
  2374. (paste-block-vec-tree-at-target tree* [])))
  2375. (defn- paste-segmented-text
  2376. [format text]
  2377. (let [paragraphs (string/split text #"(?:\r?\n){2,}")
  2378. updated-paragraphs
  2379. (string/join "\n"
  2380. (mapv (fn [p] (->> (string/trim p)
  2381. ((fn [p]
  2382. (if (util/safe-re-find (if (= format :org)
  2383. #"\s*\*+\s+"
  2384. #"\s*-\s+") p)
  2385. p
  2386. (str (if (= format :org) "* " "- ") p))))))
  2387. paragraphs))]
  2388. (paste-text-parseable format updated-paragraphs)))
  2389. (defn- paste-text
  2390. [text e]
  2391. (let [repo (state/get-current-repo)
  2392. page (or (db/entity [:block/name (state/get-current-page)])
  2393. (db/entity [:block/original-name (state/get-current-page)])
  2394. (:block/page (db/entity (:db/id (state/get-edit-block)))))
  2395. copied-blocks (state/get-copied-blocks)
  2396. copied-block-tree (:copy/block-tree copied-blocks)]
  2397. (if (and
  2398. (:copy/content copied-blocks)
  2399. (not (string/blank? text))
  2400. (= (string/trim text) (string/trim (:copy/content copied-blocks))))
  2401. (do
  2402. ;; copy from logseq internally
  2403. (paste-block-vec-tree-at-target copied-block-tree [])
  2404. (util/stop e))
  2405. (do
  2406. ;; from external
  2407. (let [format (or (db/get-page-format (state/get-current-page)) :markdown)]
  2408. (match [format
  2409. (nil? (util/safe-re-find #"(?m)^\s*(?:[-+*]|#+)\s+" text))
  2410. (nil? (util/safe-re-find #"(?m)^\s*\*+\s+" text))
  2411. (nil? (util/safe-re-find #"(?:\r?\n){2,}" text))]
  2412. [:markdown false _ _]
  2413. (do
  2414. (paste-text-parseable format text)
  2415. (util/stop e))
  2416. [:org _ false _]
  2417. (do
  2418. (paste-text-parseable format text)
  2419. (util/stop e))
  2420. [:markdown true _ false]
  2421. (do
  2422. (paste-segmented-text format text)
  2423. (util/stop e))
  2424. [:markdown true _ true]
  2425. (do)
  2426. [:org _ true false]
  2427. (do
  2428. (paste-segmented-text format text)
  2429. (util/stop e))
  2430. [:org _ true true]
  2431. (do)))))))
  2432. (defn editor-on-paste!
  2433. [id]
  2434. (fn [e]
  2435. (if-let [handled
  2436. (let [pick-one-allowed-item
  2437. (fn [items]
  2438. (if (util/electron?)
  2439. (let [existed-file-path (js/window.apis.getFilePathFromClipboard)
  2440. existed-file-path (if (and
  2441. (string? existed-file-path)
  2442. (not util/mac?)
  2443. (not util/win32?)) ; FIXME: linux
  2444. (when (util/safe-re-find #"^(/[^/ ]*)+/?$" existed-file-path)
  2445. existed-file-path)
  2446. existed-file-path)
  2447. has-file-path? (not (string/blank? existed-file-path))
  2448. has-image? (js/window.apis.isClipboardHasImage)]
  2449. (if (or has-image? has-file-path?)
  2450. [:asset (js/File. #js[] (if has-file-path? existed-file-path "image.png"))]))
  2451. (when (and items (.-length items))
  2452. (let [files (. (js/Array.from items) (filter #(= (.-kind %) "file")))
  2453. it (gobj/get files 0) ;;; TODO: support multiple files
  2454. mime (and it (.-type it))]
  2455. (cond
  2456. (contains? #{"image/jpeg" "image/png" "image/jpg" "image/gif"} mime) [:asset (. it getAsFile)])))))
  2457. clipboard-data (gobj/get e "clipboardData")
  2458. items (or (.-items clipboard-data)
  2459. (.-files clipboard-data))
  2460. picked (pick-one-allowed-item items)]
  2461. (if (get picked 1)
  2462. (match picked
  2463. [:asset file] (set-asset-pending-file file))))]
  2464. (util/stop e)
  2465. (paste-text (.getData (gobj/get e "clipboardData") "text") e))))
  2466. (defn- cut-blocks-and-clear-selections!
  2467. [copy?]
  2468. (cut-selection-blocks copy?)
  2469. (clear-selection! nil))
  2470. (defn shortcut-copy-selection
  2471. [e]
  2472. (copy-selection-blocks))
  2473. (defn shortcut-cut-selection
  2474. [e]
  2475. (util/stop e)
  2476. (cut-blocks-and-clear-selections! true))
  2477. (defn shortcut-delete-selection
  2478. [e]
  2479. (util/stop e)
  2480. (cut-blocks-and-clear-selections! false))
  2481. ;; credits to @pengx17
  2482. (defn- copy-current-block-ref
  2483. []
  2484. (when-let [current-block (state/get-edit-block)]
  2485. (when-let [block-id (:block/uuid current-block)]
  2486. (copy-block-ref! block-id #(str "((" % "))"))
  2487. (notification/show!
  2488. [:div
  2489. [:span.mb-1.5 "Block ref copied!"]
  2490. [:div [:code.whitespace-nowrap (str "((" block-id "))")]]]
  2491. :success true
  2492. ;; use uuid to make sure there is only one toast a time
  2493. (str "copied-block-ref:" block-id)))))
  2494. (defn shortcut-copy
  2495. "shortcut copy action:
  2496. * when in selection mode, copy selected blocks
  2497. * when in edit mode but no text selected, copy current block ref
  2498. * when in edit mode with text selected, copy selected text as normal"
  2499. [e]
  2500. (when-not (auto-complete?)
  2501. (cond
  2502. (state/selection?)
  2503. (shortcut-copy-selection e)
  2504. (state/editing?)
  2505. (let [input (state/get-input)
  2506. selected-start (.-selectionStart input)
  2507. selected-end (.-selectionEnd input)]
  2508. (if (= selected-start selected-end)
  2509. (copy-current-block-ref)
  2510. (js/document.execCommand "copy")))
  2511. :else
  2512. (js/document.execCommand "copy"))))
  2513. (defn shortcut-cut
  2514. "shortcut cut action:
  2515. * when in selection mode, cut selected blocks
  2516. * when in edit mode with text selected, cut selected text
  2517. * otherwise same as delete shortcut"
  2518. [e]
  2519. (cond
  2520. (state/selection?)
  2521. (shortcut-cut-selection e)
  2522. (state/editing?)
  2523. (keydown-backspace-handler true e)))
  2524. (defn delete-selection
  2525. [e]
  2526. (when (state/selection?)
  2527. (shortcut-delete-selection e)))
  2528. (defn editor-delete
  2529. [_state e]
  2530. (when (state/editing?)
  2531. (keydown-delete-handler e)))
  2532. (defn editor-backspace
  2533. [_state e]
  2534. (when (state/editing?)
  2535. (keydown-backspace-handler false e)))
  2536. (defn shortcut-up-down [direction]
  2537. (fn [e]
  2538. (when-not (auto-complete?)
  2539. (util/stop e)
  2540. (cond
  2541. (state/editing?)
  2542. (keydown-up-down-handler direction)
  2543. (and (state/selection?) (== 1 (count (state/get-selection-blocks))))
  2544. (select-up-down direction)
  2545. :else
  2546. (select-first-last direction)))))
  2547. (defn open-selected-block!
  2548. [direction e]
  2549. (when-let [block-id (some-> (state/get-selection-blocks)
  2550. first
  2551. (dom/attr "blockid")
  2552. medley/uuid)]
  2553. (util/stop e)
  2554. (let [block {:block/uuid block-id}
  2555. left? (= direction :left)]
  2556. (edit-block! block
  2557. (if left? 0 :max)
  2558. (:block/format block)
  2559. block-id))))
  2560. (defn shortcut-left-right [direction]
  2561. (fn [e]
  2562. (when-not (auto-complete?)
  2563. (util/stop e)
  2564. (cond
  2565. (state/editing?)
  2566. (keydown-arrow-handler direction)
  2567. (and (state/selection?) (== 1 (count (state/get-selection-blocks))))
  2568. (open-selected-block! direction e)
  2569. :else
  2570. nil))))
  2571. (defn clear-block-content! []
  2572. (save-current-block! {:force? true})
  2573. (state/set-edit-content! (state/get-edit-input-id) ""))
  2574. (defn kill-line-before! []
  2575. (save-current-block! {:force? true})
  2576. (util/kill-line-before! (state/get-input)))
  2577. (defn kill-line-after! []
  2578. (save-current-block! {:force? true})
  2579. (util/kill-line-after! (state/get-input)))
  2580. (defn beginning-of-block []
  2581. (cursor/move-cursor-to (state/get-input) 0))
  2582. (defn end-of-block []
  2583. (cursor/move-cursor-to-end (state/get-input)))
  2584. (defn cursor-forward-word []
  2585. (cursor/move-cursor-forward-by-word (state/get-input)))
  2586. (defn cursor-backward-word []
  2587. (cursor/move-cursor-backward-by-word (state/get-input)))
  2588. (defn backward-kill-word []
  2589. (let [input (state/get-input)]
  2590. (save-current-block! {:force? true})
  2591. (util/backward-kill-word input)
  2592. (state/set-edit-content! (state/get-edit-input-id) (.-value input))))
  2593. (defn forward-kill-word []
  2594. (let [input (state/get-input)]
  2595. (save-current-block! {:force? true})
  2596. (util/forward-kill-word input)
  2597. (state/set-edit-content! (state/get-edit-input-id) (.-value input))))
  2598. (defn all-blocks-with-level
  2599. "Return all blocks associated with correct level
  2600. if :collapse? true, return without any collapsed children
  2601. for example:
  2602. - a
  2603. - b (collapsed)
  2604. - c
  2605. - d
  2606. - e
  2607. return:
  2608. blocks
  2609. [{:block a :level 1}
  2610. {:block b :level 2}
  2611. {:block e :level 2}]"
  2612. [{:keys [collapse?] :or {collapse? false}}]
  2613. (when-let [page (or (state/get-current-page)
  2614. (date/today))]
  2615. (->>
  2616. (-> page
  2617. (db/get-page-blocks-no-cache)
  2618. (tree/blocks->vec-tree page))
  2619. (#(if collapse?
  2620. (w/postwalk
  2621. (fn [x]
  2622. (if (and (map? x) (-> x :block/properties :collapsed))
  2623. (assoc x :block/children []) x)) %) %))
  2624. (mapcat (fn [x] (tree-seq map? :block/children x)))
  2625. (map (fn [x] (dissoc x :block/children))))))
  2626. (defn collapse-block! [block-id]
  2627. (when (db-model/has-children? block-id)
  2628. (set-block-property! block-id :collapsed true)))
  2629. (defn expand-block! [block-id]
  2630. (remove-block-property! block-id :collapsed))
  2631. (defn expand!
  2632. []
  2633. (cond
  2634. (state/editing?)
  2635. (when-let [block-id (:block/uuid (state/get-edit-block))]
  2636. (expand-block! block-id))
  2637. (state/selection?)
  2638. (do
  2639. (->> (get-selected-blocks-with-children)
  2640. (map (fn [dom]
  2641. (-> (dom/attr dom "blockid")
  2642. medley/uuid
  2643. expand-block!)))
  2644. doall)
  2645. (clear-selection! nil))
  2646. :else
  2647. ;; expand one level
  2648. (let [blocks-with-level (all-blocks-with-level {})
  2649. max-level (apply max (map :block/level blocks-with-level))]
  2650. (loop [level 1]
  2651. (if (> level max-level)
  2652. nil
  2653. (let [blocks-to-expand (->> blocks-with-level
  2654. (filter (fn [b] (= (:block/level b) level)))
  2655. (filter (fn [{:block/keys [properties]}]
  2656. (contains? properties :collapsed))))]
  2657. (if (empty? blocks-to-expand)
  2658. (recur (inc level))
  2659. (doseq [{:block/keys [uuid]} blocks-to-expand]
  2660. (expand-block! uuid)))))))))
  2661. (defn collapse!
  2662. []
  2663. (cond
  2664. (state/editing?)
  2665. (when-let [block-id (:block/uuid (state/get-edit-block))]
  2666. (collapse-block! block-id))
  2667. (state/selection?)
  2668. (do
  2669. (->> (get-selected-blocks-with-children)
  2670. (map (fn [dom]
  2671. (-> (dom/attr dom "blockid")
  2672. medley/uuid
  2673. collapse-block!)))
  2674. doall)
  2675. (clear-selection! nil))
  2676. :else
  2677. ;; collapse by one level from outside
  2678. (let [blocks-with-level
  2679. (all-blocks-with-level {:collapse? true})
  2680. max-level (apply max (map :block/level blocks-with-level))]
  2681. (loop [level (dec max-level)]
  2682. (if (zero? level)
  2683. nil
  2684. (let [blocks-to-collapse
  2685. (->> blocks-with-level
  2686. (filter (fn [b] (= (:block/level b) level)))
  2687. (remove (fn [b]
  2688. (or (not (db-model/has-children? (:block/uuid b)))
  2689. (-> b :block/properties :collapsed)))))]
  2690. (if (empty? blocks-to-collapse)
  2691. (recur (dec level))
  2692. (doseq [{:block/keys [uuid]} blocks-to-collapse]
  2693. (collapse-block! uuid)))))))))
  2694. (defn- collapse-all!
  2695. []
  2696. (let [blocks-to-collapse
  2697. (->> (all-blocks-with-level {:collapse? true})
  2698. (filter (fn [b] (= (:block/level b) 1)))
  2699. (remove (fn [b] (-> b :block/properties :collapsed))))]
  2700. (when (seq blocks-to-collapse)
  2701. (doseq [{:block/keys [uuid]} blocks-to-collapse]
  2702. (collapse-block! uuid)))))
  2703. (defn- expand-all!
  2704. []
  2705. (->> (all-blocks-with-level {})
  2706. (filter (fn [b] (-> b :block/properties :collapsed)))
  2707. (map (comp expand-block! :block/uuid))
  2708. doall))
  2709. (defn toggle-open! []
  2710. (let [all-collapsed?
  2711. (->> (all-blocks-with-level {:collapse? true})
  2712. (filter (fn [b] (= (:block/level b) 1)))
  2713. (every? (fn [{:block/keys [uuid properties]}]
  2714. (or
  2715. (not (db-model/has-children? uuid))
  2716. (some? (-> properties :collapsed))))))]
  2717. (if all-collapsed?
  2718. (expand-all!)
  2719. (collapse-all!))))
  2720. (defn select-all-blocks!
  2721. []
  2722. (if-let [current-input-id (state/get-edit-input-id)]
  2723. (let [input (gdom/getElement current-input-id)
  2724. blocks-container (util/rec-get-blocks-container input)
  2725. blocks (dom/by-class blocks-container "ls-block")]
  2726. (state/exit-editing-and-set-selected-blocks! blocks))
  2727. (->> (all-blocks-with-level {:collapse? true})
  2728. (map (comp gdom/getElementByClass str :block/uuid))
  2729. state/exit-editing-and-set-selected-blocks!)))