branch: externals/hyperbole
commit 214c9b594bc2960d053d7ceb6ed0a2bb296e2b0d
Author: bw <r...@gnu.org>
Commit: bw <r...@gnu.org>
hibtypes.el - Add 'ibut:label-set' call to defib calls without it
---
ChangeLog | 10 +++++++++-
hbut.el | 14 ++++++++------
hib-debbugs.el | 7 +++++--
hibtypes.el | 43 +++++++++++++++++++++++++++++--------------
4 files changed, 51 insertions(+), 23 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index 9eda7c08e3..9544d59b6f 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,12 @@
2024-06-30 Bob Weiner <r...@gnu.org>
+* hbut.el (defib): Remove requirement for call to 'hact' since sometimes
+ the action includes this instead.
+
+* hibtypes.el (annot-bib, gnus-push-button, hyp-address, elink, glink, ilink,
+ python-tb-previous-line, debugger-source):
+ Add 'ibut:label-set' call.
+
* man/hyperbole.texi (Programmatic Implicit Button Types): Expand doc on
'at-p' argument and explain its 'ibut:label-set' and 'hact' calls.
@@ -12,7 +19,8 @@
from either the package pathname or from "debbugs.el" or "debbugs-gnu.el".
Fixes bug where debbugs is installed bug not used so bug ibuts are not
active.
- (defib debbugs-gnu-query): Add `ibut:label-set' call.
+ (defib debbugs-gnu-mode, defib debbugs-gnu-query): Add
`ibut:label-set'
+ call.
(defib): Improve doc to mention requirement for call to
'ibut:label-set'.
* test/hui-tests.el (hui-ebut-create-link-to-info-index-using-completion):
diff --git a/hbut.el b/hbut.el
index 7e27af988f..93b26098c0 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-Jun-24 at 22:03:56 by Bob Weiner
+;; Last-Mod: 30-Jun-24 at 10:01:50 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -2953,8 +2953,9 @@ TYPE is an unquoted symbol. PARAMS are presently ignored.
AT-P is a boolean form of no arguments which determines whether or not point
is within a button of this type. When non-nil, it must contain a call
to `ibut:label-set' with the text and optional buffer region of the
-button's label. This must be followed by a call to `hact' with an
-action to be performed whenever a button of this type is activated.
+button's label. This almost always should be followed by a call to
+`hact' with an action to be performed whenever a button of this type
+is activated.
The action may be a regular Emacs Lisp function or a Hyperbole action
type created with `defact' but may not return nil since any nil value
@@ -2979,10 +2980,11 @@ type for ibtype is presently undefined."
(let* ((to-func (when to-p (action:create nil (list to-p))))
(at-func (list at-p))
(at-func-symbols (flatten-tree at-func)))
- (progn (unless (member 'ibut:label-set at-func-symbols)
+ (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))
+ ;; (unless (member 'hact at-func-symbols)
+ ;; (error "(defib): %s `at-p' argument must include a call to
`hact'" type))
`(progn (symtable:add ',type symtable:ibtypes)
(htype:create ,type ibtypes ,doc nil ,at-func
'(to-p ,to-func style ,style)))))))
diff --git a/hib-debbugs.el b/hib-debbugs.el
index 5452bd3ef1..b3792760ba 100644
--- a/hib-debbugs.el
+++ b/hib-debbugs.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 21-Jun-16 at 14:24:53
-;; Last-Mod: 29-Jun-24 at 22:30:57 by Bob Weiner
+;; Last-Mod: 30-Jun-24 at 03:16:07 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -144,7 +144,10 @@ Ignore other types of GNU debbugs query strings."
(defib debbugs-gnu-mode ()
"Make a Gnu Debbugs listing entry at point display the discussion on the
issue."
- (if (eq major-mode 'debbugs-gnu-mode)
+ (when (eq major-mode 'debbugs-gnu-mode)
+ (ibut:label-set (buffer-substring-no-properties
+ (line-beginning-position) (line-end-position))
+ (line-beginning-position) (line-end-position))
(hact 'smart-debbugs-gnu)))
(defun debbugs-gnu-mode:help (&optional _but)
diff --git a/hibtypes.el b/hibtypes.el
index f05a421f75..d66efa347c 100644
--- a/hibtypes.el
+++ b/hibtypes.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 19-Sep-91 at 20:45:31
-;; Last-Mod: 16-Jun-24 at 11:25:46 by Mats Lidell
+;; Last-Mod: 30-Jun-24 at 10:34:39 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -113,8 +113,7 @@ reference line so since not on a Hyperbole button, move
back a
line and check for a source reference line again."
(save-excursion
(unless (/= (forward-line -1) 0)
- ;; Don't wrap this next line in (hact) since has hact call
- ;; in the function itself.
+ (ibut:label-set "temp") ;; Real value set in action call below
(hib-python-traceback))))
;;; ========================================================================
@@ -374,14 +373,16 @@ attached file."
(not (apply #'derived-mode-p '(prog-mode c-mode objc-mode c++-mode
java-mode markdown-mode org-mode)))
(unless (ibut:label-p t "[[" "]]" t) ;; Org link
(let ((ref (hattr:get 'hbut:current 'lbl-key))
- (lbl-start (hattr:get 'hbut:current 'lbl-start)))
+ (lbl-start (hattr:get 'hbut:current 'lbl-start))
+ lbl-start-end)
(and ref
lbl-start
(eq ?w (char-syntax (aref ref 0)))
(not (string-match "[#@]" ref))
(save-excursion
(goto-char lbl-start)
- (ibut:label-p t "[" "]" t))
+ (setq lbl-start-end (ibut:label-p t "[" "]" t)))
+ (apply #'ibut:label-set lbl-start-end)
(hact 'annot-bib ref))))))
;;; ========================================================================
@@ -824,7 +825,9 @@ context of the current buffer.
Recognizes the format '<elink:' button_label [':' button_file_path] '>',
where : button_file_path is given only when the link is to another file,
e.g. <elink: project-list: ~/projs>."
- (hlink 'link-to-ebut "" elink:start elink:end))
+ (progn
+ (ibut:label-set "temp") ;; Real value set in action call below
+ (hlink 'link-to-ebut "" elink:start elink:end)))
(defconst glink:start "<glink:"
"String matching the start of a link to a Hyperbole global button.")
@@ -838,7 +841,9 @@ of the current buffer.
Recognizes the format '<glink:' button_label '>',
e.g. <glink: open todos>."
- (hlink 'link-to-gbut "" glink:start glink:end))
+ (progn
+ (ibut:label-set "temp") ;; Real value set in action call below
+ (hlink 'link-to-gbut "" glink:start glink:end)))
(defconst ilink:start "<ilink:"
"String matching the start of a link to a Hyperbole implicit button.")
@@ -853,7 +858,9 @@ current buffer.
Recognizes the format '<ilink:' button_label [':' button_file_path] '>',
where button_file_path is given only when the link is to another file,
e.g. <ilink: my series of keys: ${hyperb:dir}/HYPB>."
- (hlink 'link-to-ibut "" ilink:start ilink:end))
+ (progn
+ (ibut:label-set "temp") ;; Real value set in action call below
+ (hlink 'link-to-ibut "" ilink:start ilink:end)))
;;; ========================================================================
;;; Displays files at specific lines and optional column number
@@ -1088,9 +1095,8 @@ xdb. Such lines are recognized in any buffer."
(beginning-of-line)
(cond
;; Python pdb or traceback, pytype error
- ;; Don't wrap this next line in (hact) since has hact call
- ;; in the function itself.
- ((hib-python-traceback))
+ ((progn (ibut:label-set "temp") ;; Real value set in action call below
+ (hib-python-traceback)))
;; JavaScript traceback
((or (looking-at "[a-zA-Z0-9-:.()? ]+? +at \\([^() \t]+\\) (\\([^:,
\t()]+\\):\\([0-9]+\\):\\([0-9]+\\))$")
@@ -1384,9 +1390,15 @@ documentation string is displayed."
"Activate GNUS-specific article push-buttons, e.g. for hiding signatures.
GNUS is a news and mail reader."
(and (fboundp 'get-text-property)
- (get-text-property (point) 'gnus-callback)
(fboundp 'gnus-article-press-button)
- (hact 'gnus-article-press-button)))
+ (get-text-property (point) 'gnus-callback)
+ (let* ((but (button-at (point)))
+ (but-start (when but (button-start but)))
+ (but-end (when but (button-end but))))
+ (when but
+ (ibut:label-set (buffer-substring-no-properties but-start but-end)
+ but-start but-end)
+ (hact 'gnus-article-press-button)))))
;;; ========================================================================
;;; Displays Info nodes when double quoted "(file)node" button is activated.
@@ -1434,11 +1446,13 @@ also the documentation for `actypes::hyp-config'.
For example, an Action Mouse Key click on <hyperbole-us...@gnu.org> in
a mail composer window would activate this implicit button type."
(when (memq major-mode (list 'mail-mode hmail:composer hnews:composer))
- (let ((addr (thing-at-point 'email)))
+ (let ((addr (thing-at-point 'email t)))
(cond ((null addr) nil)
((member addr '("hyperbole" "hyperbole-us...@gnu.org"
"bug-hyperb...@gnu.org"))
+ (ibut:label-set addr)
(hact 'hyp-config))
((string-match
"\\(hyperbole\\|hyperbole-users@gnu\\.org\\|bug-hyperbole@gnu\\.org\\)\\(-\\(join\\|leave\\|owner\\)\\)"
addr)
+ (ibut:label-set addr)
(hact 'hyp-request))))))
;;; ========================================================================
@@ -1574,6 +1588,7 @@ action type, function symbol to call or test to execute,
i.e.
args `(',action)))))
;; Create implicit button object and store in symbol hbut:current.
+ (ibut:label-set lbl)
(ibut:create :lbl-key lbl-key :lbl-start start-pos :lbl-end end-pos
:categ 'ibtypes::action :actype actype :args args)
