editor.cljs 158 KB

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