From fbdc679e119cd74911ffee1e23f83a9d68305d7b Mon Sep 17 00:00:00 2001 From: Alex Bochannek Date: Fri, 31 May 2024 17:19:02 -0700 Subject: [PATCH] Add new keyboard macro counter functions (bug#61549) Advanced keyboard macro counter commands for register integration and conditional macro termination * lisp/kmacro.el (kmacro-keymap) (kmacro-reg-load-counter, kmacro-reg-save-counter) (kmacro-reg-add-counter-equal, kmacro-reg-add-counter-less) (kmacro-reg-add-counter-greater, kmacro-reg-add-counter) (kmacro-quit-counter-equal, kmacro-quit-counter-less) (kmacro-quit-counter-greater, kmacro-quit-counter): Add advanced keyboard macro counter commands to kmacro keymap. Implement advanced keyboard macro counter commands. * test/lisp/kmacro-tests.el (kmacro-tests-test-reg-load) (kmacro-tests-test-reg-save) (kmacro-tests-test-reg-add-counter-equal-01) (kmacro-tests-test-reg-add-counter-equal-02) (kmacro-tests-test-reg-add-counter-equal-03) (kmacro-tests-test-reg-add-counter-equal-04) (kmacro-tests-test-reg-add-counter-less) (kmacro-tests-test-reg-add-counter-greater) (kmacro-tests-test-quit-counter-equal-01) (kmacro-tests-test-quit-counter-equal-02) (kmacro-tests-test-quit-counter-equal-03) (kmacro-tests-test-quit-counter-equal-04) (kmacro-tests-test-quit-counter-less) (kmacro-tests-test-quit-counter-greater): Implement unit tests for advanced keyboard macro counter commands. * etc/NEWS: Document advanced keyboard macro counter commands. (cherry picked from commit 5ad8ebe6e2808df001255e1f34e8c880e1e57ad4) --- etc/NEWS | 19 ++++ lisp/kmacro.el | 84 +++++++++++++++ test/lisp/kmacro-tests.el | 213 ++++++++++++++++++++++++++++++++++++++ 3 files changed, 316 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index 19474b933a4..0985fe8e96a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1776,6 +1776,25 @@ The user option 'proced-auto-update-flag' can now be set to 2 additional values, which control automatic updates of Proced buffers that are not displayed in some window. +** Kmacro + ++++ +*** New Advanced Macro Counter functions. +New commands have been added to implement advanced macro counter +functions. + +The commands 'C-x C-k C-r l' and 'C-x C-k C-r s' load and save the +macro counter from and to a number register, respectively. + +The commands 'C-x C-k C-r a =', 'C-x C-k C-r a <', and +'C-x C-k C-r a >' compare the macro counter with the contents of a +number register and increment the counter by an optional prefix if the +comparison succeeds. + +The commands 'C-x C-k C-q =', 'C-x C-k C-q <', and 'C-x C-k C-q >' +compare the macro counter with an optional prefix and terminate the +macro if the comparison succeeds. + ** Kmacro Menu mode +++ diff --git a/lisp/kmacro.el b/lisp/kmacro.el index 33766a7a719..0276b8b968d 100644 --- a/lisp/kmacro.el +++ b/lisp/kmacro.el @@ -187,6 +187,14 @@ macro to be executed before appending to it." "C-c" #'kmacro-set-counter "C-i" #'kmacro-insert-counter "C-a" #'kmacro-add-counter + "C-r l" #'kmacro-reg-load-counter + "C-r s" #'kmacro-reg-save-counter + "C-r a =" #'kmacro-reg-add-counter-equal + "C-r a <" #'kmacro-reg-add-counter-less + "C-r a >" #'kmacro-reg-add-counter-greater + "C-q =" #'kmacro-quit-counter-equal + "C-q <" #'kmacro-quit-counter-less + "C-q >" #'kmacro-quit-counter-greater ;; macro editing "C-e" #'kmacro-edit-macro-repeat @@ -346,6 +354,82 @@ information." (unless executing-kbd-macro (kmacro-display-counter))) +(defun kmacro-reg-load-counter (register) + "Load the value of a REGISTER into `kmacro-counter'." + (interactive + (list (register-read-with-preview "Load register to counter: "))) + (let ((register-val (get-register register))) + (when (numberp register-val) + (setq kmacro-counter register-val)))) + +(defun kmacro-reg-save-counter (register) + "Save the value of `kmacro-counter' to a REGISTER." + (interactive + (list (register-read-with-preview "Save counter to register: "))) + (set-register register kmacro-counter)) + +(defun kmacro-reg-add-counter-equal (&optional arg) + "Increment counter by one if it is equal to register value. +Optional non-nil ARG specifies the increment." + (interactive "p") + (let + ((register (register-read-with-preview "Compare counter to register: "))) + (kmacro-reg-add-counter #'= register arg))) + +(defun kmacro-reg-add-counter-less (&optional arg) + "Increment counter by one if it is less than register value. +Optional non-nil ARG specifies increment." + (interactive "p") + (let + ((register (register-read-with-preview "Compare counter to register: "))) + (kmacro-reg-add-counter #'< register arg))) + + +(defun kmacro-reg-add-counter-greater (&optional arg) + "Increment counter by one if it is greater than register value. +Optional non-nil ARG specifies increment." + (interactive "p") + (let + ((register (register-read-with-preview "Compare counter to register: "))) + (kmacro-reg-add-counter #'> register arg))) + +(defun kmacro-reg-add-counter (pred register arg) + "Increment `kmacro-counter' by ARG if PRED returns non-nil. +PRED is called with two arguments: `kmacro-counter' and REGISTER." + (let ((register-val (get-register register))) + (when (funcall pred kmacro-counter register-val) + (setq current-prefix-arg nil) + (kmacro-add-counter arg)))) + +(defun kmacro-quit-counter-equal (&optional arg) + "Quit the keyboard macro if the counter is equal to ARG. +ARG defaults to zero if nil or omitted." + (interactive "p") + (kmacro-quit-counter #'= arg)) + +(defun kmacro-quit-counter-less (&optional arg) + "Quit the keyboard macro if the counter is less than ARGS. +ARG defaults to zero if nil or omitted." + (interactive "p") + (kmacro-quit-counter #'< arg)) + +(defun kmacro-quit-counter-greater (&optional arg) + "Quit the keyboard macro if the counter is greater than ARG. +ARG defaults to zero if nil or omitted." + (interactive "p") + (kmacro-quit-counter #'> arg)) + +(defun kmacro-quit-counter (pred arg) + "Quit the keyboard macro if PRED returns non-nil. +PRED is called with two arguments: `kmacro-counter' and ARG. +ARG defaults to zero if it is nil." + (when kmacro-initial-counter-value + (setq kmacro-counter kmacro-initial-counter-value + kmacro-initial-counter-value nil)) + (let ((arg (if (null current-prefix-arg) + 0 arg))) + (when (funcall pred kmacro-counter arg) + (keyboard-quit)))) (defun kmacro-loop-setup-function () "Function called prior to each iteration of macro." diff --git a/test/lisp/kmacro-tests.el b/test/lisp/kmacro-tests.el index 2eead234988..52abe138ae9 100644 --- a/test/lisp/kmacro-tests.el +++ b/test/lisp/kmacro-tests.el @@ -275,6 +275,219 @@ cause the current test to fail." ;; Verify that the recording state has changed. (should (equal defining-kbd-macro 'append)))) + +(kmacro-tests-deftest kmacro-tests-test-reg-load () + "`kmacro-reg-load-counter' loads the value of a register into the counter." + (set-register ?\C-r 4) ;; Should be safe as a register name + (kmacro-tests-simulate-command '(kmacro-set-counter 1)) + (kmacro-tests-define-macro (vconcat + ;; Insert and increment counter + "\C-x\C-k\C-i" + "\C-x\C-k\C-i" + ;; Load from register + "\C-x\C-k\C-rl\C-r" + )) + (kmacro-tests-should-insert "1245" + (kmacro-tests-simulate-command '(kmacro-end-or-call-macro 2))) + (set-register ?\C-r nil)) + +(kmacro-tests-deftest kmacro-tests-test-reg-save () + "`kmacro-reg-save-counter' saves the counter to a register." + (set-register ?\C-r nil) ;; Should be safe as a register name + (kmacro-tests-simulate-command '(kmacro-set-counter 1)) + (kmacro-tests-define-macro (vconcat + ;; Insert and increment counter + "\C-x\C-k\C-i" + ;; Save to register + "\C-x\C-k\C-rs\C-r" + ;; Add to counter + "\C-u2\C-x\C-k\C-a" + ;; Insert and increment counter + "\C-x\C-k\C-i" + ;; Insert register + "\C-xri\C-r" + )) + (kmacro-tests-should-insert "142586" + (kmacro-tests-simulate-command '(kmacro-end-or-call-macro 2))) + (set-register ?\C-r nil)) + + +(kmacro-tests-deftest kmacro-tests-test-reg-add-counter-equal-01 () + "`kmacro-reg-add-counter-equal' increments counter by one if equal to register." + (set-register ?\C-r 2) ;; Should be safe as a register name + (kmacro-tests-define-macro (vconcat + ;; Insert and increment counter + "\C-x\C-k\C-i" + ;; Increment counter if it matches + "\C-x\C-k\C-ra=\C-r" + )) + (kmacro-tests-should-insert "0134" + (kmacro-tests-simulate-command '(kmacro-end-or-call-macro 4))) + (set-register ?\C-r nil)) + +(kmacro-tests-deftest kmacro-tests-test-reg-add-counter-equal-02 () + "`kmacro-reg-add-counter-equal' increments counter by prefix if equal to register." + (set-register ?\C-r 2) ;; Should be safe as a register name + (kmacro-tests-define-macro (vconcat + ;; Insert and increment counter + "\C-x\C-k\C-i" + ;; Add two to counter if it matches + "\C-u2\C-x\C-k\C-ra=\C-r" + )) + (kmacro-tests-should-insert "0145" + (kmacro-tests-simulate-command '(kmacro-end-or-call-macro 4))) + (set-register ?\C-r nil)) + +(kmacro-tests-deftest kmacro-tests-test-reg-add-counter-equal-03 () + "`kmacro-reg-add-counter-equal' increments counter by universal arg if equal to register." + (set-register ?\C-r 2) ;; Should be safe as a register name + (kmacro-tests-define-macro (vconcat + ;; Insert and increment counter + "\C-x\C-k\C-i" + ;; Add four to counter if it matches + "\C-u\C-x\C-k\C-ra=\C-r" + )) + (kmacro-tests-should-insert "0167" + (kmacro-tests-simulate-command '(kmacro-end-or-call-macro 4))) + (set-register ?\C-r nil)) + +(kmacro-tests-deftest kmacro-tests-test-reg-add-counter-equal-04 () + "`kmacro-reg-add-counter-equal' decrements counter by one if equal to register." + (set-register ?\C-r 2) ;; Should be safe as a register name + (kmacro-tests-define-macro (vconcat + ;; Insert and increment counter + "\C-x\C-k\C-i" + ;; Decrement counter if it matches + "\C-u-\C-x\C-k\C-ra=\C-r" + )) + (kmacro-tests-should-insert "0111" + (kmacro-tests-simulate-command '(kmacro-end-or-call-macro 4))) + (set-register ?\C-r nil)) + +(kmacro-tests-deftest kmacro-tests-test-reg-add-counter-less () + "`kmacro-reg-add-counter-less' decrements counter if less than register." + (set-register ?\C-r 6) ;; Should be safe as a register name + (kmacro-tests-simulate-command '(kmacro-set-counter 7)) + (kmacro-tests-define-macro (vconcat + ;; Decrement counter if it's + ;; less than the register + "\C-u-\C-x\C-k\C-ra<\C-r" + ;; Insert and decrement counter + "\C-u-\C-x\C-k\C-i" + )) + (kmacro-tests-should-insert "7642" + (kmacro-tests-simulate-command '(kmacro-end-or-call-macro 4))) + (set-register ?\C-r nil)) + +(kmacro-tests-deftest kmacro-tests-test-reg-add-counter-greater () + "`kmacro-reg-add-counter-greater' increments counter if greater than register." + (set-register ?\C-r 1) ;; Should be safe as a register name + (kmacro-tests-define-macro (vconcat + ;; Insert and increment counter + "\C-x\C-k\C-i" + ;; Increment counter if it's greater + ;; than the register + "\C-x\C-k\C-ra>\C-r" + )) + (kmacro-tests-should-insert "0135" + (kmacro-tests-simulate-command '(kmacro-end-or-call-macro 4))) + (set-register ?\C-r nil)) + + +(kmacro-tests-deftest kmacro-tests-test-quit-counter-equal-01 () + "`kmacro-quit-counter-equal' stops macro if counter is equal to positive prefix." + (kmacro-tests-define-macro (vconcat + ;; Insert and increment counter + "\C-x\C-k\C-i" + ;; Stop if the counter is at 5 + "\C-u5\C-x\C-k\C-q=" + )) + (kmacro-tests-should-insert "0123" + (kmacro-tests-simulate-command '(kmacro-end-or-call-macro 4))) + (should (= 4 kmacro-counter)) + (should (condition-case abort + (kmacro-tests-simulate-command '(kmacro-end-or-call-macro 1)) + (quit abort)))) + +(kmacro-tests-deftest kmacro-tests-test-quit-counter-equal-02 () + "`kmacro-quit-counter-equal' stops macro if counter is equal to zero." + (kmacro-tests-simulate-command '(kmacro-set-counter 5)) + (kmacro-tests-define-macro (vconcat + ;; Insert and decrement counter + "\C-u-\C-x\C-k\C-i" + ;; Stop if the counter is at 0 + "\C-x\C-k\C-q=" + )) + (kmacro-tests-should-insert "5432" + (kmacro-tests-simulate-command '(kmacro-end-or-call-macro 4))) + (should (= 1 kmacro-counter)) + (should (condition-case abort + (kmacro-tests-simulate-command '(kmacro-end-or-call-macro 1)) + (quit abort)))) + +(kmacro-tests-deftest kmacro-tests-test-quit-counter-equal-03 () + "`kmacro-quit-counter-equal' stops macro if counter is equal to negative prefix." + (kmacro-tests-simulate-command '(kmacro-set-counter 4)) + (kmacro-tests-define-macro (vconcat + ;; Insert and decrement counter + "\C-u-\C-x\C-k\C-i" + ;; Stop if the counter is at -1 + "\C-u-\C-x\C-k\C-q=" + )) + (kmacro-tests-should-insert "4321" + (kmacro-tests-simulate-command '(kmacro-end-or-call-macro 4))) + (should (= 0 kmacro-counter)) + (should (condition-case abort + (kmacro-tests-simulate-command '(kmacro-end-or-call-macro 1)) + (quit abort)))) + +(kmacro-tests-deftest kmacro-tests-test-quit-counter-equal-04 () + "`kmacro-quit-counter-equal' doesn't stop macro if counter doesn't equal prefix." + (kmacro-tests-define-macro (vconcat + ;; Insert and increment counter + "\C-u2\C-x\C-k\C-i" + ;; Stop if the counter is at 7 + "\C-u7\C-x\C-k\C-q=" + )) + (kmacro-tests-should-insert "0246" + (kmacro-tests-simulate-command '(kmacro-end-or-call-macro 4))) + (should-not (condition-case abort + (kmacro-tests-simulate-command '(kmacro-end-or-call-macro 1)) + (quit abort))) + (should (= 10 kmacro-counter))) + +(kmacro-tests-deftest kmacro-tests-test-quit-counter-less () + "`kmacro-quit-counter-less' stops macro if counter is less than prefix." + (kmacro-tests-simulate-command '(kmacro-set-counter 8)) + (kmacro-tests-define-macro (vconcat + ;; Stop if the counter is less than 5 + "\C-u5\C-x\C-k\C-q<" + ;; Insert and decrement counter + "\C-u-\C-x\C-k\C-i" + )) + (kmacro-tests-should-insert "8765" + (kmacro-tests-simulate-command '(kmacro-end-or-call-macro 4))) + (should (condition-case abort + (should (= 4 kmacro-counter)) + (kmacro-tests-simulate-command '(kmacro-end-or-call-macro 1)) + (quit abort)))) + +(kmacro-tests-deftest kmacro-tests-test-quit-counter-greater () + "`kmacro-quit-counter-greater' stops macro if counter is greater than prefix." + (kmacro-tests-define-macro (vconcat + ;; Insert and increment counter + "\C-x\C-k\C-i" + ;; Stop if the counter is greater than 4 + "\C-u4\C-x\C-k\C-q>" + )) + (kmacro-tests-should-insert "0123" + (kmacro-tests-simulate-command '(kmacro-end-or-call-macro 4))) + (should (condition-case abort + (should (= 4 kmacro-counter)) + (kmacro-tests-simulate-command '(kmacro-end-or-call-macro 1)) + (quit abort)))) + + (kmacro-tests-deftest kmacro-tests-end-call-macro-prefix-args () "kmacro-end-call-macro changes behavior based on prefix arg." ;; "Record" two macros. -- 2.39.2