[elpa] externals/hyperbole ba5922d8f8 1/2: Fix ibut creation functions not setting categ attribute.

[ELPA Syncer]

branch: externals/hyperbole
commit ba5922d8f8d3ba826355aa7a3eddbe9419ade08b
Author: Robert Weiner <rsw@gnu.org>
Commit: Robert Weiner <rsw@gnu.org>

    Fix ibut creation functions not setting categ attribute.
    
    Fix klinks to not trigger on ibut names or msg <#part ...>.
---
 ChangeLog     | 11 +++++++++++
 HY-NEWS       |  2 +-
 hbut.el       | 15 ++++++++++-----
 hsys-org.el   |  6 +++++-
 hui.el        |  6 +++++-
 kotl/klink.el |  7 ++++---
 6 files changed, 36 insertions(+), 11 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 07fe0e138a..1078f692ac 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,16 @@
 2023-05-20  Bob Weiner  <rsw@gnu.org>
 
+* hui.el (hui:ibut-create, hui:ebut-create,
+          hui:ibut-link-create, hui:ebut-link-create):
+  hbut.el (ebut:program, ibut:program):
+    Set categ property, needed for 'ebut:is-p' and 'ibut:is-p' tests.
+          (ibut:is-p): Update to handle (eq categ 'implicit).
+          (ibut:create): If categ arg is not given and ibtype is found
+    from the given button, use that.  Otherwise, set to 'implicit.
+
+* kotl/klink.el (klink:at-p): Ignore <[ibut name]> and msg attachments like
+    <#part ...>.
+
 * hsys-org.el (hsys-org-link-at-p): Stop using (org-in-regexp org-link-any-re 
nil t)
     to avoid rx warnings.  Use (eq (org-element-type (org-element-context)) 
'link)
     instead.
diff --git a/HY-NEWS b/HY-NEWS
index ba03e3a144..64a2f50d04 100644
--- a/HY-NEWS
+++ b/HY-NEWS
@@ -438,7 +438,7 @@
 
 ** TEST CASES  (See "${hyperb:dir}/test").
 
-  *** Hyperbole Automated Testing: Automated test cases increased to over 285.
+  *** Hyperbole Automated Testing: Automated test cases increased to almost 
300.
       Simply run 'make test-all' or 'make test' from the command-line when in
       the Hyperbole source directory and you should see all tests pass.  If
       any fail, you can press the Action Key to see the source of the failure.
diff --git a/hbut.el b/hbut.el
index 55634caf37..478a5d7e05 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:     20-May-23 at 15:39:10 by Bob Weiner
+;; Last-Mod:     20-May-23 at 17:53:22 by Bob Weiner
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
@@ -449,6 +449,7 @@ For interactive creation, use `hui:ebut-create' instead."
       (condition-case err
          (progn
            (hattr:clear 'hbut:current)
+           (hattr:set 'hbut:current 'categ 'explicit)
            (hattr:set 'hbut:current 'loc (hui:key-src but-buf))
            (hattr:set 'hbut:current 'dir (hui:key-dir but-buf))
             (if (or (and actype-sym (fboundp actype-sym))
@@ -1678,11 +1679,11 @@ return nil if no implicit button is found at point."
          (when (or is-type but-sym)
            (unless but-sym
              (setq but-sym 'hbut:current))
-           (let ((current-name      (hattr:get but-sym 'name))
+           (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-categ     (hattr:get but-sym 'categ))
                  (current-loc       (hattr:get but-sym 'loc))
                  (current-dir       (hattr:get but-sym 'dir))
                  (current-action    (hattr:get but-sym 'action))
@@ -1713,7 +1714,8 @@ return nil if no implicit button is found at point."
                (when lbl-end
                  (hattr:set 'hbut:current 'lbl-end lbl-end)))
 
-             (hattr:set 'hbut:current 'categ is-type)
+             (hattr:set 'hbut:current 'categ
+                        (or is-type current-categ 'implicit))
 
              (if current-loc
                  (setq loc current-loc)
@@ -1855,7 +1857,9 @@ Return nil if no matching button is found."
   "Return non-nil if OBJECT is a symbol representing an implicit Hyperbole 
button."
   (when (symbolp object)
     (let ((categ (hattr:get object 'categ)))
-      (and categ (string-match "\\`ibtypes::" (symbol-name categ))))))
+      (and categ
+          (or (eq categ 'implicit)
+              (string-match "\\`ibtypes::" (symbol-name categ)))))))
 
 (defun    ibut:label-map (but-func &optional _start-delim _end-delim
                                   _regexp-match _include-delims)
@@ -2210,6 +2214,7 @@ For interactive creation, use `hui:ibut-create' instead."
       (condition-case err
          (progn
            (hattr:clear 'hbut:current)
+           (hattr:set 'hbut:current 'categ 'implicit)
            (hattr:set 'hbut:current 'loc (hui:key-src but-buf))
            (hattr:set 'hbut:current 'dir (hui:key-dir but-buf))
             (if (or (and actype-sym (fboundp actype-sym))
diff --git a/hsys-org.el b/hsys-org.el
index ef596ec6ff..baefeefcd3 100644
--- a/hsys-org.el
+++ b/hsys-org.el
@@ -226,7 +226,11 @@ Return the (start . end) buffer positions of the region."
 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))
-    (eq (org-element-type (org-element-context)) 'link)))
+    (condition-case ()
+       ;; org-element-context may call looking-at with a nil value,
+       ;; triggering an error, so catch it.
+       (eq (org-element-type (org-element-context)) 'link)
+      (error nil))))
 
 ;; Assume caller has already checked that the current buffer is in org-mode.
 (defun hsys-org-heading-at-p (&optional _)
diff --git a/hui.el b/hui.el
index 9b5b4ee25d..9c815bb79a 100644
--- a/hui.el
+++ b/hui.el
@@ -3,7 +3,7 @@
 ;; Author:       Bob Weiner
 ;;
 ;; Orig-Date:    19-Sep-91 at 21:42:03
-;; Last-Mod:     19-May-23 at 08:07:13 by Bob Weiner
+;; Last-Mod:     20-May-23 at 17:31:58 by Bob Weiner
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
@@ -299,6 +299,7 @@ For programmatic creation, use `ebut:program' instead."
        (setq but-buf (current-buffer))
        (hui:buf-writable-err but-buf "ebut-create")
 
+       (hattr:set 'hbut:current 'categ 'explicit)
        (hattr:set 'hbut:current 'loc (hui:key-src but-buf))
        (hattr:set 'hbut:current 'dir (hui:key-dir but-buf))
        (setq actype (hui:actype))
@@ -898,6 +899,7 @@ For programmatic creation, use `ibut:program' instead."
        (hui:buf-writable-err but-buf "ibut-create")
 
        (hattr:set 'hbut:current 'name lbl)
+       (hattr:set 'hbut:current 'categ 'implicit)
        (hattr:set 'hbut:current 'loc (hui:key-src but-buf))
        (hattr:set 'hbut:current 'dir (hui:key-dir but-buf))
        (setq actype (hui:actype))
@@ -1593,6 +1595,7 @@ in which to create button.  BUT-DIR is the directory of 
BUT-LOC.
 TYPE-AND-ARGS is the action type for the button followed by any
 arguments it requires.  Any text properties are removed from string
 arguments."
+  (hattr:set 'hbut:current 'categ 'explicit)
   (hattr:set 'hbut:current 'loc but-loc)
   (hattr:set 'hbut:current 'dir but-dir)
   (hattr:set 'hbut:current 'actype (actype:elisp-symbol (car type-and-args)))
@@ -1615,6 +1618,7 @@ in which to create button.  BUT-DIR is the directory of 
BUT-LOC.
 TYPE-AND-ARGS is the action type for the button followed by any
 arguments it requires.  Any text properties are removed from string
 arguments."
+  (hattr:set 'hbut:current 'categ 'implicit)
   (hattr:set 'hbut:current 'loc but-loc)
   (hattr:set 'hbut:current 'dir but-dir)
   (hattr:set 'hbut:current 'actype (actype:elisp-symbol (car type-and-args)))
diff --git a/kotl/klink.el b/kotl/klink.el
index 54f9cac564..8ca1161d22 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:     29-Apr-23 at 14:02:57 by Bob Weiner
+;; Last-Mod:     20-May-23 at 16:52:28 by Bob Weiner
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
@@ -184,8 +184,9 @@ link-end-position, (including delimiters)."
             ;; even if inside a comment
             (and (search-backward "<" bol t)
                  (not (eq (preceding-char) ?#))
-                 ;; Don't match to \<(explicit)> Hyperbole buttons
-                 (not (eq (char-after (1+ (point))) ?\())))
+                 ;; Don't match to \<(explicit)> or <[implicit]> Hyperbole
+                  ;; buttons or message attachments such as <#part ...>
+                 (not (memq (char-after (1+ (point))) '(?\( ?\[ ?#)))))
           (setq label-and-pos (hbut:label-p t "<" ">" t))
           (stringp (setq referent (car label-and-pos)))
           (setq referent (string-trim referent))