editor.cljs 145 KB

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