emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals/hyperbole f11e01b636 4/6: hsys-org-link-at-p and hbut:a


From: ELPA Syncer
Subject: [elpa] externals/hyperbole f11e01b636 4/6: hsys-org-link-at-p and hbut:act - Fix gbut handling from other bufs
Date: Sun, 14 Apr 2024 15:58:04 -0400 (EDT)

branch: externals/hyperbole
commit f11e01b63685bcb6bd518a16db0cfcb718135515
Author: Bob Weiner <rsw@gnu.org>
Commit: Bob Weiner <rsw@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  <rsw@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 _)



reply via email to

[Prev in Thread] Current Thread [Next in Thread]