branch: externals/hyperbole commit 4c939c9a3ef5c4bbc9fa6e161745650a7da8fc32 Merge: 445a7101a2 2c5f1a4939 Author: Robert Weiner <r...@gnu.org> Commit: GitHub <nore...@github.com>
Merge pull request #552 from rswgnu/rsw hib-debbugs.el - Fix most issues with use of the GNU debbugs package --- ChangeLog | 23 ++++++++++++++ hbut.el | 33 +++++++++++++------- hib-debbugs.el | 28 +++++++++++------ hib-kbd.el | 11 ++++--- hibtypes.el | 43 ++++++++++++++++--------- hynote.el | 3 +- kotl/klink.el | 10 +++--- man/hyperbole.texi | 92 +++++++++++++++++++++++++++++++++++++++--------------- 8 files changed, 174 insertions(+), 69 deletions(-) diff --git a/ChangeLog b/ChangeLog index a73d8dd728..9544d59b6f 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,28 @@ +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. + +* hib-kbd.el (kbd-key): Add support for key sequences in Texinfo mode. + 2024-06-29 Bob Weiner <r...@gnu.org> +* hbut.el (ibut:to-text): Add current ibtype to the error when lbl-key attr is nil. + hib-debbugs.el (debbugs-version-sufficient-p): Update to get version number + 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-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): When finished, kill all *info*<#> buffers. diff --git a/hbut.el b/hbut.el index 958db847ee..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: 25-Jun-24 at 01:03:43 by Bob Weiner +;; Last-Mod: 30-Jun-24 at 10:01:50 by Bob Weiner ;; ;; SPDX-License-Identifier: GPL-3.0-or-later ;; @@ -2289,8 +2289,8 @@ lines." result)))) (defun ibut:label-set (label &optional start end) - "Set current implicit button attributes. -Get attributes from LABEL and optional START, END positions. + "Set current implicit button label attributes. +Provide arguments LABEL and optional START, END positions. Return label. When START and END are given, they specify the region in the buffer to flash when this implicit button is activated or queried for its attributes; this typically should @@ -2892,7 +2892,9 @@ The caller must have populated the attributes of \='hbut:current. Return the symbol for the button if found, else nil." (unless (stringp lbl-key) - (error "(ibut:to-text): 'lbl-key' arg must be a string, not: %S" lbl-key)) + (error "(ibut:to-text): %s 'lbl-key' arg must be a string, not: %S" + (hattr:get 'hbut:current 'categ) + lbl-key)) (hbut:funcall (lambda (lbl-key _buffer _key-src) (let* ((name-end (hattr:get 'hbut:current 'name-end)) @@ -2949,8 +2951,11 @@ Return the symbol for the button if found, else nil." 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 and if it is, calls `hact' with an -action to be performed whenever a button of this type is activated. +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 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 @@ -2972,11 +2977,17 @@ type for ibtype is presently undefined." [&optional stringp] ; Doc string, if present. def-body))) (when type - (let ((to-func (when to-p (action:create nil (list to-p)))) - (at-func (list at-p))) - `(progn (symtable:add ',type symtable:ibtypes) - (htype:create ,type ibtypes ,doc nil ,at-func - '(to-p ,to-func style ,style)))))) + (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 (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)) + `(progn (symtable:add ',type symtable:ibtypes) + (htype:create ,type ibtypes ,doc nil ,at-func + '(to-p ,to-func style ,style))))))) ;; Support edebug-defun for interactive debugging of ibtypes (def-edebug-spec defib diff --git a/hib-debbugs.el b/hib-debbugs.el index 34d4343919..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: 2-Feb-24 at 22:44:22 by Mats Lidell +;; Last-Mod: 30-Jun-24 at 03:16:07 by Bob Weiner ;; ;; SPDX-License-Identifier: GPL-3.0-or-later ;; @@ -114,6 +114,10 @@ attribute): Note that `issue' or `debbugs' may be used as well in place of `bug'." (when (debbugs-version-sufficient-p) (when (debbugs-query:at-p) + (ibut:label-set (buffer-substring-no-properties + (match-beginning 1) (match-end 2)) + (match-beginning 1) + (match-end 2)) (if (and (match-beginning 3) (string-equal "?" (match-string 3))) (hact 'debbugs-gnu-query:string (buffer-substring-no-properties (or (match-beginning 1) (match-beginning 2)) @@ -140,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) @@ -265,18 +272,21 @@ Return t unless no attributes are printed." "Return t iff debbugs version is sufficient for use with Hyperbole. Must be greater than equal to 0.9.7." (save-excursion - (let* ((debbugs-src (locate-file "debbugs-gnu" load-path '(".el"))) + (let* ((debbugs-src (or (locate-file "debbugs" load-path '(".el")) + (locate-file "debbugs-gnu" load-path '(".el")))) (visiting-debbugs-src (when debbugs-src (get-file-buffer debbugs-src))) debbugs-src-buffer version) (when debbugs-src (unwind-protect - (progn (set-buffer (setq debbugs-src-buffer (find-file-noselect debbugs-src))) - (widen) - (goto-char (point-min)) - (when (re-search-forward "^;; Version: \\([.0-9]+\\)" nil t) - (setq version (match-string 1)))) - (unless visiting-debbugs-src + (if (string-match "debbugs-\\([0-9]+.[0-9]+\\(.[0-9]+\\)?\\)" debbugs-src) + (setq version (match-string 1 debbugs-src)) + (set-buffer (setq debbugs-src-buffer (find-file-noselect debbugs-src))) + (widen) + (goto-char (point-min)) + (when (re-search-forward "^;; Version: \\([.0-9]+\\)" nil t) + (setq version (match-string 1)))) + (unless (or visiting-debbugs-src (null debbugs-src-buffer)) (kill-buffer debbugs-src-buffer))) (when (and version (not (equal version ""))) (version-list-<= (version-to-list "0.9.7") (version-to-list version))))))) diff --git a/hib-kbd.el b/hib-kbd.el index 9d93b9e0db..8dd80b222b 100644 --- a/hib-kbd.el +++ b/hib-kbd.el @@ -3,7 +3,7 @@ ;; Author: Bob Weiner ;; ;; Orig-Date: 22-Nov-91 at 01:37:57 -;; Last-Mod: 23-Jun-24 at 00:04:17 by Mats Lidell +;; Last-Mod: 30-Jun-24 at 02:19:16 by Bob Weiner ;; ;; SPDX-License-Identifier: GPL-3.0-or-later ;; @@ -140,9 +140,12 @@ Any key sequence within the series must be a string of one of the following: ;; Match only when start delimiter is preceded by whitespace, ;; double quotes or is the 1st buffer character, so do not ;; match to things like ${variable}. - (when (memq (char-before start) '(nil ?\ ?\t ?\n ?\r ?\f ?\")) - (when (and (stringp key-series) - (not (string-equal key-series ""))) + (when (or (memq (char-before start) '(nil ?\ ?\t ?\n ?\r ?\f ?\")) + ;; In Texinfo, allow for @bkbd{} or @kbd{}, so an + ;; alpha char preceding + (and (derived-mode-p 'texinfo-mode) + (= (char-syntax (char-before start)) ?w))) + (when (and (stringp key-series) (not (string-empty-p key-series))) ;; Replace any ${} internal or env vars; leave ;; $VAR untouched for the shell to evaluate. (let ((hpath:variable-regexp "\\${\\([^}]+\\)}")) 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) diff --git a/hynote.el b/hynote.el index 8f16206fd5..0bbe4bc258 100644 --- a/hynote.el +++ b/hynote.el @@ -3,7 +3,7 @@ ;; Author: Bob Weiner ;; ;; Orig-Date: 23-Jun-24 at 12:50:37 -;; Last-Mod: 25-Jun-24 at 02:39:05 by Bob Weiner +;; Last-Mod: 30-Jun-24 at 11:27:57 by Bob Weiner ;; ;; SPDX-License-Identifier: GPL-3.0-or-later ;; @@ -25,6 +25,7 @@ ;;; Other required Elisp libraries ;;; ************************************************************************ +(require 'hbut) (require 'hyrolo) (require 'hywiki) diff --git a/kotl/klink.el b/kotl/klink.el index 6482434e1e..f91366c779 100644 --- a/kotl/klink.el +++ b/kotl/klink.el @@ -3,7 +3,7 @@ ;; Author: Bob Weiner ;; ;; Orig-Date: 15-Nov-93 at 12:15:16 -;; Last-Mod: 30-Oct-23 at 01:00:01 by Bob Weiner +;; Last-Mod: 30-Jun-24 at 11:36:47 by Bob Weiner ;; ;; SPDX-License-Identifier: GPL-3.0-or-later ;; @@ -65,7 +65,7 @@ (require 'subr-x) ;; For string-trim (require 'hmouse-tag) ;; For smart-c-include-regexp -(eval-when-compile (require 'hbut)) ;; For defib. +(require 'hbut) ;; For defib. ;;; ************************************************************************ ;;; Public variables @@ -252,9 +252,11 @@ same directory." See documentation for the `link-to-kotl' function for valid klink formats." (let* ((link-and-pos (klink:at-p)) (link (car link-and-pos)) - (start-pos (nth 1 link-and-pos))) + (start (nth 1 link-and-pos)) + (end (nth 2 link-and-pos))) (when link - (hact 'klink:act link start-pos)))) + (ibut:label-set link start end) + (hact 'klink:act link start)))) (defact link-to-kotl (link) "Display at the top of another window the referent pointed to by LINK. diff --git a/man/hyperbole.texi b/man/hyperbole.texi index 3f5b8a7de2..3a1be6c8fd 100644 --- a/man/hyperbole.texi +++ b/man/hyperbole.texi @@ -7,7 +7,7 @@ @c Author: Bob Weiner @c @c Orig-Date: 6-Nov-91 at 11:18:03 -@c Last-Mod: 16-Apr-24 at 22:13:33 by Bob Weiner +@c Last-Mod: 30-Jun-24 at 11:07:23 by Bob Weiner @c %**start of header (This is for running Texinfo on a region.) @setfilename hyperbole.info @@ -159,7 +159,7 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.</P> <PRE> Edition 9.0.2pre -Printed June 2, 2024. +Printed June 30, 2024. Published by the Free Software Foundation, Inc. Author: Bob Weiner @@ -201,7 +201,7 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. @example Edition 9.0.2pre -June 2, 2024 +June 30, 2024 Published by the Free Software Foundation, Inc. Author: Bob Weiner @@ -7175,23 +7175,46 @@ same thing without any special definitions. @cindex ibtype @findex defib @findex ibtype:create -An implicit button type is created or loaded via the @code{(defib)} -function (which is an alias for @code{(ibtype:create)}). The calling -signature for this function is given in its documentation; it is the -same as that of @code{(defun)}, but with a number of constraints. The -parameter list should always be empty since no parameters will be used. -A documentation string is required; it is followed by the body of the -type. - -@cindex ibtype, predicate -@cindex ibtype, argument -@cindex ibtype, return val -@cindex ibtype, actype -The body of an implicit button type is a predicate which determines -whether or not point is within an implicit button of the type. If -not, the predicate returns @samp{nil}. If the type is delimited, -Hyperbole automatically sets up to flash the button when activated. -Action invocations have the form: @code{(hact 'actype &rest +@cindex ibtype predicate +@cindex ibtype argument +@cindex ibtype return val +@cindex ibtype actype +@cindex ibtype at-p +An implicit button type is defined or updated via the @code{(defib)} +macro (@code{ibtype:create} is alias for this). It may be called just +as @code{(defun)} is, but with a number of constraints. The parameter +list should always be empty since no parameters will be used. A +documentation string is required. The last required form is the +@code{at-p} predicate which when non-@samp{nil}, must do three things: +@itemize @enumerate +@item determine if there is a button at point that matches the type being defined; +@item if so, call @code{ibut:set-label) to identify the label text of the button; +@item if so, call @code{hact} to invoke the button's action, typically using the label. +@end itemize + +@findex ibut:label-set +@cindex ibtype ibut:label-set +The call to @code{ibut:label-set} may contain just the button's label +argument or the label plus its start and end positions in the buffer, +if you wnat the button to flash when pressed. + +@cindex ibtype hact +The @code{hact} call, run whenever a button of the type is activated, +must be the last expression within the @code{at-p} form unless the +action itself ends with a call to @code{hact}. This call will always +return @samp{t} when the @code{at-p} form is tested for a boolean +value since the implicit button type's check has already evaluated +true before this is called. The arguments to the call to @code{hact} +are an action function and whatever arguments it takes. The action +may be a Hyperbole action type created with @code{defact} or a regular +Emacs Lisp function. However, the action should not return @samp{nil} +since any @samp{nil} value returned is converted to @samp{t} to ensure +the implicit button checker recognizes that the action has been +executed. + +@cindex action +@cindex ibtype action +Action invocations have the form: @code{(hact actype &rest actype-arguments)} where @code{actype} is a Hyperbole action type symbol or an Emacs Lisp function name or lambda; @code{actype-arguments} are the arguments fed to the action invocation @@ -7201,11 +7224,11 @@ It is imperative that all actions (non-predicate code) be invoked through the @code{(hact)} function or your ibtypes will not work properly. (Hyperbole first tests to see if any ibtype matches the current context before activating any type, so it ensures that -@code{(hact)} calls are disabled during this testing.) Any action +@code{(hact)} calls are disabled during this testing). Any action types used in the definition of an implicit button type may be created before or after the definition, but obviously, must be defined before -any implicit buttons of the given type are activated; an error will -result, otherwise. +any implicit buttons of the given type are activated or an error will +result. If an implicit button type create is successful, the symbol that Hyperbole uses internally to reference the type is returned. On @@ -7215,6 +7238,21 @@ may be the same without any conflict. In fact, such naming is encouraged when an implicit button type is the exclusive user of an action type. +@cindex ibtype priorities +@cindex priority of ibtypes +@cindex types, implicit button +@findex hui:htype-help 'ibtypes +@kindex C-h h i t +When the Action Key is pressed, each implicit button type predicate is +checked in priority order and the first one whose @code{at-p} form +evaluates non-@samp{nil} is activated (its action is run using the +button label at point). The first time an implicit button type is +defined, it becomes the highest priority type; repeated definitions of +the same type update the type but do not change its priority order. +@bkbd{C-h h i t @key{RET}} @code{(hui:htype-help 'ibtypes 'no-sort)} +displays the doc strings for all current implicit button types in +descending priority order. + @findex ibtype:delete Call @code{(ibtype:delete)} to remove an implicit button type from a Hyperbole environment. It takes a single parameter which should be the @@ -7224,9 +7262,6 @@ by the implicit button; that must be done separately. @cindex ibtype, help @findex ibut:at-p -@vindex class, hattr -@vindex class, hbut -@vindex file, hib-kbd.el By default, a request for help on an implicit button will display the button's attributes in the same manner as is done for explicit buttons. For some implicit button types, other forms of help will be @@ -7241,6 +7276,11 @@ context). Remember that the standard help for buttons with custom help functions is still available with @bkbd{C-h A} for the Action Key and @bkbd{C-u C-h A} for the Assist Key. +@vindex class, hattr +@vindex class, hbut +@cindex hbut class +@cindex hattr class +@vindex file, hib-kbd.el To programmatically query implicit buttons for their attributes, use the functions from the @samp{hbut} and @samp{hattr} classes. See the @file{hib-kbd.el} file for an example of a custom help function.