diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi index 3f6a418de1a..f82b605598e 100644 --- a/doc/emacs/building.texi +++ b/doc/emacs/building.texi @@ -1556,18 +1556,26 @@ command prompts for a @dfn{library name} rather than a file name; it searches through each directory in the Emacs Lisp load path, trying to find a file matching that library name. If the library name is @samp{@var{foo}}, it tries looking for files named -@file{@var{foo}.elc}, @file{@var{foo}.el}, and @file{@var{foo}}. The -default behavior is to load the first file found. This command -prefers @file{.elc} files over @file{.el} files because compiled files -load and run faster. If it finds that @file{@var{lib}.el} is newer -than @file{@var{lib}.elc}, it issues a warning, in case someone made -changes to the @file{.el} file and forgot to recompile it, but loads -the @file{.elc} file anyway. (Due to this behavior, you can save -unfinished edits to Emacs Lisp source files, and not recompile until -your changes are ready for use.) If you set the option -@code{load-prefer-newer} to a non-@code{nil} value, however, then -rather than the procedure described above, Emacs loads whichever -version of the file is newest. +@file{@var{foo}.elc}, @file{@var{foo}.el}, and @file{@var{foo}}. (If +Emacs was built with native compilation enabled, @code{load-library} +looks for a @samp{.eln} file that corresponds to @file{@var{foo}.el} +and loads it instead of @file{@var{foo}.elc}.) The default behavior +is to load the first file found. This command prefers @file{.eln} +files over @file{.elc} files, and prefers @file{.elc} files over +@file{.el} files, because compiled files load and run faster. If it +finds that @file{@var{lib}.el} is newer than @file{@var{lib}.elc}, it +issues a warning, in case someone made changes to the @file{.el} file +and forgot to recompile it, but loads the @file{.elc} file anyway. +(Due to this behavior, you can save unfinished edits to Emacs Lisp +source files, and not recompile until your changes are ready for use.) +If you set the option @code{load-prefer-newer} to a non-@code{nil} +value, however, then rather than the procedure described above, Emacs +loads whichever version of the file is newest. If Emacs was built +with native compilation, and it cannot find the @samp{.eln} file +corresponding to @file{@var{lib}.el}, it will load a +@file{@var{lib}.elc} and start native compilation of +@file{@var{lib}.el} in the background, then load the @samp{.eln} file +when it finishes compilation. Emacs Lisp programs usually load Emacs Lisp files using the @code{load} function. This is similar to @code{load-library}, but is @@ -1604,6 +1612,11 @@ It is customary to put locally installed libraries in the @code{load-path}, or in some subdirectory of @file{site-lisp}. This way, you don't need to modify the default value of @code{load-path}. +@vindex native-comp-eln-load-path + Similarly to @code{load-path}, the list of directories where Emacs +looks for @file{*.eln} files with natively-compiled Lisp code is +specified by the variable @code{native-comp-eln-load-path}. + @cindex autoload Some commands are @dfn{autoloaded}; when you run them, Emacs automatically loads the associated library first. For instance, the diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index a5e1689b6c7..37da6b5956d 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -2745,10 +2745,12 @@ desktop reloading, since it bypasses the init file, where @findex desktop-revert You can have separate saved desktop configurations in different directories; starting Emacs from a directory where you have a saved -desktop configuration will restore that configuration. You can save -the current desktop and reload the one saved in another directory by -typing @kbd{M-x desktop-change-dir}. Typing @kbd{M-x desktop-revert} -reverts to the previously reloaded desktop. +desktop configuration will restore that configuration, provided that +you customize @code{desktop-path} to prepend @file{.} (the current +directory) to the other directories there. You can save the current +desktop and reload the one saved in another directory by typing +@kbd{M-x desktop-change-dir}. Typing @kbd{M-x desktop-revert} reverts +to the previously reloaded desktop. @vindex desktop-load-locked-desktop The file in which Emacs saves the desktop is locked while the diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi index dbbdc767738..5c84ba4b1eb 100644 --- a/doc/lispref/loading.texi +++ b/doc/lispref/loading.texi @@ -75,17 +75,20 @@ file exists, and Emacs was compiled with native-compilation support (@pxref{Native Compilation}), @code{load} attempts to find a corresponding @samp{.eln} file, and if found, loads it instead of @file{@var{filename}.elc}. Otherwise, it loads -@file{@var{filename}.elc}. If there is no file by that name, then -@code{load} looks for a file named @file{@var{filename}.el}. If that -file exists, it is loaded. If Emacs was compiled with support for -dynamic modules (@pxref{Dynamic Modules}), @code{load} next looks for -a file named @file{@var{filename}.@var{ext}}, where @var{ext} is a -system-dependent file-name extension of shared libraries. Finally, if -neither of those names is found, @code{load} looks for a file named -@var{filename} with nothing appended, and loads it if it exists. (The -@code{load} function is not clever about looking at @var{filename}. -In the perverse case of a file named @file{foo.el.el}, evaluation of -@code{(load "foo.el")} will indeed find it.) +@file{@var{filename}.elc} (and starts a background native compilation +to produce the missing @samp{.eln} file, followed by loading that +file). If there is no @file{@var{filename}.elc}, then @code{load} +looks for a file named @file{@var{filename}.el}. If that file exists, +it is loaded. If Emacs was compiled with support for dynamic modules +(@pxref{Dynamic Modules}), @code{load} next looks for a file named +@file{@var{filename}.@var{ext}}, where @var{ext} is a system-dependent +file-name extension of shared libraries (@samp{.so} on GNU and Unix +systems). Finally, if neither of those names is found, @code{load} +looks for a file named @var{filename} with nothing appended, and loads +it if it exists. (The @code{load} function is not clever about +looking at @var{filename}. In the perverse case of a file named +@file{foo.el.el}, evaluation of @code{(load "foo.el")} will indeed +find it.) If Auto Compression mode is enabled, as it is by default, then if @code{load} can not find a file, it searches for a compressed version diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 4c40f414ca0..fedb2804f26 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -3688,8 +3688,8 @@ default, from @code{font-lock-function-name-face}. @vindex font-lock-variable-name-face for the name of a variable being defined or declared. -@item font-lock-variable-ref-face -@vindex font-lock-variable-ref-face +@item font-lock-variable-use-face +@vindex font-lock-variable-use-face for the name of a variable being referenced. This face inherits, by default, from @code{font-lock-variable-name-face}. @@ -3772,8 +3772,8 @@ for properties of an object, such as the declaration of fields in a struct. This face inherits, by default, from @code{font-lock-variable-name-face}. -@item font-lock-property-ref-face -@vindex font-lock-property-ref-face +@item font-lock-property-use-face +@vindex font-lock-property-use-face for properties of an object, such as use of fields in a struct. This face inherits, by default, from @code{font-lock-property-name-face}. @@ -5093,7 +5093,15 @@ This anchor is a function that is called with 3 arguments: @var{node}, @item parent-bol This anchor is a function that is called with 3 arguments: @var{node}, @var{parent}, and @var{bol}, and returns the first non-space character -on the line of @var{parent}. +on the line which @var{parent}'s start is on. + +@item parent-bol +This anchor is a function that is called with 3 arguments: @var{node}, +@var{parent}, and @var{bol}. It finds the first ancestor node +(parent, grandparent, etc) of @var{node} that starts on its own line, +and return the start of that node. ``Starting on its own line'' means +there is only whitespace character before the node on the line which +the node's start is on. @item prev-sibling This anchor is a function that is called with 3 arguments: @var{node}, diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index d513726979b..f0d3c75d055 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -14509,13 +14509,23 @@ Here's an example method that's more complex: @end example @table @code +@vindex nnimap-address @item nnimap-address The address of the server, like @samp{imap.gmail.com}. +@vindex nnimap-user +@item nnimap-user +Username to use for authentication to the @acronym{IMAP} server. This +corresponds to the value of the @samp{login} token in your +@file{~/.authinfo} file. Set this variable if you want to access +multiple accounts from the same @acronym{IMAP} server. + +@vindex nnimap-server-port @item nnimap-server-port If the server uses a non-standard port, that can be specified here. A typical port would be @code{"imap"} or @code{"imaps"}. +@vindex nnimap-stream @item nnimap-stream How @code{nnimap} should connect to the server. Possible values are: @@ -14546,6 +14556,7 @@ Non-encrypted and unsafe straight socket connection. @end table +@vindex nnimap-authenticator @item nnimap-authenticator Some @acronym{IMAP} servers allow anonymous logins. In that case, this should be set to @code{anonymous}. If this variable isn't set, @@ -14555,6 +14566,7 @@ specific login method to be used, you can set this variable to either @code{plain}, @code{cram-md5} or @code{xoauth2}. (The latter method requires using the @file{oauth2.el} library.) +@vindex nnimap-expunge @item nnimap-expunge When to expunge deleted messages. If @code{never}, deleted articles are marked with the IMAP @code{\\Delete} flag but not automatically @@ -14570,27 +14582,32 @@ EXPUNGE nil is equivalent to @code{never}, while t will immediately expunge ALL articles that are currently flagged as deleted (i.e., potentially not only the article that was just deleted). +@vindex nnimap-streaming @item nnimap-streaming Virtually all @acronym{IMAP} server support fast streaming of data. If you have problems connecting to the server, try setting this to @code{nil}. +@vindex nnimap-fetch-partial-articles @item nnimap-fetch-partial-articles If non-@code{nil}, fetch partial articles from the server. If set to a string, then it's interpreted as a regexp, and parts that have matching types will be fetched. For instance, @samp{"text/"} will fetch all textual parts, while leaving the rest on the server. +@vindex nnimap-record-commands @item nnimap-record-commands If non-@code{nil}, record all @acronym{IMAP} commands in the @samp{"*imap log*"} buffer. +@vindex nnimap-use-namespaces @item nnimap-use-namespaces If non-@code{nil}, omit the IMAP namespace prefix in nnimap group names. If your IMAP mailboxes are called something like @samp{INBOX} and @samp{INBOX.Lists.emacs}, but you'd like the nnimap group names to be @samp{INBOX} and @samp{Lists.emacs}, you should enable this option. +@vindex nnimap-keepalive-intervals @item nnimap-keepalive-intervals By default, nnimap will send occasional @samp{NOOP} (keepalive) commands to the server, to keep the connection alive. This option diff --git a/etc/NEWS b/etc/NEWS index ed276a4241d..139bc1fb457 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -107,6 +107,15 @@ If you want to get back the old behavior, set the user option to the value (setopt gdb-locals-table-row-config `((type . 0) (name . 0) (value . ,gdb-locals-value-limit))) +** Compile + +*** New user option 'grep-use-headings'. +When non-nil, the output of Grep is split into sections, one for each +file, instead of having file names prefixed to each line. It is +equivalent to the --heading option of some tools such as 'git grep' +and 'rg'. The headings are displayed using the new 'grep-heading' +face. + ** VC --- @@ -352,6 +361,21 @@ compared reliably at all. This warning can be suppressed using 'with-suppressed-warnings' with the warning name 'suspicious'. +--- +*** Warn about 'condition-case' without handlers. +The compiler now warns when the 'condition-case' form is used without +any actual handlers, as in + + (condition-case nil (read buffer)) + +because it has no effect other than the execution of the body form. +In particular, no errors are caught or suppressed. If the intention +was to catch all errors, add an explicit handler for 'error', or use +'ignore-error' or 'ignore-errors'. + +This warning can be suppressed using 'with-suppressed-warnings' with +the warning name 'suspicious'. + +++ ** New function 'file-user-uid'. This function is like 'user-uid', but is aware of file name handlers, diff --git a/etc/NEWS.29 b/etc/NEWS.29 index 5a244285efa..b5e67d47037 100644 --- a/etc/NEWS.29 +++ b/etc/NEWS.29 @@ -832,8 +832,8 @@ These faces are primarily meant for use with tree-sitter. They are: 'font-lock-escape-face', 'font-lock-function-call-face', 'font-lock-misc-punctuation-face', 'font-lock-number-face', 'font-lock-operator-face', 'font-lock-property-name-face', -'font-lock-property-ref-face', 'font-lock-punctuation-face', -'font-lock-regexp-face', and 'font-lock-variable-ref-face'. +'font-lock-property-use-face', 'font-lock-punctuation-face', +'font-lock-regexp-face', and 'font-lock-variable-use-face'. +++ ** New face 'variable-pitch-text'. diff --git a/lib-src/etags.c b/lib-src/etags.c index 2628849d78e..cb842dbf669 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c @@ -1732,6 +1732,8 @@ process_file_name (char *file, language *lang) char *cmd = xmalloc (buf_len); snprintf (cmd, buf_len, "%s %s > %s", compr->command, new_real_name, new_tmp_name); + free (new_real_name); + free (new_tmp_name); #endif inf = (system (cmd) == -1 ? NULL diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 1da4f9ad738..a1545edba19 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -2482,7 +2482,8 @@ the United States." (interactive) (cond ((eq last-command 'calcDigit-start) (erase-buffer)) - (t (backward-delete-char 1))) + (t (with-suppressed-warnings ((interactive-only backward-delete-char)) + (backward-delete-char 1)))) (if (= (calc-minibuffer-size) 0) (progn (setq last-command-event 13) diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el index 46e41dd046c..5d3f2585976 100644 --- a/lisp/cus-theme.el +++ b/lisp/cus-theme.el @@ -73,11 +73,11 @@ Do not call this mode function yourself. It is meant for internal use." font-lock-keyword-face font-lock-negation-char-face font-lock-number-face font-lock-misc-punctuation-face font-lock-operator-face font-lock-preprocessor-face - font-lock-property-name-face font-lock-property-ref-face + font-lock-property-name-face font-lock-property-use-face font-lock-punctuation-face font-lock-regexp-grouping-backslash font-lock-regexp-grouping-construct font-lock-string-face font-lock-type-face font-lock-variable-name-face - font-lock-variable-ref-face + font-lock-variable-use-face font-lock-warning-face button link link-visited fringe header-line tooltip mode-line mode-line-buffer-id mode-line-emphasis mode-line-highlight mode-line-inactive diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index d60e3a9dae7..12aa8fb3982 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1664,8 +1664,8 @@ See Info node `(elisp) Integer Basics'." file-directory-p file-exists-p file-locked-p file-name-absolute-p file-name-concat file-newer-than-file-p file-readable-p file-symlink-p file-writable-p - float float-time floor format format-time-string frame-first-window - frame-root-window frame-selected-window + float float-time floor format format-message format-time-string + frame-first-window frame-root-window frame-selected-window frame-visible-p fround ftruncate get gethash get-buffer get-buffer-window get-file-buffer hash-table-count @@ -1685,7 +1685,7 @@ See Info node `(elisp) Integer Basics'." regexp-quote region-beginning region-end reverse round sin sqrt string string-equal string-lessp string-search string-to-char - string-to-number string-to-syntax substring + string-to-number string-to-syntax substring substring-no-properties sxhash-equal sxhash-eq sxhash-eql symbol-function symbol-name symbol-plist symbol-value string-make-unibyte diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index c57a27069d6..8cb67c3b8b5 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -339,14 +339,19 @@ Assumes the caller has bound `macroexpand-all-environment'." (`(cond . ,clauses) (macroexp--cons fn (macroexp--all-clauses clauses) form)) (`(condition-case . ,(or `(,err ,body . ,handlers) pcase--dontcare)) - (macroexp--cons - fn - (macroexp--cons err - (macroexp--cons (macroexp--expand-all body) - (macroexp--all-clauses handlers 1) - (cddr form)) - (cdr form)) - form)) + (let ((exp-body (macroexp--expand-all body))) + (if handlers + (macroexp--cons fn + (macroexp--cons + err (macroexp--cons + exp-body + (macroexp--all-clauses handlers 1) + (cddr form)) + (cdr form)) + form) + (macroexp-warn-and-return + (format-message "`condition-case' without handlers") + exp-body (list 'suspicious 'condition-case) t form)))) (`(,(or 'defvar 'defconst) ,(and name (pred symbolp)) . ,_) (push name macroexp--dynvars) (macroexp--all-forms form 2)) diff --git a/lisp/font-lock.el b/lisp/font-lock.el index b82b7648797..f8815c1698a 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -2046,7 +2046,7 @@ as the constructs of Haddock, Javadoc and similar systems." "Font Lock mode face used to highlight variable names." :group 'font-lock-faces) -(defface font-lock-variable-ref-face +(defface font-lock-variable-use-face '((t :inherit font-lock-variable-name-face)) "Font Lock mode face used to highlight variable references." :group 'font-lock-faces @@ -2134,7 +2134,7 @@ For example, the declaration of fields in a struct." :group 'font-lock-faces :version "29.1") -(defface font-lock-property-ref-face +(defface font-lock-property-use-face '((t :inherit font-lock-property-name-face)) "Font Lock mode face used to highlight property references. For example, property lookup of fields in a struct." diff --git a/lisp/icomplete.el b/lisp/icomplete.el index f7a91599f3b..47fdf3e7913 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -215,15 +215,29 @@ the default otherwise." ;; calculated, This causes the first cached completion to ;; be taken (i.e. the one that the user sees highlighted) completion-all-sorted-completions) - (minibuffer-force-complete-and-exit) + (if (window-minibuffer-p) + (minibuffer-force-complete-and-exit) + (minibuffer-force-complete (icomplete--field-beg) + (icomplete--field-end) + 'dont-cycle) + (completion-in-region-mode -1)) ;; Otherwise take the faster route... - (minibuffer-complete-and-exit))) + (if (window-minibuffer-p) + (minibuffer-complete-and-exit) + (completion-complete-and-exit + (icomplete--field-beg) + (icomplete--field-end) + (lambda () (completion-in-region-mode -1)))))) (defun icomplete-force-complete () "Complete the icomplete minibuffer." (interactive) ;; We're not at all interested in cycling here (bug#34077). - (minibuffer-force-complete nil nil 'dont-cycle)) + (if (window-minibuffer-p) + (minibuffer-force-complete nil nil 'dont-cycle) + (minibuffer-force-complete (icomplete--field-beg) + (icomplete--field-end) + 'dont-cycle))) ;; Apropos `icomplete-scroll', we implement "scrolling icomplete" ;; within classic icomplete, which is "rotating", by contrast. @@ -429,9 +443,12 @@ more like `ido-mode' than regular `icomplete-mode'." :global t (remove-hook 'minibuffer-setup-hook #'icomplete-minibuffer-setup) (remove-hook 'minibuffer-setup-hook #'icomplete--fido-mode-setup) + (remove-hook 'completion-in-region-mode-hook #'icomplete--in-region-setup) (when fido-mode (icomplete-mode -1) (setq icomplete-mode t) + (when icomplete-in-buffer + (add-hook 'completion-in-region-mode-hook #'icomplete--in-region-setup)) (add-hook 'minibuffer-setup-hook #'icomplete-minibuffer-setup) (add-hook 'minibuffer-setup-hook #'icomplete--fido-mode-setup))) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index baa9f966dd8..2110d815c95 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -4778,7 +4778,13 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") (defun tramp-handle-unlock-file (file) "Like `unlock-file' for Tramp files." - (when-let ((lockname (tramp-compat-make-lock-file-name file))) + ;; When there is no connection, we don't do it. Otherwise, + ;; functions like `kill-buffer' would try to reestablish the + ;; connection. See Bug#61663. + (when-let ((v (tramp-dissect-file-name file)) + (p (tramp-get-process v)) + ((process-live-p p)) + (lockname (tramp-compat-make-lock-file-name file))) (condition-case err (delete-file lockname) ;; `userlock--handle-unlock-error' exists since Emacs 28.1. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 035df909eb2..8122115c102 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -77,6 +77,7 @@ (declare-function treesit-node-child "treesit.c") (declare-function treesit-node-child-by-field-name "treesit.c") (declare-function treesit-node-type "treesit.c") +(declare-function treesit-node-prev-sibling "treesit.c") ;;; Custom variables @@ -279,6 +280,12 @@ doesn't have a child." ;; prev-sibling doesn't have a child. (treesit-node-start prev-sibling))) +(defun c-ts-mode--standalone-grandparent (_node parent bol &rest args) + "Like the standalone-parent anchor but pass it the grandparent. +PARENT, BOL, ARGS are the same as other anchor functions." + (apply (alist-get 'standalone-parent treesit-simple-indent-presets) + parent (treesit-node-parent parent) bol args)) + (defun c-ts-mode--indent-styles (mode) "Indent rules supported by `c-ts-mode'. MODE is either `c' or `cpp'." @@ -300,9 +307,9 @@ MODE is either `c' or `cpp'." ((parent-is "comment") prev-adaptive-prefix 0) ;; Labels. - ((node-is "labeled_statement") parent-bol 0) + ((node-is "labeled_statement") standalone-parent 0) ((parent-is "labeled_statement") - point-min c-ts-common-statement-offset) + c-ts-mode--standalone-grandparent c-ts-mode-indent-offset) ((node-is "preproc") point-min 0) ((node-is "#endif") point-min 0) @@ -330,7 +337,7 @@ MODE is either `c' or `cpp'." ;; Closing bracket. This should be before initializer_list ;; (and probably others) rule because that rule (and other ;; similar rules) will match the closing bracket. (Bug#61398) - ((node-is "}") point-min c-ts-common-statement-offset) + ((node-is "}") standalone-parent 0) ,@(when (eq mode 'cpp) '(((node-is "access_specifier") parent-bol 0) ;; Indent the body of namespace definitions. @@ -341,25 +348,25 @@ MODE is either `c' or `cpp'." ((match nil "initializer_list" nil 1 1) parent-bol c-ts-mode-indent-offset) ((match nil "initializer_list" nil 2) c-ts-mode--anchor-prev-sibling 0) ;; Statement in enum. - ((match nil "enumerator_list" nil 1 1) point-min c-ts-common-statement-offset) + ((match nil "enumerator_list" nil 1 1) standalone-parent c-ts-mode-indent-offset) ((match nil "enumerator_list" nil 2) c-ts-mode--anchor-prev-sibling 0) ;; Statement in struct and union. - ((match nil "field_declaration_list" nil 1 1) point-min c-ts-common-statement-offset) + ((match nil "field_declaration_list" nil 1 1) standalone-parent c-ts-mode-indent-offset) ((match nil "field_declaration_list" nil 2) c-ts-mode--anchor-prev-sibling 0) ;; Statement in {} blocks. - ((match nil "compound_statement" nil 1 1) point-min c-ts-common-statement-offset) + ((match nil "compound_statement" nil 1 1) standalone-parent c-ts-mode-indent-offset) ((match nil "compound_statement" nil 2) c-ts-mode--anchor-prev-sibling 0) ;; Opening bracket. - ((node-is "compound_statement") point-min c-ts-common-statement-offset) + ((node-is "compound_statement") standalone-parent c-ts-mode-indent-offset) ;; Bug#61291. - ((match "expression_statement" nil "body") point-min c-ts-common-statement-offset) + ((match "expression_statement" nil "body") standalone-parent c-ts-mode-indent-offset) ;; These rules are for cases where the body is bracketless. ;; Tested by the "Bracketless Simple Statement" test. - ((parent-is "if_statement") point-min c-ts-common-statement-offset) - ((parent-is "for_statement") point-min c-ts-common-statement-offset) - ((parent-is "while_statement") point-min c-ts-common-statement-offset) - ((parent-is "do_statement") point-min c-ts-common-statement-offset) + ((parent-is "if_statement") standalone-parent c-ts-mode-indent-offset) + ((parent-is "for_statement") standalone-parent c-ts-mode-indent-offset) + ((parent-is "while_statement") standalone-parent c-ts-mode-indent-offset) + ((parent-is "do_statement") standalone-parent c-ts-mode-indent-offset) ,@(when (eq mode 'cpp) `(((node-is "field_initializer_list") parent-bol ,(* c-ts-mode-indent-offset 2))))))) @@ -388,16 +395,13 @@ MODE is either `c' or `cpp'." ((parent-is "do_statement") parent-bol 0) ,@common)))) -(defun c-ts-mode--top-level-label-matcher (node &rest _) +(defun c-ts-mode--top-level-label-matcher (node parent &rest _) "A matcher that matches a top-level label. -NODE should be a labeled_statement." - (let ((func (treesit-parent-until - node (lambda (n) - (equal (treesit-node-type n) - "compound_statement"))))) - (and (equal (treesit-node-type node) - "labeled_statement") - (not (treesit-node-top-level func "compound_statement"))))) +NODE should be a labeled_statement. PARENT is its parent." + (and (equal (treesit-node-type node) + "labeled_statement") + (equal "function_definition" + (treesit-node-type (treesit-node-parent parent))))) ;;; Font-lock @@ -543,7 +547,7 @@ MODE is either `c' or `cpp'." '((assignment_expression left: (identifier) @font-lock-variable-name-face) (assignment_expression - left: (field_expression field: (_) @font-lock-property-ref-face)) + left: (field_expression field: (_) @font-lock-property-use-face)) (assignment_expression left: (pointer_expression (identifier) @font-lock-variable-name-face)) @@ -579,7 +583,7 @@ MODE is either `c' or `cpp'." :language mode :feature 'property - '((field_identifier) @font-lock-property-ref-face) + '((field_identifier) @font-lock-property-use-face) :language mode :feature 'bracket @@ -656,7 +660,7 @@ OVERRIDE, START, END, and ARGS, see `treesit-font-lock-rules'." "call_expression")) (treesit-fontify-with-override (treesit-node-start node) (treesit-node-end node) - 'font-lock-variable-ref-face override start end))) + 'font-lock-variable-use-face override start end))) (defun c-ts-mode--fontify-defun (node override start end &rest _) "Correctly fontify the DEFUN macro. @@ -867,6 +871,8 @@ the semicolon. This function skips the semicolon." (when (eq c-ts-mode-indent-style 'linux) (setq-local indent-tabs-mode t)) (setq-local c-ts-common-indent-offset 'c-ts-mode-indent-offset) + ;; This setup is not needed anymore, but we might find uses for it + ;; later, so I'm keeping it. (setq-local c-ts-common-indent-type-regexp-alist `((block . ,(rx (or "compound_statement" "field_declaration_list" diff --git a/lisp/progmodes/cmake-ts-mode.el b/lisp/progmodes/cmake-ts-mode.el index a3f9279ec1c..d83a956af21 100644 --- a/lisp/progmodes/cmake-ts-mode.el +++ b/lisp/progmodes/cmake-ts-mode.el @@ -154,7 +154,7 @@ :language 'cmake :feature 'variable :override t - '((variable) @font-lock-variable-ref-face) + '((variable) @font-lock-variable-use-face) :language 'cmake :feature 'error diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index ccf64fb670b..6d151db8a83 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -1706,7 +1706,7 @@ to `compilation-error-regexp-alist' if RULES is nil." (set-marker (make-marker) (save-excursion (goto-char (point-min)) - (text-property-search-forward 'compilation-header-end) + (text-property-search-forward 'compilation-annotation) ;; If we have no end marker, this will be ;; `point-min' still. (point))))) @@ -1854,6 +1854,14 @@ If nil, don't hide anything." ;; buffers when it changes from nil to non-nil or vice-versa. (unless compilation-in-progress (force-mode-line-update t))) +(defun compilation-insert-annotation (&rest args) + "Insert ARGS at point, adding the `compilation-annotation' text property. +This property is used to distinguish output of the compilation +process from additional information inserted by Emacs." + (let ((start (point))) + (apply #'insert args) + (put-text-property start (point) 'compilation-annotation t))) + ;;;###autoload (defun compilation-start (command &optional mode name-function highlight-regexp continue) @@ -1975,17 +1983,16 @@ Returns the compilation buffer created." (setq-local compilation-auto-jump-to-next t)) (when (zerop (buffer-size)) ;; Output a mode setter, for saving and later reloading this buffer. - (insert "-*- mode: " name-of-mode - "; default-directory: " - (prin1-to-string (abbreviate-file-name default-directory)) - " -*-\n")) - (insert (format "%s started at %s\n\n" - mode-name - (substring (current-time-string) 0 19)) - command "\n") - ;; Mark the end of the header so that we don't interpret - ;; anything in it as an error. - (put-text-property (1- (point)) (point) 'compilation-header-end t) + (compilation-insert-annotation + "-*- mode: " name-of-mode + "; default-directory: " + (prin1-to-string (abbreviate-file-name default-directory)) + " -*-\n")) + (compilation-insert-annotation + (format "%s started at %s\n\n" + mode-name + (substring (current-time-string) 0 19)) + command "\n") (setq thisdir default-directory)) (set-buffer-modified-p nil)) ;; Pop up the compilation buffer. @@ -2467,13 +2474,13 @@ commands of Compilation major mode are available. See (cur-buffer (current-buffer))) ;; Record where we put the message, so we can ignore it later on. (goto-char omax) - (insert ?\n mode-name " " (car status)) + (compilation-insert-annotation ?\n mode-name " " (car status)) (if (and (numberp compilation-window-height) (zerop compilation-window-height)) (message "%s" (cdr status))) (if (bolp) (forward-char -1)) - (insert " at " (substring (current-time-string) 0 19)) + (compilation-insert-annotation " at " (substring (current-time-string) 0 19)) (goto-char (point-max)) ;; Prevent that message from being recognized as a compilation error. (add-text-properties omax (point) diff --git a/lisp/progmodes/csharp-mode.el b/lisp/progmodes/csharp-mode.el index 4ed8b0368b5..ea4977254ce 100644 --- a/lisp/progmodes/csharp-mode.el +++ b/lisp/progmodes/csharp-mode.el @@ -708,9 +708,9 @@ compilation and evaluation time conflicts." (treesit-font-lock-rules :language 'c-sharp :feature 'expression - '((conditional_expression (identifier) @font-lock-variable-ref-face) - (postfix_unary_expression (identifier)* @font-lock-variable-ref-face) - (initializer_expression (assignment_expression left: (identifier) @font-lock-variable-ref-face))) + '((conditional_expression (identifier) @font-lock-variable-use-face) + (postfix_unary_expression (identifier)* @font-lock-variable-use-face) + (initializer_expression (assignment_expression left: (identifier) @font-lock-variable-use-face))) :language 'c-sharp :feature 'bracket @@ -739,8 +739,8 @@ compilation and evaluation time conflicts." :language 'c-sharp :override t :feature 'property - `((attribute (identifier) @font-lock-property-ref-face (attribute_argument_list)) - (attribute (identifier) @font-lock-property-ref-face)) + `((attribute (identifier) @font-lock-property-use-face (attribute_argument_list)) + (attribute (identifier) @font-lock-property-use-face)) :language 'c-sharp :override t @@ -878,23 +878,23 @@ compilation and evaluation time conflicts." :override t '((if_directive "if" @font-lock-preprocessor-face - (identifier) @font-lock-variable-ref-face) + (identifier) @font-lock-variable-use-face) (elif_directive "elif" @font-lock-preprocessor-face - (identifier) @font-lock-variable-ref-face) + (identifier) @font-lock-variable-use-face) (else_directive) @font-lock-preprocessor-face (endif_directive) @font-lock-preprocessor-face (define_directive "define" @font-lock-preprocessor-face - (identifier) @font-lock-variable-ref-face) + (identifier) @font-lock-variable-use-face) (nullable_directive) @font-lock-preprocessor-face (pragma_directive) @font-lock-preprocessor-face (region_directive) @font-lock-preprocessor-face (endregion_directive) @font-lock-preprocessor-face (region_directive - (preproc_message) @font-lock-variable-ref-face) + (preproc_message) @font-lock-variable-use-face) (endregion_directive - (preproc_message) @font-lock-variable-ref-face)))) + (preproc_message) @font-lock-variable-use-face)))) ;;;###autoload (add-to-list 'auto-mode-alist '("\\.cs\\'" . csharp-mode)) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index d0e899cbed5..0a3189a0263 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -486,7 +486,8 @@ This can be useful when using docker to run a language server.") (WorkspaceEdit () (:changes :documentChanges)) (WorkspaceSymbol (:name :kind) (:containerName :location :data)) (InlayHint (:position :label) (:kind :textEdits :tooltip :paddingLeft - :paddingRight :data))) + :paddingRight :data)) + (InlayHintLabelPart (:value) (:tooltip :location :command))) "Alist (INTERFACE-NAME . INTERFACE) of known external LSP interfaces. INTERFACE-NAME is a symbol designated by the spec as @@ -641,7 +642,7 @@ Honor `eglot-strict-mode'." Honor `eglot-strict-mode'." (declare (indent 1) (debug (sexp &rest form))) (let ((e (cl-gensym "jsonrpc-lambda-elem"))) - `(lambda (,e) (eglot--dbind ,cl-lambda-list ,e ,@body)))) + `(lambda (,e) (cl-block nil (eglot--dbind ,cl-lambda-list ,e ,@body))))) (cl-defmacro eglot--dcase (obj &rest clauses) "Like `pcase', but for the LSP object OBJ. @@ -816,6 +817,7 @@ treated as in `eglot--dbind'." `(:valueSet [,@(mapcar #'car eglot--tag-faces)]))) + :general (list :positionEncodings ["utf-32" "utf-8" "utf-16"]) :experimental eglot--{}))) (cl-defgeneric eglot-workspace-folders (server) @@ -1439,71 +1441,111 @@ CONNECT-ARGS are passed as additional arguments to (let ((warning-minimum-level :error)) (display-warning 'eglot (apply #'format format args) :warning))) -(defun eglot-current-column () (- (point) (line-beginning-position))) +(defalias 'eglot--bol + (if (fboundp 'pos-bol) #'pos-bol + (lambda (&optional n) (let ((inhibit-field-text-motion t)) + (line-beginning-position n)))) + "Return position of first character in current line.") -(defvar eglot-current-column-function #'eglot-lsp-abiding-column - "Function to calculate the current column. + +;;; Encoding fever +;;; +(define-obsolete-function-alias + 'eglot-lsp-abiding-column 'eglot-utf-16-linepos "29.1") +(define-obsolete-function-alias + 'eglot-current-column 'eglot-utf-32-linepos "29.1") +(define-obsolete-variable-alias + 'eglot-current-column-function 'eglot-current-linepos-function "29.1") -This is the inverse operation of -`eglot-move-to-column-function' (which see). It is a function of -no arguments returning a column number. For buffers managed by -fully LSP-compliant servers, this should be set to -`eglot-lsp-abiding-column' (the default), and -`eglot-current-column' for all others.") +(defvar eglot-current-linepos-function #'eglot-utf-16-linepos + "Function calculating position relative to line beginning. -(defun eglot-lsp-abiding-column (&optional lbp) - "Calculate current COLUMN as defined by the LSP spec. -LBP defaults to `line-beginning-position'." - (/ (- (length (encode-coding-region (or lbp (line-beginning-position)) +It is a function of no arguments considering the text from line +beginning up to current point. The return value is the number of +UTF code units needed to encode that text from the LSP server's +perspective. This may be a number of octets, 16-bit words or +Unicode code points, depending on whether the LSP server's +`positionEncoding' capability is UTF-8, UTF-16 or UTF-32, +respectively. Position of point should remain unaltered if that +return value is fed through the corresponding inverse function +`eglot-move-to-linepos-function' (which see).") + +(defun eglot-utf-8-linepos () + "Calculate number of UTF-8 bytes from line beginning." + (length (encode-coding-region (eglot--bol) (point) 'utf-8-unix t))) + +(defun eglot-utf-16-linepos (&optional lbp) + "Calculate number of UTF-16 code units from position given by LBP. +LBP defaults to `eglot--bol'." + (/ (- (length (encode-coding-region (or lbp (eglot--bol)) ;; Fix github#860 (min (point) (point-max)) 'utf-16 t)) 2) 2)) +(defun eglot-utf-32-linepos () + "Calculate number of Unicode codepoints from line beginning." + (- (point) (eglot--bol))) + (defun eglot--pos-to-lsp-position (&optional pos) "Convert point POS to LSP position." (eglot--widening ;; LSP line is zero-origin; emacs is one-origin. (list :line (1- (line-number-at-pos pos t)) :character (progn (when pos (goto-char pos)) - (funcall eglot-current-column-function))))) + (funcall eglot-current-linepos-function))))) -(defvar eglot-move-to-column-function #'eglot-move-to-lsp-abiding-column - "Function to move to a column reported by the LSP server. +(define-obsolete-function-alias + 'eglot-move-to-current-column 'eglot-move-to-utf-32-linepos "29.1") +(define-obsolete-function-alias + 'eglot-move-to-lsp-abiding-column 'eglot-move-to-utf-16-linepos "29.1") +(define-obsolete-variable-alias +'eglot-move-to-column-function 'eglot-move-to-linepos-function "29.1") -According to the standard, LSP column/character offsets are based -on a count of UTF-16 code units, not actual visual columns. So -when LSP says position 3 of a line containing just \"aXbc\", -where X is a multi-byte character, it actually means `b', not -`c'. However, many servers don't follow the spec this closely. +(defvar eglot-move-to-linepos-function #'eglot-move-to-utf-16-linepos + "Function to move to a position within a line reported by the LSP server. -For buffers managed by fully LSP-compliant servers, this should -be set to `eglot-move-to-lsp-abiding-column' (the default), and -`eglot-move-to-column' for all others.") +Per the LSP spec, character offsets in LSP Position objects count +UTF-16 code units, not actual code points. So when LSP says +position 3 of a line containing just \"aXbc\", where X is a funny +looking character in the UTF-16 \"supplementary plane\", it +actually means `b', not `c'. The default value +`eglot-move-to-utf-16-linepos' accounts for this. -(defun eglot-move-to-column (column) - "Move to COLUMN without closely following the LSP spec." +This variable can also be set to `eglot-move-to-utf-8-linepos' or +`eglot-move-to-utf-32-linepos' for servers not closely following +the spec. Also, since LSP 3.17 server and client may agree on an +encoding and Eglot will set this variable automatically.") + +(defun eglot-move-to-utf-8-linepos (n) + "Move to line's Nth byte as computed by LSP's UTF-8 criterion." + (let* ((bol (eglot--bol)) + (goal-byte (+ (position-bytes bol) n)) + (eol (line-end-position))) + (goto-char bol) + (while (and (< (position-bytes (point)) goal-byte) (< (point) eol)) + ;; raw bytes take 2 bytes in the buffer + (when (>= (char-after) #x3fff80) (setq goal-byte (1+ goal-byte))) + (forward-char 1)))) + +(defun eglot-move-to-utf-16-linepos (n) + "Move to line's Nth code unit as computed by LSP's UTF-16 criterion." + (let* ((bol (eglot--bol)) + (goal-char (+ bol n)) + (eol (line-end-position))) + (goto-char bol) + (while (and (< (point) goal-char) (< (point) eol)) + ;; code points in the "supplementary place" use two code units + (when (<= #x010000 (char-after) #x10ffff) (setq goal-char (1- goal-char))) + (forward-char 1)))) + +(defun eglot-move-to-utf-32-linepos (n) + "Move to line's Nth codepoint as computed by LSP's UTF-32 criterion." ;; We cannot use `move-to-column' here, because it moves to *visual* - ;; columns, which can be different from LSP columns in case of + ;; columns, which can be different from LSP characters in case of ;; `whitespace-mode', `prettify-symbols-mode', etc. (github#296, ;; github#297) - (goto-char (min (+ (line-beginning-position) column) - (line-end-position)))) - -(defun eglot-move-to-lsp-abiding-column (column) - "Move to COLUMN abiding by the LSP spec." - (save-restriction - (cl-loop - with lbp = (line-beginning-position) - initially - (narrow-to-region lbp (line-end-position)) - (move-to-column column) - for diff = (- column - (eglot-lsp-abiding-column lbp)) - until (zerop diff) - do (condition-case eob-err - (forward-char (/ (if (> diff 0) (1+ diff) (1- diff)) 2)) - (end-of-buffer (cl-return eob-err)))))) + (goto-char (min (+ (eglot--bol) n) (line-end-position)))) (defun eglot--lsp-position-to-point (pos-plist &optional marker) "Convert LSP position POS-PLIST to Emacs point. @@ -1515,16 +1557,17 @@ If optional MARKER, return a marker instead" (forward-line (min most-positive-fixnum (plist-get pos-plist :line))) (unless (eobp) ;; if line was excessive leave point at eob - (let ((tab-width 1) - (col (plist-get pos-plist :character))) + (let ((col (plist-get pos-plist :character))) (unless (wholenump col) (eglot--warn "Caution: LSP server sent invalid character position %s. Using 0 instead." col) (setq col 0)) - (funcall eglot-move-to-column-function col))) + (funcall eglot-move-to-linepos-function col))) (if marker (copy-marker (point-marker)) (point))))) + +;;; More helpers (defconst eglot--uri-path-allowed-chars (let ((vec (copy-sequence url-path-allowed-chars))) (aset vec ?: nil) ;; see github#639 @@ -1758,6 +1801,14 @@ Use `eglot-managed-p' to determine if current buffer is managed.") :init-value nil :lighter nil :keymap eglot-mode-map (cond (eglot--managed-mode + (pcase (plist-get (eglot--capabilities (eglot-current-server)) + :positionEncoding) + ("utf-32" + (eglot--setq-saving eglot-current-linepos-function #'eglot-utf-32-linepos) + (eglot--setq-saving eglot-move-to-linepos-function #'eglot-move-to-utf-32-linepos)) + ("utf-8" + (eglot--setq-saving eglot-current-linepos-function #'eglot-utf-8-linepos) + (eglot--setq-saving eglot-move-to-linepos-function #'eglot-move-to-utf-8-linepos))) (add-hook 'after-change-functions 'eglot--after-change nil t) (add-hook 'before-change-functions 'eglot--before-change nil t) (add-hook 'kill-buffer-hook #'eglot--managed-mode-off nil t) @@ -2144,7 +2195,7 @@ COMMAND is a symbol naming the command." (eglot--widening (goto-char (point-min)) (setq beg - (line-beginning-position + (eglot--bol (1+ (plist-get (plist-get range :start) :line)))) (setq end (line-end-position @@ -2584,14 +2635,14 @@ Try to visit the target file for a richer summary line." (collect (lambda () (eglot--widening (pcase-let* ((`(,beg . ,end) (eglot--range-region range)) - (bol (progn (goto-char beg) (line-beginning-position))) + (bol (progn (goto-char beg) (eglot--bol))) (substring (buffer-substring bol (line-end-position))) (hi-beg (- beg bol)) (hi-end (- (min (line-end-position) end) bol))) (add-face-text-property hi-beg hi-end 'xref-match t substring) (list substring (line-number-at-pos (point) t) - (eglot-current-column) (- end beg)))))) + (eglot-utf-32-linepos) (- end beg)))))) (`(,summary ,line ,column ,length) (cond (visiting (with-current-buffer visiting (funcall collect))) @@ -2935,7 +2986,7 @@ for which LSP on-type-formatting should be requested." (looking-back (regexp-opt (cl-coerce (cl-getf completion-capability :triggerCharacters) 'list)) - (line-beginning-position)))) + (eglot--bol)))) :exit-function (lambda (proxy status) (when (memq status '(finished exact)) @@ -3545,20 +3596,30 @@ If NOERROR, return predicate, else erroring function." (paint-hint (eglot--lambda ((InlayHint) position kind label paddingLeft paddingRight) (goto-char (eglot--lsp-position-to-point position)) - (let ((ov (make-overlay (point) (point))) - (left-pad (and paddingLeft (not (memq (char-before) '(32 9))))) - (right-pad (and paddingRight (not (memq (char-after) '(32 9))))) - (text (if (stringp label) - label (plist-get (elt label 0) :value)))) - (overlay-put ov 'before-string - (propertize - (concat (and left-pad " ") text (and right-pad " ")) - 'face (pcase kind - (1 'eglot-type-hint-face) - (2 'eglot-parameter-hint-face) - (_ 'eglot-inlay-hint-face)))) - (overlay-put ov 'eglot--inlay-hint t) - (overlay-put ov 'eglot--overlay t))))) + (when (or (> (point) to) (< (point) from)) (cl-return)) + (let ((left-pad (and paddingLeft + (not (memq (char-before) '(32 9))) " ")) + (right-pad (and paddingRight + (not (memq (char-after) '(32 9))) " "))) + (cl-flet + ((do-it (text lpad rpad) + (let ((ov (make-overlay (point) (point)))) + (overlay-put ov 'before-string + (propertize + (concat lpad text rpad) + 'face (pcase kind + (1 'eglot-type-hint-face) + (2 'eglot-parameter-hint-face) + (_ 'eglot-inlay-hint-face)))) + (overlay-put ov 'eglot--inlay-hint t) + (overlay-put ov 'eglot--overlay t)))) + (if (stringp label) (do-it label left-pad right-pad) + (cl-loop + for i from 0 for ldetail across label + do (eglot--dbind ((InlayHintLabelPart) value) ldetail + (do-it value + (and (zerop i) left-pad) + (and (= i (1- (length label))) right-pad)))))))))) (jsonrpc-async-request (eglot--current-server-or-lose) :textDocument/inlayHint diff --git a/lisp/progmodes/go-ts-mode.el b/lisp/progmodes/go-ts-mode.el index 0e019f5bad9..ce77cc3973d 100644 --- a/lisp/progmodes/go-ts-mode.el +++ b/lisp/progmodes/go-ts-mode.el @@ -178,12 +178,12 @@ :language 'go :feature 'property - '((selector_expression field: (field_identifier) @font-lock-property-ref-face) - (keyed_element (_ (identifier) @font-lock-property-ref-face))) + '((selector_expression field: (field_identifier) @font-lock-property-use-face) + (keyed_element (_ (identifier) @font-lock-property-use-face))) :language 'go :feature 'variable - '((identifier) @font-lock-variable-ref-face) + '((identifier) @font-lock-variable-use-face) :language 'go :feature 'escape-sequence diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 0da16b44dda..82e9c5d8edf 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -457,6 +457,33 @@ buffer `default-directory'." :type '(repeat (choice (const :tag "Default" nil) (string :tag "Directory")))) +(defcustom grep-use-headings nil + "If non-nil, subdivide grep output into sections, one per file." + :type 'boolean + :version "30.1") + +(defface grep-heading `((t :inherit ,grep-hit-face)) + "Face of headings when `grep-use-headings' is non-nil." + :version "30.1") + +(defvar grep-heading-regexp + (rx bol + (or + (group-n 2 + (group-n 1 (+ (not (any 0 ?\n)))) + 0) + (group-n 2 + (group-n 1 (+? nonl)) + (any ?: ?- ?=))) + (+ digit) + (any ?: ?- ?=)) + "Regexp used to create headings from grep output lines. +It should be anchored at beginning of line. The first capture +group, if present, should match the heading associated to the +line. The buffer range of the second capture, if present, is +made invisible (presumably because displaying it would be +redundant).") + (defvar grep-find-abbreviate-properties (let ((ellipsis (if (char-displayable-p ?…) "[…]" "[...]")) (map (make-sparse-keymap))) @@ -612,6 +639,40 @@ This function is called from `compilation-filter-hook'." (while (re-search-forward "\033\\[[0-9;]*[mK]" end 1) (replace-match "" t t)))))) +(defvar grep--heading-format + (eval-when-compile + (let ((title (propertize "%s" + 'font-lock-face 'grep-heading + 'outline-level 1))) + (propertize (concat title "\n") 'compilation-annotation t))) + "Format string of grep headings. +This is passed to `format' with one argument, the text of the +first capture group of `grep-heading-regexp'.") + +(defvar-local grep--heading-state nil + "Variable to keep track of the `grep--heading-filter' state.") + +(defun grep--heading-filter () + "Filter function to add headings to output of a grep process." + (unless grep--heading-state + (setq grep--heading-state (cons (point-min-marker) nil))) + (save-excursion + (let ((limit (car grep--heading-state))) + ;; Move point to the old limit and update limit marker. + (move-marker limit (prog1 (pos-bol) (goto-char limit))) + (while (re-search-forward grep-heading-regexp limit t) + (unless (get-text-property (point) 'compilation-annotation) + (let ((heading (match-string-no-properties 1)) + (start (match-beginning 2)) + (end (match-end 2))) + (when start + (put-text-property start end 'invisible t)) + (when (and heading (not (equal heading (cdr grep--heading-state)))) + (save-excursion + (goto-char (pos-bol)) + (insert-before-markers (format grep--heading-format heading))) + (setf (cdr grep--heading-state) heading)))))))) + (defun grep-probe (command args &optional func result) (let (process-file-side-effects) (equal (condition-case nil @@ -906,6 +967,11 @@ The value depends on `grep-command', `grep-template', (add-function :filter-return (local 'kill-transform-function) (lambda (string) (string-replace "\0" ":" string))) + (when grep-use-headings + (add-hook 'compilation-filter-hook #'grep--heading-filter 80 t) + (setq-local outline-search-function #'outline-search-level + outline-level (lambda () (get-text-property + (point) 'outline-level)))) (add-hook 'compilation-filter-hook #'grep-filter nil t)) (defun grep--save-buffers () diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el index 54ed8b4277d..d31d2d71c38 100644 --- a/lisp/progmodes/java-ts-mode.el +++ b/lisp/progmodes/java-ts-mode.el @@ -244,7 +244,7 @@ name: (identifier) @font-lock-variable-name-face) (element_value_pair - key: (identifier) @font-lock-property-ref-face) + key: (identifier) @font-lock-property-use-face) (formal_parameter name: (identifier) @font-lock-variable-name-face) @@ -255,14 +255,14 @@ :override t :feature 'expression '((method_invocation - object: (identifier) @font-lock-variable-ref-face) + object: (identifier) @font-lock-variable-use-face) (method_invocation name: (identifier) @font-lock-function-call-face) (argument_list (identifier) @font-lock-variable-name-face) - (expression_statement (identifier) @font-lock-variable-ref-face)) + (expression_statement (identifier) @font-lock-variable-use-face)) :language 'java :feature 'bracket diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 93298f4fb6e..f68ecb6fa6c 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -3563,13 +3563,13 @@ This function is intended for use in `after-change-functions'." :language 'javascript :feature 'property - '(((property_identifier) @font-lock-property-ref-face + '(((property_identifier) @font-lock-property-use-face (:pred js--treesit-property-not-function-p - @font-lock-property-ref-face)) + @font-lock-property-use-face)) - (pair value: (identifier) @font-lock-variable-ref-face) + (pair value: (identifier) @font-lock-variable-use-face) - ((shorthand_property_identifier) @font-lock-property-ref-face)) + ((shorthand_property_identifier) @font-lock-property-use-face)) :language 'javascript :feature 'assignment @@ -3681,8 +3681,8 @@ For OVERRIDE, START, END, see `treesit-font-lock-rules'." (treesit-fontify-with-override (treesit-node-start node) (treesit-node-end node) (pcase (treesit-node-type node) - ("identifier" 'font-lock-variable-ref-face) - ("property_identifier" 'font-lock-property-ref-face)) + ("identifier" 'font-lock-variable-use-face) + ("property_identifier" 'font-lock-property-use-face)) override start end))) (defun js--treesit-defun-name (node) diff --git a/lisp/progmodes/json-ts-mode.el b/lisp/progmodes/json-ts-mode.el index c5979b9a14c..f56d118c0fe 100644 --- a/lisp/progmodes/json-ts-mode.el +++ b/lisp/progmodes/json-ts-mode.el @@ -101,7 +101,7 @@ :language 'json :feature 'pair :override t ; Needed for overriding string face on keys. - '((pair key: (_) @font-lock-property-ref-face)) + '((pair key: (_) @font-lock-property-use-face)) :language 'json :feature 'error :override t diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 5aab31c3ea8..1f970633bfc 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -1147,7 +1147,7 @@ fontified." @font-lock-variable-name-face) (assignment left: (attribute attribute: (identifier) - @font-lock-property-ref-face)) + @font-lock-property-use-face)) (pattern_list (identifier) @font-lock-variable-name-face) (tuple_pattern (identifier) @@ -1184,12 +1184,12 @@ fontified." :feature 'property :language 'python '((attribute - attribute: (identifier) @font-lock-property-ref-face) + attribute: (identifier) @font-lock-property-use-face) (class_definition body: (block (expression_statement (assignment left: - (identifier) @font-lock-property-ref-face))))) + (identifier) @font-lock-property-use-face))))) :feature 'operator :language 'python diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index dba9ff0a846..559b62fef54 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -909,7 +909,9 @@ This only affects the output of the command `ruby-toggle-block'." "<<=" ">>=" "&&=" "||=" "and" "or")) (cond ((not ruby-after-operator-indent) - (ruby-smie--indent-to-stmt ruby-indent-level)) + (ruby-smie--indent-to-stmt (if (smie-indent--hanging-p) + ruby-indent-level + 0))) ((and (smie-rule-parent-p ";" nil) (smie-indent--hanging-p)) ruby-indent-level))) diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index f70c0279d3d..4530b162e6e 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -292,11 +292,11 @@ values of OVERRIDE" :language language :feature 'global - '((global_variable) @font-lock-variable-ref-face) + '((global_variable) @font-lock-variable-use-face) :language language :feature 'instance - '((instance_variable) @font-lock-variable-ref-face) + '((instance_variable) @font-lock-variable-use-face) :language language :feature 'method-definition diff --git a/lisp/progmodes/rust-ts-mode.el b/lisp/progmodes/rust-ts-mode.el index a46d442a0e5..2d5c3211c1a 100644 --- a/lisp/progmodes/rust-ts-mode.el +++ b/lisp/progmodes/rust-ts-mode.el @@ -239,8 +239,8 @@ :language 'rust :feature 'property - '((field_identifier) @font-lock-property-ref-face - (shorthand_field_initializer (identifier) @font-lock-property-ref-face)) + '((field_identifier) @font-lock-property-use-face + (shorthand_field_initializer (identifier) @font-lock-property-use-face)) ;; Must be under type, otherwise some imports can be highlighted as constants. :language 'rust @@ -251,25 +251,25 @@ :language 'rust :feature 'variable - '((arguments (identifier) @font-lock-variable-ref-face) - (array_expression (identifier) @font-lock-variable-ref-face) - (assignment_expression right: (identifier) @font-lock-variable-ref-face) - (binary_expression left: (identifier) @font-lock-variable-ref-face) - (binary_expression right: (identifier) @font-lock-variable-ref-face) - (block (identifier) @font-lock-variable-ref-face) - (compound_assignment_expr right: (identifier) @font-lock-variable-ref-face) - (field_expression value: (identifier) @font-lock-variable-ref-face) - (field_initializer value: (identifier) @font-lock-variable-ref-face) - (if_expression condition: (identifier) @font-lock-variable-ref-face) - (let_condition value: (identifier) @font-lock-variable-ref-face) - (let_declaration value: (identifier) @font-lock-variable-ref-face) - (match_arm value: (identifier) @font-lock-variable-ref-face) - (match_expression value: (identifier) @font-lock-variable-ref-face) - (reference_expression value: (identifier) @font-lock-variable-ref-face) - (return_expression (identifier) @font-lock-variable-ref-face) - (tuple_expression (identifier) @font-lock-variable-ref-face) - (unary_expression (identifier) @font-lock-variable-ref-face) - (while_expression condition: (identifier) @font-lock-variable-ref-face)) + '((arguments (identifier) @font-lock-variable-use-face) + (array_expression (identifier) @font-lock-variable-use-face) + (assignment_expression right: (identifier) @font-lock-variable-use-face) + (binary_expression left: (identifier) @font-lock-variable-use-face) + (binary_expression right: (identifier) @font-lock-variable-use-face) + (block (identifier) @font-lock-variable-use-face) + (compound_assignment_expr right: (identifier) @font-lock-variable-use-face) + (field_expression value: (identifier) @font-lock-variable-use-face) + (field_initializer value: (identifier) @font-lock-variable-use-face) + (if_expression condition: (identifier) @font-lock-variable-use-face) + (let_condition value: (identifier) @font-lock-variable-use-face) + (let_declaration value: (identifier) @font-lock-variable-use-face) + (match_arm value: (identifier) @font-lock-variable-use-face) + (match_expression value: (identifier) @font-lock-variable-use-face) + (reference_expression value: (identifier) @font-lock-variable-use-face) + (return_expression (identifier) @font-lock-variable-use-face) + (tuple_expression (identifier) @font-lock-variable-use-face) + (unary_expression (identifier) @font-lock-variable-use-face) + (while_expression condition: (identifier) @font-lock-variable-use-face)) :language 'rust :feature 'escape-sequence diff --git a/lisp/progmodes/typescript-ts-mode.el b/lisp/progmodes/typescript-ts-mode.el index d907608d0db..ca6fd2c09da 100644 --- a/lisp/progmodes/typescript-ts-mode.el +++ b/lisp/progmodes/typescript-ts-mode.el @@ -249,9 +249,9 @@ Argument LANGUAGE is either `typescript' or `tsx'." (public_field_definition name: (property_identifier) @font-lock-property-name-face) - (pair key: (property_identifier) @font-lock-property-ref-face) + (pair key: (property_identifier) @font-lock-property-use-face) - ((shorthand_property_identifier) @font-lock-property-ref-face)) + ((shorthand_property_identifier) @font-lock-property-use-face)) :language language :feature 'expression @@ -272,7 +272,7 @@ Argument LANGUAGE is either `typescript' or `tsx'." :language language :feature 'pattern `((pair_pattern - key: (property_identifier) @font-lock-property-ref-face + key: (property_identifier) @font-lock-property-use-face value: [(identifier) @font-lock-variable-name-face (assignment_pattern left: (identifier) @font-lock-variable-name-face)]) diff --git a/lisp/subr.el b/lisp/subr.el index 168f85992bc..e60b2d2da88 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -768,7 +768,9 @@ one is kept. See `seq-uniq' for non-destructive operation." (defun delete-consecutive-dups (list &optional circular) "Destructively remove `equal' consecutive duplicates from LIST. First and last elements are considered consecutive if CIRCULAR is -non-nil." +non-nil. +Of several consecutive `equal' occurrences, the one earliest in +the list is kept." (let ((tail list) last) (while (cdr tail) (if (equal (car tail) (cadr tail)) @@ -804,6 +806,7 @@ TO as (+ FROM (* N INC)) or use a variable whose value was computed with this exact expression. Alternatively, you can, of course, also replace TO with a slightly larger value \(or a slightly more negative value if INC is negative)." + (declare (side-effect-free t)) (if (or (not to) (= from to)) (list from) (or inc (setq inc 1)) @@ -825,6 +828,7 @@ of course, also replace TO with a slightly larger value If TREE is a cons cell, this recursively copies both its car and its cdr. Contrast to `copy-sequence', which copies only along the cdrs. With second argument VECP, this copies vectors as well as conses." + (declare (side-effect-free t)) (if (consp tree) (let (result) (while (consp tree) @@ -5266,11 +5270,13 @@ wherever possible, since it is slow." (defsubst looking-at-p (regexp) "\ Same as `looking-at' except this function does not change the match data." + (declare (side-effect-free t)) (looking-at regexp t)) (defsubst string-match-p (regexp string &optional start) "\ Same as `string-match' except this function does not change the match data." + (declare (side-effect-free t)) (string-match regexp string start t)) (defun subregexp-context-p (regexp pos &optional start) @@ -5541,7 +5547,7 @@ Upper-case and lower-case letters are treated as equal. Unibyte strings are converted to multibyte for comparison. See also `string-equal'." - (declare (pure t) (side-effect-free t)) + (declare (side-effect-free t)) (eq t (compare-strings string1 0 nil string2 0 nil t))) (defun string-prefix-p (prefix string &optional ignore-case) @@ -5868,6 +5874,7 @@ integer that encodes the corresponding syntax class. See Info node `(elisp)Syntax Table Internals' for a list of codes. If SYNTAX is nil, return nil." + (declare (pure t) (side-effect-free t)) (and syntax (logand (car syntax) 65535))) ;; Utility motion commands @@ -6718,6 +6725,7 @@ Note that a version specified by the list (1) is equal to (1 0), \(1 0 0), (1 0 0 0), etc. That is, the trailing zeros are insignificant. Also, a version given by the list (1) is higher than (1 -1), which in turn is higher than (1 -2), which is higher than (1 -3)." + (declare (pure t) (side-effect-free t)) (while (and l1 l2 (= (car l1) (car l2))) (setq l1 (cdr l1) l2 (cdr l2))) @@ -6739,6 +6747,7 @@ Note that a version specified by the list (1) is equal to (1 0), \(1 0 0), (1 0 0 0), etc. That is, the trailing zeros are insignificant. Also, a version given by the list (1) is higher than (1 -1), which in turn is higher than (1 -2), which is higher than (1 -3)." + (declare (pure t) (side-effect-free t)) (while (and l1 l2 (= (car l1) (car l2))) (setq l1 (cdr l1) l2 (cdr l2))) @@ -6760,6 +6769,7 @@ Note that integer list (1) is equal to (1 0), (1 0 0), (1 0 0 0), etc. That is, the trailing zeroes are insignificant. Also, integer list (1) is greater than (1 -1) which is greater than (1 -2) which is greater than (1 -3)." + (declare (pure t) (side-effect-free t)) (while (and l1 l2 (= (car l1) (car l2))) (setq l1 (cdr l1) l2 (cdr l2))) @@ -6777,6 +6787,7 @@ which is greater than (1 -3)." "Return the first non-zero element of LST, which is a list of integers. If all LST elements are zeros or LST is nil, return zero." + (declare (pure t) (side-effect-free t)) (while (and lst (zerop (car lst))) (setq lst (cdr lst))) (if lst @@ -6943,6 +6954,7 @@ REGEXP defaults to \"[ \\t\\n\\r]+\"." "Trim STRING of trailing string matching REGEXP. REGEXP defaults to \"[ \\t\\n\\r]+\"." + (declare (side-effect-free t)) (let ((i (string-match-p (concat "\\(?:" (or regexp "[ \t\n\r]+") "\\)\\'") string))) (if i (substring string 0 i) string))) @@ -7014,6 +7026,7 @@ sentence (see Info node `(elisp) Documentation Tips')." "Return OBJECT as a list. If OBJECT is already a list, return OBJECT itself. If it's not a list, return a one-element list containing OBJECT." + (declare (side-effect-free error-free)) (if (listp object) object (list object))) @@ -7089,6 +7102,7 @@ is inserted before adjusting the number of empty lines." If OMIT-NULLS, empty lines will be removed from the results. If KEEP-NEWLINES, don't strip trailing newlines from the result lines." + (declare (side-effect-free t)) (if (equal string "") (if omit-nulls nil diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index 39e38179359..f51edfb4c80 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -1399,8 +1399,8 @@ for determining whether point is within a selector." :feature 'query :language 'css - '((keyword_query) @font-lock-property-ref-face - (feature_name) @font-lock-property-ref-face) + '((keyword_query) @font-lock-property-use-face + (feature_name) @font-lock-property-use-face) :feature 'bracket :language 'css diff --git a/lisp/textmodes/toml-ts-mode.el b/lisp/textmodes/toml-ts-mode.el index 2ff9d07d13b..2c491034372 100644 --- a/lisp/textmodes/toml-ts-mode.el +++ b/lisp/textmodes/toml-ts-mode.el @@ -92,8 +92,8 @@ :language 'toml :feature 'pair :override t ; Needed for overriding string face on keys. - '((bare_key) @font-lock-property-ref-face - (quoted_key) @font-lock-property-ref-face + '((bare_key) @font-lock-property-use-face + (quoted_key) @font-lock-property-use-face (table ("[" @font-lock-bracket-face (_) @font-lock-type-face "]" @font-lock-bracket-face)) diff --git a/lisp/textmodes/yaml-ts-mode.el b/lisp/textmodes/yaml-ts-mode.el index dc0fa00df27..dfa8d22fb34 100644 --- a/lisp/textmodes/yaml-ts-mode.el +++ b/lisp/textmodes/yaml-ts-mode.el @@ -94,22 +94,22 @@ :feature 'property :override t '((block_mapping_pair - key: (flow_node (plain_scalar (string_scalar) @font-lock-property-ref-face))) + key: (flow_node (plain_scalar (string_scalar) @font-lock-property-use-face))) (block_mapping_pair key: (flow_node - [(double_quote_scalar) (single_quote_scalar)] @font-lock-property-ref-face)) + [(double_quote_scalar) (single_quote_scalar)] @font-lock-property-use-face)) (flow_mapping - (_ key: (flow_node (plain_scalar (string_scalar) @font-lock-property-ref-face)))) + (_ key: (flow_node (plain_scalar (string_scalar) @font-lock-property-use-face)))) (flow_mapping (_ key: (flow_node - [(double_quote_scalar) (single_quote_scalar)] @font-lock-property-ref-face))) + [(double_quote_scalar) (single_quote_scalar)] @font-lock-property-use-face))) (flow_sequence - (_ key: (flow_node (plain_scalar (string_scalar) @font-lock-property-ref-face)))) + (_ key: (flow_node (plain_scalar (string_scalar) @font-lock-property-use-face)))) (flow_sequence (_ key: (flow_node - [(double_quote_scalar) (single_quote_scalar)] @font-lock-property-ref-face)))) + [(double_quote_scalar) (single_quote_scalar)] @font-lock-property-use-face)))) :language 'yaml :feature 'error diff --git a/lisp/treesit.el b/lisp/treesit.el index a413311e824..9e639149ce0 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1227,6 +1227,16 @@ See `treesit-simple-indent-presets'.") (goto-char (treesit-node-start parent)) (back-to-indentation) (point)))) + (cons 'standalone-parent + (lambda (_n parent &rest _) + (save-excursion + (catch 'term + (while parent + (goto-char (treesit-node-start parent)) + (when (looking-back (rx bol (* whitespace)) + (line-beginning-position)) + (throw 'term (point))) + (setq parent (treesit-node-parent parent))))))) (cons 'prev-sibling (lambda (node &rest _) (treesit-node-start (treesit-node-prev-sibling node)))) @@ -1323,6 +1333,11 @@ parent-bol Returns the beginning of non-space characters on the line where PARENT is on. +standalone-parent + + Finds the first ancestor node (parent, grandparent, etc) that + starts on its own line, and return the start of that node. + prev-sibling Returns the start of NODE's previous sibling. @@ -1854,10 +1869,23 @@ This is a tree-sitter equivalent of `beginning-of-defun'. Behavior of this function depends on `treesit-defun-type-regexp' and `treesit-defun-skipper'." (interactive "^p") - (when (treesit-beginning-of-thing treesit-defun-type-regexp arg) - (when treesit-defun-skipper - (funcall treesit-defun-skipper)) - t)) + (let ((orig-point (point)) + (success nil)) + (catch 'done + (dotimes (_ 2) + + (when (treesit-beginning-of-thing treesit-defun-type-regexp arg) + (when treesit-defun-skipper + (funcall treesit-defun-skipper) + (setq success t))) + + ;; If we end up at the same point, it means we went to the + ;; next beg-of-defun, but defun skipper moved point back to + ;; where we started, in this case we just move one step + ;; further. + (if (or (eq arg 0) (not (eq orig-point (point)))) + (throw 'done success) + (setq arg (if (> arg 0) (1+ arg) (1- arg)))))))) (defun treesit-end-of-defun (&optional arg _) "Move forward to next end of defun. @@ -1869,9 +1897,21 @@ This is a tree-sitter equivalent of `end-of-defun'. Behavior of this function depends on `treesit-defun-type-regexp' and `treesit-defun-skipper'." (interactive "^p\nd") - (when (treesit-end-of-thing treesit-defun-type-regexp arg) - (when treesit-defun-skipper - (funcall treesit-defun-skipper)))) + (let ((orig-point (point))) + (catch 'done + (dotimes (_ 2) ; Not making progress is better than infloop. + + (when (treesit-end-of-thing treesit-defun-type-regexp arg) + (when treesit-defun-skipper + (funcall treesit-defun-skipper))) + + ;; If we end up at the same point, it means we went to the + ;; prev end-of-defun, but defun skipper moved point back to + ;; where we started, in this case we just move one step + ;; further. + (if (or (eq arg 0) (not (eq orig-point (point)))) + (throw 'done nil) + (setq arg (if (> arg 0) (1+ arg) (1- arg)))))))) (defvar-local treesit-text-type-regexp "\\`comment\\'" "A regexp that matches the node type of textual nodes. @@ -2027,9 +2067,9 @@ REGEXP and PRED are the same as in `treesit-thing-at-point'." ;; ;; prev-end (tricky): ;; 1. prev-sibling exists -;; -> If you think about it, we are already at prev-sibling's end! -;; So we need to go one step further, either to -;; prev-prev-sibling's end, or parent's prev-sibling's end, etc. +;; -> If we are already at prev-sibling's end, we need to go one +;; step further, either to prev-prev-sibling's end, or parent's +;; prev-sibling's end, etc. ;; 2. prev-sibling is nil but parent exists ;; -> Obviously we don't want to go to parent's end, instead, we ;; want to go to parent's prev-sibling's end. Again, we recurse @@ -2079,18 +2119,24 @@ function is called recursively." ;; ...forward. (if (and (eq side 'beg) ;; Should we skip the defun (recurse)? - (cond (next (not recursing)) ; [1] (see below) - (parent t) ; [2] - (t nil))) - ;; Special case: go to next beg-of-defun. Set POS - ;; to the end of next-sib/parent defun, and run one - ;; more step. If there is a next-sib defun, we only - ;; need to recurse once, so we don't need to recurse - ;; if we are already recursing [1]. If there is no + (cond (next (and (not recursing) ; [1] (see below) + (eq pos (funcall advance next)))) + (parent t))) ; [2] + ;; Special case: go to next beg-of-defun, but point + ;; is already on beg-of-defun. Set POS to the end + ;; of next-sib/parent defun, and run one more step. + ;; If there is a next-sib defun, we only need to + ;; recurse once, so we don't need to recurse if we + ;; are already recursing [1]. If there is no ;; next-sib but a parent, keep stepping out ;; (recursing) until we got out of the parents until ;; (1) there is a next sibling defun, or (2) no more ;; parents [2]. + ;; + ;; If point on beg-of-defun but we are already + ;; recurring, that doesn't count as special case, + ;; because we have already made progress (by moving + ;; the end of next before recurring.) (setq pos (or (treesit--navigate-thing (treesit-node-end (or next parent)) 1 'beg regexp pred t) @@ -2099,9 +2145,9 @@ function is called recursively." (setq pos (funcall advance (or next parent)))) ;; ...backward. (if (and (eq side 'end) - (cond (prev (not recursing)) - (parent t) - (t nil))) + (cond (prev (and (not recursing) + (eq pos (funcall advance prev)))) + (parent t))) ;; Special case: go to prev end-of-defun. (setq pos (or (treesit--navigate-thing (treesit-node-start (or prev parent)) diff --git a/msdos/sedlibmk.inp b/msdos/sedlibmk.inp index 634bf999e50..c3f410bd74d 100644 --- a/msdos/sedlibmk.inp +++ b/msdos/sedlibmk.inp @@ -428,6 +428,8 @@ s/= @GL_GENERATE_STDINT_H_CONDITION@/= 1/ s/= @GL_GENERATE_LIMITS_H_CONDITION@/= 1/ s/= @GL_GENERATE_ERRNO_H_CONDITION@/= / s/= @GL_GENERATE_LIMITS_H_CONDITION@/= / +s/= @GL_GENERATE_GETOPT_CDEFS_H_CONDITION@/= 1/ +s/= @GL_GENERATE_GETOPT_H_CONDITION@/= 1/ s/= @GL_GENERATE_GMP_H_CONDITION@/= 1/ s/= @GL_GENERATE_GMP_GMP_H_CONDITION@/= / s/= @GL_GENERATE_MINI_GMP_H_CONDITION@/= 1/ diff --git a/nt/mingw-cfg.site b/nt/mingw-cfg.site index 7ca19cbad06..425eaace30d 100644 --- a/nt/mingw-cfg.site +++ b/nt/mingw-cfg.site @@ -170,3 +170,6 @@ gl_cv_func_free_preserves_errno=yes # Don't build the Gnulib nanosleep module: it requires W2K or later, # and MinGW does have nanosleep. gl_cv_func_nanosleep=yes +# Suppress configure-time diagnostic from unnecessary libxattr check, +# as xattr will not be supported here. +enable_xattr=no diff --git a/src/indent.c b/src/indent.c index 6de18d749ca..08d2bf5ea28 100644 --- a/src/indent.c +++ b/src/indent.c @@ -2401,7 +2401,7 @@ whether or not it is currently displayed in some window. */) last line that it occupies. */ if (it_start < ZV) { - if ((it.bidi_it.scan_dir > 0) + if ((it.bidi_it.scan_dir >= 0 || it.vpos == vpos_init) ? IT_CHARPOS (it) < it_start : IT_CHARPOS (it) > it_start) { diff --git a/src/treesit.c b/src/treesit.c index ef0f2407840..5a4fe3e8803 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -2484,7 +2484,7 @@ treesit_predicate_match (Lisp_Object args, struct capture_range captures) { if (XFIXNUM (Flength (args)) != 2) xsignal2 (Qtreesit_query_error, - build_string ("Predicate `equal' requires two " + build_string ("Predicate `match' requires two " "arguments but only given"), Flength (args)); diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 185abaf5c22..b6dcfeedb0c 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -1446,6 +1446,12 @@ literals (Bug#20852)." '((suspicious set-buffer)) "Warning: Use .with-current-buffer. rather than") + (test-suppression + '(defun zot (x) + (condition-case nil (list x))) + '((suspicious condition-case)) + "Warning: `condition-case' without handlers") + (test-suppression '(defun zot () (let ((_ 1)) diff --git a/test/lisp/international/mule-tests.el b/test/lisp/international/mule-tests.el index 6b76e35ae22..3e0c5bf9f4b 100644 --- a/test/lisp/international/mule-tests.el +++ b/test/lisp/international/mule-tests.el @@ -119,9 +119,10 @@ provide HTML fragments. Some tests override those variables." (ert-deftest sgml-html-meta-no-post-less-than-10lines () "No '', detect charset in the first 10 lines." (let ((sgml-html-meta-post "")) - (should (eq 'utf-8 (sgml-html-meta-run - (concat "\n\n\n\n\n\n\n\n\n" - "")))))) + (should (eq 'utf-8 (coding-system-base + (sgml-html-meta-run + (concat "\n\n\n\n\n\n\n\n\n" + ""))))))) (ert-deftest sgml-html-meta-no-post-10lines () "No '', do not detect charset after the first 10 lines." diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index f19847b0103..69004bdbdf3 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -6535,11 +6535,33 @@ INPUT, if non-nil, is a string sent to the process." (save-buffer) (should-not (buffer-modified-p))) (should-not (with-no-warnings (file-locked-p tmp-name1))) + + ;; `kill-buffer' removes the lock. (with-no-warnings (lock-file tmp-name1)) (should (eq (with-no-warnings (file-locked-p tmp-name1)) t)) + (with-temp-buffer + (set-visited-file-name tmp-name1) + (insert "foo") + (should (buffer-modified-p)) + (cl-letf (((symbol-function #'read-from-minibuffer) + (lambda (&rest _args) "yes"))) + (kill-buffer))) + (should-not (with-no-warnings (file-locked-p tmp-name1))) + ;; `kill-buffer' should not remove the lock when the + ;; connection is broken. See Bug#61663. + (with-no-warnings (lock-file tmp-name1)) + (should (eq (with-no-warnings (file-locked-p tmp-name1)) t)) + (with-temp-buffer + (set-visited-file-name tmp-name1) + (insert "foo") + (should (buffer-modified-p)) + (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) + (cl-letf (((symbol-function #'read-from-minibuffer) + (lambda (&rest _args) "yes"))) + (kill-buffer))) ;; A new connection changes process id, and also the - ;; lockname contents. + ;; lockname contents. But the lock file still exists. (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) (should (stringp (with-no-warnings (file-locked-p tmp-name1)))) diff --git a/test/lisp/progmodes/eglot-tests.el b/test/lisp/progmodes/eglot-tests.el index 4b6528351b2..5d5de59a19a 100644 --- a/test/lisp/progmodes/eglot-tests.el +++ b/test/lisp/progmodes/eglot-tests.el @@ -856,8 +856,8 @@ pylsp prefers autopep over yafp, despite its README stating the contrary." '((c-mode . ("clangd"))))) (with-current-buffer (eglot--find-file-noselect "project/foo.c") - (setq-local eglot-move-to-column-function #'eglot-move-to-lsp-abiding-column) - (setq-local eglot-current-column-function #'eglot-lsp-abiding-column) + (setq-local eglot-move-to-linepos-function #'eglot-move-to-utf-16-linepos) + (setq-local eglot-current-linepos-function #'eglot-utf-16-linepos) (eglot--sniffing (:client-notifications c-notifs) (eglot--tests-connect) (end-of-line) @@ -866,12 +866,12 @@ pylsp prefers autopep over yafp, despite its README stating the contrary." (eglot--wait-for (c-notifs 2) (&key params &allow-other-keys) (should (equal 71 (cadddr (cadadr (aref (cadddr params) 0)))))) (beginning-of-line) - (should (eq eglot-move-to-column-function #'eglot-move-to-lsp-abiding-column)) - (funcall eglot-move-to-column-function 71) + (should (eq eglot-move-to-linepos-function #'eglot-move-to-utf-16-linepos)) + (funcall eglot-move-to-linepos-function 71) (should (looking-at "p"))))))) (ert-deftest eglot-test-lsp-abiding-column () - "Test basic `eglot-lsp-abiding-column' and `eglot-move-to-lsp-abiding-column'." + "Test basic LSP character counting logic." (skip-unless (executable-find "clangd")) (eglot-tests--lsp-abiding-column-1)) diff --git a/test/lisp/progmodes/grep-tests.el b/test/lisp/progmodes/grep-tests.el index 39307999d6d..9b7f83086bf 100644 --- a/test/lisp/progmodes/grep-tests.el +++ b/test/lisp/progmodes/grep-tests.el @@ -66,4 +66,18 @@ (cl-letf (((symbol-function 'w32-shell-dos-semantics) #'ignore)) (grep-tests--check-rgrep-abbreviation)))) +(ert-deftest grep-tests--grep-heading-regexp-without-null () + (dolist (sep '(?: ?- ?=)) + (let ((string (format "filename%c123%ctext" sep sep))) + (should (string-match grep-heading-regexp string)) + (should (equal (match-string 1 string) "filename")) + (should (equal (match-string 2 string) (format "filename%c" sep)))))) + +(ert-deftest grep-tests--grep-heading-regexp-with-null () + (dolist (sep '(?: ?- ?=)) + (let ((string (format "funny:0:filename%c123%ctext" 0 sep))) + (should (string-match grep-heading-regexp string)) + (should (equal (match-string 1 string) "funny:0:filename")) + (should (equal (match-string 2 string) "funny:0:filename\0"))))) + ;;; grep-tests.el ends here diff --git a/test/lisp/progmodes/ruby-mode-resources/ruby-after-operator-indent.rb b/test/lisp/progmodes/ruby-mode-resources/ruby-after-operator-indent.rb index 25cd8736f97..e339d229d3e 100644 --- a/test/lisp/progmodes/ruby-mode-resources/ruby-after-operator-indent.rb +++ b/test/lisp/progmodes/ruby-mode-resources/ruby-after-operator-indent.rb @@ -10,6 +10,10 @@ foo = obj.bar { |m| tee(m) } + obj.qux { |m| hum(m) } +some_variable = abc + some_method( + some_argument +) + foo. bar .baz diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index d5efabc1370..050ee22ac18 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -1171,5 +1171,39 @@ final or penultimate step during initialization.")) (should-not (list-of-strings-p '("a" nil "b"))) (should-not (list-of-strings-p '("a" "b" . "c")))) +(ert-deftest subr--delete-dups () + (should (equal (delete-dups nil) nil)) + (let* ((a (list "a" "b" "c")) + (a-dedup (delete-dups a))) + (should (equal a-dedup '("a" "b" "c"))) + (should (eq a a-dedup))) + (let* ((a (list "a" "a" "b" "b" "a" "c" "b" "c" "a")) + (a-b (cddr a)) ; link of first "b" + (a-dedup (delete-dups a))) + (should (equal a-dedup '("a" "b" "c"))) + (should (eq a a-dedup)) + (should (eq (cdr a-dedup) a-b)))) + +(ert-deftest subr--delete-consecutive-dups () + (should (equal (delete-consecutive-dups nil) nil)) + (let* ((a (list "a" "b" "c")) + (a-dedup (delete-consecutive-dups a))) + (should (equal a-dedup '("a" "b" "c"))) + (should (eq a a-dedup))) + (let* ((a (list "a" "a" "b" "a" "a" "b" "b" "b" "c" "c" "a" "a")) + (a-b (nthcdr 3 a)) ; link of third "a" + (a-dedup (delete-consecutive-dups a))) + (should (equal a-dedup '("a" "b" "a" "b" "c" "a"))) + (should (eq a a-dedup)) + (should (equal (nthcdr 2 a-dedup) a-b))) + (let* ((a (list "a" "b" "a")) + (a-dedup (delete-consecutive-dups a t))) + (should (equal a-dedup '("a" "b"))) + (should (eq a a-dedup))) + (let* ((a (list "a" "a" "b" "a" "a" "b" "b" "b" "c" "c" "a" "a")) + (a-dedup (delete-consecutive-dups a t))) + (should (equal a-dedup '("a" "b" "a" "b" "c"))) + (should (eq a a-dedup)))) + (provide 'subr-tests) ;;; subr-tests.el ends here diff --git a/test/src/treesit-tests.el b/test/src/treesit-tests.el index 5aa12e8aa0e..468cd221ef9 100644 --- a/test/src/treesit-tests.el +++ b/test/src/treesit-tests.el @@ -977,22 +977,22 @@ and \"]\"." (defvar treesit--ert-defun-navigation-nested-master ;; START PREV-BEG NEXT-END PREV-END NEXT-BEG - '((0 103 105 102 106) ; Between Beg of parent & 1st sibling. + '((0 103 105 102 104) ; Between Beg of parent & 1st sibling. (1 103 105 102 106) ; Beg of 1st sibling. (2 104 105 102 106) ; Inside 1st sibling. - (3 104 107 102 109) ; End of 1st sibling. - (4 104 107 102 109) ; Between 1st sibling & 2nd sibling. - (5 104 107 102 109) ; Beg of 2nd sibling. + (3 104 107 102 106) ; End of 1st sibling. + (4 104 107 105 106) ; Between 1st sibling & 2nd sibling. + (5 104 107 105 109) ; Beg of 2nd sibling. (6 106 107 105 109) ; Inside 2nd sibling. (7 106 108 105 109) ; End of 2nd sibling. - (8 106 108 105 109) ; Between 2nd sibling & end of parent. - (9 103 110 102 nil) ; End of parent. + (8 106 108 107 109) ; Between 2nd sibling & end of parent. + (9 103 110 102 109) ; End of parent. - (100 nil 102 nil 103) ; Before 1st parent. + (100 nil 102 nil 101) ; Before 1st parent. (101 nil 102 nil 103) ; Beg of 1st parent. - (102 101 108 nil 109) ; Between 1st & 2nd parent. - (103 101 108 nil 109) ; Beg of 2nd parent. - (110 109 nil 108 nil) ; After 3rd parent. + (102 101 108 102 103) ; Between 1st & 2nd parent. + (103 101 108 102 109) ; Beg of 2nd parent. + (110 109 nil 110 nil) ; After 3rd parent. ) "Master of nested navigation test. @@ -1000,7 +1000,7 @@ This basically says, e.g., \"start with point on marker 0, go to the prev-beg, now point should be at marker 103\", etc.") (defvar treesit--ert-defun-navigation-top-level-master - ;; START PREV-BEG NEXT-END NEXT-BEG PREV-END + ;; START PREV-BEG NEXT-END PREV-END NEXT-BEG '((0 103 108 102 109) ; Between Beg of parent & 1st sibling. (1 103 108 102 109) ; Beg of 1st sibling. (2 103 108 102 109) ; Inside 1st sibling. @@ -1010,14 +1010,14 @@ the prev-beg, now point should be at marker 103\", etc.") (6 103 108 102 109) ; Inside 2nd sibling. (7 103 108 102 109) ; End of 2nd sibling. (8 103 108 102 109) ; Between 2nd sibling & end of parent. - (9 103 110 102 nil) ; End of parent. + (9 103 110 102 109) ; End of parent. ;; Top-level defuns should be identical to the nested test. - (100 nil 102 nil 103) ; Before 1st parent. + (100 nil 102 nil 101) ; Before 1st parent. (101 nil 102 nil 103) ; Beg of 1st parent. - (102 101 108 nil 109) ; Between 1st & 2nd parent. - (103 101 108 nil 109) ; Beg of 2nd parent. - (110 109 nil 108 nil) ; After 3rd parent. + (102 101 108 102 103) ; Between 1st & 2nd parent. + (103 101 108 102 109) ; Beg of 2nd parent. + (110 109 nil 110 nil) ; After 3rd parent. ) "Master of top-level navigation test.")