Skip to content

Commit

Permalink
paredit: kill-*at-pos end of string/seq handling (#363)
Browse files Browse the repository at this point in the history 
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
  • Loading branch information
@lread
lread authored Feb 19, 2025
1 parent 47b9871 commit 753b744
Show file tree
Hide file tree
Showing 3 changed files with 127 additions and 91 deletions.
2 changes: 2 additions & 0 deletions CHANGELOG.adoc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -69,6 +69,8 @@ A release with known breaking changes is marked with:
{issue}334[#334] ({lread})
** slurping forward now slurps when at empty seq at end of a seq
{issue}333[#333] ({lread})
** when `pos` is at closing `"`,`)` `]`, etc `kill-at-pos`, `kill-one-at-pos` now kill the found node
{issue}362[#362] ({lread})

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

Expand Down
129 changes: 71 additions & 58 deletions src/rewrite_clj/paredit.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,8 @@
"Paredit zipper operations for Clojure/ClojureScript/EDN.
You might find inspiration from examples here: http://pub.gajendra.net/src/paredit-refcard.pdf"
(:require [rewrite-clj.custom-zipper.core :as zraw]
(:require [clojure.string :as str]
[rewrite-clj.custom-zipper.core :as zraw]
[rewrite-clj.custom-zipper.utils :as u]
[rewrite-clj.node :as nd]
[rewrite-clj.zip :as z]
Expand Down Expand Up @@ -133,56 +134,62 @@
(or (u/remove-and-move-left zloc)
(z/remove* zloc))))

(defn- kill-in-string-node [zloc pos]
(if (= (z/string zloc) "\"\"")
(z/remove zloc)
(let [bounds (-> zloc z/node meta)
row-idx (- (:row pos) (:row bounds))
sub-length (if-not (= (:row pos) (:row bounds))
(dec (:col pos))
(- (:col pos) (inc (:col bounds))))]

(-> (take (inc row-idx) (-> zloc z/node :lines))
vec
(update-in [row-idx] #(subs % 0 sub-length))
(#(z/replace zloc (nd/string-node %)))))))

(defn- kill-in-comment-node [zloc pos]
(let [col-bounds (-> zloc z/node meta :col)]
(if (= (:col pos) col-bounds)
(z/remove zloc)
(-> zloc
(z/replace (-> zloc
z/node
:s
(subs 0 (- (:col pos) col-bounds 1))
nd/comment-node))
(#(if (z/right* %)
(z/insert-right* % (nd/newlines 1))
%))))))
(defn- kill-in-string-node [zloc [kill-row kill-col]]
(let [[elem-row elem-col] (z/position zloc)
lines-ndx (- kill-row elem-row)
sub-length (if (= kill-row elem-row)
(- kill-col (inc elem-col))
(dec kill-col))
cur-lines (-> zloc z/node :lines)
new-lines (-> (take (inc lines-ndx) cur-lines)
vec
(update-in [lines-ndx] #(subs % 0 sub-length)))]
(z/replace zloc (nd/string-node new-lines))))

(defn- kill-in-comment-node [zloc [_kill-row kill-col]]
(let [[_elem-row elem-col] (z/position zloc)
cur-comment (-> zloc z/node :s)
;; comments contain their newline, preserve it if present
suffix (when (str/ends-with? cur-comment "\n") "\n")
new-comment (str (subs cur-comment 0 (-> kill-col (- elem-col) dec)) suffix)]
(z/replace zloc (nd/comment-node new-comment))))

(defn kill-at-pos
"In string and comment aware kill
"Return `zloc` with found item starting at `pos` removed to its natural end.
Perform kill for given position `pos` Like [[kill]], but:
If `pos` is:
- if inside string kills to end of string and stops there
- If inside comment kills to end of line (not including linebreak)
- inside a string, removes all characters in string starting at `pos` to the end of the string
- is inside a comment, removes all characters in comment starting at `pos` to the end of line
(not including comment linebreak, if present)
- otherwise, executes [[kill]] at node found from `pos`
- `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
`zloc` location is (inclusive) 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)."
Throws if `zloc` was not created with [position tracking](/doc/01-user-guide.adoc#position-tracking).
- `[:foo \"Hello |World\"]` => [:foo |\"Hello \"]`
- `42 ;; A comment| of some length => 42 |;; A comment`
- `[:foo |\"Hello World\"] => [|:foo ]`"
[zloc pos]
(if-let [candidate (z/find-last-by-pos zloc pos)]
(let [pos (fz/pos-as-map pos)]
(let [pos (fz/pos-as-vec pos)
[candidate-pos candidate-end-pos] (-> candidate z/position-span)
candidate-end-pos (update candidate-end-pos 1 dec)]
(cond
(string-node? candidate) (kill-in-string-node candidate pos)
(ws/comment? candidate) (kill-in-comment-node candidate pos)
(and (empty-seq? candidate)
(> (:col pos) (-> candidate z/node meta :col))) (z/remove candidate)
:else (kill candidate)))
(and (string-node? candidate)
(not= candidate-pos pos)
(not= candidate-end-pos pos))
(kill-in-string-node candidate pos)

(and (ws/comment? candidate)
(not= candidate-pos pos))
(kill-in-comment-node candidate pos)

:else
(kill candidate)))
zloc))

(defn- find-word-bounds
Expand Down Expand Up @@ -214,26 +221,26 @@
(subs s end))
s))

(defn- kill-word-in-comment-node [zloc pos]
(let [col-bounds (-> zloc z/position fz/pos-as-map :col)]
(defn- kill-word-in-comment-node [zloc [_kill-row kill-col]]
(let [[_elem-row elem-col] (z/position zloc)]
(-> zloc
(z/replace (-> zloc
z/node
:s
(remove-word-at (- (:col pos) col-bounds))
(remove-word-at (- kill-col elem-col))
nd/comment-node)))))

(defn- kill-word-in-string-node [zloc pos]
(let [bounds (-> zloc z/position fz/pos-as-map)
row-idx (- (:row pos) (:row bounds))
col (if (= 0 row-idx)
(- (:col pos) (:col bounds))
(:col pos))]
(defn- kill-word-in-string-node [zloc [kill-row kill-col]]
(let [[elem-row elem-col] (z/position zloc)
row-ndx (- kill-row elem-row)
col (if (= 0 row-ndx)
(- kill-col elem-col)
kill-col)]
(-> zloc
(z/replace (-> zloc
z/node
:lines
(update-in [row-idx]
(update-in [row-ndx]
#(remove-word-at % col))
nd/string-node)))))

Expand All @@ -245,7 +252,7 @@
- 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
`zloc` location is (inclusive) 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.
Expand All @@ -259,13 +266,19 @@
[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)
candidate-pos (-> candidate z/position fz/pos-as-map)
kill-in-node? (not (and (= (:row pos) (:row candidate-pos))
(<= (:col pos) (:col candidate-pos))))]
(let [pos (fz/pos-as-vec pos)
[candidate-pos candidate-end-pos] (-> candidate z/position-span)
candidate-end-pos (update candidate-end-pos 1 dec)]
(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)
(and (string-node? candidate)
(not= candidate-pos pos)
(not= candidate-end-pos pos))
(kill-word-in-string-node candidate pos)

(and (ws/comment? candidate)
(not= candidate-pos pos))
(kill-word-in-comment-node candidate pos)

:else
(or (rz/remove-and-move-left candidate)
(z/remove candidate))))
Expand Down
87 changes: 54 additions & 33 deletions test/rewrite_clj/paredit_test.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -46,28 +46,45 @@
(deftest kill-at-pos-test
;; for this pos fn test, ⊚ in `s` represents character row/col for the `pos`
;; ⊚ in `expected` is at zipper node granularity
(doseq [[s expected]
[["[⊚] 5" "◬5"] ;; TODO: questionable, our pos is now at :forms root node
["; dill⊚dall" "⊚; dill"]
["(str \"He⊚llo \" \"World!\")" "(str ⊚\"He\" \"World!\")"]
[(str "(str \""
"First line\n"
" Second⊚ Line\n"
" Third Line\n"
" \")") (str "(str ⊚\""
"First line\n"
" Second\")")]
[(str "\n"
"(println \"Hello⊚\n"
" There"
" World\")")
"\n(println ⊚\"Hello\")"

["⊚\"\"" "◬"]]]]
(let [{:keys [pos s]} (th/pos-and-s s)
(doseq [[sloc expected]
[["2 [⊚] 5" "2⊚ "]
["2 ⊚[] 5" "2⊚ "]
["2⊚ [] 5" "⊚2"]
["⊚2 [] 5" "◬"]
["41; dill⊚dall\n42" "41⊚; dill\n42"]
["(str \"He⊚llo \" \"World!\")" "(str ⊚\"He\" \"World!\")" ]
["(str \"\nSecond line\n Third⊚ Line\n Fourth Line\n \")" "(str ⊚\"\nSecond line\n Third\")"]
["\n(println \"Hello⊚\n There\n World\")" "\n(println ⊚\"Hello\")"]
["42 ⊚\"\"" "42⊚ "]
["42 \"⊚\"" "42⊚ "]
["7 ⊚\"foo\"" "7⊚ "]
["7 \"foo⊚\"" "7⊚ "]
["7 \"⊚foo\"" "7 ⊚\"\""]
["\"\n⊚ \"" "⊚\"\n\""]
["\"f⊚oo\"" "⊚\"f\""]
["[:foo⊚ \"Hello World\"]" "[⊚:foo]"]
["[:foo ⊚\"Hello World\"]" "[:foo⊚ ]"]
["[:foo \"Hello ⊚World\"]" "[:foo ⊚\"Hello \"]"]
["foo ⊚; dingo" "foo⊚ "]
["foo ;⊚; dingo" "foo ⊚;"]
["[1 2 3] ⊚;; dingo" "[1 2 3]⊚ "]
["[1 2 3] ;⊚; dingo" "[1 2 3] ⊚;"]
["[1 2 3]⊚ ;; dingo" "⊚[1 2 3]"]
["[1 2 3]⊚;; dingo" "⊚[1 2 3]"]
[";; ding⊚o\ndog\n" "⊚;; ding\ndog\n"]
[";; dingo⊚\ndog\n" "⊚;; dingo\ndog\n"]
["[1⊚ 2 3 4]" "[⊚1]"]
["[1⊚ 2 3 4]" "[⊚1]"]
["[⊚;a comment\n \n]" "⊚[]"]
["[\n ⊚\n ;a comment\n]" "[\n⊚ ]"]
["42 ;; A comment⊚ of some length" "42 ⊚;; A comment"]
["⊚[]" "◬"]
["[⊚]" "◬"]
["[\n⊚ ]" "[⊚\n]"]]]
(let [{:keys [pos s]} (th/pos-and-s sloc)
zloc (z/of-string* s {:track-position? true})]
(doseq [pos [pos [(:row pos) (:col pos)]]]
(testing (str s " @pos " pos)
(testing (str (pr-str sloc) " @pos " pos)
(is (= expected (-> zloc (pe/kill-at-pos pos) th/root-locmarked-string))))))))

(deftest kill-one-at-pos-test
Expand All @@ -86,23 +103,27 @@
["[10\n 20\n⊚ 30]" "[10\n ⊚20]"]
["[⊚10 20 30]" "⊚[20 30]"]
["⊚[10 20 30]" "◬"]
["32 [⊚]" "⊚32"]

;; in comment
["; 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 ;;
["2 ; hello⊚ world" "2 ⊚; hello world"] ;; only kill word if word spans pos
["2 ; hello ⊚world" "2 ⊚; hello "] ;; at w of world, kill it
["2 ; ⊚hello world" "2 ⊚; world"] ;; at h of hello, kill it
["2 ; hello worl⊚d" "2 ⊚; hello "] ;; at d of world, kill it
["2 ;⊚ hello world" "2 ⊚; hello world"] ;; not in any word, no-op
["2 ⊚; hello world" "⊚2"] ;; kill comment node when at start of comment

;; in string
["\"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 lorem\""] ;; not in word, no-op
["\"foo bar do\n ⊚lorem\"" "⊚\"foo bar do\n \""]
["\"foo bar ⊚do\n lorem\"" "⊚\"foo bar \n lorem\""]]]
["3 \"hello⊚ world\"" "3 ⊚\"hello world\""] ;; not in word, no-op
["3 \"hello ⊚world\"" "3 ⊚\"hello \""]
["3 \"hello worl⊚d\"" "3 ⊚\"hello \""]
["3 \"⊚hello world\"" "3 ⊚\" world\""]
["3 ⊚\"hello world\"" "⊚3"] ;; at start quote, kill node
["3 \"hello world⊚\"" "⊚3"] ;; at end quote, kill node
["3 \"⊚foo bar do\n lorem\"" "3 ⊚\" bar do\n lorem\""]
["3 \"foo bar do\n⊚ lorem\"" "3 ⊚\"foo bar do\n lorem\""] ;; not in word, no-op
["3 \"foo bar do\n ⊚lorem\"" "3 ⊚\"foo bar do\n \""]
["3 \"foo bar ⊚do\n lorem\"" "3 ⊚\"foo bar \n lorem\""]]]
(let [{:keys [pos s]} (th/pos-and-s s)
zloc (z/of-string* s {:track-position? true})]
(doseq [pos [pos [(:row pos) (:col pos)]]]
Expand Down

0 comments on commit 753b744

Please sign in to comment.