branch: externals/hyperbole
commit f872e9d6d9f33a3544e2a1537428a5649871c1c9
Author: bw <r...@gnu.org>
Commit: bw <r...@gnu.org>
Fix HyWikiWord highlighting edge cases and improve non-page tests
hypb.el (hypb:in-string-p): Remove check of chars prior to string open char.
hywiki.el (hywiki--word-face): Add underlining by default. Helps to see if
spaces are highlighted or not.
(hywiki-highlight-word-move-range): Add for potential future use.
(hywiki--extend-region): Fix to not extend region to include
trailing
whitespace unless delimited.
test/hywiki-tests.el (hywiki-tests--get-brace-strings,
hywiki-tests--insert-by-char,
hywiki-tests--execute-commands): Add.
hywiki.el (hywiki-buttonize-character-commands): Fix doc that this runs
before
'post-command-hook'.
hmouse-tag.el (smart-tags-find-p): Rewrite to better match
`smart-tags-display'
behavior which includes case-sensitive tag lookup and using xref hsys-xref
to detect more tag types.
test/hy-test-helpers.el (hy-delete-file-and-buffer): Previously just cleared
file modified flag without saving it. Now additionally save the file
prior to trying to kill it.
---
ChangeLog | 66 ++++--
hbut.el | 13 +-
hib-debbugs.el | 3 +-
hibtypes.el | 4 +-
hmouse-drv.el | 6 +-
hmouse-tag.el | 17 +-
hui-mouse.el | 4 +-
hypb.el | 39 ++--
hywiki.el | 172 ++++++++-------
test/MANIFEST | 2 +-
test/{hsettings-test.el => hsettings-tests.el} | 10 +-
test/hui-register-tests.el | 10 +-
test/hy-test-helpers.el | 35 +--
test/hyrolo-tests.el | 8 +-
test/hywiki-tests.el | 281 +++++++++++++++----------
15 files changed, 395 insertions(+), 275 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index 904f50b20f..2ec42b0c27 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,36 @@
+2025-08-17 Bob Weiner <r...@gnu.org>
+
+* test/hywiki-tests.el (hywiki-tests--referent-test): Clarify behavior in doc
+ string and change wiki-referent to wiki-word-non-page. Fix test cases
+ that create a non-page referent.
+
+* hbut.el (ibut:create): Fix error handling and don't switch to *Messages*
buffer.
+
+2025-08-16 Bob Weiner <r...@gnu.org>
+
+* hypb.el (hypb:in-string-p): Remove check of chars prior to string open char.
+
+* hywiki.el (hywiki--word-face): Add underlining by default. Helps to see if
+ spaces are highlighted or not.
+ (hywiki-highlight-word-move-range): Add for potential future use.
+ (hywiki--extend-region): Fix to not extend region to include
trailing
+ whitespace unless delimited.
+
+* test/hywiki-tests.el (hywiki-tests--get-brace-strings,
+ hywiki-tests--insert-by-char,
+ hywiki-tests--execute-commands): Add.
+
+* hywiki.el (hywiki-buttonize-character-commands): Fix doc that this runs
before
+ 'post-command-hook'.
+
+* hmouse-tag.el (smart-tags-find-p): Rewrite to better match
`smart-tags-display'
+ behavior which includes case-sensitive tag lookup and using xref hsys-xref
+ to detect more tag types.
+
+* test/hy-test-helpers.el (hy-delete-file-and-buffer): Previously just cleared
+ file modified flag without saving it. Now additionally save the file
+ prior to trying to kill it.
+
2025-08-10 Bob Weiner <r...@gnu.org>
* test/hywiki-tests.el (hywiki-tests--with-face-test): Make default value be
@@ -32,9 +65,6 @@
(insert "<string-empty-p \"False\">")
<string-empty-p "False">
-* test/hy-test-helpers.el (hy-test-helpers:eval-as-command): Add and use only
in
- ert test cases to emulate the command loop hooks.
-
* hypb.el (hypb:eval-as-command): Rename to just `hypb:eval' and remove calling
of command hooks.
@@ -45,8 +75,8 @@
2025-08-03 Bob Weiner <r...@gnu.org>
-* test/hywiki-tests.el (hywiki-test--edit-string-pairs,
- hywiki-test--edit, hywiki-test--interpolate-buffer):
Add
+* test/hywiki-tests.el (hywiki-tests--edit-string-pairs,
+ hywiki-tests--edit, hywiki-tests--interpolate-buffer):
Add
simplified HyWiki string pair ert testing.
* hywiki.el (hywiki-mode): Remove explicit call to
'hywiki-word-set-auto-highlighting'
@@ -1445,7 +1475,7 @@ value to be [[WikiWord]] not
[[file:WikiWord.org][WikiWord]].
* hyrolo.el (hyrolo-expand-path-list): Fix to include a default file name
even when the file does not yet exist.
-* test/hyrolo-tests.el (hyrolo-test--expand-path-list): Expand matching
+* test/hyrolo-tests.el (hyrolo-tests--expand-path-list): Expand matching
filename.
* hyrolo.el (hyrolo-expand-path-list): Use default "~/.rolo.org" when it
@@ -1650,7 +1680,7 @@ value to be [[WikiWord]] not
[[file:WikiWord.org][WikiWord]].
2025-01-20 Mats Lidell <ma...@gnu.org>
-* test/test-helpers-tests.el (test-helpers-test--make-random-wikiword):
+* test/test-helpers-tests.el (test-helpers-tests--make-random-wikiword):
Add test.
* test/MANIFEST: Test file for the test helpers.
@@ -3093,8 +3123,8 @@ value to be [[WikiWord]] not
[[file:WikiWord.org][WikiWord]].
2024-08-05 Mats Lidell <ma...@gnu.org>
-* test/hyrolo-tests.el (hyrolo-test--expand-path-list)
- (hyrolo-test--at-tags-p): Add tests.
+* test/hyrolo-tests.el (hyrolo-tests--expand-path-list)
+ (hyrolo-tests--at-tags-p): Add tests.
2024-07-31 Bob Weiner <r...@gnu.org>
@@ -4018,7 +4048,7 @@ value to be [[WikiWord]] not
[[file:WikiWord.org][WikiWord]].
* .github/workflows/main.yml (jobs): Add Emacs 29.3 to versions used for
the CI builds.
-* test/hyrolo-tests.el (hyrolo-test--grep-count): Verify hyrolo match count.
+* test/hyrolo-tests.el (hyrolo-tests--grep-count): Verify hyrolo match count.
2024-03-31 Bob Weiner <r...@gnu.org>
@@ -4535,8 +4565,8 @@ V9.0.1 changes ^^^^:
* Update copyright date of latest updated version to be 2024 for all files
with copyright string that so far have been updated in git under 2024.
-* test/hsettings-test.el: New test file for hsettings.
- (hsettings-test--hyperbole-web-search): Test hyperbole-web-search.
+* test/hsettings-tests.el: New test file for hsettings.
+ (hsettings-tests--hyperbole-web-search): Test hyperbole-web-search.
* Makefile (package-lint): Add explicit loading of package-lint from Melpa
for this target. Only needed there.
@@ -6180,7 +6210,7 @@ V9.0.1 changes ^^^^:
2023-08-27 Bob Weiner <r...@gnu.org>
-* test/hui-register-tests.el (hui-register-test--register-val-insert-ibut):
Fix this test.
+* test/hui-register-tests.el (hui-register-tests--register-val-insert-ibut):
Fix this test.
* hbut.el (ebut:to): Simplify so if 'lbl-key' is nil, look only for ebutton at
point.
(ibut:to): Simplify so if 'name-key' is nil, look only for ibutton
at point.
@@ -6249,7 +6279,7 @@ V9.0.1 changes ^^^^:
* test/hmouse-drv-tests.el
(hbut-pathname-path-variable-with-three-colons-is-a-path-test):
test/smart-org-tests.el
(smart-org-mode-with-smart-keys-buttons-on-hypb-button-activates)
smart-org-mode-with-smart-keys-on-hypb-button-activates):
- test/hui-register-tests.el (hui-register-test--register-val-insert-ebut):
+ test/hui-register-tests.el (hui-register-tests--register-val-insert-ebut):
test/hypb-tests.el (hypb:installation-type-test): Make work under Windows
where path root
is "c:/".
@@ -8194,10 +8224,10 @@ name with 'name' and 'name-key'.
* 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
+* test/hui-register-tests.el (hui-register-tests--create-register-content)
+ (hui-register-tests--register-val-jump-to)
+ (hui-register-tests--register-val-insert-ebut)
+ (hui-register-tests--register-val-insert-ibut): Add test cases for
hui-register.
* Makefile (EL_COMPILE, ELC_COMPILE): Add hui-register.
diff --git a/hbut.el b/hbut.el
index 029b1617ac..1c7435707d 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: 10-Aug-25 at 11:35:24 by Bob Weiner
+;; Last-Mod: 17-Aug-25 at 00:25:01 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -2027,18 +2027,17 @@ If a new button is created, store its attributes in the
symbol,
(setq ibtype-point (point-marker))
(while (and (not is-type) types)
(setq itype (car types))
- ;; Any implicit button type check should leave point
- ;; unchanged. Trigger an error if not.
- (unless (equal (point-marker) ibtype-point)
- (hypb:error "(Hyperbole): ibtype %s improperly
moved point from %s to %s"
- itype opoint (point)))
(when (condition-case err
(and itype (setq args (funcall itype)))
(error (progn (message "%S: %S" itype err)
- (switch-to-buffer "*Messages*")
;; Show full stack trace
(debug))))
(setq is-type itype))
+ ;; Any implicit button type check should leave point
+ ;; unchanged. Trigger an error if not.
+ (unless (equal ibtype-point (point-marker))
+ (hypb:error "(Hyperbole): ibtype %s improperly
moved point from %s to %s"
+ itype ibtype-point (point-marker)))
(setq types (cdr types))))
(set-marker ibtype-point nil)
(goto-char opoint)))
diff --git a/hib-debbugs.el b/hib-debbugs.el
index 0dec33a9db..073bb5c450 100644
--- a/hib-debbugs.el
+++ b/hib-debbugs.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 21-Jun-16 at 14:24:53
-;; Last-Mod: 4-Jan-25 at 21:57:09 by Bob Weiner
+;; Last-Mod: 16-Aug-25 at 10:01:43 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -193,6 +193,7 @@ used as well in place of `bug'."
(push (cons 'bugs (list (string-to-number id))) attr-pair-list))
(debbugs-gnu-query:list attr-pair-list)))
+;;;###autoload
(defun debbugs-gnu-query:list (query-attribute-list)
"Show the results of a Gnu debbugs query with QUERY-ATTRIBUTE-LIST
attributes.
Each element of the list should be of the form (attribute . attribute-value).
diff --git a/hibtypes.el b/hibtypes.el
index d7db8dbeb3..4ea915c5fc 100644
--- a/hibtypes.el
+++ b/hibtypes.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 19-Sep-91 at 20:45:31
-;; Last-Mod: 10-Aug-25 at 13:20:09 by Bob Weiner
+;; Last-Mod: 17-Aug-25 at 00:28:01 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -1601,7 +1601,7 @@ action type, function symbol to call or test to execute,
i.e.
;; at the end of the buffer
;; or is followed by a space, punctuation or grouping character.
(when (and lbl-key
- (or testing-flag
+ (or testing-flag (hypb:in-string-p)
(and (or (null (char-before start-pos))
(memq (if (char-before start-pos)
(char-syntax (char-before start-pos))
diff --git a/hmouse-drv.el b/hmouse-drv.el
index 1bdba28299..397fd48384 100644
--- a/hmouse-drv.el
+++ b/hmouse-drv.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 04-Feb-90
-;; Last-Mod: 20-Jun-25 at 15:22:16 by Bob Weiner
+;; Last-Mod: 17-Aug-25 at 00:03:53 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -1065,9 +1065,9 @@ Useful in testing Smart Key contexts."
(while (and (null pred-value) (setq hkey-form (car hkey-forms)))
(setq pred (car hkey-form)
pred-value (hypb:eval-debug pred))
- (unless (equal (point-marker) pred-point)
+ (unless (equal pred-point (point-marker))
(hypb:error "(Hyperbole): predicate %s improperly moved point from %s
to %s"
- pred (point) pred-point))
+ pred pred-point (point-marker)))
(if pred-value
(progn
(setq hkey-actions (cdr hkey-form))
diff --git a/hmouse-tag.el b/hmouse-tag.el
index e8ff8a9bf0..4666d7c012 100644
--- a/hmouse-tag.el
+++ b/hmouse-tag.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 24-Aug-91
-;; Last-Mod: 12-Apr-25 at 18:46:48 by Bob Weiner
+;; Last-Mod: 16-Aug-25 at 15:02:58 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -1117,7 +1117,7 @@ When optional NO-FLASH, do not flash."
(defun smart-ancestor-tag-files (&optional dirs name-of-tags-file)
"Walk up DIRS trees looking for NAME-OF-TAGS-FILE.
-DIRS may be a list of directory or a single directory.
+DIRS may be a list of directories or a single directory.
Return a tags table list in DIRS order, where for each directory,
list the found tags tables from furthest to nearest."
(or dirs (setq dirs default-directory))
@@ -1268,7 +1268,7 @@ known Emacs Lisp identifier."
(let ((result (smart-lisp-bound-symbol-def tag-sym)))
(when (cdr result)
tag))))
- ;; This part only works properly for Emacs Lisp, so is
conditionalized.
+ ;; This part works properly for Emacs Lisp only, so is
conditionalized.
((and tag (smart-tags-find-p tag) tag))))))
(defun smart-lisp-bound-symbol-def (tag-sym)
@@ -1296,12 +1296,15 @@ variable or face."
(defun smart-tags-find-p (tag)
"Return non-nil if TAG is found within a tags table, else nil."
(let* ((tags-table-list (smart-entire-tags-table-list))
+ ;; Identifier searches should almost always be case-sensitive today
+ (tags-case-fold-search nil)
(func (smart-tags-noselect-function))
- (tags-file-name (if tags-table-list
- nil
- (and (boundp 'tags-file-name) tags-file-name)))
+ (tags-file-name (unless tags-table-list
+ (when (boundp 'tags-file-name) tags-file-name)))
(tags-add-tables nil))
- (ignore-errors (and func (funcall func tag) t))))
+ (ignore-errors
+ (cond ((and func tags-table-list (funcall func tag) t))
+ ((with-no-warnings (and (hsys-xref-definition tag) t)))))))
(defun smart-java-cross-reference ()
"If within a Java @see comment, edit the def and return non-nil, else nil.
diff --git a/hui-mouse.el b/hui-mouse.el
index b0e1c85a57..f48a3b5e53 100644
--- a/hui-mouse.el
+++ b/hui-mouse.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 04-Feb-89
-;; Last-Mod: 10-Aug-25 at 13:26:31 by Bob Weiner
+;; Last-Mod: 16-Aug-25 at 13:20:13 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -471,7 +471,7 @@ Its default value is `smart-scroll-down'. To disable it,
set it to
(or (setq hkey-value (smart-lisp-at-load-expression-p))
(smart-lisp-at-tag-p)))
;; Tightly limit Lisp matches in change-log-mode but
- ;; only call this if hkey-value is true since
+ ;; call this only if hkey-value is true since
;; otherwise, already know there is no tag at point.
(when hkey-value
(smart-lisp-at-change-log-tag-p))))
diff --git a/hypb.el b/hypb.el
index 7c36ff3fec..b9ecda8a75 100644
--- a/hypb.el
+++ b/hypb.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 6-Oct-91 at 03:42:38
-;; Last-Mod: 10-Aug-25 at 17:35:34 by Bob Weiner
+;; Last-Mod: 16-Aug-25 at 23:58:24 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -498,19 +498,29 @@ the `format' function."
(defun hypb:eval (sexp &rest rest)
"Apply SEXP to REST of arguments and maintain the current buffer."
(let ((buf (current-buffer))
- (cmd (if (listp sexp)
- (cond ((eq 'quote (car sexp))
+ (cmd (cond ((symbolp sexp)
+ sexp)
+ ((listp sexp)
+ (if (eq 'quote (car sexp))
;; Unquote the expression so it is evaluated
- (cadr sexp))
- (t sexp)))))
+ (cadr sexp)
+ sexp)))))
+ (setq last-command this-command
+ this-command (if (and (listp cmd) (symbolp (car cmd)))
+ (car cmd)
+ cmd))
+ (run-hooks 'pre-command-hook)
(unwind-protect
- (if rest
- (apply cmd rest)
- (eval cmd t))
+ (command-execute
+ (lambda () (interactive)
+ (if rest
+ (apply cmd rest)
+ (eval cmd t))))
;; Ensure point remains in the same buffer before and after SEXP
;; evaluation. This prevents false switching to the *ert* test
;; buffer when debugging.
- (set-buffer buf))))
+ (set-buffer buf)
+ (run-hooks 'post-command-hook))))
(defun hypb:eval-debug (sexp)
"Eval SEXP and on error, show a debug backtrace of the problem."
@@ -743,11 +753,12 @@ Quoting conventions recognized are:
;; If this is the start of a string, it must be
;; at the start of line, preceded by whitespace
;; or preceded by another string end sequence.
- (save-match-data
- (or (string-empty-p (match-string 1))
- (string-search (match-string 1) " \t\n\r\f")
- (progn (goto-char (1+ (point)))
- (looking-back close-regexp nil)))))
+ ;; (save-match-data
+ ;; (or (string-empty-p (match-string 1))
+ ;; (string-search (match-string 1) "
\t\n\r\f")
+ ;; (progn (goto-char (1+ (point)))
+ ;; (looking-back close-regexp nil))))
+ )
(forward-line 0)
(setq start (point))
(goto-char opoint)
diff --git a/hywiki.el b/hywiki.el
index c1508f8fb6..342c855831 100644
--- a/hywiki.el
+++ b/hywiki.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 21-Apr-24 at 22:41:13
-;; Last-Mod: 10-Aug-25 at 17:31:00 by Bob Weiner
+;; Last-Mod: 16-Aug-25 at 23:54:09 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -522,10 +522,10 @@ It may be a section or a line number reference. Group
one is the type
of reference and group two is the rest of the suffix reference.")
(defface hywiki--word-face
- '((((min-colors 88) (background dark)) (:foreground "orange"))
- (((background dark)) (:background "orange" :foreground "black"))
- (((min-colors 88)) (:foreground "orange"))
- (t (:background "orange")))
+ '((((min-colors 88) (background dark)) (:foreground "orange" :underline t))
+ (((background dark)) (:background "orange" :foreground "black" :underline
t))
+ (((min-colors 88)) (:foreground "orange" :underline t))
+ (t (:background "orange" :underline t)))
"Face for HyWiki word highlighting."
:group 'hyperbole-hywiki)
@@ -560,6 +560,8 @@ Non-nil is the default."
"Store any HyWikiWord before or after point for later comparison.
Triggered by `pre-command-hook' for non-character -commands, including
deletion commands and those in `hywiki-non-character-commands'."
+ ;; (when ert--running-tests
+ ;; (message "Running pre-command-hook..."))
(setq hywiki--buffer-modified-tick (buffer-modified-tick)
hywiki--word-pre-command nil)
@@ -588,15 +590,71 @@ deletion commands and those in
`hywiki-non-character-commands'."
(set-marker hywiki--buttonize-end end)
start))))
+(defun hywiki-buttonize-character-commands ()
+ "Turn any HyWikiWords around point into highlighted Hyperbole buttons.
+Triggered by `post-self-insert-hook' after self-inserting one or
+more characters while the command is still executing. The
+`post-command-hook' runs later after the command has finished."
+ ;; (when ert--running-tests
+ ;; (message "Running post-self-insert-hook..."))
+ (unless (hywiki-non-hook-context-p)
+ (setq hywiki--range nil)
+
+ ;; Dehighlight any previously highlighted WikiWord at point
+ ;; before we move to the start of any current WikiWord and
+ ;; rehighlight that.
+ (hywiki--maybe-dehighlight-at-point)
+
+ (save-excursion
+ (cond ((marker-position hywiki--buttonize-start)
+ ;; Point was before or after a WikiWord delimiter
+ (goto-char hywiki--buttonize-start)
+ (skip-chars-backward "-" (line-beginning-position))
+ (goto-char (1- (point))))
+ ((not (equal (setq hywiki--range (hywiki-highlight-word-get-range))
+ '(nil nil nil)))
+ (cl-destructuring-bind (_ start end)
+ hywiki--range
+ (if (and start end)
+ (progn
+ ;; On a non-delimited HyWikiWord
+ (set-marker hywiki--buttonize-start start)
+ (set-marker hywiki--buttonize-end end)
+ (goto-char start)
+ (skip-chars-backward "-" (line-beginning-position))
+ t)
+ (setq hywiki--range nil))))
+ ((not (member (setq hywiki--range (hywiki-at-range-delimiter))
+ '(nil nil)))
+ ;; At delimiters surrounding a WikiWord
+ (let ((start (nth 0 hywiki--range))
+ (end (nth 1 hywiki--range)))
+ (when (and start end)
+ ;; Use these to store any range of a delimited
HyWikiWord#section
+ (set-marker hywiki--buttonize-start (1+ start))
+ (set-marker hywiki--buttonize-end (1- end))))))
+
+ ;; This first rehighlighting is needed to ensure
+ ;; any wikiword before an inserted whitespace character is
+ ;; properly highlighted when separating two words or after a
+ ;; closing delimiter.
+ (save-excursion
+ (goto-char (max (1- (point)) (point-min)))
+ (hywiki--maybe-rehighlight-at-point))
+
+ (hywiki--maybe-rehighlight-at-point))))
+
(defun hywiki-buttonize-non-character-commands ()
"Highlight any HyWikiWord before or after point as a Hyperbole button.
Triggered by `post-command-hook' for non-character-commands, including
deletion commands and those in `hywiki-non-character-commands'."
+ ;; (when ert--running-tests
+ ;; (message "Running post-command-hook..."))
(unless (or (eq hywiki--buffer-modified-tick (buffer-modified-tick))
(hywiki-non-hook-context-p))
(setq hywiki--range nil)
(cond ((and (symbolp this-command)
- (string-match-p
"^insert$\\|-insert-?\\|eval-last-sexp\\|eval-expression\\|read--expression-try-read"
+ (string-match-p
"^insert\\(-\\|$\\)\\|-insert-?\\|eval-last-sexp\\|eval-expression\\|read--expression-try-read"
(symbol-name this-command)))
(setq hywiki--end (point))
(when (and hywiki--start (not (eq hywiki--start hywiki--end)))
@@ -653,57 +711,6 @@ deletion commands and those in
`hywiki-non-character-commands'."
(hywiki--maybe-rehighlight-at-point)))))))
-(defun hywiki-buttonize-character-commands ()
- "Turn any HyWikiWords around point into highlighted Hyperbole buttons.
-Triggered by `post-self-insert-hook' after self-inserting one or more
-characters after `post-command-hook' has run."
- (unless (hywiki-non-hook-context-p)
- (setq hywiki--range nil)
-
- ;; Dehighlight any previously highlighted WikiWord at point
- ;; before we move to the start of any current WikiWord and
- ;; rehighlight that.
- (hywiki--maybe-dehighlight-at-point)
-
- (save-excursion
- (cond ((marker-position hywiki--buttonize-start)
- ;; Point was before or after a WikiWord delimiter
- (goto-char hywiki--buttonize-start)
- (skip-chars-backward "-" (line-beginning-position))
- (goto-char (1- (point))))
- ((not (equal (setq hywiki--range (hywiki-highlight-word-get-range))
- '(nil nil nil)))
- (cl-destructuring-bind (_ start end)
- hywiki--range
- (if (and start end)
- (progn
- ;; On a non-delimited HyWikiWord
- (set-marker hywiki--buttonize-start start)
- (set-marker hywiki--buttonize-end end)
- (goto-char start)
- (skip-chars-backward "-" (line-beginning-position))
- t)
- (setq hywiki--range nil))))
- ((not (member (setq hywiki--range (hywiki-at-range-delimiter))
- '(nil nil)))
- ;; At delimiters surrounding a WikiWord
- (let ((start (nth 0 hywiki--range))
- (end (nth 1 hywiki--range)))
- (when (and start end)
- ;; Use these to store any range of a delimited
HyWikiWord#section
- (set-marker hywiki--buttonize-start (1+ start))
- (set-marker hywiki--buttonize-end (1- end))))))
-
- ;; This first rehighlighting is needed to ensure
- ;; any wikiword before an inserted whitespace character is
- ;; properly highlighted when separating two words or after a
- ;; closing delimiter.
- (save-excursion
- (goto-char (max (1- (point)) (point-min)))
- (hywiki--maybe-rehighlight-at-point))
-
- (hywiki--maybe-rehighlight-at-point))))
-
(defun hywiki-buttonize-word (func start end face)
"Create a HyWikiWord button by calling FUNC with START and END positions.
Function may apply FACE to highlight the button or may transform it
@@ -2695,8 +2702,8 @@ save and potentially set `hywiki--directory-mod-time' and
(when (or (not (stringp save-file)) (equal save-file ""))
(setq save-file (hywiki-cache-default-file)))
(setq save-file (expand-file-name save-file hywiki-directory))
- (or (file-writable-p save-file)
- (error "(hywiki-cache-save): Non-writable Environment file, \"%s\""
save-file))
+ (unless (file-writable-p save-file)
+ (error "(hywiki-cache-save): Non-writable Environment file, \"%s\""
save-file))
(let ((buf (get-file-buffer save-file)))
(when buf
(if (buffer-modified-p buf)
@@ -2705,8 +2712,8 @@ save and potentially set `hywiki--directory-mod-time' and
(kill-buffer buf))))
(let ((dir (or (file-name-directory save-file)
default-directory)))
- (or (file-writable-p dir)
- (error "(hywiki-cache-save): Non-writable Environment directory,
\"%s\"" dir)))
+ (unless (file-writable-p dir)
+ (error "(hywiki-cache-save): Non-writable Environment directory, \"%s\""
dir)))
(save-window-excursion
(let ((standard-output (hywiki-cache-edit save-file)))
(with-current-buffer standard-output
@@ -3321,6 +3328,22 @@ non-nil or this will return nil."
(hproperty:but-add start end hywiki-word-face))
(list wikiword start end)))
+(defun hywiki-highlight-word-move-range ()
+ "Ensure wikiword highlighting range matches expected range.
+Return t if the highlighted range exists at point and gets moved."
+ (let* ((but (hproperty:but-get (point) 'face hywiki-word-face))
+ (but-start (when but (hproperty:but-start but)))
+ (but-end (when but (hproperty:but-end but))))
+ (when (and but-start but-end)
+ (save-excursion
+ (goto-char but-start)
+ (cl-destructuring-bind (wikiword start end)
+ (hywiki-word-at :range)
+ (when (and wikiword start end but-start but-end
+ (or (/= start but-start) (/= end but-end)))
+ (hproperty:but-move but start end)
+ t))))))
+
(defun hywiki-word-at-point ()
"Return singular HyWikiWord at point with its suffix stripped or nil.
Point should be on the HyWikiWord itself. Suffix is anything after
@@ -3515,15 +3538,17 @@ Used to extend a region to fully include any strings or
balanced pair delimiters
(let ((maximum (max start end)))
(setq start (min start end)
end (max end maximum)))
- (let ((result (list start end)))
+ (let ((result (list start end))
+ (in-string-flag (hypb:in-string-p)))
;; Skip past all double-quoted ranges and extend `start' and `end' as
needed
(save-excursion
(goto-char start)
(condition-case nil
(while (and (<= (point) end)
- (skip-syntax-forward "^\"" end)
- (not (zerop (skip-syntax-forward "\"" end)))
+ (skip-syntax-forward "^\"" (unless in-string-flag end))
+ (not (zerop (skip-syntax-forward
+ "\"" (unless in-string-flag end))))
(= ?\" (char-syntax (preceding-char))))
(when (or (= (1- (point)) (point-min))
(/= ?\\ (char-before (1- (point)))))
@@ -3541,8 +3566,8 @@ Used to extend a region to fully include any strings or
balanced pair delimiters
(goto-char start)
(condition-case nil
(while (and (<= (point) end)
- (skip-syntax-forward "^\)" end)
- (not (zerop (skip-syntax-forward "\)" end)))
+ (skip-syntax-forward "^\)")
+ (not (zerop (skip-syntax-forward "\)")))
(= ?\) (char-syntax (preceding-char))))
(when (or (= (1- (point)) (point-min))
(/= ?\\ (char-before (1- (point)))))
@@ -3557,8 +3582,8 @@ Used to extend a region to fully include any strings or
balanced pair delimiters
(goto-char end)
(condition-case nil
(while (and (>= (point) start)
- (skip-syntax-backward "^\(" start)
- (not (zerop (skip-syntax-backward "\(" start)))
+ (skip-syntax-backward "^\(")
+ (not (zerop (skip-syntax-backward "\(")))
(= ?\( (char-syntax (following-char))))
(when (not (eq ?\\ (char-before (max (point) (point-min)))))
(save-excursion
@@ -3569,12 +3594,17 @@ Used to extend a region to fully include any strings or
balanced pair delimiters
;; Skip past any current word at start and end to extend if needed
(save-excursion
(goto-char start)
+ (skip-chars-forward " \t\n\r")
(skip-syntax-backward "w")
(setq start (point))
(goto-char end)
- (skip-syntax-forward "w")
- (setq end (point)
- result (list start end)))
+ (setq result (nth 2 (hywiki-delimited-p))
+ end (or result end))
+ (unless result
+ (skip-chars-backward " \t\n\r")
+ (skip-syntax-forward "w")
+ (setq end (point)))
+ (setq result (list start end)))
result))
(defun hywiki--get-all-references (function &optional start end)
diff --git a/test/MANIFEST b/test/MANIFEST
index 80854f59d0..042808d613 100644
--- a/test/MANIFEST
+++ b/test/MANIFEST
@@ -10,7 +10,7 @@ hibtypes-tests.el - unit test for hib-kbd
hmouse-drv-tests.el - hmouse-drv unit tests
hmouse-info-tests.el - hmouse-info unit tests
hpath-tests.el - unit tests for hpath
-hsettings-test.el - unit tests for hsettings
+hsettings-tests.el - unit tests for hsettings
hsys-org-tests.el - hsys-org tests
hui-mini-tests.el - hui-mini tests
hui-mouse-tests.el - hui-mouse and hkey-alist Action Key tests
diff --git a/test/hsettings-test.el b/test/hsettings-tests.el
similarity index 82%
rename from test/hsettings-test.el
rename to test/hsettings-tests.el
index 5e8a83c781..0963993f2b 100644
--- a/test/hsettings-test.el
+++ b/test/hsettings-tests.el
@@ -1,9 +1,9 @@
-;;; hsettings-test.el --- one line summary -*- lexical-binding:
t; -*-
+;;; hsettings-tests.el --- one line summary -*-
lexical-binding: t; -*-
;;
;; Author: Mats Lidell
;;
;; Orig-Date: 20-Jan-24 at 12:28:01
-;; Last-Mod: 12-Mar-24 at 22:59:00 by Mats Lidell
+;; Last-Mod: 16-Aug-25 at 15:34:14 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -21,7 +21,7 @@
(require 'el-mock)
(require 'hsettings)
-(ert-deftest hsettings-test--hyperbole-web-search ()
+(ert-deftest hsettings-tests--hyperbole-web-search ()
"Verify `hyperbole-web-search´."
(mocklet (((browse-url "http://www.google.com/search?q=hyperbole";) =>
"return"))
(should (string= (hyperbole-web-search "google" "hyperbole" nil)
"return")))
@@ -35,7 +35,7 @@
(should (string= (hyperbole-web-search "Jump" "arg" nil) "return")))
(should (equal (hyperbole-web-search "Jump" "arg" t) '(webjump))))
-(provide 'hsettings-test)
+(provide 'hsettings-tests)
;; This file can't be byte-compiled without the `el-mock' package
;; which is not a dependency of Hyperbole.
@@ -44,4 +44,4 @@
;; no-byte-compile: t
;; End:
-;;; hsettings-test.el ends here
+;;; hsettings-tests.el ends here
diff --git a/test/hui-register-tests.el b/test/hui-register-tests.el
index 45f1363423..3ae8a4fc74 100644
--- a/test/hui-register-tests.el
+++ b/test/hui-register-tests.el
@@ -3,7 +3,7 @@
;; Author: Mats Lidell <ma...@gnu.org>
;;
;; Orig-Date: 10-Sep-22 at 20:43:17
-;; Last-Mod: 22-Feb-24 at 00:00:12 by Mats Lidell
+;; Last-Mod: 16-Aug-25 at 15:36:47 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -22,7 +22,7 @@
(require 'hui-register)
(require 'hy-test-helpers "test/hy-test-helpers")
-(ert-deftest hui-register-test--create-register-content ()
+(ert-deftest hui-register-tests--create-register-content ()
"Verify the struct contains its parts."
(let ((file (make-temp-file "hypb")))
(unwind-protect
@@ -38,7 +38,7 @@
(should (equal (hui-register-but-file content)
(hypb:buffer-file-name)))))
(hy-delete-file-and-buffer file))))
-(ert-deftest hui-register-test--register-val-jump-to ()
+(ert-deftest hui-register-tests--register-val-jump-to ()
"Verify register val jumps to right file."
(let ((file (make-temp-file "hypb")))
(unwind-protect
@@ -55,7 +55,7 @@
(should (equal pos (point)))))
(hy-delete-file-and-buffer file))))
-(ert-deftest hui-register-test--register-val-insert-ibut ()
+(ert-deftest hui-register-tests--register-val-insert-ibut ()
"Verify register val inserts ibut."
(let ((file1 (make-temp-file "hypb"))
(file2 (make-temp-file "hypb")))
@@ -78,7 +78,7 @@
(hy-delete-file-and-buffer file1)
(hy-delete-file-and-buffer file2))))
-(ert-deftest hui-register-test--register-val-insert-ebut ()
+(ert-deftest hui-register-tests--register-val-insert-ebut ()
"Verify register val inserts link to ebut."
(let ((file1 (make-temp-file "hypb"))
(file2 (make-temp-file "hypb")))
diff --git a/test/hy-test-helpers.el b/test/hy-test-helpers.el
index 556f03e00f..f482d14917 100644
--- a/test/hy-test-helpers.el
+++ b/test/hy-test-helpers.el
@@ -3,7 +3,7 @@
;; Author: Mats Lidell <ma...@gnu.org>
;;
;; Orig-Date: 30-Jan-21 at 12:00:00
-;; Last-Mod: 10-Aug-25 at 09:50:52 by Bob Weiner
+;; Last-Mod: 17-Aug-25 at 10:12:52 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -47,33 +47,6 @@ processing."
(vertico-mode 1))
(ert-simulate-keys ,keys ,@body)))
-(defun hy-test-helpers:eval-as-command (sexp &rest rest)
- "Apply SEXP to REST of arguments as a command.
-Run pre, post and post-self-insert-hook (on insert).
-This is for simulating the command loop."
- (run-hooks 'pre-command-hook)
- (let ((buf (current-buffer))
- (cmd (cond ((symbolp sexp)
- sexp)
- ((listp sexp)
- (when (symbolp (car sexp))
- (car sexp))))))
- (unwind-protect
- (command-execute
- (lambda () (interactive)
- (if rest
- (apply sexp rest)
- (eval sexp t))))
- ;; Ensure point remains in the same buffer before and after SEXP
- ;; evaluation. This prevents false switching to the *ert* test
- ;; buffer when debugging.
- (set-buffer buf)
- (run-hooks 'post-command-hook)
- ;; (when (string-match-p "^insert$\\|-insert-?" (symbol-name cmd))
- (run-hooks 'post-self-insert-hook)
- ;; )
- )))
-
(defun hy-test-helpers:should-last-message (msg captured)
"Verify MSG is in CAPTURED text."
(should (string-search msg captured)))
@@ -121,7 +94,11 @@ Checks ACTYPE, ARGS, LOC, LBL-KEY and NAME."
(let ((buf (find-buffer-visiting file)))
(when buf
(with-current-buffer buf
- (set-buffer-modified-p nil)
+ (when (buffer-modified-p)
+ (save-buffer)
+ ;; If the save failed, ensure it shows non-modified before
+ ;; trying to kill it.
+ (set-buffer-modified-p nil))
(kill-buffer))))
(delete-file file))
diff --git a/test/hyrolo-tests.el b/test/hyrolo-tests.el
index 61676cff29..3893c4b291 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: 16-Jun-25 at 22:03:21 by Bob Weiner
+;; Last-Mod: 16-Aug-25 at 15:30:03 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -1653,7 +1653,7 @@ body
(kill-buffer hyrolo-display-buffer)
(hy-delete-files-and-buffers hyrolo-file-list))))
-(ert-deftest hyrolo-test--grep-count ()
+(ert-deftest hyrolo-tests--grep-count ()
"Verify number of matched entries are correct."
(unwind-protect
(with-temp-buffer
@@ -1678,7 +1678,7 @@ match
(kill-buffer hyrolo-display-buffer)
(ert-fail "Buffer %s should not have been created"
hyrolo-display-buffer))))
-(ert-deftest hyrolo-test--expand-path-list ()
+(ert-deftest hyrolo-tests--expand-path-list ()
"Verify `hyrolo-expand-path-list'."
(should (equal (hyrolo-expand-path-list nil)
(list (expand-file-name "~/.rolo.otl"))))
@@ -1697,7 +1697,7 @@ match
=> (list "/file1")))
(should (equal (hyrolo-expand-path-list '("/file1")) '("/file1"))))))
-(ert-deftest hyrolo-test--at-tags-p ()
+(ert-deftest hyrolo-tests--at-tags-p ()
"Verify `hyrolo-at-tags-p´."
(let ((orig-buffer-name (symbol-function 'buffer-name)))
(cl-letf (((symbol-function 'buffer-name)
diff --git a/test/hywiki-tests.el b/test/hywiki-tests.el
index 614a7b2649..cba11dd39d 100644
--- a/test/hywiki-tests.el
+++ b/test/hywiki-tests.el
@@ -3,7 +3,7 @@
;; Author: Mats Lidell
;;
;; Orig-Date: 18-May-24 at 23:59:48
-;; Last-Mod: 10-Aug-25 at 18:08:30 by Bob Weiner
+;; Last-Mod: 17-Aug-25 at 10:00:33 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -26,8 +26,13 @@
(require 'ox-publish)
(require 'seq) ;; for `seq-take-while' and `seq-uniq'
-(defconst hywiki-test--edit-string-pairs
+(defconst hywiki-tests--edit-string-pairs
[
+ ("HiHo#s<insert-char ? >" "{HiHo#s} ")
+ ("Hi#a<insert-char ?b> cd" "{Hi#ab} cd")
+ ("Hi" "{Hi}")
+ ("HyWikiWord" "{HyWikiWord}")
+ ("HiHo#s " "{HiHo#s} ")
("HyWikiW<kill-word 1>ord<yank 1> HyW<kill-word 1>ikiWord<yank
1><search-backward \" \">"
"{HyWikiWord} {HyWikiWord}")
("HyWiki<delete-region>Word" "{HyWikiWord}")
@@ -45,8 +50,8 @@
"Vector of (pre-test-str-with-edit-cmds post-test-str-result
[test-name-str] [doc-str]) elements.
Last two elements are optional.")
-(ert-deftest hywiki-test--edit ()
- (let ((edit-string-pairs hywiki-test--edit-string-pairs)
+(ert-deftest hywiki-tests--edit ()
+ (let ((edit-string-pairs hywiki-tests--edit-string-pairs)
(hywiki-directory (make-temp-file "hywiki" t))
(test-num 0)
before
@@ -60,60 +65,111 @@ Last two elements are optional.")
start
end
hywiki-ref-positions)
- (with-temp-buffer
- (hywiki-tests--preserve-hywiki-mode
- (org-mode)
- (hywiki-mode 1)
- (mapc
- (lambda (before-after)
- (setq before (nth 0 before-after)
- after (nth 1 before-after)
- name (nth 2 before-after)
- doc (nth 3 before-after))
- ;;
- ;; (seq-take-while (lambda (seq) (when (string-match "{\\([^\}]+\\)}"
seq) (match-string 1 seq))))
- ;; '("a {Wiki} {Non2} {Non#extra text}"))
- ;; Markup before string in temp buffer
- (erase-buffer)
- (insert before)
- (hywiki-test--interpolate-buffer)
- ;; Surround any HyWikiWord refs with braces to match after string.
- ;; Do it in reverse order so do not affect the already
- ;; computed buffer positions.
- (setq hywiki-ref-positions (nreverse (hywiki-get-reference-positions)))
- (dolist (start-end hywiki-ref-positions)
- (setq start (car start-end)
- end (cdr start-end))
- (goto-char end)
- (insert "}")
- (goto-char start)
- (insert "{"))
- ;; Store the buffer string for comparison
- (setq markedup-before (string-trim (buffer-string)))
- ;; Markup after string
- (erase-buffer)
- (insert after)
- (hywiki-test--interpolate-buffer)
- (setq markedup-after (string-trim (buffer-string)))
- ;; Compare markedup-before to markedup-after
- (if (or name doc)
- (should (equal (list :markedup markedup-before
- :test-num test-num :test-name name :doc doc
- :before before :after after)
- (list :markedup markedup-after
- :test-num test-num :test-name name :doc doc
- :before before :after after)))
- (should (equal (list :markedup markedup-before
- :test-num test-num
- :before before :after after)
- (list :markedup markedup-after
- :test-num test-num
- :before before :after after))))
- (cl-incf test-num))
- edit-string-pairs))
- (goto-char (point-min)))))
-
-(defun hywiki-test--interpolate-buffer ()
+ (with-temp-buffer
+ (hywiki-tests--preserve-hywiki-mode
+ (org-mode)
+ (hywiki-mode 1)
+ (mapc
+ (lambda (before-after)
+ (condition-case err
+ (progn
+ (setq before (nth 0 before-after)
+ after (nth 1 before-after)
+ name (nth 2 before-after)
+ doc (nth 3 before-after))
+ ;; Ensure all brace delimited HyWikiWords have their pages
+ ;; created so their references will be highlighted.
+ (mapc #'hywiki-add-page
+ (delq nil
+ (mapcar #'hywiki-get-singular-wikiword
+ (seq-remove #'string-empty-p
+ (mapcar #'string-trim
+
(hywiki-tests--get-brace-strings after))))))
+ (unwind-protect
+ (progn
+ (pop-to-buffer (current-buffer))
+ (erase-buffer)
+ (hywiki-tests--insert-by-char before)
+ (hywiki-tests--interpolate-buffer)
+ ;; Markup before string in temp buffer
+ ;; Surround any HyWikiWord refs with braces to match
after string.
+ ;; Do it in reverse order so do not affect the already
+ ;; computed buffer positions.
+ (setq hywiki-ref-positions (nreverse
(hywiki-get-reference-positions)))
+ (dolist (start-end hywiki-ref-positions)
+ (setq start (car start-end)
+ end (cdr start-end))
+ (goto-char end)
+ (insert "}")
+ (goto-char start)
+ (insert "{"))
+ ;; Store the buffer string for comparison
+ (setq markedup-before (string-trim (buffer-string)))
+ ;; Markup after string
+ (erase-buffer)
+ (insert after)
+ (hywiki-tests--interpolate-buffer)
+ (setq markedup-after (string-trim (buffer-string)))
+ ;; Compare markedup-before to markedup-after
+ (if (or name doc)
+ (should (equal (list :markedup markedup-before
+ :test-num test-num :test-name
name :doc doc
+ :before before :after after)
+ (list :markedup markedup-after
+ :test-num test-num :test-name
name :doc doc
+ :before before :after after)))
+ (should (equal (list :markedup markedup-before
+ :test-num test-num
+ :before before :after after)
+ (list :markedup markedup-after
+ :test-num test-num
+ :before before :after after))))
+ (cl-incf test-num))
+ (goto-char (point-min))))
+ (error (error "%s ---- %S" err (list :markedup markedup-before
+ :test-num test-num
+ :before before :after after)))))
+ hywiki-tests--edit-string-pairs)))))
+
+(defun hywiki-tests--get-brace-strings (s)
+ "Return the substrings in S delimited by curly braces {…}, excluding braces.
+Assume no nesting of braces, nor any quoting of braces."
+ (let ((pos 0)
+ (result '()))
+ (while (string-match "{\\([^}]*\\)}" s pos)
+ (push (match-string 1 s) result)
+ (setq pos (match-end 0)))
+ (nreverse result)))
+
+(defun hywiki-tests--insert-by-char (str)
+ "Interactively insert the characters from STR."
+ (interactive "sInsert string: ")
+ (mapc (lambda (c)
+ (setq unread-command-events (nconc unread-command-events
+ (listify-key-sequence
+ (char-to-string c)))))
+ str)
+ (hywiki-tests--execute-commands))
+
+(defun hywiki-tests--execute-commands ()
+ "Process all events from `unread-command-events'."
+ (interactive)
+ (while unread-command-events
+ (let ((event (pop unread-command-events)))
+ ;; Execute this event as if typed
+ (setq this-command (key-binding (vector event) t)
+ last-command-event event)
+ ;; (message "Event = %s; last-command-event = %s; cmd = %s"
+ ;; event last-command-event this-command)
+ (when this-command
+ (run-hooks 'pre-command-hook)
+ ;; `command-execute' runs only `post-self-insert-hook' since
+ ;; this is run during the command; pre- and post-command hooks
+ ;; must be manually run.
+ (command-execute this-command)
+ (run-hooks 'post-command-hook)))))
+
+(defun hywiki-tests--interpolate-buffer ()
"Replace action buttons and Hyperbole variable markup in buffer."
(let ((str (buffer-string)))
;; Replace env and lisp variable references
@@ -128,22 +184,33 @@ Last two elements are optional.")
;; Force HyWikiWord highlighting
;; (setq last-command this-command)
;; (setq this-command sexp)
- (hy-test-helpers:eval-as-command
- 'hbut:act 'hbut:current)))
- ;; Highlight all HyWikiWord references in buffer
- ;; (hywiki-highlight-page)
- ))
-
-(defun hywiki-tests--command-execute (cmd &rest rest)
- "Run CMD, with optional REST params, between calls to pre and post hooks.
+ (hywiki-tests--command-execute
+ 'hbut:act 'hbut:current)))))
+
+(defun hywiki-tests--command-execute (sexp &rest rest)
+ "Apply SEXP to REST of arguments as a command.
+Run pre and post command hooks around the call.
This is for simulating the command loop."
- (setq last-command this-command)
- (setq this-command cmd)
- (run-hooks 'pre-command-hook)
- (if rest
- (apply cmd rest)
- (command-execute cmd))
- (run-hooks 'post-command-hook))
+ (let ((buf (current-buffer))
+ (cmd (cond ((symbolp sexp)
+ sexp)
+ ((listp sexp)
+ (when (symbolp (car sexp))
+ (car sexp))))))
+ (setq last-command this-command
+ this-command cmd)
+ (run-hooks 'pre-command-hook)
+ (unwind-protect
+ (command-execute
+ (lambda () (interactive)
+ (if rest
+ (apply sexp rest)
+ (eval sexp t))))
+ ;; Ensure point remains in the same buffer before and after SEXP
+ ;; evaluation. This prevents false switching to the *ert* test
+ ;; buffer when debugging.
+ (set-buffer buf)
+ (run-hooks 'post-command-hook))))
(defmacro hywiki-tests--preserve-hywiki-mode (&rest body)
"Restore hywiki-mode after running BODY."
@@ -1149,32 +1216,35 @@ Note special meaning of `hywiki-allow-plurals-flag'."
(hywiki-get-referent wikiword))))
(hy-delete-dir-and-buffer hywiki-directory))))
-(defmacro hywiki-tests--referent-test (expected &rest prepare)
- "Referent test boilerplate code.
-EXPECTED is the result expected from hywiki-get-referent. PREPARE sets
-up the test."
+(defmacro hywiki-tests--referent-test (expected-referent &rest prepare)
+ "Template macro for generated a non-page HyWikiWord referent.
+EXPECTED-REFERENT is the result expected from `hywiki-get-referent'.
+The template creates the HyWikiWord named WikiPage with a page referent.
+The rest of arguments, PREPARE, must create a HyWikiWord named WikiReferent
+with a non-page referent type."
(declare (indent 0) (debug t))
`(let* ((hsys-consult-flag nil)
(hywiki-directory (make-temp-file "hywiki" t))
- (wiki-referent "WikiReferent")
- (wiki-page (cdr (hywiki-add-page "WikiPage" )))
+ (wiki-word-non-page "WikiReferent")
+ (wiki-word-with-page "WikiPage")
+ (wiki-page (cdr (hywiki-add-page wiki-word-with-page)))
(mode-require-final-newline nil)
wiki-page-buffer)
(unwind-protect
(save-excursion
- ;; (should (equal '("WikiPage") (hywiki-get-wikiword-list)))
+ (should (equal (list wiki-word-with-page)
(hywiki-get-wikiword-list)))
(setq wiki-page-buffer (find-file wiki-page))
(erase-buffer)
- (insert wiki-referent)
+ (insert wiki-word-non-page)
(save-buffer)
(goto-char 4)
,@prepare
- (should (equal ,expected (hywiki-get-referent wiki-referent)))
- (should (file-exists-p (hywiki-cache-default-file)))
(set-buffer wiki-page-buffer)
- (should (string= wiki-referent (buffer-substring-no-properties
+ (should (file-exists-p (hywiki-cache-default-file)))
+ (should (equal ,expected-referent (hywiki-get-referent
wiki-word-non-page)))
+ (should (string= wiki-word-non-page (buffer-substring-no-properties
(point-min) (point-max))))
;; Simulate reload from cache
@@ -1182,7 +1252,7 @@ up the test."
(setq hywiki--referent-hasht nil)
(hywiki-make-referent-hasht)
- (should (equal ,expected (hywiki-get-referent wiki-referent))))
+ (should (equal ,expected-referent (hywiki-get-referent
wiki-word-non-page))))
(hy-delete-files-and-buffers (list wiki-page
(hywiki-cache-default-file)))
(hy-delete-dir-and-buffer hywiki-directory))))
@@ -1192,14 +1262,14 @@ up the test."
(hywiki-tests--referent-test
(cons 'key-series "{ABC}")
(hy-test-helpers:ert-simulate-keys "ABC\r"
- (hywiki-add-key-series wiki-referent))))
+ (hywiki-add-key-series wiki-word-non-page))))
(ert-deftest hywiki-tests--save-referent-keyseries-use-menu ()
"Verify saving and loading a referent keyseries works using Hyperbole's
menu."
; The failure is intermittent. See expanded test case below.
(skip-unless (not noninteractive))
`(let* ((hywiki-directory (make-temp-file "hywiki" t))
- (wiki-page (cdr (hywiki-add-page "WikiPage" )))
+ (wiki-page (cdr (hywiki-add-page "WikiPage")))
(mode-require-final-newline nil)
wiki-page-buffer)
(unwind-protect
@@ -1223,9 +1293,9 @@ up the test."
(ert-deftest hywiki-tests--save-referent-bookmark ()
"Verify saving and loading a referent bookmark works."
(hywiki-tests--referent-test
- (cons 'bookmark wiki-referent)
- (hy-test-helpers:ert-simulate-keys (concat wiki-referent "\r")
- (hywiki-add-bookmark wiki-referent))))
+ (cons 'bookmark wiki-word-non-page)
+ (hy-test-helpers:ert-simulate-keys (concat wiki-word-non-page "\r")
+ (hywiki-add-bookmark wiki-word-non-page))))
;; Command
(defun hywiki-tests--command (wikiword)
@@ -1238,14 +1308,14 @@ up the test."
(hywiki-tests--referent-test
(cons 'command #'hywiki-tests--command)
(hy-test-helpers:ert-simulate-keys "hywiki-tests--command\r"
- (hywiki-add-command wiki-referent))))
+ (hywiki-add-command wiki-word-non-page))))
(ert-deftest hywiki-tests--save-referent-command-use-menu ()
"Verify saving and loading a referent command works using Hyperbole's menu.."
(skip-unless (not noninteractive))
(hywiki-tests--referent-test
(cons 'command #'hywiki-tests--command)
- (should (hact 'kbd-key "C-u C-h hhcc hywiki-tests--command RET"))
+ (should (hact 'kbd-key "C-u C-h hhc WikiReferent RET c
hywiki-tests--command RET"))
(hy-test-helpers:consume-input-events)))
;; Find
@@ -1253,7 +1323,7 @@ up the test."
"Verify saving and loading a referent find works."
(hywiki-tests--referent-test
(cons 'find #'hywiki-word-grep)
- (hywiki-add-find wiki-referent)))
+ (hywiki-add-find wiki-word-non-page)))
(ert-deftest hywiki-tests--save-referent-find-use-menu ()
"Verify saving and loading a referent find works using Hyperbole's menu.."
@@ -1262,7 +1332,7 @@ up the test."
(hywiki-tests--referent-test
(cons 'find #'hywiki-word-grep)
(hy-test-helpers:ert-simulate-keys
- "C-u C-h hhc WikiReferent RET f"
+ "C-u C-h hhc WikiReferent RET f hywikiword RET"
(hy-test-helpers:consume-input-events))))
;; Global-button
@@ -1271,7 +1341,7 @@ up the test."
(hywiki-tests--referent-test
(cons 'global-button "gbtn")
(mocklet ((hargs:read-match => "gbtn"))
- (hywiki-add-global-button wiki-referent))))
+ (hywiki-add-global-button wiki-word-non-page))))
(ert-deftest hywiki-tests--save-referent-global-button-use-menu ()
"Verify saving and loading a referent global-button works using Hyperbole's
menu."
@@ -1288,7 +1358,7 @@ up the test."
(stub gbut:label-list => (list "global"))
(mock (gbut:act "global") => t)
(gbut:ebut-program "global" 'link-to-file test-file)
- (should (hact 'kbd-key "C-u C-h hhcg global RET"))
+ (should (hact 'kbd-key "C-u C-h hhc WikiReferent RET g global RET"))
(hy-test-helpers:consume-input-events))
(hy-delete-file-and-buffer test-file)))))
@@ -1297,7 +1367,7 @@ up the test."
"Verify saving and loading a referent hyrolo works."
(hywiki-tests--referent-test
(cons 'hyrolo #'hyrolo-fgrep)
- (hywiki-add-hyrolo wiki-referent)))
+ (hywiki-add-hyrolo wiki-word-non-page)))
;; Info index
(ert-deftest hywiki-tests--save-referent-info-index ()
@@ -1307,7 +1377,7 @@ up the test."
(save-excursion
(hy-test-helpers:ert-simulate-keys "files\r"
(info "emacs")
- (hywiki-add-info-index wiki-referent)))))
+ (hywiki-add-info-index wiki-word-non-page)))))
(ert-deftest hywiki-tests--save-referent-info-index-use-menu ()
"Verify saving and loading a referent info index works using Hyperbole's
menu."
@@ -1317,7 +1387,7 @@ up the test."
(save-excursion
(unwind-protect
(progn
- (should (hact 'kbd-key "C-u C-h hhci (emacs)files RET"))
+ (should (hact 'kbd-key "C-u C-h hhc WikiReferent RET i
(emacs)files RET"))
(hy-test-helpers:consume-input-events))
(kill-buffer "*info*")))))
@@ -1329,7 +1399,7 @@ up the test."
(save-excursion
(unwind-protect
(hy-test-helpers:ert-simulate-keys "(emacs)\r"
- (hywiki-add-info-node wiki-referent))
+ (hywiki-add-info-node wiki-word-non-page))
(kill-buffer "*info*")))))
(ert-deftest hywiki-tests--save-referent-info-node-use-menu ()
@@ -1340,8 +1410,7 @@ up the test."
(save-excursion
(unwind-protect
(progn
- ;; (should (hact 'kbd-key "C-u C-h hhc MyWiki RET n (emacs) RET"))
- (should (hact 'kbd-key "C-u C-h hhcn (emacs) RET"))
+ (should (hact 'kbd-key "C-u C-h hhc WikiReferent RET n (emacs)
RET"))
(hy-test-helpers:consume-input-events))
(kill-buffer "*info*")))))
@@ -1350,7 +1419,7 @@ up the test."
"Verify saving and loading a referent path link works."
(hywiki-tests--referent-test
(cons 'path-link "file:L1")
- (hywiki-add-path-link wiki-referent "file" 1)))
+ (hywiki-add-path-link wiki-word-non-page "file" 1)))
;; Org id
(ert-deftest hywiki-tests--save-referent-org-id ()
@@ -1365,7 +1434,7 @@ up the test."
(mocklet (((hmouse-choose-link-and-referent-windows) => (list nil
(get-buffer-window)))
((org-id-get-create) => "generated-org-id"))
(goto-char (point-max))
- (hywiki-add-org-id wiki-referent)))
+ (hywiki-add-org-id wiki-word-non-page)))
(hy-delete-file-and-buffer filea))))))
;; FIXME: Add Org-id links tests.
@@ -1378,7 +1447,7 @@ up the test."
(mocklet (((hypb:require-package 'org-roam) => t)
((org-roam-node-read) => "node")
((org-roam-node-title "node") => "node-title"))
- (hywiki-add-org-roam-node wiki-referent))))
+ (hywiki-add-org-roam-node wiki-word-non-page))))
(ert-deftest hywiki-tests--save-referent-org-roam-node-use-menu ()
"Verify saving and loading a referent org roam node works using Hyperbole's
menu."
@@ -1389,7 +1458,7 @@ up the test."
((org-roam-node-read) => "node")
((org-roam-node-title "node") => "node-title")
(hywiki-display-org-roam-node => t))
- (should (hact 'kbd-key "C-u C-h hhcr"))
+ (should (hact 'kbd-key "C-u C-h hhc WikiReferent r Org-Roam-ID RET"))
(hy-test-helpers:consume-input-events))))
(ert-deftest hywiki-tests--delete-parenthesised-char ()
