diff --git a/ChangeLog b/ChangeLog index 91ce3c61..e43bdd71 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,16 @@ +2022-10-04 Mats Lidell + +* 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 * hui-mouse.el: diff --git a/Makefile b/Makefile index cfa5e290..6b3375be 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 00000000..71684157 --- /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 d605683f..9fcfca8f 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 00000000..a688571e --- /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 +;; +;; 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