[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master b9eb7f19452 2/2: Merge branch 'master' of git.savannah.gnu.org:/s
|
From: |
Eli Zaretskii |
|
Subject: |
master b9eb7f19452 2/2: Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs |
|
Date: |
Thu, 17 Oct 2024 09:23:09 -0400 (EDT) |
branch: master
commit b9eb7f194526f654e4cc4d69f6a1632a5e92b18c
Merge: 4c0d69cbff1 ee265922a0d
Author: Eli Zaretskii <eliz@gnu.org>
Commit: Eli Zaretskii <eliz@gnu.org>
Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs
---
doc/misc/eshell.texi | 56 ++++++----
etc/NEWS | 14 +++
lisp/emacs-lisp/comp-cstr.el | 11 +-
lisp/emacs-lisp/comp.el | 5 +-
lisp/eshell/esh-arg.el | 5 +-
lisp/eshell/esh-cmd.el | 104 +++++++++++-------
lisp/eshell/esh-io.el | 5 +-
lisp/eshell/esh-var.el | 4 +-
lisp/jka-cmpr-hook.el | 10 +-
lisp/progmodes/cc-awk.el | 10 +-
lisp/progmodes/cc-defs.el | 123 ++++++++++++++++++---
lisp/progmodes/cc-engine.el | 169 ++++++++++++++++-------------
lisp/progmodes/cc-mode.el | 76 ++++++-------
lisp/progmodes/project.el | 6 +
lisp/vc/log-edit.el | 17 ++-
test/infra/Dockerfile.emba | 26 +----
test/lisp/eshell/esh-arg-tests.el | 13 +++
test/lisp/eshell/esh-cmd-tests.el | 48 +++++++-
test/lisp/eshell/esh-var-tests.el | 3 +
test/src/comp-resources/comp-test-funcs.el | 17 +++
test/src/comp-tests.el | 4 +
21 files changed, 480 insertions(+), 246 deletions(-)
diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi
index f8abb3d860a..9a2714b14fb 100644
--- a/doc/misc/eshell.texi
+++ b/doc/misc/eshell.texi
@@ -1689,36 +1689,52 @@ convenience.
Most of Eshell's control flow statements accept a @var{conditional}.
This can take a few different forms. If @var{conditional} is a dollar
-expansion, the condition is satisfied if the result is a
-non-@code{nil} value. If @var{conditional} is a @samp{@{
-@var{subcommand} @}} or @samp{(@var{lisp form})}, the condition is
-satisfied if the command's exit status is 0.
+expansion, the condition is satisfied if the result is a non-@code{nil}
+value. Alternately, @var{conditional} may be a subcommand, either in
+command form, e.g.@: @samp{@{@var{subcommand}@}}; or in Lisp form,
+e.g.@: @samp{(@var{lisp form})}. In that case, the condition is
+satisfied if the subcommand's exit status is 0.
@table @code
-@item if @var{conditional} @{ @var{true-commands} @}
-@itemx if @var{conditional} @{ @var{true-commands} @} @{ @var{false-commands}
@}
-Evaluate @var{true-commands} if @var{conditional} is satisfied;
-otherwise, evaluate @var{false-commands}.
+@item if @var{conditional} @var{true-subcommand}
+@itemx if @var{conditional} @var{true-subcommand} else @var{false-subcommand}
+Evaluate @var{true-subcommand} if @var{conditional} is satisfied;
+otherwise, evaluate @var{false-subcommand}. Both @var{true-subcommand}
+and @var{false-subcommand} should be subcommands, as with
+@var{conditional}.
-@item unless @var{conditional} @{ @var{false-commands} @}
-@itemx unless @var{conditional} @{ @var{false-commands} @} @{
@var{true-commands} @}
-Evaluate @var{false-commands} if @var{conditional} is not satisfied;
-otherwise, evaluate @var{true-commands}.
+You can also chain together @code{if}/@code{else} forms, for example:
-@item while @var{conditional} @{ @var{commands} @}
-Repeatedly evaluate @var{commands} so long as @var{conditional} is
+@example
+if @{[ -f file.txt ]@} @{
+ echo found file
+@} else if @{[ -f alternate.txt ]@} @{
+ echo found alternate
+@} else @{
+ echo not found!
+@}
+@end example
+
+@item unless @var{conditional} @var{false-subcommand}
+@itemx unless @var{conditional} @var{false-subcommand} else
@var{true-subcommand}
+Evaluate @var{false-subcommand} if @var{conditional} is not satisfied;
+otherwise, evaluate @var{true-subcommand}. Like above, you can also
+chain together @code{unless}/@code{else} forms.
+
+@item while @var{conditional} @var{subcommand}
+Repeatedly evaluate @var{subcommand} so long as @var{conditional} is
satisfied.
-@item until @var{conditional} @{ @var{commands} @}
-Repeatedly evaluate @var{commands} until @var{conditional} is
+@item until @var{conditional} @var{subcommand}
+Repeatedly evaluate @var{subcommand} until @var{conditional} is
satisfied.
-@item for @var{var} in @var{list}@dots{} @{ @var{commands} @}
+@item for @var{var} in @var{list}@dots{} @var{subcommand}
Iterate over each element of @var{list}, storing the element in
-@var{var} and evaluating @var{commands}. If @var{list} is not a list,
-treat it as a list of one element. If you specify multiple
-@var{lists}, this will iterate over each of them in turn.
+@var{var} and evaluating @var{subcommand}. If @var{list} is not a list,
+treat it as a list of one element. If you specify multiple @var{lists},
+this will iterate over each of them in turn.
@end table
diff --git a/etc/NEWS b/etc/NEWS
index 4346fb4aedd..f9ba659ed86 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -257,6 +257,20 @@ These functions now take an optional ERROR-TARGET argument
to control
where to send the standard error output. See the "(eshell) Entry
Points" node in the Eshell manual for more details.
++++
+*** Conditional statements in Eshell now use an 'else' keyword.
+Eshell now prefers the following form when writing conditionals:
+
+ if {conditional} {true-subcommand} else {false-subcommand}
+
+The old form (without the 'else' keyword) is retained for compatibility.
+
++++
+*** You can now chain conditional statements in Eshell.
+When using the newly-preferred conditional form in Eshell, you can now
+chain together multiple 'if'/'else' statements. For more information,
+see "(eshell) Control Flow" in the Eshell manual.
+
+++
*** Eshell's built-in 'wait' command now accepts a timeout.
By passing '-t' or '--timeout', you can specify a maximum time to wait
diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el
index 66c44f16835..3f70b42774f 100644
--- a/lisp/emacs-lisp/comp-cstr.el
+++ b/lisp/emacs-lisp/comp-cstr.el
@@ -936,6 +936,8 @@ Non memoized version of `comp-cstr-intersection-no-mem'."
(defun comp-cstr-type-p (cstr type)
"Return t if CSTR is certainly of type TYPE."
+ ;; Only basic types are valid input.
+ (cl-assert (symbolp type))
(when
(with-comp-cstr-accessors
(cl-case type
@@ -950,9 +952,12 @@ Non memoized version of `comp-cstr-intersection-no-mem'."
(if-let ((pred (get type 'cl-deftype-satisfies)))
(and (null (range cstr))
(null (neg cstr))
- (and (or (null (typeset cstr))
- (equal (typeset cstr) `(,type)))
- (cl-every pred (valset cstr))))
+ (if (null (typeset cstr))
+ (and (valset cstr)
+ (cl-every pred (valset cstr)))
+ (when (equal (typeset cstr) `(,type))
+ ;; (valset cstr) can be nil as well.
+ (cl-every pred (valset cstr)))))
(error "Unknown predicate for type %s" type)))))
t))
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 342212f5185..f72d23fee1a 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -2851,10 +2851,11 @@ Return t if something was changed."
(call symbol-value ,(and (pred comp-cstr-cl-tag-p) mvar-tag)))
(set ,(and (pred comp-mvar-p) mvar-3)
(call memq ,(and (pred comp-mvar-p) mvar-1) ,(and (pred
comp-mvar-p) mvar-2)))
- (cond-jump ,(and (pred comp-mvar-p) mvar-3) ,(pred comp-mvar-p)
,_bb1 ,bb2))
+ (cond-jump ,(and (pred comp-mvar-p) mvar-3) ,(pred comp-mvar-p)
,bb1 ,bb2))
(cl-assert (comp-cstr-imm-vld-p mvar-tag))
(when (comp-cstr-type-p mvar-tested (comp-cstr-cl-tag mvar-tag))
- (comp-log (format "Optimizing conditional branch in function: %s"
+ (comp-log (format "Optimizing conditional branch %s in function: %s"
+ bb1
(comp-func-name comp-func))
3)
(setf (car insns-seq) '(comment "optimized by
comp--type-check-optim")
diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el
index 6fc700cce89..b441cbfc274 100644
--- a/lisp/eshell/esh-arg.el
+++ b/lisp/eshell/esh-arg.el
@@ -35,6 +35,8 @@
(eval-when-compile
(require 'cl-lib))
+(declare-function eshell-term-as-value "esh-cmd" (term))
+
(defgroup eshell-arg nil
"Argument parsing involves transforming the arguments passed on the
command line into equivalent Lisp forms that, when evaluated, will
@@ -626,7 +628,8 @@ If the form has no `type', the syntax is parsed as if
`type' were
(prog1
(cons creation-fun
(let ((eshell-current-argument-plain t))
- (eshell-parse-arguments (point) end)))
+ (mapcar #'eshell-term-as-value
+ (eshell-parse-arguments (point) end))))
(goto-char (1+ end)))
(ignore (goto-char here)))))))
diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el
index 09fc65522ad..c9096b0d159 100644
--- a/lisp/eshell/esh-cmd.el
+++ b/lisp/eshell/esh-cmd.el
@@ -181,8 +181,7 @@ describing where Eshell will find the function."
:type 'hook)
(defcustom eshell-pre-rewrite-command-hook
- '(eshell-no-command-conversion
- eshell-subcommand-arg-values)
+ '(eshell-no-command-conversion)
"A hook run before command rewriting begins.
The terms of the command to be rewritten is passed as arguments, and
may be modified in place. Any return value is ignored."
@@ -455,6 +454,7 @@ command hooks should be run before and after the command."
(defun eshell-subcommand-arg-values (terms)
"Convert subcommand arguments {x} to ${x}, in order to take their values."
+ (declare (obsolete nil "31.1"))
(setq terms (cdr terms)) ; skip command argument
(while terms
(if (and (listp (car terms))
@@ -466,9 +466,9 @@ command hooks should be run before and after the command."
(defun eshell-rewrite-sexp-command (terms)
"Rewrite a sexp in initial position, such as `(+ 1 2)'."
;; this occurs when a Lisp expression is in first position
- (if (and (listp (car terms))
- (eq (caar terms) 'eshell-command-to-value))
- (car (cdar terms))))
+ (when (and (listp (car terms))
+ (eq (caar terms) 'eshell-lisp-command))
+ (car terms)))
(defun eshell-rewrite-initial-subcommand (terms)
"Rewrite a subcommand in initial position, such as `{+ 1 2}'."
@@ -478,19 +478,23 @@ command hooks should be run before and after the command."
(defun eshell-rewrite-named-command (terms)
"If no other rewriting rule transforms TERMS, assume a named command."
- (let ((sym (if eshell-in-pipeline-p
- 'eshell-named-command*
- 'eshell-named-command))
- (grouped-terms (eshell-prepare-splice terms)))
- (cond
- (grouped-terms
- `(let ((terms (nconc ,@grouped-terms)))
- (,sym (car terms) (cdr terms))))
- ;; If no terms are spliced, use a simpler command form.
- ((cdr terms)
- (list sym (car terms) `(list ,@(cdr terms))))
- (t
- (list sym (car terms))))))
+ (when terms
+ (setq terms (cons (car terms)
+ ;; Convert arguments to take their values.
+ (mapcar #'eshell-term-as-value (cdr terms))))
+ (let ((sym (if eshell-in-pipeline-p
+ 'eshell-named-command*
+ 'eshell-named-command))
+ (grouped-terms (eshell-prepare-splice terms)))
+ (cond
+ (grouped-terms
+ `(let ((new-terms (nconc ,@grouped-terms)))
+ (,sym (car new-terms) (cdr new-terms))))
+ ;; If no terms are spliced, use a simpler command form.
+ ((cdr terms)
+ (list sym (car terms) `(list ,@(cdr terms))))
+ (t
+ (list sym (car terms)))))))
(defvar eshell--command-body)
(defvar eshell--test-body)
@@ -503,6 +507,7 @@ current output stream, which is separately redirectable.
SILENT
means the user and/or any redirections shouldn't see any output
from this command. If both SHARE-OUTPUT and SILENT are non-nil,
the second is ignored."
+ (declare (obsolete nil "31.1"))
;; something that begins with `eshell-convert' means that it
;; intends to return a Lisp value. We want to get past this,
;; but if it's not _actually_ a value interpolation -- in which
@@ -536,22 +541,29 @@ implemented via rewriting, rather than as a function."
,@(mapcar
(lambda (elem)
(if (listp elem)
- elem
+ (eshell-term-as-value elem)
`(list ,elem)))
(nthcdr 3 terms)))))
(while ,for-items
(let ((,(intern (cadr terms)) (car ,for-items))
(eshell--local-vars (cons ',(intern (cadr terms))
eshell--local-vars)))
- ,(eshell-invokify-arg body t))
+ ,body)
(setq ,for-items (cdr ,for-items)))))))
-(defun eshell-structure-basic-command (func names keyword test body
- &optional else)
+(defun eshell-structure-basic-command (func names keyword test &rest body)
"With TERMS, KEYWORD, and two NAMES, structure a basic command.
The first of NAMES should be the positive form, and the second the
negative. It's not likely that users should ever need to call this
function."
+ (unless test
+ (error "Missing test for `%s' command" keyword))
+
+ ;; If the test form is a subcommand, wrap it in `eshell-commands' to
+ ;; silence the output.
+ (when (memq (car test) '(eshell-as-subcommand eshell-lisp-command))
+ (setq test `(eshell-commands ,test t)))
+
;; If the test form begins with `eshell-convert' or
;; `eshell-escape-arg', it means something data-wise will be
;; returned, and we should let that determine the truth of the
@@ -572,33 +584,39 @@ function."
(setq test `(not ,test)))
;; Finally, create the form that represents this structured command.
- `(,func ,test ,body ,else))
+ `(,func ,test ,@body))
(defun eshell-rewrite-while-command (terms)
"Rewrite a `while' command into its equivalent Eshell command form.
Because the implementation of `while' relies upon conditional
evaluation of its argument (i.e., use of a Lisp special form), it
must be implemented via rewriting, rather than as a function."
- (if (and (stringp (car terms))
- (member (car terms) '("while" "until")))
- (eshell-structure-basic-command
- 'while '("while" "until") (car terms)
- (eshell-invokify-arg (cadr terms) nil t)
- (eshell-invokify-arg (car (last terms)) t))))
+ (when (and (stringp (car terms))
+ (member (car terms) '("while" "until")))
+ (eshell-structure-basic-command
+ 'while '("while" "until") (car terms)
+ (cadr terms)
+ (caddr terms))))
(defun eshell-rewrite-if-command (terms)
"Rewrite an `if' command into its equivalent Eshell command form.
Because the implementation of `if' relies upon conditional
evaluation of its argument (i.e., use of a Lisp special form), it
must be implemented via rewriting, rather than as a function."
- (if (and (stringp (car terms))
- (member (car terms) '("if" "unless")))
- (eshell-structure-basic-command
- 'if '("if" "unless") (car terms)
- (eshell-invokify-arg (cadr terms) nil t)
- (eshell-invokify-arg (car (last terms (if (= (length terms) 4) 2))) t)
- (when (= (length terms) 4)
- (eshell-invokify-arg (car (last terms)) t)))))
+ (when (and (stringp (car terms))
+ (member (car terms) '("if" "unless")))
+ (eshell-structure-basic-command
+ 'if '("if" "unless") (car terms)
+ (cadr terms)
+ (caddr terms)
+ (if (equal (nth 3 terms) "else")
+ ;; If there's an "else" keyword, allow chaining together
+ ;; multiple "if" forms...
+ (or (eshell-rewrite-if-command (nthcdr 4 terms))
+ (nth 4 terms))
+ ;; ... otherwise, only allow a single "else" block (without the
+ ;; keyword) as before for compatibility.
+ (nth 3 terms)))))
(defun eshell-set-exit-info (status &optional result)
"Set the exit status and result for the last command.
@@ -680,8 +698,7 @@ This means an exit code of 0."
(end-of-file
(throw 'eshell-incomplete "(")))))
(if (eshell-arg-delimiter)
- `(eshell-command-to-value
- (eshell-lisp-command (quote ,obj)))
+ `(eshell-lisp-command (quote ,obj))
(ignore (goto-char here))))))
(defun eshell-split-commands (terms separator &optional
@@ -906,6 +923,15 @@ This avoids the need to use `let*'."
,command
,value))))
+(defun eshell-term-as-value (term)
+ "Convert an Eshell TERM to take its value."
+ (cond
+ ((eq (car-safe term) 'eshell-as-subcommand) ; {x} -> ${x}
+ `(eshell-convert (eshell-command-to-value ,term)))
+ ((eq (car-safe term) 'eshell-lisp-command) ; (x) -> $(x)
+ `(eshell-command-to-value ,term))
+ (t term)))
+
;;;_* Iterative evaluation
;;
;; Eshell runs all of its external commands asynchronously, so that
diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el
index feb4bf8959f..443c39ff0d1 100644
--- a/lisp/eshell/esh-io.el
+++ b/lisp/eshell/esh-io.el
@@ -75,6 +75,7 @@
(require 'cl-lib))
(declare-function eshell-interactive-print "esh-mode" (string))
+(declare-function eshell-term-as-value "esh-cmd" (term))
(defgroup eshell-io nil
"Eshell's I/O management code provides a scheme for treating many
@@ -301,8 +302,8 @@ describing the mode, e.g. for using with
`eshell-get-target'.")
(unless (cdr tt)
(error "Missing redirection target"))
(nconc eshell-current-redirections
- (list (list 'ignore
- (append (car tt) (list (cadr tt))))))
+ `((ignore ,(append (car tt)
+ (list (eshell-term-as-value (cadr tt)))))))
(setcdr tl (cddr tt))
(setq tt (cddr tt)))
(t
diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el
index d53ae997cdf..059bba03ee4 100644
--- a/lisp/eshell/esh-var.el
+++ b/lisp/eshell/esh-var.el
@@ -670,7 +670,9 @@ the original value of INDEX."
(defun eshell-prepare-indices (indices)
"Prepare INDICES to be evaluated by Eshell.
INDICES is a list of index-lists generated by `eshell-parse-indices'."
- `(list ,@(mapcar (lambda (idx-list) (cons 'list idx-list)) indices)))
+ `(list ,@(mapcar (lambda (idx-list)
+ (cons 'list (mapcar #'eshell-term-as-value idx-list)))
+ indices)))
(defun eshell-get-variable (name &optional indices quoted)
"Get the value for the variable NAME.
diff --git a/lisp/jka-cmpr-hook.el b/lisp/jka-cmpr-hook.el
index ced998fafb6..7e502f02b3c 100644
--- a/lisp/jka-cmpr-hook.el
+++ b/lisp/jka-cmpr-hook.el
@@ -160,8 +160,8 @@ and `inhibit-local-variables-suffixes'."
(append auto-mode-alist jka-compr-mode-alist-additions))
;; Make sure that (load "foo") will find /bla/foo.el.gz.
- (setq load-file-rep-suffixes
- (append load-file-rep-suffixes jka-compr-load-suffixes nil)))
+ (dolist (suff jka-compr-load-suffixes load-file-rep-suffixes)
+ (add-to-list 'load-file-rep-suffixes suff t)))
(defun jka-compr-installed-p ()
"Return non-nil if jka-compr is installed.
@@ -379,14 +379,14 @@ compressed when writing."
"Evaluate BODY with automatic file compression and uncompression enabled."
(declare (indent 0))
(let ((already-installed (make-symbol "already-installed")))
- `(let ((,already-installed (jka-compr-installed-p)))
+ `(let ((,already-installed auto-compression-mode))
(unwind-protect
(progn
(unless ,already-installed
- (jka-compr-install))
+ (auto-compression-mode 1))
,@body)
(unless ,already-installed
- (jka-compr-uninstall))))))
+ (auto-compression-mode -1))))))
;; This is what we need to know about jka-compr-handler
;; in order to decide when to call it.
diff --git a/lisp/progmodes/cc-awk.el b/lisp/progmodes/cc-awk.el
index e377c4831fc..b71442c4751 100644
--- a/lisp/progmodes/cc-awk.el
+++ b/lisp/progmodes/cc-awk.el
@@ -761,14 +761,14 @@
(c-put-string-fence end))
((eq (char-after beg) ?/) ; Properly bracketed regexp
(c-put-char-property beg 'syntax-table '(7)) ; (7) = "string"
- (c-put-char-property end 'syntax-table '(7)))
- (t)) ; Properly bracketed string: Nothing to do.
+ (c-put-syntax-table-trim-caches end '(7)))
+ (t)) ; Properly bracketed string: Nothing to do.
;; Now change the properties of any escaped "s in the string to punctuation.
(save-excursion
(goto-char (1+ beg))
(or (eobp)
- (while (search-forward "\"" end t)
- (c-put-char-property (1- (point)) 'syntax-table '(1))))))
+ (while (search-forward "\"" end t)
+ (c-put-syntax-table-trim-caches (1- (point)) '(1))))))
(defun c-awk-syntax-tablify-string ()
;; Point is at the opening " or _" of a string. Set the syntax-table
@@ -861,7 +861,7 @@
(let (anchor
(anchor-state-/div nil)) ; t means a following / would be a div sign.
(c-awk-beginning-of-logical-line) ; ACM 2002/7/21. This is probably
redundant.
- (c-clear-char-properties (point) lim 'syntax-table)
+ (c-clear-syntax-table-properties-trim-caches (point) lim)
;; Once round the next loop for each string, regexp, or div sign
(while (progn
;; Skip any "harmless" lines before the next tricky one.
diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el
index e45ab76ec07..b6137c02ca9 100644
--- a/lisp/progmodes/cc-defs.el
+++ b/lisp/progmodes/cc-defs.el
@@ -1248,6 +1248,14 @@ MODE is either a mode symbol or a list of mode symbols."
`((setq c-syntax-table-hwm (min c-syntax-table-hwm -pos-))))
(put-text-property -pos- (1+ -pos-) ',property ,value))))
+(defmacro c-put-syntax-table-trim-caches (pos value)
+ ;; Put a 'syntax-table property with VALUE at POS. Also invalidate four
+ ;; caches from the position POS.
+ (declare (debug t))
+ `(let ((-pos- ,pos))
+ (c-put-char-property -pos- 'syntax-table ,value)
+ (c-truncate-lit-pos/state-cache -pos-)))
+
(defmacro c-put-string-fence (pos)
;; Put the string-fence syntax-table text property at POS.
;; Since the character there cannot then count as syntactic whitespace,
@@ -1333,6 +1341,14 @@ MODE is either a mode symbol or a list of mode symbols."
;; Emacs < 21.
`(c-clear-char-property-fun ,pos ',property))))
+(defmacro c-clear-syntax-table-trim-caches (pos)
+ ;; Remove the 'syntax-table property at POS and invalidate the four caches
+ ;; from that position.
+ (declare (debug t))
+ `(let ((-pos- ,pos))
+ (c-clear-char-property -pos- 'syntax-table)
+ (c-truncate-lit-pos/state-cache -pos-)))
+
(defmacro c-min-property-position (from to property)
;; Return the first position in the range [FROM to) where the text property
;; PROPERTY is set, or `most-positive-fixnum' if there is no such position.
@@ -1387,7 +1403,8 @@ MODE is either a mode symbol or a list of mode symbols."
(c-use-extents
;; XEmacs
`(map-extents (lambda (ext ignored)
- (delete-extent ext))
+ (delete-extent ext)
+ nil) ; To prevent exit from `map-extents'.
nil ret -to- nil nil ',property))
((and (fboundp 'syntax-ppss)
(eq property 'syntax-table))
@@ -1402,6 +1419,15 @@ MODE is either a mode symbol or a list of mode symbols."
ret)
nil)))
+(defmacro c-clear-syntax-table-properties-trim-caches (from to)
+ ;; Remove all occurrences of the 'syntax-table property in (FROM TO) and
+ ;; invalidate the four caches from the first position from which the
+ ;; property was removed, if any.
+ (declare (debug t))
+ `(let ((first (c-clear-char-properties ,from ,to 'syntax-table)))
+ (when first
+ (c-truncate-lit-pos/state-cache first))))
+
(defmacro c-clear-syn-tab-properties (from to)
;; Remove all occurrences of the `syntax-table' and `c-fl-syn-tab' text
;; properties between FROM and TO.
@@ -1492,8 +1518,10 @@ point is then left undefined."
"Remove all text-properties PROPERTY from the region (FROM, TO)
which have the value VALUE, as tested by `equal'. These
properties are assumed to be over individual characters, having
-been put there by `c-put-char-property'. POINT remains unchanged."
- (let ((place from) end-place)
+been put there by `c-put-char-property'. POINT remains unchanged.
+Return the position of the first removed property, if any, or nil."
+ (let ((place from) end-place
+ first)
(while ; loop round occurrences of (PROPERTY VALUE)
(progn
(while ; loop round changes in PROPERTY till we find VALUE
@@ -1506,25 +1534,51 @@ been put there by `c-put-char-property'. POINT remains
unchanged."
(setq c-syntax-table-hwm (min c-syntax-table-hwm place)))
(setq end-place (c-next-single-property-change place property nil to))
(remove-text-properties place end-place (list property nil))
+ (unless first (setq first place))
;; Do we have to do anything with stickiness here?
- (setq place end-place))))
+ (setq place end-place))
+ first))
(defmacro c-clear-char-property-with-value (from to property value)
"Remove all text-properties PROPERTY from the region [FROM, TO)
which have the value VALUE, as tested by `equal'. These
properties are assumed to be over individual characters, having
-been put there by `c-put-char-property'. POINT remains unchanged."
+been put there by `c-put-char-property'. POINT remains unchanged.
+Return the position of the first removed property, or nil."
(declare (debug t))
(if c-use-extents
;; XEmacs
- `(let ((-property- ,property))
+ `(let ((-property- ,property)
+ (first (1+ (point-max))))
(map-extents (lambda (ext val)
- (if (equal (extent-property ext -property-) val)
- (delete-extent ext)))
- nil ,from ,to ,value nil -property-))
- ;; GNU Emacs
+ ;; In the following, the test on the extent's property
+ ;; is probably redundant. See documentation of
+ ;; `map-extents'. NO it's NOT! This automatic check
+ ;; would require another argument to `map-extents',
+ ;; but the test would use `eq', not `equal', so it's
+ ;; no good. :-(
+ (when (equal (extent-property ext -property-) val)
+ (setq first (min first
+ (extent-start-position ext)))
+ (delete-extent ext))
+ nil)
+ nil ,from ,to ,value nil -property-)
+ (and (<= first (point-max)) first))
+ ;; Gnu Emacs
`(c-clear-char-property-with-value-function ,from ,to ,property ,value)))
+(defmacro c-clear-syntax-table-with-value-trim-caches (from to value)
+ "Remove all `syntax-table' text-properties with value VALUE from [FROM, TO)
+and invalidate the four caches from the first postion, if any, where a
+property was removed. Return the position of the first property removed,
+if any, else nil. POINT and the match data remain unchanged."
+ (declare (debug t))
+ `(let ((first
+ (c-clear-char-property-with-value ,from ,to 'syntax-table ,value)))
+ (when first
+ (c-truncate-lit-pos/state-cache first))
+ first))
+
(defmacro c-search-forward-char-property-with-value-on-char
(property value char &optional limit)
"Search forward for a text-property PROPERTY having value VALUE on a
@@ -1620,7 +1674,8 @@ property, or nil."
(or first
(progn (setq first place)
(when (eq property 'syntax-table)
- (setq c-syntax-table-hwm (min c-syntax-table-hwm
place))))))
+ (setq c-syntax-table-hwm
+ (min c-syntax-table-hwm place))))))
;; Do we have to do anything with stickiness here?
(setq place (1+ place)))
first))
@@ -1639,26 +1694,46 @@ property, or nil."
(-char- ,char)
(first (1+ (point-max))))
(map-extents (lambda (ext val)
- (when (and (equal (extent-property ext -property-) val)
+ ;; In the following, the test on the extent's property
+ ;; is probably redundant. See documentation of
+ ;; map-extents. NO! See
+ ;; `c-clear-char-property-with-value'.
+ (when (and (equal (extent-property ext -property-)
+ val)
(eq (char-after
(extent-start-position ext))
-char-))
(setq first (min first (extent-start-position ext)))
- (delete-extent ext)))
+ (delete-extent ext))
+ nil)
nil ,from ,to ,value nil -property-)
(and (<= first (point-max)) first))
- ;; GNU Emacs
+ ;; Gnu Emacs
`(c-clear-char-property-with-value-on-char-function ,from ,to ,property
,value ,char)))
+(defmacro c-clear-syntax-table-with-value-on-char-trim-caches
+ (from to value char)
+ "Remove all `syntax-table' properties with VALUE on CHAR in [FROM, TO),
+as tested by `equal', and invalidate the four caches from the first position,
+if any, where a property was removed. POINT and the match data remain
+unchanged."
+ (declare (debug t))
+ `(let ((first (c-clear-char-property-with-value-on-char
+ ,from ,to 'syntax-table ,value ,char)))
+ (when first
+ (c-truncate-lit-pos/state-cache first))))
+
(defmacro c-put-char-properties-on-char (from to property value char)
;; This needs to be a macro because `property' passed to
;; `c-put-char-property' must be a constant.
"Put the text property PROPERTY with value VALUE on characters
-with value CHAR in the region [FROM to)."
+with value CHAR in the region [FROM to). Return the position of the
+first char changed, if any, else nil."
(declare (debug t))
`(let ((skip-string (concat "^" (list ,char)))
- (-to- ,to))
+ (-to- ,to)
+ first)
(save-excursion
(goto-char ,from)
(while (progn (skip-chars-forward skip-string -to-)
@@ -1667,8 +1742,20 @@ with value CHAR in the region [FROM to)."
(eq (eval property) 'syntax-table))
`((setq c-syntax-table-hwm (min c-syntax-table-hwm (point)))))
(c-put-char-property (point) ,property ,value)
- (forward-char)))))
-
+ (when (not first) (setq first (point)))
+ (forward-char)))
+ first))
+
+(defmacro c-put-syntax-table-properties-on-char-trim-caches
+ (from to value char)
+ "Put a `syntax-table' text property with value VALUE on all characters
+with value CHAR in the region [FROM to), and invalidate the four caches
+from the first position, if any, where a property was put."
+ (declare (debug t))
+ `(let ((first (c-put-char-properties-on-char
+ ,from ,to 'syntax-table ,value ,char)))
+ (when first
+ (c-truncate-lit-pos/state-cache first))))
;; Miscellaneous macro(s)
(defvar c-string-fences-set-flag nil)
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index 868267f06f4..c46cd54438b 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -164,6 +164,7 @@
(cc-require-when-compile 'cc-langs)
(cc-require 'cc-vars)
+(defvar c-state-cache-invalid-pos)
(defvar c-doc-line-join-re)
(defvar c-doc-bright-comment-start-re)
(defvar c-doc-line-join-end-ch)
@@ -2199,8 +2200,9 @@ comment at the start of cc-engine.el for more info."
(c-put-is-sws (1+ rung-pos)
(1+ (point)))
(c-put-in-sws rung-pos
- (setq rung-pos (point)
- last-put-in-sws-pos rung-pos)))
+ (point))
+ (setq rung-pos (point)
+ last-put-in-sws-pos rung-pos))
;; Now move over any comments (x)or a CPP construct.
(setq simple-ws-end (point))
@@ -3210,6 +3212,7 @@ comment at the start of cc-engine.el for more info."
(c-full-put-near-cache-entry here s nil))
(list s))))))))
+
(defsubst c-truncate-lit-pos-cache (pos)
;; Truncate the upper bound of each of the three caches to POS, if it is
;; higher than that position.
@@ -3217,6 +3220,12 @@ comment at the start of cc-engine.el for more info."
c-semi-near-cache-limit (min c-semi-near-cache-limit pos)
c-full-near-cache-limit (min c-full-near-cache-limit pos)))
+(defsubst c-truncate-lit-pos/state-cache (pos)
+ ;; Truncate the upper bound of each of the four caches to POS, if it is
+ ;; higher than that position.
+ (c-truncate-lit-pos-cache pos)
+ (setq c-state-cache-invalid-pos (min c-state-cache-invalid-pos pos)))
+
(defun c-foreign-truncate-lit-pos-cache (beg _end)
"Truncate CC Mode's literal cache.
@@ -3266,7 +3275,7 @@ initializing CC Mode. Currently (2020-06) these are
`js-mode' and
;; subparen that is closed before the last recorded position.
;;
;; The exact position is chosen to try to be close to yet earlier than
-;; the position where `c-state-cache' will be called next. Right now
+;; the position where `c-parse-state' will be called next. Right now
;; the heuristic is to set it to the position after the last found
;; closing paren (of any type) before the line on which
;; `c-parse-state' was called. That is chosen primarily to work well
@@ -3282,6 +3291,19 @@ initializing CC Mode. Currently (2020-06) these are
`js-mode' and
;; the middle of the desert, as long as it is not within a brace pair
;; recorded in `c-state-cache' or a paren/bracket pair.
+(defvar c-state-cache-invalid-pos 1)
+(make-variable-buffer-local 'c-state-cache-invalid-pos)
+;; This variable is always a number, and is typically eq to
+;; `c-state-cache-good-pos'.
+;;
+;; Its purpose is to record the position that `c-invalidate-state-cache' needs
+;; to trim `c-state-cache' to.
+;;
+;; When a `syntax-table' text property has been
+;; modified at a position before `c-state-cache-good-pos', it gets set to
+;; the lowest such position. When that variable is nil,
+;; `c-state-cache-invalid-pos' is set to `c-state-point-min-literal'.
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; We maintain a simple cache of positions which aren't in a literal, so as to
;; speed up testing for non-literality.
@@ -3747,6 +3769,7 @@ initializing CC Mode. Currently (2020-06) these are
`js-mode' and
(c-state-mark-point-min-literal)
(setq c-state-cache nil
c-state-cache-good-pos c-state-min-scan-pos
+ c-state-cache-invalid-pos c-state-cache-good-pos
c-state-brace-pair-desert nil))
;; point-min has MOVED FORWARD.
@@ -3770,7 +3793,8 @@ initializing CC Mode. Currently (2020-06) these are
`js-mode' and
; inside a recorded
; brace pair.
(setq c-state-cache nil
- c-state-cache-good-pos c-state-min-scan-pos)
+ c-state-cache-good-pos c-state-min-scan-pos
+ c-state-cache-invalid-pos c-state-cache-good-pos)
;; Do not alter the original `c-state-cache' structure, since there
;; may be a loop suspended which is looping through that structure.
;; This may have been the cause of bug #37910.
@@ -3778,7 +3802,8 @@ initializing CC Mode. Currently (2020-06) these are
`js-mode' and
(setcdr ptr nil)
(setq c-state-cache (copy-sequence c-state-cache))
(setcdr ptr cdr-ptr))
- (setq c-state-cache-good-pos (1+ (c-state-cache-top-lparen))))
+ (setq c-state-cache-good-pos (1+ (c-state-cache-top-lparen))
+ c-state-cache-invalid-pos c-state-cache-good-pos))
)))
(setq c-state-point-min (point-min)))
@@ -4302,6 +4327,7 @@ initializing CC Mode. Currently (2020-06) these are
`js-mode' and
(defun c-state-cache-init ()
(setq c-state-cache nil
c-state-cache-good-pos 1
+ c-state-cache-invalid-pos 1
c-state-nonlit-pos-cache nil
c-state-nonlit-pos-cache-limit 1
c-state-brace-pair-desert nil
@@ -4338,8 +4364,9 @@ initializing CC Mode. Currently (2020-06) these are
`js-mode' and
(defun c-invalidate-state-cache-1 (here)
;; Invalidate all info on `c-state-cache' that applies to the buffer at HERE
- ;; or higher and set `c-state-cache-good-pos' accordingly. The cache is
- ;; left in a consistent state.
+ ;; or higher and set `c-state-cache-good-pos' and
+ ;; `c-state-cache-invalid-pos' accordingly. The cache is left in a
+ ;; consistent state.
;;
;; This is much like `c-whack-state-after', but it never changes a paren
;; pair element into an open paren element. Doing that would mean that the
@@ -4353,7 +4380,6 @@ initializing CC Mode. Currently (2020-06) these are
`js-mode' and
;; HERE.
(if (<= here c-state-nonlit-pos-cache-limit)
(setq c-state-nonlit-pos-cache-limit (1- here)))
- (c-truncate-lit-pos-cache here)
(cond
;; `c-state-cache':
@@ -4363,6 +4389,7 @@ initializing CC Mode. Currently (2020-06) these are
`js-mode' and
(< here (c-state-get-min-scan-pos)))
(setq c-state-cache nil
c-state-cache-good-pos nil
+ c-state-cache-invalid-pos (c-state-get-min-scan-pos)
c-state-min-scan-pos nil))
;; Case 2: `here' is below `c-state-cache-good-pos', so we need to amend
@@ -4377,7 +4404,9 @@ initializing CC Mode. Currently (2020-06) these are
`js-mode' and
(setq c-state-cache-good-pos
(if scan-forward-p
(c-append-to-state-cache good-pos here)
- good-pos)))))
+ good-pos)
+ c-state-cache-invalid-pos
+ (or c-state-cache-good-pos (c-state-get-min-scan-pos))))))
;; The brace-pair desert marker:
(when (car c-state-brace-pair-desert)
@@ -4474,7 +4503,8 @@ initializing CC Mode. Currently (2020-06) these are
`js-mode' and
(if (and bopl-state
(< good-pos (- here c-state-cache-too-far)))
(c-state-cache-lower-good-pos here here-bopl bopl-state)
- good-pos)))
+ good-pos)
+ c-state-cache-invalid-pos c-state-cache-good-pos))
((eq strategy 'backward)
(setq res (c-remove-stale-state-cache-backwards here)
@@ -4486,7 +4516,8 @@ initializing CC Mode. Currently (2020-06) these are
`js-mode' and
(setq c-state-cache-good-pos
(if scan-forward-p
(c-append-to-state-cache good-pos here)
- good-pos)))
+ good-pos)
+ c-state-cache-invalid-pos c-state-cache-good-pos))
(t ; (eq strategy 'IN-LIT)
(setq c-state-cache nil
@@ -4494,7 +4525,7 @@ initializing CC Mode. Currently (2020-06) these are
`js-mode' and
c-state-cache)
-(defun c-invalidate-state-cache (here)
+(defun c-invalidate-state-cache ()
;; This is a wrapper over `c-invalidate-state-cache-1'.
;;
;; It suppresses the syntactic effect of the < and > (template) brackets and
@@ -4504,9 +4535,9 @@ initializing CC Mode. Currently (2020-06) these are
`js-mode' and
(if (eval-when-compile (memq 'category-properties c-emacs-features))
;; Emacs
(c-with-<->-as-parens-suppressed
- (c-invalidate-state-cache-1 here))
+ (c-invalidate-state-cache-1 c-state-cache-invalid-pos))
;; XEmacs
- (c-invalidate-state-cache-1 here)))
+ (c-invalidate-state-cache-1 c-state-cache-invalid-pos)))
(defmacro c-state-maybe-marker (place marker)
;; If PLACE is non-nil, return a marker marking it, otherwise nil.
@@ -4539,8 +4570,14 @@ initializing CC Mode. Currently (2020-06) these are
`js-mode' and
(if (eval-when-compile (memq 'category-properties c-emacs-features))
;; Emacs
(c-with-<->-as-parens-suppressed
+ (when (< c-state-cache-invalid-pos
+ (or c-state-cache-good-pos (c-state-get-min-scan-pos)))
+ (c-invalidate-state-cache-1 c-state-cache-invalid-pos))
(c-parse-state-1))
;; XEmacs
+ (when (< c-state-cache-invalid-pos
+ (or c-state-cache-good-pos (c-state-get-min-scan-pos)))
+ (c-invalidate-state-cache-1 c-state-cache-invalid-pos))
(c-parse-state-1))
(setq c-state-old-cpp-beg
(c-state-maybe-marker here-cpp-beg c-state-old-cpp-beg-marker)
@@ -4572,6 +4609,7 @@ initializing CC Mode. Currently (2020-06) these are
`js-mode' and
(t val)))))
'(c-state-cache
c-state-cache-good-pos
+ c-state-cache-invalid-pos
c-state-nonlit-pos-cache
c-state-nonlit-pos-cache-limit
c-state-brace-pair-desert
@@ -4609,6 +4647,7 @@ initializing CC Mode. Currently (2020-06) these are
`js-mode' and
(let ((here (point)) (min-point (point-min)) (res1 (c-real-parse-state))
res2)
(let ((c-state-cache nil)
(c-state-cache-good-pos 1)
+ (c-state-cache-invalid-pos 1)
(c-state-nonlit-pos-cache nil)
(c-state-nonlit-pos-cache-limit 1)
(c-state-brace-pair-desert nil)
@@ -6999,9 +7038,9 @@ comment at the start of cc-engine.el for more info."
(when (equal (c-get-char-property (1- (point)) 'syntax-table)
c->-as-paren-syntax) ; should always be true.
(c-unmark-<->-as-paren (1- (point)))
- (c-truncate-lit-pos-cache (1- (point))))
+ (c-truncate-lit-pos/state-cache (1- (point))))
(c-unmark-<->-as-paren pos)
- (c-truncate-lit-pos-cache pos))))
+ (c-truncate-lit-pos/state-cache pos))))
(defun c-clear->-pair-props (&optional pos)
;; POS (default point) is at a > character. If it is marked with
@@ -7018,9 +7057,9 @@ comment at the start of cc-engine.el for more info."
(when (equal (c-get-char-property (point) 'syntax-table)
c-<-as-paren-syntax) ; should always be true.
(c-unmark-<->-as-paren (point))
- (c-truncate-lit-pos-cache (point)))
+ (c-truncate-lit-pos/state-cache (point)))
(c-unmark-<->-as-paren pos)
- (c-truncate-lit-pos-cache pos))))
+ (c-truncate-lit-pos/state-cache pos))))
(defun c-clear-<>-pair-props (&optional pos)
;; POS (default point) is at a < or > character. If it has an
@@ -7054,7 +7093,7 @@ comment at the start of cc-engine.el for more info."
c->-as-paren-syntax)) ; should always be true.
(c-unmark-<->-as-paren (1- (point)))
(c-unmark-<->-as-paren pos)
- (c-truncate-lit-pos-cache pos)
+ (c-truncate-lit-pos/state-cache pos)
(point)))))
(defun c-clear->-pair-props-if-match-before (lim &optional pos)
@@ -7075,7 +7114,7 @@ comment at the start of cc-engine.el for more info."
(equal (c-get-char-property (point) 'syntax-table)
c-<-as-paren-syntax)) ; should always be true.
(c-unmark-<->-as-paren (point))
- (c-truncate-lit-pos-cache (point))
+ (c-truncate-lit-pos/state-cache (point))
(c-unmark-<->-as-paren pos)
(point)))))
@@ -7194,7 +7233,8 @@ comment at the start of cc-engine.el for more info."
(not (eq beg-literal-end end-literal-end))
(skip-chars-forward "\\\\")
(eq (char-after) ?\n)
- (not (zerop (skip-chars-backward "\\\\"))))
+ (not (zerop (skip-chars-backward "\\\\")))
+ (< (point) end))
(setq swap-open-string-ends t)
(if (c-get-char-property (1- beg-literal-end)
'syntax-table)
@@ -7500,16 +7540,11 @@ multi-line strings (but not C++, for example)."
;; Remove any syntax-table text properties from the multi-line string
;; delimiters specified by STRING-DELIMS, the output of
;; `c-ml-string-delims-around-point'.
- (let (found)
- (if (setq found (c-clear-char-properties (caar string-delims)
- (cadar string-delims)
- 'syntax-table))
- (c-truncate-lit-pos-cache found))
+ (c-clear-syntax-table-properties-trim-caches (caar string-delims)
+ (cadar string-delims))
(when (cdr string-delims)
- (if (setq found (c-clear-char-properties (cadr string-delims)
- (caddr string-delims)
- 'syntax-table))
- (c-truncate-lit-pos-cache found)))))
+ (c-clear-syntax-table-properties-trim-caches (cadr string-delims)
+ (caddr string-delims))))
(defun c-get-ml-closer (open-delim)
;; Return the closer, a three element dotted list of the closer's start, its
@@ -7943,7 +7978,7 @@ multi-line strings (but not C++, for example)."
((eq (nth 3 (car state)) t)
(insert ?\")
(c-put-string-fence end)))
- (c-truncate-lit-pos-cache end)
+ (c-truncate-lit-pos/state-cache end)
;; ....ensure c-new-END extends right to the end of the about
;; to be un-stringed raw string....
(save-excursion
@@ -7963,7 +7998,7 @@ multi-line strings (but not C++, for example)."
;; Remove the temporary string delimiter.
(goto-char end)
(delete-char 1)
- (c-truncate-lit-pos-cache end))))
+ (c-truncate-lit-pos/state-cache end))))
;; Have we just created a new starting id?
(goto-char beg)
@@ -8013,7 +8048,7 @@ multi-line strings (but not C++, for example)."
(> (point) beg)))
(goto-char (caar c-old-1-beg-ml))
(setq c-new-BEG (min c-new-BEG (point)))
- (c-truncate-lit-pos-cache (point))))
+ (c-truncate-lit-pos/state-cache (point))))
(when (looking-at c-ml-string-opener-re)
(goto-char (match-end 1))
@@ -8026,11 +8061,8 @@ multi-line strings (but not C++, for example)."
(when (c-get-char-property (match-beginning 2) 'c-fl-syn-tab)
(c-remove-string-fences (match-beginning 2)))
(setq c-new-END (point-max))
- (c-clear-char-properties (caar (or c-old-beg-ml c-old-1-beg-ml))
- c-new-END
- 'syntax-table)
- (c-truncate-lit-pos-cache
- (caar (or c-old-beg-ml c-old-1-beg-ml))))))
+ (c-clear-syntax-table-properties-trim-caches
+ (caar (or c-old-beg-ml c-old-1-beg-ml)) c-new-END))))
;; Have we disturbed the innards of an ml string, possibly by deleting "s?
(when (and
@@ -8056,10 +8088,9 @@ multi-line strings (but not C++, for example)."
bound 'bound)
(< (match-end 1) new-END-end-ml-string))
(setq c-new-END (max new-END-end-ml-string c-new-END))
- (c-clear-char-properties (caar c-old-beg-ml) c-new-END
- 'syntax-table)
- (setq c-new-BEG (min (caar c-old-beg-ml) c-new-BEG))
- (c-truncate-lit-pos-cache (caar c-old-beg-ml)))))
+ (c-clear-syntax-table-properties-trim-caches
+ (caar c-old-beg-ml) c-new-END)
+ (setq c-new-BEG (min (caar c-old-beg-ml) c-new-BEG)))))
;; Have we terminated an existing raw string by inserting or removing
;; text?
@@ -8093,7 +8124,7 @@ multi-line strings (but not C++, for example)."
(setq c-new-BEG (min (point) c-new-BEG)
c-new-END (point-max))
(c-clear-syn-tab-properties (point) c-new-END)
- (c-truncate-lit-pos-cache (point)))))
+ (c-truncate-lit-pos/state-cache (point)))))
;; Are there any raw strings in a newly created macro?
(goto-char (c-point 'bol beg))
@@ -8147,8 +8178,7 @@ multi-line strings (but not C++, for example)."
(cadr delim))
(< (point) (cadr delim)))
(when (not (eq (point) (cddr delim)))
- (c-put-char-property (point) 'syntax-table '(1))
- (c-truncate-lit-pos-cache (point)))
+ (c-put-syntax-table-trim-caches (point) '(1)))
(forward-char))))
(defun c-propertize-ml-string-opener (delim bound)
@@ -8181,14 +8211,12 @@ multi-line strings (but not C++, for example)."
(while (progn (skip-syntax-forward c-ml-string-non-punc-skip-chars
(car end-delim))
(< (point) (car end-delim)))
- (c-put-char-property (point) 'syntax-table '(1)) ; punctuation
- (c-truncate-lit-pos-cache (point))
+ (c-put-syntax-table-trim-caches (point) '(1)) ; punctuation
(forward-char))
(goto-char (cadr end-delim))
t)
- (c-put-char-property (cddr delim) 'syntax-table '(1))
+ (c-put-syntax-table-trim-caches (cddr delim) '(1))
(c-put-string-fence (1- (cadr delim)))
- (c-truncate-lit-pos-cache (1- (cddr delim)))
(when bound
;; In a CPP construct, we try to apply a generic-string
;; `syntax-table' text property to the last possible character in
@@ -8218,10 +8246,9 @@ multi-line strings (but not C++, for example)."
(if (match-beginning 10)
(progn
(c-put-string-fence (match-beginning 10))
- (c-truncate-lit-pos-cache (match-beginning 10)))
- (c-put-char-property (match-beginning 5) 'syntax-table '(1))
- (c-put-string-fence (1+ (match-beginning 5)))
- (c-truncate-lit-pos-cache (match-beginning 5))))
+ (c-truncate-lit-pos/state-cache (match-beginning 10)))
+ (c-put-syntax-table-trim-caches (match-beginning 5) '(1))
+ (c-put-string-fence (1+ (match-beginning 5)))))
(goto-char bound))
nil))
@@ -8261,20 +8288,18 @@ multi-line strings (but not C++, for example)."
'(15)))
(goto-char (cdddr string-delims))
(when (c-safe (c-forward-sexp)) ; To '(15) at EOL.
- (c-clear-char-property (1- (point)) 'syntax-table)
- (c-truncate-lit-pos-cache (1- (point)))))
+ (c-clear-syntax-table-trim-caches (1- (point)))))
;; The '(15) in the closing delimiter will be cleared by the following.
(c-depropertize-ml-string-delims string-delims)
(let ((bound1 (if (cdr string-delims)
(caddr string-delims) ; end of closing delimiter.
bound))
- first s)
- (if (and
- bound1
- (setq first (c-clear-char-properties (cadar string-delims) bound1
- 'syntax-table)))
- (c-truncate-lit-pos-cache first))
+ s)
+ (if bound1
+ (c-clear-syntax-table-properties-trim-caches
+ (cadar string-delims) bound1))
+
(setq s (parse-partial-sexp (or c-neutralize-pos (caar string-delims))
(or bound1 (point-max))))
(cond
@@ -8283,15 +8308,13 @@ multi-line strings (but not C++, for example)."
(setq c-neutralize-pos (nth 8 s))
(setq c-neutralized-prop (c-get-char-property c-neutralize-pos
'syntax-table))
- (c-put-char-property c-neutralize-pos 'syntax-table '(1))
- (c-truncate-lit-pos-cache c-neutralize-pos))
+ (c-put-syntax-table-trim-caches c-neutralize-pos '(1)))
((eq (nth 3 s) (char-after c-neutralize-pos))
;; New unbalanced quote balances old one.
(if c-neutralized-prop
- (c-put-char-property c-neutralize-pos 'syntax-table
- c-neutralized-prop)
- (c-clear-char-property c-neutralize-pos 'syntax-table))
- (c-truncate-lit-pos-cache c-neutralize-pos)
+ (c-put-syntax-table-trim-caches c-neutralize-pos
+ c-neutralized-prop)
+ (c-clear-syntax-table-trim-caches c-neutralize-pos))
(setq c-neutralize-pos nil))
;; New unbalanced quote doesn't balance old one. Nothing to do.
)))
@@ -8350,10 +8373,8 @@ multi-line strings (but not C++, for example)."
eom))))))) ; bound.
(when c-neutralize-pos
(if c-neutralized-prop
- (c-put-char-property c-neutralize-pos 'syntax-table
- c-neutralized-prop)
- (c-clear-char-property c-neutralize-pos 'syntax-table))
- (c-truncate-lit-pos-cache c-neutralize-pos)))
+ (c-put-syntax-table-trim-caches c-neutralize-pos c-neutralized-prop)
+ (c-clear-syntax-table-trim-caches c-neutralize-pos))))
(defun c-before-after-change-check-c++-modules (beg end &optional _old_len)
@@ -8793,7 +8814,7 @@ multi-line strings (but not C++, for example)."
(when c-parse-and-markup-<>-arglists
(c-mark-<-as-paren (point))
(c-mark->-as-paren (match-beginning 1))
- (c-truncate-lit-pos-cache (point)))
+ (c-truncate-lit-pos/state-cache (point)))
(goto-char (match-end 1))
t)
nil))
@@ -8927,11 +8948,11 @@ multi-line strings (but not C++, for example)."
(save-excursion
(and (c-go-list-backward)
(eq (char-after) ?<)
- (c-truncate-lit-pos-cache (point))
+ (c-truncate-lit-pos/state-cache (point))
(c-unmark-<->-as-paren (point)))))
(c-mark-<-as-paren start)
(c-mark->-as-paren (1- (point)))
- (c-truncate-lit-pos-cache start))
+ (c-truncate-lit-pos/state-cache start))
(setq res t)
nil)) ; Exit the loop.
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index fe3ddaa170f..71fafeca59f 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -658,7 +658,7 @@ that requires a literal mode spec at compile time."
;; Initialize the cache for `c-looking-at-or-maybe-in-bracelist'.
(setq c-laomib-cache nil)
;; Initialize the three literal sub-caches.
- (c-truncate-lit-pos-cache 1)
+ (c-truncate-lit-pos/state-cache 1)
;; Initialize the cache of brace pairs, and opening braces/brackets/parens.
(c-state-cache-init)
;; Initialize the "brace stack" cache.
@@ -1023,8 +1023,8 @@ Note that the style variables are always made local to
the buffer."
(setq m-beg (point))
(c-end-of-macro)
(when c-ml-string-opener-re
- (save-excursion (c-depropertize-ml-strings-in-region m-beg (point))))
- (c-clear-char-property-with-value m-beg (point) 'syntax-table '(1)))
+ (save-excursion (c-depropertize-ml-strings-in-region m-beg (point)))
+ (c-clear-syntax-table-with-value-trim-caches m-beg (point) '(1))))
(while (and (< (point) end)
(setq ss-found
@@ -1035,17 +1035,17 @@ Note that the style variables are always made local to
the buffer."
(when (and ss-found (> (point) end))
(when c-ml-string-opener-re
(save-excursion (c-depropertize-ml-strings-in-region m-beg (point))))
- (c-clear-char-property-with-value m-beg (point) 'syntax-table '(1)))
+ (c-clear-syntax-table-with-value-trim-caches m-beg (point) '(1)))
(while (and (< (point) c-new-END)
- (search-forward-regexp c-anchored-cpp-prefix c-new-END 'bound))
+ (search-forward-regexp c-anchored-cpp-prefix
+ c-new-END 'bound))
(goto-char (match-beginning 1))
(setq m-beg (point))
(c-end-of-macro)
(when c-ml-string-opener-re
(save-excursion (c-depropertize-ml-strings-in-region m-beg (point))))
- (c-clear-char-property-with-value
- m-beg (point) 'syntax-table '(1)))))
+ (c-clear-syntax-table-with-value-trim-caches m-beg (point) '(1)))))
(defun c-extend-region-for-CPP (_beg _end)
;; Adjust `c-new-BEG', `c-new-END' respectively to the beginning and end of
@@ -1126,7 +1126,7 @@ Note that the style variables are always made local to
the buffer."
(setq s (parse-partial-sexp beg end -1))
(cond
((< (nth 0 s) 0) ; found an unmated ),},]
- (c-put-char-property (1- (point)) 'syntax-table '(1))
+ (c-put-syntax-table-trim-caches (1- (point)) '(1))
t)
;; Unbalanced strings are now handled by
;; `c-before-change-check-unbalanced-strings', etc.
@@ -1134,7 +1134,7 @@ Note that the style variables are always made local to
the buffer."
;; (c-put-char-property (nth 8 s) 'syntax-table '(1))
;; t)
((> (nth 0 s) 0) ; In a (,{,[
- (c-put-char-property (nth 1 s) 'syntax-table '(1))
+ (c-put-syntax-table-trim-caches (nth 1 s) '(1))
t)
(t nil)))))))
@@ -1284,7 +1284,7 @@ Note that the style variables are always made local to
the buffer."
;; (-value- ,value))
(if (equal value '(15))
(c-put-string-fence pos)
- (c-put-char-property pos 'syntax-table value))
+ (c-put-syntax-table-trim-caches pos value))
(c-put-char-property pos 'c-fl-syn-tab value)
(cond
((null c-min-syn-tab-mkr)
@@ -1295,12 +1295,11 @@ Note that the style variables are always made local to
the buffer."
((null c-max-syn-tab-mkr)
(setq c-max-syn-tab-mkr (copy-marker (1+ pos) nil)))
((>= pos c-max-syn-tab-mkr)
- (move-marker c-max-syn-tab-mkr (1+ pos))))
- (c-truncate-lit-pos-cache pos))
+ (move-marker c-max-syn-tab-mkr (1+ pos)))))
(defun c-clear-syn-tab (pos)
;; Remove both the 'syntax-table and `c-fl-syn-tab properties at POS.
- (c-clear-char-property pos 'syntax-table)
+ (c-clear-syntax-table-trim-caches pos)
(c-clear-char-property pos 'c-fl-syn-tab)
(when c-min-syn-tab-mkr
(if (and (eq pos (marker-position c-min-syn-tab-mkr))
@@ -1321,12 +1320,15 @@ Note that the style variables are always made local to
the buffer."
pos
(c-previous-single-property-change
pos 'c-fl-syn-tab nil (1+ c-min-syn-tab-mkr)))))))
- (c-truncate-lit-pos-cache pos))
+ (c-truncate-lit-pos/state-cache pos))
(defun c-clear-string-fences ()
;; Clear syntax-table text properties which are "mirrored" by c-fl-syn-tab
;; text properties. However, any such " character which ends up not being
;; balanced by another " is left with a '(1) syntax-table property.
+ ;; Note we don't truncate the caches in this function, since it is only
+ ;; called before leaving CC Mode, and the text properties will be restored
+ ;; by `c-restore-string-fences' before we continue in CC Mode.
(when
(and c-min-syn-tab-mkr c-max-syn-tab-mkr)
(c-save-buffer-state (s pos) ; Prevent text property stuff causing change
@@ -1391,6 +1393,7 @@ Note that the style variables are always made local to
the buffer."
(defun c-restore-string-fences ()
;; Restore any syntax-table text properties which are "mirrored" by
;; c-fl-syn-tab text properties.
+ ;; We don't truncate the caches here. See `c-clear-string-fences'.
(when (and c-min-syn-tab-mkr c-max-syn-tab-mkr)
(c-save-buffer-state ; Prevent text property stuff causing change function
; invocation.
@@ -1947,12 +1950,8 @@ Note that this is a strict tail, so won't match, e.g.
\"0x....\".")
(goto-char c-new-BEG)
(when (c-search-forward-char-property-with-value-on-char
'syntax-table '(1) ?\' c-new-END)
- (c-invalidate-state-cache (1- (point)))
- (c-truncate-lit-pos-cache (1- (point)))
- (c-clear-char-property-with-value-on-char
- (1- (point)) c-new-END
- 'syntax-table '(1)
- ?')
+ (c-clear-syntax-table-with-value-on-char-trim-caches
+ (1- (point)) c-new-END '(1) ?')
;; Remove the c-digit-separator text property from the same "'"s.
(when c-has-quoted-numbers
(c-clear-char-property-with-value-on-char
@@ -1979,10 +1978,8 @@ Note that this is a strict tail, so won't match, e.g.
\"0x....\".")
((c-quoted-number-straddling-point)
(setq num-beg (match-beginning 0)
num-end (match-end 0))
- (c-invalidate-state-cache num-beg)
- (c-truncate-lit-pos-cache num-beg)
- (c-put-char-properties-on-char num-beg num-end
- 'syntax-table '(1) ?')
+ (c-put-syntax-table-properties-on-char-trim-caches
+ num-beg num-end '(1) ?')
(c-put-char-properties-on-char num-beg num-end
'c-digit-separator t ?')
(goto-char num-end))
@@ -1991,15 +1988,11 @@ Note that this is a strict tail, so won't match, e.g.
\"0x....\".")
\\)'") ; balanced quoted expression.
(goto-char (match-end 0)))
((looking-at "\\\\'") ; Anomalous construct.
- (c-invalidate-state-cache (1- (point)))
- (c-truncate-lit-pos-cache (1- (point)))
- (c-put-char-properties-on-char (1- (point)) (+ (point) 2)
- 'syntax-table '(1) ?')
- (goto-char (match-end 0)))
+ (c-truncate-lit-pos/state-cache (1- (point)))
+ (c-put-syntax-table-properties-on-char-trim-caches
+ (1- (point)) (+ (point) 2) '(1) ?'))
(t
- (c-invalidate-state-cache (1- (point)))
- (c-truncate-lit-pos-cache (1- (point)))
- (c-put-char-property (1- (point)) 'syntax-table '(1))))
+ (c-put-syntax-table-trim-caches (1- (point)) '(1))))
;; Prevent the next `c-quoted-number-straddling-point' getting
;; confused by already processed single quotes.
(narrow-to-region (point) (point-max))))))
@@ -2036,12 +2029,10 @@ with // and /*, not more generic line and block
comments."
(if (eq (cadr end-state) 'c)
(when (search-forward "\\*/"
(or (cdr (caddr end-state)) (point-max)) t)
- (c-clear-char-property (match-beginning 0) 'syntax-table)
- (c-truncate-lit-pos-cache (match-beginning 0)))
+ (c-clear-syntax-table-trim-caches (match-beginning 0)))
(while (search-forward "\\\\\n"
(or (cdr (caddr end-state)) (point-max)) t)
- (c-clear-char-property (match-beginning 0) 'syntax-table)
- (c-truncate-lit-pos-cache (match-beginning 0)))))))
+ (c-clear-syntax-table-trim-caches (match-beginning 0)))))))
(defun c-after-change-fix-comment-escapes (beg end _old-len)
"Apply punctuation syntax-table text properties to C/C++ comment markers.
@@ -2073,8 +2064,7 @@ with // and /*, not more generic line and block comments."
(match-beginning 3))
((eq (cadr state) 'c++)
(match-beginning 2)))
- (c-put-char-property (match-beginning 0) 'syntax-table '(1))
- (c-truncate-lit-pos-cache (match-beginning 0))))
+ (c-put-syntax-table-trim-caches (match-beginning 0) '(1))))
(goto-char end)
(setq state (c-semi-pp-to-literal (point)))
@@ -2082,8 +2072,7 @@ with // and /*, not more generic line and block comments."
((eq (cadr state) 'c)
(when (search-forward "*/" nil t)
(when (eq (char-before (match-beginning 0)) ?\\)
- (c-put-char-property (1- (match-beginning 0)) 'syntax-table '(1))
- (c-truncate-lit-pos-cache (1- (match-beginning 0))))))
+ (c-put-syntax-table-trim-caches (1- (match-beginning 0)) '(1)))))
((eq (cadr state) 'c++)
(while
(progn
@@ -2091,8 +2080,7 @@ with // and /*, not more generic line and block comments."
(and (eq (char-before) ?\\)
(progn
(when (eq (char-before (1- (point))) ?\\)
- (c-put-char-property (- (point) 2) 'syntax-table '(1))
- (c-truncate-lit-pos-cache (1- (point))))
+ (c-put-syntax-table-trim-caches (- (point) 2) '(1)))
t)
(not (eobp))))
(forward-char))))))
@@ -2278,11 +2266,11 @@ with // and /*, not more generic line and block
comments."
c-get-state-before-change-functions))
(c-laomib-invalidate-cache beg end))))
- (c-truncate-lit-pos-cache beg)
+ (c-truncate-lit-pos/state-cache beg)
;; The following must be done here rather than in `c-after-change'
;; because newly inserted parens would foul up the invalidation
;; algorithm.
- (c-invalidate-state-cache beg)
+ (c-invalidate-state-cache)
;; The following must happen after the previous, which likely alters
;; the macro cache.
(when c-opt-cpp-symbol
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 18613e9ec33..3cdaa7c2a76 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -1958,6 +1958,12 @@ When PROMPT is non-nil, use it as the prompt string."
(project--ensure-read-project-list)
(mapcar #'car project--list))
+(defun project-read-project ()
+ "Read a project with completion from the known list.
+Returns an object that the API methods can be used with."
+ ;; Will prompt again if the entered directory is not a project anymore.
+ (project-current t (funcall project-prompter)))
+
;;;###autoload
(defun project-execute-extended-command ()
"Execute an extended command in project root."
diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el
index d61a108b195..7ec394a263d 100644
--- a/lisp/vc/log-edit.el
+++ b/lisp/vc/log-edit.el
@@ -890,6 +890,14 @@ different header separator appropriate for
`log-edit-mode'."
(zerop (forward-line 1))))
(eobp))))
+(defun log-edit--make-header-line (header &optional value)
+ ;; Make \\`C-a' work like it does in other buffers with header names.
+ (concat (propertize (concat header ": ")
+ 'field 'header
+ 'rear-nonsticky t)
+ value
+ "\n"))
+
(defun log-edit-insert-message-template ()
"Insert the default VC commit log template with Summary and Author."
(interactive)
@@ -897,11 +905,8 @@ different header separator appropriate for
`log-edit-mode'."
(log-edit-empty-buffer-p))
(dolist (header (append '("Summary") (and log-edit-setup-add-author
'("Author"))))
- ;; Make `C-a' work like in other buffers with header names.
- (insert (propertize (concat header ": ")
- 'field 'header
- 'rear-nonsticky t)
- "\n"))
+
+ (insert (log-edit--make-header-line header)))
(insert "\n")
(message-position-point)))
@@ -1315,7 +1320,7 @@ If TOGGLE is non-nil, and the value of HEADER already is
VALUE,
clear it. Make sure there is an empty line after the headers.
Return t if toggled on (or TOGGLE is nil), otherwise nil."
(let ((val t)
- (line (concat header ": " value "\n")))
+ (line (log-edit--make-header-line header value)))
(save-excursion
(save-restriction
(rfc822-goto-eoh)
diff --git a/test/infra/Dockerfile.emba b/test/infra/Dockerfile.emba
index de32906212b..f5c79b91ba1 100644
--- a/test/infra/Dockerfile.emba
+++ b/test/infra/Dockerfile.emba
@@ -24,7 +24,7 @@
# Maintainer: Ted Zlatanov <tzz@lifelogs.com>
# URL: https://emba.gnu.org/emacs/emacs
-FROM debian:bullseye as emacs-base
+FROM debian:bookworm as emacs-base
RUN apt-get update && \
apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 \
@@ -60,16 +60,7 @@ RUN ./autogen.sh autoconf
RUN ./configure --with-file-notification=gfile
RUN make -j `nproc` bootstrap
-# Debian bullseye doesn't provide proper packages. So we use Debian
-# sid for this.
-FROM debian:sid as emacs-eglot
-
-# This corresponds to emacs-base.
-RUN apt-get update && \
- apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 \
- libc-dev gcc g++ make autoconf automake libncurses-dev gnutls-dev \
- libxml2-dev libdbus-1-dev libacl1-dev acl git texinfo gdb \
- && rm -rf /var/lib/apt/lists/*
+FROM emacs-base as emacs-eglot
# Install clangd, tsserver.
RUN apt-get update && \
@@ -112,16 +103,7 @@ RUN make -j `nproc` bootstrap
# --eval '(package-install (quote company))' \
# --eval '(package-install (quote yasnippet))'
-# Debian bullseye doesn't provide proper packages. So we use Debian
-# sid for this.
-FROM debian:sid as emacs-tree-sitter
-
-# This corresponds to emacs-base.
-RUN apt-get update && \
- apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 \
- libc-dev gcc g++ make autoconf automake libncurses-dev gnutls-dev \
- libxml2-dev libdbus-1-dev libacl1-dev acl git texinfo gdb \
- && rm -rf /var/lib/apt/lists/*
+FROM emacs-base as emacs-tree-sitter
# Install tree-sitter library.
RUN apt-get update && \
@@ -183,7 +165,7 @@ FROM emacs-base as emacs-native-comp
# The libgccjit version must correspond to the gcc version.
RUN apt-get update && \
apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 \
- libgccjit-10-dev zlib1g-dev \
+ libgccjit-12-dev zlib1g-dev \
&& rm -rf /var/lib/apt/lists/*
FROM emacs-native-comp as emacs-native-comp-speed0
diff --git a/test/lisp/eshell/esh-arg-tests.el
b/test/lisp/eshell/esh-arg-tests.el
index b748c5ab4c0..209c4fa8ea9 100644
--- a/test/lisp/eshell/esh-arg-tests.el
+++ b/test/lisp/eshell/esh-arg-tests.el
@@ -181,6 +181,19 @@ chars."
"setq eshell-test-value #<marker 1 #<buffer (buffer-name)>>")
(should (equal eshell-test-value marker)))))
+(ert-deftest esh-arg-test/special-reference/command-form ()
+ "Test that command forms inside special references work."
+ (with-temp-eshell
+ (let ((marker (make-marker))
+ eshell-test-value)
+ (set-marker marker 1 (current-buffer))
+ (eshell-insert-command
+ "setq eshell-test-value #<marker 1 {current-buffer}>")
+ (should (equal eshell-test-value marker))
+ (eshell-insert-command
+ "setq eshell-test-value #<marker 1 #<buffer {buffer-name}>>")
+ (should (equal eshell-test-value marker)))))
+
(ert-deftest esh-arg-test/special-reference/special-characters ()
"Test that \"#<...>\" works correctly when escaping special characters."
(with-temp-buffer
diff --git a/test/lisp/eshell/esh-cmd-tests.el
b/test/lisp/eshell/esh-cmd-tests.el
index cac349a2616..0f388a9eba4 100644
--- a/test/lisp/eshell/esh-cmd-tests.el
+++ b/test/lisp/eshell/esh-cmd-tests.el
@@ -325,6 +325,12 @@ processes correctly."
(eshell-match-command-output "for i in 1 { echo $for-items }"
"hello\n")))
+(ert-deftest esh-cmd-test/for-loop-lisp-body ()
+ "Test invocation of a for loop with a Lisp body form."
+ (with-temp-eshell
+ (eshell-match-command-output "for i in 1 2 3 (format \"%s\" i)"
+ "1\n2\n3\n")))
+
(ert-deftest esh-cmd-test/for-loop-pipe ()
"Test invocation of a for loop piped to another command."
(skip-unless (executable-find "rev"))
@@ -350,6 +356,15 @@ processes correctly."
"{ setq eshell-test-value (1+ eshell-test-value) }")
"1\n2\n3\n"))))
+(ert-deftest esh-cmd-test/while-loop-lisp-body ()
+ "Test invocation of a while loop using a Lisp form for the body."
+ (with-temp-eshell
+ (let ((eshell-test-value 0))
+ (eshell-match-command-output
+ (concat "while (/= eshell-test-value 3) "
+ "(setq eshell-test-value (1+ eshell-test-value))")
+ "1\n2\n3\n"))))
+
(ert-deftest esh-cmd-test/while-loop-ext-cmd ()
"Test invocation of a while loop using an external command."
(skip-unless (executable-find "["))
@@ -412,11 +427,15 @@ processes correctly."
(ert-deftest esh-cmd-test/if-else-statement ()
"Test invocation of an if/else statement."
(let ((eshell-test-value t))
- (eshell-command-result-equal "if $eshell-test-value {echo yes} {echo no}"
- "yes"))
+ (eshell-command-result-equal
+ "if $eshell-test-value {echo yes} {echo no}" "yes")
+ (eshell-command-result-equal
+ "if $eshell-test-value {echo yes} else {echo no}" "yes"))
(let ((eshell-test-value nil))
- (eshell-command-result-equal "if $eshell-test-value {echo yes} {echo no}"
- "no")))
+ (eshell-command-result-equal
+ "if $eshell-test-value {echo yes} {echo no}" "no")
+ (eshell-command-result-equal
+ "if $eshell-test-value {echo yes} else {echo no}" "no")))
(ert-deftest esh-cmd-test/if-else-statement-lisp-form ()
"Test invocation of an if/else statement using a Lisp form."
@@ -440,6 +459,17 @@ This tests when `eshell-lisp-form-nil-is-failure' is nil."
(eshell-command-result-equal "if (zerop \"foo\") {echo yes} {echo no}"
"no"))))
+(ert-deftest esh-cmd-test/if-else-statement-lisp-body ()
+ "Test invocation of an if/else statement using Lisp forms for the bodies."
+ (eshell-command-result-equal "if (zerop 0) (format \"yes\") (format \"no\")"
+ "yes")
+ (eshell-command-result-equal "if (zerop 1) (format \"yes\") (format \"no\")"
+ "no")
+ (let ((debug-on-error nil))
+ (eshell-command-result-equal
+ "if (zerop \"foo\") (format \"yes\") (format \"no\")"
+ "no")))
+
(ert-deftest esh-cmd-test/if-else-statement-ext-cmd ()
"Test invocation of an if/else statement using an external command."
(skip-unless (executable-find "["))
@@ -448,6 +478,16 @@ This tests when `eshell-lisp-form-nil-is-failure' is nil."
(eshell-command-result-equal "if {[ foo = bar ]} {echo yes} {echo no}"
"no"))
+(ert-deftest esh-cmd-test/if-else-statement-chain ()
+ "Test invocation of a chained if/else statement."
+ (dolist (case '((1 . "one") (2 . "two") (3 . "other")))
+ (let ((eshell-test-value (car case)))
+ (eshell-command-result-equal
+ (concat "if (= eshell-test-value 1) {echo one} "
+ "else if (= eshell-test-value 2) {echo two} "
+ "else {echo other}")
+ (cdr case)))))
+
(ert-deftest esh-cmd-test/if-statement-pipe ()
"Test invocation of an if statement piped to another command."
(skip-unless (executable-find "rev"))
diff --git a/test/lisp/eshell/esh-var-tests.el
b/test/lisp/eshell/esh-var-tests.el
index 7b29e4a21db..7ac9807a1a7 100644
--- a/test/lisp/eshell/esh-var-tests.el
+++ b/test/lisp/eshell/esh-var-tests.el
@@ -190,6 +190,9 @@ nil, use FUNCTION instead."
"zero")
(eshell-command-result-equal
"echo $eshell-test-value[${*echo 0} ${*echo 2}]"
+ '("zero" "two"))
+ (eshell-command-result-equal
+ "echo $eshell-test-value[{*echo 0} {*echo 2}]"
'("zero" "two"))))
(ert-deftest esh-var-test/interp-var-length-list ()
diff --git a/test/src/comp-resources/comp-test-funcs.el
b/test/src/comp-resources/comp-test-funcs.el
index 084fcd8c9db..87d3220f381 100644
--- a/test/src/comp-resources/comp-test-funcs.el
+++ b/test/src/comp-resources/comp-test-funcs.el
@@ -562,6 +562,23 @@
(defun comp-test-67883-1-f ()
'#1=(1 . #1#))
+(cl-defstruct comp-test-73270-base)
+(cl-defstruct
+ (comp-test-73270-child1 (:include comp-test-73270-base)))
+(cl-defstruct
+ (comp-test-73270-child2 (:include comp-test-73270-base)))
+(cl-defstruct
+ (comp-test-73270-child3 (:include comp-test-73270-base)))
+(cl-defstruct
+ (comp-test-73270-child4 (:include comp-test-73270-base)))
+
+(defun comp-test-73270-1-f (x)
+ (cl-typecase x
+ (comp-test-73270-child1 'child1)
+ (comp-test-73270-child2 'child2)
+ (comp-test-73270-child3 'child3)
+ (comp-test-73270-child4 'child4)))
+
;;;;;;;;;;;;;;;;;;;;
;; Tromey's tests ;;
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index dfeeaff05d8..487c95416ad 100644
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -592,6 +592,10 @@ dedicated byte-op code."
"<https://lists.gnu.org/archive/html/bug-gnu-emacs/2023-11/msg00925.html>"
(should-not (comp-test-67239-1-f)))
+(comp-deftest comp-test-73270-1 ()
+ "<https://lists.gnu.org/archive/html/bug-gnu-emacs/2024-09/msg00794.html>"
+ (should (eq (comp-test-73270-1-f (make-comp-test-73270-child4)) 'child4)))
+
;;;;;;;;;;;;;;;;;;;;;
;; Tromey's tests. ;;
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- master b9eb7f19452 2/2: Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs,
Eli Zaretskii <=