procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge remote-tracking branch 'origin/master' into feature/android

Browse source
This commit is contained in:
Po Lu 2023-04-15 07:28:19 +08:00
commit 5919511881
18 changed files with 641 additions and 382 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
doc/lispref/variables.texi
View file

@ -2558,6 +2558,9 @@ documentation as @var{base-variable} has, if any, unless
the documentation of the variable at the end of the chain of aliases.
This function returns @var{base-variable}.
If the resulting variable definition chain would be circular, then
Emacs will signal a @code{cyclic-variable-indirection} error.
@end defun
Variable aliases are convenient for replacing an old name for a
@ -2606,9 +2609,6 @@ look like:
This function returns the variable at the end of the chain of aliases
of @var{variable}. If @var{variable} is not a symbol, or if @var{variable} is
not defined as an alias, the function returns @var{variable}.
This function signals a @code{cyclic-variable-indirection} error if
there is a loop in the chain of symbols.
@end defun
@example

38
doc/misc/cc-mode.texi
View file

@ -330,6 +330,7 @@ Syntactic Symbols
* Multiline Macro Symbols::
* Objective-C Method Symbols::
* Java Symbols::
* Constraint Symbols::
* Statement Block Symbols::
* K&R Symbols::
@ -4234,6 +4235,9 @@ The first line in a ``topmost'' definition. @ref{Function Symbols}.
Topmost definition continuation lines. This is only used in the parts
that aren't covered by other symbols such as @code{func-decl-cont} and
@code{knr-argdecl}. @ref{Function Symbols}.
@item constraint-cont
Continuation line of a topmost C++20 concept or requires clause.
@ref{Constraint Symbols}.
@item annotation-top-cont
Topmost definition continuation lines where all previous items are
annotations. @ref{Java Symbols}.
@ -4397,6 +4401,7 @@ Java. @ref{Java Symbols}.
* Multiline Macro Symbols::
* Objective-C Method Symbols::
* Java Symbols::
* Constraint Symbols::
* Statement Block Symbols::
* K&R Symbols::
@end menu
@ -5070,6 +5075,39 @@ the current line. Similarly, line 4 is assigned the @code{annotation-var-cont}
syntax due to it being a continuation of a variable declaration where preceding
the declaration is an annotation.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@node Constraint Symbols
@subsection C++ Constraint Symbols
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
The C++20 standard introduced the notion of @dfn{concepts} and
@dfn{requirements}, a typical instance of which looks something like
this:
@example
1: template <typename T>
2: requires
3: requires (T t) @{
4: @{ ++t; @}
5: @}
6: && std::is_integral<T>
7: int foo();
@end example
@ssindex constraint-cont
Line 1 is assigned the familiar @code{topmost-intro}. Line 2 gets
@code{topmost-intro-cont}, being the keyword which introduces a
@dfn{requires clause}. Lines 3, 6, and 7 are assigned the syntax
@code{constraint-cont}, being continuations of the requires clause
started on line 2. Lines 4 and 5 get the syntaxes
@code{defun-block-intro} and @code{defun-close}, being analyzed as
though part of a function.
Note that the @code{requires} on Line 3 begins a @dfn{requires
expression}, not a a requires clause, hence its components are not
assigned @code{constraint-cont}. See
@url{https://en.cppreference.com/w/cpp/language/requires}.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@node Statement Block Symbols
@subsection Statement Block Symbols

24
etc/NEWS
View file

@ -194,14 +194,14 @@ to load the edited aliases.
+++
*** 'rgrep' is now a builtin command.
Running "rgrep" in Eshell now uses the Emacs grep facility instead of
Running 'rgrep' in Eshell now uses the Emacs grep facility instead of
calling external rgrep.
** Shell Mode
+++
*** New user option 'shell-get-old-input-include-continuation-lines'.
When this user option is non-nil, 'shell-get-old-input' (C-RET)
When this user option is non-nil, 'shell-get-old-input' ('C-RET')
includes multiple shell "\" continuation lines from command output.
Default is nil.
@ -277,6 +277,7 @@ following to your init file:
#'shortdoc-help-fns-examples-function)
** Package
---
*** New user option 'package-vc-register-as-project'.
When non-nil, it will automatically register every package as a
@ -284,6 +285,7 @@ project, that you can quickly select using 'project-switch-project'
('C-x p p').
** Flymake
+++
*** New user option 'flymake-show-diagnostics-at-end-of-line'.
When non-nil, Flymake shows summarized descriptions of diagnostics at
@ -369,7 +371,7 @@ The new functions 'touch-screen-track-tap' and
'touch-screen-track-drag' handle tracking common touch screen gestures
from within a command.
** New var 'inhibit-auto-fill' to temporarily prevent auto-fill.
** New variable 'inhibit-auto-fill' to temporarily prevent auto-fill.
** Functions and variables to transpose sexps
@ -485,7 +487,7 @@ any unwind forms, as in
(unwind-protect (read buffer))
because the behaviour is identical to that of the argument; there is
because the behavior is identical to that of the argument; there is
no protection of any kind. Perhaps the intended unwind forms have
been misplaced or forgotten, or the use of 'unwind-protect' could be
simplified away.
@ -515,19 +517,19 @@ so it will return the remote UID for remote files (or -1 if the
connection has no associated user).
+++
** 'fset' and 'defalias' now signal an error for circular alias chains.
Previously, 'fset' and 'defalias' could be made to build circular
function indirection chains as in
** 'fset', 'defalias' and 'defvaralias' now signal an error for cyclic aliases.
Previously, 'fset', 'defalias' and 'defvaralias' could be made to
build circular function and variable indirection chains as in
(defalias 'able 'baker)
(defalias 'baker 'able)
but trying to call them would often make Emacs hang. Now, an attempt
but trying to use them would sometimes make Emacs hang. Now, an attempt
to create such a loop results in an error.
Since circular alias chains now cannot occur, 'function-alias-p' and
'indirect-function' will never signal an error. Their second
'noerror' arguments have no effect and are therefore obsolete.
Since circular alias chains now cannot occur, 'function-alias-p',
'indirect-function' and 'indirect-variable' will never signal an error.
Their 'noerror' arguments have no effect and are therefore obsolete.
* Changes in Emacs 30.1 on Non-Free Operating Systems

207
lisp/gnus/nnselect.el
View file

@ -885,13 +885,14 @@ article came from is also searched."
(defun nnselect-push-info (_group)
(defun nnselect-push-info (group)
"Copy mark-lists from GROUP to the originating groups."
(let ((select-unreads (numbers-by-group gnus-newsgroup-unreads))
(select-reads (numbers-by-group
(gnus-sorted-difference gnus-newsgroup-articles
gnus-newsgroup-unreads)))
(select-unseen (numbers-by-group gnus-newsgroup-unseen))
(quit-config (gnus-group-quit-config group))
(gnus-newsgroup-active nil) mark-list)
;; collect the set of marked article lists categorized by
;; originating groups
@ -903,124 +904,120 @@ article came from is also searched."
(unless (eq 'tuple mark-type)
(setq type-list (range-list-intersection
gnus-newsgroup-articles type-list)))
(push (cons
type
(numbers-by-group type-list mark-type))
(push (cons type (numbers-by-group type-list mark-type))
mark-list))))
;; now work on each originating group one at a time
(pcase-dolist (`(,artgroup . ,artlist)
(numbers-by-group gnus-newsgroup-articles))
(numbers-by-group gnus-newsgroup-articles))
(setq artlist (sort artlist #'<))
(let* ((group-info (gnus-get-info artgroup))
(old-unread (gnus-list-of-unread-articles artgroup))
newmarked delta-marks)
(when group-info
;; iterate over mark lists for this group
(pcase-dolist (`(,_mark . ,type) gnus-article-mark-lists)
(let ((list (cdr (assoc artgroup (alist-get type mark-list))))
(mark-type (gnus-article-mark-to-type type)))
(let ((group-info (gnus-get-info artgroup))
(old-unread (gnus-list-of-unread-articles artgroup))
(rsm (gnus-check-backend-function 'request-set-mark artgroup))
newmarked delta-marks)
(when group-info
;; iterate over mark lists for this group
(pcase-dolist (`(,_mark . ,type) gnus-article-mark-lists)
(let ((list (cdr (assoc artgroup (alist-get type mark-list))))
(mark-type (gnus-article-mark-to-type type))
(group-marks (alist-get type (gnus-info-marks group-info))))
;; When the backend can store marks we collect any
;; changes. Unlike a normal group the mark lists only
;; include marks for articles we retrieved.
(when (and (gnus-check-backend-function
'request-set-mark gnus-newsgroup-name)
(not (gnus-article-unpropagatable-p type)))
(let* ((old (range-list-intersection
artlist
(alist-get type (gnus-info-marks group-info))))
(del (range-remove (copy-tree old) list))
(add (range-remove (copy-tree list) old)))
(when add (push (list add 'add (list type)) delta-marks))
(when del
;; Don't delete marks from outside the active range.
;; This shouldn't happen, but is a sanity check.
(setq del (range-intersection
(gnus-active artgroup) del))
(push (list del 'del (list type)) delta-marks))))
;; When the backend can store marks we collect any
;; changes. Unlike a normal group the mark lists only
;; include marks for articles we retrieved. If there is
;; no quit-config then gnus-update-marks has already
;; been called to handle this.
(when (and quit-config rsm
(not (gnus-article-unpropagatable-p type)))
(let* ((old (range-list-intersection
artlist group-marks))
(del (range-remove (copy-tree old) list))
(add (range-remove (copy-tree list) old)))
(when add (push (list add 'add (list type)) delta-marks))
(when del
;; Don't delete marks from outside the active range.
;; This shouldn't happen, but is a sanity check.
(setq del (range-intersection (gnus-active artgroup) del))
(push (list del 'del (list type)) delta-marks))))
;; Marked sets are of mark-type 'tuple, 'list, or
;; 'range. We merge the lists with what is already in
;; the original info to get full list of new marks. We
;; do this by removing all the articles we retrieved
;; from the full list, and then add back in the newly
;; marked ones.
(cond
((eq mark-type 'tuple)
;; Get rid of the entries that have the default
;; score.
(when (and list (eq type 'score) gnus-save-score)
(let* ((arts list)
(prev (cons nil list))
(all prev))
(while arts
(if (or (not (consp (car arts)))
(= (cdar arts) gnus-summary-default-score))
(setcdr prev (cdr arts))
(setq prev arts))
(setq arts (cdr arts)))
(setq list (cdr all))))
;; now merge with the original list and sort just to
;; make sure
(setq
list (sort
;; Marked sets are of mark-type 'tuple, 'list, or
;; 'range. We merge the lists with what is already in
;; the original info to get full list of new marks. We
;; do this by removing all the articles we retrieved
;; from the full list, and then add back in the newly
;; marked ones.
(cond
((eq mark-type 'tuple)
;; Get rid of the entries that have the default
;; score.
(when (and list (eq type 'score) gnus-save-score)
(let* ((arts list)
(prev (cons nil list))
(all prev))
(while arts
(if (or (not (consp (car arts)))
(= (cdar arts) gnus-summary-default-score))
(setcdr prev (cdr arts))
(setq prev arts))
(setq arts (cdr arts)))
(setq list (cdr all))))
;; now merge with the original list and sort just to
;; make sure
(setq list
(sort
(map-merge
'alist list
'alist list
(delq nil
(mapcar
(lambda (x) (unless (memq (car x) artlist) x))
(alist-get type (gnus-info-marks group-info)))))
group-marks)))
'car-less-than-car)))
(t
(setq list
(range-compress-list
(gnus-sorted-union
(gnus-sorted-difference
(gnus-uncompress-sequence
(alist-get type (gnus-info-marks group-info)))
artlist)
(sort list #'<)))))
(t
(setq list
(range-compress-list
(gnus-sorted-union
(gnus-sorted-difference
(gnus-uncompress-sequence group-marks)
artlist)
(sort list #'<))))
;; When exiting the group, everything that's previously been
;; unseen is now seen.
(when (eq type 'seen)
(setq list (range-concat
list (cdr (assoc artgroup select-unseen))))))
;; When exiting the group, everything that's previously been
;; unseen is now seen.
(when (eq type 'seen)
(setq list (range-concat
list (cdr (assoc artgroup select-unseen)))))))
(when (or list (eq type 'unexist))
(push (cons type list) newmarked)))) ;; end of mark-type loop
(when (or list (eq type 'unexist))
(push (cons type list) newmarked)))) ;; end of mark-type loop
(when delta-marks
(unless (gnus-check-group artgroup)
(error "Can't open server for %s" artgroup))
(gnus-request-set-mark artgroup delta-marks))
(gnus-atomic-progn
(gnus-info-set-marks group-info newmarked)
;; Cut off the end of the info if there's nothing else there.
(let ((i 5))
(while (and (> i 2)
(not (nth i group-info)))
(when (nthcdr (cl-decf i) group-info)
(setcdr (nthcdr i group-info) nil))))
(when delta-marks
(unless (gnus-check-group artgroup)
(error "Can't open server for %s" artgroup))
(gnus-request-set-mark artgroup delta-marks))
(gnus-atomic-progn
(gnus-info-set-marks group-info newmarked)
;; Cut off the end of the info if there's nothing else there.
(let ((i 5))
(while (and (> i 2)
(not (nth i group-info)))
(when (nthcdr (cl-decf i) group-info)
(setcdr (nthcdr i group-info) nil))))
;; update read and unread
(gnus-update-read-articles
artgroup
(range-uncompress
(range-add-list
(range-remove
old-unread
(cdr (assoc artgroup select-reads)))
(sort (cdr (assoc artgroup select-unreads)) #'<))))
(gnus-get-unread-articles-in-group
group-info (gnus-active artgroup) t))
(gnus-group-update-group
artgroup t
(equal group-info
(setq group-info (copy-sequence (gnus-get-info artgroup))
group-info
(delq (gnus-info-params group-info) group-info)))))))))
;; update read and unread
(gnus-update-read-articles
artgroup
(range-uncompress
(range-add-list
(range-remove
old-unread
(cdr (assoc artgroup select-reads)))
(sort (cdr (assoc artgroup select-unreads)) #'<)))))
(gnus-get-unread-articles-in-group
group-info (gnus-active artgroup) t)
(gnus-group-update-group
artgroup t
(equal group-info
(setq group-info (copy-sequence (gnus-get-info artgroup))
group-info
(delq (gnus-info-params group-info) group-info)))))))))
(declare-function gnus-registry-get-id-key "gnus-registry" (id key))

139
lisp/progmodes/cc-defs.el
View file

@ -2153,86 +2153,79 @@ non-nil, a caret is prepended to invert the set."
;; Record whether the `category' text property works.
(if c-use-category (setq list (cons 'category-properties list)))
(let ((buf (generate-new-buffer " test"))
parse-sexp-lookup-properties
parse-sexp-ignore-comments
lookup-syntax-properties) ; XEmacs
(let ((buf (generate-new-buffer " test")))
(with-current-buffer buf
(set-syntax-table (make-syntax-table))
(let ((parse-sexp-lookup-properties t)
(parse-sexp-ignore-comments t)
(lookup-syntax-properties t))
(set-syntax-table (make-syntax-table))
;; For some reason we have to set some of these after the
;; buffer has been made current. (Specifically,
;; `parse-sexp-ignore-comments' in Emacs 21.)
(setq parse-sexp-lookup-properties t
parse-sexp-ignore-comments t
lookup-syntax-properties t)
;; Find out if the `syntax-table' text property works.
(modify-syntax-entry ?< ".")
(modify-syntax-entry ?> ".")
(insert "<()>")
(c-mark-<-as-paren (point-min))
(c-mark->-as-paren (+ 3 (point-min)))
(goto-char (point-min))
(c-forward-sexp)
(if (= (point) (+ 4 (point-min)))
(setq list (cons 'syntax-properties list))
(error (concat
"CC Mode is incompatible with this version of Emacs - "
"support for the `syntax-table' text property "
"is required.")))
;; Find out if the `syntax-table' text property works.
(modify-syntax-entry ?< ".")
(modify-syntax-entry ?> ".")
(insert "<()>")
(c-mark-<-as-paren (point-min))
(c-mark->-as-paren (+ 3 (point-min)))
(goto-char (point-min))
(c-forward-sexp)
(if (= (point) (+ 4 (point-min)))
(setq list (cons 'syntax-properties list))
(error (concat
"CC Mode is incompatible with this version of Emacs - "
"support for the `syntax-table' text property "
"is required.")))
;; Find out if "\\s!" (generic comment delimiters) work.
(c-safe
(modify-syntax-entry ?x "!")
(if (string-match "\\s!" "x")
(setq list (cons 'gen-comment-delim list))))
;; Find out if "\\s!" (generic comment delimiters) work.
(c-safe
(modify-syntax-entry ?x "!")
(if (string-match "\\s!" "x")
(setq list (cons 'gen-comment-delim list))))
;; Find out if "\\s|" (generic string delimiters) work.
(c-safe
(modify-syntax-entry ?x "|")
(if (string-match "\\s|" "x")
(setq list (cons 'gen-string-delim list))))
;; Find out if "\\s|" (generic string delimiters) work.
(c-safe
(modify-syntax-entry ?x "|")
(if (string-match "\\s|" "x")
(setq list (cons 'gen-string-delim list))))
;; See if POSIX char classes work.
(when (and (string-match "[[:alpha:]]" "a")
;; All versions of Emacs 21 so far haven't fixed
;; char classes in `skip-chars-forward' and
;; `skip-chars-backward'.
(progn
(delete-region (point-min) (point-max))
(insert "foo123")
(skip-chars-backward "[:alnum:]")
(bobp))
(= (skip-chars-forward "[:alpha:]") 3))
(setq list (cons 'posix-char-classes list)))
;; See if POSIX char classes work.
(when (and (string-match "[[:alpha:]]" "a")
;; All versions of Emacs 21 so far haven't fixed
;; char classes in `skip-chars-forward' and
;; `skip-chars-backward'.
(progn
(delete-region (point-min) (point-max))
(insert "foo123")
(skip-chars-backward "[:alnum:]")
(bobp))
(= (skip-chars-forward "[:alpha:]") 3))
(setq list (cons 'posix-char-classes list)))
;; See if `open-paren-in-column-0-is-defun-start' exists and
;; isn't buggy (Emacs >= 21.4).
(when (boundp 'open-paren-in-column-0-is-defun-start)
(let ((open-paren-in-column-0-is-defun-start nil)
(parse-sexp-ignore-comments t))
(delete-region (point-min) (point-max))
(set-syntax-table (make-syntax-table))
(modify-syntax-entry ?\' "\"")
(cond
;; XEmacs. Afaik this is currently an Emacs-only
;; feature, but it's good to be prepared.
((memq '8-bit list)
(modify-syntax-entry ?/ ". 1456")
(modify-syntax-entry ?* ". 23"))
;; Emacs
((memq '1-bit list)
(modify-syntax-entry ?/ ". 124b")
(modify-syntax-entry ?* ". 23")))
(modify-syntax-entry ?\n "> b")
(insert "/* '\n () */")
(backward-sexp)
(if (bobp)
(setq list (cons 'col-0-paren list)))))
;; See if `open-paren-in-column-0-is-defun-start' exists and
;; isn't buggy (Emacs >= 21.4).
(when (boundp 'open-paren-in-column-0-is-defun-start)
(let ((open-paren-in-column-0-is-defun-start nil)
(parse-sexp-ignore-comments t))
(delete-region (point-min) (point-max))
(set-syntax-table (make-syntax-table))
(modify-syntax-entry ?\' "\"")
(cond
;; XEmacs. Afaik this is currently an Emacs-only
;; feature, but it's good to be prepared.
((memq '8-bit list)
(modify-syntax-entry ?/ ". 1456")
(modify-syntax-entry ?* ". 23"))
;; Emacs
((memq '1-bit list)
(modify-syntax-entry ?/ ". 124b")
(modify-syntax-entry ?* ". 23")))
(modify-syntax-entry ?\n "> b")
(insert "/* '\n () */")
(backward-sexp)
(if (bobp)
(setq list (cons 'col-0-paren list)))))
(set-buffer-modified-p nil))
(kill-buffer buf))
(set-buffer-modified-p nil))
(kill-buffer buf)))
;; Check how many elements `parse-partial-sexp' returns.
(let ((ppss-size (or (c-safe (length

409
lisp/progmodes/cc-engine.el
View file

@ -9460,19 +9460,24 @@ multi-line strings (but not C++, for example)."
(setq ,ps (cdr ,ps)))))
(defun c-forward-over-compound-identifier ()
;; Go over a possibly compound identifier, such as C++'s Foo::Bar::Baz,
;; returning that identifier (with any syntactic WS removed). Return nil if
;; we're not at an identifier.
(when (c-on-identifier)
;; Go over a possibly compound identifier (but not any following
;; whitespace), such as C++'s Foo::Bar::Baz, returning that identifier (with
;; any syntactic WS removed). Return nil if we're not at an identifier, in
;; which case point is not moved.
(when
(eq (c-on-identifier)
(point))
(let ((consolidated "") (consolidated-:: "")
start end)
(here (point))
start end end-token)
(while
(progn
(setq start (point))
(c-forward-over-token)
(setq consolidated
(concat consolidated-::
(buffer-substring-no-properties start (point))))
(buffer-substring-no-properties start (point)))
end-token (point))
(c-forward-syntactic-ws)
(and c-opt-identifier-concat-key
(looking-at c-opt-identifier-concat-key)
@ -9487,7 +9492,9 @@ multi-line strings (but not C++, for example)."
(concat consolidated
(buffer-substring-no-properties start end))))))))
(if (equal consolidated "")
nil
(progn (goto-char here)
nil)
(goto-char end-token)
consolidated))))
(defun c-back-over-compound-identifier ()
@ -9660,13 +9667,16 @@ point unchanged and return nil."
;; Handling of large scale constructs like statements and declarations.
(defun c-forward-primary-expression (&optional limit)
;; Go over the primary expression (if any) at point, moving to the next
;; token and return non-nil. If we're not at a primary expression leave
;; point unchanged and return nil.
(defun c-forward-primary-expression (&optional limit stop-at-end)
;; Go over the primary expression (if any) at point, and unless STOP-AT-END
;; is non-nil, move to the next token then return non-nil. If we're not at
;; a primary expression leave point unchanged and return nil.
;;
;; Note that this function is incomplete, handling only those cases expected
;; to be common in a C++20 requires clause.
;;
;; Note also that (...) is not recognised as a primary expression if the
;; next token is an open brace.
(let ((here (point))
(c-restricted-<>-arglists t)
(c-parse-and-markup-<>-arglists nil)
@ -9674,28 +9684,38 @@ point unchanged and return nil."
(if (cond
((looking-at c-constant-key)
(goto-char (match-end 1))
(c-forward-syntactic-ws limit)
(unless stop-at-end (c-forward-syntactic-ws limit))
t)
((eq (char-after) ?\()
(and (c-go-list-forward (point) limit)
(eq (char-before) ?\))
(progn (c-forward-syntactic-ws limit)
t)))
(let ((after-paren (point)))
(c-forward-syntactic-ws limit)
(prog1
(not (eq (char-after) ?{))
(when stop-at-end
(goto-char after-paren))))))
((c-forward-over-compound-identifier)
(c-forward-syntactic-ws limit)
(while (cond
((looking-at "<")
(prog1
(c-forward-<>-arglist nil)
(c-forward-syntactic-ws limit)))
((looking-at c-opt-identifier-concat-key)
(and
(zerop (c-forward-token-2 1 nil limit))
(prog1
(c-forward-over-compound-identifier)
(c-forward-syntactic-ws limit))))))
t)
((looking-at c-fun-name-substitute-key) ; "requires"
(let ((after-id (point)))
(c-forward-syntactic-ws limit)
(while (cond
((and
(looking-at "<")
(prog1
(and
(c-forward-<>-arglist nil)
(setq after-id (point)))))
(c-forward-syntactic-ws limit))
((looking-at c-opt-identifier-concat-key)
(and
(zerop (c-forward-token-2 1 nil limit))
(prog1
(c-forward-over-compound-identifier)
(c-forward-syntactic-ws limit))))))
(goto-char after-id)))
((and
(looking-at c-fun-name-substitute-key) ; "requires"
(not (eq (char-after (match-end 0)) ?_)))
(goto-char (match-end 1))
(c-forward-syntactic-ws limit)
(and
@ -9708,36 +9728,47 @@ point unchanged and return nil."
(and (c-go-list-forward (point) limit)
(eq (char-before) ?}))
(progn
(c-forward-syntactic-ws limit)
(unless stop-at-end (c-forward-syntactic-ws limit))
t))))
t
(goto-char here)
nil)))
(defun c-forward-c++-requires-clause (&optional limit)
;; Point is at the keyword "requires". Move forward over the requires
;; clause to the next token after it and return non-nil. If there is no
;; valid requires clause at point, leave point unmoved and return nil.
(defun c-forward-constraint-clause (&optional limit stop-at-end)
;; Point is at the putative start of a constraint clause. Move to its end
;; (when STOP-AT-END is non-zero) or the token after that (otherwise) and
;; return non-nil. Return nil without moving if we fail to find a
;; constraint.
(let ((here (point))
final-point)
(or limit (setq limit (point-max)))
(if (and
(zerop (c-forward-token-2 1 nil limit)) ; over "requires".
(prog1
(c-forward-primary-expression limit)
(setq final-point (point))
(while
(and (looking-at "\\(?:&&\\|||\\)")
(progn (goto-char (match-end 0))
(c-forward-syntactic-ws limit)
(and (< (point) limit)
(c-forward-primary-expression limit))))
(setq final-point (point)))))
(progn (goto-char final-point)
t)
(if (c-forward-primary-expression limit t)
(progn
(setq final-point (point))
(c-forward-syntactic-ws limit)
(while
(and (looking-at "\\(?:&&\\|||\\)")
(<= (match-end 0) limit)
(progn (goto-char (match-end 0))
(c-forward-syntactic-ws limit)
(and (<= (point) limit)))
(c-forward-primary-expression limit t)
(setq final-point (point))))
(goto-char final-point)
(or stop-at-end (c-forward-syntactic-ws limit))
t)
(goto-char here)
nil)))
(defun c-forward-c++-requires-clause (&optional limit stop-at-end)
;; Point is at the keyword "requires". Move forward over the requires
;; clause to its end (if STOP-AT-END is non-nil) or the next token after it
;; (otherwise) and return non-nil. If there is no valid requires clause at
;; point, leave point unmoved and return nil.
(or limit (setq limit (point-max)))
(and (zerop (c-forward-token-2)) ; over "requires".
(c-forward-constraint-clause limit stop-at-end)))
(defun c-forward-decl-arglist (not-top id-in-parens &optional limit)
;; Point is at an open parenthesis, assumed to be the arglist of a function
;; declaration. Move over this arglist and following syntactic whitespace,
@ -9939,7 +9970,9 @@ point unchanged and return nil."
((looking-at c-type-decl-suffix-key)
(cond
((save-match-data
(looking-at c-fun-name-substitute-key))
(and
(looking-at c-fun-name-substitute-key)
(not (eq (char-after (match-end 0)) ?_))))
(c-forward-c++-requires-clause))
((eq (char-after) ?\()
(if (c-forward-decl-arglist not-top decorated limit)
@ -10393,7 +10426,9 @@ This function might do hidden buffer changes."
(when (and (c-major-mode-is 'c++-mode)
(c-keyword-member kwd-sym 'c-<>-sexp-kwds)
(save-match-data
(looking-at c-fun-name-substitute-key)))
(and
(looking-at c-fun-name-substitute-key)
(not (eq (char-after (match-end 0)) ?_)))))
(c-forward-c++-requires-clause))
(setq kwd-clause-end (point))))
((and c-opt-cpp-prefix
@ -10743,7 +10778,9 @@ This function might do hidden buffer changes."
((save-match-data (looking-at "\\s("))
(c-safe (c-forward-sexp 1) t))
((save-match-data
(looking-at c-fun-name-substitute-key)) ; C++ requires
(and
(looking-at c-fun-name-substitute-key)
(not (eq (char-after (match-end 0)) ?_)))) ; C++ requires
(c-forward-c++-requires-clause))
(t (goto-char (match-end 1))
t))
@ -12866,7 +12903,9 @@ comment at the start of cc-engine.el for more info."
in-paren 'in-paren))
((looking-at c-pre-brace-non-bracelist-key)
(setq braceassignp nil))
((looking-at c-fun-name-substitute-key)
((and
(looking-at c-fun-name-substitute-key)
(not (eq (char-after (match-end 0)) ?_)))
(setq braceassignp nil))
((looking-at c-return-key))
((and (looking-at c-symbol-start)
@ -12881,7 +12920,8 @@ comment at the start of cc-engine.el for more info."
;; Have we a requires with a parenthesis list?
(when (save-excursion
(and (zerop (c-backward-token-2 1 nil lim))
(looking-at c-fun-name-substitute-key)))
(looking-at c-fun-name-substitute-key)
(not (eq (char-after (match-end 0)) ?_))))
(setq braceassignp nil))
nil)
(t nil))
@ -13212,6 +13252,120 @@ comment at the start of cc-engine.el for more info."
(t nil)))
(goto-char here))))
(defun c-forward-concept-fragment (&optional limit stop-at-end)
;; Are we currently at the "concept" keyword in a concept construct? If so
;; we return the position of the first constraint expression following the
;; "=" sign and move forward over the constraint. Otherwise we return nil.
;; LIMIT is a forward search limit.
(let ((here (point)))
(if
(and
(looking-at c-equals-nontype-decl-key) ; "concept"
(goto-char (match-end 0))
(progn (c-forward-syntactic-ws limit)
(not (looking-at c-keywords-regexp)))
(looking-at c-identifier-key)
(goto-char (match-end 0))
(progn (c-forward-syntactic-ws limit)
(looking-at c-operator-re))
(equal (match-string 0) "=")
(goto-char (match-end 0)))
(prog1
(progn (c-forward-syntactic-ws limit)
(point))
(c-forward-constraint-clause limit stop-at-end))
(goto-char here)
nil)))
(defun c-looking-at-concept (&optional limit)
;; Are we currently at the start of a concept construct? I.e. at the
;; "template" keyword followed by the construct? If so, we return a cons of
;; the position of "concept" and the position of the first constraint
;; expression following the "=" sign, otherwise we return nil. LIMIT is a
;; forward search limit.
(save-excursion
(let (conpos)
(and (looking-at c-pre-concept-<>-key)
(goto-char (match-end 1))
(< (point) limit)
(progn (c-forward-syntactic-ws limit)
(eq (char-after) ?<))
(let ((c-parse-and-markup-<>-arglists t)
c-restricted-<>-arglists)
(c-forward-<>-arglist nil))
(< (point) limit)
(progn (c-forward-syntactic-ws limit)
(looking-at c-equals-nontype-decl-key)) ; "concept"
(setq conpos (match-beginning 0))
(goto-char (match-end 0))
(< (point) limit)
(c-syntactic-re-search-forward
"=" limit t t)
(goto-char (match-end 0))
(<= (point) limit)
(progn (c-forward-syntactic-ws limit)
(cons conpos (point)))))))
(defun c-in-requires-or-at-end-of-clause (&optional pos)
;; Is POS (default POINT) in a C++ "requires" expression or "requires"
;; clause or at the end of a "requires" clause? If so return a cons
;; (POSITION . END) where POSITION is that of the "requires" keyword, and
;; END is `expression' if POS is in an expression, nil if it's in a clause
;; or t if it's at the end of a clause. "End of a clause" means just after
;; the non syntactic WS on the line where the clause ends.
;;
;; Note we can't use `c-beginning-of-statement-1' in this function because
;; of this function's use in `c-at-vsemi-p' for C++ Mode.
(save-excursion
(if pos (goto-char pos) (setq pos (point)))
(let ((limit (max (- (point) 2000) (point-min)))
found-req req-pos found-clause res pe-start pe-end
)
(while ; Loop around syntactically significant "requires" keywords.
(progn
(while
(and
(setq found-req (re-search-backward
c-fun-name-substitute-key
limit t)) ; Fast!
(or (not (setq found-req
(not (eq (char-after (match-end 0)) ?_))))
(not (setq found-req (not (c-in-literal))))))) ; Slow!
(setq req-pos (point))
(cond
((not found-req) ; No "requires" found
nil)
((save-excursion ; A primary expression `pos' is in
(setq pe-end nil)
(while (and (setq pe-start (point))
(< (point) pos)
(c-forward-primary-expression nil t)
(setq pe-end (point))
(progn (c-forward-syntactic-ws)
(looking-at "&&\\|||"))
(c-forward-over-token-and-ws)))
pe-end)
(if (<= pe-end pos)
t ; POS is not in a primary expression.
(setq res (cons pe-start 'expression))
nil))
((progn
(goto-char req-pos)
(if (looking-at c-fun-name-substitute-key)
(setq found-clause (c-forward-c++-requires-clause nil t))
(and (c-forward-concept-fragment)
(setq found-clause (point))))
nil))
((and found-clause (>= (point) pos))
(setq res (cons req-pos (eq (point) pos)))
nil)
(found-clause ; We found a constraint clause, but it did not
; extend far enough forward to reach POS.
(c-go-up-list-backward req-pos limit))
(t (goto-char req-pos)
t))))
res)))
(defun c-looking-at-inexpr-block (lim containing-sexp &optional check-at-end)
;; Return non-nil if we're looking at the beginning of a block
;; inside an expression. The value returned is actually a cons of
@ -13408,6 +13562,19 @@ comment at the start of cc-engine.el for more info."
(looking-at c-pre-lambda-tokens-re)))
(not (c-in-literal))))
(defun c-c++-vsemi-p (&optional pos)
;; C++ Only - Is there a "virtual semicolon" at POS or point?
;; (See cc-defs.el for full details of "virtual semicolons".)
;;
;; This is true when point is at the last non syntactic WS position on the
;; line, and either there is a "macro with semicolon" just before it (see
;; `c-at-macro-vsemi-p') or there is a "requires" clause which ends there.
(let (res)
(cond
((setq res (c-in-requires-or-at-end-of-clause pos))
(and res (eq (cdr res) t)))
((c-at-macro-vsemi-p)))))
(defun c-at-macro-vsemi-p (&optional pos)
;; Is there a "virtual semicolon" at POS or point?
;; (See cc-defs.el for full details of "virtual semicolons".)
@ -13959,7 +14126,7 @@ comment at the start of cc-engine.el for more info."
literal char-before-ip before-ws-ip char-after-ip macro-start
in-macro-expr c-syntactic-context placeholder
step-type tmpsymbol keyword injava-inher special-brace-list tmp-pos
tmp-pos2 containing-<
tmp-pos2 containing-< tmp constraint-detail
;; The following record some positions for the containing
;; declaration block if we're directly within one:
;; `containing-decl-open' is the position of the open
@ -14374,6 +14541,33 @@ comment at the start of cc-engine.el for more info."
containing-decl-start
containing-decl-kwd))
;; CASE 5A.7: "defun" open in a requires expression.
((save-excursion
(goto-char indent-point)
(c-backward-syntactic-ws lim)
(and (or (not (eq (char-before) ?\)))
(c-go-list-backward nil lim))
(progn (c-backward-syntactic-ws lim)
(zerop (c-backward-token-2 nil nil lim)))
(looking-at c-fun-name-substitute-key)
(not (eq (char-after (match-end 0)) ?_))
(setq placeholder (point))))
(goto-char placeholder)
(back-to-indentation)
(c-add-syntax 'defun-open (point)))
;; CASE 5A.6: "defun" open in concept.
;; ((save-excursion
;; (goto-char indent-point)
;; (skip-chars-forward " \t")
;; (and (eq (char-after) ?{)
;; (eq (c-beginning-of-statement-1 lim) 'same)
;; (setq placeholder
;; (cdr (c-looking-at-concept indent-point)))))
;; (goto-char placeholder)
;; (back-to-indentation)
;; (c-add-syntax 'defun-open (point)))
;; CASE 5A.5: ordinary defun open
(t
(save-excursion
@ -14544,10 +14738,35 @@ comment at the start of cc-engine.el for more info."
nil nil
containing-sexp paren-state))
;; CASE 5F: Close of a non-class declaration level block.
((and (eq char-after-ip ?})
(c-keyword-member containing-decl-kwd
'c-other-block-decl-kwds))
;; This is inconsistent: Should use `containing-decl-open'
;; here if it's at boi, like in case 5J.
(goto-char containing-decl-start)
(c-add-stmt-syntax
(if (string-equal (symbol-name containing-decl-kwd) "extern")
;; Special case for compatibility with the
;; extern-lang syntactic symbols.
'extern-lang-close
(intern (concat (symbol-name containing-decl-kwd)
"-close")))
nil t
(c-most-enclosing-brace paren-state (point))
paren-state))
;; CASE 5T: Continuation of a concept clause.
((save-excursion
(and (eq (c-beginning-of-statement-1 nil t) 'same)
(setq tmp (c-looking-at-concept indent-point))))
(c-add-syntax 'constraint-cont (car tmp)))
;; CASE 5D: this could be a top-level initialization, a
;; member init list continuation, or a template argument
;; list continuation.
((save-excursion
(setq constraint-detail (c-in-requires-or-at-end-of-clause))
;; Note: We use the fact that lim is always after any
;; preceding brace sexp.
(if c-recognize-<>-arglists
@ -14577,8 +14796,9 @@ comment at the start of cc-engine.el for more info."
;; clause - we assume only C++ needs it.
(c-syntactic-skip-backward "^;,=" lim t))
(setq placeholder (point))
(and (memq (char-before) '(?, ?= ?<))
(not (c-crosses-statement-barrier-p (point) indent-point))))
(or constraint-detail
(and (memq (char-before) '(?, ?= ?<))
(not (c-crosses-statement-barrier-p (point) indent-point)))))
(cond
;; CASE 5D.6: Something like C++11's "using foo = <type-exp>"
@ -14596,8 +14816,7 @@ comment at the start of cc-engine.el for more info."
(c-on-identifier))
(setq placeholder preserve-point)))))
(c-add-syntax
'statement-cont placeholder)
)
'statement-cont placeholder))
;; CASE 5D.3: perhaps a template list continuation?
((and (c-major-mode-is 'c++-mode)
@ -14647,21 +14866,10 @@ comment at the start of cc-engine.el for more info."
;; CASE 5D.7: Continuation of a "concept foo =" line in C++20 (or
;; similar).
((and c-equals-nontype-decl-key
(save-excursion
(prog1
(and (zerop (c-backward-token-2 1 nil lim))
(looking-at c-operator-re)
(equal (match-string 0) "=")
(zerop (c-backward-token-2 1 nil lim))
(looking-at c-symbol-start)
(not (looking-at c-keywords-regexp))
(zerop (c-backward-token-2 1 nil lim))
(looking-at c-equals-nontype-decl-key)
(eq (c-beginning-of-statement-1 lim) 'same))
(setq placeholder (point)))))
(goto-char placeholder)
(c-add-stmt-syntax 'topmost-intro-cont nil nil containing-sexp
((and constraint-detail
(not (eq (cdr constraint-detail) 'expression)))
(goto-char (car constraint-detail))
(c-add-stmt-syntax 'constraint-cont nil nil containing-sexp
paren-state))
;; CASE 5D.5: Continuation of the "expression part" of a
@ -14686,24 +14894,6 @@ comment at the start of cc-engine.el for more info."
nil nil containing-sexp paren-state))
))
;; CASE 5F: Close of a non-class declaration level block.
((and (eq char-after-ip ?})
(c-keyword-member containing-decl-kwd
'c-other-block-decl-kwds))
;; This is inconsistent: Should use `containing-decl-open'
;; here if it's at boi, like in case 5J.
(goto-char containing-decl-start)
(c-add-stmt-syntax
(if (string-equal (symbol-name containing-decl-kwd) "extern")
;; Special case for compatibility with the
;; extern-lang syntactic symbols.
'extern-lang-close
(intern (concat (symbol-name containing-decl-kwd)
"-close")))
nil t
(c-most-enclosing-brace paren-state (point))
paren-state))
;; CASE 5G: we are looking at the brace which closes the
;; enclosing nested class decl
((and containing-sexp
@ -14916,6 +15106,16 @@ comment at the start of cc-engine.el for more info."
(c-add-syntax 'topmost-intro-cont (c-point 'boi)))
))
;; CASE 20: A C++ requires sub-clause.
((and (setq tmp (c-in-requires-or-at-end-of-clause indent-point))
(not (eq (cdr tmp) 'expression))
(setq placeholder (car tmp)))
(c-add-syntax
(if (eq char-after-ip ?{)
'substatement-open
'substatement)
(c-point 'boi placeholder)))
;; ((Old) CASE 6 has been removed.)
;; CASE 6: line is within a C11 _Generic expression.
((and c-generic-key
@ -15299,6 +15499,20 @@ comment at the start of cc-engine.el for more info."
(c-add-syntax 'defun-close (point))
(c-add-syntax 'inline-close (point))))
;; CASE 16G: Do we have the closing brace of a "requires" clause
;; of a C++20 "concept"?
((save-excursion
(c-backward-syntactic-ws lim)
(and (or (not (eq (char-before) ?\)))
(c-go-list-backward nil lim))
(progn (c-backward-syntactic-ws lim)
(zerop (c-backward-token-2 nil nil lim)))
(looking-at c-fun-name-substitute-key)
(not (eq (char-after (match-end 0)) ?_))))
(goto-char containing-sexp)
(back-to-indentation)
(c-add-stmt-syntax 'defun-close nil t lim paren-state))
;; CASE 16F: Can be a defun-close of a function declared
;; in a statement block, e.g. in Pike or when using gcc
;; extensions, but watch out for macros followed by
@ -15449,6 +15663,21 @@ comment at the start of cc-engine.el for more info."
(if (eq char-after-ip ?{)
(c-add-syntax 'block-open)))
;; CASE 17J: first "statement" inside a C++20 requires
;; "function".
((save-excursion
(goto-char containing-sexp)
(c-backward-syntactic-ws lim)
(and (or (not (eq (char-before) ?\)))
(c-go-list-backward nil lim))
(progn (c-backward-syntactic-ws lim)
(zerop (c-backward-token-2 nil nil lim)))
(looking-at c-fun-name-substitute-key)
(not (eq (char-after (match-end 0)) ?_))))
(goto-char containing-sexp)
(back-to-indentation)
(c-add-syntax 'defun-block-intro (point)))
;; CASE 17F: first statement in an inline, or first
;; statement in a top-level defun. we can tell this is it
;; if there are no enclosing braces that haven't been

3
lisp/progmodes/cc-fonts.el
View file

@ -1388,7 +1388,8 @@ casts and declarations are fontified. Used on level 2 and higher."
(memq type '(c-decl-arg-start
c-decl-type-start))))))))
((and (zerop (c-backward-token-2))
(looking-at c-fun-name-substitute-key)))))))))
(looking-at c-fun-name-substitute-key)
(not (eq (char-after (match-end 0)) ?_))))))))))
;; Cache the result of this test for next time around.
(c-put-char-property (1- match-pos) 'c-type 'c-decl-arg-start)
(cons 'decl nil))

10
lisp/progmodes/cc-langs.el
View file

@ -586,7 +586,8 @@ Such a function takes one optional parameter, a buffer position (defaults to
point), and returns nil or t. This variable contains nil for languages which
don't have EOL terminated statements. "
t nil
(c c++ objc) 'c-at-macro-vsemi-p
(c objc) 'c-at-macro-vsemi-p
c++ 'c-c++-vsemi-p
awk 'c-awk-at-vsemi-p)
(c-lang-defvar c-at-vsemi-p-fn (c-lang-const c-at-vsemi-p-fn))
@ -2634,9 +2635,12 @@ clause. An arglist may or may not follow such a keyword."
c++ '("requires"))
(c-lang-defconst c-fun-name-substitute-key
;; An adorned regular expression which matches any member of
;; An unadorned regular expression which matches any member of
;; `c-fun-name-substitute-kwds'.
t (c-make-keywords-re t (c-lang-const c-fun-name-substitute-kwds)))
t (c-make-keywords-re 'appendable (c-lang-const c-fun-name-substitute-kwds)))
;; We use 'appendable, so that we get "\\>" on the regexp, but without a further
;; character, which would mess up backward regexp search from just after the
;; keyword. If only XEmacs had \\_>. ;-(
(c-lang-defvar c-fun-name-substitute-key
(c-lang-const c-fun-name-substitute-key))

5
lisp/progmodes/cc-vars.el
View file

@ -1094,6 +1094,8 @@ can always override the use of `c-default-style' by making calls to
;; Anchor pos: Bol at the last line of previous construct.
(topmost-intro-cont . c-lineup-topmost-intro-cont)
;;Anchor pos: Bol at the topmost annotation line
(constraint-cont . +)
;; Anchor pos: Boi of the starting requires/concept line
(annotation-top-cont . 0)
;;Anchor pos: Bol at the topmost annotation line
(annotation-var-cont . +)
@ -1326,6 +1328,9 @@ Here is the current list of valid syntactic element symbols:
knr-argdecl -- Subsequent lines in a K&R C argument declaration.
topmost-intro -- The first line in a topmost construct definition.
topmost-intro-cont -- Topmost definition continuation lines.
constraint-cont -- Continuation line of a C++ requires clause (not
to be confused with a \"requires expression\") or
concept.
annotation-top-cont -- Topmost definition continuation line where only
annotations are on previous lines.
annotation-var-cont -- A continuation of a C (or like) statement where

8
lisp/progmodes/flymake.el
View file

@ -434,22 +434,22 @@ verify FILTER, a function, and sort them by COMPARE (using KEY)."
(defface flymake-error-echo
'((t :inherit compilation-error))
"Face used for showing summarized descriptions of errors."
:package-version '("Flymake" . "1.3.4"))
:package-version '(Flymake . "1.3.4"))
(defface flymake-warning-echo
'((t :inherit compilation-warning))
"Face used for showing summarized descriptions of warnings."
:package-version '("Flymake" . "1.3.4"))
:package-version '(Flymake . "1.3.4"))
(defface flymake-note-echo
'((t :inherit flymake-note))
"Face used for showing summarized descriptions of notes."
:package-version '("Flymake" . "1.3.4"))
:package-version '(Flymake . "1.3.4"))
(defcustom flymake-show-diagnostics-at-end-of-line nil
"If non-nil, add diagnostic summary messages at end-of-line."
:type 'boolean
:package-version '("Flymake" . "1.3.4"))
:package-version '(Flymake . "1.3.4"))
(define-obsolete-face-alias 'flymake-warnline 'flymake-warning "26.1")
(define-obsolete-face-alias 'flymake-errline 'flymake-error "26.1")

2
src/buffer.c
View file

@ -1307,7 +1307,7 @@ buffer_local_value (Lisp_Object variable, Lisp_Object buffer)
start:
switch (sym->u.s.redirect)
{
case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start;
case SYMBOL_PLAINVAL: result = SYMBOL_VAL (sym); break;
case SYMBOL_LOCALIZED:
{ /* Look in local_var_alist. */

61
src/data.c
View file

@ -683,7 +683,7 @@ global value outside of any lexical scope. */)
switch (sym->u.s.redirect)
{
case SYMBOL_PLAINVAL: valcontents = SYMBOL_VAL (sym); break;
case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start;
case SYMBOL_LOCALIZED:
{
struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
@ -1249,51 +1249,20 @@ The value, if non-nil, is a list of mode name symbols. */)
Getting and Setting Values of Symbols
***********************************************************************/
/* Return the symbol holding SYMBOL's value. Signal
`cyclic-variable-indirection' if SYMBOL's chain of variable
indirections contains a loop. */
struct Lisp_Symbol *
indirect_variable (struct Lisp_Symbol *symbol)
{
struct Lisp_Symbol *tortoise, *hare;
hare = tortoise = symbol;
while (hare->u.s.redirect == SYMBOL_VARALIAS)
{
hare = SYMBOL_ALIAS (hare);
if (hare->u.s.redirect != SYMBOL_VARALIAS)
break;
hare = SYMBOL_ALIAS (hare);
tortoise = SYMBOL_ALIAS (tortoise);
if (hare == tortoise)
{
Lisp_Object tem;
XSETSYMBOL (tem, symbol);
xsignal1 (Qcyclic_variable_indirection, tem);
}
}
return hare;
}
DEFUN ("indirect-variable", Findirect_variable, Sindirect_variable, 1, 1, 0,
doc: /* Return the variable at the end of OBJECT's variable chain.
If OBJECT is a symbol, follow its variable indirections (if any), and
return the variable at the end of the chain of aliases. See Info node
`(elisp)Variable Aliases'.
If OBJECT is not a symbol, just return it. If there is a loop in the
chain of aliases, signal a `cyclic-variable-indirection' error. */)
If OBJECT is not a symbol, just return it. */)
(Lisp_Object object)
{
if (SYMBOLP (object))
{
struct Lisp_Symbol *sym = indirect_variable (XSYMBOL (object));
struct Lisp_Symbol *sym = XSYMBOL (object);
while (sym->u.s.redirect == SYMBOL_VARALIAS)
sym = SYMBOL_ALIAS (sym);
XSETSYMBOL (object, sym);
}
return object;
@ -1582,7 +1551,7 @@ find_symbol_value (Lisp_Object symbol)
start:
switch (sym->u.s.redirect)
{
case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start;
case SYMBOL_PLAINVAL: return SYMBOL_VAL (sym);
case SYMBOL_LOCALIZED:
{
@ -1671,7 +1640,7 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
start:
switch (sym->u.s.redirect)
{
case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start;
case SYMBOL_PLAINVAL: SET_SYMBOL_VAL (sym , newval); return;
case SYMBOL_LOCALIZED:
{
@ -1925,7 +1894,7 @@ default_value (Lisp_Object symbol)
start:
switch (sym->u.s.redirect)
{
case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start;
case SYMBOL_PLAINVAL: return SYMBOL_VAL (sym);
case SYMBOL_LOCALIZED:
{
@ -2019,7 +1988,7 @@ set_default_internal (Lisp_Object symbol, Lisp_Object value,
start:
switch (sym->u.s.redirect)
{
case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start;
case SYMBOL_PLAINVAL: set_internal (symbol, value, Qnil, bindflag); return;
case SYMBOL_LOCALIZED:
{
@ -2157,7 +2126,7 @@ See also `defvar-local'. */)
start:
switch (sym->u.s.redirect)
{
case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start;
case SYMBOL_PLAINVAL:
forwarded = 0; valcontents.value = SYMBOL_VAL (sym);
if (BASE_EQ (valcontents.value, Qunbound))
@ -2225,7 +2194,7 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */)
start:
switch (sym->u.s.redirect)
{
case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start;
case SYMBOL_PLAINVAL:
forwarded = 0; valcontents.value = SYMBOL_VAL (sym); break;
case SYMBOL_LOCALIZED:
@ -2311,7 +2280,7 @@ From now on the default value will apply in this buffer. Return VARIABLE. */)
start:
switch (sym->u.s.redirect)
{
case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start;
case SYMBOL_PLAINVAL: return variable;
case SYMBOL_FORWARDED:
{
@ -2378,7 +2347,7 @@ Also see `buffer-local-boundp'.*/)
start:
switch (sym->u.s.redirect)
{
case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start;
case SYMBOL_PLAINVAL: return Qnil;
case SYMBOL_LOCALIZED:
{
@ -2428,7 +2397,7 @@ value in BUFFER, or if VARIABLE is automatically buffer-local (see
start:
switch (sym->u.s.redirect)
{
case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start;
case SYMBOL_PLAINVAL: return Qnil;
case SYMBOL_LOCALIZED:
{
@ -2463,7 +2432,7 @@ If the current binding is global (the default), the value is nil. */)
start:
switch (sym->u.s.redirect)
{
case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
case SYMBOL_VARALIAS: sym = SYMBOL_ALIAS (sym); goto start;
case SYMBOL_PLAINVAL: return Qnil;
case SYMBOL_FORWARDED:
{

22
src/eval.c
View file

@ -571,11 +571,12 @@ omitted or nil, NEW-ALIAS gets the documentation string of BASE-VARIABLE,
or of the variable at the end of the chain of aliases, if BASE-VARIABLE is
itself an alias. If NEW-ALIAS is bound, and BASE-VARIABLE is not,
then the value of BASE-VARIABLE is set to that of NEW-ALIAS.
The return value is BASE-VARIABLE. */)
The return value is BASE-VARIABLE.
If the resulting chain of variable definitions would contain a loop,
signal a `cyclic-variable-indirection' error. */)
(Lisp_Object new_alias, Lisp_Object base_variable, Lisp_Object docstring)
{
struct Lisp_Symbol *sym;
CHECK_SYMBOL (new_alias);
CHECK_SYMBOL (base_variable);
@ -584,7 +585,18 @@ The return value is BASE-VARIABLE. */)
error ("Cannot make a constant an alias: %s",
SDATA (SYMBOL_NAME (new_alias)));
sym = XSYMBOL (new_alias);
struct Lisp_Symbol *sym = XSYMBOL (new_alias);
/* Ensure non-circularity. */
struct Lisp_Symbol *s = XSYMBOL (base_variable);
for (;;)
{
if (s == sym)
xsignal1 (Qcyclic_variable_indirection, base_variable);
if (s->u.s.redirect != SYMBOL_VARALIAS)
break;
s = SYMBOL_ALIAS (s);
}
switch (sym->u.s.redirect)
{
@ -3476,7 +3488,7 @@ specbind (Lisp_Object symbol, Lisp_Object value)
switch (sym->u.s.redirect)
{
case SYMBOL_VARALIAS:
sym = indirect_variable (sym); XSETSYMBOL (symbol, sym); goto start;
sym = SYMBOL_ALIAS (sym); XSETSYMBOL (symbol, sym); goto start;
case SYMBOL_PLAINVAL:
/* The most common case is that of a non-constant symbol with a
trivial value. Make that as fast as we can. */

1
src/lisp.h
View file

@ -3970,7 +3970,6 @@ extern Lisp_Object arithcompare (Lisp_Object num1, Lisp_Object num2,
extern intmax_t cons_to_signed (Lisp_Object, intmax_t, intmax_t);
extern uintmax_t cons_to_unsigned (Lisp_Object, uintmax_t);
extern struct Lisp_Symbol *indirect_variable (struct Lisp_Symbol *);
extern AVOID args_out_of_range (Lisp_Object, Lisp_Object);
extern AVOID circular_list (Lisp_Object);
extern Lisp_Object do_symval_forwarding (lispfwd);

2
src/nsterm.m
View file

@ -4603,7 +4603,7 @@ in certain situations (rapid incoming events).
#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
static void
check_native_fs ()
check_native_fs (void)
{
Lisp_Object frame, tail;

55
src/treesit.c
View file

@ -1962,19 +1962,19 @@ live. */)
TSNode treesit_node = XTS_NODE (node)->node;
bool result;
if (EQ (property, Qoutdated))
if (BASE_EQ (property, Qoutdated))
return treesit_node_uptodate_p (node) ? Qnil : Qt;
treesit_check_node (node);
if (EQ (property, Qnamed))
if (BASE_EQ (property, Qnamed))
result = ts_node_is_named (treesit_node);
else if (EQ (property, Qmissing))
else if (BASE_EQ (property, Qmissing))
result = ts_node_is_missing (treesit_node);
else if (EQ (property, Qextra))
else if (BASE_EQ (property, Qextra))
result = ts_node_is_extra (treesit_node);
else if (EQ (property, Qhas_error))
else if (BASE_EQ (property, Qhas_error))
result = ts_node_has_error (treesit_node);
else if (EQ (property, Qlive))
else if (BASE_EQ (property, Qlive))
result = treesit_parser_live_p (XTS_NODE (node)->parser);
else
signal_error ("Expecting `named', `missing', `extra', "
@ -2293,19 +2293,19 @@ PATTERN can be
See Info node `(elisp)Pattern Matching' for detailed explanation. */)
(Lisp_Object pattern)
{
if (EQ (pattern, QCanchor))
if (BASE_EQ (pattern, QCanchor))
return Vtreesit_str_dot;
if (EQ (pattern, intern_c_string (":?")))
if (BASE_EQ (pattern, intern_c_string (":?")))
return Vtreesit_str_question_mark;
if (EQ (pattern, intern_c_string (":*")))
if (BASE_EQ (pattern, intern_c_string (":*")))
return Vtreesit_str_star;
if (EQ (pattern, intern_c_string (":+")))
if (BASE_EQ (pattern, intern_c_string (":+")))
return Vtreesit_str_plus;
if (EQ (pattern, QCequal))
if (BASE_EQ (pattern, QCequal))
return Vtreesit_str_pound_equal;
if (EQ (pattern, QCmatch))
if (BASE_EQ (pattern, QCmatch))
return Vtreesit_str_pound_match;
if (EQ (pattern, QCpred))
if (BASE_EQ (pattern, QCpred))
return Vtreesit_str_pound_pred;
Lisp_Object opening_delimeter
= VECTORP (pattern)
@ -2898,7 +2898,7 @@ the query. */)
/* 2. Get predicates and check whether this match can be
included in the result list. */
Lisp_Object predicates = AREF (predicates_table, match.pattern_index);
if (EQ (predicates, Qt))
if (BASE_EQ (predicates, Qt))
{
predicates = treesit_predicates_for_pattern (treesit_query,
match.pattern_index);
@ -3148,15 +3148,13 @@ treesit_traverse_validate_predicate (Lisp_Object pred,
{
if (STRINGP (pred))
return true;
/* We want to allow cl-labels-defined functions, so we allow
symbols. */
else if (FUNCTIONP (pred) || SYMBOLP (pred))
else if (FUNCTIONP (pred))
return true;
else if (CONSP (pred))
{
Lisp_Object car = XCAR (pred);
Lisp_Object cdr = XCDR (pred);
if (EQ (car, Qnot))
if (BASE_EQ (car, Qnot))
{
if (!CONSP (cdr))
{
@ -3176,7 +3174,7 @@ treesit_traverse_validate_predicate (Lisp_Object pred,
return treesit_traverse_validate_predicate (XCAR (cdr),
signal_data);
}
else if (EQ (car, Qor))
else if (BASE_EQ (car, Qor))
{
if (!CONSP (cdr) || NILP (cdr))
{
@ -3194,8 +3192,7 @@ treesit_traverse_validate_predicate (Lisp_Object pred,
}
return true;
}
/* We allow the function to be a symbol to support cl-label. */
else if (STRINGP (car) && (FUNCTIONP (cdr) || SYMBOLP (cdr)))
else if (STRINGP (car) && FUNCTIONP (cdr))
return true;
}
*signal_data = list2 (build_string ("Invalid predicate, see TODO for "
@ -3230,9 +3227,7 @@ treesit_traverse_match_predicate (TSTreeCursor *cursor, Lisp_Object pred,
const char *type = ts_node_type (node);
return fast_c_string_match (pred, type, strlen (type)) >= 0;
}
/* We want to allow cl-labels-defined functions, so we allow
symbols. */
else if (FUNCTIONP (pred) || SYMBOLP (pred))
else if (FUNCTIONP (pred))
{
Lisp_Object lisp_node = make_treesit_node (parser, node);
return !NILP (CALLN (Ffuncall, pred, lisp_node));
@ -3242,10 +3237,10 @@ treesit_traverse_match_predicate (TSTreeCursor *cursor, Lisp_Object pred,
Lisp_Object car = XCAR (pred);
Lisp_Object cdr = XCDR (pred);
if (EQ (car, Qnot))
if (BASE_EQ (car, Qnot))
return !treesit_traverse_match_predicate (cursor, XCAR (cdr),
parser, named);
else if (EQ (car, Qor))
else if (BASE_EQ (car, Qor))
{
FOR_EACH_TAIL (cdr)
{
@ -3255,17 +3250,15 @@ treesit_traverse_match_predicate (TSTreeCursor *cursor, Lisp_Object pred,
}
return false;
}
/* We want to allow cl-labels-defined functions, so we allow
symbols. */
else if (STRINGP (car) && (FUNCTIONP (cdr) || SYMBOLP (cdr)))
else if (STRINGP (car) && FUNCTIONP (cdr))
{
/* A bit of code duplication here, but should be fine. */
const char *type = ts_node_type (node);
if (!(fast_c_string_match (pred, type, strlen (type)) >= 0))
if (!(fast_c_string_match (car, type, strlen (type)) >= 0))
return false;
Lisp_Object lisp_node = make_treesit_node (parser, node);
if (NILP (CALLN (Ffuncall, pred, lisp_node)))
if (NILP (CALLN (Ffuncall, cdr, lisp_node)))
return false;
return true;

16
test/src/eval-tests.el
View file

@ -266,4 +266,20 @@ expressions works for identifiers starting with period."
)
(should (eq eval-test--local-var 'global)))
(ert-deftest eval-tests-defvaralias ()
(defvar eval-tests--my-var 'coo)
(defvaralias 'eval-tests--my-var1 'eval-tests--my-var)
(defvar eval-tests--my-var1)
(should (equal eval-tests--my-var 'coo))
(should (equal eval-tests--my-var1 'coo))
(defvaralias 'eval-tests--my-a 'eval-tests--my-b)
(defvaralias 'eval-tests--my-b 'eval-tests--my-c)
(should-error (defvaralias 'eval-tests--my-c 'eval-tests--my-c)
:type 'cyclic-variable-indirection)
(defvaralias 'eval-tests--my-d 'eval-tests--my-a)
(should-error (defvaralias 'eval-tests--my-c 'eval-tests--my-d)
:type 'cyclic-variable-indirection))
;;; eval-tests.el ends here

15
test/src/treesit-tests.el
View file

@ -363,11 +363,12 @@ BODY is the test body."
while cursor
do (should (equal (treesit-node-text cursor) text)))
;; Test (regexp . function)
(cl-labels ((is-odd (string)
(and (eq 1 (length string))
(cl-oddp (string-to-number string)))))
(let ((is-odd (lambda (node)
(let ((string (treesit-node-text node)))
(and (eq 1 (length string))
(cl-oddp (string-to-number string)))))))
(cl-loop for cursor = (treesit-node-child array 0)
then (treesit-search-forward cursor '("number" . is-odd)
then (treesit-search-forward cursor `("number" . ,is-odd)
nil t)
for text in '("[" "1" "3" "5" "7" "9")
while cursor
@ -377,13 +378,13 @@ BODY is the test body."
"Test tree-sitter's ability to detect invalid predicates."
(skip-unless (treesit-language-available-p 'json))
(treesit--ert-search-setup
(dolist (pred '( 1 (not 1) (not "2" "3") (or) (or 1)))
(dolist (pred '( 1 (not 1) (not "2" "3") (or) (or 1) 'a))
(should-error (treesit-search-forward (treesit-node-child array 0)
pred)
:type 'treesit-invalid-predicate))
(should-error (treesit-search-forward (treesit-node-child array 0)
'not-a-function)
:type 'void-function)))
(lambda (node) (car node)))
:type 'wrong-type-argument)))
(ert-deftest treesit-cursor-helper-with-missing-node ()
"Test treesit_cursor_helper with a missing node."