branch: externals/hyperbole
commit de692018b3cae9b6d35f9f52fcfee4f7fde8f604
Merge: bf304d6f10 587e476445
Author: Robert Weiner <r...@gnu.org>
Commit: GitHub <nore...@github.com>
Merge pull request #515 from rswgnu/rsw
hsys-org-link-at-p and hbut:act - Fix gbut handling from other bufs
---
ChangeLog | 40 +++++++++++++++++++++++++
hact.el | 6 ++--
hbut.el | 87 +++++++++++++++++++++++++++++++++++-------------------
hib-social.el | 53 ++++++++++++++++++---------------
hsettings.el | 4 +--
hsys-org.el | 6 ++--
man/hyperbole.texi | 19 ++++++------
7 files changed, 144 insertions(+), 71 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index ac45c6ff70..68c46e4012 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,43 @@
+2024-04-14 Bob Weiner <r...@gnu.org>
+
+* hbut.el (ibut:create): Set 'name-start' and 'name-end' location attributes
+ when previously set in call of 'ibut:set-name-and-label-key-p'.
+
+* hbut.el (hbut:act): Fix to set current buffer to button 'loc attribute and
+ to not set delim-text-start/end to use name start/end but only label.
+ (hbut:funcall): Fix to set button's 'loc attribute to 'key-src'
+ when given. Otherwise, activation of a global button from another buffer
+ would not set the actual location of the button.
+
+* hsys-org.el (hsys-org-link-at-p): Org treats URLs with and without
+ angle brackets as Org links but Hyperbole handles such links separately.
+ Fix to match only to Org links within square brackets. This also fixes
+ a problem where activating a URL global button fails because the Org
+ open link code could not handle having point originally in another buffer.
+
+* hbut.el (ibtype:delete):
+ hact.el (actype:delete): Make interactive with completion.
+ Remove call to 'symtable:delete' since following call to
+ 'htype:delete' does that.
+
+2024-04-13 Bob Weiner <r...@gnu.org>
+
+* hsettings.el (hyperbole-web-search-alist):
+ man/hyperbole.texi (Implicit Button Types, Menus):
+ hib-social.el (social-reference): Update to use 'x' anywhere 'twitter'
+ was previously allowed; either one is now usable for the same service
+ name.
+
+* man/hyperbole.texi (Action Types):
+ hib-social.el (github-reference): Github links have largely moved from
+ using 'tree' to 'blob', so fix this. Also fix doc so that if not
+ given a ref-type keyword, assume ref-type is to a file.
+
+2024-04-10 Bob Weiner <r...@gnu.org>
+
+* hbut.el (ibut:insert-text): Fix when given a command-name to output proper
+ action button, not a nil with nil arguments.
+
2024-04-09 Bob Weiner <r...@gnu.org>
* hmouse-tag.el (smart-python-tag): Rewrite to just try to display a tag
diff --git a/hact.el b/hact.el
index 995bf772d0..4833778ada 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: 18-Feb-24 at 11:27:01 by Mats Lidell
+;; Last-Mod: 14-Apr-24 at 01:33:24 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -516,8 +516,8 @@ Return symbol created when successful, else nil."
(defun actype:delete (type)
"Delete an action TYPE (a symbol). Return TYPE's symbol if it existed."
- (symtable:delete type symtable:actypes)
- (htype:delete type 'actypes))
+ (interactive (list (hui:htype-delete 'actypes))
+ (htype:delete type 'actypes)))
(defun actype:doc (but &optional full)
"Return first line of action doc for BUT.
diff --git a/hbut.el b/hbut.el
index cc2442dfc9..bb13b033a5 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: 31-Mar-24 at 17:02:39 by Bob Weiner
+;; Last-Mod: 14-Apr-24 at 13:52:20 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -1035,32 +1035,36 @@ Default is the symbol hbut:current."
(cond ((hbut:is-p hbut)
(let ((orig-point (point-marker))
(action (hattr:get hbut 'action))
+ (loc (hattr:get hbut 'loc))
text-point)
+ (when loc
+ ;; Button's location may be different than the current
+ ;; buffer, so move point there if so.
+ (hbut:key-src-set-buffer loc))
(when (ibut:is-p hbut)
;; Determine whether point is already within hbut; if
;; not, it is moved there.
;;
- ;; The next line returns the lbl-key of the current
- ;; button only if point is within the optional name,
- ;; otherwise, nil.
- (let* ((lbl-key-start-end (ibut:label-p nil nil nil t t))
- (lbl-key (nth 0 lbl-key-start-end))
- (delim-text-start (or (nth 1 lbl-key-start-end)
- (hattr:get hbut 'lbl-start)))
- (delim-text-end (or (nth 2 lbl-key-start-end)
- (hattr:get hbut 'lbl-end))))
- (if (and lbl-key
- (or (equal (hattr:get hbut 'loc) (current-buffer))
- (equal (hattr:get hbut 'loc) buffer-file-name))
- (equal lbl-key (hattr:get hbut 'lbl-key)))
+ ;; The next line returns the key version of the optional
+ ;; name of the current button if and only if point is
+ ;; within the name; otherwise, including if point is on
+ ;; the text of the button, this returns nil.
+ (let* ((name-key-start-end (ibut:label-p nil nil nil t t))
+ (name-key (nth 0 name-key-start-end))
+ (delim-text-start (hattr:get hbut 'lbl-start))
+ (delim-text-end (hattr:get hbut 'lbl-end)))
+ (if (and name-key
+ (or (equal loc buffer-file-name)
+ (equal loc (current-buffer)))
+ (equal name-key (ibut:label-to-key (hattr:get hbut
'name))))
(unless (and delim-text-start delim-text-end
(< delim-text-start (point))
(>= delim-text-end (point)))
(goto-char delim-text-start)
(skip-chars-forward "^-_a-zA-Z0-9"))
;; Here handle when there is no name preceding the implicit
button.
- (unless (and (or (equal (hattr:get hbut 'loc) (current-buffer))
- (equal (hattr:get hbut 'loc)
buffer-file-name))
+ (unless (and (or (equal loc buffer-file-name)
+ (equal loc (current-buffer)))
delim-text-start delim-text-end
(< delim-text-start (point))
(>= delim-text-end (point)))
@@ -1220,12 +1224,14 @@ button file) or within the current buffer if both are
null. Use
of point when desired.
Caller must have used (ibut:at-p) to create hbut:current prior to
-calling this function."
+calling this function. When KEY-SRC is given, this set's
+hbut:current's 'loc attribute to KEY-SRC."
(if buffer
(if (bufferp buffer)
(set-buffer buffer)
(error "(ibut:get): Invalid buffer argument: %s" buffer))
- (when (null key-src)
+ (if key-src
+ (hattr:set 'hbut:current 'loc key-src)
(let ((loc (hattr:get 'hbut:current 'loc)))
(when loc
(set-buffer (or (get-buffer loc) (find-file-noselect loc)))))
@@ -1960,16 +1966,20 @@ If a new button is created, store its attributes in the
symbol,
(when (or is-type but-sym)
(unless but-sym
(setq but-sym 'hbut:current))
- (let ((current-categ (hattr:get but-sym 'categ))
- (current-name (hattr:get but-sym 'name))
- (current-lbl-key (hattr:get but-sym 'lbl-key))
- (current-lbl-start (hattr:get but-sym 'lbl-start))
- (current-lbl-end (hattr:get but-sym 'lbl-end))
- (current-loc (hattr:get but-sym 'loc))
- (current-dir (hattr:get but-sym 'dir))
- (current-action (hattr:get but-sym 'action))
- (current-actype (hattr:get but-sym 'actype))
- (current-args (hattr:get but-sym 'args)))
+ (let ((current-categ (hattr:get but-sym 'categ))
+ (current-name (hattr:get but-sym 'name))
+ (current-name-start (hattr:get but-sym 'name-start))
+ (current-name-end (hattr:get but-sym 'name-end))
+ (current-lbl-key (hattr:get but-sym 'lbl-key))
+ (current-lbl-start (hattr:get but-sym 'lbl-start))
+ (current-lbl-end (hattr:get but-sym 'lbl-end))
+ (current-loc (hattr:get but-sym 'loc))
+ (current-dir (hattr:get but-sym 'dir))
+ (current-action (hattr:get but-sym 'action))
+ (current-actype (hattr:get but-sym 'actype))
+ (current-args (hattr:get but-sym 'args))
+ name-start
+ name-end)
(cond ((and but-sym-flag current-name)
(setq name current-name))
@@ -1979,6 +1989,22 @@ If a new button is created, store its attributes in the
symbol,
(when name
(hattr:set 'hbut:current 'name name))
+ (cond ((and but-sym-flag current-name-start)
+ (setq name-start current-name-start))
+ ((or name-start name-and-lbl-key-flag))
+ (current-name-start
+ (setq name-start current-name-start)))
+ (when name-start
+ (hattr:set 'hbut:current 'name-start name-start))
+
+ (cond ((and but-sym-flag current-name-end)
+ (setq name-end current-name-end))
+ ((or name-end name-and-lbl-key-flag))
+ (current-name-end
+ (setq name-end current-name-end)))
+ (when name-end
+ (hattr:set 'hbut:current 'name-end name-end))
+
(cond ((and but-sym-flag current-lbl-key)
(setq lbl-key current-lbl-key))
((or lbl-key name-and-lbl-key-flag))
@@ -2647,7 +2673,8 @@ Summary of operations based on inputs (name arg from
\\='hbut:current attrs):
(if (<= arg2 1) "" (concat ":I" (number-to-string
arg2))))))
('nil (error "(ibut:insert-text): actype must be a Hyperbole actype or
Lisp function symbol, not '%s'" orig-actype))
;; Generic action button type
- (_ (insert (format "<%s%s%s>" (actype:def-symbol actype) (if args " " "")
+ (_ (insert (format "<%s%s%s>" (or (actype:def-symbol actype) actype)
+ (if args " " "")
(if args (hypb:format-args args) "")))))
(unless (looking-at "\\s-\\|\\'")
(insert " "))))
@@ -3143,7 +3170,7 @@ is returned."
(defun ibtype:delete (type)
"Delete an implicit button TYPE (a symbol).
Return TYPE's symbol if it existed, else nil."
- (symtable:delete type symtable:ibtypes)
+ (interactive (list (hui:htype-delete 'ibtypes)))
(htype:delete type 'ibtypes))
;; Return the full Elisp symbol for IBTYPE, which may be a string or symbol.
diff --git a/hib-social.el b/hib-social.el
index 913ba26831..129790c931 100644
--- a/hib-social.el
+++ b/hib-social.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 20-Jul-16 at 22:41:34
-;; Last-Mod: 3-Mar-24 at 10:50:02 by Mats Lidell
+;; Last-Mod: 13-Apr-24 at 11:17:42 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -19,14 +19,14 @@
;; When the referent is a web page, this calls the function given by
;; `hibtypes-social-display-function' to display it, initially set to
`browse-url'.
;;
-;; A hashtag reference is either:
[facebook|github|gitlab|git|instagram|twitter]#<hashtag>
-;; or using 2-letter service abbreviations: [fb|gh|gl|gt|in|tw]#<hashtag>.
+;; A hashtag reference is either:
[facebook|github|gitlab|git|instagram|twitter|x]#<hashtag>
+;; or using 1 to 2-letter service abbreviations:
[fb|gh|gl|gt|in|tw|x]#<hashtag>.
;;
-;; A username reference is either:
[facebook|github|gitlab|instagram|twitter]@<username>
-;; or [fb|gh|gl|in|tw]@<username>.
+;; A username reference is either:
[facebook|github|gitlab|instagram|twitter|x]@<username>
+;; or [fb|gh|gl|in|tw|x]@<username>.
;;
;; If the social media service is not given, it defaults to the value of
-;; `hibtypes-social-default-service', initially set to \"twitter\".
+;; `hibtypes-social-default-service', initially set to \"x\".
;;
;; Below are a list of examples; simply press the Action Key on each one
;; to test it; use the Assist Key to see what it will do. The git
@@ -37,11 +37,11 @@
;; github@rswgnu
;; gitlab@seriyalexandrov
;; instagram@lostart
-;; twitter@nytimestravel
+;; x@nytimestravel
;; fb#technology Display page of hashtag
matches
;; in#art
-;; tw#travel
+;; x#travel
;; Git (local) reference links
;;
@@ -192,14 +192,15 @@
"Hyperbole explicit, global and implicit button customizations."
:group 'hyperbole)
-(defcustom hibtypes-social-default-service "twitter"
+(defcustom hibtypes-social-default-service "x"
"Lowercase string matching the social media service to use as a default."
:type '(radio (const "facebook")
(const "git")
(const "github")
(const "gitlab")
(const "instagram")
- (const "twitter"))
+ (const "twitter")
+ (const "x"))
:group 'hyperbole-buttons)
(defcustom hibtypes-social-display-function #'browse-url
@@ -247,7 +248,8 @@
("\\`\\(gl\\|gitlab\\)\\'" . "https://www.gitlab.com/%s/%s/%s%s";)
("\\`\\(gt\\|git\\)\\'" . "(cd %s && git %s %s)")
("\\`\\(in\\|instagram\\)\\'" .
"https://www.instagram.com/explore/tags/%s/";)
- ("\\`\\(tw\\|twitter\\)\\'" .
"https://twitter.com/search?q=%%23%s&src=hashtag";))
+ ("\\`\\(tw\\|twitter\\)\\'" .
"https://twitter.com/search?q=%%23%s&src=hashtag";)
+ ("\\`\\(x\\)\\'" .
"https://x.com/search?q=%%23%s&src=hashtag";))
"Alist of (social-media-service-regexp . to-display-hashtag-reference)
elements.")
(defconst hibtypes-social-username-alist
@@ -255,7 +257,8 @@
("\\`\\(gh\\|github\\)\\'" . "https://github.com/%s/";)
("\\`\\(gl\\|gitlab\\)\\'" . "https://www.gitlab.com/%s/";)
("\\`\\(in\\|instagram\\)\\'" . "https://www.instagram.com/%s/";)
- ("\\`\\(tw\\|twitter\\)\\'" . "https://twitter.com/search?q=@%s";))
+ ("\\`\\(tw\\|twitter\\)\\'" . "https://twitter.com/search?q=@%s";)
+ ("\\`\\(x\\)\\'" . "https://x.com/search?q=@%s";))
"Alist of (social-media-service-regexp . url-with-%s-for-username)
elements.")
;; Assume at least a 2-character project name
@@ -278,13 +281,13 @@ See `ibtypes::social-reference' for format details.")
(defib social-reference ()
"Display web page associated with a social hashtag/username reference at
point.
Reference format is:
- [facebook|git|github|gitlab|instagram|twitter]?[#@]<reference> or
- [fb|gt|gh|gl|in|tw]?[#@]<reference>.
+ [facebook|git|github|gitlab|instagram|twitter|x]?[#@]<reference> or
+ [fb|gt|gh|gl|in|tw|x]?[#@]<reference>.
The first part of the label for a button of this type is the social
service name. The service name defaults to the value of
-`hibtypes-social-default-service' (default value of \"twitter\")
-when not given, so #hashtag would be the same as twitter#hashtag.
+`hibtypes-social-default-service' (default value of \"x\")
+when not given, so #hashtag would be the same as x#hashtag.
Local git references allow hashtags only, not username references.
@@ -372,8 +375,8 @@ or /<project>.
a commit reference given by a hex number, 55a1f0; the commit
diff is displayed;
- a branch or tag reference given by an alphanumeric name,
- e.g. hyper20; the files in the branch are listed.
+ a filename reference given by an alphanumeric name; the file
+ is displayed.
USER defaults to the value of `hibtypes-github-default-user'.
If given, PROJECT overrides any project value in REFERENCE. If no
@@ -431,16 +434,18 @@ PROJECT value is provided, it defaults to the value of
;; issue, or pull
(setq ref-type (substring reference 0 (match-end 1))
reference (substring reference (match-end 0))
- ref-type (concat ref-type (if (string-equal
ref-type "issue") "s/" "/"))))
- ((string-match "\\`[0-9a-f]+\\'" reference)
+ ref-type (concat ref-type (if (string-equal
ref-type "issue") "s/" "/")))) ((string-match
"\\`[0-9a-f]+\\'" reference)
;; Commit reference
(setq ref-type "commit/"))
(t
;; Specific branch or commit tag reference
- (setq ref-type "tree/")
- (when (string-match "\\`\\(branch\\|tag\\)/" reference)
- ;; If preceded by optional keyword, remove that from
the reference.
- (setq reference (substring reference (match-end
0)))))))
+ (if (string-match "\\`\\(branch\\|tag\\)/" reference)
+ ;; Reference is a specific branch or tag.
+ ;; If preceded by optional keyword, remove that
from the reference.
+ (setq ref-type "blob/"
+ reference (substring reference (match-end 0)))
+ ;; Reference is a file within a branch.
+ (setq ref-type "blob/master/")))))
(if (and (stringp user) (stringp project))
(funcall hibtypes-social-display-function
(if reference
diff --git a/hsettings.el b/hsettings.el
index 01a7bc6304..7e1994fdaa 100644
--- a/hsettings.el
+++ b/hsettings.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 15-Apr-91 at 00:48:49
-;; Last-Mod: 20-Jan-24 at 15:49:24 by Bob Weiner
+;; Last-Mod: 13-Apr-24 at 11:22:31 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -272,8 +272,8 @@ Hyperbole, and then restart Emacs."
("Maps" . "http://maps.google.com/maps?q=%s";)
("RFCs" . "https://tools.ietf.org/html/rfc%s";)
("StackOverflow" . "https://stackoverflow.com/search?q=%s";)
- ("Twitter" . "https://twitter.com/search?q=%s";)
("Wikipedia" . "https://en.wikipedia.org/wiki/%s";)
+ ("X" . "https://x.com/search?q=%s";)
("Youtube" . "https://www.youtube.com/results?search_query=%s";))
"*Alist of (web-service-name . emacs-cmd-or-url-with-%s-parameter) elements.
The first capitalized character of each web-service-name must be unique.
diff --git a/hsys-org.el b/hsys-org.el
index 5f28aad176..d847ba05c5 100644
--- a/hsys-org.el
+++ b/hsys-org.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 2-Jul-16 at 14:54:14
-;; Last-Mod: 10-Mar-24 at 11:31:56 by Bob Weiner
+;; Last-Mod: 14-Apr-24 at 11:37:50 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -396,12 +396,12 @@ Return the (start . end) buffer positions of the region."
(looking-at org-babel-src-block-regexp))))
(defun hsys-org-link-at-p ()
- "Return non-nil iff point is on an Org mode link.
+ "Return non-nil iff point is on a square-bracketed Org mode link.
Assume caller has already checked that the current buffer is in `org-mode'
or are looking for an Org link in another buffer type."
(unless (or (smart-eolp) (smart-eobp))
(with-suppressed-warnings nil
- (org-in-regexp org-link-any-re nil t))))
+ (org-in-regexp org-link-bracket-re nil t))))
;; Assume caller has already checked that the current buffer is in org-mode.
(defun hsys-org-heading-at-p (&optional _)
diff --git a/man/hyperbole.texi b/man/hyperbole.texi
index dc681e8b82..fe469a6071 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: 7-Apr-24 at 10:27:10 by Bob Weiner
+@c Last-Mod: 13-Apr-24 at 11:21:43 by Bob Weiner
@c %**start of header (This is for running Texinfo on a region.)
@setfilename hyperbole.info
@@ -2900,8 +2900,8 @@ username reference at point.
Reference format is:
@example
-[facebook|instagram|twitter]?[#@@]<hashtag-or-username> or
-[fb|in|tw]?[#@@]<hashtag-or-username>
+[facebook|instagram|twitter|x]?[#@@]<hashtag-or-username> or
+[fb|in|tw|x]?[#@@]<hashtag-or-username>
@end example
@noindent
@@ -2910,8 +2910,8 @@ For example, @samp{fb@@someuser} displays the home page
for facebook user
@samp{hashtag}. The first part of the label for a button of this type
is the social media service name. The service name defaults to the
value of @code{hibtypes-social-default-service} (default value of
-``twitter'') when not given, so #hashtag would be the same as
-twitter#hashtag.
+``x'') when not given, so #hashtag would be the same as
+x#hashtag.
@findex ibtypes hyperbole-run-tests
@cindex ert
@@ -3209,8 +3209,8 @@ the item is shown
the issue is displayed
@item @bullet{} a commit reference given by a hex number, 55a1f0
the commit diff is displayed
-@item @bullet{} a branch or tag reference given by an alphanumeric name, e.g.
hyper20
-the files in the branch are listed.
+@item @bullet{} a filename reference given by an alphanumeric name; the file
+is displayed.
@end table
@vindex hibtypes-github-default-user
@@ -4222,8 +4222,9 @@ Web/ - Select a search engine and term and
search with them or
@smallexample
@noindent
-Web> Amazon Bing Dictionary Elisp Facebook Google gitHub Images
- Jump Maps RFCs StackOverflow Twitter Wikipedia Youtube
+Web> Amazon Bing Dictionary ducKduckgo Elisp Facebook
+ Google gitHub Images Jump Maps RFCs StackOverflow
+ Wikipedia X Youtube
@end smallexample
@end itemize
