Skip to content

Commit 5b258c0

Browse files
lreadlread
committed
paredit: kill-*at-pos end of string/seq handling
When `pos` is at end of string marker `"` or end of sequence marker `]`, `)` etc, kill the node. Closes #362 Rewrite of `kill-at-pos` contributes to #256
1 parent 47b9871 commit 5b258c0

File tree

3 files changed

+126
-90
lines changed

3 files changed

+126
-90
lines changed

‎CHANGELOG.adoc

+2
Original file line numberDiff line numberDiff line change
@@ -69,6 +69,8 @@ A release with known breaking changes is marked with:
6969
{issue}334[#334] ({lread})
7070
** slurping forward now slurps when at empty seq at end of a seq
7171
{issue}333[#333] ({lread})
72+
** when `pos` is at closing `"`,`)` `]`, etc `kill-at-pos`, `kill-one-at-pos` now kills the found node
73+
{issue}362[#362] ({lread})
7274

7375
=== v1.1.49 - 2024-11-18 [[v1.1.49]]
7476

‎src/rewrite_clj/paredit.cljc

+70-57
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,8 @@
22
"Paredit zipper operations for Clojure/ClojureScript/EDN.
33
44
You might find inspiration from examples here: http://pub.gajendra.net/src/paredit-refcard.pdf"
5-
(:require [rewrite-clj.custom-zipper.core :as zraw]
5+
(:require [clojure.string :as str]
6+
[rewrite-clj.custom-zipper.core :as zraw]
67
[rewrite-clj.custom-zipper.utils :as u]
78
[rewrite-clj.node :as nd]
89
[rewrite-clj.zip :as z]
@@ -133,56 +134,62 @@
133134
(or (u/remove-and-move-left zloc)
134135
(z/remove* zloc))))
135136

136-
(defn- kill-in-string-node [zloc pos]
137-
(if (= (z/string zloc) "\"\"")
138-
(z/remove zloc)
139-
(let [bounds (-> zloc z/node meta)
140-
row-idx (- (:row pos) (:row bounds))
141-
sub-length (if-not (= (:row pos) (:row bounds))
142-
(dec (:col pos))
143-
(- (:col pos) (inc (:col bounds))))]
144-
145-
(-> (take (inc row-idx) (-> zloc z/node :lines))
146-
vec
147-
(update-in [row-idx] #(subs % 0 sub-length))
148-
(#(z/replace zloc (nd/string-node %)))))))
149-
150-
(defn- kill-in-comment-node [zloc pos]
151-
(let [col-bounds (-> zloc z/node meta :col)]
152-
(if (= (:col pos) col-bounds)
153-
(z/remove zloc)
154-
(-> zloc
155-
(z/replace (-> zloc
156-
z/node
157-
:s
158-
(subs 0 (- (:col pos) col-bounds 1))
159-
nd/comment-node))
160-
(#(if (z/right* %)
161-
(z/insert-right* % (nd/newlines 1))
162-
%))))))
137+
(defn- kill-in-string-node [zloc [kill-row kill-col]]
138+
(let [[elem-row elem-col] (z/position zloc)
139+
lines-ndx (- kill-row elem-row)
140+
sub-length (if (= kill-row elem-row)
141+
(- kill-col (inc elem-col))
142+
(dec kill-col))
143+
cur-lines (-> zloc z/node :lines)
144+
new-lines (-> (take (inc lines-ndx) cur-lines)
145+
vec
146+
(update-in [lines-ndx] #(subs % 0 sub-length)))]
147+
(z/replace zloc (nd/string-node new-lines))))
148+
149+
(defn- kill-in-comment-node [zloc [_kill-row kill-col]]
150+
(let [[_elem-row elem-col] (z/position zloc)
151+
cur-comment (-> zloc z/node :s)
152+
;; comments contain their newline, preserve it if present
153+
suffix (when (str/ends-with? cur-comment "\n") "\n")
154+
new-comment (str (subs cur-comment 0 (-> kill-col (- elem-col) dec)) suffix)]
155+
(z/replace zloc (nd/comment-node new-comment))))
163156

164157
(defn kill-at-pos
165-
"In string and comment aware kill
158+
"Return `zloc` with found item starting at `pos` removed to its natural end.
166159
167-
Perform kill for given position `pos` Like [[kill]], but:
160+
If `pos` is:
168161
169-
- if inside string kills to end of string and stops there
170-
- If inside comment kills to end of line (not including linebreak)
162+
- inside a string, removes all characters in string starting at `pos` to the end of the string
163+
- is inside a comment, removes all characters in comment starting at `pos` to the end of line
164+
(not including comment linebreak, if present)
165+
- otherwise, executes [[kill]] at node found from `pos`
171166
172-
- `zloc` location is (inclusive) starting point for `pos` depth-first search
173-
- `pos` can be a `{:row :col}` map or a `[row col]` vector. The `row` and `col` values are
167+
`zloc` location is (exclusive) starting point for `pos` search
168+
`pos` can be a `{:row :col}` map or a `[row col]` vector. The `row` and `col` values are
174169
1-based and relative to the start of the source code the zipper represents.
175170
176-
Throws if `zloc` was not created with [position tracking](/doc/01-user-guide.adoc#position-tracking)."
171+
Throws if `zloc` was not created with [position tracking](/doc/01-user-guide.adoc#position-tracking).
172+
173+
- `[:foo \"Hello |World\"]` => [:foo |\"Hello \"]`
174+
- `42 ;; A comment| of some length => 42 |;; A comment`
175+
- `[:foo |\"Hello World\"] => [|:foo ]`"
177176
[zloc pos]
178177
(if-let [candidate (z/find-last-by-pos zloc pos)]
179-
(let [pos (fz/pos-as-map pos)]
178+
(let [pos (fz/pos-as-vec pos)
179+
[candidate-pos candidate-end-pos] (-> candidate z/position-span)
180+
candidate-end-pos (update candidate-end-pos 1 dec)]
180181
(cond
181-
(string-node? candidate) (kill-in-string-node candidate pos)
182-
(ws/comment? candidate) (kill-in-comment-node candidate pos)
183-
(and (empty-seq? candidate)
184-
(> (:col pos) (-> candidate z/node meta :col))) (z/remove candidate)
185-
:else (kill candidate)))
182+
(and (string-node? candidate)
183+
(not= candidate-pos pos)
184+
(not= candidate-end-pos pos))
185+
(kill-in-string-node candidate pos)
186+
187+
(and (ws/comment? candidate)
188+
(not= candidate-pos pos))
189+
(kill-in-comment-node candidate pos)
190+
191+
:else
192+
(kill candidate)))
186193
zloc))
187194

188195
(defn- find-word-bounds
@@ -214,26 +221,26 @@
214221
(subs s end))
215222
s))
216223

217-
(defn- kill-word-in-comment-node [zloc pos]
218-
(let [col-bounds (-> zloc z/position fz/pos-as-map :col)]
224+
(defn- kill-word-in-comment-node [zloc [_kill-row kill-col]]
225+
(let [[_elem-row elem-col] (z/position zloc)]
219226
(-> zloc
220227
(z/replace (-> zloc
221228
z/node
222229
:s
223-
(remove-word-at (- (:col pos) col-bounds))
230+
(remove-word-at (- kill-col elem-col))
224231
nd/comment-node)))))
225232

226-
(defn- kill-word-in-string-node [zloc pos]
227-
(let [bounds (-> zloc z/position fz/pos-as-map)
228-
row-idx (- (:row pos) (:row bounds))
229-
col (if (= 0 row-idx)
230-
(- (:col pos) (:col bounds))
231-
(:col pos))]
233+
(defn- kill-word-in-string-node [zloc [kill-row kill-col]]
234+
(let [[elem-row elem-col] (z/position zloc)
235+
row-ndx (- kill-row elem-row)
236+
col (if (= 0 row-ndx)
237+
(- kill-col elem-col)
238+
kill-col)]
232239
(-> zloc
233240
(z/replace (-> zloc
234241
z/node
235242
:lines
236-
(update-in [row-idx]
243+
(update-in [row-ndx]
237244
#(remove-word-at % col))
238245
nd/string-node)))))
239246

@@ -259,13 +266,19 @@
259266
[zloc pos]
260267
(if-let [candidate (->> (z/find-last-by-pos zloc pos)
261268
(ws/skip z/right* ws/whitespace?))]
262-
(let [pos (fz/pos-as-map pos)
263-
candidate-pos (-> candidate z/position fz/pos-as-map)
264-
kill-in-node? (not (and (= (:row pos) (:row candidate-pos))
265-
(<= (:col pos) (:col candidate-pos))))]
269+
(let [pos (fz/pos-as-vec pos)
270+
[candidate-pos candidate-end-pos] (-> candidate z/position-span)
271+
candidate-end-pos (update candidate-end-pos 1 dec)]
266272
(cond
267-
(and kill-in-node? (string-node? candidate)) (kill-word-in-string-node candidate pos)
268-
(and kill-in-node? (ws/comment? candidate)) (kill-word-in-comment-node candidate pos)
273+
(and (string-node? candidate)
274+
(not= candidate-pos pos)
275+
(not= candidate-end-pos pos))
276+
(kill-word-in-string-node candidate pos)
277+
278+
(and (ws/comment? candidate)
279+
(not= candidate-pos pos))
280+
(kill-word-in-comment-node candidate pos)
281+
269282
:else
270283
(or (rz/remove-and-move-left candidate)
271284
(z/remove candidate))))

‎test/rewrite_clj/paredit_test.cljc

+54-33
Original file line numberDiff line numberDiff line change
@@ -46,28 +46,45 @@
4646
(deftest kill-at-pos-test
4747
;; for this pos fn test, ⊚ in `s` represents character row/col for the `pos`
4848
;; ⊚ in `expected` is at zipper node granularity
49-
(doseq [[s expected]
50-
[["[⊚] 5" "◬5"] ;; TODO: questionable, our pos is now at :forms root node
51-
["; dill⊚dall" "⊚; dill"]
52-
["(str \"He⊚llo \" \"World!\")" "(str ⊚\"He\" \"World!\")"]
53-
[(str "(str \""
54-
"First line\n"
55-
" Second⊚ Line\n"
56-
" Third Line\n"
57-
" \")") (str "(str ⊚\""
58-
"First line\n"
59-
" Second\")")]
60-
[(str "\n"
61-
"(println \"Hello⊚\n"
62-
" There"
63-
" World\")")
64-
"\n(println ⊚\"Hello\")"
65-
66-
["⊚\"\"" "◬"]]]]
67-
(let [{:keys [pos s]} (th/pos-and-s s)
49+
(doseq [[sloc expected]
50+
[["2 [⊚] 5" "2⊚ "]
51+
["2 ⊚[] 5" "2⊚ "]
52+
["2⊚ [] 5" "⊚2"]
53+
["⊚2 [] 5" "◬"]
54+
["41; dill⊚dall\n42" "41⊚; dill\n42"]
55+
["(str \"He⊚llo \" \"World!\")" "(str ⊚\"He\" \"World!\")" ]
56+
["(str \"\nSecond line\n Third⊚ Line\n Fourth Line\n \")" "(str ⊚\"\nSecond line\n Third\")"]
57+
["\n(println \"Hello⊚\n There\n World\")" "\n(println ⊚\"Hello\")"]
58+
["42 ⊚\"\"" "42⊚ "]
59+
["42 \"⊚\"" "42⊚ "]
60+
["7 ⊚\"foo\"" "7⊚ "]
61+
["7 \"foo⊚\"" "7⊚ "]
62+
["7 \"⊚foo\"" "7 ⊚\"\""]
63+
["\"\n⊚ \"" "⊚\"\n\""]
64+
["\"f⊚oo\"" "⊚\"f\""]
65+
["[:foo⊚ \"Hello World\"]" "[⊚:foo]"]
66+
["[:foo ⊚\"Hello World\"]" "[:foo⊚ ]"]
67+
["[:foo \"Hello ⊚World\"]" "[:foo ⊚\"Hello \"]"]
68+
["foo ⊚; dingo" "foo⊚ "]
69+
["foo ;⊚; dingo" "foo ⊚;"]
70+
["[1 2 3] ⊚;; dingo" "[1 2 3]⊚ "]
71+
["[1 2 3] ;⊚; dingo" "[1 2 3] ⊚;"]
72+
["[1 2 3]⊚ ;; dingo" "⊚[1 2 3]"]
73+
["[1 2 3]⊚;; dingo" "⊚[1 2 3]"]
74+
[";; ding⊚o\ndog\n" "⊚;; ding\ndog\n"]
75+
[";; dingo⊚\ndog\n" "⊚;; dingo\ndog\n"]
76+
["[1⊚ 2 3 4]" "[⊚1]"]
77+
["[1⊚ 2 3 4]" "[⊚1]"]
78+
["[⊚;a comment\n \n]" "⊚[]"]
79+
["[\n ⊚\n ;a comment\n]" "[\n⊚ ]"]
80+
["42 ;; A comment⊚ of some length" "42 ⊚;; A comment"]
81+
["⊚[]" "◬"]
82+
["[⊚]" "◬"]
83+
["[\n⊚ ]" "[⊚\n]"]]]
84+
(let [{:keys [pos s]} (th/pos-and-s sloc)
6885
zloc (z/of-string* s {:track-position? true})]
6986
(doseq [pos [pos [(:row pos) (:col pos)]]]
70-
(testing (str s " @pos " pos)
87+
(testing (str (pr-str sloc) " @pos " pos)
7188
(is (= expected (-> zloc (pe/kill-at-pos pos) th/root-locmarked-string))))))))
7289

7390
(deftest kill-one-at-pos-test
@@ -86,23 +103,27 @@
86103
["[10\n 20\n⊚ 30]" "[10\n ⊚20]"]
87104
["[⊚10 20 30]" "⊚[20 30]"]
88105
["⊚[10 20 30]" "◬"]
106+
["32 [⊚]" "⊚32"]
89107

90108
;; in comment
91-
["; hello⊚ world" "⊚; hello world"] ;; only kill word if word spans pos
92-
["; hello ⊚world" "⊚; hello "] ;; at w of world, kill it
93-
["; ⊚hello world" "⊚; world"] ;; at h of hello, kill it
94-
["; hello worl⊚d" "⊚; hello "] ;; at d of world, kill it
95-
[";⊚ hello world" "⊚; hello world"] ;; not in any word, no-op ;;
109+
["2 ; hello⊚ world" "2 ⊚; hello world"] ;; only kill word if word spans pos
110+
["2 ; hello ⊚world" "2 ⊚; hello "] ;; at w of world, kill it
111+
["2 ; ⊚hello world" "2 ⊚; world"] ;; at h of hello, kill it
112+
["2 ; hello worl⊚d" "2 ⊚; hello "] ;; at d of world, kill it
113+
["2 ;⊚ hello world" "2 ⊚; hello world"] ;; not in any word, no-op
114+
["2 ⊚; hello world" "⊚2"] ;; kill comment node when at start of comment
96115

97116
;; in string
98-
["\"hello⊚ world\"" "⊚\"hello world\""] ;; not in word, no-op
99-
["\"hello ⊚world\"" "⊚\"hello \""]
100-
["\"hello worl⊚d\"" "⊚\"hello \""]
101-
["\"⊚hello world\"" "⊚\" world\""]
102-
["\"⊚foo bar do\n lorem\"" "⊚\" bar do\n lorem\""]
103-
["\"foo bar do\n⊚ lorem\"" "⊚\"foo bar do\n lorem\""] ;; not in word, no-op
104-
["\"foo bar do\n ⊚lorem\"" "⊚\"foo bar do\n \""]
105-
["\"foo bar ⊚do\n lorem\"" "⊚\"foo bar \n lorem\""]]]
117+
["3 \"hello⊚ world\"" "3 ⊚\"hello world\""] ;; not in word, no-op
118+
["3 \"hello ⊚world\"" "3 ⊚\"hello \""]
119+
["3 \"hello worl⊚d\"" "3 ⊚\"hello \""]
120+
["3 \"⊚hello world\"" "3 ⊚\" world\""]
121+
["3 ⊚\"hello world\"" "⊚3"] ;; at start quote, kill node
122+
["3 \"hello world⊚\"" "⊚3"] ;; at end quote, kill node
123+
["3 \"⊚foo bar do\n lorem\"" "3 ⊚\" bar do\n lorem\""]
124+
["3 \"foo bar do\n⊚ lorem\"" "3 ⊚\"foo bar do\n lorem\""] ;; not in word, no-op
125+
["3 \"foo bar do\n ⊚lorem\"" "3 ⊚\"foo bar do\n \""]
126+
["3 \"foo bar ⊚do\n lorem\"" "3 ⊚\"foo bar \n lorem\""]]]
106127
(let [{:keys [pos s]} (th/pos-and-s s)
107128
zloc (z/of-string* s {:track-position? true})]
108129
(doseq [pos [pos [(:row pos) (:col pos)]]]

0 commit comments

Comments
 (0)