[elpa] externals/hyperbole ef3a180e4b 3/5: Fix ibut-instance functions, ibut:operate and actypes hbut-tests

[ELPA Syncer]

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

    Fix ibut-instance functions, ibut:operate and actypes hbut-tests
---
 hbdata.el          |  54 ++++++++++++++---------------
 hbut.el            |  25 +++++++-------
 test/hbut-tests.el | 100 ++++++++++++++++++++++-------------------------------
 3 files changed, 79 insertions(+), 100 deletions(-)

diff --git a/hbdata.el b/hbdata.el
index 963691816f..757bd7ece8 100644
--- a/hbdata.el
+++ b/hbdata.el
@@ -3,7 +3,7 @@
 ;; Author:       Bob Weiner
 ;;
 ;; Orig-Date:     2-Apr-91
-;; Last-Mod:     11-Jun-23 at 09:59:24 by Bob Weiner
+;; Last-Mod:     13-Jun-23 at 01:27:25 by Bob Weiner
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
@@ -36,9 +36,9 @@
 ;;    (Key            Placeholders  LinkType      <arg-list>             
creator and modifier with times)
 ;;    ("alt.mouse.el" nil nil       link-to-file  ("./ell/alt-mouse.el") 
"zzz@gnu.org" "19991027:09:19:26" "zzz@gnu.org" "19991027:09:31:36")
 ;;
-;;  which means:  button \<(alt.mouse.el)> found in file "TO-DO" in the current
-;;  directory provides a link to the local file "./ell/alt-mouse.el".  It was
-;;  created and last modified by zzz@gnu.org.
+;;  which means: button \<(alt.mouse.el)> found in file "TO-DO" in the
+;;  current directory provides a link to the local file "./ell/alt-mouse.el".
+;;  It was created and last modified by zzz@gnu.org.
 ;;
 ;;  All link entries that originate from the same source file are stored
 ;;  contiguously, one per line, in reverse order of creation.
@@ -284,33 +284,29 @@ class `hbdata' to operate on the entry."
    (lambda () (read (current-buffer)))
    lbl-key key-src directory))
 
-(defun hbdata:ibut-instance (&optional orig-name-key but-sym)
-  "Return ibutton instance number string from optional ORIG-NAME-KEY and 
BUT-SYM.
-ORIG-NAME-KEY nil means create a new ibutton; otherwise modify an
-existing one.  BUT-SYM nil means use `hbut:current'.  If
-successful, return a button instance string to append to button
-label or t when first instance."
-  (let* ((b (hattr:copy (or but-sym 'hbut:current) 'but))
-        (name-key (ibut:label-to-key (hattr:get b 'name)))
-        (key (or orig-name-key name-key))
-        (new-key (if orig-name-key name-key key))
-        (lbl-instance))
-    (or (when key
-         (if orig-name-key
-             (let ((inst-num (hbdata:ibut-instance-last new-key)))
-               (setq lbl-instance (when inst-num
-                                    (hbdata:instance-next
-                                     (concat new-key hbut:instance-sep
-                                             (int-to-string inst-num))))))
-           (when (setq lbl-instance (hbdata:ibut-instance-last new-key))
-             (setq lbl-instance (concat hbut:instance-sep
-                                        (int-to-string (1+ lbl-instance))))))
-         lbl-instance)
-       t)))
+(defun hbdata:ibut-instance-next (name-key)
+  "Given NAME-KEY, return next ibutton instance number string for current 
buffer.
+If there is no existing ibutton with NAME-KEY, return t.
+
+With NAME-KEY nil or NAME-KEY 'name' and no existing in-buffer ibutton
+with that name, return t.
+With NAME-KEY 'name' and highest in-buffer ibutton 'name:3',
+return ':4'."
+  (if (null name-key)
+      t
+    (let ((lbl-instance (hbdata:ibut-instance-last name-key)))
+      (if lbl-instance
+         (concat hbut:instance-sep (int-to-string (1+ lbl-instance)))
+       t))))
 
 (defun hbdata:ibut-instance-last (name-key)
   "Return highest instance number for implicit button NAME-KEY in current 
buffer.
-1 if not repeated, nil if no instance."
+Instance number is returned as an integer.  Return 1 if NAME-KEY exists
+in the buffer but no other instances do; nil if no instance.
+
+With no match, return nil.
+With only 'name' found, return 1.
+With 'name' and 'name:2' found, return 2."
   (let ((key (car (ibut:label-sort-keys (ibut:label-key-match name-key)))))
     (cond ((null key) nil)
          ((string-match (concat (regexp-quote hbut:instance-sep)
@@ -323,6 +319,8 @@ label or t when first instance."
   "Return string for the next higher button instance number after NAME-KEY's.
 Return nil if NAME-KEY is nil.
 
+Given 'name', return ':2'.  Given 'name:2', return ':3'.
+
 This does not search any buffer for other instances; it uses the
 NAME-KEY string literally, so it must include any instance number
 to increment."
diff --git a/hbut.el b/hbut.el
index 356873ffa9..440182606f 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:     11-Jun-23 at 21:32:08 by Bob Weiner
+;; Last-Mod:     12-Jun-23 at 22:56:47 by Bob Weiner
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
@@ -1875,7 +1875,7 @@ Store new button attributes in the symbol, 'hbut:current."
              (when args
                (hattr:set 'hbut:current 'args (if actype (cdr args) args))))
 
-           (hbdata:ibut-instance)))
+           (hbdata:ibut-instance-next (ibut:label-to-key name))))
       (set-marker ibpoint nil))))
 
 (def-edebug-spec cl-defun
@@ -2176,7 +2176,6 @@ Summary of operations based on inputs:
         (name-regexp (ibut:label-regexp (ibut:label-to-key name)))
         (modify new-name)
         (region-flag (hmouse-use-region-p))
-        ;; (new-name-key)
         (instance-flag))
     (unless actype
       (hypb:error "(ibut:operate): hbut:current ibut actype (%s) must be 
non-nil"
@@ -2187,8 +2186,6 @@ Summary of operations based on inputs:
 
     (unless new-name
       (setq new-name name))
-    ;; (setq new-name-key (ibut:label-to-key new-name))
-    ;; (hattr:set 'hbut:current 'lbl-key new-name-key)
     (when (stringp new-name)
       (hattr:set 'hbut:current 'name new-name))
     (save-excursion
@@ -2292,7 +2289,6 @@ Summary of operations based on inputs:
     ;; Append any instance-flag string to the button name
     (when (stringp instance-flag)
       (setq new-name (concat new-name instance-flag))
-      ;; (hattr:set 'hbut:current 'lbl-key (ibut:label-to-key new-name))
       (hattr:set 'hbut:current 'name new-name))
 
     ;; Position point
@@ -2311,10 +2307,11 @@ Summary of operations based on inputs:
 
     (let ((lbl-key (hattr:get 'hbut:current 'lbl-key)))
       (unless lbl-key
-       (when (ibut:set-name-and-label-key-p)
+       (when (or (ibut:set-name-and-label-key-p)
+                 (ibut:at-p)) ;; Sets lbl-key for non-delimited ibtypes
          (setq lbl-key (hattr:get 'hbut:current 'lbl-key))))
       (unless (and (stringp lbl-key) (not (string-empty-p lbl-key)))
-       (hypb:error "(ibut:operate): hbut:current ibut lbl-key (%s) must be 
non-nil"
+       (hypb:error "(ibut:operate): hbut:current ibut lbl-key '%s' must be 
non-nil"
                    lbl-key)))
 
     ;; instance-flag might be 't which we don't want to return.
@@ -2332,9 +2329,11 @@ Summary of operations based on inputs:
         (arg3   (nth 2 args)))
     (pcase actype
       ('actypes::kbd-key
-       (if (and (stringp arg1) (string-match "\\s-*{.+}\\s-*" arg1))
-          (insert arg1)
-        (insert "{" arg1 "}")))
+       (cond ((and (stringp arg1) (string-match "\\s-*{.+}\\s-*" arg1))
+             (insert arg1))
+            ((stringp arg1)
+             (insert "{" arg1 "}"))
+            (t (insert "{}"))))
       ((or 'actypes::link-to-directory 'actypes::link-to-Info-node 
'actypes::link-to-Info-index-item)
        (insert "\"" arg1 "\""))
       ('actypes::annot-bib (insert "[" arg1 "]"))
@@ -2347,7 +2346,7 @@ Summary of operations based on inputs:
       ('actypes::link-to-ibut (progn (insert "<ilink:" arg1)
                                     (when arg2 (insert ": " arg2))
                                     (insert ">")))
-      ('actypes::link-to-kcell (progn (insert "<") (when arg1 (insert arg1))
+      ('actypes::link-to-kcell (progn (insert "<@ ") (when arg1 (insert arg1))
                                      (when arg2 (insert ", " arg2))
                                      (insert ">")))
       ('actypes::link-to-org-id (insert (format "\"id:%s\"" arg1)))
@@ -2416,7 +2415,7 @@ For interactive creation, use `hui:ibut-create' instead."
            (hattr:set 'hbut:current 'args args)
            (ibut:operate))
        (error (hattr:clear 'hbut:current)
-              (error "(ibut:program): %S" err))))))
+              (error "(ibut:program): name: %S actype: %S args: %S - %S" name 
actype args err))))))
 
 (defun    ibut:rename (old-lbl new-lbl)
   "Change an implicit button name in the current buffer from OLD-LBL to 
NEW-LBL.
diff --git a/test/hbut-tests.el b/test/hbut-tests.el
index e8c4e943a6..56dd53921e 100644
--- a/test/hbut-tests.el
+++ b/test/hbut-tests.el
@@ -272,79 +272,61 @@ Needed since hyperbole expands all links to absolute 
paths and
   "Insert ibut text using an ibut in a temp buffer as source."
   (dolist (bd
            ;; Test data is in the format:
-           ;;  - action-type implicit-button-text resulting-button-text
-           ;; The third parameter is optional and if missing the
-           ;; implicit-button-text is used as the result as
-           ;; well. i.e. Works when the input string is preserved.
+           ;;  (action-type expected-implicit-button-text &rest 
implicit-button-args)
            '(
-             ('actypes::kbd-key "{C-h h}")
-             ; ('actypes::annotate-bib "[FSF 12]") ;; Requires a file!?
-             ; ('actypes::exec-shell-cmd "!/bin/bash") ;; Not identified as an 
ibut
-             ; ('actypes::exec-window-cmd "&/bin/bash") ;; Not identified as 
an ibut
-             ('actypes::link-to-gbut "<glink:arg1>")
-             ('actypes::link-to-ebut "<elink:arg1>")
-             ('actypes::link-to-ebut "<elink:arg1:arg2>" "<elink:arg1: arg2>")
-             ('actypes::link-to-ibut "<ilink:arg1>")
-             ('actypes::link-to-ibut "<ilink:arg1:arg2>" "<ilink:arg1: arg2>")
-             ('actypes::link-to-kcell "<@ 3b=06>" "<nil \"@ 3b=06\" 13>")
+             (actypes::kbd-key "{C-h h}" "C-h h")
+             ; (actypes::annotate-bib "[FSF 12]" nil) ;; Requires a file!?
+             ; (actypes::exec-shell-cmd "!/bin/bash" nil) ;; Not identified as 
an ibut
+             ; (actypes::exec-window-cmd "&/bin/bash" nil) ;; Not identified 
as an ibut
+             (actypes::link-to-gbut "<glink:arg1>" "arg1")
+             (actypes::link-to-ebut "<elink:arg1>" "arg1")
+             (actypes::link-to-ebut "<elink:arg1: arg2>" "arg1" "arg2")
+             (actypes::link-to-ibut "<ilink:arg1>" "arg1")
+             (actypes::link-to-ibut "<ilink:arg1: arg2>" "arg1" "arg2")
+             (actypes::link-to-kcell "<@ 3b=06>" "3b=06")
 
              ;; Verified manually. Produces nil when run by ert!?
-             ; ('actypes::link-to-kcell "<EXAMPLE.kotl, 4=012>" "<nil 
EXAMPLE.kotl, 4=012 13>")
+             ; (actypes::link-to-kcell "<EXAMPLE.kotl, 4=012>" "<nil 
EXAMPLE.kotl, 4=012 13>")
 
-             ; ('actypes::link-to-org-id "id:arg1") ;; Can links to org id be 
created using text only?
-             ('actypes::link-to-rfc "rfc123")
-             ; ('actypes::man-show "rm(1)      - remove")
-             ('actypes::link-to-file-line "/etc/passwd:10" 
"\"/etc/passwd:10\"")
-             ('actypes::link-to-file "/etc/passwd" "\"/etc/passwd\"")))
+             ; (actypes::link-to-org-id "id:arg1") ;; Can links to org id be 
created using text only?
+             ; (actypes::man-show "rm(1)       - remove")
+             (actypes::link-to-file "\"/etc/passwd\"" "/etc/passwd")
+             (actypes::link-to-file-line "\"/etc/passwd:10\"" "/etc/passwd" 10)
+             (actypes::link-to-rfc "rfc123" 123)))
     (with-temp-buffer
-      (insert (format "<[label]> - %s" (cadr bd)))
+      (apply #'ibut:program nil (car bd) (cddr bd))
       (goto-char 3)
-      (let ((but (ibut:at-p))
-            (match (or (caddr bd) (cadr bd))))
-        (with-temp-buffer
-          (ibut:insert-text but)
-          (should (string= match (buffer-string))))))))
+      (should (string= (cadr bd) (buffer-string))))))
 
 (ert-deftest hbut-tests-ibut-insert-text-temp-file ()
   "Insert ibut text using an ibut in a temp file as source."
   (dolist (bd
            ;; Test data is in the format:
-           ;;  - action-type implicit-button-text resulting-button-text
-           ;; The third parameter is optional and if missing the
-           ;; implicit-button-text is used as the result as
-           ;; well. i.e. Work when the input string is preserved.
+           ;;  (action-type expected-implicit-button-text &rest 
implicit-button-args)
            '(
-             ('actypes::kbd-key "{C-h h}")
-             ('actypes::annotate-bib "[FSF 12]") ;; Requires a file!
-             ; ('actypes::exec-shell-cmd "!/bin/bash") ;; Not identified as an 
ibut
-             ; ('actypes::exec-window-cmd "&/bin/bash") ;; Not identified as 
an ibut
-             ('actypes::link-to-gbut "<glink:arg1>")
-             ('actypes::link-to-ebut "<elink:arg1>")
-             ('actypes::link-to-ebut "<elink:arg1:arg2>" "<elink:arg1: arg2>")
-             ('actypes::link-to-ibut "<ilink:arg1>")
-             ('actypes::link-to-ibut "<ilink:arg1:arg2>" "<ilink:arg1: arg2>")
-             ('actypes::link-to-kcell "<@ 3b=06>" "<nil \"@ 3b=06\" 13>")
+             (actypes::kbd-key "<[label]> - {C-h h}" "C-h h")
+             ; (actypes::annotate-bib "<[label]> - [FSF 12]" nil) ;; Requires 
a file!?
+             ; (actypes::exec-shell-cmd "<[label]> - !/bin/bash" "!/bin/bash") 
;; Not identified as an ibut
+             ; (actypes::exec-window-cmd "<[label]> - &/bin/bash" 
"&/bin/bash") ;; Not identified as an ibut
+             (actypes::link-to-gbut "<[label]> - <glink:arg1>" "arg1")
+             (actypes::link-to-ebut "<[label]> - <elink:arg1>" "arg1")
+             (actypes::link-to-ebut "<[label]> - <elink:arg1: arg2>" "arg1" 
"arg2")
+             (actypes::link-to-ibut "<[label]> - <ilink:arg1>" "arg1")
+             (actypes::link-to-ibut "<[label]> - <ilink:arg1: arg2>" "arg1" 
"arg2")
+             (actypes::link-to-kcell "<[label]> - <@ 3b=06>" "3b=06")
 
              ;; Verified manually. Produces nil when run by ert!?
-             ; ('actypes::link-to-kcell "<EXAMPLE.kotl, 4=012>" "<nil 
EXAMPLE.kotl, 4=012 13>")
-
-             ; ('actypes::link-to-org-id "id:arg1") ;; Can links to org id be 
created using text only?
-             ('actypes::link-to-rfc "rfc123")
-             ; ('actypes::man-show "rm(1)      - remove")
-             ('actypes::link-to-file-line "/etc/passwd:10" 
"\"/etc/passwd:10\"")
-             ('actypes::link-to-file "/etc/passwd" "\"/etc/passwd\"")))
-    (let ((file (make-temp-file "hypb" nil ".txt"
-                                (format "<[label]> - %s" (cadr bd)))))
-      (unwind-protect
-          (progn
-            (find-file file)
-            (goto-char 3)
-            (let ((but (ibut:at-p))
-                  (match (or (caddr bd) (cadr bd))))
-              (with-temp-buffer
-                (ibut:insert-text but)
-                (should (string= match (buffer-string))))))
-        (delete-file file)))))
+             ; (actypes::link-to-kcell "<[label]> - <EXAMPLE.kotl, 4=012>" 
"<nil EXAMPLE.kotl, 4=012 13>")
+
+             ; (actypes::link-to-org-id "<[label]> - id:arg1") ;; Can links to 
org id be created using text only?
+             ; (actypes::man-show "<[label]> - rm(1)   - remove")
+             (actypes::link-to-file "<[label]> - \"/etc/passwd\"" 
"/etc/passwd")
+             (actypes::link-to-file-line "<[label]> - \"/etc/passwd:10\"" 
"/etc/passwd" 10)
+             (actypes::link-to-rfc "<[label]> - rfc123" 123)))
+    (with-temp-file "hypb.txt"
+      (apply #'ibut:program "label" (car bd) (cddr bd))
+      (goto-char 3)
+      (should (string= (cadr bd) (buffer-string))))))
 
 ;; This file can't be byte-compiled without the `el-mock' package (because of
 ;; the use of the `with-mock' macro), which is not a dependency of Hyperbole.