branch: externals/hyperbole
commit d57be5a4582aeae518e29ad079062571b9e9da04
Author: bw <r...@gnu.org>
Commit: bw <r...@gnu.org>
hkey-help - Put hbut and actype info at the top of help
In cases like the multi-context 'smart-org' handler where a specific
action type is triggered without defining an implicit button, display
the action type information at the top as well, so it is clear the
specific action that will be taken at point.
---
ChangeLog | 15 ++++++++
hmouse-drv.el | 114 +++++++++++++++++++++++++++++++++-------------------------
2 files changed, 80 insertions(+), 49 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index 31aef3eb19..46b5c47b3e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -16,6 +16,21 @@
'ert-test-failed match is found but it is far way and unconnected to the
current point.
+* hmouse-drv.el (hkey-help):
+ Update {C-h A} Hyperbole help so button information is displayed at
+ the top before long Action/Assist Key behavior description.
+
+ In cases like the multi-context 'smart-org' handler where a specific
+ action type is triggered without defining an implicit button, display
+ the action type information at the top as well, so it is clear the
+ specific action that will be taken at point.
+
+ Fix bug where 'categ' is nil and 'htype:names' returns a list of all
+ type names to 'concat' since expecting only a single name.
+
+ When displaying Assist Key help, remove actype and action attributes
+ from button or actype display.
+
* hycontrol.el (require 'zoom-frm): Wrap in an 'ignore-errors' so if its
required library, 'frame-cmds' is not installed, no error occurs and
HyControl behaves works without the library.
diff --git a/hmouse-drv.el b/hmouse-drv.el
index e9a3583353..bacb22e1ce 100644
--- a/hmouse-drv.el
+++ b/hmouse-drv.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 04-Feb-90
-;; Last-Mod: 15-Dec-24 at 22:38:04 by Bob Weiner
+;; Last-Mod: 22-Feb-25 at 11:52:57 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -1115,47 +1115,32 @@ documentation is found."
(format "%s %sKey"
(if assisting "Assist" "Action")
(if mouse-flag "Mouse " "")))
- (princ (format "A %s of the %s %sKey"
- (if mouse-flag
- (if mouse-drag-flag "drag" "click")
- "press")
- (if assisting "Assist" "Action")
- (if mouse-flag "Mouse " "")))
- (terpri)
- (princ "WHEN ")
- (princ
- (or condition
- "there is no matching context"))
- (terpri)
-
- (mapc (lambda (c)
- (when (and (> (length calls) 1)
- (not (eq (car calls) c)))
- ;; Is an 'or' set of calls
- (princ "OR "))
- (princ "CALLS ") (princ (if (consp c) c (list c)))
- (when (and (fboundp (setq call (if (consp c) (car
c) c)))
- (setq doc (documentation call)))
- (princ " WHICH")
- (princ (if (string-match
"\\`[a-zA-Z]*[a-rt-zA-RT-Z]+s[ [:punct:]]" doc)
- ":" " WILL:"))
- (terpri) (terpri)
- (princ (replace-regexp-in-string "^" " " doc nil
t))
- (terpri) (terpri)))
- calls)
;; Print Hyperbole button attributes
- (when (memq cmd-sym '(hui:hbut-act hui:hbut-help))
- (let ((actype (or (actype:elisp-symbol (hattr:get
'hbut:current 'actype))
- (hattr:get 'hbut:current 'actype)))
- ;; (lbl-key (hattr:get 'hbut:current 'lbl-key))
- (categ (hattr:get 'hbut:current 'categ))
- (attributes (nthcdr 2 (hattr:list 'hbut:current))))
-
- (princ (format "%s %s BUTTON SPECIFICS:\n"
- (htype:def-symbol
- (if (eq categ 'explicit) actype categ))
- (if (eq categ 'explicit) "EXPLICIT"
"IMPLICIT")))
+ (when (or (memq cmd-sym '(hui:hbut-act hui:hbut-help))
+ (hattr:get 'hbut:current 'actype))
+ (let* ((actype (or (actype:elisp-symbol (hattr:get
'hbut:current 'actype))
+ (hattr:get 'hbut:current 'actype)))
+ ;; (lbl-key (hattr:get 'hbut:current 'lbl-key))
+ (categ (hattr:get 'hbut:current 'categ))
+ (attributes (nthcdr 2 (hattr:list 'hbut:current)))
+ (but-def-symbol (htype:def-symbol
+ (if (eq categ 'explicit) actype
categ))))
+
+ (princ (format "%s %s SPECIFICS:\n"
+ (or but-def-symbol
+ (htype:def-symbol actype))
+ (cond ((eq categ 'explicit)
+ "EXPLICIT BUTTON")
+ (categ
+ "IMPLICIT BUTTON")
+ (t "ACTION TYPE"))))
+ (when (and assisting
+ (or (plist-member attributes 'actype)
+ (plist-member attributes 'action)))
+ (setq attributes (copy-sequence attributes))
+ (hypb:remove-from-plist attributes 'actype)
+ (hypb:remove-from-plist attributes 'action))
(hattr:report attributes)
(unless (or assisting
(eq categ 'explicit)
@@ -1167,13 +1152,15 @@ documentation is found."
(replace-regexp-in-string "^" " "
(documentation categ)
nil t))))
(if assisting
- (let* ((custom-help-func (intern-soft
- (concat (htype:names
'ibtypes categ)
- ":help")))
- (type-help-func (or (and custom-help-func
(fboundp custom-help-func)
+ (let* ((ibtype-name (htype:names 'ibtypes categ))
+ (custom-help-func (when (stringp ibtype-name)
+ (intern-soft
+ (concat ibtype-name
":help"))))
+ (type-help-func (or (and custom-help-func
+ (fboundp
custom-help-func)
custom-help-func)
'hbut:report)))
- (princ (format "\n%s ASSIST SPECIFICS:\n%s\n"
+ (princ (format "\n%s ASSIST KEY SPECIFICS:\n%s\n"
type-help-func
(replace-regexp-in-string
"^" " " (documentation
type-help-func)
@@ -1181,10 +1168,11 @@ documentation is found."
(when (and (symbolp actype)
(fboundp actype)
(documentation actype))
- (princ (format "\n%s ACTION SPECIFICS:\n%s\n"
+ (princ (format "\n%s ACTION KEY SPECIFICS:\n%s\n"
(or (actype:def-symbol actype)
actype)
(replace-regexp-in-string "^" " "
(documentation actype)
- nil
t)))))))
+ nil t)))))
+ (terpri)))
;; Print Emacs push-button attributes
(when (memq cmd-sym '(smart-push-button
smart-push-button-help))
@@ -1199,9 +1187,37 @@ documentation is found."
(princ (format "\n%s ACTION SPECIFICS:\n%s\n"
(plist-get attributes 'action)
(replace-regexp-in-string "^" " "
(actype:doc button t)
- nil
t)))))))
+ nil t))))
+ (terpri))))
- (terpri)))
+ (princ (format "A %s of the %s %sKey"
+ (if mouse-flag
+ (if mouse-drag-flag "drag" "click")
+ "press")
+ (if assisting "Assist" "Action")
+ (if mouse-flag "Mouse " "")))
+ (terpri)
+ (princ "WHEN ")
+ (princ
+ (or condition
+ "there is no matching context"))
+ (terpri)
+
+ (mapc (lambda (c)
+ (when (and (> (length calls) 1)
+ (not (eq (car calls) c)))
+ ;; Is an 'or' set of calls
+ (princ "OR "))
+ (princ "CALLS ") (princ (if (consp c) c (list c)))
+ (when (and (fboundp (setq call (if (consp c) (car
c) c)))
+ (setq doc (documentation call)))
+ (princ " WHICH")
+ (princ (if (string-match
"\\`[a-zA-Z]*[a-rt-zA-RT-Z]+s[ [:punct:]]" doc)
+ ":" " WILL:"))
+ (terpri) (terpri)
+ (princ (replace-regexp-in-string "^" " " doc nil
t))
+ (terpri) (terpri)))
+ calls)))
"")
(message "No %s Key command for current context."
(if assisting "Assist" "Action"))))
