branch: externals/hyperbole
commit 2d2b23c3d5ce1bbc3953325cd953d535637e12fa
Author: Mats Lidell <mats.lid...@lidells.se>
Commit: GitHub <nore...@github.com>
refactor hkey execute (#727)
---
ChangeLog | 8 +++++
hmouse-drv.el | 81 ++++++++++++++++++++----------------------------
test/hmouse-drv-tests.el | 53 ++++++++++++++++++++++++++++++-
3 files changed, 94 insertions(+), 48 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index c534fac7a2..7a61caecaf 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2025-05-12 Mats Lidell <ma...@gnu.org>
+
+* test/hmouse-drv-tests.el (hmouse-drv--hkey-actions): Test hkey-actions.
+ (hmouse-drv--hkey-execute): Test hkey-execute.
+ (hmouse-drv--hkey-execute-called, hmouse-drv--hkey-execute-action)
+ (hmouse-drv--hkey-execute-assist): Helpers used in hkey-execute
+ verification.
+
2025-05-08 Mats Lidell <ma...@gnu.org>
* hui-mouse.el (hkey-alist): Use deprecated but still supported calling
diff --git a/hmouse-drv.el b/hmouse-drv.el
index c4d0c01a62..c5bb06f429 100644
--- a/hmouse-drv.el
+++ b/hmouse-drv.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 04-Feb-90
-;; Last-Mod: 7-May-25 at 21:52:27 by Mats Lidell
+;; Last-Mod: 10-May-25 at 00:19:45 by Mats Lidell
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -992,26 +992,6 @@ frame instead."
(mouse-drag-frame-move start-event)
(mouse-drag-frame start-event 'move))))))
-(defun hkey-actions ()
- "Return the cons of the Action and Assist Key actions at point.
-Useful in testing Smart Key contexts."
- (let ((hkey-forms hkey-alist)
- (pred-point (point-marker))
- pred-value hkey-actions hkey-form pred)
- (unwind-protect
- (progn
- (while (and (null pred-value) (setq hkey-form (car hkey-forms)))
- (setq pred (car hkey-form)
- pred-value (hypb:eval-debug pred))
- (unless (equal (point-marker) pred-point)
- (hypb:error "(Hyperbole): predicate %s improperly moved point
from %s to %s"
- pred (point) pred-point))
- (if pred-value
- (setq hkey-actions (cdr hkey-form))
- (setq hkey-forms (cdr hkey-forms))))
- hkey-actions)
- (set-marker pred-point nil))))
-
(defun hkey-debug (pred pred-value hkey-action)
"Display a message with the context and values from Smart Key activation."
(message (concat "(HyDebug) %sContext: %s; %s: %s; Buf: %s; Mode: %s;
MinibufDepth: %s\n"
@@ -1041,39 +1021,46 @@ Useful in testing Smart Key contexts."
assist-key-depress-window
assist-key-release-window))
+(defun hkey-actions ()
+ "Return the cons of the Action and Assist Key actions at point.
+Useful in testing Smart Key contexts."
+ (let ((hkey-forms hkey-alist)
+ (pred-point (point-marker))
+ pred-value hkey-actions hkey-form pred)
+ (progn
+ (while (and (null pred-value) (setq hkey-form (car hkey-forms)))
+ (setq pred (car hkey-form)
+ pred-value (hypb:eval-debug pred))
+ (unless (equal (point-marker) pred-point)
+ (hypb:error "(Hyperbole): predicate %s improperly moved point from %s
to %s"
+ pred (point) pred-point))
+ (if pred-value
+ (progn
+ (setq hkey-actions (cdr hkey-form))
+ ;; Conditionally debug after Smart Key release and evaluation
+ ;; of matching predicate but before hkey-action is executed.
+ (when hkey-debug
+ (hkey-debug pred pred-value (if assist-flag (cdr hkey-actions)
(car hkey-actions)))))
+ (setq hkey-forms (cdr hkey-forms))))
+ hkey-actions)))
+
(defun hkey-execute (assisting)
"Evaluate Action Key form for first non-nil predicate from `hkey-alist'.
Non-nil ASSISTING means evaluate second form (Assist Key form),
otherwise evaluate first form. Return non-nil iff a non-nil
predicate is found."
;; Keep in mind that hkey-alist may be set to hmouse-alist here, with
additional predicates.
- (let ((hkey-forms hkey-alist)
- (assist-flag assisting)
- (pred-point (point-marker))
- pred-value hkey-action hkey-form pred)
+ (let ((assist-flag assisting)
+ (pred-point (point-marker)))
(unwind-protect
- (progn
- (while (and (null pred-value) (setq hkey-form (car hkey-forms)))
- (setq hkey-action (if assisting (cddr hkey-form) (cadr hkey-form))
- pred (car hkey-form)
- pred-value (hypb:eval-debug pred))
- ;; Any Smart Key predicate should leave point unchanged.
- ;; Trigger an error if not.
- (unless (equal (point-marker) pred-point)
- (hypb:error "(Hyperbole): predicate %s improperly moved point
from %s to %s"
- pred (point) pred-point))
- (if pred-value
- ;; Found the ibtype for the current context
- (progn
- ;; Conditionally debug after Smart Key release and evaluation
- ;; of matching predicate but before hkey-action is executed.
- (when hkey-debug
- (hkey-debug pred pred-value hkey-action))
- (if hkey-debug
- (hypb:eval-debug hkey-action)
- (eval hkey-action)))
- (setq hkey-forms (cdr hkey-forms))))
- pred-value)
+ (let* ((hkey-actions (hkey-actions))
+ (hkey-action (if assisting (cdr hkey-actions) (car
hkey-actions))))
+ (if hkey-action
+ ;; Found the ibtype for the current context
+ (if hkey-debug
+ (hypb:eval-debug hkey-action)
+ (eval hkey-action)))
+ hkey-action)
(set-marker pred-point nil))))
(defun hkey-help (&optional assisting)
diff --git a/test/hmouse-drv-tests.el b/test/hmouse-drv-tests.el
index 07d6652af4..87728289cd 100644
--- a/test/hmouse-drv-tests.el
+++ b/test/hmouse-drv-tests.el
@@ -3,7 +3,7 @@
;; Author: Mats Lidell <ma...@gnu.org>
;;
;; Orig-Date: 28-Feb-21 at 22:52:00
-;; Last-Mod: 25-Apr-25 at 10:01:41 by Mats Lidell
+;; Last-Mod: 17-May-25 at 16:07:56 by Mats Lidell
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -655,6 +655,57 @@ The frame setup is mocked."
(hy-delete-file-and-buffer filea)
(hy-delete-file-and-buffer fileb))))
+(ert-deftest hmouse-drv--hkey-actions ()
+ "Verify `hkey-actions'."
+ ;; No action
+ (let ((hkey-alist '((nil . ((action) . (assist))))))
+ (should-not (hkey-actions)))
+
+ (let ((hkey-alist '((t . ((action) . (assist))))))
+ ;; Normal case
+ (should (equal (hkey-actions) '((action) assist)))
+
+ ;; Point is moved by predicate
+ (let ((marker 1))
+ (cl-letf (((symbol-function 'point-marker)
+ (lambda () (setq marker (1+ marker)))))
+ (let ((err (should-error (hkey-actions) :type 'error)))
+ (should (string-match-p
+ (format "(Hyperbole): predicate %s improperly moved point
from %s to %s" t 1 2)
+ (cadr err))))))
+
+ ;; Debug is called for action and assist.
+ (let ((hkey-debug t))
+ (dolist (v '(nil t))
+ (let ((assist-flag v))
+ (mocklet (((hkey-debug t t (if assist-flag '(assist) '(action))) =>
t))
+ (should (equal (hkey-actions) '((action) assist)))))))))
+
+(defvar hmouse-drv--hkey-execute-called nil "For checking what method was
called.")
+(defun hmouse-drv--hkey-execute-action () "Action." (setq
hmouse-drv--hkey-execute-called "action"))
+(defun hmouse-drv--hkey-execute-assist () "Assist." (setq
hmouse-drv--hkey-execute-called "assist"))
+
+(ert-deftest hmouse-drv--hkey-execute ()
+ "Verify `hkey-execute'."
+ ;; No action
+ (let ((hkey-alist '((nil . ("action" . "assist")))))
+ (should-not (hkey-execute nil)))
+
+ ;; Normal case with action or assist
+ (let ((hkey-alist '((t . ((hmouse-drv--hkey-execute-action) .
(hmouse-drv--hkey-execute-assist)))))
+ hmouse-drv--hkey-execute-called)
+ ;; Action
+ (should (equal (hkey-execute nil) '(hmouse-drv--hkey-execute-action)))
+ (should (string= hmouse-drv--hkey-execute-called "action"))
+ ;; Assist
+ (should (equal (hkey-execute t) '(hmouse-drv--hkey-execute-assist)))
+ (should (string= hmouse-drv--hkey-execute-called "assist"))
+
+ ;; Print debug info
+ (let ((hkey-debug t))
+ (mocklet (((hypb:eval-debug *) => t))
+ (should (equal (hkey-execute nil)
'(hmouse-drv--hkey-execute-action)))))))
+
;; This file can't be byte-compiled without the `el-mock' package
;; which is not a dependency of Hyperbole.
;; Local Variables:
