[elpa] externals/hyperbole caa137ff41 4/4: First stab at register support (#272)

[ELPA Syncer]

branch: externals/hyperbole
commit caa137ff4101f6802cca70dc085ec7c69f5c8f93
Author: Mats Lidell <mats.lidell@lidells.se>
Commit: GitHub <noreply@github.com>

    First stab at register support (#272)
---
 ChangeLog                  |  13 ++++++
 Makefile                   |   6 +--
 hui-register.el            |  75 ++++++++++++++++++++++++++++++++++
 hui.el                     |  12 ++++--
 test/hui-register-tests.el | 100 +++++++++++++++++++++++++++++++++++++++++++++
 5 files changed, 200 insertions(+), 6 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 91ce3c61f2..e43bdd718c 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,16 @@
+2022-10-04  Mats Lidell  <matsl@gnu.org>
+
+* hui.el (hui-copy-to-register): Use hui-register-struct-at-point if on a
+    button.
+
+* test/hui-register-tests.el (hui-register-test--create-register-content)
+    (hui-register-test--register-val-jump-to)
+    (hui-register-test--register-val-insert-ebut)
+    (hui-register-test--register-val-insert-ibut): Add test cases for
+    hui-register.
+
+* Makefile (EL_COMPILE, ELC_COMPILE): Add hui-register.
+
 2022-10-03  Mats Lidell  <matsl@gnu.org>
 
 * hui-mouse.el:
diff --git a/Makefile b/Makefile
index cfa5e2905f..6b3375be16 100644
--- a/Makefile
+++ b/Makefile
@@ -3,7 +3,7 @@
 # Author:       Bob Weiner
 #
 # Orig-Date:    15-Jun-94 at 03:42:38
-# Last-Mod:     10-Jul-22 at 23:40:15 by Bob Weiner
+# Last-Mod:     14-Sep-22 at 22:16:31 by Mats Lidell
 #
 # Copyright (C) 1994-2022  Free Software Foundation, Inc.
 # See the file HY-COPY for license information.
@@ -185,7 +185,7 @@ EL_COMPILE = hact.el hactypes.el hargs.el hbdata.el 
hbmap.el hbut.el \
             hycontrol.el hui-jmenu.el hui-menu.el hui-mini.el hui-mouse.el 
hui-select.el \
             hui-treemacs.el hui-window.el hui.el hvar.el hversion.el hvm.el 
hypb.el hyperbole.el \
             hyrolo-demo.el hyrolo-logic.el hyrolo-menu.el hyrolo.el 
hywconfig.el set.el hypb-ert.el \
-            hui-dired-sidebar.el hypb-maintenance.el hui-em-but.el
+            hui-dired-sidebar.el hypb-maintenance.el hui-em-but.el 
hui-register.el
 
 EL_KOTL = kotl/kexport.el kotl/kfile.el kotl/kfill.el kotl/kimport.el 
kotl/klabel.el \
          kotl/klink.el kotl/kmenu.el kotl/kotl-mode.el kotl/kotl-orgtbl.el \
@@ -200,7 +200,7 @@ ELC_COMPILE =  hactypes.elc hibtypes.elc hib-debbugs.elc 
hib-doc-id.elc hib-kbd.
             hycontrol.elc hui-jmenu.elc hui-menu.elc hui-mini.elc 
hui-mouse.elc hui-select.elc \
             hui-treemacs.elc hui-window.elc hui.elc hvar.elc hversion.elc 
hvm.elc hypb.elc hyperbole.elc \
             hyrolo-demo.elc hyrolo-logic.elc hyrolo-menu.elc hyrolo.elc 
hywconfig.elc \
-            set.elc hypb-ert.elc hui-dired-sidebar.elc hypb-maintenance.elc
+            set.elc hypb-ert.elc hui-dired-sidebar.elc hypb-maintenance.elc 
hui-register.elc
 
 ELC_KOTL = kotl/kexport.elc kotl/kfile.elc kotl/kfill.elc kotl/kimport.elc 
kotl/klabel.elc \
           kotl/klink.elc kotl/kmenu.elc kotl/kotl-mode.elc 
kotl/kotl-orgtbl.elc \
diff --git a/hui-register.el b/hui-register.el
new file mode 100644
index 0000000000..7168415714
--- /dev/null
+++ b/hui-register.el
@@ -0,0 +1,75 @@
+;;; hui-register.el --- register support for Hyperbole    -*- lexical-binding: 
t; -*-
+;;
+;; Author:       Mats Lidell
+;;
+;; Orig-Date:     6-Oct-91 at 03:42:38
+;; Last-Mod:     18-Sep-22 at 00:40:52 by Mats Lidell
+;;
+;; Copyright (C) 1991-2022  Free Software Foundation, Inc.
+;; See the "HY-COPY" file for license information.
+;;
+;; This file is part of GNU Hyperbole.
+
+;;; Code:
+
+;;; Commentary:
+;;
+;; Implements a struct for ebut and ibut, a content type of a
+;; register.  See "(Emacs) Registers"
+;;
+
+(eval-when-compile (require 'cl-lib))
+
+(require 'hbut)
+
+;;; ************************************************************************
+;;; Public functions
+;;; ************************************************************************
+
+(cl-defstruct hui-register-but
+  "Button register struct."
+  label file mpos link)
+
+;;;###autoload
+(defun hui-register-struct-at-point ()
+  "Make a Hyperbole link to button register struct for button at point."
+  (let* ((ebut-label (ebut:label-p))
+         (ibut-label (ibut:label-p))
+         (label (or ebut-label ibut-label)))
+    (unless label
+      (hypb:error "Point must be at a Hyperbole button"))
+    (make-hui-register-but
+     :label label
+     :file (buffer-file-name)
+     :mpos (point-marker)
+     :link (if ebut-label 'link-to-ebut 'link-to-ibut))))
+
+;;; ************************************************************************
+;;; Private functions
+;;; ************************************************************************
+
+(cl-defmethod register-val-jump-to ((val hui-register-but) _arg)
+  "Move point to location for Hyperbole button stored in VAL."
+  (let ((buf (marker-buffer (hui-register-but-mpos val)))
+        (pos (marker-position (hui-register-but-mpos val))))
+    (unless buf
+      (user-error "That Hyperbole button's buffer no longer exists"))
+    (switch-to-buffer buf)
+    (goto-char pos)))
+
+(cl-defmethod register-val-describe ((val hui-register-but) _verbose)
+  "Print description of Hyperbole button register value VAL to 
`standard-output'."
+  (princ "Hyperbole button\n    ")
+  (princ (format "%s in file %s\n"
+                 (hui-register-but-label val)
+                 (hui-register-but-file val))))
+
+(cl-defmethod register-val-insert ((val hui-register-but))
+  "Insert an ebut linking to the register button stored in VAL."
+  (ebut:program (hui-register-but-label val)
+                (hui-register-but-link val)
+                (hui-register-but-label val)
+                (hui-register-but-file val)))
+
+(provide 'hui-register)
+;;; hui-register.el ends here
diff --git a/hui.el b/hui.el
index d605683f65..9fcfca8f47 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:     23-Jul-22 at 20:11:01 by Bob Weiner
+;; Last-Mod:      2-Oct-22 at 10:21:06 by Mats Lidell
 ;;
 ;; Copyright (C) 1991-2021  Free Software Foundation, Inc.
 ;; See the "HY-COPY" file for license information.
@@ -72,9 +72,15 @@ point; see `hui:delimited-selectable-thing'."
        str)
     (prog1 (setq str
                 ;; If called interactively, transient-mark-mode is
-                ;; enabled, and no region is active, copy thing 
-                ;; at point or current kcell ref when in kotl-mode
+                ;; enabled, and no region is active, copy thing at
+                ;; point, current kcell ref when in kotl-mode or
+                ;; button if on an ibut or ebut.
                 (cond ((and (called-interactively-p 'interactive)
+                            transient-mark-mode
+                            (not (use-region-p))
+                             (or (ebut:label-p) (ibut:label-p)))
+                        (hui-register-struct-at-point))
+                       ((and (called-interactively-p 'interactive)
                             transient-mark-mode
                             (not (use-region-p))
                             (prog1 (setq thing-and-bounds 
(hui:delimited-selectable-thing-and-bounds)
diff --git a/test/hui-register-tests.el b/test/hui-register-tests.el
new file mode 100644
index 0000000000..a688571e0a
--- /dev/null
+++ b/test/hui-register-tests.el
@@ -0,0 +1,100 @@
+;;; hui-register-tests.el --- test for hui-register         -*- 
lexical-binding: t; -*-
+;;
+;; Author:       Mats Lidell <matsl@gnu.org>
+;;
+;; Orig-Date:    10-Sep-22 at 20:43:17
+;; Last-Mod:      2-Oct-22 at 11:21:13 by Mats Lidell
+;;
+;; Copyright (C) 2021-2022  Free Software Foundation, Inc.
+;; See the "HY-COPY" file for license information.
+;;
+;; This file is part of GNU Hyperbole.
+
+;;; Commentary:
+;;
+
+;;; Code:
+
+(require 'ert)
+(require 'hmouse-drv)
+(require 'hui-register)
+
+(ert-deftest hui-register-test--create-register-content ()
+  "Verify the struct contains its parts."
+  (let ((file (make-temp-file "hypb")))
+    (unwind-protect
+        (progn
+          (find-file file)
+          (insert "<[label label]> $HOME")
+          (goto-char 5)
+          (let ((content (hui-register-struct-at-point)))
+            (should (equal (hui-register-but-label content) "label_label"))
+            (should (equal (hui-register-but-link content) 'link-to-ibut))
+            (should (markerp (hui-register-but-mpos content)))
+            (should (equal (marker-buffer (hui-register-but-mpos content)) 
(current-buffer)))
+            (should (equal (hui-register-but-file content) 
(buffer-file-name)))))
+      (delete-file file))))
+
+(ert-deftest hui-register-test--register-val-jump-to ()
+  "Verify register val jumps to right file."
+  (let ((file (make-temp-file "hypb")))
+    (unwind-protect
+        (progn
+          (find-file file)
+          (insert "<[label]> $HOME")
+          (goto-char 5)
+          (let ((content (hui-register-struct-at-point))
+                (pos (point)))
+            (set-buffer "*scratch*")
+            (should (equal (buffer-name) "*scratch*"))
+            (register-val-jump-to content nil)
+            (should (equal (buffer-file-name) file))
+            (should (equal pos (point)))))
+      (delete-file file))))
+
+;; TODO - Problem with link to ebut
+;; (ert-deftest hui-register-test--register-val-insert-ibut ()
+;;   "Verify register val inserts link to ibut."
+;;   (let ((file1 (make-temp-file "hypb"))
+;;         (file2 (make-temp-file "hypb")))
+;;     (unwind-protect
+;;         (progn
+;;           (find-file file1)
+;;           (insert "<[label]> $HOME")
+;;           (goto-char 5)
+;;           (let ((content (hui-register-struct-at-point))
+;;                 (pos (point)))
+;;             (find-file file2)
+;;             (register-val-insert content)
+;;             (should (equal (buffer-file-name) file2))
+;;             (goto-char 5)
+;;             (should (ebut:at-p))
+;;             (action-key)
+;;             (should (equal (buffer-file-name) file1))))
+;;       (delete-file file1)
+;;       (delete-file file2))))
+
+(ert-deftest hui-register-test--register-val-insert-ebut ()
+  "Verify register val inserts link to ebut."
+  (let ((file1 (make-temp-file "hypb"))
+        (file2 (make-temp-file "hypb")))
+    (unwind-protect
+        (progn
+          (find-file file1)
+          (ebut:program "label" 'link-to-directory "/tmp")
+          (goto-char 5)
+          (let ((content (hui-register-struct-at-point))
+                (pos (point)))
+            (find-file file2)
+            (register-val-insert content)
+            (should (equal (buffer-file-name) file2))
+            (goto-char 5)
+            (should (ebut:at-p))
+            (action-key)
+            (should (equal major-mode 'dired-mode))
+            (should (equal default-directory "/tmp/"))))
+      (delete-file file1)
+      (delete-file file2))))
+
+(provide 'hui-register-tests)
+;;; hui-register-tests.el ends here