commit 5be32aa047d18b578412e8b249bb4f128a0dc207 (HEAD, refs/remotes/origin/master) Author: Jostein Kjønigsen Date: Sat Sep 6 22:50:53 2025 +0200 csharp-mode: indentation fixes (bug#79398) * lisp/progmodes/csharp-mode.el (csharp-ts-mode--indent-rules): Adjust rules to fix the following incorrect behaviours: - in multiline expressions/method call chains; - in object initialization expressions; - in array creation expressions. diff --git a/lisp/progmodes/csharp-mode.el b/lisp/progmodes/csharp-mode.el index 2ef97ccc687..0c44fff18bf 100644 --- a/lisp/progmodes/csharp-mode.el +++ b/lisp/progmodes/csharp-mode.el @@ -673,11 +673,14 @@ compilation and evaluation time conflicts." ((parent-is "namespace_declaration") parent-bol 0) ((parent-is "class_declaration") parent-bol 0) ((parent-is "constructor_declaration") parent-bol 0) + ((parent-is "array_creation_expression") parent-bol 0) ;; actual initialization is in contained initializer_expression + ((match "{" "initializer_expression" ) parent-bol 0) ((parent-is "initializer_expression") parent-bol csharp-ts-mode-indent-offset) ((match "{" "anonymous_object_creation_expression") parent-bol 0) ((parent-is "anonymous_object_creation_expression") parent-bol csharp-ts-mode-indent-offset) ((match "{" "object_creation_expression") parent-bol 0) ((parent-is "object_creation_expression") parent-bol 0) + ((parent-is "member_access_expression") parent-bol csharp-ts-mode-indent-offset) ((parent-is "method_declaration") parent-bol 0) ((parent-is "enum_declaration") parent-bol 0) ((parent-is "operator_declaration") parent-bol 0) commit 765dfb225a03910db10e4fe79723a9cf2882c959 Author: Roi Martin Date: Wed Sep 3 15:22:16 2025 +0200 Fix grammar installation in elixir-ts-mode and heex-ts-mode Fix tree-sitter grammar installation issues in elixir-ts-mode and heex-ts-mode (Bug#79363). * lisp/progmodes/elixir-ts-mode.el (elixir-ts--font-lock-settings): Check that tree-sitter is available. (elixir-ts-mode): If the user answers "no" to installing the heex tree-sitter grammar, do not ask again. Group heex settings. * lisp/progmodes/heex-ts-mode.el (heex-ts-mode): Ensure that elixir tree-sitter grammar is installed. diff --git a/lisp/progmodes/elixir-ts-mode.el b/lisp/progmodes/elixir-ts-mode.el index 04227599630..b6828a3d09c 100644 --- a/lisp/progmodes/elixir-ts-mode.el +++ b/lisp/progmodes/elixir-ts-mode.el @@ -371,216 +371,216 @@ 0))))) (defvar elixir-ts--font-lock-settings - (treesit-font-lock-rules - :language 'elixir - :feature 'elixir-definition - `((call target: (identifier) @target-identifier - (arguments - (call target: (identifier) @font-lock-function-name-face - (arguments))) - (:match ,elixir-ts--definition-keywords-re @target-identifier)) - (call target: (identifier) @target-identifier - (arguments (identifier) @font-lock-function-name-face) - (:match ,elixir-ts--definition-keywords-re @target-identifier)) - (call target: (identifier) @target-identifier - (arguments - (call target: (identifier) @font-lock-function-name-face - (arguments ((identifier)) @font-lock-variable-name-face))) - (:match ,elixir-ts--definition-keywords-re @target-identifier)) - (call target: (identifier) @target-identifier - (arguments - (binary_operator - left: (call target: (identifier) @font-lock-function-name-face))) - (:match ,elixir-ts--definition-keywords-re @target-identifier)) - (call target: (identifier) @target-identifier - (arguments (identifier) @font-lock-function-name-face) - (do_block) - (:match ,elixir-ts--definition-keywords-re @target-identifier)) - (call target: (identifier) @target-identifier - (arguments - (call target: (identifier) @font-lock-function-name-face - (arguments ((identifier)) @font-lock-variable-name-face))) - (do_block) - (:match ,elixir-ts--definition-keywords-re @target-identifier)) - (call target: (identifier) @target-identifier - (arguments - (binary_operator - left: (call target: (identifier) @font-lock-function-name-face - (arguments ((identifier)) @font-lock-variable-name-face)))) - (do_block) - (:match ,elixir-ts--definition-keywords-re @target-identifier)) - (unary_operator - operator: "@" - (call (arguments - (binary_operator - left: (call target: (identifier) @font-lock-function-name-face)))))) - - :language 'elixir - :feature 'elixir-comment - :override t - '((comment) @font-lock-comment-face - ((identifier) @font-lock-comment-face - (:match "^_[a-z]\\|^_$" @font-lock-comment-face))) - - :language 'elixir - :feature 'elixir-variable - `((call target: (identifier) - (arguments - (binary_operator - (call target: (identifier) - (arguments ((identifier) @font-lock-variable-use-face)))))) - (call target: (identifier) - (arguments - (call target: (identifier) - (arguments ((identifier)) @font-lock-variable-use-face)))) - (dot left: (identifier) @font-lock-variable-use-face operator: "." )) - - :language 'elixir - :feature 'elixir-doc - `((unary_operator - operator: "@" @elixir-ts-comment-doc-attribute - operand: (call - target: (identifier) @elixir-ts-comment-doc-identifier - ;; Arguments can be optional, so adding another - ;; entry without arguments. - ;; If we don't handle then we don't apply font - ;; and the non doc fortification query will take specify - ;; a more specific font which takes precedence. - (arguments - [ - (string) @font-lock-doc-face - (charlist) @font-lock-doc-face - (sigil) @font-lock-doc-face - (boolean) @font-lock-doc-face - (keywords) @font-lock-doc-face - ])) - (:match ,elixir-ts--doc-keywords-re - @elixir-ts-comment-doc-identifier)) - (unary_operator - operator: "@" @elixir-ts-comment-doc-attribute - operand: (call - target: (identifier) @elixir-ts-comment-doc-identifier) - (:match ,elixir-ts--doc-keywords-re - @elixir-ts-comment-doc-identifier))) - - :language 'elixir - :feature 'elixir-string - '((interpolation - "#{" @font-lock-escape-face - "}" @font-lock-escape-face) - (string (quoted_content) @font-lock-string-face) - (quoted_keyword (quoted_content) @font-lock-string-face) - (charlist (quoted_content) @font-lock-string-face) - ["\"" "'" "\"\"\""] @font-lock-string-face) - - :language 'elixir - :feature 'elixir-sigil - `((sigil - (sigil_name) @elixir-ts-sigil-name - (quoted_content) @font-lock-string-face - ;; HEEx and Surface templates will handled by - ;; heex-ts-mode if its available. - (:match "^[^HF]$" @elixir-ts-sigil-name)) - @font-lock-string-face - (sigil - (sigil_name) @font-lock-regexp-face - (:match "^[rR]$" @font-lock-regexp-face)) - @font-lock-regexp-face - (sigil - "~" @font-lock-string-face - (sigil_name) @font-lock-string-face - quoted_start: _ @font-lock-string-face - quoted_end: _ @font-lock-string-face)) - - :language 'elixir - :feature 'elixir-operator - `(["!"] @font-lock-negation-char-face - ["%"] @font-lock-bracket-face - ["," ";"] @font-lock-operator-face - ["(" ")" "[" "]" "{" "}" "<<" ">>"] @font-lock-bracket-face) - - :language 'elixir - :feature 'elixir-data-type - '((alias) @font-lock-type-face - (atom) @elixir-ts-atom - (keywords (pair key: (keyword) @elixir-ts-keyword-key)) - [(keyword) (quoted_keyword)] @elixir-ts-atom - [(boolean) (nil)] @elixir-ts-atom - (unary_operator operator: "@" @elixir-ts-attribute - operand: [ - (identifier) @elixir-ts-attribute - (call target: (identifier) - @elixir-ts-attribute) - (boolean) @elixir-ts-attribute - (nil) @elixir-ts-attribute - ]) - (operator_identifier) @font-lock-operator-face) - - :language 'elixir - :feature 'elixir-keyword - `(,elixir-ts--reserved-keywords-vector - @font-lock-keyword-face - (binary_operator - operator: _ @font-lock-keyword-face - (:match ,elixir-ts--reserved-keywords-re @font-lock-keyword-face)) - (binary_operator operator: _ @font-lock-operator-face) - (call - target: (identifier) @font-lock-keyword-face - (:match ,elixir-ts--definition-keywords-re @font-lock-keyword-face)) - (call - target: (identifier) @font-lock-keyword-face - (:match ,elixir-ts--kernel-keywords-re @font-lock-keyword-face))) - - :language 'elixir - :feature 'elixir-function-call - '((call target: (identifier) @font-lock-function-call-face) - (unary_operator operator: "&" @font-lock-operator-face - operand: (binary_operator - left: (identifier) - @font-lock-function-call-face - operator: "/" right: (integer))) - (call - target: (dot right: (identifier) @font-lock-function-call-face)) - (unary_operator operator: "&" @font-lock-variable-use-face - operand: (integer) @font-lock-variable-use-face) - (unary_operator operator: "&" @font-lock-operator-face - operand: (list))) - - :language 'elixir - :feature 'elixir-string-escape - :override t - `((escape_sequence) @font-lock-escape-face) - - :language 'elixir - :feature 'elixir-number - '([(integer) (float)] @font-lock-number-face) - - :language 'elixir - :feature 'elixir-variable - '((binary_operator left: (identifier) @font-lock-variable-use-face) - (binary_operator right: (identifier) @font-lock-variable-use-face) - (arguments ( (identifier) @font-lock-variable-use-face)) - (tuple (identifier) @font-lock-variable-use-face) - (list (identifier) @font-lock-variable-use-face) - (pair value: (identifier) @font-lock-variable-use-face) - (body (identifier) @font-lock-variable-use-face) - (unary_operator operand: (identifier) @font-lock-variable-use-face) - (interpolation (identifier) @font-lock-variable-use-face) - (do_block (identifier) @font-lock-variable-use-face) - (rescue_block (identifier) @font-lock-variable-use-face) - (catch_block (identifier) @font-lock-variable-use-face) - (else_block (identifier) @font-lock-variable-use-face) - (after_block (identifier) @font-lock-variable-use-face) - (access_call target: (identifier) @font-lock-variable-use-face) - (access_call "[" key: (identifier) @font-lock-variable-use-face "]")) - - :language 'elixir - :feature 'elixir-builtin - :override t - `(((identifier) @font-lock-builtin-face - (:match ,elixir-ts--builtin-keywords-re - @font-lock-builtin-face)))) - + (when (treesit-available-p) + (treesit-font-lock-rules + :language 'elixir + :feature 'elixir-definition + `((call target: (identifier) @target-identifier + (arguments + (call target: (identifier) @font-lock-function-name-face + (arguments))) + (:match ,elixir-ts--definition-keywords-re @target-identifier)) + (call target: (identifier) @target-identifier + (arguments (identifier) @font-lock-function-name-face) + (:match ,elixir-ts--definition-keywords-re @target-identifier)) + (call target: (identifier) @target-identifier + (arguments + (call target: (identifier) @font-lock-function-name-face + (arguments ((identifier)) @font-lock-variable-name-face))) + (:match ,elixir-ts--definition-keywords-re @target-identifier)) + (call target: (identifier) @target-identifier + (arguments + (binary_operator + left: (call target: (identifier) @font-lock-function-name-face))) + (:match ,elixir-ts--definition-keywords-re @target-identifier)) + (call target: (identifier) @target-identifier + (arguments (identifier) @font-lock-function-name-face) + (do_block) + (:match ,elixir-ts--definition-keywords-re @target-identifier)) + (call target: (identifier) @target-identifier + (arguments + (call target: (identifier) @font-lock-function-name-face + (arguments ((identifier)) @font-lock-variable-name-face))) + (do_block) + (:match ,elixir-ts--definition-keywords-re @target-identifier)) + (call target: (identifier) @target-identifier + (arguments + (binary_operator + left: (call target: (identifier) @font-lock-function-name-face + (arguments ((identifier)) @font-lock-variable-name-face)))) + (do_block) + (:match ,elixir-ts--definition-keywords-re @target-identifier)) + (unary_operator + operator: "@" + (call (arguments + (binary_operator + left: (call target: (identifier) @font-lock-function-name-face)))))) + + :language 'elixir + :feature 'elixir-comment + :override t + '((comment) @font-lock-comment-face + ((identifier) @font-lock-comment-face + (:match "^_[a-z]\\|^_$" @font-lock-comment-face))) + + :language 'elixir + :feature 'elixir-variable + `((call target: (identifier) + (arguments + (binary_operator + (call target: (identifier) + (arguments ((identifier) @font-lock-variable-use-face)))))) + (call target: (identifier) + (arguments + (call target: (identifier) + (arguments ((identifier)) @font-lock-variable-use-face)))) + (dot left: (identifier) @font-lock-variable-use-face operator: "." )) + + :language 'elixir + :feature 'elixir-doc + `((unary_operator + operator: "@" @elixir-ts-comment-doc-attribute + operand: (call + target: (identifier) @elixir-ts-comment-doc-identifier + ;; Arguments can be optional, so adding another + ;; entry without arguments. + ;; If we don't handle then we don't apply font + ;; and the non doc fortification query will take specify + ;; a more specific font which takes precedence. + (arguments + [ + (string) @font-lock-doc-face + (charlist) @font-lock-doc-face + (sigil) @font-lock-doc-face + (boolean) @font-lock-doc-face + (keywords) @font-lock-doc-face + ])) + (:match ,elixir-ts--doc-keywords-re + @elixir-ts-comment-doc-identifier)) + (unary_operator + operator: "@" @elixir-ts-comment-doc-attribute + operand: (call + target: (identifier) @elixir-ts-comment-doc-identifier) + (:match ,elixir-ts--doc-keywords-re + @elixir-ts-comment-doc-identifier))) + + :language 'elixir + :feature 'elixir-string + '((interpolation + "#{" @font-lock-escape-face + "}" @font-lock-escape-face) + (string (quoted_content) @font-lock-string-face) + (quoted_keyword (quoted_content) @font-lock-string-face) + (charlist (quoted_content) @font-lock-string-face) + ["\"" "'" "\"\"\""] @font-lock-string-face) + + :language 'elixir + :feature 'elixir-sigil + `((sigil + (sigil_name) @elixir-ts-sigil-name + (quoted_content) @font-lock-string-face + ;; HEEx and Surface templates will handled by + ;; heex-ts-mode if its available. + (:match "^[^HF]$" @elixir-ts-sigil-name)) + @font-lock-string-face + (sigil + (sigil_name) @font-lock-regexp-face + (:match "^[rR]$" @font-lock-regexp-face)) + @font-lock-regexp-face + (sigil + "~" @font-lock-string-face + (sigil_name) @font-lock-string-face + quoted_start: _ @font-lock-string-face + quoted_end: _ @font-lock-string-face)) + + :language 'elixir + :feature 'elixir-operator + `(["!"] @font-lock-negation-char-face + ["%"] @font-lock-bracket-face + ["," ";"] @font-lock-operator-face + ["(" ")" "[" "]" "{" "}" "<<" ">>"] @font-lock-bracket-face) + + :language 'elixir + :feature 'elixir-data-type + '((alias) @font-lock-type-face + (atom) @elixir-ts-atom + (keywords (pair key: (keyword) @elixir-ts-keyword-key)) + [(keyword) (quoted_keyword)] @elixir-ts-atom + [(boolean) (nil)] @elixir-ts-atom + (unary_operator operator: "@" @elixir-ts-attribute + operand: [ + (identifier) @elixir-ts-attribute + (call target: (identifier) + @elixir-ts-attribute) + (boolean) @elixir-ts-attribute + (nil) @elixir-ts-attribute + ]) + (operator_identifier) @font-lock-operator-face) + + :language 'elixir + :feature 'elixir-keyword + `(,elixir-ts--reserved-keywords-vector + @font-lock-keyword-face + (binary_operator + operator: _ @font-lock-keyword-face + (:match ,elixir-ts--reserved-keywords-re @font-lock-keyword-face)) + (binary_operator operator: _ @font-lock-operator-face) + (call + target: (identifier) @font-lock-keyword-face + (:match ,elixir-ts--definition-keywords-re @font-lock-keyword-face)) + (call + target: (identifier) @font-lock-keyword-face + (:match ,elixir-ts--kernel-keywords-re @font-lock-keyword-face))) + + :language 'elixir + :feature 'elixir-function-call + '((call target: (identifier) @font-lock-function-call-face) + (unary_operator operator: "&" @font-lock-operator-face + operand: (binary_operator + left: (identifier) + @font-lock-function-call-face + operator: "/" right: (integer))) + (call + target: (dot right: (identifier) @font-lock-function-call-face)) + (unary_operator operator: "&" @font-lock-variable-use-face + operand: (integer) @font-lock-variable-use-face) + (unary_operator operator: "&" @font-lock-operator-face + operand: (list))) + + :language 'elixir + :feature 'elixir-string-escape + :override t + `((escape_sequence) @font-lock-escape-face) + + :language 'elixir + :feature 'elixir-number + '([(integer) (float)] @font-lock-number-face) + + :language 'elixir + :feature 'elixir-variable + '((binary_operator left: (identifier) @font-lock-variable-use-face) + (binary_operator right: (identifier) @font-lock-variable-use-face) + (arguments ( (identifier) @font-lock-variable-use-face)) + (tuple (identifier) @font-lock-variable-use-face) + (list (identifier) @font-lock-variable-use-face) + (pair value: (identifier) @font-lock-variable-use-face) + (body (identifier) @font-lock-variable-use-face) + (unary_operator operand: (identifier) @font-lock-variable-use-face) + (interpolation (identifier) @font-lock-variable-use-face) + (do_block (identifier) @font-lock-variable-use-face) + (rescue_block (identifier) @font-lock-variable-use-face) + (catch_block (identifier) @font-lock-variable-use-face) + (else_block (identifier) @font-lock-variable-use-face) + (after_block (identifier) @font-lock-variable-use-face) + (access_call target: (identifier) @font-lock-variable-use-face) + (access_call "[" key: (identifier) @font-lock-variable-use-face "]")) + + :language 'elixir + :feature 'elixir-builtin + :override t + `(((identifier) @font-lock-builtin-face + (:match ,elixir-ts--builtin-keywords-re + @font-lock-builtin-face))))) "Tree-sitter font-lock settings.") (defvar elixir-ts--font-lock-feature-list @@ -737,16 +737,6 @@ Return nil if NODE is not a defun node or doesn't have a name." #'elixir-ts--electric-pair-string-delimiter 'append t) (when (treesit-ensure-installed 'elixir) - ;; The HEEx parser has to be created first for elixir to ensure elixir - ;; is the first language when looking for treesit ranges. - ;; (In Emacs 31 this requirement is removed.) - (when (treesit-ensure-installed 'heex) - ;; Require heex-ts-mode only when we load elixir-ts-mode - ;; so that we don't get a tree-sitter compilation warning for - ;; elixir-ts-mode. - (require 'heex-ts-mode) - (treesit-parser-create 'heex)) - (setq-local treesit-primary-parser (treesit-parser-create 'elixir)) @@ -764,8 +754,7 @@ Return nil if NODE is not a defun node or doesn't have a name." ;; Navigation. (setq-local treesit-thing-settings - `((elixir ,@elixir-ts--thing-settings) - (heex ,@heex-ts--thing-settings))) + `((elixir ,@elixir-ts--thing-settings))) (setq-local treesit-defun-type-regexp '("call" . elixir-ts--defun-p)) @@ -773,6 +762,9 @@ Return nil if NODE is not a defun node or doesn't have a name." ;; Embedded Heex. (when (treesit-ensure-installed 'heex) + (require 'heex-ts-mode) + (treesit-parser-create 'heex) + (setq-local treesit-range-settings (append elixir-ts--range-rules ;; Leave only local parsers from heex @@ -791,7 +783,11 @@ Return nil if NODE is not a defun node or doesn't have a name." (setq-local treesit-font-lock-feature-list (treesit-merge-font-lock-feature-list treesit-font-lock-feature-list - heex-ts--font-lock-feature-list))) + heex-ts--font-lock-feature-list)) + + (setq-local treesit-thing-settings + (append treesit-thing-settings + `((heex ,@heex-ts--thing-settings))))) (treesit-major-mode-setup) diff --git a/lisp/progmodes/heex-ts-mode.el b/lisp/progmodes/heex-ts-mode.el index 2b8b75c444e..e9626e32f33 100644 --- a/lisp/progmodes/heex-ts-mode.el +++ b/lisp/progmodes/heex-ts-mode.el @@ -235,7 +235,7 @@ Return nil if NODE is not a defun node or doesn't have a name." (setq-local treesit-font-lock-feature-list heex-ts--font-lock-feature-list) - (when (treesit-ready-p 'elixir) + (when (treesit-ensure-installed 'elixir) (require 'elixir-ts-mode) (treesit-parser-create 'elixir) commit 445d6d5921c09c44328cdd5882190b984a52a188 Author: Roi Martin Date: Wed Sep 3 15:30:14 2025 +0200 Fix font lock in go-ts-mode Fix font lock in go-ts-mode when the tree-sitter grammar is automatically installed (Bug#79363). * lisp/progmodes/go-ts-mode.el (go-ts-mode--font-lock-settings): Evaluate the rules only after the tree-sitter grammar is installed. (go-ts-mode): Call the new `go-ts-mode--font-lock-settings' function. diff --git a/lisp/progmodes/go-ts-mode.el b/lisp/progmodes/go-ts-mode.el index e149e9230ec..1b44478f41a 100644 --- a/lisp/progmodes/go-ts-mode.el +++ b/lisp/progmodes/go-ts-mode.el @@ -162,121 +162,129 @@ (ignore-errors (or (treesit-query-string "" '((method_elem) @cap) 'go) t))) -(defvar go-ts-mode--font-lock-settings - (treesit-font-lock-rules - :language 'go - :feature 'bracket - '((["(" ")" "[" "]" "{" "}"]) @font-lock-bracket-face) - - :language 'go - :feature 'comment - '((comment) @font-lock-comment-face) - - :language 'go - :feature 'builtin - `((call_expression - function: ((identifier) @font-lock-builtin-face - (:match ,(rx-to-string - `(seq bol - (or ,@go-ts-mode--builtin-functions) - eol)) - @font-lock-builtin-face)))) - - :language 'go - :feature 'constant - `([(false) (nil) (true)] @font-lock-constant-face - ,@(when (go-ts-mode--iota-query-supported-p) - '((iota) @font-lock-constant-face)) - (const_declaration - (const_spec name: (identifier) @font-lock-constant-face - ("," name: (identifier) @font-lock-constant-face)*))) - - :language 'go - :feature 'delimiter - '((["," "." ";" ":"]) @font-lock-delimiter-face) - - :language 'go - :feature 'operator - `([,@go-ts-mode--operators] @font-lock-operator-face) - - :language 'go - :feature 'definition - `((function_declaration - name: (identifier) @font-lock-function-name-face) - (method_declaration - name: (field_identifier) @font-lock-function-name-face) - (,(if (go-ts-mode--method-elem-supported-p) - 'method_elem - 'method_spec) - name: (field_identifier) @font-lock-function-name-face) - (field_declaration - name: (field_identifier) @font-lock-property-name-face) - (parameter_declaration - name: (identifier) @font-lock-variable-name-face) - (variadic_parameter_declaration - name: (identifier) @font-lock-variable-name-face) - (short_var_declaration - left: (expression_list - (identifier) @font-lock-variable-name-face - ("," (identifier) @font-lock-variable-name-face)*)) - (var_spec name: (identifier) @font-lock-variable-name-face - ("," name: (identifier) @font-lock-variable-name-face)*) - (range_clause - left: (expression_list - (identifier) @font-lock-variable-name-face))) - - :language 'go - :feature 'function - '((call_expression - function: (identifier) @font-lock-function-call-face) - (call_expression - function: (selector_expression - field: (field_identifier) @font-lock-function-call-face))) - - :language 'go - :feature 'keyword - `([,@go-ts-mode--keywords] @font-lock-keyword-face) - - :language 'go - :feature 'label - '((label_name) @font-lock-constant-face) - - :language 'go - :feature 'number - '([(float_literal) - (imaginary_literal) - (int_literal)] @font-lock-number-face) - - :language 'go - :feature 'string - '([(interpreted_string_literal) - (raw_string_literal) - (rune_literal)] @font-lock-string-face) - - :language 'go - :feature 'type - '([(package_identifier) (type_identifier)] @font-lock-type-face) - - :language 'go - :feature 'property - '((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-use-face) - - :language 'go - :feature 'escape-sequence - :override t - '((escape_sequence) @font-lock-escape-face) - - :language 'go - :feature 'error - :override t - '((ERROR) @font-lock-warning-face)) +(defvar go-ts-mode--font-lock-settings nil "Tree-sitter font-lock settings for `go-ts-mode'.") +(defun go-ts-mode--font-lock-settings () + "Return tree-sitter font-lock settings for `go-ts-mode'. + +Tree-sitter font-lock rules are evaluated the first time this function +is called. Subsequent calls return the first evaluated value." + (or go-ts-mode--font-lock-settings + (setq go-ts-mode--font-lock-settings + (treesit-font-lock-rules + :language 'go + :feature 'bracket + '((["(" ")" "[" "]" "{" "}"]) @font-lock-bracket-face) + + :language 'go + :feature 'comment + '((comment) @font-lock-comment-face) + + :language 'go + :feature 'builtin + `((call_expression + function: ((identifier) @font-lock-builtin-face + (:match ,(rx-to-string + `(seq bol + (or ,@go-ts-mode--builtin-functions) + eol)) + @font-lock-builtin-face)))) + + :language 'go + :feature 'constant + `([(false) (nil) (true)] @font-lock-constant-face + ,@(when (go-ts-mode--iota-query-supported-p) + '((iota) @font-lock-constant-face)) + (const_declaration + (const_spec name: (identifier) @font-lock-constant-face + ("," name: (identifier) @font-lock-constant-face)*))) + + :language 'go + :feature 'delimiter + '((["," "." ";" ":"]) @font-lock-delimiter-face) + + :language 'go + :feature 'operator + `([,@go-ts-mode--operators] @font-lock-operator-face) + + :language 'go + :feature 'definition + `((function_declaration + name: (identifier) @font-lock-function-name-face) + (method_declaration + name: (field_identifier) @font-lock-function-name-face) + (,(if (go-ts-mode--method-elem-supported-p) + 'method_elem + 'method_spec) + name: (field_identifier) @font-lock-function-name-face) + (field_declaration + name: (field_identifier) @font-lock-property-name-face) + (parameter_declaration + name: (identifier) @font-lock-variable-name-face) + (variadic_parameter_declaration + name: (identifier) @font-lock-variable-name-face) + (short_var_declaration + left: (expression_list + (identifier) @font-lock-variable-name-face + ("," (identifier) @font-lock-variable-name-face)*)) + (var_spec name: (identifier) @font-lock-variable-name-face + ("," name: (identifier) @font-lock-variable-name-face)*) + (range_clause + left: (expression_list + (identifier) @font-lock-variable-name-face))) + + :language 'go + :feature 'function + '((call_expression + function: (identifier) @font-lock-function-call-face) + (call_expression + function: (selector_expression + field: (field_identifier) @font-lock-function-call-face))) + + :language 'go + :feature 'keyword + `([,@go-ts-mode--keywords] @font-lock-keyword-face) + + :language 'go + :feature 'label + '((label_name) @font-lock-constant-face) + + :language 'go + :feature 'number + '([(float_literal) + (imaginary_literal) + (int_literal)] @font-lock-number-face) + + :language 'go + :feature 'string + '([(interpreted_string_literal) + (raw_string_literal) + (rune_literal)] @font-lock-string-face) + + :language 'go + :feature 'type + '([(package_identifier) (type_identifier)] @font-lock-type-face) + + :language 'go + :feature 'property + '((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-use-face) + + :language 'go + :feature 'escape-sequence + :override t + '((escape_sequence) @font-lock-escape-face) + + :language 'go + :feature 'error + :override t + '((ERROR) @font-lock-warning-face))))) + (defvar-keymap go-ts-mode-map :doc "Keymap used in Go mode, powered by tree-sitter" :parent prog-mode-map @@ -348,7 +356,7 @@ (append "{}()" electric-indent-chars)) ;; Font-lock. - (setq-local treesit-font-lock-settings go-ts-mode--font-lock-settings) + (setq-local treesit-font-lock-settings (go-ts-mode--font-lock-settings)) (setq-local treesit-font-lock-feature-list '(( comment definition) ( keyword string type) commit 86cc48e45eddadde635616ef1037be7c212fb77d Author: Roi Martin Date: Thu Sep 4 07:40:32 2025 +0200 Fix font lock and indentation in cmake-ts-mode Fix font lock and indentation in cmake-ts-mode when the tree-sitter grammar is automatically installed (Bug#79363). * lisp/progmodes/cmake-ts-mode.el (cmake-ts-mode--indent-rules) (cmake-ts-mode--font-lock-settings): Evaluate the rules only after the tree-sitter grammar is installed. (cmake-ts-mode): Call the new `cmake-ts-mode--indent-rules' and `cmake-ts-mode--font-lock-settings' functions. diff --git a/lisp/progmodes/cmake-ts-mode.el b/lisp/progmodes/cmake-ts-mode.el index 84589b1eb73..8e49b18f731 100644 --- a/lisp/progmodes/cmake-ts-mode.el +++ b/lisp/progmodes/cmake-ts-mode.el @@ -61,28 +61,36 @@ table) "Syntax table for `cmake-ts-mode'.") -(defvar cmake-ts-mode--indent-rules - `((cmake - ((node-is ")") parent-bol 0) - ((node-is "else_command") parent-bol 0) - ((node-is "elseif_command") parent-bol 0) - ((node-is "endforeach_command") parent-bol 0) - ((node-is "endfunction_command") parent-bol 0) - ((node-is "endif_command") parent-bol 0) - ((parent-is "foreach_loop") parent-bol cmake-ts-mode-indent-offset) - ((parent-is "function_def") parent-bol cmake-ts-mode-indent-offset) - ((parent-is "if_condition") parent-bol cmake-ts-mode-indent-offset) - ((parent-is "normal_command") parent-bol cmake-ts-mode-indent-offset) - ;;; Release v0.4.0 wraps arguments in an argument_list node. - ,@(ignore-errors - (treesit-query-capture 'cmake '((argument_list) @capture)) - `(((parent-is "argument_list") grand-parent cmake-ts-mode-indent-offset))) - ;;; Release v0.3.0 wraps the body of commands into a body node. - ,@(ignore-errors - (treesit-query-capture 'cmake '((body) @capture)) - `(((parent-is "body") grand-parent cmake-ts-mode-indent-offset))))) +(defvar cmake-ts-mode--indent-rules nil "Tree-sitter indent rules for `cmake-ts-mode'.") +(defun cmake-ts-mode--indent-rules () + "Return tree-sitter indent rules for `cmake-ts-mode'. + +Tree-sitter indent rules are evaluated the first time this function +is called. Subsequent calls return the first evaluated value." + (or cmake-ts-mode--indent-rules + (setq cmake-ts-mode--indent-rules + `((cmake + ((node-is ")") parent-bol 0) + ((node-is "else_command") parent-bol 0) + ((node-is "elseif_command") parent-bol 0) + ((node-is "endforeach_command") parent-bol 0) + ((node-is "endfunction_command") parent-bol 0) + ((node-is "endif_command") parent-bol 0) + ((parent-is "foreach_loop") parent-bol cmake-ts-mode-indent-offset) + ((parent-is "function_def") parent-bol cmake-ts-mode-indent-offset) + ((parent-is "if_condition") parent-bol cmake-ts-mode-indent-offset) + ((parent-is "normal_command") parent-bol cmake-ts-mode-indent-offset) + ;; Release v0.4.0 wraps arguments in an argument_list node. + ,@(ignore-errors + (treesit-query-capture 'cmake '((argument_list) @capture)) + `(((parent-is "argument_list") grand-parent cmake-ts-mode-indent-offset))) + ;; Release v0.3.0 wraps the body of commands into a body node. + ,@(ignore-errors + (treesit-query-capture 'cmake '((body) @capture)) + `(((parent-is "body") grand-parent cmake-ts-mode-indent-offset)))))))) + (defvar cmake-ts-mode--constants '("ON" "TRUE" "YES" "Y" "OFF" "FALSE" "NO" "N" "IGNORE" "NOTFOUND") "CMake constants for tree-sitter font-locking.") @@ -140,69 +148,77 @@ Check if a node type is available, then return the right font lock rules." eol)) @font-lock-constant-face)))))))) -(defvar cmake-ts-mode--font-lock-settings - (treesit-font-lock-rules - :language 'cmake - :feature 'bracket - '((["(" ")"]) @font-lock-bracket-face) - - :language 'cmake - :feature 'builtin - (cmake-ts-mode--font-lock-compatibility-fe9b5e0) - - :language 'cmake - :feature 'comment - '([(bracket_comment) (line_comment)] @font-lock-comment-face) - - :language 'cmake - :feature 'constant - `(((argument) @font-lock-constant-face - (:match ,(rx-to-string - `(seq bol - (or ,@cmake-ts-mode--constants) - eol)) - @font-lock-constant-face))) - - :language 'cmake - :feature 'function - '((normal_command (identifier) @font-lock-function-call-face)) - - :language 'cmake - :feature 'keyword - `([,@cmake-ts-mode--keywords] @font-lock-keyword-face) - - :language 'cmake - :feature 'number - '(((unquoted_argument) @font-lock-number-face - (:match "\\`-?[[:digit:]]*\\.?[[:digit:]]*\\.?[[:digit:]]+\\'" - @font-lock-number-face))) - - :language 'cmake - :feature 'string - '([(bracket_argument) (quoted_argument)] @font-lock-string-face) - - :language 'cmake - :feature 'escape-sequence - :override t - '((escape_sequence) @font-lock-escape-face) - - :language 'cmake - :feature 'misc-punctuation - ;; Don't override strings. - :override 'nil - '((["$" "{" "}"]) @font-lock-misc-punctuation-face) - - :language 'cmake - :feature 'variable - :override t - '((variable) @font-lock-variable-use-face) - - :language 'cmake - :feature 'error - :override t - '((ERROR) @font-lock-warning-face)) +(defvar cmake-ts-mode--font-lock-settings nil "Tree-sitter font-lock settings for `cmake-ts-mode'.") +(defun cmake-ts-mode--font-lock-settings () + "Return tree-sitter font-lock settings for `cmake-ts-mode'. + +Tree-sitter font-lock rules are evaluated the first time this function +is called. Subsequent calls return the first evaluated value." + (or cmake-ts-mode--font-lock-settings + (setq cmake-ts-mode--font-lock-settings + (treesit-font-lock-rules + :language 'cmake + :feature 'bracket + '((["(" ")"]) @font-lock-bracket-face) + + :language 'cmake + :feature 'builtin + (cmake-ts-mode--font-lock-compatibility-fe9b5e0) + + :language 'cmake + :feature 'comment + '([(bracket_comment) (line_comment)] @font-lock-comment-face) + + :language 'cmake + :feature 'constant + `(((argument) @font-lock-constant-face + (:match ,(rx-to-string + `(seq bol + (or ,@cmake-ts-mode--constants) + eol)) + @font-lock-constant-face))) + + :language 'cmake + :feature 'function + '((normal_command (identifier) @font-lock-function-call-face)) + + :language 'cmake + :feature 'keyword + `([,@cmake-ts-mode--keywords] @font-lock-keyword-face) + + :language 'cmake + :feature 'number + '(((unquoted_argument) @font-lock-number-face + (:match "\\`-?[[:digit:]]*\\.?[[:digit:]]*\\.?[[:digit:]]+\\'" + @font-lock-number-face))) + + :language 'cmake + :feature 'string + '([(bracket_argument) (quoted_argument)] @font-lock-string-face) + + :language 'cmake + :feature 'escape-sequence + :override t + '((escape_sequence) @font-lock-escape-face) + + :language 'cmake + :feature 'misc-punctuation + ;; Don't override strings. + :override 'nil + '((["$" "{" "}"]) @font-lock-misc-punctuation-face) + + :language 'cmake + :feature 'variable + :override t + '((variable) @font-lock-variable-use-face) + + :language 'cmake + :feature 'error + :override t + '((ERROR) @font-lock-warning-face))))) + (defun cmake-ts-mode--defun-name (node) "Return the defun name of NODE. Return nil if there is no name or if NODE is not a defun node." @@ -238,10 +254,10 @@ Return nil if there is no name or if NODE is not a defun node." (setq-local which-func-functions nil) ;; Indent. - (setq-local treesit-simple-indent-rules cmake-ts-mode--indent-rules) + (setq-local treesit-simple-indent-rules (cmake-ts-mode--indent-rules)) ;; Font-lock. - (setq-local treesit-font-lock-settings cmake-ts-mode--font-lock-settings) + (setq-local treesit-font-lock-settings (cmake-ts-mode--font-lock-settings)) (setq-local treesit-font-lock-feature-list '((comment) (keyword string) commit a4ea22d9989cece0dcbae511c3e321b34474fe14 Author: Mattias Engdegård Date: Sun Sep 7 17:47:51 2025 +0200 * lisp/emacs-lisp/cl-lib.el (cl-copy-list): Not error-free, bug#79396 diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index f1b3b8fdbcc..07f37410d3f 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -486,7 +486,7 @@ Thus, `(cl-list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to (defun cl-copy-list (list) "Return a copy of LIST, which may be a dotted list. The elements of LIST are not copied, just the list structure itself." - (declare (side-effect-free error-free)) + (declare (side-effect-free t)) (if (consp list) (let ((res nil)) (while (consp list) (push (pop list) res)) commit c13c620f12e2f874d22715e7b1dcd06bb5ed1930 Author: Mattias Engdegård Date: Sat Sep 6 10:44:43 2025 +0200 Less expensive jsonrpc logging (bug#79361) Remove the oldest 1/4 of the jsonrpc events buffer when reaching the size limit instead of just a few lines. This reduces the cost of adding a log entry from O(buffer-size) to O(1). Also make messages forwarded to the events buffer, such as ones sent to stderr from the server process, obey the same limit. * lisp/jsonrpc.el (jsonrpc--limit-buffer-size): New. (jsonrpc--log-event, jsonrpc--forwarding-buffer): Use it. diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index bb75196cdc8..1ad0a78b1d1 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -995,6 +995,20 @@ TIMEOUT is nil)." fn oops) (remove-hook 'jsonrpc-event-hook fn))))))) +(defun jsonrpc--limit-buffer-size (max-size) + "Limit the current buffer to MAX-SIZE by eating lines at the beginning. +Do nothing if MAX-SIZE is nil." + (when max-size + (while (> (buffer-size) max-size) + (delete-region + (point-min) + (save-excursion + ;; Remove 1/4, so that the cost is O(1) amortised, since each + ;; call to `delete-region' will move the buffer contents twice. + (goto-char (+ (point-min) (/ (buffer-size) 4))) + (forward-line) + (point)))))) + (defvar jsonrpc-event-hook (list #'jsonrpc--log-event) "Hook run when JSON-RPC events are emitted. This hooks runs in the events buffer of every `jsonrpc-connection' @@ -1071,15 +1085,7 @@ of the API instead.") (when error (setq msg (propertize msg 'face 'error))) (insert-before-markers msg) - ;; Trim the buffer if it's too large - (when max - (save-excursion - (goto-char (point-min)) - (while (> (buffer-size) max) - (delete-region (point) (progn (forward-line 1) - (forward-sexp 1) - (forward-line 2) - (point))))))))))) + (jsonrpc--limit-buffer-size max)))))) (defun jsonrpc--forwarding-buffer (name prefix conn) "Helper for `jsonrpc-process-connection' helpers. @@ -1093,19 +1099,23 @@ PREFIX to CONN's events buffer." (add-hook 'after-change-functions (lambda (beg _end _pre-change-len) - (cl-loop initially (goto-char beg) - do (forward-line) - when (bolp) - for line = (buffer-substring - (line-beginning-position 0) - (line-end-position 0)) - do (with-current-buffer (jsonrpc-events-buffer conn) - (goto-char (point-max)) - (let ((inhibit-read-only t)) - (insert - (propertize (format "%s %s\n" prefix line) - 'face 'shadow)))) - until (eobp))) + (let* ((props (slot-value conn '-events-buffer-config)) + (max (plist-get props :size))) + (unless (eql max 0) + (cl-loop initially (goto-char beg) + do (forward-line) + when (bolp) + for line = (buffer-substring + (line-beginning-position 0) + (line-end-position 0)) + do (with-current-buffer (jsonrpc-events-buffer conn) + (goto-char (point-max)) + (let ((inhibit-read-only t)) + (insert + (propertize (format "%s %s\n" prefix line) + 'face 'shadow)) + (jsonrpc--limit-buffer-size max))) + until (eobp))))) nil t)) (current-buffer))) commit 36c8ebe78a048db7886f070168858d457b486caf Author: Mattias Engdegård Date: Thu Sep 4 11:22:57 2025 +0200 Avoid unnecessary text decoding in jsonrpc for speed (bug#79361) The built-in JSON parser works on undecoded (unibyte) input; decoding received data is just a waste and does take time even when all-ASCII. * lisp/jsonrpc.el (initialize-instance): Use unibyte process buffer and binary coding for process I/O, implying unibyte strings being passed to the filter function. (jsonrpc-connection-send): More efficient message generation. (jsonrpc--json-read): Compatibility code for the old elisp json parser. (jsonrpc--process-filter): Faster header-matching regexp. diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index 6c969120926..bb75196cdc8 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -548,7 +548,9 @@ connection object, called when the process dies.") (set-process-buffer proc (get-buffer-create (format " *%s output*" name))) (set-process-filter proc #'jsonrpc--process-filter) (set-process-sentinel proc #'jsonrpc--process-sentinel) + (set-process-coding-system proc 'binary 'binary) (with-current-buffer (process-buffer proc) + (set-buffer-multibyte nil) (buffer-disable-undo) (set-marker (process-mark proc) (point-min)) (let ((inhibit-read-only t)) @@ -578,16 +580,11 @@ connection object, called when the process dies.") (id 'request) (method 'notification))) (converted (jsonrpc-convert-to-endpoint connection args kind)) - (json (jsonrpc--json-encode converted)) - (headers - `(("Content-Length" . ,(format "%d" (string-bytes json))) - ;; ("Content-Type" . "application/vscode-jsonrpc; charset=utf-8") - ))) + (json (jsonrpc--json-encode converted))) (process-send-string (jsonrpc--process connection) - (cl-loop for (header . value) in headers - concat (concat header ": " value "\r\n") into header-section - finally return (format "%s\r\n%s" header-section json))) + (concat "Content-Length: " (number-to-string (string-bytes json)) "\r\n" + "\r\n" json)) (jsonrpc--event connection 'client @@ -641,11 +638,19 @@ and delete the network process." :false-object :json-false)) (require 'json) (defvar json-object-type) - (declare-function json-read "json" ()) + (declare-function json-read-from-string "json" (string)) (lambda () (let ((json-object-type 'plist)) - (json-read)))) - "Read JSON object in buffer, move point to end of buffer.") + ;; `json-read' can't be used because the old json API requires + ;; decoded input. + (prog1 + (json-read-from-string + (decode-coding-string + (buffer-substring-no-properties (point) (point-max)) + 'utf-8-unix t)) + (goto-char (point-max)))))) + "Read JSON object in (binary unibyte) buffer from point. +Move point to end of buffer.") (defalias 'jsonrpc--json-encode (if (fboundp 'json-serialize) @@ -745,8 +750,11 @@ and delete the network process." ;; (setq expected-bytes (and (search-forward-regexp - "\\(?:.*: .*\r\n\\)*Content-Length: \ -*\\([[:digit:]]+\\)\r\n\\(?:.*: .*\r\n\\)*\r\n" + (rx bol "Content-Length: " (group (+ digit)) + "\r\n" + (* (* (not (in ":\n"))) ": " + (* (not (in "\r\n"))) "\r\n") + "\r\n") (+ (point) 100) t) (string-to-number (match-string 1)))) commit 11b3af64251a899c697b685cf7b311274be8dc6d Author: Mattias Engdegård Date: Sat Sep 6 12:06:28 2025 +0200 Harmonise doc strings for {re-,posix-,}search-{forward,backward} The doc strings for re-search-forward and re-search-backward have been improved (bug#25193, bug#31584) but the corresponding posix- and non-regexp search functions still have the original text, despite describing the exact same mechanism. There is no reason for them to differ, so we make them all use the updated version which also is more readable. Any future doc string improvements should be made to all of them in the same way for consistency. * src/search.c (Fsearch_backward, Fsearch_forward) (Fposix_search_backward, Fposix_search_forward): Use text from Fre_search_forward and Fre_search_backward. diff --git a/src/search.c b/src/search.c index 89bc7e91612..540e27a36dd 100644 --- a/src/search.c +++ b/src/search.c @@ -2206,24 +2206,10 @@ set_search_regs (ptrdiff_t beg_byte, ptrdiff_t nbytes) DEFUN ("search-backward", Fsearch_backward, Ssearch_backward, 1, 4, "MSearch backward: ", doc: /* Search backward from point for STRING. -Set point to the beginning of the occurrence found, and return point. -An optional second argument bounds the search; it is a buffer position. - The match found must not begin before that position. A value of nil - means search to the beginning of the accessible portion of the buffer. -Optional third argument, if t, means if fail just return nil (no error). - If not nil and not t, position at limit of search and return nil. -Optional fourth argument COUNT, if a positive number, means to search - for COUNT successive occurrences. If COUNT is negative, search - forward, instead of backward, for -COUNT occurrences. A value of - nil means the same as 1. -With COUNT positive, the match found is the COUNTth to last one (or - last, if COUNT is 1 or nil) in the buffer located entirely before - the origin of the search; correspondingly with COUNT negative. - -Search case-sensitivity is determined by the value of the variable -`case-fold-search', which see. - -See also the functions `match-beginning', `match-end' and `replace-match'. */) +This function is almost identical to `search-forward', except that +by default it searches backward instead of forward, and the sign of +COUNT also indicates exactly the opposite searching direction. +See `search-forward' for details. */) (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror, Lisp_Object count) { return search_command (string, bound, noerror, count, -1, false, false); @@ -2232,23 +2218,28 @@ See also the functions `match-beginning', `match-end' and `replace-match'. */) DEFUN ("search-forward", Fsearch_forward, Ssearch_forward, 1, 4, "MSearch: ", doc: /* Search forward from point for STRING. Set point to the end of the occurrence found, and return point. -An optional second argument bounds the search; it is a buffer position. - The match found must not end after that position. A value of nil - means search to the end of the accessible portion of the buffer. -Optional third argument, if t, means if fail just return nil (no error). - If not nil and not t, move to limit of search and return nil. -Optional fourth argument COUNT, if a positive number, means to search - for COUNT successive occurrences. If COUNT is negative, search - backward, instead of forward, for -COUNT occurrences. A value of - nil means the same as 1. -With COUNT positive, the match found is the COUNTth one (or first, - if COUNT is 1 or nil) in the buffer located entirely after the - origin of the search; correspondingly with COUNT negative. +The optional second argument BOUND is a buffer position that bounds + the search. The match found must not end after that position. A + value of nil means search to the end of the accessible portion of + the buffer. +The optional third argument NOERROR indicates how errors are handled + when the search fails: if it is nil or omitted, emit an error; if + it is t, simply return nil and do nothing; if it is neither nil nor + t, move to the limit of search and return nil. +The optional fourth argument COUNT is a number that indicates the + search direction and the number of occurrences to search for. If it + is positive, search forward for COUNT successive occurrences; if it + is negative, search backward, instead of forward, for -COUNT + occurrences. A value of nil means the same as 1. +With COUNT positive/negative, the match found is the COUNTth/-COUNTth + one in the buffer located entirely after/before the origin of the + search. Search case-sensitivity is determined by the value of the variable `case-fold-search', which see. -See also the functions `match-beginning', `match-end' and `replace-match'. */) +See also the functions `match-beginning', `match-end', `match-string', +and `replace-match'. */) (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror, Lisp_Object count) { return search_command (string, bound, noerror, count, 1, false, false); @@ -2305,25 +2296,14 @@ DEFUN ("posix-search-backward", Fposix_search_backward, Sposix_search_backward, "sPosix search backward: ", doc: /* Search backward from point for match for REGEXP according to Posix rules. Find the longest match in accord with Posix regular expression rules. -Set point to the beginning of the occurrence found, and return point. -An optional second argument bounds the search; it is a buffer position. - The match found must not begin before that position. A value of nil - means search to the beginning of the accessible portion of the buffer. -Optional third argument, if t, means if fail just return nil (no error). - If not nil and not t, position at limit of search and return nil. -Optional fourth argument COUNT, if a positive number, means to search - for COUNT successive occurrences. If COUNT is negative, search - forward, instead of backward, for -COUNT occurrences. A value of - nil means the same as 1. -With COUNT positive, the match found is the COUNTth to last one (or - last, if COUNT is 1 or nil) in the buffer located entirely before - the origin of the search; correspondingly with COUNT negative. - -Search case-sensitivity is determined by the value of the variable -`case-fold-search', which see. +This function is almost identical to `posix-search-forward', except that +by default it searches backward instead of forward, and the sign of +COUNT also indicates exactly the opposite searching direction. +See `posix-search-forward' for details. -See also the functions `match-beginning', `match-end', `match-string', -and `replace-match'. */) +Note that searching backwards may give a shorter match than expected, +because REGEXP is still matched in the forward direction. See Info +anchor `(elisp) re-search-backward' for details. */) (Lisp_Object regexp, Lisp_Object bound, Lisp_Object noerror, Lisp_Object count) { return search_command (regexp, bound, noerror, count, -1, true, true); @@ -2334,18 +2314,22 @@ DEFUN ("posix-search-forward", Fposix_search_forward, Sposix_search_forward, 1, doc: /* Search forward from point for REGEXP according to Posix rules. Find the longest match in accord with Posix regular expression rules. Set point to the end of the occurrence found, and return point. -An optional second argument bounds the search; it is a buffer position. - The match found must not end after that position. A value of nil - means search to the end of the accessible portion of the buffer. -Optional third argument, if t, means if fail just return nil (no error). - If not nil and not t, move to limit of search and return nil. -Optional fourth argument COUNT, if a positive number, means to search - for COUNT successive occurrences. If COUNT is negative, search - backward, instead of forward, for -COUNT occurrences. A value of - nil means the same as 1. -With COUNT positive, the match found is the COUNTth one (or first, - if COUNT is 1 or nil) in the buffer located entirely after the - origin of the search; correspondingly with COUNT negative. +The optional second argument BOUND is a buffer position that bounds + the search. The match found must not end after that position. A + value of nil means search to the end of the accessible portion of + the buffer. +The optional third argument NOERROR indicates how errors are handled + when the search fails: if it is nil or omitted, emit an error; if + it is t, simply return nil and do nothing; if it is neither nil nor + t, move to the limit of search and return nil. +The optional fourth argument COUNT is a number that indicates the + search direction and the number of occurrences to search for. If it + is positive, search forward for COUNT successive occurrences; if it + is negative, search backward, instead of forward, for -COUNT + occurrences. A value of nil means the same as 1. +With COUNT positive/negative, the match found is the COUNTth/-COUNTth + one in the buffer located entirely after/before the origin of the + search. Search case-sensitivity is determined by the value of the variable `case-fold-search', which see. commit adc9c43306e29340823797ebe4cca1989af68710 Author: Lockywolf Date: Thu Jul 24 21:07:10 2025 +0800 ispell.el: Add 56 tests (bug#79177) * test/lisp/textmodes/ispell-tests/ispell-tests.el: * test/lisp/textmodes/ispell-tests/ispell-aspell-tests.el: * test/lisp/textmodes/ispell-tests/ispell-international-ispell-tests.el: * test/lisp/textmodes/ispell-tests/ispell-hunspell-tests.el: New files. * test/lisp/textmodes/ispell-resources/fake-aspell.bash: Add a mock `aspell' for use in ispell.el test, with old version. * test/lisp/textmodes/ispell-resources/fake-aspell-new.bash: Add a mock `aspell' for use in ispell.el test, with recent version. diff --git a/test/lisp/textmodes/ispell-resources/fake-aspell-new.bash b/test/lisp/textmodes/ispell-resources/fake-aspell-new.bash new file mode 100755 index 00000000000..7dd935bac3c --- /dev/null +++ b/test/lisp/textmodes/ispell-resources/fake-aspell-new.bash @@ -0,0 +1,43 @@ +#!/bin/bash + +vv= + +show_vv() +{ + printf '%s\n' "@(#) International Ispell Version 3.1.20 (but really Aspell 0.60.0)" +} + +imitate_repl() +{ + while true ; do + read a +# printf 'debug="%s"\n' "$a" + if [[ "$a" == '' ]] ; then + printf '' + elif [[ "$a" == 'tarampampamtararam' ]] ; then + printf '# tarampampamtararam 0\n\n' # wrong word + else + printf '*\n\n' + fi + done +} + +show_vv + +while :; do + case $1 in + -vv|-v) + #show_vv # for ispell.el error detection + exit + ;; + -a) # imitate REPL + imitate_repl + ;; + -?*) + printf 'WARN: Unknown option (ignored): %s\n' "$1" >&2 + ;; + *) + break + esac + shift +done diff --git a/test/lisp/textmodes/ispell-resources/fake-aspell.bash b/test/lisp/textmodes/ispell-resources/fake-aspell.bash new file mode 100755 index 00000000000..4406a18a22e --- /dev/null +++ b/test/lisp/textmodes/ispell-resources/fake-aspell.bash @@ -0,0 +1,2 @@ +#!/bin/bash +printf '%s\n' "@(#) International Ispell Version 3.1.20 (but really Aspell 0.59.800)" diff --git a/test/lisp/textmodes/ispell-tests/ispell-aspell-tests.el b/test/lisp/textmodes/ispell-tests/ispell-aspell-tests.el new file mode 100644 index 00000000000..c24d284f426 --- /dev/null +++ b/test/lisp/textmodes/ispell-tests/ispell-aspell-tests.el @@ -0,0 +1,73 @@ +;;; ispell-aspell-tests.el --- Test ispell.el aspell backend. -*- lexical-binding: t; -*- + +;; Copyright (C) 2025 Lockywolf + +;; Author: Lockywolf +;; Keywords: languages, text + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Tests for ispell.el's aspell integration. + +;;; Code: + +(require 'ispell) + +(load (expand-file-name "test/lisp/textmodes/ispell-tests/ispell-tests-common.el" source-directory)) + +(ert-deftest ispell/aspell/ispell-check-version/works () + "Test that aspell is correctly detected." + (skip-unless (and (executable-find "aspell") + (with-temp-buffer + (call-process "aspell" nil t nil "-vv") + (search-backward "but really Aspell")))) + (should (stringp + (let ((test-saved-ispell-program-name ispell-program-name)) + (unwind-protect + (let () + (setq ispell-last-program-name (time-to-seconds)) + (setf ispell-program-name "aspell") + ispell-really-aspell) + (setf ispell-program-name test-saved-ispell-program-name)))))) + +(ert-deftest ispell/aspell/ispell-check-version/version-lowlow () + "Test that aspell is correctly detected." + (skip-unless (progn + (let ((fake-aspell-path (expand-file-name + "./fake-aspell.bash" + tests-ispell-data-directory))) + (chmod fake-aspell-path 504) + (call-process fake-aspell-path nil nil nil)))) + (let ((fake-aspell-path (expand-file-name + "./fake-aspell.bash" + tests-ispell-data-directory))) + (let ((test-saved-ispell-program-name ispell-program-name) + (test-saved-ispell-last-program-name ispell-last-program-name)) + (unwind-protect + (progn + (setq ispell-last-program-name (time-to-seconds)) + (should-error + (progn + (setopt ispell-program-name fake-aspell-path) + (ispell-check-version t))) + ispell-really-aspell) + (set-variable 'ispell-program-name test-saved-ispell-program-name) + (set-variable 'ispell-last-program-name + test-saved-ispell-last-program-name))))) + + +(provide 'tests-ispell-aspell) +;;; tests-ispell-aspell.el ends here diff --git a/test/lisp/textmodes/ispell-tests/ispell-hunspell-tests.el b/test/lisp/textmodes/ispell-tests/ispell-hunspell-tests.el new file mode 100644 index 00000000000..ae3d6e303b3 --- /dev/null +++ b/test/lisp/textmodes/ispell-tests/ispell-hunspell-tests.el @@ -0,0 +1,335 @@ +;;; ispell-hunspell-tests.el --- Test ispell.el Hunspell backend. -*- lexical-binding: t; -*- + +;; Copyright (C) 2025 Lockywolf + +;; Author: Lockywolf +;; Keywords: languages, text + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Tests for ispell.el's cooperation with Hunspell + +;;; Code: + +(require 'ispell) + +(load (expand-file-name "test/lisp/textmodes/ispell-tests/ispell-tests-common.el" source-directory)) +(ert-deftest ispell/hunspell/ispell-word/english/check-only () +"This test checks that Russian spellchecking works for Hunspell." + (skip-unless (executable-find "hunspell")) + (skip-unless (equal + 0 + (call-process "hunspell" nil nil nil "-vv"))) + (skip-unless (equal + 0 + (with-temp-buffer + (insert "привет") + (call-process-region nil nil "hunspell" nil '("*scratch*" t) nil "-d en_US")))) + (with-environment-variables (("HOME" temporary-file-directory)) + (let ((default-directory temporary-file-directory)) + (letopt ((ispell-program-name "hunspell")) + (ignore-errors (ispell-kill-ispell t t)) + (with-temp-buffer + (insert + "hello\n") + (goto-char 0) + (ispell-change-dictionary "en_US") + (let ((ispell-check-only t) + (current-point + (with-current-buffer "*Messages*" + (point)))) + (ispell-word) + (with-current-buffer "*Messages*" + (goto-char (point-max)) + (should (> (search-backward "is correct" nil t) + current-point))) + )) + (with-temp-buffer + (insert + ;; there is no such a word in English, I swear. + "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\n" + ) + (goto-char 0) + (ispell-change-dictionary "en_US") + (let ((ispell-check-only t) + (current-point + (with-current-buffer "*Messages*" + (point)))) + (ispell-word) + (with-current-buffer "*Messages*" + (goto-char (point-max)) + (should (> (search-backward "is incorrect" nil t) + current-point))) + )) + (with-temp-buffer + (insert + ;; giving Hunspell a wrong language should not fail + "привет\n" + ) + (goto-char 0) + (ispell-change-dictionary "en_US") + (let ((ispell-check-only t) + (current-point + (with-current-buffer "*Messages*" + (point)))) + (ispell-word) + (with-current-buffer "*Messages*" + (goto-char (point-max)) + (should (> (search-backward "is incorrect" nil t) + current-point))) + )) + ))) + ) + +(ert-deftest ispell/hunspell/ispell-word/russian/check-only () + "This test checks that Russian spellchecking works Hunspell. +With UTF-8." + (skip-unless (executable-find "hunspell")) + (skip-unless (equal + 0 + (call-process "hunspell" nil nil nil "-vv"))) + (skip-unless (equal + 0 + (let ((retval (with-temp-buffer + (insert "привет") + (call-process-region nil nil "hunspell" nil '("*scratch*" t) nil "-d" "ru_RU")))) + (message "lwf:hunspell-test-call=%s" retval) + retval ))) + (with-environment-variables (("HOME" temporary-file-directory)) + (let ((default-directory temporary-file-directory)) + (letopt ((ispell-program-name "hunspell")) + (ignore-errors (ispell-kill-ispell t t)) + (with-temp-buffer + (insert + "привет\n") + (goto-char 0) + (ispell-change-dictionary "ru_RU") + (let ((ispell-check-only t) + (current-point + (with-current-buffer "*Messages*" + (point)))) + (ispell-word) + (with-current-buffer "*Messages*" + (goto-char (point-max)) + (should (> (search-backward "is correct" nil t) + current-point))) + )) + (with-temp-buffer + (insert + ;; there is no such a word in Russian, I swear. + "ыфаывфафыввпфывафывафывафывавы\n" + ) + (goto-char 0) + (ispell-change-dictionary "ru_RU") + (let ((ispell-check-only t) + (current-point + (with-current-buffer "*Messages*" + (point)))) + (ispell-word) + (with-current-buffer "*Messages*" + (goto-char (point-max)) + (should (> (search-backward "is incorrect" nil t) + current-point))) + )) + ))) + ) + +(ert-deftest ispell/hunspell/ispell-word/language-switch/check-only () + "This test checks that Russian spellchecking works Hunspell." + (skip-unless (executable-find "hunspell")) + (skip-unless (equal + 0 + (call-process "hunspell" nil nil nil "-vv"))) + (skip-unless (equal + 0 + (with-temp-buffer + (insert "привет") + (call-process-region nil nil "hunspell" nil '("*scratch*" t) nil "-d" "ru_RU")))) + (with-environment-variables (("HOME" temporary-file-directory)) + (let ((default-directory temporary-file-directory)) + (letopt ((ispell-program-name "hunspell")) + (ignore-errors (ispell-kill-ispell t t)) + (with-temp-buffer + (insert + "привет\n") + (goto-char 0) + (ispell-change-dictionary "ru_RU") + (let ((ispell-check-only t) + (current-point + (with-current-buffer "*Messages*" + (point)))) + (ispell-word) + (with-current-buffer "*Messages*" + (goto-char (point-max)) + (should (> (search-backward "is correct" nil t) + current-point))) + ) + (goto-char (buffer-end 1)) + (insert + ;; there is no such a word in Russian, I swear. + "\nыфаывфафыввпфывафывафывафывавы\n" + ) + (forward-line -1) + (let ((ispell-check-only t) + (current-point + (with-current-buffer "*Messages*" + (point)))) + (ispell-word) + (with-current-buffer "*Messages*" + (goto-char (point-max)) + (should (> (search-backward "is incorrect" nil t) + current-point))) + ) + (goto-char (buffer-end 1)) + (ispell-change-dictionary "en_US") + (insert + "\nhello\n" + ) + (forward-line -1) + (let ((ispell-check-only t) + (current-point + (with-current-buffer "*Messages*" + (point)))) + (ispell-word) + (with-current-buffer "*Messages*" + (goto-char (point-max)) + (should (> (search-backward "is correct" nil t) + current-point))) + ) + )))) +) + +(ert-deftest ispell/hunspell/ispell-word/russian/check-only/wrong-language () + "If we give Russian-checking Hunspell an english word, it should. +Still process it gracefully. It will not say correct/incorrect, but. +It should at least not crash or something." + (skip-unless (executable-find "hunspell")) + (skip-unless (equal + 0 + (call-process "hunspell" nil nil nil "-vv"))) + (skip-unless (equal + 0 + (with-temp-buffer + (insert "привет") + (call-process-region nil nil "hunspell" nil '("*scratch*" t) nil "-d" "ru_RU")))) + (with-environment-variables (("HOME" temporary-file-directory)) + (let ((default-directory temporary-file-directory)) + (letopt ((ispell-program-name "hunspell")) + (ignore-errors (ispell-kill-ispell t t)) + (with-temp-buffer + (insert + "hello\n") + (goto-char 0) + (ispell-change-dictionary "ru_RU") + (let ((ispell-check-only t)) + ;; should not fail + (ispell-word)) + (insert "\nпривет\n") + (forward-line -1) + (let ((ispell-check-only t) + (current-point + (with-current-buffer "*Messages*" + (point)))) + (ispell-word) + (with-current-buffer "*Messages*" + (goto-char (point-max)) + (should (> (search-backward "is correct" nil t) + current-point))) + ))))) +) + +(ert-deftest ispell/hunspell/ispell-word/multilang () + "Hunspell is able to check two languages at once." + (skip-unless (executable-find "hunspell")) + (skip-unless (equal + 0 + (call-process "hunspell" nil nil nil "-vv"))) + (skip-unless (equal + 0 + (with-temp-buffer + (insert "привет") + (call-process-region nil nil "hunspell" nil '("*scratch*" t) nil "-d" "ru_RU")))) + (skip-unless (equal + 0 + (with-temp-buffer + (insert "привет") + (call-process-region nil nil "hunspell" nil '("*scratch*" t) nil "-d" "en_US")))) + (with-environment-variables (("HOME" temporary-file-directory)) + (let ((default-directory temporary-file-directory) + (multidict "en_US,ru_RU")) + (letopt ((ispell-program-name "hunspell")) + (ignore-errors (ispell-kill-ispell t t)) + (ispell-hunspell-add-multi-dic multidict) + (with-temp-buffer + (insert + "hello\n") + (goto-char 0) + (ispell-change-dictionary multidict) + (insert "\nпривет\n") + (forward-line -1) + (let ((ispell-check-only t) + (current-point + (with-current-buffer "*Messages*" + (point)))) + (ispell-word) + (with-current-buffer "*Messages*" + (goto-char (point-max)) + (should (> (search-backward "is correct" nil t) + current-point))) + ) + (insert "\nhello\n") + (forward-line -1) + (let ((ispell-check-only t) + (current-point + (with-current-buffer "*Messages*" + (point)))) + (ispell-word) + (with-current-buffer "*Messages*" + (goto-char (point-max)) + (should (> (search-backward "is correct" nil t) + current-point))) + ) + (insert "\nывафываываыфвавыафывавыфафывафываыва\n") + (forward-line -1) + (let ((ispell-check-only t) + (current-point + (with-current-buffer "*Messages*" + (point)))) + (ispell-word) + (with-current-buffer "*Messages*" + (goto-char (point-max)) + (should (> (search-backward "is incorrect" nil t) + current-point))) + ) + (insert "\nhelooooooooo\n") + (forward-line -1) + (let ((ispell-check-only t) + (current-point + (with-current-buffer "*Messages*" + (point)))) + (ispell-word) + (with-current-buffer "*Messages*" + (goto-char (point-max)) + (should (> (search-backward "is incorrect" nil t) + current-point))) + ) + )))) +) + + + +(provide 'ispell-hunspell-tests) +;;; ispell-hunspell-tests.el ends here diff --git a/test/lisp/textmodes/ispell-tests/ispell-international-ispell-tests.el b/test/lisp/textmodes/ispell-tests/ispell-international-ispell-tests.el new file mode 100644 index 00000000000..f232f26d10d --- /dev/null +++ b/test/lisp/textmodes/ispell-tests/ispell-international-ispell-tests.el @@ -0,0 +1,259 @@ +;;; ispell-international-ispell-tests.el --- Test ispell.el International Ispell backend. -*- lexical-binding: t; -*- + +;; Copyright (C) 2025 Lockywolf + +;; Author: Lockywolf +;; Keywords: languages, text + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Tests for ispell.el's cooperation with International Ispell. + +;;; Code: + +(require 'ispell) + +(load (expand-file-name "test/lisp/textmodes/ispell-tests/ispell-tests-common.el" source-directory)) + +(ert-deftest ispell/international-ispell/ispell-word/russian/check-only () +"This test checks that Russian spellchecking works for. +International Ispell with UTF-8." + (skip-unless (executable-find "ispell")) + (skip-unless (equal + 0 + (call-process "ispell" nil nil nil "-vv"))) + (skip-unless (string-equal + " +* + +привет +" + (with-temp-buffer + (insert "привет\n") + (forward-line -1) + (call-process-region nil nil "ispell" nil t nil "-a" "-d" "russian") + (goto-char 0) + (kill-line) + (buffer-string)))) + (with-environment-variables (("HOME" temporary-file-directory)) + (let ((default-directory temporary-file-directory)) + (letopt ((ispell-program-name "ispell") + (ispell-local-dictionary-alist + '(( + "russian" + "[A-Za-zабвгдеёжзиклмнопрстуфхцчшщъыьэюяАБВГДЕЁЖЗИКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ]" + "[^A-Za-zабвгдеёжзиклмнопрстуфхцчшщъыьэюяАБВГДЕЁЖЗИКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ]" + "" + nil + nil + nil + nil + )))) + (ignore-errors (ispell-kill-ispell t t)) + (with-temp-buffer + (insert + "привет\n") + (goto-char 0) + (ispell-change-dictionary "russian") + (let ((ispell-check-only t) + (current-point + (with-current-buffer "*Messages*" + (point)))) + (ispell-word) + (with-current-buffer "*Messages*" + (goto-char (point-max)) + (should (> (search-backward "is correct" nil t) + current-point))) + )) + (with-temp-buffer + (insert + "ёлка\n") + (goto-char 0) + (ispell-change-dictionary "russian") + (let ((ispell-check-only t) + (current-point + (with-current-buffer "*Messages*" + (point)))) + (ispell-word) + (with-current-buffer "*Messages*" + (goto-char (point-max)) + (should (> (search-backward "is correct" nil t) + current-point))) + )) + (with-temp-buffer + (insert + ;; there is no such a word in Russian, I swear. + "ыфаывфафыввпфывафывафывафывавы\n" + ) + (goto-char 0) + (ispell-change-dictionary "russian") + (let ((ispell-check-only t) + (current-point + (with-current-buffer "*Messages*" + (point)))) + (ispell-word) + (with-current-buffer "*Messages*" + (goto-char (point-max)) + (should (> (search-backward "is incorrect" nil t) + current-point))) + )) + ))) + ) + +(ert-deftest ispell/international-ispell/ispell-word/language-switch/check-only () + "This test checks that Russian spellchecking works for + International Ispell with UTF-8." + (skip-unless (executable-find "ispell")) + (skip-unless (equal + 0 + (call-process "ispell" nil nil nil "-vv"))) + (skip-unless (string-equal + " +* + +привет +" + (with-temp-buffer + (insert "привет\n") + (forward-line -1) + (call-process-region nil nil "ispell" nil t nil "-a" "-d" "russian") + (goto-char 0) + (kill-line) + (buffer-string)))) + (with-environment-variables (("HOME" temporary-file-directory)) + (let ((default-directory temporary-file-directory)) + (letopt ((ispell-program-name "ispell") + (ispell-local-dictionary-alist + '(( + "russian" + "[A-Za-zабвгдеёжзиклмнопрстуфхцчшщъыьэюяАБВГДЕЁЖЗИКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ]" + "[^A-Za-zабвгдеёжзиклмнопрстуфхцчшщъыьэюяАБВГДЕЁЖЗИКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ]" + "" + nil + nil + nil + nil + )))) + (ignore-errors (ispell-kill-ispell t t)) + (with-temp-buffer + (insert + "привет\n") + (goto-char 0) + (ispell-change-dictionary "russian") + (let ((ispell-check-only t) + (current-point + (with-current-buffer "*Messages*" + (point)))) + (ispell-word) + (with-current-buffer "*Messages*" + (goto-char (point-max)) + (should (> (search-backward "is correct" nil t) + current-point))) + ) + (goto-char (buffer-end 1)) + (insert + ;; there is no such a word in Russian, I swear. + "\nыфаывфафыввпфывафывафывафывавы\n" + ) + (forward-line -1) + (let ((ispell-check-only t) + (current-point + (with-current-buffer "*Messages*" + (point)))) + (ispell-word) + (with-current-buffer "*Messages*" + (goto-char (point-max)) + (should (> (search-backward "is incorrect" nil t) + current-point))) + ) + (goto-char (buffer-end 1)) + (ispell-change-dictionary "english") + (insert + "\nhello\n" + ) + (forward-line -1) + (let ((ispell-check-only t) + (current-point + (with-current-buffer "*Messages*" + (point)))) + (ispell-word) + (with-current-buffer "*Messages*" + (goto-char (point-max)) + (should (> (search-backward "is correct" nil t) + current-point))) + ) + )))) +) + +(ert-deftest ispell/international-ispell/ispell-word/russian/check-only/wrong-language () +"If we give Russian-checking Ispell an english word, it should. +Still process it gracefully. It will not say correct/incorrect, but +it should at least not crash or something." + (skip-unless (executable-find "ispell")) + (skip-unless (equal + 0 + (call-process "ispell" nil nil nil "-vv"))) + (skip-unless (string-equal + " +* + +привет +" + (with-temp-buffer + (insert "привет\n") + (forward-line -1) + (call-process-region nil nil "ispell" nil t nil "-a" "-d" "russian") + (goto-char 0) + (kill-line) + (buffer-string)))) + (with-environment-variables (("HOME" temporary-file-directory)) + (let ((default-directory temporary-file-directory)) + (letopt ((ispell-program-name "ispell") + (ispell-local-dictionary-alist + '(( + "russian" + "[A-Za-zабвгдеёжзиклмнопрстуфхцчшщъыьэюяАБВГДЕЁЖЗИКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ]" + "[^A-Za-zабвгдеёжзиклмнопрстуфхцчшщъыьэюяАБВГДЕЁЖЗИКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ]" + "" + nil + nil + nil + nil + )))) + (ignore-errors (ispell-kill-ispell t t)) + (with-temp-buffer + (insert + "hello\n") + (goto-char 0) + (ispell-change-dictionary "russian") + (let ((ispell-check-only t)) + (ispell-word)) + (insert "\nпривет\n") + (forward-line -1) + (let ((ispell-check-only t) + (current-point + (with-current-buffer "*Messages*" + (point)))) + (ispell-word) + (with-current-buffer "*Messages*" + (goto-char (point-max)) + (should (> (search-backward "is correct" nil t) + current-point))) + ))))) +) + +(provide 'ispell-international-ispell-tests) +;;; ispell-international-ispell-tests.el ends here diff --git a/test/lisp/textmodes/ispell-tests/ispell-tests-common.el b/test/lisp/textmodes/ispell-tests/ispell-tests-common.el new file mode 100644 index 00000000000..a6c4f1247ee --- /dev/null +++ b/test/lisp/textmodes/ispell-tests/ispell-tests-common.el @@ -0,0 +1,36 @@ +;;; common.el --- -*- lexical-binding: t; -*- + +(defvar tests-ispell-data-directory + (expand-file-name "test/lisp/textmodes/ispell-resources/" source-directory)) + +(let* ((backend-binaries (list "ispell" "aspell" "hunspell" "enchant-2")) + (filter-binaries (lambda () + (seq-filter + #'executable-find + backend-binaries)))) + + (defun ispell-tests--some-backend-available-p () + (not + (null (funcall filter-binaries)))) + + (defun ispell-tests--some-backend () + (car (funcall filter-binaries)))) + +(cl-defmacro letopt (bindings &body body) + (declare (indent 1)) + (let* ((binding-var (lambda (binding) (car binding))) + (binding-val (lambda (binding) (cadr binding))) + (make-setopt (lambda (a b) + (list 'setopt a b))) + (vars (seq-map binding-var bindings)) + (values (seq-map binding-val bindings)) + (temp-vars (seq-map #'gensym vars)) + (savebindings (seq-mapn #'list temp-vars vars)) + (tempbindings (seq-mapn make-setopt vars values)) + (restorebindings (seq-mapn make-setopt vars temp-vars))) + `(let ,savebindings + (unwind-protect (progn ,@tempbindings + ,@body) + ,@(reverse restorebindings))))) + +(provide 'ispell-tests-common) diff --git a/test/lisp/textmodes/ispell-tests/ispell-tests.el b/test/lisp/textmodes/ispell-tests/ispell-tests.el new file mode 100644 index 00000000000..9e675443986 --- /dev/null +++ b/test/lisp/textmodes/ispell-tests/ispell-tests.el @@ -0,0 +1,1031 @@ +;;; tests-ispell.el --- Test ispell.el. -*- lexical-binding: t; -*- + +;; Copyright (C) 2025 Lockywolf + +;; Author: Lockywolf +;; Keywords: languages, text + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Tests for ispell.el. + +;;; Code: + +(require 'ispell) +(load (expand-file-name "test/lisp/textmodes/ispell-tests/ispell-tests-common.el" source-directory)) + + +(defun warnings-buffer-exists-p () + "Check if a buffer named \"*Warnings*\" exists." + (if (get-buffer "*Warnings*") + t + nil)) + +(ert-deftest ispell/ispell-program-name/nil () + "Sanity check. Setting a non-string should produce a warning. +Give ispell-program-name a wrong type." + (should (unwind-protect + (progn + (setq ispell-program-name "ispell") + (when (warnings-buffer-exists-p) + (kill-buffer "*Warnings*")) + (setopt ispell-program-name nil) + (if (warnings-buffer-exists-p) + t + nil)) + (when (warnings-buffer-exists-p) + (kill-buffer "*Warnings*"))))) + +(ert-deftest ispell/ispell-program-name/noncommand () + "Sanity check. Should error or at least warn. +Give ispell-program-name a meaningless string." + :expected-result :failed + (should-error + (setopt ispell-program-name "6c628ac4-63a0-11f0-b37c-e38fc166e3fc") ;; random ispellnonexistent name + )) + +(ert-deftest ispell/ispell-program-name/noncommand/interactive () + "Sanity check. Should error or at least warn. +Give ispell-program-name a meaningless string." + (should-error + (progn + (setopt ispell-program-name "6c628ac4-63a0-11f0-b37c-e38fc166e3fc") ;; random ispellnonexistent name + (ispell-check-version) + ))) + +(ert-deftest ispell/ispell-program-name/non-executable () + "Sanity check. Should error or at least warn. +Give ispell-program-name a path to a non-executable. +I personally think that this should always fail, but +at the moment only an interactive call fails." + :expected-result :failed + (should-error + (progn + (setopt ispell-program-name null-device)))) + +(ert-deftest ispell/ispell-program-name/non-executable/interactive () + "Sanity check. Should error or at least warn. +Give ispell-program-name a path to a non-executable." + (should-error + (progn + (setopt ispell-program-name null-device) + (ispell-check-version t)))) + +(ert-deftest ispell/ispell-program-name/non-spellchecker () + "Sanity check. Give ispell-program-name a path to a non-spellchecker. +Fails because for non-interactive runs, `ispell-check-version' does +not actually err." + :expected-result :failed + (skip-unless (executable-find "etags")) + (should-error (string-equal "etags" (setopt ispell-ispell-program "etags")))) + +(ert-deftest ispell/ispell-program-name/non-spellchecker/interactive () + "Sanity check. Give ispell-program-name a path to a non-spellchecker." + (skip-unless (executable-find "etags")) + (should-error + (progn (setopt ispell-ispell-program "etags") + (ispell-check-version t)) + )) + +(ert-deftest ispell/ispell-program-name/ispell () + "Sanity check. If at least some ispell is available, should pass. +Give ispell-program-name a real spellchecker" + (skip-unless (and (executable-find "ispell") + (with-temp-buffer + (call-process "ispell" nil t nil "-vv") + (search-backward "Ispell")))) + ;; should not throw + (should (string-equal "ispell" (setopt ispell-ispell-program "ispell")))) + +(ert-deftest ispell/ispell-with-safe-default-directory/bad () + "Try doing something with a bad default directory." + (should (with-temp-buffer + (let ((default-directory "c296752a-7d7b-4769-a2d4-4bfd96c7ca71")) + (ispell-with-safe-default-directory + (equal default-directory (expand-file-name "~/"))))))) + +(ert-deftest ispell/ispell-with-safe-default-directory/good () + "Try doing something with a bad default directory." + (should (with-temp-buffer + (let ((default-directory temporary-file-directory)) + (ispell-with-safe-default-directory + (equal default-directory temporary-file-directory)))))) + +(ert-deftest ispell/ispell-call-process/simple () + "Check that ispell-call-process works. +This test fails, because HOME is not defined. +This should not be the case, because ispell-call-process +whould be making sure that the directory for running +the backend's process exists." + :expected-result :failed + (should + (with-temp-buffer + (let ((default-directory "86e44985-cfba-43ba-98dc-73be46addbc2")) + (ispell-call-process "emacs" nil t nil '("--batch" "-Q" "--eval" "(progn (message default-directory) (kill-emacs))")) + (search-backward (expand-file-name "~")))))) + +(ert-deftest ispell/ispell-call-process/simple-writable () + "Check that ispell-call-process works." + (should + (with-temp-buffer + (let ((default-directory temporary-file-directory)) + (ispell-call-process "emacs" nil t nil "--batch" "-Q" "--eval" "(message default-directory)") + (search-backward (directory-file-name temporary-file-directory)))))) + +(ert-deftest ispell/ispell-call-process-region/cat-empty () + "Check ispell-call-process-region works with unrelated process. +This test is expected to fail, because at the moment, there is +a construction (let ((default-directory default-directory))...) in +the `ispell-with-safe-default-directory' function, which effectively +makes it useless." + :expected-result :failed + (should + (with-temp-buffer + (let* ((string-to-send "") + (dir (concat temporary-file-directory + "86e44985-cfba-43ba-98dc-73be46addbc2"))) + (make-directory dir t) + (chmod dir 000) + (let ((default-directory dir)) + ;; (ispell-call-process-region string-to-send nil "cat" nil t nil) + (ispell-call-process-region "emacs" nil t nil "--batch" "-Q" "--eval" "(progn (setq this-read (ignore-errors (read-from-minibuffer \"\"))) (message \"%s\" this-read))") + ;; emacs --batch --eval '(progn (setq this-read (ignore-errors (read-from-minibuffer ""))) (message "%s" this-read))' + (equal (buffer-string) string-to-send)))))) + +(ert-deftest ispell/ispell-call-process-region/cat-random () + "Check ispell-call-process-region works with unrelad process. +This test is expected to fail, because at the moment, there is +a construction (let ((default-directory default-directory))...) in +the `ispell-with-safe-default-directory' function, which effectively +makes it useless." + :expected-result :failed + (should + (with-temp-buffer + (let ((string-to-send (format "%s" (random))) + (default-directory "86e44985-cfba-43ba-98dc-73be46addbc2")) + (ispell-call-process-region "emacs" nil t nil "--batch" "-Q" "--eval" "(progn (setq this-read (ignore-errors (read-from-minibuffer \"\"))) (message \"%s\" this-read))") + (equal (buffer-string) string-to-send))))) + +(ert-deftest ispell/ispell-create-debug-buffer () + "Make sure that debug buffer creation works." + (when (bufferp (get-buffer "*ispell-debug*")) + (with-current-buffer "*ispell-debug*" + (rename-buffer "*ispell-debug*-test"))) + (unwind-protect + (progn + (ispell-create-debug-buffer) + (should (bufferp (get-buffer "*ispell-debug*"))) + (kill-buffer "*ispell-debug*") ;; should not error + ) + (when (bufferp (get-buffer "*ispell-debug*-test")) + (with-current-buffer "*ispell-debug*-test" + (rename-buffer "*ispell-debug*")))) + ) + +;; FIXME: this test should probably go into a separate file, dedicated +;; to the hunspell backend, but so far there is not partition between +;; backends, so let us add it here. It is easy to move it. +(ert-deftest ispell/ispell-valid-dictionary-list/hunspell/no-library-directory () + "If hunspell, `ispell-valid-dictionary-list' returns default. +This function only works for aspell and ispell, for hunspell and +enchant-2 it always returns either default or everything. +I think this is an issue in itself, but this test is added to verify +that changes to third-party code do not break existing behaviour." + (skip-unless (executable-find "hunspell")) + (skip-unless (equal 0 (call-process "hunspell" nil nil nil))) + (let ((old-ispell ispell-program-name) + (old-library-directory ispell-library-directory)) + (unwind-protect + (progn + (setopt ispell-program-name "hunspell") + (setopt ispell-library-directory nil) + (ispell-check-version t) + (should + (equal + (sort (ispell-valid-dictionary-list) 'string<) + (sort (cl-substitute "default" nil (mapcar #'car ispell-dictionary-alist)) 'string<)))) + (setopt ispell-library-directory old-library-directory) + (setopt ispell-program-name old-ispell))) + ) + +;; FIXME: this test should probably go into a separate file, dedicated +;; to the hunspell backend, but so far there is not partition between +;; backends, so let us add it here. It is easy to move it. +(ert-deftest ispell/ispell-valid-dictionary-list/hunspell/library-directory () + "If hunspell, `ispell-valid-dictionary-list' returns default. +This function only works for aspell and ispell, for hunspell and +enchant-2 it always returns either default or everything. +I think this is an issue in itself, but this test is added to verify +that changes to third-party code do not break existing behaviour." + (skip-unless (executable-find "hunspell")) + (skip-unless (equal 0 (call-process "hunspell" nil nil nil))) + (let ((old-ispell ispell-program-name) + (old-library-directory ispell-library-directory)) + (unwind-protect + (progn + (setopt ispell-program-name "hunspell") + (ispell-check-version t) + (setopt ispell-library-directory temporary-file-directory) + (should + (equal + (ispell-valid-dictionary-list) + '("default")))) + (setopt ispell-library-directory old-library-directory) + (setopt ispell-program-name old-ispell))) + ) + +;; FIXME: this test should probably go into a separate file, dedicated +;; to the enchant-2 backend, but so far there is not partition between +;; backends, so let us add it here. It is easy to move it. +(ert-deftest ispell/ispell-valid-dictionary-list/enchant-2/no-library-directory () + "If enchant-2, `ispell-valid-dictionary-list' returns default. +This function only works for aspell and ispell, for hunspell and +enchant-2 it always returns either default or everything. +I think this is an issue in itself, but this test is added to verify +that changes to third-party code do not break existing behaviour." + (skip-unless (executable-find "enchant-2")) + (let ((old-ispell ispell-program-name) + (old-library-directory ispell-library-directory)) + (unwind-protect + (progn + (setopt ispell-program-name "enchant-2") + (setopt ispell-library-directory nil) + (ispell-check-version t) + (should + (equal + (sort (ispell-valid-dictionary-list) 'string<) + (sort (cl-substitute "default" nil (mapcar #'car ispell-dictionary-alist)) 'string<)))) + (setopt ispell-library-directory old-library-directory) + (setopt ispell-program-name old-ispell))) + ) + +;; FIXME: this test should probably go into a separate file, dedicated +;; to the enchant-2 backend, but so far there is not partition between +;; backends, so let us add it here. It is easy to move it. +(ert-deftest ispell/ispell-valid-dictionary-list/enchant-2/library-directory () + "If enchant-2, `ispell-valid-dictionary-list' returns default. +This function only works for aspell and ispell, for hunspell and +enchant-2 it always returns either default or everything. +I think this is an issue in itself, but this test is added to verify +that changes to third-party code do not break existing behaviour." + (skip-unless (executable-find "enchant-2")) + (let ((old-ispell ispell-program-name) + (old-library-directory ispell-library-directory)) + (unwind-protect + (progn + (setopt ispell-program-name "enchant-2") + (setopt ispell-library-directory temporary-file-directory) + (ispell-check-version t) + (should + (equal + (ispell-valid-dictionary-list) + '("default")))) + (setopt ispell-library-directory old-library-directory) + (setopt ispell-program-name old-ispell))) + ) + +(ert-deftest ispell/ispell-valid-dictionary-list/international-ispell () + "Check that ispell-valid-dictionary-list does something useful for ispell. +For ispell, `ispell-valid-dictionary-list' checks that a corresponding +file is present in `ispell-library-directory'." + (skip-unless (executable-find "ispell")) + (skip-unless (let ((libdir (with-temp-buffer + (call-process "ispell" nil t nil "-vv") + (goto-char (point-min)) + (when (re-search-forward + "LIBDIR *= *\"\\([^\"]+\\)\"" nil t) + (match-string 1))))) + (file-readable-p (expand-file-name "english.hash" libdir)))) + (let ((old-ispell ispell-program-name) + (old-library-directory ispell-library-directory) + (old-ispell-local-dictionary-alist ispell-local-dictionary-alist)) + (unwind-protect + (progn + (setopt ispell-program-name "ispell") ;; this should set ispell-library-directory + (ispell-check-version t) ;; sets ispell-library-directory + (should (not (null ispell-library-directory))) + ;; english is always shipped with international ispell, + ;; other languages not necessarily + (setopt ispell-local-dictionary-alist + '(("english" "[A-Za-z]" "[^A-Za-z]" "[']" nil ("-B") nil utf-8))) + (should (member "english" (ispell-valid-dictionary-list))) + (should (member "default" (ispell-valid-dictionary-list))) + ) + (setopt ispell-library-directory old-library-directory) + (setopt ispell-program-name old-ispell) + (setopt ispell-local-dictionary-alist old-ispell-local-dictionary-alist)))) + +(ert-deftest ispell/ispell-valid-dictionary-list/aspell () + "Check that ispell-valid-dictionary-list does something useful for aspell. +For aspell, `ispell-valid-dictionary-list' computes an intersection of +`ispell-dictionary-alist' and `ispell--aspell-found-dictionaries'." + (skip-unless (executable-find "aspell")) + (skip-unless (with-temp-buffer + (call-process "aspell" nil t nil "dicts") + (> (length (buffer-string)) 2))) + (let ((old-ispell ispell-program-name) + (old-library-directory ispell-library-directory) + (old-ispell-local-dictionary-alist ispell-local-dictionary-alist) + (old-ispell-dictionary-alist ispell-dictionary-alist)) + (unwind-protect + (progn + (setopt ispell-program-name "aspell") ;; this should set ispell-library-directory + (ispell-check-version t) ;; sets ispell-library-directory + ;; english is always shipped with international ispell, + ;; other languages not necessarily + (setopt ispell-local-dictionary-alist + '(("english" "[A-Za-z]" "[^A-Za-z]" "[']" nil ("-B") nil utf-8))) + (should + (> (length (ispell-valid-dictionary-list)) + (length ispell--aspell-found-dictionaries)))) + (setopt ispell-library-directory old-library-directory) + (setopt ispell-dictionary-alist old-ispell-dictionary-alist) + (setopt ispell-program-name old-ispell) + (setopt ispell-local-dictionary-alist old-ispell-local-dictionary-alist)))) + +;; Adding file-local words into the file. (They are _not_ sent to the +;; backend in this function.) + +(ert-deftest ispell/ispell-add-per-file-word-list/simple () + "Adding a per-file word to an empty buffer. No comment +syntax expected." + (with-temp-buffer + (let ((testword (format "%s" (random)))) + (ispell-add-per-file-word-list testword) + (should (equal (buffer-string) + (concat " +" ispell-words-keyword " " testword " +")))))) + +(ert-deftest ispell/ispell-add-per-file-word-list/comments () + "Adding a per-file word to an empty buffer. Uses default +emacs-lisp comment syntax." + (with-temp-buffer + (let ((testword (format "%s" (random)))) + (emacs-lisp-mode) + (ispell-add-per-file-word-list testword) + (should (equal (buffer-string) + (concat " +; " ispell-words-keyword " " testword " +")))))) + +(ert-deftest ispell/ispell-add-per-file-word-list/nxml () + "Adding a per-file word to an empty buffer. Uses default +xml comment syntax, which has an opening and a closing +marker." + (with-temp-buffer + (let ((testword (format "%s" (random)))) + (nxml-mode) + (ispell-add-per-file-word-list testword) + (should (equal (buffer-string) + (concat " + +")))))) + +(ert-deftest ispell/ispell-add-per-file-word-list/keyword-there-space () + "Adding a per-file word to buffer with keyword. Uses default +xml comment syntax, which has an opening and a closing +marker. " + (with-temp-buffer + (let ((testword (format "%s" (random)))) + (nxml-mode) + (insert " + +") + (ispell-add-per-file-word-list testword) + (should (equal (buffer-string) + (concat " + +")))))) + +(ert-deftest ispell/ispell-add-per-file-word-list/longline () + "Adding a per-file word to buffer with keyword. Uses default +xml comment syntax, which has an opening and a closing +marker. +This test fails, because ispell.el does not work well with +nXML comments." + :expected-result :failed + (letopt ((ispell-program-name "ispell")) + (with-temp-buffer + (let* ((testword (format "%s" (random))) + (fill-column 50)) + (nxml-mode) + (insert " + +") + (ispell-add-per-file-word-list testword) + (should (equal (buffer-string) + (concat " + +" +" + +"))))))) + +;; Adding file-local words from the file's cellar into the backend +;; (@-prefixed, see *man ispell*). (They _are_ sent to the backend in +;; this function.) + +(ert-deftest ispell/ispell-buffer-local-words/ispell-words-keyword () + "Send some words prefixed by @ from the file's cellar to backend. +Should pass regardless of the backend and the dictionary, because +presumably nobody will have `hellooooooo' in their dictionary." + (skip-unless (ispell-tests--some-backend-available-p)) + (letopt ((ispell-program-name (ispell-tests--some-backend))) + (with-temp-buffer + (nxml-mode) + (ignore-errors (ispell-kill-ispell)) + (with-environment-variables (("HOME" temporary-file-directory)) + (ispell-init-process) + (let ((test-output (ispell--run-on-word "hellooooooo"))) + (should (listp test-output)) + (should-not (equal t test-output))) + (ispell-add-per-file-word-list "hellooooooo") + (ispell-buffer-local-words) + (should (equal t (ispell--run-on-word "hellooooooo"))))))) + + +(ert-deftest + ispell/ispell-buffer-local-words/ispell-buffer-session-localwords () + "Send some words prefixed by @ from the file's cellar to backend. +Should pass regardless of the backend and the dictionary, because +presumably nobody will have `hellooooooo' in their dictionary." + (skip-unless (ispell-tests--some-backend-available-p)) + (letopt ((ispell-program-name (ispell-tests--some-backend))) + (cd temporary-file-directory) + (with-temp-buffer + (nxml-mode) + (ignore-errors (ispell-kill-ispell)) + (with-environment-variables (("HOME" temporary-file-directory)) + (ispell-init-process) + (let ((test-output (ispell--run-on-word "hellooooooo"))) + (should (listp test-output)) + (should-not (equal t test-output))) + (let ((ispell-buffer-session-localwords (list "hellooooooo"))) + (ispell-buffer-local-words) + (should (equal t (ispell--run-on-word "hellooooooo")))))))) + +(ert-deftest ispell/ispell-init-process/works-nohome () + "Simple test to check that ispell-init-process works." + :expected-result :failed + (skip-unless (ispell-tests--some-backend-available-p)) + (letopt ((ispell-program-name (ispell-tests--some-backend))) + (with-temp-buffer + (ispell-init-process)))) + +(ert-deftest ispell/ispell-init-process/works-withhome () + "Simple test to check that ispell-init-process works." + (skip-unless (ispell-tests--some-backend-available-p)) + (letopt ((ispell-program-name (ispell-tests--some-backend))) + (with-temp-buffer + (with-environment-variables (("HOME" temporary-file-directory)) + (ispell-init-process))))) + +;; Some more tests for buffer-local stuff. +;; `ispell-buffer-local-dict' +(let ((possible-pdict-paths (list "/tmp/lispellnonexistent.txt" + "Q:\\ispellnonexistent\\ispellnonexistent.pdict" + "https://example.text" + "(my-favourite-function)" + (format "%s" (random)) + (expand-file-name + (format "%s" (random)) + temporary-file-directory)))) + (ert-deftest ispell/ispell-buffer-local-dict/no-reload+no-overriden () + "ispell.el can recognise keyword-defined dictionary and keyword-defined +personal-dictionary." + (with-temp-buffer + (nxml-mode) + (let ((test-dict "ispellnonexistent")) + (seq-map (lambda (test-pdict) + (insert + "hello\n\n\n" + "" + "") + (ispell-buffer-local-dict t) + (should (equal ispell-local-dictionary test-dict)) + (should (equal ispell-local-pdict test-pdict))) + possible-pdict-paths)))) + + (ert-deftest ispell/ispell-buffer-local-dict/reload+no-overriden () + "ispell.el can recognise keyword-defined dictionary and keyword-defined +personal-dictionary." + :expected-result :failed + (with-temp-buffer + (nxml-mode) + (let ((test-dict "ispellnonexistent")) + (seq-map (lambda (test-pdict) + (insert + "hello\n\n\n" + "" + "") + (letopt ((ispell-current-dictionary "ispellnonexistent2")) + (ispell-buffer-local-dict) + (should (equal ispell-current-dictionary test-dict)) + (should (equal ispell-current-personal-dictionary test-pdict)))) + possible-pdict-paths)))) + + (ert-deftest ispell/ispell-buffer-local-dict/no-reload+overriden () + "ispell.el can recognise keyword-defined dictionary and keyword-defined +personal-dictionary. With no-reload it needs no backend at all." + (with-temp-buffer + (nxml-mode) + (let ((test-dict "ispellnonexistent")) + (seq-map (lambda (test-pdict) + (insert + "hello\n\n\n" + "" + "") + (letopt ((ispell-current-dictionary "ispellnonexistent2")) + (let ((ispell-local-dictionary-overridden t)) + (ispell-buffer-local-dict t)) + (should-not (equal ispell-local-dictionary test-dict)) + (should (equal ispell-local-pdict test-pdict)))) + possible-pdict-paths)))) + + (ert-deftest ispell/ispell-buffer-local-dict/reload+overriden () + "ispell.el can recognise keyword-defined dictionary and keyword-defined +personal-dictionary. With no-reload it needs no backend at all." + :expected-result :failed + (with-temp-buffer + (nxml-mode) + (let ((test-dict "ispellnonexistent")) + (seq-map (lambda (test-pdict) + (insert + "hello\n\n\n" + "" + "") + (letopt ((ispell-current-dictionary "ispellnonexistent2")) + (let ((ispell-local-dictionary-overridden t)) + (ispell-buffer-local-dict t)) + (should-not (equal ispell-current-dictionary test-dict)) + (should (equal ispell-current-personal-dictionary + test-pdict)))) + possible-pdict-paths))))) + +;; parsing + +(ert-deftest ispell/ispell-buffer-local-parsing/local-keyword () + "Check that ispell.el can suscessfully pick up a tex parser +from a buffer-local keyword." + ;; FIXME: what if default dictionary sets + ;; (ispell-get-extended-character-mode) ? + (with-temp-buffer + (let ((test-parser "~tex") + (test-dictname "testdict") + (test-extcharmode "~latin3")) + (letopt ((ispell-parser 'ispellnonexistent) + (ispell-local-dictionary-alist + `((,test-dictname "[A-Za-z]" "[^A-Za-z]" "[']" + nil ("-B") ,test-extcharmode utf-8))) + (ispell-current-dictionary test-dictname)) + + (insert + "hello\n\n\n" ispell-parsing-keyword test-parser) + (let* ((counter 0)) + (cl-labels ((checker (s) + (setq counter (+ 1 counter)) + (when (equal counter 1) + (should (string-equal s "!\n"))) + (when (equal counter 2) + (should (string-equal s "-\n"))) + (when (equal counter 3) + (should (string-equal s (concat test-extcharmode "\n")))) + (when (equal counter 4) + (should (string-equal s (concat test-parser "\n")))) + t)) + (unwind-protect (progn + (advice-add 'ispell-send-string :override + #'checker) + (let ((ispell-really-hunspell nil)) + (ispell-buffer-local-parsing))) + (advice-remove 'ispell-send-string #'checker))))))) + ) + +(ert-deftest ispell/ispell-buffer-local-parsing/local-keyword/hunspell-bug () + "Check that ispell.el can suscessfully pick up a tex parser +from a buffer-local keyword." + ;; FIXME: what if default dictionary sets + ;; (ispell-get-extended-character-mode) ? + :expected-result :failed + (with-temp-buffer + (let ((test-parser "~tex") + (test-dictname "testdict") + (test-extcharmode "~latin3")) + (letopt ((ispell-parser 'ispellnonexistent) + (ispell-local-dictionary-alist + `((,test-dictname "[A-Za-z]" "[^A-Za-z]" "[']" + nil ("-B") ,test-extcharmode utf-8))) + (ispell-current-dictionary test-dictname)) + + (insert + "hello\n\n\n" ispell-parsing-keyword test-parser) + (let* ((counter 0)) + (cl-labels ((checker (s) + (setq counter (+ 1 counter)) + (when (equal counter 1) + (should (string-equal s "!\n"))) + (when (equal counter 2) + (should (string-equal s "-\n"))) + (when (equal counter 3) + (should (string-equal s (concat test-extcharmode "\n")))) + (when (equal counter 4) + (should (string-equal s (concat test-parser "\n")))) + t)) + (unwind-protect (progn + (advice-add 'ispell-send-string :override + #'checker) + (let ((ispell-really-hunspell t)) + (ispell-buffer-local-parsing))) + (advice-remove 'ispell-send-string #'checker))))))) + ) + +(ert-deftest ispell/ispell-buffer-local-parsing/mode-tex () + "Check that ispell.el can suscessfully pick up a tex parser +from tex-based mode-name. +There is another implicit check here: explicit-character-mode +(argument 7 from the ispell.el dictionary structure) is nil." + (with-temp-buffer + (let ((test-dictname "testdict") + (test-extcharmode nil)) + (letopt ((ispell-check-comments t) + (ispell-parser 'use-mode-name) + (ispell-local-dictionary-alist + `((,test-dictname "[A-Za-z]" "[^A-Za-z]" "[']" + nil ("-B") ,test-extcharmode utf-8))) + (ispell-current-dictionary test-dictname)) + (insert + "hello\n\n\n") + (tex-mode) + (let* ((counter 0)) + (cl-labels ((checker (s) + (setq counter (+ 1 counter)) + (when (equal counter 1) + (should (string-equal s "!\n"))) + (when (equal counter 2) + (should (string-equal s "+\n"))) + (when (equal counter 3) + (error "Should not have a third call to `ispell-send-string'")) + t)) + (unwind-protect (progn + (advice-add 'ispell-send-string :override + #'checker) + (ispell-buffer-local-parsing)) + (advice-remove 'ispell-send-string #'checker))))))) + ) + +(ert-deftest ispell/ispell-buffer-local-parsing/extended-character-mode () + "Check that ispell.el can suscessfully pick up an extended character +mode from the dictionary." + (with-temp-buffer + (insert + "hello\n\n\n") + (let ((test-extcharmode "~latin3")) + (letopt ((ispell-check-comments t) + (ispell-parser 'use-mode-name) + ;; FIXME: what if default dictionary sets + ;; (ispell-get-extended-character-mode)? + (ispell-local-dictionary-alist + `(("english" "[A-Za-z]" "[^A-Za-z]" "[']" + nil ("-B") ,test-extcharmode utf-8))) + ) + (tex-mode) + (let* ((counter 0)) + (cl-labels ((checker (s) + (setq counter (+ 1 counter)) + (when (equal counter 1) + (should (string-equal s "!\n"))) + (when (equal counter 2) + (should (string-equal s "+\n"))) + (when (equal counter 3) + (should (string-equal s (concat test-extcharmode "\n")))) + (when (equal counter 4) + (error "Should not have a third call to `ispell-send-string'")) + t)) + (unwind-protect (progn + (advice-add 'ispell-send-string :override + #'checker) + (ispell-buffer-local-parsing)) + (advice-remove 'ispell-send-string #'checker))))))) + ) + +;; Let us now test the most important state-related function: +;; `ispell-accept-buffer-local-defs'. +;; Why is it important? +;; Because it is used in emacs' own CI for testing documentation +;; in checkdoc. +;; Indeed, when we are running the checker in batch mode, +;; we do not want to have any global state. + + +(ert-deftest ispell/ispell-accept-buffer-local-defs/simple () + "Check that `ispell-accept-buffer-local-defs' works for a +batch mode. +1. local words +2. dictionary and pdict +3. parser and extcharmode" + (skip-unless (executable-find "ispell")) + (setq old-engine ispell-program-name) + (setopt ispell-program-name "ispell") + (ispell-check-version t) + (skip-unless (and (null ispell-really-aspell) + (null ispell-really-hunspell) + (null ispell-really-enchant))) + (setq ispell-program-name old-engine) + (with-environment-variables (("HOME" temporary-file-directory)) + (with-temp-buffer + (letopt ((ispell-program-name "ispell")) + (let ((test-dictname "english") + (test-extcharmode "~latin3") + (test-parser "~testparser") + (test-localword1 "aaaaaaaaaaaaa") + (test-localword2 "bbbbbbbbbbb") + (test-pdict "test-pdict.pdict")) + (insert + "hello\n\n\n" + ispell-dictionary-keyword test-dictname "\n" + ispell-pdict-keyword (expand-file-name test-pdict temporary-file-directory) "\n" + ispell-parsing-keyword test-parser "\n" + ispell-words-keyword " " test-localword1 " " test-localword2 "\n") + (letopt ((ispell-check-comments t) + (ispell-parser 'tex) + ;; FIXME: what if default dictionary sets + ;; (ispell-get-extended-character-mode)? + (ispell-local-dictionary-alist + `((,test-dictname "[A-Za-z]" "[^A-Za-z]" "[']" + nil ("-B") ,test-extcharmode utf-8)))) + (tex-mode) + (let* ((counter 0)) + (cl-labels ((checker-ispell-send-string (s) + (let ((references + (list nil + (concat test-extcharmode "\n") + (concat "@" test-localword1 "\n") + (concat "@" test-localword2 "\n") + "!\n" + "+\n" + (concat test-extcharmode "\n") + (concat test-parser "\n")))) + (setq counter (+ 1 counter)) + (should (<= counter (length references))) + (should (string-equal + (concat s) + (concat (nth counter references)))) + t))) + (unwind-protect (progn + (advice-add 'ispell-send-string :before + #'checker-ispell-send-string) + (ignore-errors (ispell-kill-ispell)) + (ispell-accept-buffer-local-defs) + (should (equal ispell-local-dictionary test-dictname)) + (should (equal ispell-local-pdict (expand-file-name test-pdict temporary-file-directory))) + ) + (advice-remove 'ispell-send-string #'checker-ispell-send-string))))))))) + ) + +(ert-deftest ispell/ispell--run-on-word/default () + "`ispell--run-on-word' should be the simplest interface +for checking a word." + (skip-unless (ispell-tests--some-backend-available-p)) + (skip-unless (equal + 0 + (call-process (ispell-tests--some-backend) nil nil nil "-vv"))) + (letopt ((ispell-program-name (ispell-tests--some-backend)) + (ispell-dictionary "default")) + (let ((default-directory temporary-file-directory)) + (with-temp-buffer + (with-environment-variables (("HOME" temporary-file-directory)) + (nxml-mode) + ;; t t kills regardless and clears buffer-local words + (ignore-errors (ispell-kill-ispell t t)) + (ispell-init-process) + + (let ((test-output (ispell--run-on-word "hellooooooo"))) + (should (listp test-output)) + (should-not (equal t test-output)) + (setq ispell-filter nil) + (setq ispell-filter-continue nil)) + + (let ((test-output (ispell--run-on-word "hello"))) + (should-not (listp test-output)) + (should (equal t test-output)) + (setq ispell-filter nil) + (setq ispell-filter-continue nil)) + + (let ((test-output (ispell--run-on-word "fail"))) + (should-not (listp test-output)) + (should (equal t test-output)) + (setq ispell-filter nil) + (setq ispell-filter-continue nil)) + + (let ((test-output (ispell--run-on-word "tail"))) + (should-not (listp test-output)) + (should (equal t test-output)) + (setq ispell-filter nil) + (setq ispell-filter-continue nil)) + )))) + ) + +(ert-deftest ispell/ispell--run-on-word/default/fails () + "`ispell--run-on-word' should be the simplest interface +for checking a word. This test fails due to what I consider +to be a bug. I am quite convinced that `ispell--run-on-word' +should work twice in a row, without having to call +(`ispell-init-process') or (setq ispell-filter nil) +before each call. +" + :expected-result :failed + (skip-unless (ispell-tests--some-backend-available-p)) + (skip-unless (equal + 0 + (call-process (ispell-tests--some-backend) nil nil nil "-vv"))) + (letopt ((ispell-program-name (ispell-tests--some-backend)) + (ispell-dictionary "default")) + (let ((default-directory temporary-file-directory)) + (with-temp-buffer + (with-environment-variables (("HOME" temporary-file-directory)) + (nxml-mode) + ;; t t kills regardless and clears buffer-local words + (ignore-errors (ispell-kill-ispell t t)) + (ispell-init-process) + + (let ((test-output (ispell--run-on-word "hellooooooo"))) + (should (listp test-output)) + (should-not (equal t test-output))) + + (let ((test-output (ispell--run-on-word "hello"))) + (should-not (listp test-output)) + (should (equal t test-output))) + + )))) + ) + +(ert-deftest ispell/ispell-word/default/check-only/correct () + "Check that `ispell-word' works with a default +dictionary, which we expect to be english, as +Ispell ships it. This is probably wrong and should +be rewritten with a mock." + (skip-unless (ispell-tests--some-backend-available-p)) + (skip-unless (equal + 0 + (call-process (ispell-tests--some-backend) nil nil nil "-vv"))) + (with-environment-variables (("HOME" temporary-file-directory)) + (let ((default-directory temporary-file-directory)) + (letopt ((ispell-program-name (ispell-tests--some-backend))) + (ignore-errors (ispell-kill-ispell t t)) + (with-temp-buffer + (insert + "hello\n") + (goto-char 0) + (let ((ispell-check-only t) + (current-point + (with-current-buffer "*Messages*" + (point)))) + (ispell-word) + (with-current-buffer "*Messages*" + (goto-char (point-max)) + (should ( > (search-backward "is correct" nil t) + current-point))))))))) + +(ert-deftest ispell/ispell-word/default/check-only/correct/add-init () + "Check that `ispell-word' works with a default +dictionary, which we expect to be english, as +Ispell ships it. This is probably wrong and should +be rewritten with a mock. +This test is different from the previous one in that an explicit init +call to (ispell-init-process) is added. I had issues with it, so I would +like to test it explicitly." + (skip-unless (ispell-tests--some-backend-available-p)) + (skip-unless (equal + 0 + (call-process (ispell-tests--some-backend) nil nil nil "-vv"))) + (with-environment-variables (("HOME" temporary-file-directory)) + (let ((default-directory temporary-file-directory)) + (letopt ((ispell-program-name (ispell-tests--some-backend))) + (ignore-errors (ispell-kill-ispell t t)) + (with-temp-buffer + (ispell-init-process) ;; this is added + (insert + "hello\n") + (goto-char 0) + (let ((ispell-check-only t) + (current-point + (with-current-buffer "*Messages*" + (point)))) + (ispell-word) + (with-current-buffer "*Messages*" + (goto-char (point-max)) + (should (> (search-backward "is correct" nil t) + current-point))) + )))))) + +(ert-deftest ispell/ispell-word/default/check-only/incorrect () + "Check that `ispell-word' works with a default +dictionary, which we expect to be english, as +Ispell ships it. This is probably wrong and should +be rewritten with a mock. +This test gives it a word which does not exist." + (skip-unless (ispell-tests--some-backend-available-p)) + (skip-unless (equal + 0 + (call-process (ispell-tests--some-backend) nil nil nil "-vv"))) + (with-environment-variables (("HOME" temporary-file-directory)) + (let ((default-directory temporary-file-directory)) + (letopt ((ispell-program-name (ispell-tests--some-backend))) + (ignore-errors (ispell-kill-ispell t t)) + (with-temp-buffer + (insert + "helloooo\n") + (goto-char 0) + (let ((ispell-check-only t) + (current-point + (with-current-buffer "*Messages*" + (point)))) + (ispell-word) + (with-current-buffer "*Messages*" + (goto-char (point-max)) + (should (> (search-backward "is incorrect" nil t) + current-point))) + )))))) + +(ert-deftest ispell/ispell-region/correct () + "The simplest test for `ispell-region'." + (skip-unless (ispell-tests--some-backend-available-p)) + (skip-unless (equal + 0 + (call-process (ispell-tests--some-backend) nil nil nil "-vv"))) + (with-environment-variables (("HOME" temporary-file-directory)) + (let* ((default-directory temporary-file-directory) + (fake-aspell-path (expand-file-name + "./fake-aspell-new.bash" + tests-ispell-data-directory)) + (words '("hello" "test" "test" "more" "obvious" "word")) + (text (string-join words " "))) + (letopt ((ispell-program-name fake-aspell-path)) + (ignore-errors (ispell-kill-ispell t t)) + (with-temp-buffer + (insert + text) + (goto-char (length (nth 0 words))) + (let (;(ispell-check-only t) + (current-point + (with-current-buffer "*Messages*" + (point)))) + (ispell-region (point) (point-max)) + (with-current-buffer "*Messages*" + (goto-char (point-max)) + (should (> (re-search-backward "Spell-checking region using .* with .* dictionary...done" nil t) current-point)) + 'passed) + ))))) + ) + +(ert-deftest ispell/ispell-region/incorrect () + "The simplest test for `ispell-region'." + (skip-unless (ispell-tests--some-backend-available-p)) + (skip-unless (equal + 0 + (call-process (ispell-tests--some-backend) nil nil nil "-vv"))) + (with-environment-variables (("HOME" temporary-file-directory)) + (let* ((default-directory temporary-file-directory) + (fake-aspell-path "aspell") + (words '("hello" "tarampampamtararam" "world")) + (text (string-join words " "))) + (letopt ((ispell-program-name fake-aspell-path)) + (ignore-errors (ispell-kill-ispell t t)) + (with-temp-buffer + (insert + text) + (goto-char (length (nth 0 words))) + (cl-labels ((checker () + (user-error "expected error"))) + (unwind-protect + (progn + (advice-add 'ispell-show-choices :override + #'checker) + (should-error (ispell-region (point) (point-max))) + 'passed) + (advice-remove 'ispell-show-choices #'checker))) + )))) + ) + +(provide 'tests-ispell) +;;; tests-ispell.el ends here commit baf5908caaa63d74fb795ca865b918b08ffdd01a Author: Michael Albinus Date: Sun Sep 7 09:00:45 2025 +0200 * admin/notes/jargon: Add RSN. diff --git a/admin/notes/jargon b/admin/notes/jargon index 88e942b2679..22e72f997b8 100644 --- a/admin/notes/jargon +++ b/admin/notes/jargon @@ -65,6 +65,7 @@ LMK - let me know OOO - out of office OOTB - out of the box OTOH - on the other hand +RSN - real soon now SNAFU - situation normal, all fouled up TBD - to be determined TBH - to be honest commit 59f21094fd550f41ff009ae3cce727560e21fc80 Author: Elijah Gabe Pérez Date: Sun Sep 7 09:00:20 2025 +0200 ; Fix x-gtk-stock-map * lisp/term/pgtk-win.el (x-gtk-stock-map): * lisp/term/x-win.el (x-gtk-stock-map): Fix entry. diff --git a/lisp/term/pgtk-win.el b/lisp/term/pgtk-win.el index 012ecc5ed5e..b445eaf96b6 100644 --- a/lisp/term/pgtk-win.el +++ b/lisp/term/pgtk-win.el @@ -215,7 +215,7 @@ EVENT is a `preedit-text' event." ("images/package-menu/execute" . "gtk-apply") ("images/package-menu/info" . ("dialog-information" "gtk-info")) ("images/package-menu/install" . ("archive-insert" "list-add")) - ("images/package-menu/delete" . ("archive-remove" "edit-delete" "gtk-remove")) + ("images/package-menu/delete" . ("archive-remove" "gtk-remove")) ("images/package-menu/unmark" . ("gnumeric-object-checkbox" "box")) ("images/package-menu/url" . "globe") ("images/package-menu/upgrade" . ("archive-extract" "go-bottom")) diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index ae3ea9f1ba2..afe02f4e2d3 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -1404,7 +1404,7 @@ This returns an error if any Emacs frames are X frames." ("images/package-menu/execute" . "gtk-apply") ("images/package-menu/info" . ("dialog-information" "gtk-info")) ("images/package-menu/install" . ("archive-insert" "list-add")) - ("images/package-menu/delete" . ("archive-remove" "edit-delete" "gtk-remove")) + ("images/package-menu/delete" . ("archive-remove" "gtk-remove")) ("images/package-menu/unmark" . ("gnumeric-object-checkbox" "box")) ("images/package-menu/url" . "globe") ("images/package-menu/upgrade" . ("archive-extract" "go-bottom")) commit c36259e479ab0b5b79bee3d29efc99cc910361a8 Author: Dmitry Gutov Date: Sun Sep 7 04:53:36 2025 +0300 project--read-project-buffer: Fix creating new buffer * lisp/progmodes/project.el (project--read-project-buffer): Fix the case of entering new buffer name (bug#77312). diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 418f7cec925..438b8528960 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1739,7 +1739,8 @@ Return non-nil if PROJECT is not a remote project." (project--buffers-completion-table buffers-alist) predicate nil nil nil other-name)) - (buffer (assoc-default result buffers-alist #'equal result))) + (buffer (or (assoc-default result buffers-alist) + result))) ;; XXX: This check hardcodes the default buffer-belonging relation ;; which `project-buffers' is allowed to override. Straighten ;; this up sometime later. Or not. Since we can add a method commit c26f702bf9b1a435b05199ccdf74f9c624ce3901 Author: Sean Whitton Date: Sat Sep 6 16:43:45 2025 +0100 vc-deduce-backend: Respect vc-buffer-overriding-fileset * lisp/vc/vc.el (vc-deduce-backend): Respect vc-buffer-overriding-fileset, if set. diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 8b918654242..0d55e9fbb50 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1280,20 +1280,6 @@ If the value is t, the backend is deduced in all modes." (const :tag "All" t)) :version "30.1") -(defun vc-deduce-backend () - (cond ((derived-mode-p 'vc-dir-mode) vc-dir-backend) - ((derived-mode-p 'log-view-mode) log-view-vc-backend) - ((derived-mode-p 'log-edit-mode) log-edit-vc-backend) - ((derived-mode-p 'diff-mode) diff-vc-backend) - ((or (eq vc-deduce-backend-nonvc-modes t) - (derived-mode-p vc-deduce-backend-nonvc-modes)) - (ignore-errors (vc-responsible-backend default-directory))) - (vc-mode (vc-backend buffer-file-name)))) - -(declare-function vc-dir-current-file "vc-dir" ()) -(declare-function vc-dir-deduce-fileset "vc-dir" (&optional state-model-only-files)) -(declare-function dired-vc-deduce-fileset "dired-aux" (&optional state-model-only-files not-state-changing)) - (defvar-local vc-buffer-overriding-fileset nil "Specialized, static value for `vc-deduce-fileset' for this buffer. If non-nil, this should be a list of length 2 or 5. @@ -1307,6 +1293,21 @@ Lisp code which sets this should also set `vc-buffer-overriding-fileset' such that the buffer's local variables also specify a VC backend, rendering the value of this variable unambiguous.") +(defun vc-deduce-backend () + (cond ((car vc-buffer-overriding-fileset)) + ((derived-mode-p 'vc-dir-mode) vc-dir-backend) + ((derived-mode-p 'log-view-mode) log-view-vc-backend) + ((derived-mode-p 'log-edit-mode) log-edit-vc-backend) + ((derived-mode-p 'diff-mode) diff-vc-backend) + ((or (eq vc-deduce-backend-nonvc-modes t) + (derived-mode-p vc-deduce-backend-nonvc-modes)) + (ignore-errors (vc-responsible-backend default-directory))) + (vc-mode (vc-backend buffer-file-name)))) + +(declare-function vc-dir-current-file "vc-dir" ()) +(declare-function vc-dir-deduce-fileset "vc-dir" (&optional state-model-only-files)) +(declare-function dired-vc-deduce-fileset "dired-aux" (&optional state-model-only-files not-state-changing)) + (defun vc-deduce-fileset (&optional not-state-changing allow-unregistered state-model-only-files) commit 2a1f9f8dfee82aa08d544ec776e11025642eb4a8 Author: Spencer Baugh Date: Thu Sep 4 10:36:17 2025 -0400 Fix nil value of 'elisp-flymake-byte-compile-executable' * lisp/progmodes/elisp-mode.el (elisp-flymake-byte-compile--executable): Properly check for nil, and simplify code. (Bug#79380) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index aebc93d1ddb..42653069feb 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -2301,20 +2301,23 @@ variables `invocation-name' and `invocation-directory'." (declare-function project-root "project" (project)) (defun elisp-flymake-byte-compile--executable () "Return absolute file name of the Emacs executable for flymake byte-compilation." - (let ((filename - (cond - ((file-name-absolute-p elisp-flymake-byte-compile-executable) - elisp-flymake-byte-compile-executable) - ((stringp elisp-flymake-byte-compile-executable) - (when-let* ((pr (project-current))) - (file-name-concat (project-root pr) - elisp-flymake-byte-compile-executable)))))) - (if (file-executable-p filename) - filename - (when elisp-flymake-byte-compile-executable - (message "No such `elisp-flymake-byte-compile-executable': %s" - filename)) - (expand-file-name invocation-name invocation-directory)))) + (cond + ((null elisp-flymake-byte-compile-executable) + (expand-file-name invocation-name invocation-directory)) + ((not (stringp elisp-flymake-byte-compile-executable)) + (error "Invalid `elisp-flymake-byte-compile-executable': %s" + elisp-flymake-byte-compile-executable)) + ((file-name-absolute-p elisp-flymake-byte-compile-executable) + elisp-flymake-byte-compile-executable) + (t ; relative file name + (let ((filename (file-name-concat (project-root (project-current)) + elisp-flymake-byte-compile-executable))) + (if (file-executable-p filename) + filename + ;; The user might not have built Emacs yet, so just fall back. + (message "`elisp-flymake-byte-compile-executable' (%s) doesn't exist" + elisp-flymake-byte-compile-executable) + (expand-file-name invocation-name invocation-directory)))))) ;;;###autoload (defun elisp-flymake-byte-compile (report-fn &rest _args) commit 72401548ca7e93ac816534ba4837b09fc439f0c0 Author: Eli Zaretskii Date: Sat Sep 6 17:52:31 2025 +0300 ; * src/process.c (deactivate_process): Fix last change. diff --git a/src/process.c b/src/process.c index 736098fb410..75416b8e52a 100644 --- a/src/process.c +++ b/src/process.c @@ -4832,8 +4832,11 @@ deactivate_process (Lisp_Object proc) for (i = 0; i < PROCESS_OPEN_FDS; i++) { - fd_callback_info[p->open_fd[i]].thread = NULL; - fd_callback_info[p->open_fd[i]].waiting_thread = NULL; + if (p->open_fd[i] >= 0) + { + fd_callback_info[p->open_fd[i]].thread = NULL; + fd_callback_info[p->open_fd[i]].waiting_thread = NULL; + } close_process_fd (&p->open_fd[i]); } commit e06684067d809b43df34409be78e3be38970e413 Author: Brian Leung Date: Sat Sep 6 06:19:25 2025 -0700 Eglot: Really fix neocmakelsp invocation * lisp/progmodes/eglot.el (eglot-server-programs): Remove an incorrect extra layer of parentheses. (Bug#79394) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index d06b97b431e..b35d5e15e6c 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -244,7 +244,7 @@ automatically)." ;; `eglot.el' is installed via GNU ELPA in an older Emacs. `(((rust-ts-mode rust-mode) . ("rust-analyzer")) ((cmake-mode cmake-ts-mode) - . ,(eglot-alternatives '((("neocmakelsp" "--stdio") "cmake-language-server")))) + . ,(eglot-alternatives '(("neocmakelsp" "--stdio") "cmake-language-server"))) (vimrc-mode . ("vim-language-server" "--stdio")) ((python-mode python-ts-mode) . ,(eglot-alternatives commit 2ecced627bc6553003bc32e282629273d2f9c454 Author: Sean Whitton Date: Sat Sep 6 12:15:33 2025 +0100 Fix log-view--mark-unmark interactive arguments * lisp/vc/log-view.el (log-view--mark-unmark): New BEG and END arguments. Don't call region-beginning and region-end here. (log-view-mark-entry, log-view-unmark-entry): Pass BEG and END to log-view--mark-unmark, non-nil when the region is active. diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el index d428ccad00f..1cb8b935ab5 100644 --- a/lisp/vc/log-view.el +++ b/lisp/vc/log-view.el @@ -344,14 +344,16 @@ See `log-view-mark-entry'." (log-view-unmark-entry) (log-view-mark-entry))))) -(defun log-view--mark-unmark (mark-unmark-function arg) +(defun log-view--mark-unmark (mark-unmark-function arg beg end) "Call MARK-UNMARK-FUNCTION on each line of an active region or ARG times. MARK-UNMARK-FUNCTION should end by advancing point to the next line to be processed. The last line of an active region is excluded in the case that the region ends right at the beginning of the line, or after only non-word characters." - (if (use-region-p) + (when (xor beg end) + (error "log-view--mark-unmark called with invalid arguments")) + (if (and beg end) (let ((processed-line nil) ;; Exclude the region's last line if the region ends right ;; at the beginning of that line or almost at the beginning. @@ -359,13 +361,13 @@ characters." ;; We don't want to include the last line unless the region ;; visually includes that revision. (lastl (save-excursion - (goto-char (region-end)) + (goto-char end) (skip-syntax-backward "^w") (if (bolp) (1- (line-number-at-pos)) (line-number-at-pos))))) (save-excursion - (goto-char (region-beginning)) + (goto-char beg) (while-let ((n (line-number-at-pos)) ;; Make sure we don't get stuck processing the ;; same line infinitely. @@ -377,10 +379,12 @@ characters." (dotimes (_ arg) (funcall mark-unmark-function)))) -(defun log-view-mark-entry (&optional arg) +(defun log-view-mark-entry (&optional arg beg end) "Mark the log entry at point. If the region is active in Transient Mark mode, mark all entries. When called with a prefix argument, mark that many log entries. +When called from Lisp, mark ARG entries or all entries between lying +between BEG and END. If BEG and END are supplied, ARG is ignored. When entries are marked, some commands that usually operate on the entry at point will instead operate on all marked entries. @@ -388,8 +392,10 @@ Use \\[log-view-unmark-entry] to unmark an entry. Lisp programs can use `log-view-get-marked' to obtain a list of all marked revisions." - (interactive "p") - (log-view--mark-unmark #'log-view--mark-entry arg)) + (interactive (list (prefix-numeric-value current-prefix-arg) + (use-region-beginning) + (use-region-end))) + (log-view--mark-unmark #'log-view--mark-entry arg beg end)) (defun log-view--mark-entry () "Mark the log entry at point." @@ -409,14 +415,18 @@ marked revisions." (overlay-put ov 'log-view-marked (nth 1 entry))))) (log-view-msg-next 1))) -(defun log-view-unmark-entry (&optional arg) +(defun log-view-unmark-entry (&optional arg beg end) "Unmark the log entry at point. If the region is active in Transient Mark mode, unmark all entries. When called with a prefix argument, unmark that many log entries. +When called from Lisp, mark ARG entries or all entries between lying +between BEG and END. If BEG and END are supplied, ARG is ignored. See `log-view-mark-entry'." - (interactive "p") - (log-view--mark-unmark #'log-view--unmark-entry arg)) + (interactive (list (prefix-numeric-value current-prefix-arg) + (use-region-beginning) + (use-region-end))) + (log-view--mark-unmark #'log-view--unmark-entry arg beg end)) (defun log-view--unmark-entry () "Unmark the log entry at point." commit 6c150961fd07e19b6c871d8963d6b9826ec8140f Merge: 4ac9e93e5ec 5e57829ffd8 Author: Eli Zaretskii Date: Sat Sep 6 05:53:09 2025 -0400 ; Merge from origin/emacs-30 The following commit was skipped: 5e57829ffd8 Fix command keys in doc string of 'inferior-python-mode' commit 4ac9e93e5ec3c1b28f3f6721312e2429fb42bb3d Merge: 29d18f4ffe9 aad5b676d1c Author: Eli Zaretskii Date: Sat Sep 6 05:53:08 2025 -0400 Merge from origin/emacs-30 aad5b676d1c ; * lisp/emacs-lisp/ring.el (ring-convert-sequence-to-rin... ddd63891a48 ; * doc/misc/flymake.texi (Troubleshooting): Fix typo (bu... 8dcb8020466 ; vc-hooks.el: Standardize terminology in header. commit 29d18f4ffe9c9152bdfe2d4dec9f8a74609cf4c5 Author: Eli Zaretskii Date: Sat Sep 6 12:43:19 2025 +0300 Avoid assertion violations when starting client network process * src/process.c (deactivate_process): Clear the callback info of descriptors we are closing. (Bug#79367) diff --git a/src/process.c b/src/process.c index fa003c29851..736098fb410 100644 --- a/src/process.c +++ b/src/process.c @@ -4831,7 +4831,11 @@ deactivate_process (Lisp_Object proc) /* Beware SIGCHLD hereabouts. */ for (i = 0; i < PROCESS_OPEN_FDS; i++) - close_process_fd (&p->open_fd[i]); + { + fd_callback_info[p->open_fd[i]].thread = NULL; + fd_callback_info[p->open_fd[i]].waiting_thread = NULL; + close_process_fd (&p->open_fd[i]); + } inchannel = p->infd; eassert (inchannel < FD_SETSIZE); commit 6b42b974ceabba8b0215498d4a6eb5048d91514d Author: Jostein Kjønigsen Date: Wed Sep 3 11:59:04 2025 +0200 'nxml-mode': add schema for .NET SLNX files. SLNX is a new XML-based file-format for .NET based solutions, replacing the older proprietary SLN file-format. Unlike SLN-files, it is merge-friendly and expected to become the new de-facto standard for working with .NET projects. This commit adds support for SLNX-schema to 'nxml-mode'. The schme provided has been synthesized using the official XSD-schema definition: https://github.com/microsoft/vs-solutionpersistence/blob/main/src/Microsoft.VisualStudio.SolutionPersistence/Serializer/Xml/Slnx.xsd This schema was then converted to RNG using XSDtoRNG.xsl: https://github.com/epiasini/XSDtoRNG The RNG schema was then converted to RNC using the trang CLI-tool: https://relaxng.org/jclark/trang.html * etc/schema/dotnet-slnx.rnc: New file. * etc/schema/schemas.xml: Add Slnx schema. * lisp/files.el (auto-mode-alist): Add association for SLNX files. (Bug#79379) diff --git a/etc/schema/dotnet-slnx.rnc b/etc/schema/dotnet-slnx.rnc new file mode 100644 index 00000000000..2e081ed39fd --- /dev/null +++ b/etc/schema/dotnet-slnx.rnc @@ -0,0 +1,74 @@ +default namespace = "" +namespace a = "http://relaxng.org/ns/compatibility/annotations/1.0" +namespace ns_1 = "http://relaxng.org/ns/compatibility/annotations/1.0" +namespace rng = "http://relaxng.org/ns/structure/1.0" + +start |= starting_Solution +starting_Solution = + element Solution { + (element Configurations { Configurations }? + | element Project { Project }* + | element Folder { Folder }* + | PropertiesGroup*)*, + attribute Description { xsd:string }?, + attribute Version { xsd:string }? + } +Configurations = + (element BuildType { + attribute Name { xsd:string } + }* + | element Platform { + attribute Name { xsd:string } + }* + | element ProjectType { ProjectType }*)* +ProjectType = + (ConfigurationRulesGroup*)*, + attribute TypeId { xsd:string }?, + attribute Name { xsd:string }?, + attribute Extension { xsd:string }?, + attribute BasedOn { xsd:string }?, + [ ns_1:defaultValue = "true" ] attribute IsBuildable { xsd:boolean }?, + [ ns_1:defaultValue = "true" ] + attribute SupportsPlatform { xsd:boolean }? +Folder = + (element File { + attribute Path { xsd:string } + }* + | element Project { Project }* + | PropertiesGroup*)*, + attribute Name { xsd:string } +Project = + (element BuildDependency { + attribute Project { text } + }* + | ConfigurationRulesGroup* + | PropertiesGroup*)*, + attribute Path { xsd:string }, + attribute Type { xsd:string }?, + attribute DisplayName { xsd:string }? +PropertiesGroup = + element Properties { + element Property { + attribute Name { xsd:string }, + attribute Value { xsd:string }? + }*, + attribute Name { text }, + attribute Scope { text }? + } +ConfigurationRulesGroup = + element BuildType { + attribute Solution { xsd:string }?, + attribute Project { xsd:string }? + }+ + | element Platform { + attribute Solution { xsd:string }?, + attribute Project { xsd:string } + }+ + | element Build { + attribute Solution { xsd:string }?, + attribute Project { xsd:string }? + }+ + | element Deploy { + attribute Solution { xsd:string }?, + attribute Project { xsd:string }? + }+ diff --git a/etc/schema/schemas.xml b/etc/schema/schemas.xml index 18af8ccf4af..6701b9b56a6 100644 --- a/etc/schema/schemas.xml +++ b/etc/schema/schemas.xml @@ -93,4 +93,7 @@ + + + diff --git a/lisp/files.el b/lisp/files.el index bd229673d8d..8cfbdc79bf0 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3158,6 +3158,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\|SQUASHFS\\)\\'" . ("\\.oak\\'" . scheme-mode) ("\\.sgml?\\'" . sgml-mode) ("\\.x[ms]l\\'" . xml-mode) + ("\\.slnx\\'" . xml-mode) ("\\.dbk\\'" . xml-mode) ("\\.dtd\\'" . sgml-mode) ("\\.ds\\(ss\\)?l\\'" . dsssl-mode) commit 5e57829ffd8335e815545ae70a373c37f7bd1f59 Author: Eli Zaretskii Date: Sat Sep 6 12:20:58 2025 +0300 Fix command keys in doc string of 'inferior-python-mode' * lisp/progmodes/python.el (inferior-python-mode): Mention the correct mode-map in the doc string. (Bug#79386) (cherry picked from commit ab5e0f535939e7fa94c0770e6e21acb9efea2a32) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index e593ea93ff4..8b11927591b 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -3639,7 +3639,7 @@ may want to re-add custom functions to it using the You can also add additional setup code to be run at initialization of the interpreter via `python-shell-setup-codes' variable. - +\\ \(Type \\[describe-mode] in the process buffer for a list of commands.)" (when python-shell--parent-buffer (python-util-clone-local-variables python-shell--parent-buffer)) commit ab5e0f535939e7fa94c0770e6e21acb9efea2a32 Author: Eli Zaretskii Date: Sat Sep 6 12:20:58 2025 +0300 Fix command keys in doc string of 'inferior-python-mode' * lisp/progmodes/python.el (inferior-python-mode): Mention the correct mode-map in the doc string. (Bug#79386) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 649f47f6e69..e5cc3b0078b 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -3761,7 +3761,7 @@ may want to re-add custom functions to it using the You can also add additional setup code to be run at initialization of the interpreter via `python-shell-setup-codes' variable. - +\\ \(Type \\[describe-mode] in the process buffer for a list of commands.)" (when python-shell--parent-buffer (python-util-clone-local-variables python-shell--parent-buffer)) commit 7b09f8bb7c92505c1286ed6f00b9c878bad2489a Author: Gustav Hållberg Date: Mon Sep 1 12:31:49 2025 +0200 "M-x lldb": bugfix source code location without column * lisp/progmodes/gud.el (gud-lldb-marker-filter): Fix problem where the source code location ends up at the last character of the previous line if no (or zero) column is reported by lldb. (Bug#79360) Copyright-paperwork-exempt: yes diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 7108673dddc..5980bc2f3c6 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -446,8 +446,9 @@ we're in the GUD buffer)." ,(if key `(define-key gud-global-map ,key #',func)))) ;; Where gud-display-frame should put the debugging arrow; a cons of -;; (filename . line-number). This is set by the marker-filter, which scans -;; the debugger's output for indications of the current program counter. +;; (filename . line-number) or (list filename line-number column-number). +;; This is set by the marker-filter, which scans the debugger's output +;; for indications of the current program counter. (defvar gud-last-frame nil) ;; Used by gud-refresh, which should cause gud-display-frame to redisplay @@ -3854,8 +3855,10 @@ so they have been disabled.")) (lambda (m) (let ((line (string-to-number (match-string 1 m))) (col (string-to-number (match-string 2 m))) - (file (match-string 3 m))) - (setq gud-last-frame (list file line col))) + (file (match-string 3 m))) + (setq gud-last-frame (if (zerop col) + (cons file line) + (list file line col)))) ;; Remove the line so that the user won't see it. "") string t t)) commit aad5b676d1c1a007762efe97f4aae34f69f0e79a Author: Eli Zaretskii Date: Sat Sep 6 11:36:21 2025 +0300 ; * lisp/emacs-lisp/ring.el (ring-convert-sequence-to-ring): Doc fix. diff --git a/lisp/emacs-lisp/ring.el b/lisp/emacs-lisp/ring.el index 293f0f93a0c..8518753ab20 100644 --- a/lisp/emacs-lisp/ring.el +++ b/lisp/emacs-lisp/ring.el @@ -240,7 +240,7 @@ If the RING is full, behavior depends on GROW-P: (ring-insert+extend ring item grow-p)) (defun ring-convert-sequence-to-ring (seq) - "Convert sequence SEQ to a ring. Return the ring. + "Convert sequence SEQ to a ring, and return the ring. If SEQ is already a ring, return it." (if (ring-p seq) seq commit fb969ab174990acccda64cf7ca2349e67aa6f1d4 Author: Liu Hui Date: Thu Aug 28 17:57:21 2025 +0800 Fix duplicate inputs in 'comint-read-input-ring' * lisp/comint.el (comint-read-input-ring): Fix the index of the last input in the ring. (Bug#79329) diff --git a/lisp/comint.el b/lisp/comint.el index bbb9820c16a..df1c08c3647 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -1090,8 +1090,9 @@ See also `comint-input-ignoredups' and `comint-write-input-ring'." (when (and (not (string-match history-ignore history)) (or (null ignoredups) (ring-empty-p ring) - (not (string-equal (ring-ref ring 0) - history)))) + (not (string-equal + (ring-ref ring (1- (ring-length ring))) + history)))) (when (= count ring-size) (ring-extend ring (min (- ring-max-size ring-size) ring-size)) commit ddd63891a48d2ddafe7b7bba762dcfa8526edff7 Author: Eli Zaretskii Date: Sat Sep 6 10:15:49 2025 +0300 ; * doc/misc/flymake.texi (Troubleshooting): Fix typo (bug#79391). diff --git a/doc/misc/flymake.texi b/doc/misc/flymake.texi index 65c10588f39..43b6eb1ee37 100644 --- a/doc/misc/flymake.texi +++ b/doc/misc/flymake.texi @@ -227,7 +227,7 @@ can use the variables @code{flymake-mode-line-format} and @cindex disabled backends @cindex backends, disabled As Flymake supports multiple simultaneously active external backends, -is becomes useful to monitor their status. For example, some backends +it becomes useful to monitor their status. For example, some backends may take longer than others to respond or complete, and some may decide to @emph{disable} themselves if they are not suitable for the current buffer or encounter some unavoidable problem. A disabled commit c374bb50daa0c2d603a55d9b05bef9c9534ad0a7 Author: Stefan Monnier Date: Fri Sep 5 15:02:54 2025 -0400 (redisplay_internal): Fix `follow-mode` (bug#79306) * src/xdisp.c (redisplay_internal): Don't increment `redisplay_counter` if we ail out before starting an actual redisplay. diff --git a/src/xdisp.c b/src/xdisp.c index 89561d750b6..aef40c38e54 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -17137,8 +17137,6 @@ redisplay_internal (void) bool polling_stopped_here = false; Lisp_Object tail, frame; - redisplay_counter++; - /* Set a limit to the number of retries we perform due to horizontal scrolling, this avoids getting stuck in an uninterruptible infinite loop (Bug #24633). */ @@ -17197,6 +17195,8 @@ redisplay_internal (void) return; #endif + redisplay_counter++; + /* Record a function that clears redisplaying_p when we leave this function. */ specpdl_ref count = SPECPDL_INDEX (); commit 4d8ba9fbe7528906bfa1425962ad61f6e591d5e9 Author: Sean Whitton Date: Fri Sep 5 16:08:37 2025 +0100 Log View marking commands: respect numeric prefixes & active regions * lisp/vc/log-view.el (log-view--mark-unmark) (log-view--mark-entry, log-view--unmark-entry): New functions. (log-view-mark-entry, log-view-unmark-entry): Call them. Newly respect numeric prefix arguments and active regions. diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el index cd126940410..d428ccad00f 100644 --- a/lisp/vc/log-view.el +++ b/lisp/vc/log-view.el @@ -344,15 +344,55 @@ See `log-view-mark-entry'." (log-view-unmark-entry) (log-view-mark-entry))))) -(defun log-view-mark-entry () +(defun log-view--mark-unmark (mark-unmark-function arg) + "Call MARK-UNMARK-FUNCTION on each line of an active region or ARG times. +MARK-UNMARK-FUNCTION should end by advancing point to the next line to +be processed. +The last line of an active region is excluded in the case that the +region ends right at the beginning of the line, or after only non-word +characters." + (if (use-region-p) + (let ((processed-line nil) + ;; Exclude the region's last line if the region ends right + ;; at the beginning of that line or almost at the beginning. + ;; This is like the `file' value of `dired-mark-region'. + ;; We don't want to include the last line unless the region + ;; visually includes that revision. + (lastl (save-excursion + (goto-char (region-end)) + (skip-syntax-backward "^w") + (if (bolp) + (1- (line-number-at-pos)) + (line-number-at-pos))))) + (save-excursion + (goto-char (region-beginning)) + (while-let ((n (line-number-at-pos)) + ;; Make sure we don't get stuck processing the + ;; same line infinitely. + ((<= (line-number-at-pos) lastl)) + ((not (eq processed-line n)))) + (setq processed-line n) + (funcall mark-unmark-function))) + (setq deactivate-mark t)) + (dotimes (_ arg) + (funcall mark-unmark-function)))) + +(defun log-view-mark-entry (&optional arg) "Mark the log entry at point. +If the region is active in Transient Mark mode, mark all entries. +When called with a prefix argument, mark that many log entries. + When entries are marked, some commands that usually operate on the entry at point will instead operate on all marked entries. Use \\[log-view-unmark-entry] to unmark an entry. Lisp programs can use `log-view-get-marked' to obtain a list of all marked revisions." - (interactive) + (interactive "p") + (log-view--mark-unmark #'log-view--mark-entry arg)) + +(defun log-view--mark-entry () + "Mark the log entry at point." (when-let* ((entry (log-view-current-entry)) (beg (car entry))) (save-excursion @@ -369,10 +409,17 @@ marked revisions." (overlay-put ov 'log-view-marked (nth 1 entry))))) (log-view-msg-next 1))) -(defun log-view-unmark-entry () +(defun log-view-unmark-entry (&optional arg) "Unmark the log entry at point. +If the region is active in Transient Mark mode, unmark all entries. +When called with a prefix argument, unmark that many log entries. + See `log-view-mark-entry'." - (interactive) + (interactive "p") + (log-view--mark-unmark #'log-view--unmark-entry arg)) + +(defun log-view--unmark-entry () + "Unmark the log entry at point." (when-let* ((entry (log-view-current-entry))) (when-let* ((found (get-char-property (car entry) 'log-view-self))) (delete-overlay found)) commit 9501b9b198290a62c1418996a7c80a225b4ff7e1 Author: Sean Whitton Date: Fri Sep 5 15:30:02 2025 +0100 ; log-view-mark-entry, log-view-unmark-entry: Fix advancing point. diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el index 22fcf96cb5b..cd126940410 100644 --- a/lisp/vc/log-view.el +++ b/lisp/vc/log-view.el @@ -367,7 +367,7 @@ marked revisions." ;; This is used to check if the overlay is present. (overlay-put ov 'log-view-self ov) (overlay-put ov 'log-view-marked (nth 1 entry))))) - (forward-line 1))) + (log-view-msg-next 1))) (defun log-view-unmark-entry () "Unmark the log entry at point. @@ -376,7 +376,7 @@ See `log-view-mark-entry'." (when-let* ((entry (log-view-current-entry))) (when-let* ((found (get-char-property (car entry) 'log-view-self))) (delete-overlay found)) - (forward-line 1))) + (log-view-msg-next 1))) ;;;###autoload (defun log-view-get-marked () commit 787f18010deb7f84ede432ffb66351453436ee26 Author: Sean Whitton Date: Fri Sep 5 15:22:31 2025 +0100 vc-dir-mark-unmark: When region active, don't do any y/n prompting * lisp/vc/vc-dir.el (vc-dir-mark-unmark): When region active, bind vc-dir-allow-mass-mark-changes to nil. diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 4651468f1ff..18848577052 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -689,7 +689,7 @@ With prefix argument ARG, move that many lines." (setq processed-line (line-number-at-pos)) (condition-case nil ;; Avoid any prompting. - (let ((vc-dir-allow-mass-mark-changes nil)) + (let (vc-dir-allow-mass-mark-changes) (funcall mark-unmark-function)) ;; `vc-dir-mark-file' signals an error if we try marking ;; a directory containing marked files in its tree, or a commit 9f7cdcb454e45929b0da6cc79d075d251178ead3 Author: Sean Whitton Date: Fri Sep 5 15:22:12 2025 +0100 vc-dir-mark-unmark: When region active, don't do any y/n prompting * lisp/vc/vc-dir.el (vc-dir-mark-unmark): When region active, bind vc-dir-allow-mass-mark-changes to nil. diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 3d04e8eaef5..4651468f1ff 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -688,7 +688,9 @@ With prefix argument ARG, move that many lines." (not (eq processed-line (line-number-at-pos)))) (setq processed-line (line-number-at-pos)) (condition-case nil - (funcall mark-unmark-function) + ;; Avoid any prompting. + (let ((vc-dir-allow-mass-mark-changes nil)) + (funcall mark-unmark-function)) ;; `vc-dir-mark-file' signals an error if we try marking ;; a directory containing marked files in its tree, or a ;; file in a marked directory tree. Just continue. commit 20a912934914fd36dc91493601a564169bcdf879 Author: Eli Zaretskii Date: Fri Sep 5 14:29:37 2025 +0300 ; Fix 'elisp-flymake-byte-compile-executable' defcustom * lisp/progmodes/elisp-mode.el (elisp-flymake-byte-compile-executable): Fix :type. diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index e8344852829..aebc93d1ddb 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -2292,7 +2292,9 @@ containing the file being compiled, as determined by `project-current'. If nil, or if the file named by this does not exist, Flymake will use the same executable as the running Emacs, as specified by the variables `invocation-name' and `invocation-directory'." - :type 'file + :type '(choice + (const :tag "Current session's executable" nil) + (file :tag "Specific Emacs executable")) :group 'lisp :version "31.1") commit a893dacb388e73d21ef52dc7f72c619a55908e28 Author: Sean Whitton Date: Fri Sep 5 11:58:15 2025 +0100 Make 'm' and 'u' in Log View mode more standard * lisp/vc/log-view.el (log-view-mark-entry) (log-view-unmark-entry): New commands. (log-view-toggle-mark-entry): Rewrite in terms of them. (log-view-mode-map): Unbind log-view-toggle-mark-entry. Bind the two new commands. * etc/NEWS: Document the change. diff --git a/etc/NEWS b/etc/NEWS index 656806e68a3..e0c4f3cb871 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2255,6 +2255,16 @@ Backend authors should implement the 'incoming-revision' and 'mergebase' backend functions instead. These are jointly sufficient to support the 'C-x v I' and 'C-x v O' commands. +--- +*** Marking revisions in Log View now works more like other modes. +Previously, 'm' toggled whether the current revision was marked, and +didn't advance point. Now 'm' only adds marks, 'u' removes marks, and +both advance point, like how marking works in Dired and VC-Dir. +You can get back the old behavior with something like this: + + (with-eval-after-load 'log-view + (keymap-set log-view-mode-map "m" #'log-view-toggle-mark-entry)) + ** Diff mode +++ diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el index 6394fdde6c8..22fcf96cb5b 100644 --- a/lisp/vc/log-view.el +++ b/lisp/vc/log-view.el @@ -125,7 +125,8 @@ (defvar-keymap log-view-mode-map "RET" #'log-view-toggle-entry-display - "m" #'log-view-toggle-mark-entry + "m" #'log-view-mark-entry + "u" #'log-view-unmark-entry "e" #'log-view-modify-change-comment "d" #'log-view-diff "=" #'log-view-diff @@ -335,30 +336,47 @@ if POS is omitted or nil, it defaults to point." (defun log-view-toggle-mark-entry () "Toggle the marked state for the log entry at point. -Individual log entries can be marked and unmarked. The marked -entries are denoted by changing their background color. -`log-view-get-marked' returns the list of tags for the marked -log entries." +See `log-view-mark-entry'." (interactive) (save-excursion - (let* ((entry (log-view-current-entry nil t)) - (beg (car entry)) - found) - (when entry - ;; Look to see if the current entry is marked. - (setq found (get-char-property beg 'log-view-self)) - (if found - (delete-overlay found) - ;; Create an overlay covering this entry and change its color. - (let* ((end (if (get-text-property beg 'log-view-entry-expanded) - (next-single-property-change beg 'log-view-comment) - (log-view-end-of-defun) - (point))) - (ov (make-overlay beg end))) - (overlay-put ov 'face 'log-view-file) - ;; This is used to check if the overlay is present. - (overlay-put ov 'log-view-self ov) - (overlay-put ov 'log-view-marked (nth 1 entry)))))))) + (when-let* ((entry (log-view-current-entry))) + (if (get-char-property (car entry) 'log-view-self) + (log-view-unmark-entry) + (log-view-mark-entry))))) + +(defun log-view-mark-entry () + "Mark the log entry at point. +When entries are marked, some commands that usually operate on the entry +at point will instead operate on all marked entries. +Use \\[log-view-unmark-entry] to unmark an entry. + +Lisp programs can use `log-view-get-marked' to obtain a list of all +marked revisions." + (interactive) + (when-let* ((entry (log-view-current-entry)) + (beg (car entry))) + (save-excursion + (goto-char beg) + (unless (get-char-property beg 'log-view-self) + (let* ((end (if (get-text-property beg 'log-view-entry-expanded) + (next-single-property-change beg 'log-view-comment) + (log-view-end-of-defun) + (point))) + (ov (make-overlay beg end))) + (overlay-put ov 'face 'log-view-file) + ;; This is used to check if the overlay is present. + (overlay-put ov 'log-view-self ov) + (overlay-put ov 'log-view-marked (nth 1 entry))))) + (forward-line 1))) + +(defun log-view-unmark-entry () + "Unmark the log entry at point. +See `log-view-mark-entry'." + (interactive) + (when-let* ((entry (log-view-current-entry))) + (when-let* ((found (get-char-property (car entry) 'log-view-self))) + (delete-overlay found)) + (forward-line 1))) ;;;###autoload (defun log-view-get-marked () commit 8951cea14bd9a8f845414c5d9b51571cd46defe6 Author: Sean Whitton Date: Fri Sep 5 11:24:07 2025 +0100 ; * lisp/vc/vc-hg.el (vc-hg--pushpull): Fix docs for OBSOLETE param. diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 32725f6b5fb..f2364424962 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -1567,7 +1567,8 @@ This runs the command \"hg summary\"." If PROMPT is non-nil, prompt for the Hg command to run. POST-PROCESSING is a list of commands to execute after the command. If OBSOLETE is non-nil, behave like the old versions of the Hg push/pull -commands, which only operated on marked files." +commands: when called interactively in a Log View buffer with marked +revisions, fetch only those revisions." (let (marked-list) ;; The `vc-hg-pull' and `vc-hg-push' commands existed before the ;; `pull'/`push' VC actions were implemented. commit 4e7c0489feb10e3e9e81bf612f7f9a3c62c3c01a Author: Sean Whitton Date: Fri Sep 5 11:23:34 2025 +0100 ; Delete two old comments about VC bindings We wouldn't expect to change any of these longstanding bindings, now. diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index c83f322e7b6..3d04e8eaef5 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -353,7 +353,6 @@ That is, refreshing the VC-Dir buffer also hides `up-to-date' and (define-key map "D" #'vc-root-diff) ;; C-x v D (define-key map "i" #'vc-register) ;; C-x v i (define-key map "+" #'vc-pull) ;; C-x v + - ;; I'd prefer some kind of symmetry with vc-pull: (define-key map "P" #'vc-push) ;; C-x v P (define-key map "l" #'vc-print-log) ;; C-x v l (define-key map "L" #'vc-print-root-log) ;; C-x v L diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 999bf279fba..c71b2b014c5 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -960,7 +960,6 @@ In the latter case, VC mode is deactivated for this buffer." "u" #'vc-revert "v" #'vc-next-action "+" #'vc-update - ;; I'd prefer some kind of symmetry with vc-update: "P" #'vc-push "=" #'vc-diff "D" #'vc-root-diff commit 951e782836e68a3a7938a0703e7a275df0936b19 Author: Eli Zaretskii Date: Fri Sep 5 08:52:05 2025 +0300 Fix locking to threads of the client network process * src/process.c (server_accept_connection): Make the client process be locked to the same thread as the parent server process, or unlocked if the server process was unlocked. (Bug#79367) diff --git a/src/process.c b/src/process.c index d6efac5479d..fa003c29851 100644 --- a/src/process.c +++ b/src/process.c @@ -5078,6 +5078,10 @@ server_accept_connection (Lisp_Object server, int channel) fcntl (s, F_SETFL, O_NONBLOCK); p = XPROCESS (proc); + /* make_process calls pset_thread, but if the server process is not + locked to any thread, we need to undo what make_process did. */ + if (NILP (ps->thread)) + pset_thread (p, Qnil); /* Build new contact information for this setup. */ contact = Fcopy_sequence (ps->childp); @@ -5117,6 +5121,17 @@ server_accept_connection (Lisp_Object server, int channel) add_process_read_fd (s); if (s > max_desc) max_desc = s; + /* If the server process is locked to this thread, lock the client + process to the same thread, otherwise clear the thread of its I/O + descriptors. */ + eassert (!fd_callback_info[p->infd].thread); + if (NILP (ps->thread)) + set_proc_thread (p, NULL); + else + { + eassert (XTHREAD (ps->thread) == current_thread); + set_proc_thread (p, XTHREAD (ps->thread)); + } /* Setup coding system for new process based on server process. This seems to be the proper thing to do, as the coding system commit fca0dbe0ab2930e39aaec304df3e6bb7cad17995 Author: F. Jason Park Date: Wed Sep 3 17:48:21 2025 -0700 Make function erc-scrolltobottom-mode idempotent * lisp/erc/erc-goodies.el (erc-scrolltobottom-mode) (erc-scrolltobottom-enable): Always remove hook functions whose membership hinges on the value of `erc-scrolltobottom-all'. In ERC 5.6, an init file's `setopt' form containing an `erc-modules' assignment before an `erc-scrolltobottom-all' one would result in conflicting sets of hook members come `erc-open'. Having such option-dependent branching in module setup, while difficult to maintain, is a long held ERC practice, as seen in functions like `erc-nickserv-identify-mode'. Making all new modules "local" may be the most manageable solution because existing global modules can't be made to require prior deactivation. diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 24a3205e0cd..2a787f3e014 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -87,10 +87,15 @@ be experimental. It currently only works with Emacs 28+." (unless erc--updating-modules-p (erc-buffer-do #'erc--scrolltobottom-setup)) (if erc-scrolltobottom-all (progn + (remove-hook 'erc-insert-done-hook #'erc-possibly-scroll-to-bottom) (add-hook 'erc-insert-pre-hook #'erc--scrolltobottom-on-pre-insert 25) (add-hook 'erc-pre-send-functions #'erc--scrolltobottom-on-pre-insert) (add-hook 'erc-insert-done-hook #'erc--scrolltobottom-all) (add-hook 'erc-send-completed-hook #'erc--scrolltobottom-all)) + (remove-hook 'erc-insert-pre-hook #'erc--scrolltobottom-on-pre-insert) + (remove-hook 'erc-pre-send-functions #'erc--scrolltobottom-on-pre-insert) + (remove-hook 'erc-insert-done-hook #'erc--scrolltobottom-all) + (remove-hook 'erc-send-completed-hook #'erc--scrolltobottom-all) (add-hook 'erc-insert-done-hook #'erc-possibly-scroll-to-bottom))) ((remove-hook 'erc-mode-hook #'erc--scrolltobottom-setup) (erc-buffer-do #'erc--scrolltobottom-setup) commit b3abbab63254fd18e1c7bad56d3401b49dd8604c Author: F. Jason Park Date: Sun Aug 31 16:38:30 2025 -0700 Don't touch window configuration in erc-fill prompt hook * lisp/erc/erc-fill.el (erc-fill--wrap-indent-prompt): While computing the prompt indentation's text size, don't bother saving and restoring the window configuration because unwanted scrolls are now believed to be unlikely because of other changes. diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 291dcc2e306..cbe91861e48 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -616,7 +616,9 @@ to be disabled. On Emacs 28 and below, return END minus BEG." ;; `with-selected-window' seems to interfere with the implementation ;; of `erc-scrolltobottom-all' in ERC 5.6, which needs improvement. (if (fboundp 'buffer-text-pixel-size) - ;; `buffer-text-pixel-size' can move point! + ;; This `save-excursion' is likely unnecessary. It was originally + ;; meant to protect point from `buffer-text-pixel-size', which no + ;; longer runs in the selected window's buffer. (save-excursion (save-restriction (narrow-to-region beg end) @@ -745,12 +747,7 @@ See `erc-fill-wrap-mode' for details." ;; Clear an existing `line-prefix' before measuring (bug#64971). (remove-text-properties erc-insert-marker erc-input-marker '(line-prefix nil wrap-prefix nil)) - ;; Restoring window configuration seems to prevent unwanted - ;; recentering reminiscent of `scrolltobottom'-related woes. - (let ((c (and (get-buffer-window) (current-window-configuration))) - (len (erc-fill--wrap-measure erc-insert-marker erc-input-marker))) - (when c - (set-window-configuration c)) + (let ((len (erc-fill--wrap-measure erc-insert-marker erc-input-marker))) (put-text-property erc-insert-marker erc-input-marker 'line-prefix `(space :width (- erc-fill--wrap-value ,len))))) commit 684d09169227714259809a3799c5ba650bb9fecf Author: Sean Whitton Date: Thu Sep 4 11:02:35 2025 +0100 ; * doc/emacs/vc1-xtra.texi (Other Working Trees): New FIXME. diff --git a/doc/emacs/vc1-xtra.texi b/doc/emacs/vc1-xtra.texi index f235ccfa5fb..3a8c939dc1b 100644 --- a/doc/emacs/vc1-xtra.texi +++ b/doc/emacs/vc1-xtra.texi @@ -473,6 +473,10 @@ do and do not exist. In other words, the file or directory the current buffer visits probably exists in other working trees too, and this command lets you switch to those versions of the file. +@c FIXME: It would be better to use @kbd{=} from a *vc-change-log* +@c buffer as the example here, because 'C-x v =' and 'C-x v D' are more +@c likely to be uncommitted changes on which you'd use 'C-x v w a'. +@c That requires a new node for bindings available in *vc-change-log*s. @kbd{C-x v w w} also works in Diff mode (@pxref{Diff Mode}). Instead of switching to a different buffer, the command changes the default directory of the Diff mode buffer to the corresponding directory under commit 8dcb8020466f2a46a2a1a17a9cbe01d2e0a3237f Author: Sean Whitton Date: Tue Sep 2 15:46:23 2025 +0100 ; vc-hooks.el: Standardize terminology in header. diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index a453980ca6e..d0671c7a502 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -1,4 +1,4 @@ -;;; vc-hooks.el --- resident support for version-control -*- lexical-binding:t -*- +;;; vc-hooks.el --- Preloaded support for version control -*- lexical-binding:t -*- ;; Copyright (C) 1992-1996, 1998-2025 Free Software Foundation, Inc. @@ -23,10 +23,9 @@ ;;; Commentary: -;; This is the always-loaded portion of VC. It takes care of -;; VC-related activities that are done when you visit a file, so that -;; vc.el itself is loaded only when you use a VC command. See the -;; commentary of vc.el. +;; This is the preloaded portion of VC. It takes care of VC-related +;; activities that are done when you visit a file, so that vc.el itself +;; is loaded only when you use a VC command. See commentary of vc.el. ;;; Code: