From e049fe1ba8fccc2ddc0841b33bc9c8e79303af08 Mon Sep 17 00:00:00 2001 From: lread Date: Tue, 18 Feb 2025 15:10:06 -0500 Subject: [PATCH] paredit: kill-one-at-pos: word in string fix In-string handling now: - no-op if pos does not locate to word (i.e. whitespace) - no longer has off-by-one error for word deletion Closes #343 --- CHANGELOG.adoc | 2 + src/rewrite_clj/paredit.cljc | 63 +++++++++++++++++++----------- src/rewrite_clj/zip/removez.cljc | 14 +++++++ test/rewrite_clj/paredit_test.cljc | 27 ++++++++----- 4 files changed, 74 insertions(+), 32 deletions(-) diff --git a/CHANGELOG.adoc b/CHANGELOG.adoc index 989f502c..983e3373 100644 --- a/CHANGELOG.adoc +++ b/CHANGELOG.adoc @@ -35,6 +35,8 @@ A release with known breaking changes is marked with: {issue}351[#351] ({lread}) ** `split-at-pos` no longer throws on split at string opening quote {issue}350[#350] ({lread}) +** `kill-one-at-pos` word deletion in string/comment off-by-one error fixed +{issue}343[#343] ({lread}) === v1.1.49 - 2024-11-18 [[v1.1.49]] diff --git a/src/rewrite_clj/paredit.cljc b/src/rewrite_clj/paredit.cljc index b360044c..aa934ae4 100644 --- a/src/rewrite_clj/paredit.cljc +++ b/src/rewrite_clj/paredit.cljc @@ -6,6 +6,7 @@ [rewrite-clj.node :as nd] [rewrite-clj.zip :as z] [rewrite-clj.zip.findz :as fz] + [rewrite-clj.zip.removez :as rz] [rewrite-clj.zip.whitespace :as ws])) #?(:clj (set! *warn-on-reflection* true)) @@ -146,26 +147,36 @@ zloc)) (defn- find-word-bounds - [v col] - (when (<= col (count v)) - [(->> (seq v) + "Return `[start-col end-col]` of word spanning 1-based `col` in `s`. + Else nil if `col` is not in a word." + [s col] + (when (and (> col 0) + (<= col (count s)) + (not (#{\space \newline} (nth s (dec col))))) + [(->> s (take col) reverse - (take-while #(not (= % \space))) count (- col)) - (->> (seq v) + (take-while #(not (= % \space))) + count + (- col) + inc) + (->> s (drop col) (take-while #(not (or (= % \space) (= % \newline)))) count (+ col))])) (defn- remove-word-at - [v col] - (when-let [[start end] (find-word-bounds v col)] - (str (subs v 0 start) - (subs v end)))) + "Return `s` with word at 1-based `col` removed. + If no word at `col` returns `s` unchanged" + [s col] + (if-let [[start end] (find-word-bounds s col)] + (str (subs s 0 (dec start)) + (subs s end)) + s)) (defn- kill-word-in-comment-node [zloc pos] - (let [col-bounds (-> zloc z/node meta :col)] + (let [col-bounds (-> zloc z/position fz/pos-as-map :col)] (-> zloc (z/replace (-> zloc z/node @@ -174,7 +185,7 @@ nd/comment-node))))) (defn- kill-word-in-string-node [zloc pos] - (let [bounds (-> zloc z/node meta) + (let [bounds (-> zloc z/position fz/pos-as-map) row-idx (- (:row pos) (:row bounds)) col (if (= 0 row-idx) (- (:col pos) (:col bounds)) @@ -188,31 +199,37 @@ nd/string-node))))) (defn kill-one-at-pos - "In string and comment aware kill for one node/word at `pos` in `zloc`. + "Return `zloc` with node/word found at `pos` removed. - - `zloc` location is (inclusive) starting point for `pos` depth-first search - - `pos` can be a `{:row :col}` map or a `[row col]` vector. The `row` and `col` values are + If `pos` is: + - inside a string or comment, removes word at `pos`, if at whitespace, no-op. + - otherwise removes node and moves left, or if no left node removes via [[rewrite-clj.zip/remove]]. + If `pos` locates to whitespace between nodes, skips right to find node. + + `zloc` location is (exclusive) starting point for `pos` search + `pos` can be a `{:row :col}` map or a `[row col]` vector. The `row` and `col` values are 1-based and relative to the start of the source code the zipper represents. Throws if `zloc` was not created with [position tracking](/doc/01-user-guide.adoc#position-tracking). - - `(+ |100 100) => (+ |100)` - - `(for |(bar do)) => (foo)` + - `(+ |100 200) => (|+ 200)` + - `(foo |(bar do)) => (foo)` + - `[|10 20 30]` => |[20 30]` - `\"|hello world\" => \"| world\"` - - ` ; |hello world => ; |world`" + - `; |hello world => ; |world`" [zloc pos] (if-let [candidate (->> (z/find-last-by-pos zloc pos) (ws/skip z/right* ws/whitespace?))] (let [pos (fz/pos-as-map pos) - [bounds-row bounds-col] (z/position candidate) - kill-in-node? (not (and (= (:row pos) bounds-row) - (<= (:col pos) bounds-col)))] + candidate-pos (-> candidate z/position fz/pos-as-map) + kill-in-node? (not (and (= (:row pos) (:row candidate-pos)) + (<= (:col pos) (:col candidate-pos))))] (cond (and kill-in-node? (string-node? candidate)) (kill-word-in-string-node candidate pos) (and kill-in-node? (ws/comment? candidate)) (kill-word-in-comment-node candidate pos) - (not (z/leftmost? candidate)) (-> (z/remove candidate) - (global-find-by-node (-> candidate z/left z/node))) - :else (z/remove candidate))) + :else + (or (rz/remove-and-move-left candidate) + (z/remove candidate)))) zloc)) (defn- find-slurpee-up [zloc f] diff --git a/src/rewrite_clj/zip/removez.cljc b/src/rewrite_clj/zip/removez.cljc index 042f1f58..1e0b67de 100644 --- a/src/rewrite_clj/zip/removez.cljc +++ b/src/rewrite_clj/zip/removez.cljc @@ -85,6 +85,20 @@ left-ws-trim right-ws-trim-keep-trailing-linebreak)) +(defn remove-and-move-left + "Return `zloc` with current node removed, and located to node left of removed node. + If no left node, returns `nil`. + + Currently internal, and likely not generic enough to expose, review update as necessary should we want to expose to public API." + [zloc] + (when (m/left zloc) + (->> zloc + left-ws-trim + right-ws-trim + u/remove-and-move-left + ;; TODO: needed? + (ws/skip-whitespace zraw/left)))) + (defn remove-preserve-newline "Same as [[remove]] but preserves newlines. Specifically: will trim all whitespace - or whitespace up to first linebreak if present." diff --git a/test/rewrite_clj/paredit_test.cljc b/test/rewrite_clj/paredit_test.cljc index 165ecafc..1ebbfe83 100644 --- a/test/rewrite_clj/paredit_test.cljc +++ b/test/rewrite_clj/paredit_test.cljc @@ -58,25 +58,34 @@ ;; for this pos fn test, ⊚ in `s` represents character row/col the the `pos` ;; ⊚ in `expected` is at zipper node granularity (doseq [[s expected] - [["[10⊚ 20 30]" "[⊚10 30]"] + [["(+ ⊚100 200)" "(⊚+ 200)"] + ["(foo ⊚(bar do))" "(⊚foo)"] + ["[10⊚ 20 30]" "[⊚10 30]"] ;; searches forward for node ["[10 ⊚20 30]" "[⊚10 30]"] - ["[[10]⊚ 20 30]" "[⊚[10] 30]"] - ["[[10] ⊚20 30]" "[⊚[10] 30]"] + ["[[10]⊚ 20 30]" "[⊚[10] 30]"] ;; searches forward for node + ["[[10] ⊚20 30]" "[⊚[10] 30]"] ;; navigates left after delete when possible + ["[10] [⊚20 30]" "[10] ⊚[30]"] ["[⊚10\n 20\n 30]" "⊚[20\n 30]"] ["[10\n⊚ 20\n 30]" "[⊚10\n 30]"] ["[10\n 20\n⊚ 30]" "[10\n ⊚20]"] + ["[⊚10 20 30]" "⊚[20 30]"] + ["⊚[10 20 30]" "◬"] + ;; in comment - ["; hello⊚ world" "⊚; hello "] - ["; hello ⊚world" "⊚; hello "] - ["; hello worl⊚d" "⊚; hello "] - [";⊚ hello world" "⊚; world"] + ["; hello⊚ world" "⊚; hello world"] ;; only kill word if word spans pos + ["; hello ⊚world" "⊚; hello "] ;; at w of world, kill it + ["; ⊚hello world" "⊚; world"] ;; at h of hello, kill it + ["; hello worl⊚d" "⊚; hello "] ;; at d of world, kill it + [";⊚ hello world" "⊚; hello world"] ;; not in any word, no-op ;; + ;; in string - ["\"hello⊚ world\"" "⊚\"hello \""] + ["\"hello⊚ world\"" "⊚\"hello world\""] ;; not in word, no-op ["\"hello ⊚world\"" "⊚\"hello \""] ["\"hello worl⊚d\"" "⊚\"hello \""] ["\"⊚hello world\"" "⊚\" world\""] ["\"⊚foo bar do\n lorem\"" "⊚\" bar do\n lorem\""] - ["\"foo bar do\n⊚ lorem\"" "⊚\"foo bar do\n \""] + ["\"foo bar do\n⊚ lorem\"" "⊚\"foo bar do\n lorem\""] ;; not in word, no-op + ["\"foo bar do\n ⊚lorem\"" "⊚\"foo bar do\n \""] ["\"foo bar ⊚do\n lorem\"" "⊚\"foo bar \n lorem\""]]] (let [{:keys [pos s]} (th/pos-and-s s) zloc (z/of-string* s {:track-position? true})]