editor.cljs 119 KB

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