commit c5d319af475337beba9a0720a185e4ea3d375e07 (HEAD, refs/remotes/origin/master) Merge: 93f557af0ef 613de662811 Author: Stefan Kangas Date: Tue Feb 28 06:30:13 2023 +0100 Merge from origin/emacs-29 613de662811 Rename the newly added -ref- faces to -use- f601e9666d8 Eglot: support multiple labels in same inlay hint 4a5eda7ed2a Eglot: don't paint hints outside requested region (bug#61... 11c1aa1eb12 ; * doc/misc/gnus.texi: Fix last change. 44949c292f9 ; Add `nnimap-user' to Gnus manual 6c7078c66f4 ; * lisp/progmodes/c-ts-mode.el (treesit-node-prev-siblin... 3d0a6c9baa6 Eglot: protect against unintended field text motion (bug#... 647e40f4a0c ; And yet another fix to eglot-current-linepos-function's... 9d0f856a167 Fix description of 'desktop-save-mode' aee10ca1cbe Adjust tree-sitter defun navigation (bug#61617) edf5b976869 Simplify c-ts-mode--top-level-label-matcher 0f15286c539 New tree-sitter indent anchor standalone-parent used by c... # Conflicts: # etc/NEWS commit 613de662811fccbdcc3521aef394134e8c255127 (refs/remotes/origin/emacs-29) Author: Dmitry Gutov Date: Tue Feb 28 04:07:55 2023 +0200 Rename the newly added -ref- faces to -use- * lisp/font-lock.el (font-lock-variable-use-face) (font-lock-property-use-face): Rename from font-lock-variable-ref-face and font-lock-property-ref-face. Update all references (bug#61655). diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 11892aaa40e..fedb2804f26 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -3688,8 +3688,8 @@ Faces for Font Lock @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 @@ Faces for Font Lock 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}. diff --git a/etc/NEWS b/etc/NEWS index 5a244285efa..b5e67d47037 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -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/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 @@ custom-theme--listed-faces 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/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 @@ font-lock-variable-name-face "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 @@ font-lock-property-name-face :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/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 2cb6c2709cc..4b66824c44f 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -547,7 +547,7 @@ c-ts-mode--font-lock-settings '((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)) @@ -583,7 +583,7 @@ c-ts-mode--font-lock-settings :language mode :feature 'property - '((field_identifier) @font-lock-property-ref-face) + '((field_identifier) @font-lock-property-use-face) :language mode :feature 'bracket @@ -660,7 +660,7 @@ c-ts-mode--fontify-variable "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. 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 @@ cmake-ts-mode--font-lock-settings :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/csharp-mode.el b/lisp/progmodes/csharp-mode.el index 31c87171281..47cd13e7fdb 100644 --- a/lisp/progmodes/csharp-mode.el +++ b/lisp/progmodes/csharp-mode.el @@ -708,9 +708,9 @@ csharp-ts-mode--font-lock-settings (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 @@ csharp-ts-mode--font-lock-settings :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 @@ csharp-ts-mode--font-lock-settings :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/go-ts-mode.el b/lisp/progmodes/go-ts-mode.el index d4bafdb577b..e8f93d14744 100644 --- a/lisp/progmodes/go-ts-mode.el +++ b/lisp/progmodes/go-ts-mode.el @@ -177,12 +177,12 @@ go-ts-mode--font-lock-settings :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/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el index a1f3ad692c2..827d38e30c2 100644 --- a/lisp/progmodes/java-ts-mode.el +++ b/lisp/progmodes/java-ts-mode.el @@ -244,7 +244,7 @@ java-ts-mode--font-lock-settings 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 @@ java-ts-mode--font-lock-settings :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 e53a80bd499..52ed19cc682 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -3563,13 +3563,13 @@ js--treesit-font-lock-settings :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 @@ js--treesit-fontify-assignment-lhs (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 72f90d5c997..6272c0073e1 100644 --- a/lisp/progmodes/json-ts-mode.el +++ b/lisp/progmodes/json-ts-mode.el @@ -101,7 +101,7 @@ json-ts-mode--font-lock-settings :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 @@ python--treesit-settings @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 @@ python--treesit-settings :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-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index fedba200f83..fa1d8626f14 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -292,11 +292,11 @@ ruby-ts--font-lock-settings :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 @@ rust-ts-mode--font-lock-settings :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 @@ rust-ts-mode--font-lock-settings :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 5b49b8f50a8..65fba72373c 100644 --- a/lisp/progmodes/typescript-ts-mode.el +++ b/lisp/progmodes/typescript-ts-mode.el @@ -249,9 +249,9 @@ typescript-ts-mode--font-lock-settings (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 @@ typescript-ts-mode--font-lock-settings :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/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 @@ css--treesit-settings :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 @@ toml-ts-mode--font-lock-settings :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 @@ yaml-ts-mode--font-lock-settings :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 commit 93f557af0ef85ce301bb0780e26351eb8809e91c Author: Augusto Stoffel Date: Wed Dec 7 18:44:07 2022 +0100 New user option 'grep-use-headings' * lisp/progmodes/grep.el (grep-heading-regexp): New user option. (grep-heading): New face (bug#59888). (grep--heading-format, grep--heading-state, grep--heading-filter): Filter function for grep processes and supporting variables. (grep-use-headings): New user option. (grep-mode): Use the above, if applicable. diff --git a/etc/NEWS b/etc/NEWS index 9241598f185..31fb22fc1e2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -95,6 +95,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 --- 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 @@ grep-search-path :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 @@ grep-filter (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 @@ grep-mode (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/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 @@ grep-tests--rgrep-abbreviate-properties-windows-nt-sh-semantics (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 commit b699c380286151c97ffae65010d733a092d2db14 Author: Augusto Stoffel Date: Thu Dec 8 21:05:10 2022 +0100 Introduce 'compilation-annotation' text property It is meant to mark parts of compilation buffers which do not correspond to process output (bug#59888). * lisp/progmodes/compile.el (compilation-insert-annotation): New function. (compilation-start, compilation-handle-exit): Use it. (compilation--ensure-parse) Rely on 'compilation-annotation' property instead of 'compilation-header-end'. 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 @@ compilation--ensure-parse (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 @@ compilation--update-in-progress-mode-line ;; 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 @@ compilation-start (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 @@ compilation-handle-exit (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) commit b5c13032538377b0037c745715613693a1580f81 Author: João Távora Date: Mon Feb 27 20:40:48 2023 +0200 * lisp/icomplete.el (fido-mode): Enable in-buffer completion (bug#45763). diff --git a/lisp/icomplete.el b/lisp/icomplete.el index fd47d82920f..47fdf3e7913 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -443,9 +443,12 @@ fido-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))) commit a7a984c0ebebb891e2052d8416544f0bd7002007 Author: Juri Linkov Date: Mon Feb 27 20:32:53 2023 +0200 * lisp/icomplete.el: Fix in-buffer completion. (icomplete-force-complete-and-exit, icomplete-force-complete): Use 'icomplete--field-beg/end' when not in the minibuffer to not erase the current buffer. Also disable 'completion-in-region-mode' instead of calling 'exit-minibuffer' (bug#45764, bug#51575, bug#61479). diff --git a/lisp/icomplete.el b/lisp/icomplete.el index f7a91599f3b..fd47d82920f 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -215,15 +215,29 @@ icomplete-force-complete-and-exit ;; 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. commit f601e9666d8b861712c09025711dc3a4261cb0ea Author: João Távora Date: Mon Feb 27 14:54:53 2023 +0000 Eglot: support multiple labels in same inlay hint Mainly the rust-analyzer LSP server uses this. There are still more things we could support, like tooltips and stuff. * lisp/progmodes/eglot.el (lsp-interface-alist): Add InlayHintLabelPart. (eglot--update-hints-1): Support multiple labels for same hint. diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index ef758371c16..ffc9511469f 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -486,7 +486,8 @@ eglot--executable-find (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 @@ -3596,20 +3597,29 @@ eglot--update-hints-1 (eglot--lambda ((InlayHint) position kind label paddingLeft paddingRight) (goto-char (eglot--lsp-position-to-point position)) (when (or (> (point) to) (< (point) from)) (cl-return)) - (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))))) + (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 commit 4a5eda7ed2ae7567d0d54871cc51e0c2c27d73a9 Author: João Távora Date: Mon Feb 27 14:23:35 2023 +0000 Eglot: don't paint hints outside requested region (bug#61812) * lisp/progmodes/eglot.el (eglot--lambda): Add cl-block. (eglot--update-hints-1): Return early if hint is outside the requested inlay hint range. diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 719b3abe4cb..ef758371c16 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -641,7 +641,7 @@ eglot--lambda 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. @@ -3595,6 +3595,7 @@ eglot--update-hints-1 (paint-hint (eglot--lambda ((InlayHint) position kind label paddingLeft paddingRight) (goto-char (eglot--lsp-position-to-point position)) + (when (or (> (point) to) (< (point) from)) (cl-return)) (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))))) commit 1767d18c91a3c823d6ab6d69b2666fc5bc2f7d22 Author: Mattias Engdegård Date: Sun Feb 26 16:56:24 2023 +0100 Adjust some `pure` and `side-effect-free` function declarations * lisp/emacs-lisp/byte-opt.el (side-effect-free-fns): Add `format-message` and `substring-no-properties`. * lisp/subr.el (number-sequence, copy-tree, looking-at-p) (string-match-p, string-trim-right, string-lines): Declare side-effect-free. (syntax-class, version-list-<, version-list-=, version-list-<=) (version-list-not-zero): Declare pure and side-effect-free. (ensure-list): Declare side-effect-free and error-free. (string-equal-ignore-case): Remove `pure` declaration. We may want it to be pure but right now it's not. 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 @@ byte-optimize-set 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 @@ byte-optimize-set 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/subr.el b/lisp/subr.el index ef2f63f7c37..2a8c51eb7c4 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -806,6 +806,7 @@ number-sequence 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)) @@ -827,6 +828,7 @@ copy-tree 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) @@ -5241,11 +5243,13 @@ looking-back (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) @@ -5516,7 +5520,7 @@ string-equal-ignore-case 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) @@ -5843,6 +5847,7 @@ syntax-class 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 @@ -6693,6 +6698,7 @@ version-list-< \(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))) @@ -6714,6 +6720,7 @@ version-list-= \(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))) @@ -6735,6 +6742,7 @@ version-list-<= 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))) @@ -6752,6 +6760,7 @@ version-list-not-zero "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 @@ -6918,6 +6927,7 @@ string-trim-right "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))) @@ -6989,6 +6999,7 @@ ensure-list "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))) @@ -7064,6 +7075,7 @@ string-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 commit 443c249d85003639512d8d3b6ace184a9ff53bc2 Author: Mattias Engdegård Date: Mon Feb 27 13:57:48 2023 +0100 Warn about `condition-case` without handlers Omitting handlers from a `condition-case` form makes it useless since no errors are caught. * lisp/emacs-lisp/macroexp.el (macroexp--expand-all): New warning. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-test--with-suppressed-warnings): Add test case. * etc/NEWS: Announce. diff --git a/etc/NEWS b/etc/NEWS index 4b0e4e6bd46..9241598f185 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -321,6 +321,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/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 @@ macroexp--expand-all (`(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/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 @@ bytecomp-test--with-suppressed-warnings '((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)) commit 11c1aa1eb12cb8601355512387c80bf71a2deeb5 Author: Eli Zaretskii Date: Mon Feb 27 14:32:57 2023 +0200 ; * doc/misc/gnus.texi: Fix last change. diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index cf6820948ad..f0d3c75d055 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -14509,24 +14509,24 @@ Customizing the IMAP Connection @end example @table @code -@item nnimap-address @vindex nnimap-address +@item nnimap-address The address of the server, like @samp{imap.gmail.com}. -@item nnimap-user @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. -@item nnimap-server-port @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"}. -@item nnimap-stream @vindex nnimap-stream +@item nnimap-stream How @code{nnimap} should connect to the server. Possible values are: @table @code @@ -14556,8 +14556,8 @@ Customizing the IMAP Connection @end table -@item nnimap-authenticator @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, the normal login methods will be used. If you wish to specify a @@ -14566,8 +14566,8 @@ Customizing the IMAP Connection @code{plain}, @code{cram-md5} or @code{xoauth2}. (The latter method requires using the @file{oauth2.el} library.) -@item nnimap-expunge @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 expunged. If @code{immediately}, deleted articles are immediately expunged @@ -14582,33 +14582,33 @@ Customizing the IMAP Connection expunge ALL articles that are currently flagged as deleted (i.e., potentially not only the article that was just deleted). -@item nnimap-streaming @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}. -@item nnimap-fetch-partial-articles @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. -@item nnimap-record-commands @vindex nnimap-record-commands +@item nnimap-record-commands If non-@code{nil}, record all @acronym{IMAP} commands in the @samp{"*imap log*"} buffer. -@item nnimap-use-namespaces @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. -@item nnimap-keepalive-intervals @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 governs how often that happens. It is a cons of two integers, commit 44949c292f9133025b1a895bee622d74078255dd Author: Arash Esbati Date: Mon Feb 27 10:10:13 2023 +0100 ; Add `nnimap-user' to Gnus manual * doc/misc/gnus.texi (Customizing the IMAP Connection): Document backend variable `nnimap-user' which was introduced with commit 5e68f8614f in 2011. Add index entries for all backend variables. (bug#61837) diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index d513726979b..cf6820948ad 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -14510,13 +14510,23 @@ Customizing the IMAP Connection @table @code @item nnimap-address +@vindex nnimap-address The address of the server, like @samp{imap.gmail.com}. +@item nnimap-user +@vindex 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. + @item nnimap-server-port +@vindex 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"}. @item nnimap-stream +@vindex nnimap-stream How @code{nnimap} should connect to the server. Possible values are: @table @code @@ -14547,6 +14557,7 @@ Customizing the IMAP Connection @end table @item nnimap-authenticator +@vindex 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, the normal login methods will be used. If you wish to specify a @@ -14556,6 +14567,7 @@ Customizing the IMAP Connection requires using the @file{oauth2.el} library.) @item nnimap-expunge +@vindex nnimap-expunge When to expunge deleted messages. If @code{never}, deleted articles are marked with the IMAP @code{\\Delete} flag but not automatically expunged. If @code{immediately}, deleted articles are immediately expunged @@ -14571,27 +14583,32 @@ Customizing the IMAP Connection (i.e., potentially not only the article that was just deleted). @item nnimap-streaming +@vindex 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}. @item nnimap-fetch-partial-articles +@vindex 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. @item nnimap-record-commands +@vindex nnimap-record-commands If non-@code{nil}, record all @acronym{IMAP} commands in the @samp{"*imap log*"} buffer. @item nnimap-use-namespaces +@vindex 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. @item nnimap-keepalive-intervals +@vindex nnimap-keepalive-intervals By default, nnimap will send occasional @samp{NOOP} (keepalive) commands to the server, to keep the connection alive. This option governs how often that happens. It is a cons of two integers, commit 6c7078c66f429d8fa43aa7416ee7bb07b0e81386 Author: Eli Zaretskii Date: Mon Feb 27 14:11:13 2023 +0200 ; * lisp/progmodes/c-ts-mode.el (treesit-node-prev-sibling): Declare. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index befc0cf5643..2cb6c2709cc 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 commit 3d0a6c9baa613d69d75c3b2644e033a21da5f096 Author: João Távora Date: Mon Feb 27 11:29:32 2023 +0000 Eglot: protect against unintended field text motion (bug#61726) Suggested-by: Augusto Stoffel * lisp/progmodes/eglot.el (eglot--bol): New helper. (eglot-utf-8-linepos, eglot-utf-16-linepos) (eglot-utf-32-linepos, eglot-move-to-utf-8-linepos) (eglot-move-to-utf-16-linepos, eglot-move-to-utf-32-linepos) (eglot-handle-notification, eglot--xref-make-match) (eglot-completion-at-point): Use it. diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 32f78f89c0a..719b3abe4cb 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -1440,6 +1440,12 @@ eglot--warn (let ((warning-minimum-level :error)) (display-warning 'eglot (apply #'format format args) :warning))) +(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.") + ;;; Encoding fever ;;; @@ -1465,13 +1471,12 @@ eglot-current-linepos-function (defun eglot-utf-8-linepos () "Calculate number of UTF-8 bytes from line beginning." - (length (encode-coding-region (line-beginning-position) (point) - 'utf-8-unix t))) + (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 `line-beginning-position'." - (/ (- (length (encode-coding-region (or lbp (line-beginning-position)) +LBP defaults to `eglot--bol'." + (/ (- (length (encode-coding-region (or lbp (eglot--bol)) ;; Fix github#860 (min (point) (point-max)) 'utf-16 t)) 2) @@ -1479,7 +1484,7 @@ eglot-utf-16-linepos (defun eglot-utf-32-linepos () "Calculate number of Unicode codepoints from line beginning." - (- (point) (line-beginning-position))) + (- (point) (eglot--bol))) (defun eglot--pos-to-lsp-position (&optional pos) "Convert point POS to LSP position." @@ -1513,7 +1518,7 @@ eglot-move-to-linepos-function (defun eglot-move-to-utf-8-linepos (n) "Move to line's Nth byte as computed by LSP's UTF-8 criterion." - (let* ((bol (line-beginning-position)) + (let* ((bol (eglot--bol)) (goal-byte (+ (position-bytes bol) n)) (eol (line-end-position))) (goto-char bol) @@ -1524,7 +1529,7 @@ eglot-move-to-utf-8-linepos (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 (line-beginning-position)) + (let* ((bol (eglot--bol)) (goal-char (+ bol n)) (eol (line-end-position))) (goto-char bol) @@ -1539,8 +1544,7 @@ eglot-move-to-utf-32-linepos ;; 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) n) - (line-end-position)))) + (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. @@ -2190,7 +2194,7 @@ eglot-handle-notification (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 @@ -2630,7 +2634,7 @@ eglot--xref-make-match (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))) @@ -2981,7 +2985,7 @@ eglot-completion-at-point (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)) commit 647e40f4a0cf2c653d6ff6fc32116cbd2104d6ff Author: João Távora Date: Mon Feb 27 11:04:44 2023 +0000 ; And yet another fix to eglot-current-linepos-function's docstring bug#61726 * lisp/progmodes/eglot.el (eglot-current-linepos-function): Another fix. diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index dd84f545ed4..32f78f89c0a 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -1453,11 +1453,15 @@ eglot--warn (defvar eglot-current-linepos-function #'eglot-utf-16-linepos "Function calculating position relative to line beginning. -This is the inverse of `eglot-move-to-linepos-function' (which see). -It is a function of no arguments returning the number of code units -or bytes or codepoints corresponding to the current position of point, -relative to line beginning, as expected by the function that is the -value of `eglot-move-to-linepos-function'.") +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." commit 9d0f856a167040e66ad4bef5699e24552a6bc3c4 Author: Eli Zaretskii Date: Mon Feb 27 13:31:47 2023 +0200 Fix description of 'desktop-save-mode' * doc/emacs/misc.texi (Saving Emacs Sessions): Adjust to changes in 'desktop-path'. Reported by Petteri Hintsanen . diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index acabce57223..171544fc983 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -2748,10 +2748,12 @@ Saving Emacs Sessions @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 commit 10d2b76edadb6575545433ea6183c4d8e8588191 Author: Mattias Engdegård Date: Mon Feb 27 10:40:11 2023 +0100 * lisp/calc/calc.el (calcDigit-backspace): Hush warning. 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 @@ calcDigit-backspace (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) commit 434ab2e08895bdf952de78aea285da33be63c954 Author: Mattias Engdegård Date: Sun Feb 26 14:34:58 2023 +0100 Improve delete-consecutive-dups doc precision and add test * lisp/subr.el (delete-consecutive-dups): Document which element of each run is retained (the earliest in the list). This matters because it makes it safe to ignore the return value. * test/lisp/subr-tests.el (subr--delete-dups) (subr--delete-consecutive-dups): Add tests. diff --git a/lisp/subr.el b/lisp/subr.el index 916b6de494b..ef2f63f7c37 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -768,7 +768,9 @@ delete-dups (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)) 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 @@ test-list-of-strings-p (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 commit aee10ca1cbee1d653f89f028c34066bf3ebb32ab Author: Yuan Fu Date: Mon Feb 27 00:14:32 2023 -0800 Adjust tree-sitter defun navigation (bug#61617) Before this change, when you use a tree-sitter navigation function to move to the next beginning of a thing, it jumps over the immediate next thing and lands you at the beginning of the next-next thing. Eg, when point is at the "|", and we evaluate (treesit--navigate-thing pos 1 'beg), we go from | (thing) (thing) to (thing) |(thing) But some might expect point to go to |(thing) (thing) instead, which makes sense. Also, that's how Emacs expect defun navigation functions to work. The discrepancy in expectation causes bug#61617. In this change I made tree-sitter navigation functions to work as what Emacs expects. And what I described for moving to the next beginning of thing is similarly applicable to moving to the end of previous end of thing. * lisp/treesit.el (treesit-beginning-of-defun) (treesit-end-of-defun): Handle the case where defun-skipper moves point back to where we started, by adding a retry. (treesit--navigate-thing): Add a single condition checking for progress to the condition form responsible for checking whether to skip the next defun. Namely (eq pos (funcall advance next)))). * test/src/treesit-tests.el: (treesit--ert-defun-navigation-nested-master) (treesit--ert-defun-navigation-top-level-master): Change tests to reflect the new expectation. diff --git a/lisp/treesit.el b/lisp/treesit.el index 6b4db2a990c..052f641abfd 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1828,10 +1828,23 @@ treesit-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. @@ -1843,9 +1856,21 @@ treesit-end-of-defun 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)))))))) (defun treesit-default-defun-skipper () "Skips spaces after navigating a defun. @@ -1967,9 +1992,9 @@ treesit--top-level-thing ;; ;; 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 @@ -2019,18 +2044,24 @@ treesit--navigate-thing ;; ...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) @@ -2039,9 +2070,9 @@ treesit--navigate-thing (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/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 @@ treesit--ert-defun-navigation-elixir-program (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 @@ treesit--ert-defun-navigation-nested-master 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 @@ treesit--ert-defun-navigation-top-level-master (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.") commit edf5b97686908114f254b5077c71e8202149545f Author: Yuan Fu Date: Sun Feb 26 18:24:49 2023 -0800 Simplify c-ts-mode--top-level-label-matcher * lisp/progmodes/c-ts-mode.el: (c-ts-mode--top-level-label-matcher): Make more assumptions and remove the loop, so it's faster in large files. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 2c79cf46308..befc0cf5643 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -394,16 +394,13 @@ c-ts-mode--indent-styles ((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 commit 0f15286c5396e3415e0f40c21b6f6d7554f46a5e Author: Yuan Fu Date: Sun Feb 26 18:05:13 2023 -0800 New tree-sitter indent anchor standalone-parent used by c-ts-mode When writing c-ts-mode Theo used parent-bol which works well except one case: 1 for (int i=0; 2 i < 5; 3 i++) { 4 func(i); 5 } In this case, when indenting "func(i)", parent-bol returns the start of "i++" on line 3, instead of the "correct" anchor, the start of "for" on line 1. parent-bol would have worked if the "for (...) {" part is in one line. To support this case I tried numerous things and added a bunch of stuff, culminating in c-ts-common-statement-offset. It's complicated, requires extra setup, and slow. Not anymore! I think the new anchor standalone-parent really captures the logic behind how people expect indentation to work. It's simple and fast, and requires no setup. * doc/lispref/modes.texi (Parser-based Indentation): Update manual. * lisp/progmodes/c-ts-mode.el: (c-ts-mode--standalone-grandparent): New anchor. (c-ts-mode--indent-styles): Replace c-ts-common-statement-offset with standalone-parent. (c-ts-base-mode): Add comment. * lisp/treesit.el: (treesit-simple-indent-presets): New anchor standalone-parent. diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 4c40f414ca0..11892aaa40e 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -5093,7 +5093,15 @@ Parser-based Indentation @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/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 041461f220a..2c79cf46308 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -279,6 +279,12 @@ c-ts-mode--anchor-prev-sibling ;; 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 +306,9 @@ c-ts-mode--indent-styles ((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 +336,7 @@ c-ts-mode--indent-styles ;; 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 +347,25 @@ c-ts-mode--indent-styles ((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))))))) @@ -836,6 +842,8 @@ c-ts-base-mode (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/treesit.el b/lisp/treesit.el index 1decfc3d7cf..6b4db2a990c 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1227,6 +1227,16 @@ 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 @@ treesit-simple-indent-presets 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.