editor.cljs 120 KB

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