Skip to content

paredit: kill-*at-pos end of string/seq handling #363

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Feb 19, 2025
Merged

paredit: kill-*at-pos end of string/seq handling #363

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 2 additions & 0 deletions CHANGELOG.adoc
View file
Open in desktop
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
Open in desktop
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
Open in desktop
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
Loading