branch: externals/hyperbole
commit ae4fba3980af300e558ad37004a106bb00c8aef7
Author: bw <r...@gnu.org>
Commit: bw <r...@gnu.org>
hmouse-drv.el - Improve ibtype pred error handling when move point
hui:hbut-operate - Fix improper movement of point in source buffer
with an unwind-protect.
---
ChangeLog | 16 ++++++++++
hbut.el | 21 +++++++------
hmouse-drv.el | 78 +++++++++++++++++++++++++++++++------------------
hui.el | 5 ++--
test/hui-mouse-tests.el | 54 ++++++++++++++++++++++++++++++++++
5 files changed, 132 insertions(+), 42 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index 479762bb6b..a44d873914 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,19 @@
+2025-04-14 Bob Weiner <r...@gnu.org>
+
+* test/hui-mouse-tests.el (hui-mouse-tests--hkey-alist): Update with new
+ vertico hkey-actions.
+
+* hui.el (hui:hbut-operate): Add an unwind-protect to code that restores
+ point in cases where calling the `operation' triggers an error. Fixes
+ improper point movement in hywiki-display-page with a #section ref
+ where the section is not found and an error is raised.
+
+* hbut.el (ibut:create):
+ hmouse-drv.el (hkey-execute, hkey-actions, hkey-help): Change so point
+ moved error is thrown for any ibtype predicate tested, not just the
+ one selected; this will simplify tracking down bad ibtypes. Also
+ ensure pred-point marker is always set to nil after use.
+
2025-04-13 Bob Weiner <r...@gnu.org>
* test/hsys-org-tests.el (hsys-org--meta-return-on-end-of-line): Add
diff --git a/hbut.el b/hbut.el
index c314e023c5..b17c051acd 100644
--- a/hbut.el
+++ b/hbut.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 18-Sep-91 at 02:57:09
-;; Last-Mod: 13-Apr-25 at 14:34:35 by Bob Weiner
+;; Last-Mod: 14-Apr-25 at 23:07:21 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -2021,22 +2021,23 @@ If a new button is created, store its attributes in the
symbol,
;; Move to text of ibut before trying to activate
it
;; (may be on name)
(goto-char (+ (or text-start (point)) 2))))
- (setq ibtype-point (point))
+ (setq ibtype-point (point-marker))
(while (and (not is-type) types)
(setq itype (car types))
+ ;; Any implicit button type check should leave point
+ ;; unchanged. Trigger an error if not.
+ (unless (equal (point-marker) ibtype-point)
+ (hypb:error "(Hyperbole): ibtype %s improperly
moved point from %s to %s"
+ itype opoint (point)))
(when (condition-case err
(and itype (setq args (funcall itype)))
(error (progn (message "%S: %S" itype err)
(switch-to-buffer "*Messages*")
;; Show full stack trace
(debug))))
- (setq is-type itype)
- ;; Any implicit button type check should leave
point
- ;; unchanged. Trigger an error if not.
- (unless (equal (point) ibtype-point)
- (hypb:error "(Hyperbole): `%s' at-p test
improperly moved point from %s to %s"
- is-type opoint (point-marker))))
+ (setq is-type itype))
(setq types (cdr types))))
+ (set-marker ibtype-point nil)
(goto-char opoint)))
(set-marker opoint nil))
@@ -3037,9 +3038,7 @@ type for ibtype is presently undefined."
(at-func-symbols (flatten-tree at-func)))
(progn (unless (or (member 'ibut:label-set at-func-symbols)
(member 'hsys-org-set-ibut-label at-func-symbols))
- (error "(defib): %s `at-p' argument must include a call to
`ibut:label-set'" type))
- ;; (unless (member 'hact at-func-symbols)
- ;; (error "(defib): %s `at-p' argument must include a call to
`hact'" type))
+ (error "(defib): `at-p' argument for %s must include a call to
`ibut:label-set'" type))
`(progn (symtable:add ',type symtable:ibtypes)
(htype:create ,type ibtypes ,doc nil ,at-func
'(to-p ,to-func style ,style)))))))
diff --git a/hmouse-drv.el b/hmouse-drv.el
index c2ea344f78..6a418b3426 100644
--- a/hmouse-drv.el
+++ b/hmouse-drv.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 04-Feb-90
-;; Last-Mod: 12-Apr-25 at 15:47:32 by Bob Weiner
+;; Last-Mod: 14-Apr-25 at 22:57:56 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -996,14 +996,21 @@ frame instead."
"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)
- (while (and (null pred-value) (setq hkey-form (car hkey-forms)))
- (if (setq hkey-actions (cdr hkey-form)
- pred (car hkey-form)
- pred-value (hypb:eval-debug pred))
- nil
- (setq hkey-forms (cdr hkey-forms))))
- hkey-actions))
+ (unwind-protect
+ (progn
+ (while (and (null pred-value) (setq hkey-form (car hkey-forms)))
+ (setq hkey-actions (cdr hkey-form)
+ 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))
+ (unless pred-value
+ (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."
@@ -1044,25 +1051,30 @@ predicate is found."
(assist-flag assisting)
(pred-point (point-marker))
pred-value hkey-action hkey-form pred)
- (while (and (null pred-value) (setq hkey-form (car hkey-forms)))
- (if (setq hkey-action (if assisting (cddr hkey-form) (cadr hkey-form))
- pred (car hkey-form)
- pred-value (hypb:eval-debug pred))
- (progn
+ (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): `%s' predicate failed to restore point
to %s" pred pred-point))
- (set-marker pred-point nil)
- ;; 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))
+ (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)
+ (set-marker pred-point nil))))
(defun hkey-help (&optional assisting)
"Display help for the Action Key command in current context.
@@ -1077,11 +1089,19 @@ documentation is found."
(hkey-forms (if mouse-flag hmouse-alist hkey-alist))
(hrule:action #'actype:identity)
(assist-flag assisting)
- hkey-form pred-value call calls cmd-sym doc)
- (while (and (null pred-value) (setq hkey-form (car hkey-forms)))
- (or (setq pred-value (hypb:eval-debug (car hkey-form)))
- (setq hkey-forms (cdr hkey-forms))))
- (if pred-value
+ (pred-point (point-marker))
+ hkey-form pred pred-value call calls cmd-sym doc)
+ (unwind-protect
+ (while (and (null pred-value) (setq hkey-form (car hkey-forms)))
+ (or (setq pred (car hkey-form)
+ pred-value (hypb:eval-debug pred))
+ (setq hkey-forms (cdr hkey-forms)))
+ ;; Any Smart Key predicate should leave point unchanged.
+ ;; Trigger an error if not.
+ (unless (equal (point-marker) pred-point)
+ (hypb:error "(Hyperbole): `%s' predicate left point at %s and
failed to restore it to %s" pred (point) pred-point)))
+ (set-marker pred-point nil))
+ (if pred-value
(setq call (if assisting (cdr (cdr hkey-form))
(cadr hkey-form))
cmd-sym (if (eq (car call) #'funcall)
diff --git a/hui.el b/hui.el
index 85eb4bd033..d7285acd9a 100644
--- a/hui.el
+++ b/hui.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 19-Sep-91 at 21:42:03
-;; Last-Mod: 2-Feb-25 at 12:40:26 by Bob Weiner
+;; Last-Mod: 14-Apr-25 at 23:27:50 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -1643,7 +1643,8 @@ completion of all labeled buttons within the current
buffer."
(ibut:to-text (hattr:get but 'lbl-key)))
(setq text-start (point-marker))
(hui:but-flash)
- (prog1 (apply hrule:action operation `(',but))
+ (unwind-protect
+ (apply hrule:action operation `(',but))
;; Restore point as it was prior to `text-start' move
;; if the action switched buffers or did not move point
;; within the current buffer.
diff --git a/test/hui-mouse-tests.el b/test/hui-mouse-tests.el
new file mode 100644
index 0000000000..0112cf57e1
--- /dev/null
+++ b/test/hui-mouse-tests.el
@@ -0,0 +1,54 @@
+;;; hui-mouse-tests.el --- unit tests for hui-mouse -*- lexical-binding: t; -*-
+;;
+;; Author: Mats Lidell
+;;
+;; Orig-Date: 15-Mar-25 at 22:39:37
+;; Last-Mod: 12-Apr-25 at 17:30:33 by Bob Weiner
+;;
+;; SPDX-License-Identifier: GPL-3.0-or-later
+;;
+;; Copyright (C) 2025 Free Software Foundation, Inc.
+;; See the "HY-COPY" file for license information.
+;;
+;; This file is part of GNU Hyperbole.
+
+;;; Commentary:
+;;
+;; Unit tests for "../hui-mouse.el".
+
+;;; Code:
+
+(require 'ert)
+(require 'el-mock)
+
+;; !! FIXME: Add more predicate cases from hkey-alist.
+(ert-deftest hui-mouse-tests--hkey-alist ()
+ "Verify that given predicate values triggers the proper action."
+ ;; Treemacs
+ (let ((major-mode 'treemacs-mode))
+ (should (equal (hkey-actions)
+ (cons '(smart-treemacs) '(smart-treemacs)))))
+
+ ;; dired-sidebar-mode
+ (let ((major-mode 'dired-sidebar-mode))
+ (should (equal (hkey-actions)
+ (cons '(smart-dired-sidebar) '(smart-dired-sidebar)))))
+
+ ;; Vertico
+ (let ((ivy-mode nil)
+ (vertico-mode t))
+ (mocklet ((vertico--command-p => t))
+ (should (equal (hkey-actions)
+ (cons '(funcall (lookup-key vertico-map (kbd "M-RET")))
+ '(funcall (lookup-key vertico-map (kbd
"M-RET")))))))))
+
+(provide 'hui-mouse-tests)
+
+;; This file can't be byte-compiled without the `el-mock' package
+;; which is not a dependency of Hyperbole.
+;;
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
+
+;;; hui-mouse-tests.el ends here
