editor.cljs 147 KB

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