From 036684281942343c84612ce63764ad994c752279 Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Sat, 26 Nov 2022 01:46:42 +0000 Subject: 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. --- paredit.el | 115 +++++++++++++++++++++++++++++++++---------------------------- test.el | 68 ++++++++++++++++++++++-------------- 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)) -- cgit v1.2.1