Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs
This commit is contained in:
Eli Zaretskii
commit
b9eb7f1945
21 changed files with 479 additions and 245 deletions
|
|
@ -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
|
||||
|
||||
|
|
|
|||
14
etc/NEWS
14
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
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
|
|
|
|||
|
|
@ -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)))))))
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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."
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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"))
|
||||
|
|
|
|||
|
|
@ -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 ()
|
||||
|
|
|
|||
|
|
@ -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 ;;
|
||||
|
|
|
|||
|
|
@ -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. ;;
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue