diff --git a/src/nextjournal/clojure_mode/extensions/close_brackets.cljs b/src/nextjournal/clojure_mode/extensions/close_brackets.cljs index d79d9dcc..d4b521b6 100644 --- a/src/nextjournal/clojure_mode/extensions/close_brackets.cljs +++ b/src/nextjournal/clojure_mode/extensions/close_brackets.cljs @@ -18,16 +18,29 @@ (defn escaped? [state pos] (= \\ (.. state -doc (slice (max 0 (dec pos)) pos) toString))) -(defn backspace-backoff [state from to] - (if - ;; handle line-comments (backspace should not drag forms up into line comments) - (and - ;; we are directly in front of a line-comment - (some-> (n/node| state (dec from)) (u/guard n/line-comment?)) - ;; current line is blank - (not (str/blank? (u/line-content-at state from)))) - {:cursor (dec from)} - (u/deletion from to))) +(defn backspace-backoff [^js state from to] + (if (not= from to) + (u/deletion from to) + (let [node| (n/node| state from)] + (cond + (some-> node| n/end-edge?) {:cursor (dec from)} + (some-> node| n/line-comment?) (u/deletion from to) + :else + (let [node-before (j/let [^js tree (n/tree state from -1)] ;; 1st node left of cursor + (.childBefore tree from)) + whitespace-between (when node-before (.. state -doc (sliceString (n/end node-before) from))) + delete-n-chars (some->> whitespace-between (re-find #"\n? *$") count) ;; remove up to 1 newline + replacement (when (and whitespace-between (> delete-n-chars 1)) + (cond-> (subs whitespace-between 0 (- (count whitespace-between) delete-n-chars)) + ;; if removing entire gap, add space if carrying another node + (and (= delete-n-chars (count whitespace-between)) + (some-> (n/|node state from) (u/guard (complement n/end-edge?)))) + (str " ")))] + (if replacement + (u/insertion (n/end node-before) + from + replacement) + (u/deletion from to))))))) (j/defn handle-backspace "- skips over closing brackets @@ -37,33 +50,33 @@ (let [^js range (j/get-in state [:selection :ranges 0])] (and (.-empty range) (= 0 (.-from range))))) (u/update-ranges state - #js{:annotations (u/user-event-annotation "delete")} - (j/fn [^:js {:as range :keys [head empty anchor]}] - (j/let [^:js {:as range from :from to :to} (from-to head anchor) - ^js node| (.resolveInner (n/tree state) from -1) ;; node immediately to the left of cursor - ^js parent (.-parent node|)] - (cond - - (or (not empty) ;; selection - (= "StringContent" (n/name (n/tree state from -1))) ;; inside a string - (and parent (not (n/balanced? parent)) (n/left-edge? node|))) ;; unbalanced left-paren - (u/deletion from to) - - ;; entering right edge of collection - skip - (and (n/right-edge? node|) (== from (n/end parent))) - {:cursor (dec from)} - - ;; inside left edge of collection - remove or stop - (and (or (n/start-edge? node|) - (n/same-edge? node|)) (== (n/start node|) (n/start parent))) - (if (n/empty? (n/up node|)) - ;; remove empty collection - {:cursor (n/start parent) - :changes [(from-to (n/start parent) (n/end parent))]} - ;; stop cursor at inner-left of collection - {:cursor from}) - - :else (backspace-backoff state from to))))))) + #js{:annotations (u/user-event-annotation "delete")} + (j/fn [^:js {:as range :keys [head empty anchor]}] + (j/let [^:js {:as range from :from to :to} (from-to head anchor) + ^js node| (.resolveInner (n/tree state) from -1) ;; node immediately to the left of cursor + ^js parent (.-parent node|)] + (cond + + (or (not empty) ;; selection + (= "StringContent" (n/name (n/tree state from -1))) ;; inside a string + (and parent (not (n/balanced? parent)) (n/left-edge? node|))) ;; unbalanced left-paren + (u/deletion from to) + + ;; entering right edge of collection - skip + (and (n/right-edge? node|) (== from (n/end parent))) + {:cursor (dec from)} + + ;; inside left edge of collection - remove or stop + (and (or (n/start-edge? node|) + (n/same-edge? node|)) (== (n/start node|) (n/start parent))) + (if (n/empty? (n/up node|)) + ;; remove empty collection + {:cursor (n/start parent) + :changes [(from-to (n/start parent) (n/end parent))]} + ;; stop cursor at inner-left of collection + {:cursor from}) + + :else (backspace-backoff state from to))))))) (def coll-pairs {"(" ")" "[" "]" @@ -73,61 +86,61 @@ (defn handle-open [^EditorState state ^string open] (let [^string close (coll-pairs open)] (u/update-ranges state - #js{:annotations (u/user-event-annotation "input")} - (j/fn [^:js {:keys [from to head anchor empty]}] - (cond - (in-string? state from) - (if (= open \") - (u/insertion head "\\\"") - (u/insertion from to open)) - ;; allow typing escaped bracket - (escaped? state from) - (u/insertion from to open) - :else - (if empty - {:changes {:insert (str open close) - :from head} - :cursor (+ head (count open))} - ;; wrap selections with brackets - {:changes [{:insert open :from from} - {:insert close :from to}] - :from-to [(+ anchor (count open)) (+ head (count open))]})))))) + #js{:annotations (u/user-event-annotation "input")} + (j/fn [^:js {:keys [from to head anchor empty]}] + (cond + (in-string? state from) + (if (= open \") + (u/insertion head "\\\"") + (u/insertion from to open)) + ;; allow typing escaped bracket + (escaped? state from) + (u/insertion from to open) + :else + (if empty + {:changes {:insert (str open close) + :from head} + :cursor (+ head (count open))} + ;; wrap selections with brackets + {:changes [{:insert open :from from} + {:insert close :from to}] + :from-to [(+ anchor (count open)) (+ head (count open))]})))))) (defn handle-close [state key-name] (u/update-ranges state - #js{:annotations (u/user-event-annotation "input")} - (j/fn [^:js {:as range :keys [empty head from to]}] - (if (or (in-string? state from) - (escaped? state from)) - (u/insertion from to key-name) - (when empty - (or - ;; close unbalanced (open) collection - (let [unbalanced (some-> - (n/tree state head -1) - (n/ancestors) - (->> (filter (every-pred n/coll? (complement n/balanced?)))) - first) - closing (some-> unbalanced n/down n/closed-by) - pos (some-> unbalanced n/end)] - (when (and closing (= closing key-name)) - {:changes {:from pos - :insert closing} - :cursor (inc pos)})) - - ;; jump to next closing bracket - (when-let [close-node-end - (when-let [^js cursor (-> state n/tree - (n/terminal-cursor head 1))] - (loop [] - (if (n/right-edge-type? (.-type cursor)) - (n/end cursor) - (when (.next cursor) - (recur)))))] - {:cursor close-node-end}) - ;; no-op - {:cursor head} - #_(u/insertion head key-name))))))) + #js{:annotations (u/user-event-annotation "input")} + (j/fn [^:js {:as range :keys [empty head from to]}] + (if (or (in-string? state from) + (escaped? state from)) + (u/insertion from to key-name) + (when empty + (or + ;; close unbalanced (open) collection + (let [unbalanced (some-> + (n/tree state head -1) + (n/ancestors) + (->> (filter (every-pred n/coll? (complement n/balanced?)))) + first) + closing (some-> unbalanced n/down n/closed-by) + pos (some-> unbalanced n/end)] + (when (and closing (= closing key-name)) + {:changes {:from pos + :insert closing} + :cursor (inc pos)})) + + ;; jump to next closing bracket + (when-let [close-node-end + (when-let [^js cursor (-> state n/tree + (n/terminal-cursor head 1))] + (loop [] + (if (n/right-edge-type? (.-type cursor)) + (n/end cursor) + (when (.next cursor) + (recur)))))] + {:cursor close-node-end}) + ;; no-op + {:cursor head} + #_(u/insertion head key-name))))))) (j/defn handle-backspace-cmd [^:js {:as view :keys [state]}] (u/dispatch-some view (handle-backspace state))) @@ -154,14 +167,14 @@ (.high Prec (.of view/keymap (j/lit - [{:key "Backspace" - :run (guard-scope - (j/fn [^:js {:as view :keys [state]}] - (u/dispatch-some view (handle-backspace state))))} - {:key "(" :run (guard-scope (handle-open-cmd "("))} - {:key "[" :run (guard-scope (handle-open-cmd "["))} - {:key "{" :run (guard-scope (handle-open-cmd "{"))} - {:key \" :run (guard-scope (handle-open-cmd \"))} - {:key \) :run (guard-scope (handle-close-cmd \)))} - {:key \] :run (guard-scope (handle-close-cmd \]))} - {:key \} :run (guard-scope (handle-close-cmd \}))}])))) + [{:key "Backspace" + :run (guard-scope + (j/fn [^:js {:as view :keys [state]}] + (u/dispatch-some view (handle-backspace state))))} + {:key "(" :run (guard-scope (handle-open-cmd "("))} + {:key "[" :run (guard-scope (handle-open-cmd "["))} + {:key "{" :run (guard-scope (handle-open-cmd "{"))} + {:key \" :run (guard-scope (handle-open-cmd \"))} + {:key \) :run (guard-scope (handle-close-cmd \)))} + {:key \] :run (guard-scope (handle-close-cmd \]))} + {:key \} :run (guard-scope (handle-close-cmd \}))}])))) diff --git a/src/nextjournal/clojure_mode/extensions/formatting.cljs b/src/nextjournal/clojure_mode/extensions/formatting.cljs index baf45bfb..5dce5ef8 100644 --- a/src/nextjournal/clojure_mode/extensions/formatting.cljs +++ b/src/nextjournal/clojure_mode/extensions/formatting.cljs @@ -1,7 +1,8 @@ (ns nextjournal.clojure-mode.extensions.formatting (:require ["@codemirror/language" :as language :refer [IndentContext]] - ["@codemirror/state" :refer [EditorState Transaction]] + ["@codemirror/state" :as cm.state :refer [EditorState Transaction]] [applied-science.js-interop :as j] + [clojure.string :as str] [nextjournal.clojure-mode.util :as u] [nextjournal.clojure-mode.node :as n])) @@ -16,22 +17,87 @@ (defn spaces [^js state n] (.indentString language state n)) +(defn node-line-number [^js state ^js node] (.. state -doc (lineAt (.-from node)) -number)) + +(def indentation-config* + ;; TODO extension point + '{assoc 2 + assoc-in 2 + do :body + let :body + when :body + cond :body + as-> :body + cond-> :body + case :body + ns :body + -> 1 + ->> 1 + }) +(defn indentation-rule [s] + (cond + (str/starts-with? s "with-") :body + (re-find #"\b(?:let|while|loop|binding)$" s) :body + (str/starts-with? s "def") :body + (re-find #"\-\-?>$" s) 1 ;; threading + (re-find #"\-in!?$" s) 2)) + +(def body-indent 1) + +(defn indentation-config [sym] + (when (symbol? sym) + (let [s (str sym)] + (or (indentation-config* sym) + (indentation-rule s))))) + +(j/defn indent-number [^js {:as context :keys [state]} col-start operator align-with-form body-indent] + (let [line (node-line-number state operator) + on-this-line (into [] + (comp (take-while (every-pred identity + (complement n/end-edge?) + (complement n/line-comment?) + #(= line (node-line-number state %)))) + (take (inc align-with-form))) + (iterate (j/get :nextSibling) operator))] + (if (= 1 (count on-this-line)) + (+ col-start body-indent) + (.column context (-> on-this-line last n/start))))) + (j/defn indent-node-props [^:js {type-name :name :as type}] (j/fn [^:js {:as ^js context :keys [pos unit node ^js state]}] - (cond (= "Program" type-name) - 0 - - (n/coll-type? type) - (cond-> (.column context - (-> node n/down n/end)) - ;; start at the inner-left edge of the coll. - ;; if it's a list beginning with a symbol, add 1 space. - (and (= "List" type-name) - (#{"Operator" - "DefLike" - "NS"} (some-> node n/down n/right n/name))) - (+ 1)) - :else -1))) + (if (= "Program" type-name) + 0 + (let [col-start (.column context (-> node n/down n/end))] + (if (= "List" type-name) + (let [operator (some-> node n/down n/right) + operator-type-name (when operator (n/name operator)) + operator-sym (when (#{"Operator" + "DefLike" + "NS" + "Symbol"} operator-type-name) + (symbol (.. state -doc (sliceString (n/start operator) (n/end operator))))) + indent-config (or (indentation-config operator-sym) + (cond operator-sym 1 + (= "Keyword" operator-type-name) 1 + :else :data))] + (cond (number? indent-config) (indent-number context col-start operator indent-config body-indent) + (= :body indent-config) (+ body-indent col-start) + (= :data indent-config) col-start)) + (if (n/coll-type? type) + col-start + -1)))))) + +(comment + ;; TODO + (defonce ^js indentation-config-facet + ;; use this facet to supply + ;; 1) overrides for particular symbols + ;; 2) a fn to fully qualify symbols for an editor? + (.define cm.state/Facet)) + + (defn get-indentation-config [^js state] + (.facet state indentation-config-facet)) + ) (def props (.add language/indentNodeProp indent-node-props)) @@ -63,11 +129,11 @@ (defn expected-space [n1 n2] ;; (prn :expected (map n/name [n1 n2])) (if - (or - (n/start-edge-type? n1) - (n/prefix-edge-type? n1) - (n/end-edge-type? n2) - (n/same-edge-type? n2)) + (or + (n/start-edge-type? n1) + (n/prefix-edge-type? n1) + (n/end-edge-type? n2) + (n/same-edge-type? n2)) 0 1)) @@ -131,8 +197,8 @@ (+ from current-indent) (+ from (count text))))] (cond-> changes - space-changes (into-arr space-changes) - indentation-change (j/push! indentation-change)))) + space-changes (into-arr space-changes) + indentation-change (j/push! indentation-change)))) (defn format-selection [^js state] @@ -153,12 +219,12 @@ (when (n/within-program? (.-startState tr)) (case origin ("input" "input.type" - "delete" - "keyboardselection" - "pointerselection" "select.pointer" - "cut" - "noformat" - "evalregion") nil + "delete" + "keyboardselection" + "pointerselection" "select.pointer" + "cut" + "noformat" + "evalregion") nil "format-selections" (format-selection (.-state tr)) (when-not (.. tr -changes -empty) (let [state (.-state tr) @@ -176,6 +242,6 @@ (defn prefix-all [prefix state] (u/update-lines state - (fn [from _ _] #js{:from from :insert prefix}))) + (fn [from _ _] #js{:from from :insert prefix}))) (defn ext-format-changed-lines [] (.. EditorState -transactionFilter (of format-transaction))) diff --git a/test/nextjournal/clojure_mode_tests.cljs b/test/nextjournal/clojure_mode_tests.cljs index 130bfbca..51ad8400 100644 --- a/test/nextjournal/clojure_mode_tests.cljs +++ b/test/nextjournal/clojure_mode_tests.cljs @@ -135,7 +135,7 @@ "(\n)" "(\n )" "(b\n)" "(b\n )" ;; operator gets extra indent (symbol in 1st position) "(0\n)" "(0\n )" ;; a number is not operator - "(:a\n)" "(:a\n )" ;; a keyword is not operator + "(:a\n)" "(:a\n )" ;; a keyword is an operator "(a\n\nb)" "(a\n \n b)" ;; empty lines get indent ) @@ -157,7 +157,7 @@ "|(\n)" "|(\n )" "(\n)" "(\n )" "|(0\nx<)>" "|(0\n x<)>" - "<(:a\n)>" "<(:a\n )>" + "<(:a\n)>" "<(:a\n )>" "|(a\n\nb)" "|(a\n\n b)" )) @@ -176,7 +176,7 @@ "() | a" "() |a" "|(\n )" "|(\n )" "(\n)" "(\n )" - "<(:a\n)>" "<(:a\n )>" + "<(:a\n)>" "<(:a\n )>" "|(a\n\nb)" "|(a\n\n b)" "|\"a\"" "|\"a\"" "#_a|" "#_a|" @@ -311,6 +311,6 @@ "(|)" "(\n |)" "((|))" "((\n |))" "(()|)" "(()\n |)" - "(a |b)" "(a\n |b)" - "(a b|c)" "(a b\n |c)" + "(a |b)" "(a\n |b)" + "(a b|c)" "(a b\n |c)" )))