[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/hyperbole c353f18936 3/5: {C-h A} on an Emacs push-butt
|
From: |
ELPA Syncer |
|
Subject: |
[elpa] externals/hyperbole c353f18936 3/5: {C-h A} on an Emacs push-button now shows its attributes |
|
Date: |
Sun, 9 Apr 2023 10:57:59 -0400 (EDT) |
branch: externals/hyperbole
commit c353f1893605d12204cac3905623aaef0b7521a8
Author: Bob Weiner <rsw@gnu.org>
Commit: Bob Weiner <rsw@gnu.org>
{C-h A} on an Emacs push-button now shows its attributes
Same command also shows the doc for implicit button action types
(previously displayed only the ibtype doc). It also prints whether
the current button is EXPLICIT or IMPLICIT.
---
ChangeLog | 10 ++++++++++
hact.el | 24 ++++++++++++++----------
hbut.el | 22 ++++++++++++++++++----
hmouse-drv.el | 54 +++++++++++++++++++++++++++++++++++++++++++-----------
4 files changed, 85 insertions(+), 25 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index ce3fbc947f..5aea992592 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2023-04-08 Bob Weiner <rsw@gnu.org>
+
+* hbut.el (hattr:emacs-button-attributes, hattr:emacs-button-is-p): Add
+ (hattr:list): Return Emacs push-button attributes.
+ hact.el (actype:doc): Add support for Emacs push-buttons.
+ hmouse-drv.el (hkey-help): Print attributes of Emacs push-buttons and
+ doc for button's action, just as with Hyperbole buttons.
+ Display whether a Hyperbole button is EXPLICIT or IMPLICIT.
+ Also, for implicit buttons, add display of both ibtype doc and its
+ actype doc.
* hyrolo.el (hyrolo-isearch-regexp): Fix 'arg' conditions were reversed.
diff --git a/hact.el b/hact.el
index a2aa3c7ba9..df3faf1380 100644
--- a/hact.el
+++ b/hact.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 18-Sep-91 at 02:57:09
-;; Last-Mod: 6-Feb-23 at 00:05:26 by Bob Weiner
+;; Last-Mod: 8-Apr-23 at 13:33:01 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -489,19 +489,23 @@ Return symbol created when successful, else nil."
(symtable:delete type symtable:actypes)
(htype:delete type 'actypes))
-(defun actype:doc (hbut &optional full)
- "Return first line of act doc for HBUT (a Hyperbole button symbol).
+(defun actype:doc (but &optional full)
+ "Return first line of action doc for BUT.
+BUT should be a Hyperbole button symbol or an Emacs push-button.
With optional FULL, returns full documentation string.
Return nil when no documentation."
- (let* ((act (and (hbut:is-p hbut) (or (hattr:get hbut 'action)
- (hattr:get hbut 'actype))))
- (but-type (hattr:get hbut 'categ))
- (sym-p (and act (symbolp act)))
+ (let* ((is-hbut (hbut:is-p but))
+ (act (if is-hbut
+ (and (hbut:is-p but) (or (hattr:get but 'action)
+ (hattr:get but 'actype)))
+ (plist-get (hattr:list but) 'action)))
+ (but-type (if is-hbut
+ (hattr:get but 'categ)
+ act))
+ (sym-p (when act (symbolp act)))
(end-line) (doc))
(cond ((and (functionp but-type)
- (setq doc (htype:doc but-type)))
- ;; Is an implicit button, so use its doc string if any.
- )
+ (setq doc (htype:doc but-type)))) ;; Is an implicit button, use
its doc string.
(sym-p
(setq doc (htype:doc act))))
(when doc
diff --git a/hbut.el b/hbut.el
index 7d8a3dc986..cd7c75e66f 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: 29-Mar-23 at 22:25:14 by Bob Weiner
+;; Last-Mod: 8-Apr-23 at 12:50:22 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -791,6 +791,19 @@ Return TO-HBUT."
(setplist to-hbut (copy-sequence (symbol-plist from-hbut)))
to-hbut)
+(defun hattr:emacs-button-attributes (button)
+ "Return a property list of an Emacs BUTTON."
+ (let ((category (hattr:emacs-button-is-p button)))
+ (when category
+ (symbol-plist category))))
+
+(defun hattr:emacs-button-is-p (button)
+ "If BUTTON is a valid Emacs button, return its category, else return nil."
+ (let* ((type (when (or (overlayp button) (markerp button))
+ (button-get button 'type)))
+ (category (when type (get type 'button-category-symbol))))
+ category))
+
(defun hattr:get (obj-symbol attr-symbol)
"Return value of OBJ-SYMBOL's attribute ATTR-SYMBOL."
(get obj-symbol attr-symbol))
@@ -798,9 +811,10 @@ Return TO-HBUT."
(defun hattr:list (obj-symbol)
"Return a property list of OBJ-SYMBOL's attributes.
Each pair of elements is: <attrib-name> <attrib-value>."
- (if (symbolp obj-symbol)
- (symbol-plist obj-symbol)
- (error "(hattr:list): Argument not a symbol: %s" obj-symbol)))
+ (cond ((hattr:emacs-button-attributes obj-symbol))
+ ((symbolp obj-symbol)
+ (symbol-plist obj-symbol))
+ (t (error "(hattr:list): Argument not a symbol: %s" obj-symbol))))
(defun hattr:memq (attr-symbol obj-symbol)
"Return t if ATTR-SYMBOL is in OBJ-SYMBOL's attribute list, else nil."
diff --git a/hmouse-drv.el b/hmouse-drv.el
index 5d8305bc78..61ba45bf0a 100644
--- a/hmouse-drv.el
+++ b/hmouse-drv.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 04-Feb-90
-;; Last-Mod: 12-Mar-23 at 23:59:11 by Bob Weiner
+;; Last-Mod: 8-Apr-23 at 15:15:47 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -1015,17 +1015,49 @@ documentation is found."
(terpri) (terpri)))
calls)
+ ;; Print Hyperbole button attributes
(when (memq cmd-sym '(hui:hbut-act hui:hbut-help))
- (princ (format "%s BUTTON SPECIFICS:\n"
- (htype:def-symbol
- (if (eq (hattr:get 'hbut:current 'categ)
- 'explicit)
- (hattr:get 'hbut:current 'actype)
- (hattr:get 'hbut:current 'categ)))))
- (hattr:report
- (nthcdr 2 (hattr:list 'hbut:current)))
- (princ (format "\n%s\n"
- (actype:doc 'hbut:current t))))
+ (let ((actype (or (actype:elisp-symbol (hattr:get
'hbut:current 'actype))
+ (hattr:get 'hbut:current 'actype)))
+ (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")))
+ (hattr:report attributes)
+ (unless (or (eq categ 'explicit)
+ (null categ)
+ (not (fboundp categ))
+ (null (documentation categ)))
+ ;; Include implicit button's ibtype doc
+ (princ (format "\n%s\n"
+ (replace-regexp-in-string "^" " "
(documentation categ)
+ nil t))))
+ (when (and (symbolp actype)
+ (fboundp actype)
+ (documentation actype))
+ (princ (format "\n%s ACTION SPECIFICS:\n%s\n"
+ (or (actype:def-symbol actype) actype)
+ (replace-regexp-in-string "^" " "
(documentation actype)
+ nil t))))))
+
+ ;; Print Emacs push-button attributes
+ (when (eq cmd-sym 'push-button)
+ (let* ((button (button-at (point)))
+ (attributes (when button (hattr:list button))))
+ (when attributes
+ (princ (format "%s BUTTON SPECIFICS:\n"
+ (button-label button)))
+ (hattr:report attributes)
+ (princ (format "\n%s ACTION SPECIFICS:\n%s\n"
+ (plist-get attributes 'action)
+ (replace-regexp-in-string "^" " "
(actype:doc button t)
+ nil t))))))
+
(terpri)))
"")
(message "No %s Key command for current context."