branch: externals/hyperbole
commit 7fd90d5e192223ec0cbfe40b12d57875b8731afb
Merge: 575f988b41 eaad29f6e4
Author: Robert Weiner <r...@gnu.org>
Commit: GitHub <nore...@github.com>
Merge pull request #761 from rswgnu/rsw
hargs:delimited and hypb:in-string-p - point can now be on 2nd line
---
ChangeLog | 47 ++++++++
hargs.el | 166 ++++++++++++++--------------
hypb.el | 52 ++++++---
hywiki.el | 117 ++++++++++++--------
test/hargs-tests.el | 274 +++++++++++++++++++++++++++++++++++++++++++++-
test/hmouse-drv-tests.el | 6 +-
test/hmouse-info-tests.el | 4 +-
test/hpath-tests.el | 2 +-
test/hui-tests.el | 40 +++----
test/hy-test-helpers.el | 14 ++-
test/hypb-tests.el | 9 +-
test/hywiki-tests.el | 26 ++---
12 files changed, 564 insertions(+), 193 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index f18e89c785..38293d1939 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,50 @@
+2025-07-06 Bob Weiner <r...@gnu.org>
+
+* hargs.el (hargs:delimited): Fix bug with regexp delimiters where 'start-pos'
was
+ used instead of 'start' and this stop point from moving in a loop when
matched
+ to bol. This was seen in a failure of this call in
'hpath:delimited-possible-path':
+ (let* ((space-delimiter "[ \t]"))
+ (setq triplet (hargs:delimited (format
"^\\|\\(%s\\|[\]\[()<>\;&,@]\\)+"
+ space-delimiter)
+ "\\([\]\[()<>\;&,@]\\|:*\\s-\\)+\\|$"
+ t t t)
+ p (car triplet)))
+* hypb.el (hypb:in-string-p): Internally when computing the number of lines in
+ the string match, ignore any leading and trailing newlines. This allows
+ for opening and closing quotes to be on separate lines, useful with
+ multi-line strings.
+ test/hypb-tests.el (hypb--in-string-p--max-lines): Update to allow for
+ quotes on separate lines from the string but don't count these lines when
+ applying 'max-lines'.
+
+* test/hy-test-helpers.el (hy-test-helpers:ert-simulate-keys): Add to
+ disable 'vertico-mode' which gets in the way of 'ert-simulate-keys' calls.
+
+* hargs.el (hargs:delimited): Use 'hypb:in-string-p' when delimiters indicate
+ a string match. Rewrite to remove the limit that point must be on
+ the first line; can also be on the second line now and string delimiters
+ can be on lines by themselves.. Change so the 'exclude-regexp' arg is
+ compared against the match string without its delimiters, rather than with
+ them as before. Update doc string.
+ test/hargs-tests.el (hargs-delimited-*): Add a bunch of tests for
+ `hargs:delimited'.
+
+2025-07-03 Bob Weiner <r...@gnu.org>
+
+* hywiki.el (hywiki-word-at): A HyWikiWord reference can contain one set of
+ '\n\r' in it, so fix to allow these characters.
+
+* hypb.el (hypb:in-string-p): Allow point to be on the last line of a string
+ when given 'max-lines' arg, i.e. support prior lines. If 'max-lines' is
+ 0, always return a nil-type result.
+ hywiki.el (hywiki-at-range-delimiter, hywiki-maybe-highlight-balanced-pairs,
+ hywiki-maybe-dehighlight-balanced-pairs): Update and document to
+ allow 2-line HyWikiWord references with point on the trailing delimiter,
+ i.e. allow a line before point and one after.
+ (hywiki-delimited-p): Narrow to just a few lines to constrain
+ search for delimiters. The use case for this function does not require
+ looking back to the previous line.
+
2025-06-26 Mats Lidell <ma...@gnu.org>
* man/.dir-locals.el: Use with-locale-environment to ensure English is
diff --git a/hargs.el b/hargs.el
index f9a2542fcf..726de96e47 100644
--- a/hargs.el
+++ b/hargs.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 31-Oct-91 at 23:17:35
-;; Last-Mod: 11-Jun-25 at 00:20:07 by Mats Lidell
+;; Last-Mod: 6-Jul-25 at 15:28:05 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -121,20 +121,25 @@ Convert NUL characters to colons for use with grep lines."
(defun hargs:delimited (start-delim end-delim
&optional start-regexp-flag end-regexp-flag
list-positions-flag exclude-regexp as-key)
- "Return a delimited string that point is within the first line of, or nil.
-The string matched may be up to two lines long. The delimiters
-are removed, the string is normalized and reduced to a single
-line. START-DELIM and END-DELIM are strings that specify the
-argument delimiters. With optional START-REGEXP-FLAG non-nil,
-START-DELIM is treated as a regular expression. END-REGEXP-FLAG
-is similar. With optional LIST-POSITIONS-FLAG, return list
-of (string-matched start-pos end-pos), where the positions
-exclude the delimiters. Optional EXCLUDE-REGEXP is compared
-against the match string with its delimiters included; any string
-that matches this regexp is ignored. With optional AS-KEY =
-\\='none, return t rather than the string result. Any other
-non-nil value, means return the string normalized as a Hyperbole
-button key (no spaces)."
+ "Return a delimited string that point is within two lines of, or nil.
+The string matched may be up to two lines long and must not
+contain any nested occurrences of START-DELIM and END-DELIM. In
+the returned value, the delimiters are removed and the string is
+normalized by changing newlines followed by any additional
+whitespace to a single space, reducing the string to a single
+line. Other occurrences of multiple spaces and tabs are left
+unchanged.
+
+START-DELIM and END-DELIM are strings that specify the argument
+delimiters. With optional START-REGEXP-FLAG non-nil, START-DELIM
+is treated as a regular expression. END-REGEXP-FLAG is similar.
+With optional LIST-POSITIONS-FLAG, return list of (string-matched
+start end), where the positions exclude the delimiters. Optional
+EXCLUDE-REGEXP is compared against the match string without its
+delimiters; any string that matches this regexp is ignored. With
+optional AS-KEY = \\='none, return t rather than the string
+result. Any other non-nil value, means return the string
+normalized as a Hyperbole button key (no spaces)."
(let* ((opoint (point))
;; This initial limit is the forward search limit for start delimiters
(limit (if start-regexp-flag
@@ -148,71 +153,71 @@ button key (no spaces)."
first
start ;; excludes delimiter
end ;; excludes delimiter
- start-pos
end-pos
- start-with-delim
- end-with-delim)
+ string-start-end)
- (if (string-equal start-delim end-delim)
- (save-excursion
- (beginning-of-line)
- (while (and (setq end-pos (funcall start-search-func start-delim
limit t))
- (setq start-with-delim (match-beginning 0))
+ (if (and (null start-regexp-flag) (null end-regexp-flag)
+ (string-match "\\`['`\"]+\\'" start-delim)
+ (string-match "\\`['`\"]+\\'" end-delim))
+ ;; This is a string match
+ (setq string-start-end (hypb:in-string-p 2 :range)
+ start (nth 1 string-start-end)
+ end (nth 2 string-start-end))
+ (save-excursion
+ (beginning-of-line 0) ;; start of previous line
+ (if (string-equal start-delim end-delim)
+ (progn
+ (while (and (setq end-pos (funcall start-search-func start-delim
limit t))
+ ;; Prevent infinite loop where regexp match does not
+ ;; move end-pos forward, e.g. match to bol.
+ (not (eq first end-pos))
+ (setq start end-pos)
+ (setq count (1+ count))
+ (< (point) opoint)
+ ;; This is not to find the real end delimiter but to
find
+ ;; end delimiters that precede the current argument
and are
+ ;; therefore false matches, hence the search is
limited to
+ ;; prior to the original point.
+ (funcall end-search-func end-delim opoint t)
+ (setq count (1+ count)))
+ (setq first (or first start)
+ start nil))
+ (when (and (not start) (> count 0) (zerop (% count 2)))
+ ;; Since strings can span lines but this function matches only
+ ;; strings that start on the current line, when start-delim and
+ ;; end-delim are the same and there are an even number of
+ ;; delimiters in the search range, causing the end-delim
+ ;; search to match to what should probably be the start-delim,
+ ;; assume point is within a string and not between two other
strings.
+ ;; -- RSW, 02-05-2019
+ (setq start (if (string-equal start-delim end-delim)
+ (point)
+ first))))
+ ;;
+ ;; Start and end delims are different, so don't have to worry
+ ;; about whether in or outside two of the same delimiters and
+ ;; can match much more simply.
+ ;; Use forward rather than reverse search here to perform greedy
+ ;; searches when optional matches within a regexp.
+ (while (and (<= (point) limit)
+ (setq end-pos (funcall start-search-func start-delim
limit t))
;; Prevent infinite loop where regexp match does not
;; move end-pos forward, e.g. match to bol.
- (not (eq first end-pos))
- (setq start end-pos)
- (setq count (1+ count))
- (< (point) opoint)
- ;; This is not to find the real end delimiter but to find
- ;; end delimiters that precede the current argument and
are
- ;; therefore false matches, hence the search is limited to
- ;; prior to the original point.
- (funcall end-search-func end-delim opoint t)
- (setq count (1+ count)))
- (setq first (or first start)
- start nil))
- (when (and (not start) (> count 0) (zerop (% count 2)))
- ;; Since strings can span lines but this function matches only
- ;; strings that start on the current line, when start-delim and
- ;; end-delim are the same and there are an even number of
- ;; delimiters in the search range, causing the end-delim
- ;; search to match to what should probably be the start-delim,
- ;; assume point is within a string and not between two other
strings.
- ;; -- RSW, 02-05-2019
- (setq start (if (string-equal start-delim end-delim)
- (point)
- first))))
- ;;
- ;; Start and end delims are different, so don't have to worry
- ;; about whether in or outside two of the same delimiters and
- ;; can match much more simply.
- ;; Use forward rather than reverse search here to perform greedy
- ;; searches when optional matches within a regexp.
- (save-excursion
- (beginning-of-line)
- (while (and (<= (point) limit)
- (setq start-pos (point)
- end-pos (funcall start-search-func start-delim limit
t))
- ;; Prevent infinite loop where regexp match does not
- ;; move end-pos forward, e.g. match to bol.
- (not (eq start end-pos)))
- (setq start-with-delim (match-beginning 0)
- start (match-end 0))
- (when (eq start-pos end-pos)
- ;; start-delim contains a match for bol, so move point
- ;; forward a char to prevent loop exit even though start
- ;; delim matched.
- (goto-char (min (1+ (point)) (point-max)))))))
+ (not (eq start end-pos)))
+ (setq start (match-end 0))
+ (when (eq start end-pos)
+ ;; start-delim contains a match for bol, so move point
+ ;; forward a char to prevent loop exit even though start
+ ;; delim matched.
+ (goto-char (min (1+ (point)) (point-max)))))))
- (when start
- (save-excursion
- (forward-line 2)
- (setq limit (point))
- (goto-char opoint)
- (and (funcall end-search-func end-delim limit t)
- (setq end (match-beginning 0)
- end-with-delim (match-end 0)))))
+ (when start
+ (save-excursion
+ (forward-line 2)
+ (setq limit (point))
+ (goto-char opoint)
+ (and (funcall end-search-func end-delim limit t)
+ (setq end (match-beginning 0))))))
(when (and start end)
(save-excursion
@@ -234,12 +239,11 @@ button key (no spaces)."
(if list-positions-flag
(list t start end)
t)
- (let ((result (hargs:buffer-substring start end))
- (string-with-delims (when (stringp exclude-regexp)
- (hargs:buffer-substring
start-with-delim
-
end-with-delim))))
- (unless (and string-with-delims
- (string-match exclude-regexp string-with-delims))
+ (let ((result (hargs:buffer-substring start end)))
+ (unless (or
+ ;; Ignore if more than 2 lines matched
+ (> (hypb:string-count-matches "\n" result) 1)
+ (when exclude-regexp (string-match exclude-regexp
result)))
;; Normalize the result
(setq result
(if as-key
diff --git a/hypb.el b/hypb.el
index e8a09ceb51..4f741872f8 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: 21-Jun-25 at 13:54:25 by Bob Weiner
+;; Last-Mod: 6-Jul-25 at 14:46:41 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -684,9 +684,9 @@ This will this install the Emacs helm package when needed."
"Return non-nil iff point is within a string and not on the closing quote.
With optional MAX-LINES, an integer, match only within that many
-lines from point. With optional RANGE-FLAG, return list
-of (string-matched start-pos end-pos), where the positions
-exclude the delimiters.
+lines from point. With optional RANGE-FLAG when there is a
+match, return list of (string-matched start-pos end-pos), where
+the positions exclude the delimiters.
To prevent searching back to the buffer start and producing slow
performance, this limits its count of quotes found prior to point
@@ -703,14 +703,21 @@ Quoting conventions recognized are:
(save-excursion
(save-restriction
(when (integerp max-lines)
- (narrow-to-region (line-beginning-position)
- (line-end-position max-lines)))
+ (if (zerop max-lines)
+ (narrow-to-region (point) (point)) ;; Empty range
+ ;; Allow for +/- (+ 1 max-lines) including current line so start
+ ;; and end delimiters can be on separate lines. Before returning,
+ ;; this function checks that any matched string has <= max-lines.
+ (narrow-to-region (line-beginning-position
+ (when max-lines (1+ (- max-lines))))
+ (line-end-position (1+ max-lines)))))
;; Don't use `syntax-ppss' here as it fails to ignore backquoted
;; double quote characters in strings and doesn't work in
;; `change-log-mode' due to its syntax-table.
(let ((opoint (point))
(start (point-min))
(open-match-string "")
+ str
str-start
str-end)
(cl-destructuring-bind (open-regexp close-regexp)
@@ -747,12 +754,8 @@ Quoting conventions recognized are:
(regexp-quote texinfo-close-quote))
start (point))))
(search-forward texinfo-close-quote nil t)
- (if range-flag
- (progn
- (setq str-end (match-beginning 0))
- (list (buffer-substring-no-properties str-start
str-end)
- str-start str-end))
- t))
+ (setq str-end (match-beginning 0)
+ str (buffer-substring-no-properties str-start
str-end)))
(and (cl-oddp (- (count-matches (regexp-quote open-match-string)
start (point))
;; Subtract any backslash quoted delimiters
@@ -767,12 +770,25 @@ Quoting conventions recognized are:
(goto-char (1- (point)))
t)
(re-search-forward close-regexp nil t)
- (if range-flag
- (progn
- (setq str-end (match-beginning 2))
- (list (buffer-substring-no-properties str-start
str-end)
- str-start str-end))
- t))))))))))
+ (setq str-end (match-beginning 2)
+ str (buffer-substring-no-properties str-start
str-end))))
+
+ ;; Ignore if more than `max-lines' matched
+ (when (and str
+ (or (null max-lines)
+ (and (integerp max-lines)
+ ;; When computing the number of lines in
+ ;; the string match, ignore any leading and
+ ;; trailing newlines. This allows for
+ ;; opening and closing quotes to be on
+ ;; separate lines, useful with multi-line
+ ;; strings.
+ (< (hypb:string-count-matches
+ "\n" (string-trim str))
+ max-lines))))
+ (if range-flag
+ (list str str-start str-end)
+ t)))))))))
(defun hypb:indirect-function (obj)
"Return the function at the end of OBJ's function chain.
diff --git a/hywiki.el b/hywiki.el
index 460a69820d..1f8aa30206 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: 22-Jun-25 at 22:36:22 by Bob Weiner
+;; Last-Mod: 4-Jul-25 at 19:46:06 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -571,8 +571,8 @@ deletion commands and those in
`hywiki-non-character-commands'."
(when (or (memq this-command hywiki-non-character-commands)
(and (symbolp this-command)
(string-match-p
"^\\(org-\\)?\\(delete-\\|kill-\\)\\|\\(-delete\\|-kill\\)\\(-\\|$\\)"
(symbol-name this-command))))
- ;; Test if at delimiters surrounding a WikiWord and if so,
- ;; record those for use by post hooks.
+ ;; Test if at delimiters surrounding a single WikiWord reference
+ ;; and if so, record those for use by post hooks.
(cl-destructuring-bind (start end)
;; Get delimited region only if before or after delimiters,
;; else return (nil nil).
@@ -628,7 +628,7 @@ deletion commands and those in
`hywiki-non-character-commands'."
(hywiki--maybe-rehighlight-at-point)))))
(defun hywiki-buttonize-character-commands ()
- "Turn any HyWikiWords between point into highlighted Hyperbole buttons.
+ "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)
@@ -1532,6 +1532,7 @@ publish process."
(insert "\n#+INDEX: " wikiword "\n"))))))
(defun hywiki-word-to-org-link (link &optional description)
+ "From a HyWikiWord reference LINK with an optional DESCRIPTION to an Org
link."
;; \"[[file:<hywiki-directory>/WikiWord.org::Multi-Word
Section][WikiWord#Multi-Word Section]]\".
(let ((resolved-link (hywiki-org-link-resolve link :full-data)))
(when (stringp (car resolved-link))
@@ -1700,12 +1701,19 @@ positions of each HyWikiWord and its optional #section."
(defun hywiki-at-range-delimiter ()
"Immediately before or after a balanced delimiter, return the delimited
range.
+Include: (), {}, <>, [] and \"\" (double quotes). Exclude Org links
+and radio targets.
+
+Range is limited to the previous, current and next lines, as HyWikiWord
references
+are limited to two lines maximum.
+
If no such range, return \\='(nil nil).
This includes the delimiters: (), {}, <>, [] and \"\" (double quotes)."
(save-excursion
(save-restriction
- ;; Limit balanced pair checks to the next two lines for speed
- (narrow-to-region (line-beginning-position) (line-end-position 2))
+ ;; Limit balanced pair checks to previous through next lines for speed
+ ;; Point must be either on the opening or the closing line.
+ (narrow-to-region (line-beginning-position 0) (line-end-position 2))
(let ((result (condition-case nil
(cond
;; Handle opening delimiters
@@ -1761,13 +1769,16 @@ This includes the delimiters: (), {}, <>, [] and \"\"
(double quotes)."
Include: (), {}, <>, [] and \"\" (double quotes). Exclude Org links
and radio targets.
+Range is limited to the previous, current and next lines, as HyWikiWord
references
+are limited to two lines maximum.
+
Ignore return value; it has no meaning."
(save-excursion
(save-restriction
(if (hywiki--buttonized-region-p)
(narrow-to-region hywiki--buttonize-start hywiki--buttonize-end)
- ;; Limit balanced pair checks to the next two lines for speed
- (narrow-to-region (line-beginning-position) (line-end-position 2)))
+ ;; Limit balanced pair checks to two lines around point for speed
+ (narrow-to-region (line-beginning-position 0) (line-end-position 2)))
;; char-before
(ignore-errors
@@ -1827,13 +1838,16 @@ Ignore return value; it has no meaning."
Include: (), {}, <>, [] and \"\" (double quotes). Exclude Org links
and radio targets.
+Range is limited to the previous, current and next lines, as HyWikiWord
+references are limited to two lines maximum.
+
Return t if no errors and a pair was found, else nil."
(save-excursion
(save-restriction
(if (hywiki--buttonized-region-p)
(narrow-to-region hywiki--buttonize-start hywiki--buttonize-end)
- ;; Limit balanced pair checks to the next two lines for speed
- (narrow-to-region (line-beginning-position) (line-end-position 2)))
+ ;; Limit balanced pair checks to two lines around point for speed
+ (narrow-to-region (line-beginning-position 0) (line-end-position 2)))
(let ((result t))
(condition-case nil
@@ -1989,7 +2003,8 @@ If in a programming mode, must be within a comment. Use
(unless hywiki--highlighting-done-flag
(unless on-page-name
- ;; May be a closing delimiter that we have to skip past
+ ;; May be a non-delimiter but HyWikiWord ending punctuation to
+ ;; skip past
(skip-chars-backward (hywiki-get-buttonize-characters)))
;; Skip past HyWikiWord or section
(skip-syntax-backward "^-$()<>._\"\'")
@@ -2052,7 +2067,8 @@ the current page unless they have sections attached."
(hywiki-maybe-highlight-balanced-pairs))
(unless on-page-name
- ;; May be a HyWikiWord ending character to skip past
+ ;; May be a non-delimiter but HyWikiWord ending punctuation to
+ ;; skip past
(skip-chars-backward (hywiki-get-buttonize-characters)
(line-beginning-position)))
;; Skip past HyWikiWord or section
@@ -3019,10 +3035,11 @@ non-nil or this will return nil."
;; Handle an Org link [[HyWikiWord]]
[[hy:HyWikiWord]]
;; or [[HyWikiWord#section][Description Text]].
;; Get the HyWikiWord link reference, ignoring any
- ;; description given in the link
+ ;; description given in the link.
+ ;;
;; Don't use next line so don't have to load all of
Org
- ;; mode just to check for HyWikiWords; however,
disables
- ;; support for Org mode aliases.
+ ;; mode just to check for HyWikiWords; however,
+ ;; ignoring this disables support for Org mode
aliases.
;; (setq wikiword (org-link-expand-abbrev
(org-link-unescape (string-trim wikiword))))
(setq wikiword (hywiki-strip-org-link wikiword))
(when (and wikiword end)
@@ -3037,13 +3054,17 @@ non-nil or this will return nil."
end (match-end 0))))))
(hywiki-word-is-p wikiword))
- ;; Handle delimited HyWikiWord references with
- ;; multiple words in their sections,
- ;; e.g. (MyWikiWord WikiWord#one two three)
+ ;; Handle a delimited HyWikiWord reference with
+ ;; multiple, possibly whitespace-separated words in
+ ;; its section, e.g. (MyWikiWord#one two three).
+ ;; Whitespace between section words is allowed only
+ ;; if the delimiters are immediately before and
+ ;; after a single HyWikiWord reference.
((let ((case-fold-search nil)
(bol (line-beginning-position))
opoint)
- ;; May be a HyWikiWord ending character to skip
past
+ ;; May be a non-delimiter but HyWikiWord ending
+ ;; punctuation to skip past
(skip-chars-backward
(hywiki-get-buttonize-characters) bol)
(setq opoint (point))
(when (setq wikiword-start-end
(hywiki-delimited-p)) ;; limited to 2 lines
@@ -3110,13 +3131,14 @@ non-nil or this will return nil."
wikiword (string-trim
(buffer-substring-no-properties start end))))))))
- ;; Handle non-delimited HyWikiWord references
- ;; with multiple dash-separated words in their
sections,
+ ;; Handle a non-delimited HyWikiWord reference
+ ;; with multiple dash-separated words in its section,
;; e.g. WikiWord#one-two-three.
((let ((case-fold-search nil)
(bol (line-beginning-position))
opoint)
- ;; May be a HyWikiWord ending character to skip
past
+ ;; May be a non-delimiter but HyWikiWord ending
+ ;; punctuation to skip past
(skip-chars-backward
(hywiki-get-buttonize-characters) bol)
(setq opoint (point))
(goto-char opoint)
@@ -3144,9 +3166,10 @@ non-nil or this will return nil."
;; No following char
wikiword (string-trim
(match-string-no-properties 0))))))
- ;; Handle a non-delimited HyWikiWord with optional
- ;; #section:Lnum:Cnum; if it is an Org link, it may
- ;; optionally have a hy: link-type prefix. Ignore
+ ;; Handle a non-delimited HyWikiWord reference with
+ ;; optional #section:Lnum:Cnum; if it is an Org
+ ;; link, it may optionally have a hy: link-type
+ ;; prefix. #section may not contain spaces. Ignore
;; wikiwords preceded by any non-whitespace
;; character, except any of these: "([\"'`'"
(t (let ((case-fold-search nil))
@@ -3166,11 +3189,10 @@ non-nil or this will return nil."
end (match-end 0)
;; No following char
wikiword (string-trim
(match-string-no-properties 0)))))))))
- ;; If `wikiword' has a #section, ensure there are
- ;; no invalid chars
+ ;; If `wikiword' reference has a #section, ensure there are
+ ;; no invalid chars. One set of \n\r characters is
allowed.
(if (and (stringp wikiword) (string-match "#" wikiword))
- (string-match "#[^][#()<>{}\"\n\r\f]+\\'" wikiword)
- t))
+ (string-match "#[^][#()<>{}\"\f]+\\'" wikiword)
t))
(if range-flag
(progn
(list wikiword start end))
@@ -3184,9 +3206,9 @@ non-nil or this will return nil."
"Return list of potential (HyWikiWord#section:Lnum:Cnum start end).
Also highlight HyWikiWord as necessary.
-If the HyWikiWord is delimited, point must be within the delimiters.
-The delimiters are excluded from start and end. If not at a
-HyWikiWord, return \\='(nil nil nil).
+If the HyWikiWord reference is delimited, point must be within the
+delimiters. The delimiters are excluded from start and end. If not
+at a HyWikiWord, return \\='(nil nil nil).
This works regardless of whether the HyWikiWord has been highlighted
or not.
@@ -3219,22 +3241,29 @@ or this will return nil."
(hywiki-get-singular-wikiword (hywiki-word-strip-suffix (hywiki-word-at))))
(defun hywiki-delimited-p (&optional pos)
- "Return non-nil if optional POS or point is surrounded by matching
delimiters.
-Any non-nil value returned is a list of (string-matched start-pos end-pos).
-The delimited range must be two lines or less.
+ "Return non-nil if optional POS or point is surrounded by delimiters.
+Any non-nil value returned is a list of (hywikiword-ref start-pos end-pos).
+The delimited range must be two lines or less with point on the first line.
+
+Matching delimiters around anything other than a single HyWikiWord reference
+are ignored.
Use `hywiki-word-at', which calls this, to determine whether there is
a HyWikiWord at point."
(save-excursion
- (when (natnump pos)
- (goto-char pos))
- (or (hypb:in-string-p 2 t)
- (let ((range (hargs:delimited "[\[<\(\{]" "[\]\}\)\>]" t t t)))
- (and range
- ;; Ensure closing delimiter is a match for the opening one
- (= (matching-paren (char-before (nth 1 range)))
- (char-after (nth 2 range)))
- range)))))
+ (save-restriction
+ (when (natnump pos)
+ (goto-char pos))
+ ;; Limit balanced pair checks to current through next lines for speed.
+ ;; Point must be either on the opening line.
+ (narrow-to-region (line-beginning-position) (line-end-position 2))
+ (or (hypb:in-string-p nil t)
+ (let ((range (hargs:delimited "[\[<\(\{]" "[\]\}\)\>]" t t t)))
+ (and range
+ ;; Ensure closing delimiter is a match for the opening one
+ (= (matching-paren (char-before (nth 1 range)))
+ (char-after (nth 2 range)))
+ range))))))
(defun hywiki-word-face-at-p (&optional pos)
"Non-nil if but at point or optional POS has `hywiki-word-face' property."
diff --git a/test/hargs-tests.el b/test/hargs-tests.el
index 6837258a4a..41b93586c9 100644
--- a/test/hargs-tests.el
+++ b/test/hargs-tests.el
@@ -3,7 +3,7 @@
;; Author: Mats Lidell <ma...@gnu.org>
;;
;; Orig-Date: 04-Feb-22 at 23:00:00
-;; Last-Mod: 2-Jun-25 at 23:48:30 by Bob Weiner
+;; Last-Mod: 6-Jul-25 at 15:28:45 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -29,15 +29,15 @@
(let ((file (make-temp-file "hypb")))
(unwind-protect
(progn
- (ert-simulate-keys "xyz\r"
+ (hy-test-helpers:ert-simulate-keys "xyz\r"
(should (string= (hargs:get "+I: ") "xyz")))
- (ert-simulate-keys "xyz\r"
+ (hy-test-helpers:ert-simulate-keys "xyz\r"
(should (string= (hargs:get "+L: ") "xyz")))
- (ert-simulate-keys (concat "(\"xyz\" \"" file "\")\r")
+ (hy-test-helpers:ert-simulate-keys (concat "(\"xyz\" \"" file
"\")\r")
(should (equal (hargs:get "+M: ") (list "xyz" file))))
- (ert-simulate-keys "xyz\r"
+ (hy-test-helpers:ert-simulate-keys "xyz\r"
(should (string= (hargs:get "+V: ") "xyz")))
- (ert-simulate-keys "xyz\r"
+ (hy-test-helpers:ert-simulate-keys "xyz\r"
(should (string= (hargs:get "+X: ") "(dir)xyz")))
(should-error (hargs:get "+A: ") :type 'error))
(hy-delete-file-and-buffer file))))
@@ -67,5 +67,267 @@
(should (string= (cadr v) (hargs:sexpression-p)))
(should (string= (caddr v) (hargs:sexpression-p t))))))
+;;; Tests for hargs:delimited
+(ert-deftest hargs-delimited-basic-test ()
+ "Test basic functionality with simple delimiters."
+ (with-temp-buffer
+ (insert "Before [hello world] after")
+ (goto-char 10) ; position inside "hello world"
+ (should (string= (hargs:delimited "[" "]") "hello world"))))
+
+(ert-deftest hargs-delimited-regexp-delimiters-test ()
+ "Test with regexp delimiters."
+ (with-temp-buffer
+ (insert "Before (hello world) after")
+ (goto-char 10) ; position inside "hello world"
+ (should (string= (hargs:delimited "[\[<\(\{]" "[\]\}\)\>]" t t) "hello
world"))))
+
+(ert-deftest hargs-delimited-multiline-point-first-line-test ()
+ "Test multiline expression with point on first line."
+ (with-temp-buffer
+ (insert "Before [hello\nworld] after")
+ (goto-char 10) ; position in "hello" on first line
+ (should (string= (hargs:delimited "[" "]") "hello world"))))
+
+(ert-deftest hargs-delimited-multiline-point-second-line-test ()
+ "Test multiline expression with point on second line."
+ (with-temp-buffer
+ (insert "Before [hello\nworld] after")
+ (goto-char 15) ; position in "world" on second line
+ (should (string= (hargs:delimited "[" "]") "hello world"))))
+
+(ert-deftest hargs-delimited-escaped-delimiter-test ()
+ "Test that escaped delimiters are ignored."
+ (with-temp-buffer
+ (insert "Before \\[not this\\] [hello world] after")
+ (goto-char 28) ; position inside "hello world"
+ (should (string= (hargs:delimited "[" "]") "hello world"))))
+
+(ert-deftest hargs-delimited-matching-delimiters-test ()
+ "Test proper delimiter matching."
+ (with-temp-buffer
+ (insert "Before [hello) world] after")
+ (goto-char 10) ; position inside, but ) doesn't match [
+ (should (string= (hargs:delimited "[" "]") "hello) world"))))
+
+(ert-deftest hargs-delimited-wrong-matching-delimiters-test ()
+ "Test that wrong delimiter pairs don't match."
+ (with-temp-buffer
+ (insert "Before [hello world) after")
+ (goto-char 10) ; position inside, but ) doesn't match [
+ (should-not (hargs:delimited "[" "]" nil nil))))
+
+(ert-deftest hargs-delimited-list-positions-test ()
+ "Test LIST-POSITIONS-FLAG returns list with positions."
+ (with-temp-buffer
+ (insert "Before [hello world] after")
+ (goto-char 10) ; position inside "hello world"
+ (let ((result (hargs:delimited "[" "]" nil nil t)))
+ (should (listp result))
+ (should (string= (car result) "hello world"))
+ (should (= (nth 1 result) 9)) ; position after [
+ (should (= (nth 2 result) 20))))) ; position before ]
+
+(ert-deftest hargs-delimited-exclude-regexp-test ()
+ "Test EXCLUDE-REGEXP parameter."
+ (with-temp-buffer
+ (insert "Before [excluded] after")
+ (goto-char 10) ; position inside "excluded"
+ (should (null (hargs:delimited "[" "]" nil nil nil "excluded")))))
+
+(ert-deftest hargs-delimited-as-key-none-test ()
+ "Test AS-KEY = 'none returns t."
+ (with-temp-buffer
+ (insert "Before [hello world] after")
+ (goto-char 10) ; position inside "hello world"
+ (should (eq (hargs:delimited "[" "]" nil nil nil nil 'none) t))))
+
+(ert-deftest hargs-delimited-as-key-button-test ()
+ "Test AS-KEY non-nil returns button key format."
+ (with-temp-buffer
+ (insert "Before [hello world] after")
+ (goto-char 10) ; position inside "hello world"
+ (should (string= "hello_world" (hargs:delimited
+ "[" "]" nil nil nil nil 'button)))))
+
+(ert-deftest hargs-delimited-normalization-test ()
+ "Test string normalization with extra whitespace."
+ (with-temp-buffer
+ (insert "Before [ hello world ] after")
+ (goto-char 12) ; position inside
+ (should (string= (hargs:delimited "[" "]") " hello world "))))
+
+(ert-deftest hargs-delimited-multiline-normalization-test ()
+ "Test multiline string normalization."
+ (with-temp-buffer
+ (insert "Before [hello\n world test] after")
+ (goto-char 10) ; position inside
+ (should (string= (hargs:delimited "[" "]") "hello world test"))))
+
+(ert-deftest hargs-delimited-no-match-test ()
+ "Test when point is not within delimited region."
+ (with-temp-buffer
+ (insert "Before [hello world] after")
+ (goto-char 5) ; position in "Before"
+ (should (null (hargs:delimited "[" "]")))))
+
+(ert-deftest hargs-delimited-no-end-delimiter-test ()
+ "Test when end delimiter is not found."
+ (with-temp-buffer
+ (insert "Before [hello world after")
+ (goto-char 10) ; position inside
+ (should (null (hargs:delimited "[" "]")))))
+
+(ert-deftest hargs-delimited-angle-brackets-test ()
+ "Test with angle brackets."
+ (with-temp-buffer
+ (insert "Before <hello world> after")
+ (goto-char 10) ; position inside
+ (should (string= (hargs:delimited "<" ">") "hello world"))))
+
+(ert-deftest hargs-delimited-curly-braces-test ()
+ "Test with curly braces."
+ (with-temp-buffer
+ (insert "Before {hello world} after")
+ (goto-char 10) ; position inside
+ (should (string= (hargs:delimited "{" "}") "hello world"))))
+
+(ert-deftest hargs-delimited-parentheses-test ()
+ "Test with parentheses."
+ (with-temp-buffer
+ (insert "Before (hello world) after")
+ (goto-char 10) ; position inside
+ (should (string= (hargs:delimited "(" ")") "hello world"))))
+
+(ert-deftest hargs-delimited-double-quotes-basic-test ()
+ "Test basic functionality with double quotes."
+ (with-temp-buffer
+ (insert "Before \"hello world\" after")
+ (goto-char 12) ; position inside "hello world"
+ (should (string= (hargs:delimited "\"" "\"") "hello world"))))
+
+(ert-deftest hargs-delimited-double-quotes-escaped-test ()
+ "Test double quotes with escaped quotes inside."
+ (with-temp-buffer
+ (insert "Before \"hello \\\"quoted\\\" world\" after")
+ (goto-char 12) ; position inside
+ (should (string= (hargs:delimited "\"" "\"") "hello /\"quoted/\" world"))))
+
+(ert-deftest hargs-delimited-double-quotes-multiline-test ()
+ "Test double quotes with multiline content."
+ (with-temp-buffer
+ (insert "Before \"hello\nworld\" after")
+ (goto-char 12) ; position in "hello" on first line
+ (should (string= (hargs:delimited "\"" "\"") "hello world"))))
+
+(ert-deftest hargs-delimited-double-quotes-multiline-second-line-test ()
+ "Test double quotes with point on second line."
+ (with-temp-buffer
+ (insert "Before \"hello\nworld\" after")
+ (goto-char 17) ; position in "world" on second line
+ (should (string= (hargs:delimited "\"" "\"") "hello world"))))
+
+(ert-deftest hargs-delimited-double-quotes-empty-test ()
+ "Test double quotes with empty content."
+ (with-temp-buffer
+ (insert "\"Before \\\"\\\" after\"")
+ (goto-char 9) ; position inside empty quotes
+ (should (string= (hargs:delimited "\"" "\"") "Before /\"/\" after"))))
+
+(ert-deftest hargs-delimited-double-quotes-whitespace-test ()
+ "Test double quotes with only whitespace."
+ (with-temp-buffer
+ (insert "Before \" \" after")
+ (goto-char 11) ; position inside whitespace
+ (should (string= (hargs:delimited "\"" "\"") " "))))
+
+(ert-deftest hargs-delimited-double-quotes-no-match-test ()
+ "Test when point is outside quoted region."
+ (with-temp-buffer
+ (insert "Before \"hello world\" after")
+ (goto-char 5) ; position in "Before"
+ (should (null (hargs:delimited "\"" "\"")))))
+
+(ert-deftest hargs-delimited-double-quotes-no-closing-test ()
+ "Test when closing quote is missing."
+ (with-temp-buffer
+ (insert "Before \"hello world after")
+ (goto-char 12) ; position inside
+ (should (null (hargs:delimited "\"" "\"")))))
+
+(ert-deftest hargs-delimited-double-quotes-multiple-pairs-test ()
+ "Test with multiple quote pairs, should match the one containing point."
+ (with-temp-buffer
+ (insert "Before \"first\" and \"second\" after")
+ (goto-char 24) ; position in "second"
+ (should (string= (hargs:delimited "\"" "\"") "second"))))
+
+(ert-deftest hargs-delimited-double-quotes-list-positions-test ()
+ "Test LIST-POSITIONS-FLAG with double quotes."
+ (with-temp-buffer
+ (insert "Before \"hello world\" after")
+ (goto-char 12) ; position inside "hello world"
+ (let ((result (hargs:delimited "\"" "\"" nil nil t)))
+ (should (listp result))
+ (should (string= (car result) "hello world"))
+ (should (= (nth 1 result) 9)) ; position after opening "
+ (should (= (nth 2 result) 20))))) ; position before closing "
+
+(ert-deftest hargs-delimited-double-quotes-as-key-test ()
+ "Test AS-KEY with double quotes."
+ (with-temp-buffer
+ (insert "Before \"hello world\" after")
+ (goto-char 12) ; position inside "hello world"
+ (should (string= (hargs:delimited "\"" "\"" nil nil nil nil 'button)
"hello_world"))))
+
+;; New tests for complex regex patterns
+(ert-deftest hargs-delimited-complex-regex-test ()
+ "Test with complex regex patterns that caused hanging."
+ (with-temp-buffer
+ (insert " hello world ")
+ (goto-char 5) ; position in "hello"
+ (let ((result (hargs:delimited "\\( \\|[][()<>;&,@]\\)+"
+ "\\( \\|[][()<>;&,@]\\)+"
+ t t t)))
+ (should (listp result))
+ (should (stringp (car result)))
+ (should (string= (car result) "hello world")))))
+
+(ert-deftest hargs-delimited-whitespace-boundary-test ()
+ "Test regex that matches whitespace boundaries."
+ (with-temp-buffer
+ (insert "word1 word2 word3")
+ (goto-char 8) ; position in "word2"
+ (let ((result (hargs:delimited "\\s-+" "\\s-+" t t)))
+ (should (stringp result))
+ (should (string= result "word2")))))
+
+(ert-deftest hargs-delimited-punctuation-boundary-test ()
+ "Test regex that matches punctuation boundaries."
+ (with-temp-buffer
+ (insert "word1,word2;word3")
+ (goto-char 8) ; position in "word2"
+ (let ((result (hargs:delimited "[,;]" "[,;]" t t)))
+ (should (stringp result))
+ (should (string= result "word2")))))
+
+(ert-deftest hargs-delimited-line-boundary-test ()
+ "Test regex that matches line boundaries."
+ (with-temp-buffer
+ (insert "line1\nline2\nline3")
+ (goto-char 8) ; position in "line2"
+ (let ((result (hargs:delimited "^" "$" t t)))
+ (should (stringp result))
+ (should (string= result "line2")))))
+
+(ert-deftest hargs-delimited-zero-width-match-test ()
+ "Test handling of zero-width matches."
+ (with-temp-buffer
+ (insert "hello world")
+ (goto-char 5) ; position in "hello"
+ (let ((result (hargs:delimited "\\b" "\\b" t t)))
+ (should (stringp result))
+ (should (string= result "hello")))))
+
(provide 'hargs-tests)
;;; hargs-tests.el ends here
diff --git a/test/hmouse-drv-tests.el b/test/hmouse-drv-tests.el
index ae06828033..a02046dccb 100644
--- a/test/hmouse-drv-tests.el
+++ b/test/hmouse-drv-tests.el
@@ -3,7 +3,7 @@
;; Author: Mats Lidell <ma...@gnu.org>
;;
;; Orig-Date: 28-Feb-21 at 22:52:00
-;; Last-Mod: 10-Jun-25 at 17:44:05 by Mats Lidell
+;; Last-Mod: 6-Jul-25 at 13:02:40 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -190,7 +190,7 @@
(with-temp-buffer
(insert "\"/tmp\"\n")
(goto-char 3)
- (ert-simulate-keys "TMP\r"
+ (hy-test-helpers:ert-simulate-keys "TMP\r"
(let ((enable-recursive-minibuffers t))
(hui:ibut-label-create)
(should (string= "<[TMP]> - \"/tmp\"\n" (buffer-string)))))))
@@ -200,7 +200,7 @@
(with-temp-buffer
(insert "<[LBL]>: \"/tmp\"\n")
(goto-char 14)
- (ert-simulate-keys "TMP\r"
+ (hy-test-helpers:ert-simulate-keys "TMP\r"
(condition-case err
(hui:ibut-label-create)
(error
diff --git a/test/hmouse-info-tests.el b/test/hmouse-info-tests.el
index 85a2177ea3..1e650a68c4 100644
--- a/test/hmouse-info-tests.el
+++ b/test/hmouse-info-tests.el
@@ -3,7 +3,7 @@
;; Author: Mats Lidell <ma...@gnu.org>
;;
;; Orig-Date: 29-Dec-21 at 09:02:00
-;; Last-Mod: 25-Apr-25 at 19:56:35 by Mats Lidell
+;; Last-Mod: 6-Jul-25 at 13:02:40 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -24,7 +24,7 @@
(ert-deftest hmouse-info-read-index-with-completion ()
"Read a completion that completes."
- (ert-simulate-keys "(emacs)regex\t\r"
+ (hy-test-helpers:ert-simulate-keys "(emacs)regex\t\r"
(should (string= "(emacs)regexp" (Info-read-index-item-name "Prompt: ")))))
(ert-deftest hmouse-info-build-completions-no-match ()
diff --git a/test/hpath-tests.el b/test/hpath-tests.el
index 66bf4edd5b..8e7c9da008 100644
--- a/test/hpath-tests.el
+++ b/test/hpath-tests.el
@@ -393,7 +393,7 @@ See `hpath:line-and-column-regexp'."
(should-not (string-match hpath:line-and-column-regexp "/foo/bar.org:C1")))
(ert-deftest hpath--hpath:delimited-possible-path ()
- "Verify delimited path is found in an `ls -R' listings in `shell-mode'."
+ "Verify delimited paths are found in an `ls -R' listing in `shell-mode'."
(let ((files
'(("file1.ext file2.ext file3.ext" ; Space delimited
("file1" "file2" "file3"))
diff --git a/test/hui-tests.el b/test/hui-tests.el
index e60280e48a..5b04cbd065 100644
--- a/test/hui-tests.el
+++ b/test/hui-tests.el
@@ -3,7 +3,7 @@
;; Author: Mats Lidell <ma...@gnu.org>
;;
;; Orig-Date: 30-Jan-21 at 12:00:00
-;; Last-Mod: 24-Jun-25 at 23:15:42 by Mats Lidell
+;; Last-Mod: 6-Jul-25 at 15:40:32 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -56,7 +56,7 @@
(setenv "HOME" "/tmp")
(set-buffer gbut-file-buffer)
- (ert-simulate-keys (kbd create-gbut)
+ (hy-test-helpers:ert-simulate-keys (kbd create-gbut)
(hact (lambda () (call-interactively 'hui:gbut-create))))
;; Create using program
@@ -66,7 +66,7 @@
(should (eq (hattr:get (hbut:at-p) 'actype)
'actypes::link-to-file))
(goto-char (point-max)) ;; Move past button so does not
prompt with label
- (ert-simulate-keys (kbd edit-gbut)
+ (hy-test-helpers:ert-simulate-keys (kbd edit-gbut)
(hact (lambda () (call-interactively 'hui:gbut-edit))))
;; (set-buffer gbut-file-buffer)
@@ -149,7 +149,7 @@
(with-temp-buffer
(insert "\"/tmp\"\n")
(goto-char 3)
- (ert-simulate-keys "TMP\r"
+ (hy-test-helpers:ert-simulate-keys "TMP\r"
(hui:ibut-label-create)
(should (string= "<[TMP]> - \"/tmp\"\n" (buffer-string))))))
@@ -158,7 +158,7 @@
(with-temp-buffer
(insert "<[LBL]>: \"/tmp\"\n")
(goto-char 14)
- (ert-simulate-keys "TMP\r"
+ (hy-test-helpers:ert-simulate-keys "TMP\r"
(condition-case err
(hui:ibut-label-create)
(error
@@ -183,7 +183,7 @@
(let ((file (make-temp-file "hypb_" nil ".txt")))
(unwind-protect
(find-file file)
- (ert-simulate-keys "label\rwww-url\rwww.hypb.org\r"
+ (hy-test-helpers:ert-simulate-keys "label\rwww-url\rwww.hypb.org\r"
(hui:ebut-create)
(hy-test-helpers-verify-hattr-at-p :actype 'actypes::www-url :args
'("www.hypb.org") :loc file :lbl-key "label"))
(hy-delete-file-and-buffer file))))
@@ -194,10 +194,10 @@ Ensure modifying the button but keeping the label does
not create a double label
(let ((file (make-temp-file "hypb_" nil ".txt")))
(unwind-protect
(find-file file)
- (ert-simulate-keys "label\rwww-url\rwww.hypb.org\r"
+ (hy-test-helpers:ert-simulate-keys "label\rwww-url\rwww.hypb.org\r"
(hui:ebut-create)
(hy-test-helpers-verify-hattr-at-p :actype 'actypes::www-url :args
'("www.hypb.org") :loc file :lbl-key "label"))
- (ert-simulate-keys "\r\r\r\r"
+ (hy-test-helpers:ert-simulate-keys "\r\r\r\r"
(hui:ebut-edit "label")
(hy-test-helpers-verify-hattr-at-p :actype 'actypes::www-url :args
'("www.hypb.org") :loc file :lbl-key "label")
(should (string= "<(label)>" (buffer-string)))))
@@ -628,7 +628,7 @@ Ensure modifying the button but keeping the label does not
create a double label
(unwind-protect
(progn
(find-file file)
- (ert-simulate-keys "ibut\rlink-to-rfc\r123\r"
+ (hy-test-helpers:ert-simulate-keys "ibut\rlink-to-rfc\r123\r"
(hact (lambda () (call-interactively 'hui:ibut-create))))
(should (string= "<[ibut]> - rfc123" (buffer-string))))
(hy-delete-file-and-buffer file))))
@@ -642,7 +642,7 @@ Ensure modifying the button but keeping the label does not
create a double label
(insert "ibut")
(set-mark (point-min))
(goto-char (point-max))
- (ert-simulate-keys "\rlink-to-rfc\r123\r"
+ (hy-test-helpers:ert-simulate-keys "\rlink-to-rfc\r123\r"
(hact (lambda () (call-interactively 'hui:ibut-create))))
(should (string= "<[ibut]> - rfc123" (buffer-string))))
(hy-delete-file-and-buffer file))))
@@ -655,7 +655,7 @@ Ensure modifying the button but keeping the label does not
create a double label
(progn
(find-file file)
(insert "(sexp)")
- (ert-simulate-keys "ibut\rlink-to-rfc\r123\r"
+ (hy-test-helpers:ert-simulate-keys "ibut\rlink-to-rfc\r123\r"
(hact (lambda () (call-interactively 'hui:ibut-create))))
(should (string= "(sexp); <[ibut]> - rfc123" (buffer-string))))
(hy-delete-file-and-buffer file))))
@@ -668,7 +668,7 @@ Ensure modifying the button but keeping the label does not
create a double label
(find-file file)
(insert "\"/tmp\"")
(goto-char 3)
- (ert-simulate-keys "label\r"
+ (hy-test-helpers:ert-simulate-keys "label\r"
(hact (lambda () (call-interactively 'hui:ibut-label-create))))
(should (string= "<[label]> - \"/tmp\"" (buffer-string))))
(hy-delete-file-and-buffer file))))
@@ -682,7 +682,7 @@ With point on label suggest that ibut for rename."
(find-file file)
(insert "<[label]> - rfc123")
(goto-char 3)
- (ert-simulate-keys (kbd "M-DEL renamed RET")
+ (hy-test-helpers:ert-simulate-keys (kbd "M-DEL renamed RET")
(hact (lambda () (call-interactively 'hui:ibut-rename))))
(should (string= "<[renamed]> - rfc123" (buffer-string))))
(hy-delete-file-and-buffer file))))
@@ -695,7 +695,7 @@ With point on label suggest that ibut for rename."
(find-file file)
(insert "<[label]> - rfc123")
(goto-char (point-max))
- (ert-simulate-keys (kbd "label RET M-DEL renamed RET")
+ (hy-test-helpers:ert-simulate-keys (kbd "label RET M-DEL renamed RET")
(hact (lambda () (call-interactively 'hui:ibut-rename))))
(should (string= "<[renamed]> - rfc123" (buffer-string))))
(hy-delete-file-and-buffer file))))
@@ -708,7 +708,7 @@ With point on label suggest that ibut for rename."
(find-file file)
(insert "<[label]> - rfc123")
(goto-char (point-max))
- (ert-simulate-keys "\r"
+ (hy-test-helpers:ert-simulate-keys "\r"
(should-error (hui:ibut-rename "notalabel") :type 'error)))
(hy-delete-file-and-buffer file))))
@@ -828,7 +828,7 @@ With point on label suggest that ibut for rename."
(goto-char (point-max))
(split-window)
(find-file filea)
- (ert-simulate-keys "label\r"
+ (hy-test-helpers:ert-simulate-keys "label\r"
(hui:ibut-link-directly (get-buffer-window) (get-buffer-window
(get-file-buffer fileb)) 4))
(should (string= (buffer-string) (concat "<[label]> - " "\""
(file-name-nondirectory fileb)
@@ -917,7 +917,7 @@ With point on label suggest that ibut for rename."
(goto-char (point-max))
(split-window)
(find-file filea)
- (ert-simulate-keys "button\r"
+ (hy-test-helpers:ert-simulate-keys "button\r"
(hui:ebut-link-directly (get-buffer-window)
(get-buffer-window (get-file-buffer
fileb)))
(should (string= (buffer-string) "<(button)>"))
@@ -946,7 +946,7 @@ With point on label suggest that ibut for rename."
(goto-char (1- (point))))
(split-window)
(find-file file)
- (ert-simulate-keys "button\r"
+ (hy-test-helpers:ert-simulate-keys "button\r"
(hui:ebut-link-directly (get-buffer-window) (get-buffer-window
dir-buf))
;; Implicit link should be the `dir' dired directory,
;; possibly minus the final directory '/'.
@@ -979,7 +979,7 @@ With point on label suggest that ibut for rename."
(mocklet ((gbut:file => global-but-file))
(delete-other-windows)
(find-file file)
- (ert-simulate-keys "button\r"
+ (hy-test-helpers:ert-simulate-keys "button\r"
(hui:gbut-link-directly t)
(with-current-buffer (find-buffer-visiting global-but-file)
(should (string= (buffer-string)
@@ -998,7 +998,7 @@ With point on label suggest that ibut for rename."
(mocklet ((gbut:file => global-but-file))
(delete-other-windows)
(find-file file)
- (ert-simulate-keys "button\r"
+ (hy-test-helpers:ert-simulate-keys "button\r"
(hui:gbut-link-directly)
(with-current-buffer (find-buffer-visiting global-but-file)
(should (string= (buffer-string) "First\n<(button)>\n"))
diff --git a/test/hy-test-helpers.el b/test/hy-test-helpers.el
index 738e3aa34d..54c5a1f7aa 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: 24-Jun-25 at 10:21:13 by Mats Lidell
+;; Last-Mod: 6-Jul-25 at 15:40:23 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -35,6 +35,18 @@
(should (= (length possible-types) 1))
(should (equal first-type type))))
+(defmacro hy-test-helpers:ert-simulate-keys (keys &rest body)
+ "Execute BODY with KEYS as pseudo-interactive input.
+Disable `vertico-mode' which can get in the way of standard key
+processing."
+ (declare (debug t) (indent 1))
+ `(if (bound-and-true-p vertico-mode)
+ (unwind-protect
+ (progn (vertico-mode 0)
+ (ert-simulate-keys ,keys ,@body))
+ (vertico-mode 1))
+ (ert-simulate-keys ,keys ,@body)))
+
(defun hy-test-helpers:should-last-message (msg captured)
"Verify MSG is in CAPTURED text."
(should (string-search msg captured)))
diff --git a/test/hypb-tests.el b/test/hypb-tests.el
index 37c86f9ff2..4a628a61e3 100644
--- a/test/hypb-tests.el
+++ b/test/hypb-tests.el
@@ -3,7 +3,7 @@
;; Author: Mats Lidell <ma...@gnu.org>
;;
;; Orig-Date: 5-Apr-21 at 18:53:10
-;; Last-Mod: 27-May-25 at 22:01:13 by Bob Weiner
+;; Last-Mod: 6-Jul-25 at 14:49:57 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -115,14 +115,15 @@ See Emacs bug#74042 related to usage of texi2any."
(goto-line 1) (move-to-column 1)
;; First line. Line starts with quote.
(should-not (hypb:in-string-p 1))
- (should-not (hypb:in-string-p 2))
+ (should (hypb:in-string-p 2))
(should (hypb:in-string-p 3))
(should (hypb:in-string-p 99))
;; Second line. No quote on the line.
(goto-line 2)
- (dotimes (l 5)
- (should-not (hypb:in-string-p l)))))
+ (should-not (hypb:in-string-p 1))
+ (should (hypb:in-string-p 2))
+ (should (hypb:in-string-p 3))))
;; 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.
diff --git a/test/hywiki-tests.el b/test/hywiki-tests.el
index 56f4527bc0..ef8299be88 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: 24-Jun-25 at 09:36:49 by Mats Lidell
+;; Last-Mod: 6-Jul-25 at 15:39:40 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -902,9 +902,9 @@ Note special meaning of `hywiki-allow-plurals-flag'."
(unwind-protect
(progn
(find-file file)
- (ert-simulate-keys "\r"
+ (hy-test-helpers:ert-simulate-keys "\r"
(should-error (hywiki-add-bookmark "")))
- (ert-simulate-keys "WikiWord\r"
+ (hy-test-helpers:ert-simulate-keys "WikiWord\r"
(hywiki-add-bookmark "WikiWord")
(should (equal '(bookmark . "WikiWord")
(hywiki-get-referent "WikiWord")))))
@@ -916,7 +916,7 @@ Note special meaning of `hywiki-allow-plurals-flag'."
(let ((hywiki-directory (make-temp-file "hywiki" t))
(wikiword "WikiWord"))
(unwind-protect
- (ert-simulate-keys "hpath:find\r"
+ (hy-test-helpers:ert-simulate-keys "hpath:find\r"
(hywiki-add-command wikiword)
(should (equal '(command . hpath:find)
(hywiki-get-referent wikiword))))
@@ -954,7 +954,7 @@ Note special meaning of `hywiki-allow-plurals-flag'."
"Verify `hywiki-add-info-index'."
(let ((hywiki-directory (make-temp-file "hywiki" t)))
(unwind-protect
- (ert-simulate-keys "files\r"
+ (hy-test-helpers:ert-simulate-keys "files\r"
(info "emacs")
(hywiki-add-info-index "WikiWord")
(should (equal '(info-index . "(emacs)files") (hywiki-get-referent
"WikiWord"))))
@@ -964,7 +964,7 @@ Note special meaning of `hywiki-allow-plurals-flag'."
"Verify `hywiki-add-info-node'."
(let ((hywiki-directory (make-temp-file "hywiki" t)))
(unwind-protect
- (ert-simulate-keys "(emacs)\r"
+ (hy-test-helpers:ert-simulate-keys "(emacs)\r"
(hywiki-add-info-node "WikiWord")
(should (equal '(info-node . "(emacs)") (hywiki-get-referent
"WikiWord"))))
(hy-delete-dir-and-buffer hywiki-directory))))
@@ -974,10 +974,10 @@ Note special meaning of `hywiki-allow-plurals-flag'."
(let ((hywiki-directory (make-temp-file "hywiki" t)))
(unwind-protect
(progn
- (ert-simulate-keys "ABC\r"
+ (hy-test-helpers:ert-simulate-keys "ABC\r"
(hywiki-add-key-series "WikiWord")
(should (equal '(key-series . "{ABC}") (hywiki-get-referent
"WikiWord"))))
- (ert-simulate-keys "{ABC}\r"
+ (hy-test-helpers:ert-simulate-keys "{ABC}\r"
(hywiki-add-key-series "WikiWord")
(should (equal '(key-series . "{ABC}") (hywiki-get-referent
"WikiWord")))))
(hy-delete-dir-and-buffer hywiki-directory))))
@@ -1081,7 +1081,7 @@ up the test."
"Verify saving and loading a referent keyseries works ."
(hywiki-tests--referent-test
(cons 'key-series "{ABC}")
- (ert-simulate-keys "ABC\r"
+ (hy-test-helpers:ert-simulate-keys "ABC\r"
(hywiki-add-key-series wiki-referent))))
(ert-deftest hywiki-tests--save-referent-keyseries-use-menu ()
@@ -1114,7 +1114,7 @@ up the test."
"Verify saving and loading a referent bookmark works."
(hywiki-tests--referent-test
(cons 'bookmark wiki-referent)
- (ert-simulate-keys (concat wiki-referent "\r")
+ (hy-test-helpers:ert-simulate-keys (concat wiki-referent "\r")
(hywiki-add-bookmark wiki-referent))))
;; Command
@@ -1127,7 +1127,7 @@ up the test."
"Verify saving and loading a referent command works."
(hywiki-tests--referent-test
(cons 'command #'hywiki-tests--command)
- (ert-simulate-keys "hywiki-tests--command\r"
+ (hy-test-helpers:ert-simulate-keys "hywiki-tests--command\r"
(hywiki-add-command wiki-referent))))
(ert-deftest hywiki-tests--save-referent-command-use-menu ()
@@ -1196,7 +1196,7 @@ up the test."
(hywiki-tests--referent-test
(cons 'info-index "(emacs)files")
(save-excursion
- (ert-simulate-keys "files\r"
+ (hy-test-helpers:ert-simulate-keys "files\r"
(info "emacs")
(hywiki-add-info-index wiki-referent)))))
@@ -1219,7 +1219,7 @@ up the test."
(cons 'info-node "(emacs)")
(save-excursion
(unwind-protect
- (ert-simulate-keys "(emacs)\r"
+ (hy-test-helpers:ert-simulate-keys "(emacs)\r"
(hywiki-add-info-node wiki-referent))
(kill-buffer "*info*")))))
