branch: externals/hyperbole
commit 9a39300fcbbcb99b09a0f8a519cff33394a9268d
Merge: 6befc489c5 27461eb409
Author: Bob Weiner <r...@gnu.org>
Commit: Bob Weiner <r...@gnu.org>
Merge branch 'rsw' of hyperbole into rsw
---
ChangeLog | 27 +++++++++++++
hbut.el | 33 +++++++++++++---
hui-menu.el | 4 +-
test/hbut-tests.el | 32 +++++++++++++++-
test/hyrolo-tests.el | 104 +++++++++++++++++++++++++++++++++++++++++++++------
5 files changed, 180 insertions(+), 20 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index 3a7c5ce484..af5219e739 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,30 @@
+2024-02-12 Mats Lidell <ma...@gnu.org>
+
+* test/hyrolo-tests.el (hyrolo-tests--modify-test-data): Helper for
+ modifying org test data for outline and markdown files.
+ (hyrolo-tests--outline-content-otl)
+ (hyrolo-tests--outline-content-md): Use hyrolo-tests--modify-test-data.
+ (hyrolo-tests---org-expected-outline-for-top-level)
+ (hyrolo-tests---org-expected-outline-for-overview): Add expected
+ outline for org test data.
+ (hyrolo-tests--top-level-outline-for-all-file-types): Test top level
outline.
+ (hyrolo-tests--overview-outline-for-all-file-types): Test overview outline.
+
+2024-02-11 Mats Lidell <ma...@gnu.org>
+
+* test/hbut-tests.el (hbut-tests--ebut-act-calls-hbut-act)
+ (hbut-tests--ibut-act-calls-hbut-act): Add test for new act functions
+ with error cases.
+
+* hui-menu.el (hui-menu-explicit-buttons): Use ebut:act-label.
+
+* hbut.el (ibut:act-label, ebut:act-label): Rename ebut:act and ibut:act
+ since they take a label as arg.
+ (ebut:act, ibut:act): Add new act functions taking a hbut as
+ arg. Allow only to be called with ebut or ibut respectively. If
+ falling back on hbut:current check that it is of the same type as the
+ call.
+
2024-02-08 Mats Lidell <ma...@gnu.org>
* test/hyrolo-tests.el: Make hide tests more forgiving about hiding
diff --git a/hbut.el b/hbut.el
index fa09f5dd90..e1884e862e 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: 21-Jan-24 at 10:31:14 by Bob Weiner
+;; Last-Mod: 11-Feb-24 at 23:43:08 by Mats Lidell
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -122,7 +122,19 @@ indicating the source of any of its Hyperbole buttons.")
"*Non-nil value saves button data when button source is saved.
Nil disables saving.")
-(defun ebut:act (label)
+(defun ebut:act (&optional ebut)
+ "Perform action for optional explicit Hyperbole button symbol EBUT.
+Default is the symbol hbut:current."
+ (interactive (list (hbut:get (hargs:read-match "Activate labeled Hyperbole
button: "
+ (ebut:alist)
+ nil t nil 'ebut))))
+ (unless ebut
+ (setq ebut 'hbut:current))
+ (if (ebut:is-p ebut)
+ (hbut:act ebut)
+ (error "(ebut:act): Expected an ebut but got a but of type %s" (hattr:get
ebut 'categ))))
+
+(defun ebut:act-label (label)
"Activate Hyperbole explicit button with LABEL from the current buffer."
(interactive (list (hargs:read-match "Activate explicit button labeled: "
(ebut:alist)
@@ -131,7 +143,7 @@ Nil disables saving.")
(but (ebut:get lbl-key)))
(if but
(hbut:act but)
- (error "(ebut:act): No explicit button labeled: %s" label))))
+ (error "(ebut:act-label): No explicit button labeled: %s" label))))
(defun ebut:alist (&optional file)
"Return alist of ebuts in FILE or the current buffer.
@@ -1692,8 +1704,19 @@ Keys in optional KEY-SRC or the current buffer."
;;; ibut class - Implicit Hyperbole Buttons
;;; ========================================================================
+(defun ibut:act (&optional ibut)
+ "Perform action for optional implicit Hyperbole button symbol IBUT.
+Default is the symbol hbut:current."
+ (interactive (list (hbut:get (hargs:read-match "Activate labeled Hyperbole
button: "
+ (ibut:alist)
+ nil t nil 'ibut))))
+ (unless ibut
+ (setq ibut 'hbut:current))
+ (if (ibut:is-p ibut)
+ (hbut:act ibut)
+ (error "(ebut:act): Expected an ibut but got a but of type %s" (hattr:get
ibut 'categ))))
-(defun ibut:act (label)
+(defun ibut:act-label (label)
"Activate Hyperbole implicit button with <[LABEL]> from the current buffer."
(interactive (list (hargs:read-match "Activate implicit button labeled: "
(ibut:alist)
@@ -1702,7 +1725,7 @@ Keys in optional KEY-SRC or the current buffer."
(but (ibut:get lbl-key)))
(if but
(hbut:act but)
- (error "(ibut:act): No implicit button labeled: %s" label))))
+ (error "(ibut:act-label): No implicit button labeled: %s" label))))
(defun ibut:alist (&optional file)
"Return alist of labeled ibuts in FILE or the current buffer.
diff --git a/hui-menu.el b/hui-menu.el
index 7d3bd8abbd..650cb07c61 100644
--- a/hui-menu.el
+++ b/hui-menu.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 28-Oct-94 at 10:59:44
-;; Last-Mod: 21-Jan-24 at 10:31:58 by Bob Weiner
+;; Last-Mod: 2-Feb-24 at 21:41:16 by Mats Lidell
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -110,7 +110,7 @@ BROWSER-OPTION marks current active menu option as
selected."
(not hui-menu-order-explicit-buttons))
:style toggle :selected
hui-menu-order-explicit-buttons]
"Activate:")
- (mapcar (lambda (label) (vector label `(ebut:act
,label) t))
+ (mapcar (lambda (label) (vector label `(ebut:act-label
,label) t))
(if hui-menu-order-explicit-buttons
(sort labels #'string-lessp)
labels))
diff --git a/test/hbut-tests.el b/test/hbut-tests.el
index 80d34eb95f..f8a6574bb2 100644
--- a/test/hbut-tests.el
+++ b/test/hbut-tests.el
@@ -3,7 +3,7 @@
;; Author: Mats Lidell <ma...@gnu.org>
;;
;; Orig-Date: 30-may-21 at 09:33:00
-;; Last-Mod: 20-Jan-24 at 15:43:50 by Mats Lidell
+;; Last-Mod: 11-Feb-24 at 23:35:14 by Mats Lidell
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -738,6 +738,36 @@ See #10 for the proper way to add an ibutton name.
(hbut-tests:should-match-tmp-folder buf-str)
(should (null (hattr:get 'hbut:current 'name))))))
+(ert-deftest hbut-tests--ebut-act-calls-hbut-act ()
+ "Verify `ebut:act' calls `hbut:act'."
+ (mocklet (((hbut:act 'button) => t)
+ ((ebut:is-p 'button) => t))
+ (should (ebut:act 'button)))
+ (mocklet (((hbut:act 'hbut:current) => t)
+ ((ebut:is-p 'hbut:current) => t))
+ (should (ebut:act)))
+ (mocklet ((ebut:is-p => nil))
+ (should-error (ebut:act 'button))
+ (should-error (ebut:act)))
+ (progn
+ (hattr:clear 'hbut:current)
+ (should-error (ebut:act))))
+
+(ert-deftest hbut-tests--ibut-act-calls-hbut-act ()
+ "Verify `ibut:act' calls `hbut:act'."
+ (mocklet (((hbut:act 'button) => t)
+ ((ibut:is-p 'button) => t))
+ (should (ibut:act 'button)))
+ (mocklet (((hbut:act 'hbut:current) => t)
+ ((ibut:is-p 'hbut:current) => t))
+ (should (ibut:act)))
+ (mocklet ((ibut:is-p => nil))
+ (should-error (ibut:act 'button))
+ (should-error (ibut:act)))
+ (progn
+ (hattr:clear 'hbut:current)
+ (should-error (ibut:act))))
+
;; 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.
;; Local Variables:
diff --git a/test/hyrolo-tests.el b/test/hyrolo-tests.el
index 82edf07c59..4d52b519dc 100644
--- a/test/hyrolo-tests.el
+++ b/test/hyrolo-tests.el
@@ -3,7 +3,7 @@
;; Author: Mats Lidell <ma...@gnu.org>
;;
;; Orig-Date: 19-Jun-21 at 22:42:00
-;; Last-Mod: 8-Feb-24 at 13:57:13 by Mats Lidell
+;; Last-Mod: 12-Feb-24 at 23:01:15 by Mats Lidell
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -986,19 +986,24 @@ body
body
* h-org 2
body
-** h-org-2.1
+** h-org 2.1
body
"
"Outline content for org files.")
+(defun hyrolo-tests--modify-test-data (star type str)
+ "Replace * with STAR and org with TYPE in STR.
+Useful for creating outline and markdown test data from org examples."
+ (replace-regexp-in-string
+ "org" type
+ (replace-regexp-in-string (regexp-quote "*") star str)))
+
(defconst hyrolo-tests--outline-content-otl
- (replace-regexp-in-string "org" "otl" hyrolo-tests--outline-content-org)
+ (hyrolo-tests--modify-test-data "*" "otl" hyrolo-tests--outline-content-org)
"Outline content for otl files.")
(defconst hyrolo-tests--outline-content-md
- (replace-regexp-in-string
- (regexp-quote "*") "#"
- (replace-regexp-in-string "org" "md" hyrolo-tests--outline-content-org))
+ (hyrolo-tests--modify-test-data "#" "md" hyrolo-tests--outline-content-org)
"Outline content for markdown files.")
(ert-deftest hyrolo-tests--forward-same-level-org-level2 ()
@@ -1197,7 +1202,7 @@ body...
** h-org 1.1...
** h-org 1.2...
* h-org 2...
-** h-org-2.1...
+** h-org 2.1...
"
) "$")
(hyrolo-tests--outline-as-string)))
@@ -1213,7 +1218,7 @@ body...
** h-org 1.1...
** h-org 1.2...
* h-org 2...
-** h-org-2.1...
+** h-org 2.1...
"
(hyrolo-tests--outline-as-string (point))))
@@ -1227,7 +1232,7 @@ body...
** h-org 1.1...
** h-org 1.2...
* h-org 2...
-** h-org-2.1...
+** h-org 2.1...
"
(hyrolo-tests--outline-as-string (point)))))
(kill-buffer hyrolo-display-buffer)
@@ -1289,7 +1294,7 @@ body
*** h-org 1.2.1
body
* h-org 2...
-** h-org-2.1...
+** h-org 2.1...
"
(hyrolo-tests--outline-as-string (point))))
;; Hide it again
@@ -1354,14 +1359,89 @@ body
(hy-test-helpers:consume-input-events)
(should (string=
(concat (hyrolo-tests--hyrolo-section-header org-file1)
- "* h-org 1\nbody\n** h-org 1.1\nbody\n** h-org
1.2\nbody\n*** h-org 1.2.1\nbody\n* h-org 2\nbody\n** h-org-2.1...\n")
+ "* h-org 1\nbody\n** h-org 1.1\nbody\n** h-org
1.2\nbody\n*** h-org 1.2.1\nbody\n* h-org 2\nbody\n** h-org 2.1...\n")
(hyrolo-tests--outline-as-string)))
(should (hact 'kbd-key "TAB"))
(hy-test-helpers:consume-input-events)
(should (string=
(concat (hyrolo-tests--hyrolo-section-header org-file1)
- "* h-org 1\nbody\n** h-org 1.1\nbody\n** h-org
1.2\nbody\n*** h-org 1.2.1\nbody\n* h-org 2\nbody\n** h-org-2.1\nbody\n")
+ "* h-org 1\nbody\n** h-org 1.1\nbody\n** h-org
1.2\nbody\n*** h-org 1.2.1\nbody\n* h-org 2\nbody\n** h-org 2.1\nbody\n")
+ (hyrolo-tests--outline-as-string))))
+ (kill-buffer hyrolo-display-buffer)
+ (hy-delete-files-and-buffers hyrolo-file-list))))
+
+(defconst hyrolo-tests---org-expected-outline-for-top-level
+ "\
+* h-org 1...
+* h-org 2...
+"
+ "Expected outline for org test data.")
+
+(ert-deftest hyrolo-tests--top-level-outline-for-all-file-types ()
+ "Verify `hyrolo-top-level' shows first level for all supported file types."
+ (let* ((org-file1 (make-temp-file "hypb" nil ".org"
hyrolo-tests--outline-content-org))
+ (otl-file1 (make-temp-file "hypb" nil ".otl"
hyrolo-tests--outline-content-otl))
+ (md-file1 (make-temp-file "hypb" nil ".md"
hyrolo-tests--outline-content-md))
+ (kotl-file1 (hyrolo-tests--gen-kotl-outline "h-kotl" "body" 2))
+ (hyrolo-file-list (list org-file1 otl-file1 md-file1 kotl-file1)))
+ (unwind-protect
+ (progn
+ (hyrolo-grep "body")
+ (hyrolo-top-level)
+
+ (should (string=
+ (concat (hyrolo-tests--hyrolo-section-header org-file1)
+ hyrolo-tests---org-expected-outline-for-top-level
+ (hyrolo-tests--hyrolo-section-header otl-file1)
+ (hyrolo-tests--modify-test-data "*" "otl"
hyrolo-tests---org-expected-outline-for-top-level)
+ (hyrolo-tests--hyrolo-section-header md-file1)
+ (hyrolo-tests--modify-test-data "#" "md"
hyrolo-tests---org-expected-outline-for-top-level)
+ (hyrolo-tests--hyrolo-section-header kotl-file1)
+ "\
+ 1. h-kotl...
+ 1a. h-kotl 1...
+")
+ (hyrolo-tests--outline-as-string))))
+ (kill-buffer hyrolo-display-buffer)
+ (hy-delete-files-and-buffers hyrolo-file-list))))
+
+(defconst hyrolo-tests---org-expected-outline-for-overview
+ "\
+* h-org 1...
+** h-org 1.1...
+** h-org 1.2...
+*** h-org 1.2.1...
+* h-org 2...
+** h-org 2.1...
+"
+ "Expected outline for org test data.")
+
+(ert-deftest hyrolo-tests--overview-outline-for-all-file-types ()
+ "Verify `hyrolo-overview' shows all level headings for all supported file
types."
+ (let* ((org-file1 (make-temp-file "hypb" nil ".org"
hyrolo-tests--outline-content-org))
+ (otl-file1 (make-temp-file "hypb" nil ".otl"
hyrolo-tests--outline-content-otl))
+ (md-file1 (make-temp-file "hypb" nil ".md"
hyrolo-tests--outline-content-md))
+ (kotl-file1 (hyrolo-tests--gen-kotl-outline "h-kotl" "body" 2))
+ (hyrolo-file-list (list org-file1 otl-file1 md-file1 kotl-file1)))
+ (unwind-protect
+ (progn
+ (hyrolo-grep "body")
+ (hyrolo-overview nil)
+
+ (should (string=
+ (concat (hyrolo-tests--hyrolo-section-header org-file1)
+ hyrolo-tests---org-expected-outline-for-overview
+ (hyrolo-tests--hyrolo-section-header otl-file1)
+ (hyrolo-tests--modify-test-data "*" "otl"
hyrolo-tests---org-expected-outline-for-overview)
+ (hyrolo-tests--hyrolo-section-header md-file1)
+ (hyrolo-tests--modify-test-data "#" "md"
hyrolo-tests---org-expected-outline-for-overview)
+ (hyrolo-tests--hyrolo-section-header kotl-file1)
+ "\
+ 1. h-kotl...
+ 1a. h-kotl 1...
+ 1a1. h-kotl 2...
+")
(hyrolo-tests--outline-as-string))))
(kill-buffer hyrolo-display-buffer)
(hy-delete-files-and-buffers hyrolo-file-list))))
