summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorTaylor R Campbell <campbell@paredit.org>2022-11-26 01:46:42 +0000
committerTaylor R Campbell <campbell@paredit.org>2022-11-26 01:46:42 +0000
commit036684281942343c84612ce63764ad994c752279 (patch)
treea6770e4fbd80dd277e825197b0a7256b0b393446
parent928fb082624e6b78040fb1aec9fe82694989d58c (diff)
Teach paredit-forward/backward-kill-word to take prefix argument.
XXX Unlike other paredit commands, C-u is not handled specially -- it is just interpreted as 4. No automatic tests for this at the moment.
-rw-r--r--paredit.el115
-rw-r--r--test.el68
2 files changed, 105 insertions, 78 deletions
diff --git a/paredit.el b/paredit.el
index 77f5a68..9140b39 100644
--- a/paredit.el
+++ b/paredit.el
@@ -1585,61 +1585,70 @@ With a numeric prefix argument N, do `kill-line' that many times."
;;; extraordinarily difficult or impossible, so we have to implement
;;; killing in both directions by parsing forward.
-(defun paredit-forward-kill-word ()
+(defun paredit-forward-kill-word (&optional argument)
"Kill a word forward, skipping over intervening delimiters."
- (interactive)
- (let ((beginning (point)))
- (skip-syntax-forward " -")
- (let* ((parse-state (paredit-current-parse-state))
- (state (paredit-kill-word-state parse-state 'char-after)))
- (while (not (or (eobp)
- (eq ?w (char-syntax (char-after)))))
- (setq parse-state
- (progn (forward-char 1) (paredit-current-parse-state))
-;; (parse-partial-sexp (point) (1+ (point))
-;; nil nil parse-state)
- )
- (let* ((old-state state)
- (new-state
- (paredit-kill-word-state parse-state 'char-after)))
- (cond ((not (eq old-state new-state))
- (setq parse-state
- (paredit-kill-word-hack old-state
- new-state
- parse-state))
- (setq state
- (paredit-kill-word-state parse-state
- 'char-after))
- (setq beginning (point)))))))
- (goto-char beginning)
- (kill-word 1)))
-
-(defun paredit-backward-kill-word ()
+ (interactive "p")
+ (let ((argument (or argument 1)))
+ (if (< argument 0)
+ (paredit-backward-kill-word (- argument))
+ (dotimes (i argument)
+ (let ((beginning (point)))
+ (skip-syntax-forward " -")
+ (let* ((parse-state (paredit-current-parse-state))
+ (state (paredit-kill-word-state parse-state 'char-after)))
+ (while (not (or (eobp)
+ (eq ?w (char-syntax (char-after)))))
+ (setq parse-state
+ (progn (forward-char 1) (paredit-current-parse-state))
+ ;; XXX Why did I comment this out?
+ ;; (parse-partial-sexp (point) (1+ (point))
+ ;; nil nil parse-state)
+ )
+ (let* ((old-state state)
+ (new-state
+ (paredit-kill-word-state parse-state 'char-after)))
+ (cond ((not (eq old-state new-state))
+ (setq parse-state
+ (paredit-kill-word-hack old-state
+ new-state
+ parse-state))
+ (setq state
+ (paredit-kill-word-state parse-state
+ 'char-after))
+ (setq beginning (point)))))))
+ (goto-char beginning)
+ (kill-word 1))))))
+
+(defun paredit-backward-kill-word (&optional argument)
"Kill a word backward, skipping over any intervening delimiters."
- (interactive)
- (if (not (or (bobp)
- (eq (char-syntax (char-before)) ?w)))
- (let ((end (point)))
- (backward-word 1)
- (forward-word 1)
- (goto-char (min end (point)))
- (let* ((parse-state (paredit-current-parse-state))
- (state
- (paredit-kill-word-state parse-state 'char-before)))
- (while (and (< (point) end)
- (progn
- (setq parse-state
- (parse-partial-sexp (point) (1+ (point))
- nil nil parse-state))
- (or (eq state
- (paredit-kill-word-state parse-state
- 'char-before))
- (progn (backward-char 1) nil)))))
- (if (and (eq state 'comment)
- (eq ?\# (char-after (point)))
- (eq ?\| (char-before (point))))
- (backward-char 1)))))
- (backward-kill-word 1))
+ (interactive "p")
+ (let ((argument (or argument 1)))
+ (if (< argument 0)
+ (paredit-forward-kill-word (- argument))
+ (dotimes (i argument)
+ (if (not (or (bobp)
+ (eq (char-syntax (char-before)) ?w)))
+ (let ((end (point)))
+ (backward-word 1)
+ (forward-word 1)
+ (goto-char (min end (point)))
+ (let* ((parse-state (paredit-current-parse-state))
+ (state
+ (paredit-kill-word-state parse-state 'char-before)))
+ (while (and (< (point) end)
+ (progn
+ (setq parse-state
+ (parse-partial-sexp (point) (1+ (point))
+ nil nil parse-state))
+ (or (eq state
+ (paredit-kill-word-state parse-state
+ 'char-before))
+ (progn (backward-char 1) nil)))))
+ (if (and (eq state 'comment)
+ (eq ?\# (char-after (point)))
+ (eq ?\| (char-before (point))))
+ (backward-char 1)))))
+ (backward-kill-word 1)))))
;;;;;; Word-Killing Auxiliaries
diff --git a/test.el b/test.el
index 8435d87..77850fa 100644
--- a/test.el
+++ b/test.el
@@ -1613,31 +1613,49 @@ Four arguments: the paredit command, the text of the buffer
"\n(f xy\n z\n w)\n;;;|T "
"\n(f xy\n z\n w)\n;;;|T "))))
-(paredit-test 'paredit-forward-kill-word
- '(("|(hello \"world\")"
- "(| \"world\")"
- "( \"|\")"
- error)
- ("(hello| \"world\")"
- "(hello \"|\")")
- ("(hello \"world|\")" error)
- ("(hello \"world\"|)" error)
- ("(hello \"world\")|" error)))
-
-(paredit-test 'paredit-backward-kill-word
- '(("(hello \"world\")|"
- "(hello \"|\")"
- "(|\"\")"
- ;; error or nop -- XXX broken
- )
- ("(hello \"|world\")"
- "(|\"world\")"
- ;; error or nop -- XXX broken
- )
- ("(|hello \"world\")"
- ;; error or nop -- XXX broken
- )
- ("|(hello \"world\")" "|(hello \"world\")")))
+(let ((forward-cases
+ '(("|(hello \"world\")"
+ "(| \"world\")"
+ "( \"|\")"
+ error)
+ ("(hello| \"world\")"
+ "(hello \"|\")")
+ ("(hello \"world|\")" error)
+ ("(hello \"world\"|)" error)
+ ("(hello \"world\")|" error))))
+ (paredit-test 'paredit-forward-kill-word forward-cases)
+ (let ((current-prefix-arg -1))
+ (paredit-test 'paredit-backward-kill-word forward-cases)))
+
+(let ((backward-cases
+ '(("(hello \"world\")|"
+ "(hello \"|\")"
+ "(|\"\")"
+ ;; error or nop -- XXX broken
+ )
+ ("(hello \"|world\")"
+ "(|\"world\")"
+ ;; error or nop -- XXX broken
+ )
+ ("(|hello \"world\")"
+ ;; error or nop -- XXX broken
+ )
+ ("|(hello \"world\")" "|(hello \"world\")"))))
+ (paredit-test 'paredit-backward-kill-word backward-cases)
+ (let ((current-prefix-arg -1))
+ (paredit-test 'paredit-forward-kill-word backward-cases)))
+
+(let ((current-prefix-arg 2))
+ (paredit-test 'paredit-forward-kill-word
+ '((("(foo |bar baz quux)"
+ "(foo | quux)"
+ "(foo |)"
+ "(foo |)"))))
+ (paredit-test 'paredit-backward-kill-word
+ '((("(foo bar baz| quux)"
+ "(foo | quux)"
+ "(| quux)"
+ "(| quux)")))))
(if (> paredit-test-nfailures 0)
(error "%S paredit tests failed" paredit-test-nfailures))