branch: externals/hyperbole
commit f11e01b63685bcb6bd518a16db0cfcb718135515
Author: Bob Weiner <r...@gnu.org>
Commit: Bob Weiner <r...@gnu.org>
hsys-org-link-at-p and hbut:act - Fix gbut handling from other bufs
---
ChangeLog | 17 +++++++++++++
hbut.el | 82 ++++++++++++++++++++++++++++++++++++++++---------------------
hsys-org.el | 6 ++---
3 files changed, 74 insertions(+), 31 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index d26001c1ae..68c46e4012 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,20 @@
+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
diff --git a/hbut.el b/hbut.el
index 21185d1d10..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))
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 _)
