diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index 5584cbce9a6..f92c02ae5ed 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -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 diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi index 3a808619868..71bf3fcee4a 100644 --- a/doc/misc/cc-mode.texi +++ b/doc/misc/cc-mode.texi @@ -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 + 2: requires + 3: requires (T t) @{ + 4: @{ ++t; @} + 5: @} + 6: && std::is_integral + 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 diff --git a/etc/NEWS b/etc/NEWS index e507ef1b55e..16061135ea1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -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 diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el index 57a833de9bf..4eaaffe34a5 100644 --- a/lisp/gnus/nnselect.el +++ b/lisp/gnus/nnselect.el @@ -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)) diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index aa6f33e9cab..1d98b215525 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -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 diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 4045576630c..f7320da5629 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -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 = " @@ -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 diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 17b3c7be199..9118e3253c2 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -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)) diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index 28403385115..3b4fdc6e141 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -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)) diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index afeb88c7b8a..72d4b93ee59 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -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 diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index f2fe97cb773..ac408145696 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -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") diff --git a/src/buffer.c b/src/buffer.c index 84301c86a7f..49246416698 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -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. */ diff --git a/src/data.c b/src/data.c index 4ab37e86ce5..8f9ee63e779 100644 --- a/src/data.c +++ b/src/data.c @@ -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: { diff --git a/src/eval.c b/src/eval.c index 545a280ae91..cd3eb0a3676 100644 --- a/src/eval.c +++ b/src/eval.c @@ -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. */ diff --git a/src/lisp.h b/src/lisp.h index b7f76a366f3..d0017b70a5b 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -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); diff --git a/src/nsterm.m b/src/nsterm.m index 46007ec4fcb..87bdb44eadc 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -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; diff --git a/src/treesit.c b/src/treesit.c index 45b5ab15390..dbbfa29c19d 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -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; diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el index e0a27439ba2..4589763b2f5 100644 --- a/test/src/eval-tests.el +++ b/test/src/eval-tests.el @@ -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 diff --git a/test/src/treesit-tests.el b/test/src/treesit-tests.el index 26a21c34152..ecdee3c26e4 100644 --- a/test/src/treesit-tests.el +++ b/test/src/treesit-tests.el @@ -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."