editor.cljs 89 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067
  1. (ns frontend.handler.editor
  2. (:require [frontend.state :as state]
  3. [frontend.handler.common :as common-handler]
  4. [frontend.handler.route :as route-handler]
  5. [frontend.handler.git :as git-handler]
  6. [frontend.handler.ui :as ui-handler]
  7. [frontend.handler.repo :as repo-handler]
  8. [frontend.handler.file :as file-handler]
  9. [frontend.handler.notification :as notification]
  10. [frontend.handler.draw :as draw]
  11. [frontend.handler.expand :as expand]
  12. [frontend.format.mldoc :as mldoc]
  13. [frontend.format :as format]
  14. [frontend.format.block :as block]
  15. [frontend.image :as image]
  16. [cljs-time.core :as t]
  17. [cljs-time.coerce :as tc]
  18. [frontend.db :as db]
  19. [goog.object :as gobj]
  20. [goog.dom :as gdom]
  21. [goog.dom.classes :as gdom-classes]
  22. [clojure.string :as string]
  23. [frontend.util :as util :refer-macros [profile]]
  24. [frontend.config :as config]
  25. [dommy.core :as dom]
  26. [frontend.utf8 :as utf8]
  27. [frontend.fs :as fs]
  28. [promesa.core :as p]
  29. [dommy.core :as d]
  30. [frontend.diff :as diff]
  31. [frontend.search :as search]
  32. [frontend.handler.image :as image-handler]
  33. [frontend.commands :as commands
  34. :refer [*show-commands
  35. *slash-caret-pos
  36. *angle-bracket-caret-pos
  37. *show-block-commands]]
  38. [frontend.extensions.html-parser :as html-parser]
  39. [medley.core :as medley]
  40. [frontend.text :as text]
  41. [frontend.date :as date]
  42. [frontend.handler.repeated :as repeated]
  43. [clojure.core.async :as async]
  44. [lambdaisland.glogi :as log]))
  45. ;; FIXME: should support multiple images concurrently uploading
  46. (defonce *image-uploading? (atom false))
  47. (defonce *image-uploading-process (atom 0))
  48. (defonce *selected-text (atom nil))
  49. (defn modified-time-tx
  50. [page file]
  51. (let [modified-at (tc/to-long (t/now))]
  52. [[:db/add (:db/id page) :page/last-modified-at modified-at]
  53. [:db/add (:db/id file) :file/last-modified-at modified-at]]))
  54. (defn- get-selection-and-format
  55. []
  56. (when-let [block (state/get-edit-block)]
  57. (when-let [id (:block/uuid block)]
  58. (when-let [edit-id (state/get-edit-input-id)]
  59. (when-let [input (gdom/getElement edit-id)]
  60. {:selection-start (gobj/get input "selectionStart")
  61. :selection-end (gobj/get input "selectionEnd")
  62. :format (:block/format block)
  63. :value (gobj/get input "value")
  64. :block block
  65. :edit-id edit-id
  66. :input input})))))
  67. (defn- format-text!
  68. [pattern-fn]
  69. (when-let [m (get-selection-and-format)]
  70. (let [{:keys [selection-start selection-end format value block edit-id input]} m
  71. empty-selection? (= selection-start selection-end)
  72. pattern (pattern-fn format)
  73. new-value (str
  74. (subs value 0 selection-start)
  75. pattern
  76. (subs value selection-start selection-end)
  77. pattern
  78. (subs value selection-end))]
  79. (state/set-edit-content! edit-id new-value)
  80. (when empty-selection?
  81. (util/cursor-move-back input (count pattern))))))
  82. (defn bold-format! []
  83. (format-text! config/get-bold))
  84. (defn italics-format! []
  85. (format-text! config/get-italic))
  86. (defn highlight-format! []
  87. (format-text! config/get-highlight))
  88. (defn html-link-format! []
  89. (when-let [m (get-selection-and-format)]
  90. (let [{:keys [selection-start selection-end format value block edit-id input]} m
  91. cur-pos (:pos (util/get-caret-pos input))
  92. empty-selection? (= selection-start selection-end)
  93. selection (subs value selection-start selection-end)
  94. selection-link? (and selection (or (util/starts-with? selection "http://")
  95. (util/starts-with? selection "https://")))
  96. [content forward-pos] (cond
  97. empty-selection?
  98. (config/get-empty-link-and-forward-pos format)
  99. selection-link?
  100. (config/with-default-link format selection)
  101. :else
  102. (config/with-default-label format selection))
  103. new-value (str
  104. (subs value 0 selection-start)
  105. content
  106. (subs value selection-end))
  107. cur-pos (or selection-start cur-pos)]
  108. (state/set-edit-content! edit-id new-value)
  109. (util/move-cursor-to input (+ cur-pos forward-pos)))))
  110. (defn focus-on-block!
  111. [block-id]
  112. (when block-id
  113. (route-handler/redirect! {:to :page
  114. :path-params {:name (str block-id)}})))
  115. (defn open-block-in-sidebar!
  116. [block-id]
  117. (when block-id
  118. (when-let [block (db/pull [:block/uuid block-id])]
  119. (state/sidebar-add-block!
  120. (state/get-current-repo)
  121. (:db/id block)
  122. :block
  123. block))))
  124. (defn reset-cursor-range!
  125. [node]
  126. (when node
  127. (state/set-cursor-range! (util/caret-range node))))
  128. (defn restore-cursor-pos!
  129. ([id markup]
  130. (restore-cursor-pos! id markup false))
  131. ([id markup dummy?]
  132. (when-let [node (gdom/getElement (str id))]
  133. (when-let [cursor-range (state/get-cursor-range)]
  134. (when-let [range (string/trim cursor-range)]
  135. (let [pos (diff/find-position markup range)]
  136. (util/set-caret-pos! node pos)))))))
  137. (defn block-content-join-newlines
  138. [prefix value postfix]
  139. (str
  140. (if (or (= "" prefix)
  141. (= "\n" (last prefix)))
  142. ""
  143. "\n")
  144. (string/trim value)
  145. (if (= "\n" (first postfix))
  146. ""
  147. "\n")))
  148. (defn get-current-input-node
  149. []
  150. (let [edit-input-id (state/get-edit-input-id)]
  151. (and edit-input-id (gdom/getElement edit-input-id))))
  152. (defn get-current-input-value
  153. []
  154. (let [edit-input-id (state/get-edit-input-id)
  155. input (and edit-input-id (gdom/getElement edit-input-id))]
  156. (when input
  157. (gobj/get input "value"))))
  158. (defn new-file-content
  159. [{:block/keys [content meta dummy?] :as block} file-content value]
  160. (let [utf8-content (utf8/encode file-content)
  161. prefix (utf8/substring utf8-content 0 (:start-pos meta))
  162. postfix (let [end-pos (if dummy?
  163. (:start-pos meta)
  164. (:end-pos meta))]
  165. (utf8/substring utf8-content end-pos))
  166. value (block-content-join-newlines prefix value postfix)]
  167. [(str prefix value postfix)
  168. value]))
  169. (defn get-block-new-value
  170. [{:block/keys [content meta dummy?] :as block} file-content value]
  171. (let [utf8-content (utf8/encode file-content)
  172. prefix (utf8/substring utf8-content 0 (:start-pos meta))
  173. postfix (let [end-pos (if dummy?
  174. (:start-pos meta)
  175. (:end-pos meta))]
  176. (utf8/substring utf8-content end-pos))]
  177. (block-content-join-newlines prefix value postfix)))
  178. (defn new-file-content-indent-outdent
  179. [{:block/keys [content meta dummy?] :as block} file-content value block-with-children-content last-child-end-pos indent-left?]
  180. (let [utf8-content (utf8/encode file-content)
  181. prefix (utf8/substring utf8-content 0 (:start-pos meta))
  182. last-child-end-pos (if (some? indent-left?) last-child-end-pos nil)
  183. end-pos (or
  184. last-child-end-pos
  185. (if dummy?
  186. (:start-pos meta)
  187. (:end-pos meta)))
  188. postfix (utf8/substring utf8-content end-pos)
  189. block-children-value (block-content-join-newlines prefix block-with-children-content postfix)]
  190. (str prefix block-children-value postfix)))
  191. (defn- with-block-meta
  192. [repo block]
  193. (if (:block/dummy? block)
  194. (if-let [page-id (:db/id (:block/page block))]
  195. (let [page-name (:page/name (db/entity repo page-id))
  196. end-pos (db/get-block-page-end-pos repo page-name)]
  197. (assoc block :block/meta {:start-pos end-pos
  198. :end-pos end-pos}))
  199. block)
  200. (if-let [meta (:block/meta (db/entity repo [:block/uuid (:block/uuid block)]))]
  201. (assoc block :block/meta meta)
  202. block)))
  203. (defn highlight-block!
  204. [block-uuid]
  205. (let [blocks (array-seq (js/document.getElementsByClassName (str block-uuid)))]
  206. (doseq [block blocks]
  207. (dom/add-class! block "block-highlight"))))
  208. (defn unhighlight-block!
  209. []
  210. (let [blocks (some->> (array-seq (js/document.getElementsByClassName "block-highlight"))
  211. (repeat 2)
  212. (apply concat))]
  213. (doseq [block blocks]
  214. (gdom-classes/remove block "block-highlight"))))
  215. (defn rebuild-blocks-meta
  216. [start-pos blocks]
  217. (let [last-start-pos (atom start-pos)]
  218. (mapv
  219. (fn [{:block/keys [uuid meta] :as block}]
  220. (let [old-start-pos (:start-pos meta)
  221. old-end-pos (:end-pos meta)
  222. new-end-pos (if old-end-pos
  223. (+ @last-start-pos (- old-end-pos old-start-pos)))
  224. new-meta {:start-pos @last-start-pos
  225. :end-pos new-end-pos}]
  226. (reset! last-start-pos new-end-pos)
  227. {:block/uuid uuid
  228. :block/meta new-meta}))
  229. blocks)))
  230. (defn rebuild-after-blocks
  231. [repo file before-end-pos new-end-pos]
  232. (let [file-id (:db/id file)
  233. after-blocks (db/get-file-after-blocks-meta repo file-id before-end-pos)]
  234. (rebuild-blocks-meta new-end-pos after-blocks)))
  235. (defn rebuild-after-blocks-indent-outdent
  236. [repo file block before-end-pos new-end-pos indent-left?]
  237. (let [file-id (:db/id file)
  238. after-blocks (db/get-file-after-blocks-meta repo file-id before-end-pos true)
  239. last-start-pos (atom new-end-pos)
  240. block-level (:block/level block)
  241. next-leq-level? (atom false)
  242. format (:block/format block)
  243. block-and-children-content (atom (:block/content block))
  244. last-child-end-pos (atom before-end-pos)
  245. after-blocks (mapv
  246. (fn [{:block/keys [uuid meta level content] :as block}]
  247. (let [old-start-pos (:start-pos meta)
  248. old-end-pos (:end-pos meta)]
  249. (when (<= level block-level)
  250. (reset! next-leq-level? true))
  251. (let [[new-content offset] (cond
  252. (and (not @next-leq-level?) (true? indent-left?))
  253. [(subs content 1) -1]
  254. (and (not @next-leq-level?) (false? indent-left?))
  255. [(str (config/get-block-pattern format) content) 1]
  256. :else
  257. [nil 0])
  258. new-end-pos (if old-end-pos
  259. (+ @last-start-pos
  260. (- old-end-pos old-start-pos)
  261. offset))
  262. new-meta {:start-pos @last-start-pos
  263. :end-pos new-end-pos}]
  264. (reset! last-start-pos new-end-pos)
  265. (when-not @next-leq-level?
  266. (do
  267. (reset! block-and-children-content (str @block-and-children-content new-content))
  268. (reset! last-child-end-pos old-end-pos)))
  269. (cond->
  270. {:block/uuid uuid
  271. :block/meta new-meta}
  272. (and (some? indent-left?) (not @next-leq-level?))
  273. (assoc :block/level (if indent-left? (dec level) (inc level)))
  274. (and new-content (not @next-leq-level?))
  275. (assoc :block/content new-content)))))
  276. after-blocks)]
  277. [after-blocks @block-and-children-content @last-child-end-pos]))
  278. (defn compute-retract-refs
  279. "Computes old references to be retracted."
  280. [eid {:block/keys [ref-pages ref-blocks]} old-ref-pages old-ref-blocks]
  281. (let [ref-pages-id (map #(:db/id (db/get-page (:page/name %))) ref-pages)
  282. retracted-pages (reduce (fn [done current]
  283. (if (some #(= (:db/id current) %) ref-pages-id)
  284. done
  285. (conj done (:db/id current))))
  286. [] old-ref-pages)
  287. ref-blocks-id (map #(:db/id (db/get-page (str (last %)))) ref-blocks)
  288. retracted-blocks (reduce (fn [done current]
  289. (if (some #(= (:db/id current) %) ref-blocks-id)
  290. done
  291. (conj done (:db/id current))))
  292. [] old-ref-blocks)]
  293. ;; removes retracted pages and blocks
  294. (into
  295. (mapv (fn [ref] [:db/retract eid :block/ref-pages ref]) retracted-pages)
  296. (mapv (fn [ref] [:db/retract eid :block/ref-blocks ref]) retracted-blocks))))
  297. (defn- rebuild-block-content
  298. "We'll create an empty heading if the first parsed ast element is not a paragraph, definition list or some hiccup."
  299. [content format]
  300. (let [content-without-level-spaces (text/remove-level-spaces content format)
  301. first-block (-> content-without-level-spaces
  302. (format/to-edn format)
  303. ffirst)]
  304. (if (or (block/heading-block? first-block)
  305. (block/paragraph-block? first-block)
  306. (block/hiccup-block? first-block)
  307. (block/definition-list-block? first-block))
  308. content
  309. (text/append-newline-after-level-spaces content format))))
  310. (defn- get-edit-input-id-with-block-id
  311. [block-id]
  312. (when-let [first-block (util/get-first-block-by-id block-id)]
  313. (string/replace (gobj/get first-block "id")
  314. "ls-block"
  315. "edit-block")))
  316. ;; id: block dom id, "ls-block-counter-uuid"
  317. (defn edit-block!
  318. ([block pos format id]
  319. (edit-block! block pos format id nil))
  320. ([block pos format id {:keys [custom-content custom-properties tail-len]
  321. :or {tail-len 0}}]
  322. (when-not config/publishing?
  323. (when-let [block-id (:block/uuid block)]
  324. (let [edit-input-id (if (uuid? id)
  325. (get-edit-input-id-with-block-id id)
  326. (str (subs id 0 (- (count id) 36)) block-id))
  327. block (or
  328. block
  329. (db/pull [:block/uuid block-id])
  330. ;; dummy?
  331. {:block/uuid block-id
  332. :block/content ""})
  333. {:block/keys [content properties]} block
  334. content (or custom-content content)
  335. content (string/trim (text/remove-level-spaces content format))
  336. properties (or custom-properties properties)
  337. content (if (and (seq properties) (text/properties-hidden? properties))
  338. (text/remove-properties! content)
  339. content)
  340. content-length (count content)
  341. text-range (cond
  342. (and (> tail-len 0) (>= (count content) tail-len))
  343. (subs content 0 (- (count content) tail-len))
  344. (or (= :max pos) (<= content-length pos))
  345. content
  346. :else
  347. (subs content 0 pos))]
  348. (state/set-editing! edit-input-id content block text-range))))))
  349. (defn edit-last-block-for-new-page!
  350. [last-block pos]
  351. (when-let [first-block (util/get-first-block-by-id (:block/uuid last-block))]
  352. (edit-block!
  353. last-block
  354. pos
  355. (:block/format last-block)
  356. (string/replace (gobj/get first-block "id")
  357. "ls-block"
  358. "edit-block"))))
  359. (defn- with-time-properties
  360. [block properties]
  361. (if (and (state/enable-block-time?)
  362. (not (:block/pre-block? block)))
  363. (let [time (util/time-ms)
  364. props (into {} (:block/properties block))]
  365. (merge properties
  366. (if-let [created-at (get props "created_at")]
  367. {"created_at" created-at
  368. "last_modified_at" time}
  369. {"created_at" time
  370. "last_modified_at" time})))
  371. properties))
  372. (defn- block-text-with-time
  373. [block format value]
  374. (let [value (text/remove-level-spaces value (keyword format))
  375. properties (with-time-properties block {})]
  376. (text/re-construct-block-properties value properties)))
  377. (defn save-block-if-changed!
  378. ([block value]
  379. (save-block-if-changed! block value nil))
  380. ([{:block/keys [uuid content meta file page dummy? format repo pre-block? content ref-pages ref-blocks] :as block}
  381. value
  382. {:keys [indent-left? custom-properties remove-properties rebuild-content? auto-save?]
  383. :or {rebuild-content? true
  384. custom-properties nil
  385. remove-properties nil
  386. auto-save? false}}]
  387. (let [value value
  388. repo (or repo (state/get-current-repo))
  389. e (db/entity repo [:block/uuid uuid])
  390. block (assoc (with-block-meta repo block)
  391. ;; (into {} ...) to fix the old data
  392. :block/properties (into {} (:block/properties e)))
  393. format (or format (state/get-preferred-format))
  394. page (db/entity repo (:db/id page))
  395. ;; page properties
  396. [old-properties new-properties] (when pre-block?
  397. [(:page/properties (db/entity (:db/id page)))
  398. (mldoc/parse-properties value format)])
  399. page-tags (when-let [tags (:tags new-properties)]
  400. (util/->tags tags))
  401. page-alias (when-let [alias (:alias new-properties)]
  402. (let [alias (text/split-page-refs-without-brackets alias)
  403. alias (if (string? alias) [alias] alias)]
  404. (map
  405. (fn [alias]
  406. {:page/name (string/lower-case alias)})
  407. (remove #{(:page/name page)} alias))))
  408. permalink-changed? (when (and pre-block? (:permalink old-properties))
  409. (not= (:permalink old-properties)
  410. (:permalink new-properties)))
  411. value (if permalink-changed?
  412. (db/add-properties! format value {:old_permalink (:permalink old-properties)})
  413. value)
  414. new-properties (if permalink-changed?
  415. (assoc new-properties :old_permalink (:permalink old-properties))
  416. new-properties)
  417. text-properties (text/extract-properties value)
  418. properties (->> custom-properties
  419. (with-time-properties block)
  420. (merge text-properties))
  421. properties (if (and (seq properties) (seq remove-properties))
  422. (medley/remove-keys (fn [k] (contains? (set remove-properties) k)) properties)
  423. properties)
  424. value (text/re-construct-block-properties value properties)
  425. content-changed? (not= (text/remove-timestamp-property! (string/trim content))
  426. (text/remove-timestamp-property! (string/trim value)))]
  427. (cond
  428. content-changed?
  429. (let [file (db/entity repo (:db/id file))]
  430. (cond
  431. ;; Page was referenced but no related file
  432. ;; TODO: replace with handler.page/create!
  433. (and page (not file))
  434. (let [format (name format)
  435. title (string/capitalize (:page/name page))
  436. journal-page? (date/valid-journal-title? title)
  437. path (str
  438. (if journal-page?
  439. config/default-journals-directory
  440. (config/get-pages-directory))
  441. "/"
  442. (if journal-page?
  443. (date/journal-title->default title)
  444. (-> (:page/name page)
  445. (util/page-name-sanity))) "."
  446. (if (= format "markdown") "md" format))
  447. file-path (str "/" path)
  448. dir (util/get-repo-dir repo)]
  449. (p/let [exists? (fs/file-exists? dir file-path)]
  450. (if exists?
  451. (notification/show!
  452. [:p.content
  453. (util/format "File %s already exists!" file-path)]
  454. :error)
  455. ;; create the file
  456. (let [value (block-text-with-time nil format value)
  457. content (str (util/default-content-with-title format
  458. (or (:page/original-name page)
  459. (:page/name page)))
  460. value)]
  461. (p/let [_ (fs/create-if-not-exists repo dir file-path content)
  462. _ (git-handler/git-add repo path)]
  463. (file-handler/reset-file! repo path content)
  464. (ui-handler/re-render-root!)
  465. ;; Continue to edit the last block
  466. (let [blocks (db/get-page-blocks repo (:page/name page))
  467. last-block (last blocks)]
  468. (edit-last-block-for-new-page! last-block :max)))))))
  469. (and file page)
  470. (let [file (db/entity repo (:db/id file))
  471. file-path (:file/path file)
  472. format (format/get-format file-path)
  473. file-content (db/get-file repo file-path)
  474. value (get-block-new-value block file-content value)
  475. value (if rebuild-content?
  476. (rebuild-block-content value format)
  477. value)
  478. block (assoc block :block/content value)
  479. {:keys [blocks pages start-pos end-pos]} (if pre-block?
  480. (let [new-end-pos (utf8/length (utf8/encode value))]
  481. {:blocks [(assoc-in block [:block/meta :end-pos] new-end-pos)]
  482. :pages []
  483. :start-pos 0
  484. :end-pos new-end-pos})
  485. (block/parse-block block format))
  486. block-retracted-attrs (when-not pre-block?
  487. (when-let [id (:db/id block)]
  488. [[:db/retract id :block/priority]
  489. [:db/retract id :block/deadline]
  490. [:db/retract id :block/deadline-ast]
  491. [:db/retract id :block/scheduled]
  492. [:db/retract id :block/scheduled-ast]
  493. [:db/retract id :block/marker]
  494. [:db/retract id :block/tags]
  495. [:db/retract id :block/repeated?]]))
  496. [after-blocks block-children-content new-end-pos] (rebuild-after-blocks-indent-outdent repo file block (:end-pos (:block/meta block)) end-pos indent-left?)
  497. retract-refs (compute-retract-refs (:db/id e) (first blocks) ref-pages ref-blocks)
  498. page-id (:db/id page)
  499. modified-time (let [modified-at (tc/to-long (t/now))]
  500. [[:db/add page-id :page/last-modified-at modified-at]
  501. [:db/add (:db/id file) :file/last-modified-at modified-at]])
  502. page-properties (when pre-block?
  503. (if (seq new-properties)
  504. [[:db/retract page-id :page/properties]
  505. {:db/id page-id
  506. :page/properties new-properties}]
  507. [[:db/retract page-id :page/properties]]))
  508. pages (if (seq page-tags)
  509. (let [tag-pages (map
  510. (fn [page]
  511. {:page/original-name page
  512. :page/name page})
  513. (map :tag/name page-tags))]
  514. (concat pages tag-pages))
  515. pages)
  516. pages (remove
  517. (fn [page]
  518. (string/blank? (:page/name page)))
  519. pages)
  520. page-tags (when (and pre-block? (seq page-tags))
  521. (if (seq page-tags)
  522. [[:db/retract page-id :page/tags]
  523. {:db/id page-id
  524. :page/tags page-tags}]
  525. [[:db/retract page-id :page/tags]]))
  526. page-alias (when (and pre-block? (seq page-alias))
  527. (if (seq page-alias)
  528. [[:db/retract page-id :page/alias]
  529. {:db/id page-id
  530. :page/alias page-alias}]
  531. [[:db/retract page-id :page/alias]]))]
  532. (profile
  533. "Save block: "
  534. (repo-handler/transact-react-and-alter-file!
  535. repo
  536. (concat
  537. pages
  538. block-retracted-attrs
  539. (mapv (fn [b] {:block/uuid (:block/uuid b)}) blocks)
  540. blocks
  541. retract-refs
  542. page-properties
  543. page-tags
  544. page-alias
  545. after-blocks
  546. modified-time)
  547. {:key :block/change
  548. :data (map (fn [block] (assoc block :block/page page)) blocks)}
  549. (let [new-content (new-file-content-indent-outdent block file-content value block-children-content new-end-pos indent-left?)]
  550. [[file-path new-content]])))
  551. (when (or (seq retract-refs) pre-block?)
  552. (ui-handler/re-render-root!))
  553. (repo-handler/push-if-auto-enabled! repo))
  554. :else
  555. nil))
  556. (seq (state/get-changed-files))
  557. (repo-handler/push-if-auto-enabled! repo)
  558. :else
  559. nil))))
  560. (defn insert-new-block-aux!
  561. [{:block/keys [uuid content meta file dummy? level repo page format properties collapsed?] :as block}
  562. value
  563. {:keys [create-new-block? ok-handler with-level? new-level current-page blocks-container-id]}]
  564. (let [value (or value "")
  565. block-page? (and current-page (util/uuid-string? current-page))
  566. block-self? (= uuid (and block-page? (medley/uuid current-page)))
  567. input (gdom/getElement (state/get-edit-input-id))
  568. pos (if new-level
  569. (dec (count value))
  570. (util/get-input-pos input))
  571. repo (or repo (state/get-current-repo))
  572. block-has-children? (seq (:block/children block))
  573. fst-block-text (subs value 0 pos)
  574. snd-block-text (string/triml (subs value pos))
  575. fst-block-text (string/trim (if with-level? fst-block-text (block/with-levels fst-block-text format block)))
  576. edit-self? (and block-has-children? (zero? pos))
  577. snd-block-text-level (cond
  578. new-level
  579. new-level
  580. (or block-self?
  581. (and block-has-children?
  582. (not (zero? pos))))
  583. (inc level)
  584. :else
  585. level)
  586. snd-block-text (if (and snd-block-text
  587. (re-find (re-pattern (util/format "^[%s]+\\s+" (config/get-block-pattern format))) snd-block-text))
  588. snd-block-text
  589. (rebuild-block-content
  590. (str (config/default-empty-block format snd-block-text-level) " " snd-block-text)
  591. format))
  592. block (with-block-meta repo block)
  593. original-id (:block/uuid block)
  594. format (:block/format block)
  595. page (db/entity repo (:db/id page))
  596. file (db/entity repo (:db/id file))
  597. insert-block (fn [block file-path file-content]
  598. (let [value (if create-new-block?
  599. (str fst-block-text "\n" snd-block-text)
  600. value)
  601. text-properties (text/extract-properties fst-block-text)
  602. properties (with-time-properties block text-properties)
  603. value (text/re-construct-block-properties value properties)
  604. value (rebuild-block-content value format)
  605. [new-content value] (new-file-content block file-content value)
  606. parse-result (block/parse-block (assoc block :block/content value) format)
  607. id-conflict? (some #(= original-id (:block/uuid %)) (next (:blocks parse-result)))
  608. {:keys [blocks pages start-pos end-pos]}
  609. (if id-conflict?
  610. (let [new-value (string/replace
  611. value
  612. (re-pattern (str "(?i):(custom_)?id: " original-id))
  613. "")]
  614. (block/parse-block (assoc block :block/content new-value) format))
  615. parse-result)
  616. after-blocks (rebuild-after-blocks repo file (:end-pos meta) end-pos)
  617. files [[file-path new-content]]
  618. transact-fn (fn []
  619. (repo-handler/transact-react-and-alter-file!
  620. repo
  621. (concat
  622. pages
  623. (mapv (fn [b] {:block/uuid (:block/uuid b)}) blocks)
  624. blocks
  625. after-blocks)
  626. {:key :block/insert
  627. :data (map (fn [block] (assoc block :block/page page)) blocks)}
  628. files)
  629. (state/set-editor-op! nil))]
  630. ;; Replace with batch transactions
  631. (state/add-tx! transact-fn)
  632. (let [blocks (remove (fn [block]
  633. (nil? (:block/content block))) blocks)
  634. page-blocks-atom (db/get-page-blocks-cache-atom repo (:db/id page))
  635. first-block-id (:block/uuid (first blocks))
  636. [before-part after-part] (and page-blocks-atom
  637. (split-with
  638. #(not= first-block-id (:block/uuid %))
  639. @page-blocks-atom))
  640. after-part (rest after-part)
  641. blocks-container-id (and blocks-container-id
  642. (util/uuid-string? blocks-container-id)
  643. (medley/uuid blocks-container-id))]
  644. ; WORKAROUND: The block won't refresh itself even if the content is empty.
  645. (when edit-self?
  646. (gobj/set input "value" ""))
  647. (when ok-handler
  648. (ok-handler
  649. (if edit-self? (first blocks) (last blocks))))
  650. ;; update page blocks cache if exists
  651. (when page-blocks-atom
  652. (reset! page-blocks-atom (->> (concat before-part blocks after-part)
  653. (remove nil?))))
  654. ;; update block children cache if exists
  655. (when blocks-container-id
  656. (let [blocks-atom (db/get-block-blocks-cache-atom repo blocks-container-id)
  657. [before-part after-part] (and blocks-atom
  658. (split-with
  659. #(not= first-block-id (:block/uuid %))
  660. @blocks-atom))
  661. after-part (rest after-part)]
  662. (and blocks-atom
  663. (reset! blocks-atom (->> (concat before-part blocks after-part)
  664. (remove nil?)))))))))]
  665. (cond
  666. (and (not file) page)
  667. ;; TODO: replace with handler.page/create!
  668. (let [format (name format)
  669. title (string/capitalize (:page/name page))
  670. journal-page? (date/valid-journal-title? title)
  671. path (str
  672. (if journal-page?
  673. config/default-journals-directory
  674. (config/get-pages-directory))
  675. "/"
  676. (if journal-page?
  677. (date/journal-title->default title)
  678. (-> (:page/name page)
  679. (util/page-name-sanity)))
  680. "."
  681. (if (= format "markdown") "md" format))
  682. file-path (str "/" path)
  683. dir (util/get-repo-dir repo)]
  684. (p/let [exists? (fs/file-exists? dir file-path)]
  685. (if exists?
  686. (do (notification/show!
  687. [:p.content
  688. (util/format "File %s already exists!"
  689. file-path)]
  690. :error)
  691. (state/set-editor-op! nil))
  692. ;; create the file
  693. (let [content (util/default-content-with-title format (or
  694. (:page/original-name page)
  695. (:page/name page)))]
  696. (p/let [_ (fs/create-if-not-exists repo dir file-path content)
  697. _ (git-handler/git-add repo path)]
  698. (let [value (block-text-with-time nil format value)]
  699. (file-handler/reset-file! repo path
  700. (str content
  701. value
  702. "\n"
  703. snd-block-text)))
  704. (ui-handler/re-render-root!)
  705. ;; Continue to edit the last block
  706. (let [blocks (db/get-page-blocks repo (:page/name page))
  707. last-block (last blocks)]
  708. (edit-last-block-for-new-page! last-block 0))
  709. (state/set-editor-op! nil))))))
  710. file
  711. (let [file-path (:file/path file)
  712. file-content (db/get-file repo file-path)]
  713. (insert-block block file-path file-content))
  714. :else
  715. nil)))
  716. (defn clear-when-saved!
  717. []
  718. (state/set-editor-show-input! nil)
  719. (state/set-editor-show-date-picker! false)
  720. (state/set-editor-show-page-search! false)
  721. (state/set-editor-show-block-search! false)
  722. (state/set-editor-show-template-search! false)
  723. (commands/restore-state true))
  724. (defn get-state
  725. [state]
  726. (let [[{:keys [on-hide block block-id block-parent-id dummy? format sidebar?]} id config] (:rum/args state)
  727. node (gdom/getElement id)
  728. value (gobj/get node "value")
  729. pos (gobj/get node "selectionStart")]
  730. {:config config
  731. :on-hide on-hide
  732. :dummy? dummy?
  733. :sidebar? sidebar?
  734. :format format
  735. :id id
  736. :block block
  737. :block-id block-id
  738. :block-parent-id block-parent-id
  739. :node node
  740. :value value
  741. :pos pos}))
  742. (defn- with-timetracking-properties
  743. [block value]
  744. (let [new-marker (first (re-find format/bare-marker-pattern (or value "")))
  745. new-marker (if new-marker (string/lower-case (string/trim new-marker)))]
  746. (if (and
  747. new-marker
  748. (not= new-marker (string/lower-case (or (:block/marker block) "")))
  749. (state/enable-timetracking?))
  750. {new-marker (util/time-ms)}
  751. {})))
  752. (defn insert-new-block!
  753. [state]
  754. (when (and (not config/publishing?)
  755. ;; skip this operation if it's inserting
  756. (not= :insert (state/get-editor-op)))
  757. (state/set-editor-op! :insert)
  758. (let [{:keys [block value format id config]} (get-state state)
  759. block-id (:block/uuid block)
  760. block (or (db/pull [:block/uuid block-id])
  761. block)
  762. collapsed? (:block/collapsed? block)
  763. repo (or (:block/repo block) (state/get-current-repo))
  764. last-child (and collapsed?
  765. (last (db/get-block-and-children-no-cache repo (:block/uuid block))))
  766. last-child (when (not= (:block/uuid last-child)
  767. (:block/uuid block))
  768. last-child)
  769. new-block (or last-child block)
  770. new-value (if last-child (:block/content last-child) value)
  771. properties (with-timetracking-properties new-block new-value)]
  772. ;; save the current block and insert a new block
  773. (insert-new-block-aux!
  774. (assoc new-block :block/properties properties)
  775. new-value
  776. {:create-new-block? true
  777. :ok-handler
  778. (fn [last-block]
  779. (let [last-id (:block/uuid last-block)]
  780. (edit-block! last-block 0 format id)
  781. (clear-when-saved!)))
  782. :with-level? (if last-child true false)
  783. :new-level (and last-child (:block/level block))
  784. :blocks-container-id (:id config)
  785. :current-page (state/get-current-page)}))))
  786. (defn insert-new-block-without-save-previous!
  787. [config last-block]
  788. (let [format (:block/format last-block)
  789. id (:id config)
  790. new-level (if (util/uuid-string? id)
  791. (inc (:block/level (db/entity [:block/uuid (medley/uuid id)])))
  792. 2)]
  793. (insert-new-block-aux!
  794. last-block
  795. (:block/content last-block)
  796. {:create-new-block? true
  797. :ok-handler
  798. (fn [last-block]
  799. (js/setTimeout #(edit-last-block-for-new-page! last-block :max) 50))
  800. :with-level? true
  801. :new-level new-level
  802. :blocks-container-id (:id config)
  803. :current-page (state/get-current-page)})))
  804. (defn update-timestamps-content!
  805. [{:block/keys [repeated? scheduled-ast deadline-ast marker]} content]
  806. (if repeated?
  807. (let [content (some->> (filter repeated/repeated? [scheduled-ast deadline-ast])
  808. (map (fn [ts]
  809. [(repeated/timestamp->text ts)
  810. (repeated/next-timestamp-text ts)]))
  811. (reduce (fn [content [old new]]
  812. (string/replace content old new))
  813. content))]
  814. (when content
  815. (str (string/trimr content)
  816. "\n"
  817. (util/format "- %s -> DONE [%s]"
  818. marker
  819. (date/get-local-date-time-string)))))
  820. content))
  821. (defn- with-marker-time
  822. [block marker]
  823. (if (state/enable-timetracking?)
  824. (let [marker (string/lower-case marker)]
  825. {marker (util/time-ms)})
  826. {}))
  827. (defn check
  828. [{:block/keys [uuid marker content meta file dummy? repeated?] :as block}]
  829. (let [new-content (string/replace-first content marker "DONE")
  830. new-content (if repeated?
  831. (update-timestamps-content! block content)
  832. new-content)]
  833. (save-block-if-changed! block new-content
  834. {:custom-properties (with-marker-time block "DONE")})))
  835. (defn uncheck
  836. [{:block/keys [uuid marker content meta file dummy?] :as block}]
  837. (let [marker (if (= :now (state/get-preferred-workflow))
  838. "LATER"
  839. "TODO")
  840. new-content (string/replace-first content "DONE" marker)]
  841. (save-block-if-changed! block new-content
  842. {:custom-properties (with-marker-time block marker)})))
  843. (defn cycle-todo!
  844. []
  845. (when-let [block (state/get-edit-block)]
  846. (let [edit-input-id (state/get-edit-input-id)
  847. current-input (gdom/getElement edit-input-id)
  848. content (state/get-edit-content)
  849. [new-content marker] (cond
  850. (util/starts-with? content "TODO")
  851. [(string/replace-first content "TODO" "DOING") "DOING"]
  852. (util/starts-with? content "DOING")
  853. [(string/replace-first content "DOING" "DONE") "DONE"]
  854. (util/starts-with? content "LATER")
  855. [(string/replace-first content "LATER" "NOW") "NOW"]
  856. (util/starts-with? content "NOW")
  857. [(string/replace-first content "NOW" "DONE") "DONE"]
  858. (util/starts-with? content "DONE")
  859. [(string/replace-first content "DONE" "") nil]
  860. :else
  861. (let [marker (if (= :now (state/get-preferred-workflow))
  862. "LATER"
  863. "TODO")]
  864. [(str marker " " (string/triml content)) marker]))
  865. new-content (string/triml new-content)]
  866. (let [new-pos (commands/compute-pos-delta-when-change-marker
  867. current-input content new-content marker (util/get-input-pos current-input))]
  868. (state/set-edit-content! edit-input-id new-content)
  869. (util/set-caret-pos! current-input new-pos)))))
  870. (defn set-marker
  871. [{:block/keys [uuid marker content meta file dummy? properties] :as block} new-marker]
  872. (let [new-content (string/replace-first content marker new-marker)]
  873. (save-block-if-changed! block new-content
  874. (with-marker-time block marker))))
  875. (defn set-priority
  876. [{:block/keys [uuid marker priority content meta file dummy?] :as block} new-priority]
  877. (let [new-content (string/replace-first content
  878. (util/format "[#%s]" priority)
  879. (util/format "[#%s]" new-priority))]
  880. (save-block-if-changed! block new-content)))
  881. (defn- get-prev-block-non-collapsed
  882. [block]
  883. (let [id (gobj/get block "id")
  884. prefix (re-find #"ls-block-[\d]+" id)]
  885. (when-let [blocks (d/by-class "ls-block")]
  886. (when-let [index (.indexOf blocks block)]
  887. (loop [idx (dec index)]
  888. (when (>= idx 0)
  889. (let [block (nth blocks idx)
  890. collapsed? (= "none" (d/style block "display"))
  891. prefix-match? (util/starts-with? (gobj/get block "id") prefix)]
  892. (if (or collapsed?
  893. ;; might be embed blocks
  894. (not prefix-match?))
  895. (recur (dec idx))
  896. block))))))))
  897. (defn- get-next-block-non-collapsed
  898. [block]
  899. (let [id (gobj/get block "id")
  900. prefix (re-find #"ls-block-[\d]+" id)]
  901. (when-let [blocks (d/by-class "ls-block")]
  902. (when-let [index (.indexOf blocks block)]
  903. (loop [idx (inc index)]
  904. (when (>= (count blocks) idx)
  905. (when-let [block (util/nth-safe blocks idx)]
  906. (let [collapsed? (= "none" (d/style block "display"))
  907. prefix-match? (util/starts-with? (gobj/get block "id") prefix)]
  908. (if (or collapsed?
  909. ;; might be embed blocks
  910. (not prefix-match?))
  911. (recur (inc idx))
  912. block)))))))))
  913. (defn delete-block-aux!
  914. [{:block/keys [uuid meta content file repo ref-pages ref-blocks] :as block} dummy?]
  915. (when-not dummy?
  916. (let [repo (or repo (state/get-current-repo))
  917. block (db/pull repo '[*] [:block/uuid uuid])]
  918. (when block
  919. (let [file-path (:file/path (db/entity repo (:db/id file)))
  920. file-content (db/get-file repo file-path)
  921. after-blocks (rebuild-after-blocks repo file (:end-pos meta) (:start-pos meta))
  922. new-content (utf8/delete! file-content (:start-pos meta) (:end-pos meta))]
  923. (repo-handler/transact-react-and-alter-file!
  924. repo
  925. (concat
  926. [[:db.fn/retractEntity [:block/uuid uuid]]]
  927. after-blocks)
  928. {:key :block/change
  929. :data [block]}
  930. [[file-path new-content]])
  931. (when (or (seq ref-pages) (seq ref-blocks))
  932. (ui-handler/re-render-root!)))))))
  933. (defn delete-block!
  934. [state repo e]
  935. (let [{:keys [id block-id block-parent-id dummy? value pos format]} (get-state state)]
  936. (when (and block-id
  937. (not= :block/delete (state/get-editor-op)))
  938. (state/set-editor-op! :block/delete)
  939. (let [page-id (:db/id (:block/page (db/entity [:block/uuid block-id])))
  940. page-blocks-count (and page-id (db/get-page-blocks-count repo page-id))
  941. page (and page-id (db/entity page-id))]
  942. (if (> page-blocks-count 1)
  943. (do
  944. (util/stop e)
  945. ;; delete block, edit previous block
  946. (let [block (db/pull [:block/uuid block-id])
  947. block-parent (gdom/getElement block-parent-id)
  948. sibling-block (get-prev-block-non-collapsed block-parent)]
  949. (delete-block-aux! block dummy?)
  950. (when (and repo sibling-block)
  951. (when-let [sibling-block-id (d/attr sibling-block "blockid")]
  952. (when-let [block (db/pull repo '[*] [:block/uuid (uuid sibling-block-id)])]
  953. (let [original-content (util/trim-safe (:block/content block))
  954. new-value (str original-content " " (string/triml value))
  955. tail-len (count (string/triml value))
  956. pos (max
  957. (if original-content
  958. (utf8/length (utf8/encode (text/remove-level-spaces original-content format)))
  959. 0)
  960. 0)]
  961. (edit-block! block pos format id
  962. {:custom-content new-value
  963. :tail-len tail-len})))))))))
  964. (state/set-editor-op! nil))))
  965. (defn delete-blocks!
  966. [repo block-uuids]
  967. (when (seq block-uuids)
  968. (let [current-page (state/get-current-page)
  969. top-block-id (and current-page
  970. (util/uuid-string? current-page)
  971. (medley/uuid current-page))
  972. top-block? (and top-block-id
  973. (= top-block-id (first block-uuids)))]
  974. (let [blocks (db/pull-many repo '[*] (mapv (fn [id]
  975. [:block/uuid id])
  976. block-uuids))
  977. page (db/entity repo (:db/id (:block/page (first blocks))))
  978. first-block (first blocks)
  979. last-block (last blocks)
  980. file (db/entity repo (:db/id (:block/file first-block)))
  981. file-path (:file/path file)
  982. file-content (db/get-file repo file-path)
  983. start-pos (:start-pos (:block/meta first-block))
  984. end-pos (:end-pos (:block/meta last-block))
  985. after-blocks (rebuild-after-blocks repo file end-pos start-pos)
  986. new-content (utf8/delete! file-content start-pos end-pos)
  987. retract-blocks-tx (mapv
  988. (fn [uuid]
  989. [:db.fn/retractEntity [:block/uuid uuid]])
  990. block-uuids)
  991. tx-data (concat
  992. retract-blocks-tx
  993. after-blocks
  994. [{:file/path file-path}])]
  995. (repo-handler/transact-react-and-alter-file!
  996. repo
  997. tx-data
  998. {:key :block/change
  999. :data blocks}
  1000. [[file-path new-content]])
  1001. (when top-block?
  1002. (route-handler/redirect! {:to :page
  1003. :path-params {:name (:page/name page)}})
  1004. (ui-handler/re-render-root!))
  1005. (repo-handler/push-if-auto-enabled! repo)))))
  1006. (defn remove-block-property!
  1007. [block-id key]
  1008. (let [block-id (if (string? block-id) (uuid block-id) block-id)
  1009. key (string/lower-case (str key))]
  1010. (when-let [block (db/pull [:block/uuid block-id])]
  1011. (let [{:block/keys [content properties]} block]
  1012. (when (get properties key)
  1013. (save-block-if-changed! block content
  1014. {:remove-properties [key]}))))))
  1015. (defn set-block-property!
  1016. [block-id key value]
  1017. (let [block-id (if (string? block-id) (uuid block-id) block-id)
  1018. key (string/lower-case (str key))
  1019. value (str value)]
  1020. (when-let [block (db/pull [:block/uuid block-id])]
  1021. (when-not (:block/pre-block? block)
  1022. (let [{:block/keys [content properties]} block]
  1023. (cond
  1024. (and (get properties key)
  1025. (= (string/trim (get properties key)) value))
  1026. nil
  1027. :else
  1028. (save-block-if-changed! block content
  1029. {:custom-properties {key value}
  1030. :rebuild-content? false})))))))
  1031. (defn set-block-timestamp!
  1032. [block-id key value]
  1033. (let [key (string/lower-case key)
  1034. scheduled? (= key "scheduled")
  1035. deadline? (= key "deadline")
  1036. block-id (if (string? block-id) (uuid block-id) block-id)
  1037. key (string/lower-case (str key))
  1038. value (str value)]
  1039. (when-let [block (db/pull [:block/uuid block-id])]
  1040. (let [{:block/keys [content scheduled deadline format]} block
  1041. content (or (when-let [edit-content (state/get-edit-content)]
  1042. (block/with-levels edit-content format block))
  1043. content)
  1044. new-line (str (string/upper-case key) ": " value)
  1045. new-content (cond
  1046. ;; update
  1047. (or
  1048. (and deadline deadline?)
  1049. (and scheduled scheduled?))
  1050. (let [lines (string/split-lines content)
  1051. body (map (fn [line]
  1052. (if (string/starts-with? (string/lower-case line) key)
  1053. new-line
  1054. line))
  1055. (rest lines))]
  1056. (->> (cons (first lines) body)
  1057. (string/join "\n")))
  1058. ;; insert
  1059. (or deadline? scheduled?)
  1060. (let [[title body] (if (string/includes? content "\n")
  1061. (util/split-first "\n" content)
  1062. [content ""])]
  1063. (str title "\n"
  1064. new-line
  1065. "\n" (util/trim-only-newlines body)))
  1066. :else
  1067. content)]
  1068. (when (not= content new-content)
  1069. (if-let [input-id (state/get-edit-input-id)]
  1070. (state/set-edit-content! input-id new-content)
  1071. (save-block-if-changed! block new-content)))))))
  1072. (defn copy-block-ref!
  1073. ([block-id] (copy-block-ref! block-id #(str %)))
  1074. ([block-id tap-clipboard]
  1075. (let [block (db/entity [:block/uuid block-id])]
  1076. (when-not (:block/pre-block? block)
  1077. (set-block-property! block-id "id" (str block-id))))
  1078. (util/copy-to-clipboard! (tap-clipboard block-id))))
  1079. (defn clear-selection!
  1080. [_e]
  1081. (when (state/in-selection-mode?)
  1082. (doseq [block (state/get-selection-blocks)]
  1083. (dom/remove-class! block "selected")
  1084. (dom/remove-class! block "noselect"))
  1085. (state/clear-selection!)))
  1086. (defn clear-selection-blocks!
  1087. []
  1088. (when (state/in-selection-mode?)
  1089. (doseq [block (state/get-selection-blocks)]
  1090. (dom/remove-class! block "selected")
  1091. (dom/remove-class! block "noselect"))
  1092. (state/clear-selection-blocks!)))
  1093. (defn exit-editing-and-set-selected-blocks!
  1094. [blocks]
  1095. (util/clear-selection!)
  1096. (state/clear-edit!)
  1097. (state/set-selection-blocks! blocks))
  1098. (defn select-all-blocks!
  1099. []
  1100. (when-let [current-input-id (state/get-edit-input-id)]
  1101. (let [input (gdom/getElement current-input-id)
  1102. blocks-container (util/rec-get-blocks-container input)
  1103. blocks (dom/by-class blocks-container "ls-block")]
  1104. (doseq [block blocks]
  1105. (dom/add-class! block "selected noselect"))
  1106. (exit-editing-and-set-selected-blocks! blocks))))
  1107. (defn- get-selected-blocks-with-children
  1108. []
  1109. (when-let [blocks (seq (get @state/state :selection/blocks))]
  1110. (mapcat (fn [block]
  1111. (cons block
  1112. (array-seq (dom/by-class block "ls-block"))))
  1113. blocks)))
  1114. (defn copy-selection-blocks
  1115. []
  1116. (when-let [blocks (seq (get-selected-blocks-with-children))]
  1117. (let [repo (dom/attr (first blocks) "repo")
  1118. ids (->> (distinct (map #(when-let [id (dom/attr % "blockid")]
  1119. (uuid id)) blocks))
  1120. (remove nil?))
  1121. up? (state/selection-up?)
  1122. content (some->> (db/get-blocks-contents repo ids)
  1123. (map :block/content))
  1124. content (if (false? up?) (reverse content) content)
  1125. content (string/join "" content)]
  1126. (when-not (string/blank? content)
  1127. (common-handler/copy-to-clipboard-without-id-property! content)))))
  1128. (defn cut-selection-blocks
  1129. []
  1130. (copy-selection-blocks)
  1131. (when-let [blocks (seq (get-selected-blocks-with-children))]
  1132. (let [repo (dom/attr (first blocks) "repo")
  1133. ids (distinct (map #(uuid (dom/attr % "blockid")) blocks))]
  1134. (delete-blocks! repo ids))))
  1135. (defn- get-nearest-page
  1136. []
  1137. (when-let [block (state/get-edit-block)]
  1138. (when-let [id (:block/uuid block)]
  1139. (when-let [edit-id (state/get-edit-input-id)]
  1140. (when-let [input (gdom/getElement edit-id)]
  1141. (when-let [pos (util/get-input-pos input)]
  1142. (let [value (gobj/get input "value")
  1143. page-pattern #"\[\[([^\]]+)]]"
  1144. block-pattern #"\(\(([^\)]+)\)\)"
  1145. page-matches (util/re-pos page-pattern value)
  1146. block-matches (util/re-pos block-pattern value)
  1147. matches (->> (concat page-matches block-matches)
  1148. (remove nil?))
  1149. [_ page] (first (sort-by
  1150. (fn [[start-pos content]]
  1151. (let [end-pos (+ start-pos (count content))]
  1152. (cond
  1153. (< pos start-pos)
  1154. (- pos start-pos)
  1155. (> pos end-pos)
  1156. (- end-pos pos)
  1157. :else
  1158. 0)))
  1159. >
  1160. matches))]
  1161. (when page
  1162. (subs page 2 (- (count page) 2))))))))))
  1163. (defn follow-link-under-cursor!
  1164. []
  1165. (when-let [page (get-nearest-page)]
  1166. (let [page-name (string/lower-case page)]
  1167. (state/clear-edit!)
  1168. (route-handler/redirect! {:to :page
  1169. :path-params {:name page-name}}))))
  1170. (defn open-link-in-sidebar!
  1171. []
  1172. (when-let [page (get-nearest-page)]
  1173. (let [page-name (string/lower-case page)
  1174. block? (util/uuid-string? page-name)]
  1175. (when-let [page (db/get-page page-name)]
  1176. (if block?
  1177. (state/sidebar-add-block!
  1178. (state/get-current-repo)
  1179. (:db/id page)
  1180. :block
  1181. page)
  1182. (state/sidebar-add-block!
  1183. (state/get-current-repo)
  1184. (:db/id page)
  1185. :page
  1186. {:page page}))))))
  1187. (defn zoom-in! []
  1188. (if-let [block (state/get-edit-block)]
  1189. (when-let [id (:block/uuid block)]
  1190. (route-handler/redirect! {:to :page
  1191. :path-params {:name (str id)}}))
  1192. (js/window.history.forward)))
  1193. (defn zoom-out! []
  1194. (let [page (state/get-current-page)
  1195. block-id (and
  1196. (string? page)
  1197. (util/uuid-string? page)
  1198. (medley/uuid page))]
  1199. (if block-id
  1200. (let [repo (state/get-current-repo)
  1201. block-parent (db/get-block-parent repo block-id)]
  1202. (if-let [id (:block/uuid block-parent)]
  1203. (route-handler/redirect! {:to :page
  1204. :path-params {:name (str id)}})
  1205. (let [page-id (-> (db/entity [:block/uuid block-id])
  1206. :block/page
  1207. :db/id)]
  1208. (when-let [page-name (:page/name (db/entity repo page-id))]
  1209. (route-handler/redirect! {:to :page
  1210. :path-params {:name page-name}})))))
  1211. (js/window.history.back))))
  1212. (defn cut-block!
  1213. [block-id]
  1214. (when-let [block (db/pull [:block/uuid block-id])]
  1215. (let [content (:block/content block)]
  1216. (common-handler/copy-to-clipboard-without-id-property! content)
  1217. (delete-block-aux! block false))))
  1218. (defonce select-start-block-state (atom nil))
  1219. (defn clear-last-selected-block!
  1220. []
  1221. (let [first-block (state/pop-selection-block!)]
  1222. (dom/remove-class! first-block "selected")
  1223. (dom/remove-class! first-block "noselect")))
  1224. (defn input-start-or-end?
  1225. ([input]
  1226. (input-start-or-end? input nil))
  1227. ([input up?]
  1228. (let [value (gobj/get input "value")
  1229. start (gobj/get input "selectionStart")
  1230. end (gobj/get input "selectionEnd")]
  1231. (if (nil? up?)
  1232. (or (= start 0) (= end (count value)))
  1233. (or (and (= start 0) up?)
  1234. (and (= end (count value)) (not up?)))))))
  1235. (defn highlight-selection-area!
  1236. [end-block]
  1237. (when-let [start-block (:selection/start-block @state/state)]
  1238. (clear-selection-blocks!)
  1239. (let [blocks (util/get-nodes-between-two-nodes start-block end-block "ls-block")]
  1240. (doseq [block blocks]
  1241. (dom/add-class! block "selected noselect"))
  1242. (exit-editing-and-set-selected-blocks! blocks))))
  1243. (defn on-select-block
  1244. [state e up?]
  1245. (when (and
  1246. (gobj/get e "shiftKey")
  1247. (not (gobj/get e "altKey"))
  1248. (or (state/in-selection-mode?)
  1249. (when-let [input-id (state/get-edit-input-id)]
  1250. (when-let [input (gdom/getElement input-id)]
  1251. (input-start-or-end? input up?)))))
  1252. (state/clear-edit!)
  1253. (let [{:keys [id block-id block block-parent-id dummy? value pos format] :as block-state} @select-start-block-state
  1254. element (gdom/getElement block-parent-id)
  1255. selected-blocks (state/get-selection-blocks)
  1256. selected-blocks-count (count selected-blocks)
  1257. first-block (first selected-blocks)
  1258. selection-up? (state/selection-up?)]
  1259. (when block-id
  1260. (util/stop e)
  1261. (when-let [element (if-not (state/in-selection-mode?)
  1262. element
  1263. (let [f (if up? util/get-prev-block util/get-next-block)]
  1264. (f first-block)))]
  1265. (if (and (not (nil? selection-up?)) (not= up? selection-up?))
  1266. (cond
  1267. (>= selected-blocks-count 2) ; back to the start block
  1268. (do
  1269. (when (= 2 selected-blocks-count) (state/set-selection-up! nil))
  1270. (clear-last-selected-block!))
  1271. :else
  1272. nil)
  1273. (do
  1274. (util/clear-selection!)
  1275. (state/clear-edit!)
  1276. (state/conj-selection-block! element up?))))))))
  1277. (defn save-block-aux!
  1278. [block value format opts]
  1279. (let [value (text/remove-level-spaces value format true)
  1280. new-value (block/with-levels value format block)
  1281. properties (with-timetracking-properties block value)]
  1282. ;; FIXME: somehow frontend.components.editor's will-unmount event will loop forever
  1283. ;; maybe we shouldn't save the block/file in "will-unmount" event?
  1284. (save-block-if-changed! block new-value
  1285. (merge
  1286. {:custom-properties properties}
  1287. opts))))
  1288. (defn save-block!
  1289. [{:keys [format block id repo dummy?] :as state} value]
  1290. (when (or (:db/id (db/entity repo [:block/uuid (:block/uuid block)]))
  1291. dummy?)
  1292. (save-block-aux! block value format {})))
  1293. (defn save-current-block-when-idle!
  1294. []
  1295. (when-let [repo (state/get-current-repo)]
  1296. (when (and (state/input-idle? repo)
  1297. (not (state/get-editor-show-page-search?))
  1298. (not (state/get-editor-show-page-search-hashtag?))
  1299. (not (state/get-editor-show-block-search?)))
  1300. (state/set-editor-op! :auto-save)
  1301. (try
  1302. (let [input-id (state/get-edit-input-id)
  1303. block (state/get-edit-block)
  1304. db-block (when-let [block-id (:block/uuid block)]
  1305. (db/pull [:block/uuid block-id]))
  1306. elem (and input-id (gdom/getElement input-id))
  1307. db-content (:block/content db-block)
  1308. db-content-without-heading (and db-content
  1309. (util/safe-subs db-content (:block/level db-block)))
  1310. value (and elem (gobj/get elem "value"))]
  1311. (when (and block value db-content-without-heading
  1312. (or
  1313. (not= (string/trim db-content-without-heading)
  1314. (string/trim value))))
  1315. (let [cur-pos (util/get-input-pos elem)]
  1316. (save-block-aux! db-block value (:block/format db-block)
  1317. {:auto-save? true}))))
  1318. (catch js/Error error
  1319. (log/error :save-block-failed error)))
  1320. (state/set-editor-op! nil))))
  1321. (defn on-up-down
  1322. [state e up?]
  1323. (let [{:keys [id block-id block block-parent-id dummy? value pos format] :as block-state} (get-state state)]
  1324. (if (gobj/get e "shiftKey")
  1325. (reset! select-start-block-state block-state)
  1326. (let [element (gdom/getElement id)
  1327. line-height (util/get-textarea-line-height element)]
  1328. (when (and block-id
  1329. (or (and up? (util/textarea-cursor-first-row? element line-height))
  1330. (and (not up?) (util/textarea-cursor-end-row? element line-height))))
  1331. (util/stop e)
  1332. (let [f (if up? get-prev-block-non-collapsed get-next-block-non-collapsed)
  1333. sibling-block (f (gdom/getElement block-parent-id))]
  1334. (when sibling-block
  1335. (when-let [sibling-block-id (d/attr sibling-block "blockid")]
  1336. (let [state (get-state state)
  1337. content (:block/content block)
  1338. value (:value state)]
  1339. (when (not= (-> content
  1340. (text/remove-level-spaces format)
  1341. text/remove-properties!
  1342. string/trim)
  1343. (string/trim value))
  1344. (save-block! state (:value state))))
  1345. (let [block (db/pull (state/get-current-repo) '[*] [:block/uuid (uuid sibling-block-id)])]
  1346. (edit-block! block pos format id))))))))))
  1347. (defn insert-command!
  1348. [id command-output format {:keys [restore?]
  1349. :or {restore? true}
  1350. :as option}]
  1351. (cond
  1352. ;; replace string
  1353. (string? command-output)
  1354. (commands/insert! id command-output option)
  1355. ;; steps
  1356. (vector? command-output)
  1357. (commands/handle-steps command-output format)
  1358. (fn? command-output)
  1359. (let [s (command-output)]
  1360. (commands/insert! id s option))
  1361. :else
  1362. nil)
  1363. (when restore?
  1364. (let [restore-slash-caret-pos? (if (and
  1365. (seq? command-output)
  1366. (= :editor/click-hidden-file-input
  1367. (ffirst command-output)))
  1368. false
  1369. true)]
  1370. (commands/restore-state restore-slash-caret-pos?))))
  1371. (defn- get-image-link
  1372. [format url file-name]
  1373. (case (keyword format)
  1374. :markdown (util/format "![%s](%s)" file-name url)
  1375. :org (util/format "[[%s][%s]]" url file-name)
  1376. nil))
  1377. (defn upload-image
  1378. [id files format uploading? drop?]
  1379. (image/upload
  1380. files
  1381. (fn [file file-name file-type]
  1382. (image-handler/request-presigned-url
  1383. file file-name file-type
  1384. uploading?
  1385. (fn [signed-url]
  1386. (insert-command! id
  1387. (get-image-link format signed-url file-name)
  1388. format
  1389. {:last-pattern (if drop? "" commands/slash)
  1390. :restore? true})
  1391. (reset! *image-uploading-process 0))
  1392. (fn [e]
  1393. (let [process (* (/ (gobj/get e "loaded")
  1394. (gobj/get e "total"))
  1395. 100)]
  1396. (reset! *image-uploading-process process)))))))
  1397. ;; Editor should track some useful information, like editor modes.
  1398. ;; For example:
  1399. ;; 1. Which file format is it, markdown or org mode?
  1400. ;; 2. Is it in the properties area? Then we can enable the ":" autopair
  1401. (def autopair-map
  1402. {"[" "]"
  1403. "{" "}"
  1404. "(" ")"
  1405. "`" "`"
  1406. "~" "~"
  1407. "*" "*"
  1408. ;; "_" "_"
  1409. ;; ":" ":" ; TODO: only properties editing and org mode tag
  1410. ;; "^" "^"
  1411. })
  1412. (def reversed-autopair-map
  1413. (zipmap (vals autopair-map)
  1414. (keys autopair-map)))
  1415. (def delete-map
  1416. (assoc autopair-map
  1417. "$" "$"
  1418. ":" ":"))
  1419. (def reversed-delete-map
  1420. (zipmap (vals delete-map)
  1421. (keys delete-map)))
  1422. (defn autopair
  1423. [input-id prefix format {:keys [restore?]
  1424. :or {restore? true}
  1425. :as option}]
  1426. (let [value (get autopair-map prefix)
  1427. selected (util/get-selected-text)
  1428. postfix (str selected value)
  1429. value (str prefix postfix)
  1430. input (gdom/getElement input-id)]
  1431. (when value
  1432. (when-not (string/blank? selected) (reset! *selected-text selected))
  1433. (let [[prefix pos] (commands/simple-replace! input-id value selected
  1434. {:backward-pos (count postfix)
  1435. :check-fn (fn [new-value prefix-pos]
  1436. (when (>= prefix-pos 0)
  1437. [(subs new-value prefix-pos (+ prefix-pos 2))
  1438. (+ prefix-pos 2)]))})]
  1439. (case prefix
  1440. "[["
  1441. (do
  1442. (commands/handle-step [:editor/search-page])
  1443. (reset! commands/*slash-caret-pos (util/get-caret-pos input)))
  1444. "(("
  1445. (do
  1446. (commands/handle-step [:editor/search-block :reference])
  1447. (reset! commands/*slash-caret-pos (util/get-caret-pos input)))
  1448. nil)))))
  1449. (defn surround-by?
  1450. [input before after]
  1451. (when input
  1452. (let [value (gobj/get input "value")
  1453. pos (util/get-input-pos input)
  1454. start-pos (if (= :start before) 0 (- pos (count before)))
  1455. end-pos (if (= :end after) (count value) (+ pos (count after)))]
  1456. (when (>= (count value) end-pos)
  1457. (= (cond
  1458. (and (= :end after) (= :start before))
  1459. ""
  1460. (= :end after)
  1461. before
  1462. (= :start before)
  1463. after
  1464. :else
  1465. (str before after))
  1466. (subs value start-pos end-pos))))))
  1467. (defn get-matched-pages
  1468. [q]
  1469. (let [block (state/get-edit-block)
  1470. editing-page (and block
  1471. (when-let [page-id (:db/id (:block/page block))]
  1472. (:page/name (db/entity page-id))))]
  1473. (let [pages (search/page-search q 20)]
  1474. (if editing-page
  1475. ;; To prevent self references
  1476. (remove (fn [p] (= (string/lower-case p) editing-page)) pages)
  1477. pages))))
  1478. (defn get-matched-blocks
  1479. [q]
  1480. ;; remove current block
  1481. (let [current-block (state/get-edit-block)]
  1482. (remove
  1483. (fn [h]
  1484. (= (:block/uuid current-block)
  1485. (:block/uuid h)))
  1486. (search/search q 10))))
  1487. (defn get-matched-templates
  1488. [q]
  1489. (search/template-search q))
  1490. (defn get-matched-commands
  1491. [input]
  1492. (try
  1493. (let [edit-content (gobj/get input "value")
  1494. pos (util/get-input-pos input)
  1495. last-slash-caret-pos (:pos @*slash-caret-pos)
  1496. last-command (and last-slash-caret-pos (subs edit-content last-slash-caret-pos pos))]
  1497. (when (> pos 0)
  1498. (or
  1499. (and (= \/ (util/nth-safe edit-content (dec pos)))
  1500. @commands/*initial-commands)
  1501. (and last-command
  1502. (commands/get-matched-commands last-command)))))
  1503. (catch js/Error e
  1504. nil)))
  1505. (defn get-matched-block-commands
  1506. [input]
  1507. (try
  1508. (let [edit-content (gobj/get input "value")
  1509. pos (util/get-input-pos input)
  1510. last-command (subs edit-content
  1511. (:pos @*angle-bracket-caret-pos)
  1512. pos)]
  1513. (when (> pos 0)
  1514. (or
  1515. (and (= \< (util/nth-safe edit-content (dec pos)))
  1516. (commands/block-commands-map))
  1517. (and last-command
  1518. (commands/get-matched-commands
  1519. last-command
  1520. (commands/block-commands-map))))))
  1521. (catch js/Error e
  1522. nil)))
  1523. (defn in-auto-complete?
  1524. [input]
  1525. (or @*show-commands
  1526. @*show-block-commands
  1527. (state/get-editor-show-input)
  1528. (state/get-editor-show-page-search?)
  1529. (state/get-editor-show-block-search?)
  1530. (state/get-editor-show-template-search?)
  1531. (state/get-editor-show-date-picker?)))
  1532. (defn get-previous-input-char
  1533. [input]
  1534. (when-let [pos (util/get-input-pos input)]
  1535. (let [value (gobj/get input "value")]
  1536. (when (and (>= (count value) pos)
  1537. (>= pos 1))
  1538. (util/nth-safe value (- pos 1))))))
  1539. (defn get-previous-input-chars
  1540. [input length]
  1541. (when-let [pos (util/get-input-pos input)]
  1542. (let [value (gobj/get input "value")]
  1543. (when (and (>= (count value) pos)
  1544. (>= pos 1))
  1545. (subs value (- pos length) pos)))))
  1546. (defn get-current-input-char
  1547. [input]
  1548. (when-let [pos (util/get-input-pos input)]
  1549. (let [value (gobj/get input "value")]
  1550. (when (and (>= (count value) (inc pos))
  1551. (>= pos 1))
  1552. (util/nth-safe value pos)))))
  1553. (defn- get-previous-block-level
  1554. [current-id]
  1555. (when-let [input (gdom/getElement current-id)]
  1556. (when-let [prev-block (util/get-prev-block input)]
  1557. (util/parse-int (d/attr prev-block "level")))))
  1558. ;; If it's an indent/outdent action followed by an "Enter", only adjust after inserting a block was finished. Maybe we should use a channel to serialize all the events.
  1559. (defn adjust-block-level!
  1560. ([state direction]
  1561. (adjust-block-level! state direction 100))
  1562. ([state direction retry-limit]
  1563. (if (= :insert (state/get-editor-op))
  1564. (if (> retry-limit 0)
  1565. (js/setTimeout #(adjust-block-level! state direction (dec retry-limit)) 20)
  1566. (log/error :editor/indent-outdent-retry-max-limit {:direction direction}))
  1567. (do
  1568. (state/set-editor-op! :indent-outdent)
  1569. (let [{:keys [block block-parent-id value config]} (get-state state)
  1570. start-level (:start-level config)
  1571. format (:block/format block)
  1572. level (:block/level block)
  1573. previous-level (or (get-previous-block-level block-parent-id) 1)
  1574. [add? remove?] (case direction
  1575. :left [false true]
  1576. :right [true false]
  1577. [(<= level previous-level)
  1578. (and (> level previous-level)
  1579. (> level 2))])
  1580. final-level (cond
  1581. add? (inc level)
  1582. remove? (if (> level 2)
  1583. (dec level)
  1584. level)
  1585. :else level)
  1586. new-value (block/with-levels value format (assoc block :block/level final-level))]
  1587. (when (and
  1588. (not (and (= direction :left)
  1589. (get config :id)
  1590. (util/uuid-string? (get config :id))
  1591. (<= final-level start-level)))
  1592. (<= (- final-level previous-level) 1))
  1593. (save-block-if-changed! block new-value
  1594. {:indent-left? (= direction :left)})))
  1595. (state/set-editor-op! nil)))))
  1596. (defn adjust-blocks-level!
  1597. [blocks direction])
  1598. (defn append-paste-doc!
  1599. [format event]
  1600. (let [[html text] (util/get-clipboard-as-html event)]
  1601. (when-not (util/starts-with? (string/trim text) "http")
  1602. (let [doc-text (html-parser/parse format html)]
  1603. (when-not (string/blank? doc-text)
  1604. (util/stop event)
  1605. (state/append-current-edit-content! doc-text))))))
  1606. (defn- block-and-children-content
  1607. [block-children]
  1608. (-> (map :block/content block-children)
  1609. string/join))
  1610. (defn move-up-down
  1611. [e up?]
  1612. (when-let [block-id (:block/uuid (state/get-edit-block))]
  1613. (let [block-parent-id (state/get-editing-block-dom-id)
  1614. block (db/entity [:block/uuid block-id])
  1615. meta (:block/meta block)
  1616. page (:block/page block)
  1617. block-dom-node (gdom/getElement block-parent-id)
  1618. prev-block (get-prev-block-non-collapsed block-dom-node)
  1619. next-block (get-next-block-non-collapsed block-dom-node)
  1620. repo (state/get-current-repo)
  1621. move-upwards-to-parent? (and up? prev-block (< (d/attr prev-block "level") (:block/level block)))
  1622. move-down-to-higher-level? (and (not up?) next-block (< (d/attr next-block "level") (:block/level block)))]
  1623. (when-let [sibling-block (cond
  1624. move-upwards-to-parent?
  1625. prev-block
  1626. move-down-to-higher-level?
  1627. next-block
  1628. :else
  1629. (let [f (if up? util/get-prev-block-with-same-level util/get-next-block-with-same-level)]
  1630. (f block-dom-node)))]
  1631. (when-let [sibling-block-id (d/attr sibling-block "blockid")]
  1632. (when-let [sibling-block (db/pull-block (medley/uuid sibling-block-id))]
  1633. (let [sibling-meta (:block/meta sibling-block)
  1634. hc1 (db/get-block-and-children-no-cache repo (:block/uuid block))
  1635. hc2 (if (or move-upwards-to-parent? move-down-to-higher-level?)
  1636. [sibling-block]
  1637. (db/get-block-and-children-no-cache repo (:block/uuid sibling-block)))]
  1638. ;; Same page and next to the other
  1639. (when (and
  1640. (= (:db/id (:block/page block))
  1641. (:db/id (:block/page sibling-block)))
  1642. (or
  1643. (and up? (= (:end-pos (:block/meta (last hc2))) (:start-pos (:block/meta (first hc1)))))
  1644. (and (not up?) (= (:end-pos (:block/meta (last hc1))) (:start-pos (:block/meta (first hc2)))))))
  1645. (let [hc1-content (block-and-children-content hc1)
  1646. hc2-content (block-and-children-content hc2)
  1647. file (db/get-block-file (:block/uuid block))
  1648. file-path (:file/path file)
  1649. old-file-content (db/get-file file-path)
  1650. [start-pos end-pos new-content blocks] (if up?
  1651. [(:start-pos sibling-meta)
  1652. (get-in (last hc1) [:block/meta :end-pos])
  1653. (str hc1-content hc2-content)
  1654. (concat hc1 hc2)]
  1655. [(:start-pos meta)
  1656. (get-in (last hc2) [:block/meta :end-pos])
  1657. (str hc2-content hc1-content)
  1658. (concat hc2 hc1)])]
  1659. (when (and start-pos end-pos)
  1660. (let [new-file-content (utf8/insert! old-file-content start-pos end-pos new-content)
  1661. modified-time (modified-time-tx page file)
  1662. blocks-meta (rebuild-blocks-meta start-pos blocks)]
  1663. (profile
  1664. (str "Move block " (if up? "up: " "down: "))
  1665. (repo-handler/transact-react-and-alter-file!
  1666. repo
  1667. (concat
  1668. blocks-meta
  1669. modified-time)
  1670. {:key :block/change
  1671. :data (map (fn [block] (assoc block :block/page page)) blocks)}
  1672. [[file-path new-file-content]])))))))))))))
  1673. (defn expand!
  1674. []
  1675. (when-let [current-block (state/get-edit-block)]
  1676. (expand/expand! current-block)
  1677. (state/set-collapsed-state! (:block/uuid current-block)
  1678. false)))
  1679. (defn collapse!
  1680. []
  1681. (when-let [current-block (state/get-edit-block)]
  1682. (expand/collapse! current-block)
  1683. (state/set-collapsed-state! (:block/uuid current-block)
  1684. true)))
  1685. (defn cycle-collapse!
  1686. [_state e]
  1687. (when (and
  1688. ;; not input, t
  1689. (nil? (state/get-edit-input-id))
  1690. (not (state/get-editor-show-input))
  1691. (string/blank? (:search/q @state/state)))
  1692. (util/stop e)
  1693. (expand/cycle!)))
  1694. (defn on-tab
  1695. [direction]
  1696. (fn [state e]
  1697. (when-let [repo (state/get-current-repo)]
  1698. (let [blocks (seq (state/get-selection-blocks))]
  1699. (cond
  1700. (seq blocks)
  1701. (let [ids (map (fn [block] (when-let [id (dom/attr block "blockid")]
  1702. (medley/uuid id))) blocks)
  1703. ids (->> (mapcat #(let [children (vec (db/get-block-children-ids repo %))]
  1704. (cons % children)) ids)
  1705. (distinct))
  1706. blocks (db/pull-many '[*] (map (fn [id] [:block/uuid id]) ids))
  1707. block (first blocks)
  1708. format (:block/format block)
  1709. start-pos (get-in block [:block/meta :start-pos])
  1710. old-end-pos (get-in (last blocks) [:block/meta :end-pos])
  1711. pattern (config/get-block-pattern format)
  1712. last-start-pos (atom start-pos)
  1713. blocks (doall
  1714. (map (fn [block]
  1715. (let [content (:block/content block)
  1716. level (:block/level block)
  1717. content' (if (= :left direction)
  1718. (subs content 1)
  1719. (str pattern content))
  1720. end-pos (+ @last-start-pos (utf8/length (utf8/encode content')))
  1721. block (assoc block
  1722. :block/content content'
  1723. :block/level (if (= direction :left)
  1724. (dec level)
  1725. (inc level))
  1726. :block/meta (merge
  1727. (:block/meta block)
  1728. {:start-pos @last-start-pos
  1729. :end-pos end-pos}))]
  1730. (reset! last-start-pos end-pos)
  1731. block))
  1732. blocks))
  1733. file-id (:db/id (:block/file block))
  1734. file (db/entity file-id)
  1735. page (:block/page block)
  1736. after-blocks (rebuild-after-blocks repo file old-end-pos @last-start-pos)
  1737. ;; _ (prn {:blocks (map (fn [h] (select-keys h [:block/content :block/meta])) blocks)
  1738. ;; :after-blocks after-blocks
  1739. ;; :last-start-pos @last-start-pos})
  1740. file-path (:file/path file)
  1741. file-content (db/get-file file-path)
  1742. new-content (utf8/insert! file-content start-pos old-end-pos (apply str (map :block/content blocks)))
  1743. modified-time (modified-time-tx page file)]
  1744. (profile
  1745. "Indent/outdent: "
  1746. (repo-handler/transact-react-and-alter-file!
  1747. repo
  1748. (concat
  1749. blocks
  1750. after-blocks
  1751. modified-time)
  1752. {:key :block/change
  1753. :data (map (fn [block] (assoc block :block/page page)) blocks)}
  1754. [[file-path new-content]])))
  1755. (gdom/getElement "date-time-picker")
  1756. nil
  1757. :else
  1758. (cycle-collapse! state e))))))
  1759. (defn bulk-make-todos
  1760. [state e]
  1761. (when-let [repo (state/get-current-repo)]
  1762. (let [blocks (seq (state/get-selection-blocks))]
  1763. (if (seq blocks)
  1764. (let [ids (map (fn [block] (when-let [id (dom/attr block "blockid")]
  1765. (medley/uuid id))) blocks)
  1766. ids (->> (mapcat #(let [children (vec (db/get-block-children-ids repo %))]
  1767. (cons % children)) ids)
  1768. (distinct))
  1769. blocks (db/pull-many '[*] (map (fn [id] [:block/uuid id]) ids))
  1770. block (first blocks)
  1771. format (:block/format block)
  1772. start-pos (get-in block [:block/meta :start-pos])
  1773. old-end-pos (get-in (last blocks) [:block/meta :end-pos])
  1774. pattern (config/get-block-pattern format)
  1775. last-start-pos (atom start-pos)
  1776. blocks (doall
  1777. (map (fn [block]
  1778. (let [content (:block/content block)
  1779. [prefix content] (if-let [col (util/split-first " " content)]
  1780. col
  1781. [content ""])
  1782. level (:block/level block)
  1783. new-marker (state/get-preferred-todo)
  1784. content' (string/replace-first content
  1785. format/marker-pattern
  1786. (str new-marker " "))
  1787. content' (str prefix " " content')
  1788. end-pos (+ @last-start-pos (utf8/length (utf8/encode content')))
  1789. block (assoc block
  1790. :block/marker new-marker
  1791. :block/content content'
  1792. :block/meta (merge
  1793. (:block/meta block)
  1794. {:start-pos @last-start-pos
  1795. :end-pos end-pos}))]
  1796. (reset! last-start-pos end-pos)
  1797. block))
  1798. blocks))
  1799. file-id (:db/id (:block/file block))
  1800. file (db/entity file-id)
  1801. page (:block/page block)
  1802. after-blocks (rebuild-after-blocks repo file old-end-pos @last-start-pos)
  1803. file-path (:file/path file)
  1804. file-content (db/get-file file-path)
  1805. new-content (utf8/insert! file-content start-pos old-end-pos (apply str (map :block/content blocks)))
  1806. modified-time (modified-time-tx page file)]
  1807. (profile
  1808. "Indent/outdent: "
  1809. (repo-handler/transact-react-and-alter-file!
  1810. repo
  1811. (concat
  1812. blocks
  1813. after-blocks
  1814. modified-time)
  1815. {:key :block/change
  1816. :data (map (fn [block] (assoc block :block/page page)) blocks)}
  1817. [[file-path new-content]])))
  1818. (cycle-collapse! state e)))))
  1819. (defn- get-link
  1820. [format link label]
  1821. (let [link (or link "")
  1822. label (or label "")]
  1823. (case (keyword format)
  1824. :markdown (util/format "[%s](%s)" label link)
  1825. :org (util/format "[[%s][%s]]" link label)
  1826. nil)))
  1827. (defn handle-command-input
  1828. [command id format m pos]
  1829. (case command
  1830. :link
  1831. (let [{:keys [link label]} m]
  1832. (if (and (string/blank? link)
  1833. (string/blank? label))
  1834. nil
  1835. (insert-command! id
  1836. (get-link format link label)
  1837. format
  1838. {:last-pattern (str commands/slash "link")})))
  1839. :draw
  1840. (when-not (string/blank? (:title m))
  1841. (let [file (draw/title->file-name (:title m))
  1842. value (util/format
  1843. "[[%s]]\n<iframe class=\"draw-iframe\" src=\"/draw?file=%s\" width=\"100%\" height=\"400\" frameborder=\"0\" allowfullscreen></iframe>"
  1844. file
  1845. file)]
  1846. (insert-command! id
  1847. value
  1848. format
  1849. {:last-pattern (str commands/slash "draw ")})
  1850. (draw/create-draw-with-default-content
  1851. file
  1852. (fn []
  1853. (let [input (gdom/getElement "download")]
  1854. (.click input))))))
  1855. nil)
  1856. (state/set-editor-show-input! nil)
  1857. (when-let [saved-cursor (get @state/state :editor/last-saved-cursor)]
  1858. (when-let [input (gdom/getElement id)]
  1859. (.focus input)
  1860. (util/move-cursor-to input saved-cursor))))
  1861. (defn set-block-as-a-heading!
  1862. [block-id value]
  1863. (set-block-property! block-id "heading" value))
  1864. ;; Should preserve the cursor too.
  1865. (defn open-last-block!
  1866. [journal?]
  1867. (let [edit-id (state/get-edit-input-id)
  1868. last-pos (state/get-edit-pos)
  1869. block-id (when edit-id (subs edit-id (- (count edit-id) 36)))]
  1870. (let [last-edit-block (first (array-seq (js/document.getElementsByClassName block-id)))
  1871. first-block (first (array-seq (js/document.getElementsByClassName "ls-block")))
  1872. node (or last-edit-block
  1873. (and (not journal?) first-block))]
  1874. (when node
  1875. (let [block-id (and node (d/attr node "blockid"))
  1876. edit-block-id (string/replace (gobj/get node "id") "ls-block" "edit-block")
  1877. block-id (medley/uuid block-id)]
  1878. (when-let [block (db/entity [:block/uuid block-id])]
  1879. (edit-block! block
  1880. (or (and last-edit-block last-pos)
  1881. :max)
  1882. (:block/format block)
  1883. edit-block-id)))))))
  1884. (defn get-search-q
  1885. []
  1886. (when-let [id (state/get-edit-input-id)]
  1887. (when-let [input (gdom/getElement id)]
  1888. (let [current-pos (:pos (util/get-caret-pos input))
  1889. pos (:editor/last-saved-cursor @state/state)
  1890. edit-content (state/sub [:editor/content id])]
  1891. (or
  1892. @*selected-text
  1893. (util/safe-subs edit-content pos current-pos))))))
  1894. (defn close-autocomplete-if-outside
  1895. [input]
  1896. (when (or (state/get-editor-show-page-search?)
  1897. (state/get-editor-show-page-search-hashtag?)
  1898. (state/get-editor-show-block-search?))
  1899. (when-let [q (get-search-q)]
  1900. (let [value (gobj/get input "value")
  1901. pos (:editor/last-saved-cursor @state/state)
  1902. current-pos (:pos (util/get-caret-pos input))]
  1903. (when (or (< current-pos pos)
  1904. (string/includes? q "]")
  1905. (string/includes? q ")"))
  1906. (state/set-editor-show-block-search! false)
  1907. (state/set-editor-show-page-search! false)
  1908. (state/set-editor-show-page-search-hashtag! false))))))
  1909. (defn periodically-save!
  1910. []
  1911. (js/setInterval save-current-block-when-idle! 3000))