commit 48db8b68a8eb5c12d5682f2eb31cadc53186f5d7 (HEAD, refs/remotes/origin/master) Merge: 4dc5bee98d5 c36fe3df17b Author: Stefan Kangas Date: Sun Dec 25 06:30:21 2022 +0100 Merge from origin/emacs-29 c36fe3df17b Fix c-ts-mode imenu defun name (bug#60296) a24e350170e Fix treesit--children-covering-range-recurse (bug#60301) fbb4eb919b4 Support treesit-defun-name in tree-sitter major modes 6253184afc2 ; * lisp/treesit.el (treesit-defun-at-point): Guard again... f8e219ebfaa Add treesit-defun-name and friends 35c2ca2ca64 Make treesit-node-at/on guess language at point 7f7def2ae62 ; Add treesit-no-parser error b6a2e1ddf66 * nt/INSTALL.W64: update instructions for setting up W64 ... 265b91d891a Revert "; Bump minimum supported Windows version for MinG... 75155e45860 ; Bump minimum supported Windows version for MinGW64 to W... 677f6c79eb9 ; Update minimum requirements of MinGW-w64 7723af5e4aa ; * lisp/progmodes/c-ts-mode.el: quote literal string in ... 38866510c7c ; * src/xdisp.c (redisplay_internal): Reinstate the FRAME... a825aa0b135 Fix definition of CNS 11643-15 charset a42b20dd95e ; * lisp/progmodes/c-ts-mode.el: Add outline section head... e4e36345399 Improve c-ts-mode block comment indent (bug#60270) e30621caa2c ; Add treesit_recursion_limit 6a43af58802 Fix block comment indent and filling for c-ts-mode (bug#5... e492c21e810 Fix treesit_cursor_helper (bug#60267) 4437dbedf7b Fix restart-emacs alarms (Bug#60220) 121a9ff9f6f Fix alternate stack test in configure 84888080eea Add more functions to "string" shortdoc c90f97d4e5d Make the Contour terminal an alias of xterm-256color c3fac9465fa ; Fix punctuation in last change. 756bb422a49 Correct wrong info in (info)Go to node a8c3424d28b Fix typo in TUTORIAL.fr (bug#60261) 24cd2f0daf1 Add some diff-fixup-modifs tests d32091199ae Fix quoted argument in emacsclient-mail.desktop Exec key 286c48137f6 ert-x: Move window selection logic to its own macro 823c49cea85 ; ert-x: Simplify `ert-with-test-buffer-selected' 38c6abe4d0b ; ert-x: Add test for buffer read-only state 0e39ad6fa56 Fix crash after X error commit c36fe3df17b37a705299239d6ef0185ad55b1d3a Author: Yuan Fu Date: Sat Dec 24 18:59:39 2022 -0800 Fix c-ts-mode imenu defun name (bug#60296) Extract out c-ts-mode--declarator-identifier from c-ts-mode--fontify-declarator. * lisp/progmodes/c-ts-mode.el (c-ts-mode--declarator-identifier): New function. (c-ts-mode--fontify-defun): Extract out. (c-ts-mode--defun-name): Use the new function. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 28e99732fe2..5fc44b11e14 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -387,28 +387,32 @@ c-ts-mode--font-lock-settings ;;; Font-lock helpers -(defun c-ts-mode--fontify-declarator (node override start end &rest args) - "Fontify a declarator (whatever under the \"declarator\" field). -For NODE, OVERRIDE, START, END, and ARGS, see -`treesit-font-lock-rules'." +(defun c-ts-mode--declarator-identifier (node) + "Return the identifier of the declarator node NODE." (pcase (treesit-node-type node) + ;; Recurse. ((or "attributed_declarator" "parenthesized_declarator") - (apply #'c-ts-mode--fontify-declarator - (treesit-node-child node 0 t) override start end args)) + (c-ts-mode--declarator-identifier (treesit-node-child node 0 t))) ("pointer_declarator" - (apply #'c-ts-mode--fontify-declarator - (treesit-node-child node -1) override start end args)) + (c-ts-mode--declarator-identifier (treesit-node-child node -1))) ((or "function_declarator" "array_declarator" "init_declarator") - (apply #'c-ts-mode--fontify-declarator - (treesit-node-child-by-field-name node "declarator") - override start end args)) + (c-ts-mode--declarator-identifier + (treesit-node-child-by-field-name node "declarator"))) + ;; Terminal case. ((or "identifier" "field_identifier") - (treesit-fontify-with-override - (treesit-node-start node) (treesit-node-end node) - (pcase (treesit-node-type (treesit-node-parent node)) - ("function_declarator" 'font-lock-function-name-face) - (_ 'font-lock-variable-name-face)) - override start end)))) + node))) + +(defun c-ts-mode--fontify-declarator (node override start end &rest args) + "Fontify a declarator (whatever under the \"declarator\" field). +For NODE, OVERRIDE, START, END, and ARGS, see +`treesit-font-lock-rules'." + (let* ((identifier (c-ts-mode--declarator-identifier node)) + (face (pcase (treesit-node-type (treesit-node-parent identifier)) + ("function_declarator" 'font-lock-function-name-face) + (_ 'font-lock-variable-name-face)))) + (treesit-fontify-with-override + (treesit-node-start identifier) (treesit-node-end identifier) + face override start end))) (defun c-ts-mode--fontify-variable (node override start end &rest _) "Fontify an identifier node if it is a variable. @@ -487,15 +491,9 @@ c-ts-mode--defun-name NODE doesn't have a name." (treesit-node-text (pcase (treesit-node-type node) - ("function_definition" - (treesit-node-child-by-field-name - (treesit-node-child-by-field-name node "declarator") - "declarator")) - ("declaration" - (let ((child (treesit-node-child node -1 t))) - (pcase (treesit-node-type child) - ("identifier" child) - (_ (treesit-node-child-by-field-name child "declarator"))))) + ((or "function_definition" "declaration") + (c-ts-mode--declarator-identifier + (treesit-node-child-by-field-name node "declarator"))) ("struct_specifier" (treesit-node-child-by-field-name node "name"))) t)) commit a24e350170e84d564e510739c8ddf02a7b08f276 Author: Yuan Fu Date: Sat Dec 24 18:45:36 2022 -0800 Fix treesit--children-covering-range-recurse (bug#60301) * lisp/treesit.el (treesit--children-covering-range-recurse): Always return a list of node. diff --git a/lisp/treesit.el b/lisp/treesit.el index 09483acaa7d..0eacd4075f8 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -865,7 +865,7 @@ treesit--children-covering-range-recurse (push child result)) (setq child (treesit-node-next-sibling child))) ;; If NODE has no child, keep NODE. - (or result node))) + (or result (list node)))) (defsubst treesit--node-length (node) "Return the length of the text of NODE." commit fbb4eb919b4c91dd8517a06934bf1f897eaa34bb Author: Yuan Fu Date: Sat Dec 24 18:24:01 2022 -0800 Support treesit-defun-name in tree-sitter major modes * lisp/progmodes/csharp-mode.el (csharp-ts-mode--defun-name): New function. (csharp-ts-mode--imenu-1): Extract into new function. (csharp-ts-mode): Setup treesit-defun-name-function. * lisp/progmodes/java-ts-mode.el (java-ts-mode--defun-name): New function. (java-ts-mode--imenu-1): Extract into new function. (java-ts-mode): Setup treesit-defun-name-function. * lisp/progmodes/js.el (js-treesit-current-defun): Remove function. This function is not used (for a while already). (js--treesit-defun-name): New function. (js--treesit-imenu-1): Extract into new function. (js-ts-mode): Setup treesit-defun-name-function. * lisp/progmodes/json-ts-mode.el (json-ts-mode--defun-name): New function. (json-ts-mode--imenu-1): Extract into new function. (json-ts-mode): Setup treesit-defun-name-function. * lisp/progmodes/python.el (python--treesit-defun-name): New function. (python--imenu-treesit-create-index-1): Extract into new function. (python-ts-mode): Setup treesit-defun-name-function. * lisp/progmodes/rust-ts-mode.el (rust-ts-mode--defun-name): New function. (rust-ts-mode--imenu-1): Extract into new function. (rust-ts-mode): Setup treesit-defun-name-function. * lisp/textmodes/css-mode.el (css--treesit-defun-name): New function. (css--treesit-imenu-1): Extract into new function. (css-ts-mode): Setup treesit-defun-name-function. * lisp/textmodes/toml-ts-mode.el (toml-ts-mode--get-table-name): Remove function. (toml-ts-mode--defun-name): New function. (toml-ts-mode--imenu-1): Extract into new function. (toml-ts-mode): Setup treesit-defun-name-function. diff --git a/lisp/progmodes/csharp-mode.el b/lisp/progmodes/csharp-mode.el index 2d13ae6930c..985e2e7b0bf 100644 --- a/lisp/progmodes/csharp-mode.el +++ b/lisp/progmodes/csharp-mode.el @@ -837,6 +837,22 @@ csharp-ts-mode--font-lock-settings ;;;###autoload (add-to-list 'auto-mode-alist '("\\.cs\\'" . csharp-mode)) +(defun csharp-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." + (pcase (treesit-node-type node) + ((or "method_declaration" + "record_declaration" + "struct_declaration" + "enum_declaration" + "interface_declaration" + "class_declaration" + "class_declaration") + (treesit-node-text + (treesit-node-child-by-field-name + node "name") + t)))) + (defun csharp-ts-mode--imenu-1 (node) "Helper for `csharp-ts-mode--imenu'. Find string representation for NODE and set marker, then recurse @@ -844,10 +860,7 @@ csharp-ts-mode--imenu-1 (let* ((ts-node (car node)) (subtrees (mapcan #'csharp-ts-mode--imenu-1 (cdr node))) (name (when ts-node - (or (treesit-node-text - (or (treesit-node-child-by-field-name - ts-node "name")) - t) + (or (treesit-defun-name ts-node) "Unnamed node"))) (marker (when ts-node (set-marker (make-marker) @@ -935,6 +948,7 @@ csharp-ts-mode ;; Navigation. (setq-local treesit-defun-type-regexp "declaration") + (setq-local treesit-defun-name-function #'csharp-ts-mode--defun-name) ;; Font-lock. (setq-local treesit-font-lock-settings csharp-ts-mode--font-lock-settings) diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el index 9da2c254f87..3e0439ddf54 100644 --- a/lisp/progmodes/java-ts-mode.el +++ b/lisp/progmodes/java-ts-mode.el @@ -248,6 +248,22 @@ java-ts-mode--font-lock-settings '((["," ":" ";"]) @font-lock-delimiter-face)) "Tree-sitter font-lock settings for `java-ts-mode'.") +(defun java-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." + (pcase (treesit-node-type node) + ((or "method_declaration" + "class_declaration" + "record_declaration" + "interface_declaration" + "enum_declaration" + "import_declaration" + "package_declaration" + "module_declaration") + (treesit-node-text + (treesit-node-child-by-field-name node "name") + t)))) + (defun java-ts-mode--imenu-1 (node) "Helper for `java-ts-mode--imenu'. Find string representation for NODE and set marker, then recurse @@ -255,10 +271,7 @@ java-ts-mode--imenu-1 (let* ((ts-node (car node)) (subtrees (mapcan #'java-ts-mode--imenu-1 (cdr node))) (name (when ts-node - (or (treesit-node-text - (or (treesit-node-child-by-field-name - ts-node "name")) - t) + (or (treesit-defun-name ts-node) "Unnamed node"))) (marker (when ts-node (set-marker (make-marker) @@ -334,6 +347,7 @@ java-ts-mode "import_declaration" "package_declaration" "module_declaration"))) + (setq-local treesit-defun-name-function #'java-ts-mode--defun-name) ;; Font-lock. (setq-local treesit-font-lock-settings java-ts-mode--font-lock-settings) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 1b34c0de418..14feed221fb 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -3656,24 +3656,18 @@ js--fontify-template-string (setq font-beg (treesit-node-end child) child (treesit-node-next-sibling child))))) -(defun js-treesit-current-defun () - "Return name of surrounding function. -This function can be used as a value in `which-func-functions'" - (let ((node (treesit-node-at (point))) - (name-list ())) - (cl-loop while node - if (pcase (treesit-node-type node) - ("function_declaration" t) - ("method_definition" t) - ("class_declaration" t) - ("variable_declarator" t) - (_ nil)) - do (push (treesit-node-text - (treesit-node-child-by-field-name node "name") - t) - name-list) - do (setq node (treesit-node-parent node)) - finally return (string-join name-list ".")))) +(defun js--treesit-defun-name (node) + "Return the defun name of NODE. +Return nil if there is no name or if NODE is not a defun node." + (treesit-node-text + (treesit-node-child-by-field-name + (pcase (treesit-node-type node) + ("lexical_declaration" + (treesit-search-subtree node "variable_declarator" nil nil 1)) + ((or "function_declaration" "method_definition" "class_declaration") + node)) + "name") + t)) (defun js--treesit-imenu-1 (node) "Given a sparse tree, create an imenu alist. @@ -3702,15 +3696,8 @@ js--treesit-imenu-1 ("function_declaration" 'function))) ;; The root of the tree could have a nil ts-node. (name (when ts-node - (let ((ts-node-1 - (if (eq type 'variable) - (treesit-search-subtree - ts-node "variable_declarator" nil nil 1) - ts-node))) - (treesit-node-text - (treesit-node-child-by-field-name - ts-node-1 "name") - t)))) + (or (treesit-defun-name ts-node) + "Anonymous"))) (marker (when ts-node (set-marker (make-marker) (treesit-node-start ts-node))))) @@ -3885,6 +3872,7 @@ js-ts-mode "method_definition" "function_declaration" "lexical_declaration"))) + (setq-local treesit-defun-name-function #'js--treesit-defun-name) ;; Fontification. (setq-local treesit-font-lock-settings js--treesit-font-lock-settings) (setq-local treesit-font-lock-feature-list diff --git a/lisp/progmodes/json-ts-mode.el b/lisp/progmodes/json-ts-mode.el index 6c2f3805872..6725c5f2270 100644 --- a/lisp/progmodes/json-ts-mode.el +++ b/lisp/progmodes/json-ts-mode.el @@ -107,6 +107,16 @@ json-ts-mode--font-lock-settings '((ERROR) @font-lock-warning-face)) "Font-lock settings for JSON.") +(defun json-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." + (pcase (treesit-node-type node) + ((or "pair" "object") + (treesit-node-text + (treesit-node-child-by-field-name + node "key") + t)))) + (defun json-ts-mode--imenu-1 (node) "Helper for `json-ts-mode--imenu'. Find string representation for NODE and set marker, then recurse @@ -114,10 +124,8 @@ json-ts-mode--imenu-1 (let* ((ts-node (car node)) (subtrees (mapcan #'json-ts-mode--imenu-1 (cdr node))) (name (when ts-node - (treesit-node-text - (treesit-node-child-by-field-name - ts-node "key") - t))) + (or (treesit-defun-name ts-node) + "Anonymous"))) (marker (when ts-node (set-marker (make-marker) (treesit-node-start ts-node))))) @@ -161,6 +169,7 @@ json-ts-mode ;; Navigation. (setq-local treesit-defun-type-regexp (rx (or "pair" "object"))) + (setq-local treesit-defun-name-function #'json-ts-mode--defun-name) ;; Font-lock. (setq-local treesit-font-lock-settings json-ts-mode--font-lock-settings) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index bdc9e6fa78c..d383fa57c04 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -5448,6 +5448,16 @@ python-imenu-create-flat-index ;;; Tree-sitter imenu +(defun python--treesit-defun-name (node) + "Return the defun name of NODE. +Return nil if there is no name or if NODE is not a defun node." + (pcase (treesit-node-type node) + ((or "function_definition" "class_definition") + (treesit-node-text + (treesit-node-child-by-field-name + node "name") + t)))) + (defun python--imenu-treesit-create-index-1 (node) "Given a sparse tree, create an imenu alist. @@ -5473,9 +5483,8 @@ python--imenu-treesit-create-index-1 ("class_definition" 'class))) ;; The root of the tree could have a nil ts-node. (name (when ts-node - (treesit-node-text - (treesit-node-child-by-field-name - ts-node "name") t))) + (or (treesit-defun-name ts-node) + "Anonymous"))) (marker (when ts-node (set-marker (make-marker) (treesit-node-start ts-node))))) @@ -6643,6 +6652,8 @@ python-ts-mode #'python-imenu-treesit-create-index) (setq-local treesit-defun-type-regexp (rx (or "function" "class") "_definition")) + (setq-local treesit-defun-name-function + #'python--treesit-defun-name) (treesit-major-mode-setup) (when python-indent-guess-indent-offset diff --git a/lisp/progmodes/rust-ts-mode.el b/lisp/progmodes/rust-ts-mode.el index 8b2ed191019..81f5b8765f1 100644 --- a/lisp/progmodes/rust-ts-mode.el +++ b/lisp/progmodes/rust-ts-mode.el @@ -273,6 +273,33 @@ rust-ts-mode--imenu (when struct-index `(("Struct" . ,struct-index))) (when func-index `(("Fn" . ,func-index)))))) +(defun rust-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." + (pcase (treesit-node-type node) + ("enum_item" + (treesit-node-text + (treesit-node-child-by-field-name node "name") t)) + ("function_item" + (treesit-node-text + (treesit-node-child-by-field-name node "name") t)) + ("impl_item" + (let ((trait-node (treesit-node-child-by-field-name node "trait"))) + (concat + (treesit-node-text trait-node t) + (when trait-node " for ") + (treesit-node-text + (treesit-node-child-by-field-name node "type") t)))) + ("mod_item" + (treesit-node-text + (treesit-node-child-by-field-name node "name") t)) + ("struct_item" + (treesit-node-text + (treesit-node-child-by-field-name node "name") t)) + ("type_item" + (treesit-node-text + (treesit-node-child-by-field-name node "name") t)))) + (defun rust-ts-mode--imenu-1 (node) "Helper for `rust-ts-mode--imenu'. Find string representation for NODE and set marker, then recurse @@ -282,31 +309,8 @@ rust-ts-mode--imenu-1 (subtrees (mapcan #'rust-ts-mode--imenu-1 children)) (name (when ts-node - (pcase (treesit-node-type ts-node) - ("enum_item" - (treesit-node-text - (treesit-node-child-by-field-name ts-node "name") t)) - ("function_item" - (treesit-node-text - (treesit-node-child-by-field-name ts-node "name") t)) - ("impl_item" - (let ((trait-node (treesit-node-child-by-field-name ts-node "trait"))) - (concat - (treesit-node-text - trait-node t) - (when trait-node - " for ") - (treesit-node-text - (treesit-node-child-by-field-name ts-node "type") t)))) - ("mod_item" - (treesit-node-text - (treesit-node-child-by-field-name ts-node "name") t)) - ("struct_item" - (treesit-node-text - (treesit-node-child-by-field-name ts-node "name") t)) - ("type_item" - (treesit-node-text - (treesit-node-child-by-field-name ts-node "name") t))))) + (or (treesit-defun-name ts-node) + "Anonymous"))) (marker (when ts-node (set-marker (make-marker) (treesit-node-start ts-node))))) @@ -363,6 +367,7 @@ rust-ts-mode "function_item" "impl_item" "struct_item"))) + (setq-local treesit-defun-name-function #'rust-ts-mode--defun-name) (treesit-major-mode-setup))) diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index 822097a86d8..99ef4f10a06 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -1412,6 +1412,19 @@ css--treesit-settings '((ERROR) @error)) "Tree-sitter font-lock settings for `css-ts-mode'.") +(defun css--treesit-defun-name (node) + "Return the defun name of NODE. +Return nil if there is no name or if NODE is not a defun node." + (pcase (treesit-node-type node) + ("rule_set" (treesit-node-text + (treesit-node-child node 0) t)) + ("media_statement" + (let ((block (treesit-node-child node -1))) + (string-trim + (buffer-substring-no-properties + (treesit-node-start node) + (treesit-node-start block))))))) + (defun css--treesit-imenu-1 (node) "Helper for `css--treesit-imenu'. Find string representation for NODE and set marker, then recurse @@ -1419,15 +1432,8 @@ css--treesit-imenu-1 (let* ((ts-node (car node)) (subtrees (mapcan #'css--treesit-imenu-1 (cdr node))) (name (when ts-node - (pcase (treesit-node-type ts-node) - ("rule_set" (treesit-node-text - (treesit-node-child ts-node 0) t)) - ("media_statement" - (let ((block (treesit-node-child ts-node -1))) - (string-trim - (buffer-substring-no-properties - (treesit-node-start ts-node) - (treesit-node-start block)))))))) + (or (treesit-defun-name ts-node) + "Anonymous"))) (marker (when ts-node (set-marker (make-marker) (treesit-node-start ts-node))))) @@ -1835,6 +1841,7 @@ css-ts-mode (treesit-parser-create 'css) (setq-local treesit-simple-indent-rules css--treesit-indent-rules) (setq-local treesit-defun-type-regexp "rule_set") + (setq-local treesit-defun-name-function #'css--treesit-defun-name) (setq-local treesit-font-lock-settings css--treesit-settings) (setq-local treesit-font-lock-feature-list '((selector comment query keyword) diff --git a/lisp/textmodes/toml-ts-mode.el b/lisp/textmodes/toml-ts-mode.el index bca6a5e81ad..790de2133e8 100644 --- a/lisp/textmodes/toml-ts-mode.el +++ b/lisp/textmodes/toml-ts-mode.el @@ -107,12 +107,12 @@ toml-ts-mode--font-lock-settings '((ERROR) @font-lock-warning-face)) "Font-lock settings for TOML.") -(defun toml-ts-mode--get-table-name (node) - "Obtains the header-name for the associated tree-sitter `NODE'." - (if node - (treesit-node-text - (car (cdr (treesit-node-children node)))) - "Root table")) +(defun toml-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." + (pcase (treesit-node-type node) + ((or "table" "table_array_element") + (car (cdr (treesit-node-children node)))))) (defun toml-ts-mode--imenu-1 (node) "Helper for `toml-ts-mode--imenu'. @@ -120,7 +120,8 @@ toml-ts-mode--imenu-1 the subtrees." (let* ((ts-node (car node)) (subtrees (mapcan #'toml-ts-mode--imenu-1 (cdr node))) - (name (toml-ts-mode--get-table-name ts-node)) + (name (or (treesit-defun-name ts-node) + "Root table")) (marker (when ts-node (set-marker (make-marker) (treesit-node-start ts-node))))) @@ -167,6 +168,7 @@ toml-ts-mode ;; Navigation. (setq-local treesit-defun-type-regexp (rx (or "table" "table_array_element"))) + (setq-local treesit-defun-name-function #'toml-ts-mode--defun-name) ;; Font-lock. (setq-local treesit-font-lock-settings toml-ts-mode--font-lock-settings) commit 6253184afc2e53c6782a41ec1b59779449152172 Author: Yuan Fu Date: Sat Dec 24 16:40:00 2022 -0800 ; * lisp/treesit.el (treesit-defun-at-point): Guard against nil. diff --git a/lisp/treesit.el b/lisp/treesit.el index 355c6b6b99a..09483acaa7d 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1690,7 +1690,9 @@ treesit--defuns-around parent defun surrounding POS. All of three could be nil if no sound defun exists. -REGEXP and PRED are the same as in `treesit-defun-type-regexp'." +REGEXP and PRED are the same as in `treesit-defun-type-regexp'. + +Assumes `treesit-defun-type-regexp' is set." (let* ((node (treesit-node-at pos)) ;; NODE-BEFORE/AFTER = NODE when POS is completely in NODE, ;; but if not, that means point could be in between two @@ -1876,26 +1878,30 @@ treesit--navigate-defun ;; TODO: In corporate into thing-at-point. (defun treesit-defun-at-point () - "Return the defun at point or nil if none is found. + "Return the defun node at point or nil if none is found. Respects `treesit-defun-tactic': return the top-level defun if it is `top-level', return the immediate parent defun if it is -`nested'." - (pcase-let* ((`(,regexp . ,pred) - (if (consp treesit-defun-type-regexp) - treesit-defun-type-regexp - (cons treesit-defun-type-regexp nil))) - (`(,_ ,next ,parent) - (treesit--defuns-around (point) regexp pred)) - ;; If point is at the beginning of a defun, we - ;; prioritize that defun over the parent in nested - ;; mode. - (node (or (and (eq (treesit-node-start next) (point)) - next) - parent))) - (if (eq treesit-defun-tactic 'top-level) - (treesit--top-level-defun node regexp pred) - node))) +`nested'. + +Return nil if `treesit-defun-type-regexp' is not set." + (when treesit-defun-type-regexp + (pcase-let* ((`(,regexp . ,pred) + (if (consp treesit-defun-type-regexp) + treesit-defun-type-regexp + (cons treesit-defun-type-regexp nil))) + (`(,_ ,next ,parent) + (treesit--defuns-around (point) regexp pred)) + ;; If point is at the beginning of a defun, we + ;; prioritize that defun over the parent in nested + ;; mode. + (node (or (and (eq (treesit-node-start next) (point)) + next) + parent))) + (if (eq treesit-defun-tactic 'top-level) + (treesit--top-level-defun node regexp pred) + node)))) + (defun treesit-defun-name (node) "Return the defun name of NODE. commit f8e219ebfaa286f4e7240640799020bb5b6e07b3 Author: Yuan Fu Date: Sat Dec 24 16:33:35 2022 -0800 Add treesit-defun-name and friends 1. We now have treesit-defun-name, powered by treesit-defun-name-function. 2. We now have treesit-add-log-current-defun, which powers add-log-current-defun. 3. c-ts-mode updates its code to take advantage of these new features. 4. Manual updates. * doc/lispref/parsing.texi (Tree-sitter major modes): Add manual for new functions. * lisp/progmodes/c-ts-mode.el (c-ts-mode--defun-name): New function. (c-ts-mode--imenu-1): Extract out into c-ts-mode--defun-name. (c-ts-base-mode): Setup treesit-defun-name-function. * lisp/treesit.el (treesit-defun-name-function) (treesit-add-log-defun-delimiter): New variables. (treesit-defun-at-point) (treesit-defun-name): New functions. (treesit-major-mode-setup): Setup add-log-current-defun-function. diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index e213363298d..918e197676e 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -1727,6 +1727,9 @@ Tree-sitter major modes If @code{treesit-defun-type-regexp} is non-@code{nil}, it sets up navigation functions for @code{beginning-of-defun} and @code{end-of-defun}. +@item +If @code{treesit-defun-name-function} is non-@code{nil}, it sets up +add-log functions used by @code{add-log-current-defun}. @end itemize @end defun @@ -1737,6 +1740,41 @@ Tree-sitter major modes For supporting mixing of multiple languages in a major mode, @pxref{Multiple Languages}. +Besides @code{beginning-of-defun} and @code{end-of-defun}, Emacs +provides some additional functions for working with defuns: +@code{treesit-defun-at-point} returns the defun node at point, and +@code{treesit-defun-name} returns the name of a defun node. + +@defun treesit-defun-at-point +This function returns the defun node at point, or @code{nil} if none +is found. It respects @code{treesit-defun-tactic}: it returns the +top-level defun if the value is @code{top-level}, and returns the +immediate enclosing defun if the value is @code{nested}. + +This function requires @code{treesit-defun-type-regexp} to work. If +it is @code{nil}, this function simply returns @code{nil}. +@end defun + +@defun treesit-defun-name node +This function returns the defun name of @var{node}. It returns +@code{nil} if there is no defun name for @var{node}, or if @var{node} +is not a defun node, or if @var{node} is @code{nil}. + +The defun name is names like function name, class name, struct name, +etc. + +If @code{treesit-defun-name-function} is @code{nil}, this function +always returns @code{nil}. +@end defun + +@defvar treesit-defun-name-function +If non-@code{nil}, this variable should store a function that is +called with a node and returns the defun name of it. The function +should have the same semantic as @code{treesit-defun-name}: if the +node is not a defun node, or the node is a defun node but doesn't have +a name, or the node is @code{nil}, return @code{nil}. +@end defvar + @node Tree-sitter C API @section Tree-sitter C API Correspondence diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index d3291722331..28e99732fe2 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -481,6 +481,25 @@ c-ts-mode--fontify-error ;;; Imenu +(defun c-ts-mode--defun-name (node) + "Return the name of the defun NODE. +Return nil if NODE is not a defun node, return an empty string if +NODE doesn't have a name." + (treesit-node-text + (pcase (treesit-node-type node) + ("function_definition" + (treesit-node-child-by-field-name + (treesit-node-child-by-field-name node "declarator") + "declarator")) + ("declaration" + (let ((child (treesit-node-child node -1 t))) + (pcase (treesit-node-type child) + ("identifier" child) + (_ (treesit-node-child-by-field-name child "declarator"))))) + ("struct_specifier" + (treesit-node-child-by-field-name node "name"))) + t)) + (defun c-ts-mode--imenu-1 (node) "Helper for `c-ts-mode--imenu'. Find string representation for NODE and set marker, then recurse @@ -488,22 +507,7 @@ c-ts-mode--imenu-1 (let* ((ts-node (car node)) (subtrees (mapcan #'c-ts-mode--imenu-1 (cdr node))) (name (when ts-node - (treesit-node-text - (pcase (treesit-node-type ts-node) - ("function_definition" - (treesit-node-child-by-field-name - (treesit-node-child-by-field-name - ts-node "declarator") - "declarator")) - ("declaration" - (let ((child (treesit-node-child ts-node -1 t))) - (pcase (treesit-node-type child) - ("identifier" child) - (_ (treesit-node-child-by-field-name - child "declarator"))))) - ("struct_specifier" - (treesit-node-child-by-field-name - ts-node "name")))))) + (treesit-defun-name ts-node))) (marker (when ts-node (set-marker (make-marker) (treesit-node-start ts-node))))) @@ -682,6 +686,7 @@ c-ts-base-mode "class_specifier")) #'c-ts-mode--defun-valid-p)) (setq-local treesit-defun-skipper #'c-ts-mode--defun-skipper) + (setq-local treesit-defun-name-function #'c-ts-mode--defun-name) ;; Nodes like struct/enum/union_specifier can appear in ;; function_definitions, so we need to find the top-level node. diff --git a/lisp/treesit.el b/lisp/treesit.el index 2b30da4be7a..355c6b6b99a 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1612,6 +1612,17 @@ treesit-defun-skipper If the value is nil, no skipping is performed.") +(defvar-local treesit-defun-name-function nil + "A function called with a node and returns the name of it. +If the node is a defun node, return the defun name. E.g., the +function name of a function. If the node is not a defun node, or +the defun node doesn't have a name, or the node is nil, return +nil.") + +(defvar-local treesit-add-log-defun-delimiter "." + "The delimiter used to connect several defun names. +This is used in `treesit-add-log-current-defun'.") + (defun treesit-beginning-of-defun (&optional arg) "Move backward to the beginning of a defun. @@ -1885,6 +1896,34 @@ treesit-defun-at-point (if (eq treesit-defun-tactic 'top-level) (treesit--top-level-defun node regexp pred) node))) +(defun treesit-defun-name (node) + "Return the defun name of NODE. + +Return nil if there is no name, or if NODE is not a defun node, +or if NODE is nil. + +If `treesit-defun-name-function' is nil, always return nil." + (when treesit-defun-name-function + (funcall treesit-defun-name-function node))) + +(defun treesit-add-log-current-defun () + "Return the name of the defun at point. + +Used for `add-log-current-defun-function'. + +The delimiter between nested defun names is controlled by +`treesit-add-log-defun-delimiter'." + (let ((node (treesit-defun-at-point)) + (name nil)) + (while node + (when-let ((new-name (treesit-defun-name node))) + (if name + (setq name (concat new-name + treesit-add-log-defun-delimiter + name)) + (setq name new-name))) + (setq node (treesit-node-parent node))) + name)) ;;; Activating tree-sitter @@ -1979,7 +2018,11 @@ treesit-major-mode-setup ;; the variables. In future we should update `end-of-defun' to ;; work with nested defuns. (setq-local beginning-of-defun-function #'treesit-beginning-of-defun) - (setq-local end-of-defun-function #'treesit-end-of-defun))) + (setq-local end-of-defun-function #'treesit-end-of-defun)) + ;; Defun name. + (when treesit-defun-name-function + (setq-local add-log-current-defun-function + #'treesit-add-log-current-defun))) ;;; Debugging commit 35c2ca2ca64070f6ebc75011e5e6e2d688124bec Author: Yuan Fu Date: Sat Dec 24 15:31:03 2022 -0800 Make treesit-node-at/on guess language at point If PARSER-OR-LANG is nil, it makes more sense to guess the language at point by treesit-language-at than to simply use the first parser in the parser list. * doc/lispref/parsing.texi (Retrieving Nodes): Update manual. * lisp/treesit.el (treesit-node-at) (treesit-node-on): Guess language at point. Update docstring. (treesit-buffer-root-node): Update docstring. diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi index adb4c5e6e0c..e213363298d 100644 --- a/doc/lispref/parsing.texi +++ b/doc/lispref/parsing.texi @@ -576,12 +576,12 @@ Retrieving Nodes Finally, if there is no leaf node after @var{pos}, return the first leaf node before @var{pos}. -When @var{parser-or-lang} is @code{nil} or omitted, this function uses -the first parser in @code{(treesit-parser-list)} of the current -buffer. If @var{parser-or-lang} is a parser object, it uses that -parser; if @var{parser-or-lang} is a language, it finds the first -parser using that language in @code{(treesit-parser-list)}, and uses -that. +If @var{parser-or-lang} is a parser object, this function uses that +parser; if @var{parser-or-lang} is a language, this function uses the +first parser for that language in the current buffer, or creates one +if none exists; if @var{parser-or-lang} is @code{nil}, this function +tries to guess the language at @var{pos} by +@code{treesit-language-at}. If this function cannot find a suitable node to return, it returns @code{nil}. @@ -610,13 +610,14 @@ Retrieving Nodes inside any top-level construct (function definition, etc.) most probably will give you the root node, because the root node is the smallest node that covers that empty line. Most of the time, you want -to use @code{treesit-node-at}, described above, instead. +to use @code{treesit-node-at} instead. -When @var{parser-or-lang} is @code{nil}, this function uses the first -parser in @code{(treesit-parser-list)} of the current buffer. If -@var{parser-or-lang} is a parser object, it uses that parser; if -@var{parser-or-lang} is a language, it finds the first parser using -that language in @code{(treesit-parser-list)}, and uses that. +If @var{parser-or-lang} is a parser object, this function uses that +parser; if @var{parser-or-lang} is a language, this function uses the +first parser for that language in the current buffer, or creates one +if none exists; if @var{parser-or-lang} is @code{nil}, this function +tries to guess the language at @var{beg} by +@code{treesit-language-at}. If @var{named} is non-@code{nil}, this function looks for a named node only (@pxref{tree-sitter named node, named node}). @@ -628,9 +629,10 @@ Retrieving Nodes @end defun @defun treesit-buffer-root-node &optional language -This function finds the first parser that uses @var{language} in -@code{(treesit-parser-list)} of the current buffer, and returns the -root node generated by that parser. If it cannot find an appropriate +This function finds the first parser for @var{language} in the current +buffer, or creates one if none exists, and returns the root node +generated by that parser. If @var{language} is omitted, it uses the +first parser in the parser list. If it cannot find an appropriate parser, it returns @code{nil}. @end defun diff --git a/lisp/treesit.el b/lisp/treesit.el index 3d9c61b9dc9..2b30da4be7a 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -171,13 +171,15 @@ treesit-node-at Return nil if no leaf node can be returned. If NAMED is non-nil, only look for named nodes. -If PARSER-OR-LANG is nil, use the first parser in -`treesit-parser-list'; if PARSER-OR-LANG is a parser, use -that parser; if PARSER-OR-LANG is a language, find a parser using -that language in the current buffer, and use that." +If PARSER-OR-LANG is a parser, use that parser; if PARSER-OR-LANG +is a language, find the first parser for that language in the +current buffer, or create one if none exists; If PARSER-OR-LANG +is nil, try to guess the language at POS by +`treesit-language-at'." (let* ((root (if (treesit-parser-p parser-or-lang) (treesit-parser-root-node parser-or-lang) - (treesit-buffer-root-node parser-or-lang))) + (treesit-buffer-root-node + (or parser-or-lang (treesit-language-at pos))))) (node root) (node-before root) (pos-1 (max (1- pos) (point-min))) @@ -219,13 +221,15 @@ treesit-node-on Return nil if none was found. If NAMED is non-nil, only look for named node. -If PARSER-OR-LANG is nil, use the first parser in -`treesit-parser-list'; if PARSER-OR-LANG is a parser, use -that parser; if PARSER-OR-LANG is a language, find a parser using -that language in the current buffer, and use that." +If PARSER-OR-LANG is a parser, use that parser; if PARSER-OR-LANG +is a language, find the first parser for that language in the +current buffer, or create one if none exists; If PARSER-OR-LANG +is nil, try to guess the language at BEG by +`treesit-language-at'." (let ((root (if (treesit-parser-p parser-or-lang) (treesit-parser-root-node parser-or-lang) - (treesit-buffer-root-node parser-or-lang)))) + (treesit-buffer-root-node + (or parser-or-lang (treesit-language-at beg)))))) (treesit-node-descendant-for-range root beg (or end beg) named))) (defun treesit-node-top-level (node &optional type) @@ -246,10 +250,10 @@ treesit-node-top-level (defun treesit-buffer-root-node (&optional language) "Return the root node of the current buffer. -Use the first parser in `treesit-parser-list'. -If optional argument LANGUAGE is non-nil, use the first parser -for LANGUAGE." +Use the first parser in the parser list if LANGUAGE is omitted. +If LANGUAGE is non-nil, use the first parser for LANGUAGE in the +parser list, or create one if none exists." (if-let ((parser (if language (treesit-parser-create language) commit 7f7def2ae62c80fa2fd0c73087b59060b303c230 Author: Yuan Fu Date: Sat Dec 24 14:48:50 2022 -0800 ; Add treesit-no-parser error * lisp/treesit.el (treesit-no-parser): New error. (treesit-buffer-root-node): Use the new error. diff --git a/lisp/treesit.el b/lisp/treesit.el index 845e6ab3883..3d9c61b9dc9 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -141,6 +141,9 @@ treesit-language-at ;;; Node API supplement +(define-error 'treesit-no-parser "No available parser for this buffer" + 'treesit-error) + (defun treesit-node-buffer (node) "Return the buffer in which NODE belongs." (treesit-parser-buffer @@ -248,11 +251,10 @@ treesit-buffer-root-node If optional argument LANGUAGE is non-nil, use the first parser for LANGUAGE." (if-let ((parser - (or (if language - (treesit-parser-create language) - (or (car (treesit-parser-list)) - (signal 'treesit-error - '("Buffer has no parser"))))))) + (if language + (treesit-parser-create language) + (or (car (treesit-parser-list)) + (signal 'treesit-no-parser (list (current-buffer))))))) (treesit-parser-root-node parser))) (defun treesit-filter-child (node pred &optional named) commit b6a2e1ddf664513d04026f7b9d78e9c65f1a3e2e Author: Óscar Fuentes Date: Sun Dec 25 03:18:28 2022 +0100 * nt/INSTALL.W64: update instructions for setting up W64 environment diff --git a/nt/INSTALL.W64 b/nt/INSTALL.W64 index 26420214b79..b1f5dabaaff 100644 --- a/nt/INSTALL.W64 +++ b/nt/INSTALL.W64 @@ -27,22 +27,16 @@ MinGW-w64 provides a complete runtime for projects built with GCC for 64-bit Windows -- it's located at https://mingw-w64.org/. MSYS2 is a Cygwin-derived software distribution for Windows which provides -build tools for MinGW-w64 -- see https://msys2.github.io/. +build tools for MinGW-w64 -- see https://msys2.org/. ** Download and install MinGW-w64 and MSYS2 -You can download the x86_64 version of MSYS2 (i.e. msys2-x86_64-.exe) -from - - https://sourceforge.net/projects/msys2/files/Base/x86_64 - -Run this file to install MSYS2 in your preferred directory, e.g. the default -C:\msys64 -- this will install MinGW-w64 also. Note that directory names -containing spaces may cause problems. +Go to https://msys2.org and follow the instructions. It is not +necessary to install the packages suggested on those instructions. ** Download and install the necessary packages -Run c:/msys64/msys2.exe in your MSYS2 directory and you will see a BASH window +Run mingw64.exe in your MSYS2 directory and you will see a BASH window opened. In the BASH prompt, use the following command to install the necessary @@ -122,10 +116,6 @@ put the Emacs source into C:\emacs\emacs-26: Now you're ready to build and install Emacs with autogen, configure, make, and make install. -First we need to switch to the MinGW-w64 environment. Exit the MSYS2 BASH -console and run mingw64.exe in the C:\msys64 folder, then cd back to -your Emacs source directory, e.g.: - cd /c/emacs/emacs-26 ** Run autogen commit 265b91d891adfad1051db38c6d2202d28cd0f67b Author: Eli Zaretskii Date: Sat Dec 24 21:39:26 2022 +0200 Revert "; Bump minimum supported Windows version for MinGW64 to Windows 10." This reverts commit 75155e458601a3597d382660d0be863ab4d512c0. Evidently, some MSYS2/MinGW64 folks still think Windows 8.1 is the minimum supported version, even though MinGW-w64 switched to Windows 10 as the default target in January 2022. diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 6db9e6d5be8..634480cce7d 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -3487,9 +3487,9 @@ The error message might be something like This happens if you try to build Emacs on versions of MS-Windows older than the minimum version supported by MinGW-w64. As of Dec 2022, the -minimum Windows version supported by MSYS2/MinGW-w64 is 10, and the -computer hardware (CPU, memory, disk) should also match the minimum -Windows 10 requirements. +minimum supported Windows version is 8.1, and the computer hardware +(CPU, memory, disk) should also match the minimum Windows 8.1 +requirements. *** Segfault during 'make' diff --git a/nt/INSTALL.W64 b/nt/INSTALL.W64 index cfb913a81e4..26420214b79 100644 --- a/nt/INSTALL.W64 +++ b/nt/INSTALL.W64 @@ -18,8 +18,8 @@ Emacs with the full repository, or less if you're using a release tarball. As of December 2022, the minimum supported system, both for building Emacs with the MSYS2/MinGW-w64 toolchain and for running the produced -binary, is Windows 10. The computer hardware should also match the -Microsoft requirements for Windows 10. +binary, is Windows 8.1. The computer hardware should also match the +Microsoft requirements for Windows 8.1. * Set up the MinGW-w64 / MSYS2 build environment commit 75155e458601a3597d382660d0be863ab4d512c0 Author: Eli Zaretskii Date: Sat Dec 24 20:45:08 2022 +0200 ; Bump minimum supported Windows version for MinGW64 to Windows 10. diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 634480cce7d..6db9e6d5be8 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -3487,9 +3487,9 @@ The error message might be something like This happens if you try to build Emacs on versions of MS-Windows older than the minimum version supported by MinGW-w64. As of Dec 2022, the -minimum supported Windows version is 8.1, and the computer hardware -(CPU, memory, disk) should also match the minimum Windows 8.1 -requirements. +minimum Windows version supported by MSYS2/MinGW-w64 is 10, and the +computer hardware (CPU, memory, disk) should also match the minimum +Windows 10 requirements. *** Segfault during 'make' diff --git a/nt/INSTALL.W64 b/nt/INSTALL.W64 index 26420214b79..cfb913a81e4 100644 --- a/nt/INSTALL.W64 +++ b/nt/INSTALL.W64 @@ -18,8 +18,8 @@ Emacs with the full repository, or less if you're using a release tarball. As of December 2022, the minimum supported system, both for building Emacs with the MSYS2/MinGW-w64 toolchain and for running the produced -binary, is Windows 8.1. The computer hardware should also match the -Microsoft requirements for Windows 8.1. +binary, is Windows 10. The computer hardware should also match the +Microsoft requirements for Windows 10. * Set up the MinGW-w64 / MSYS2 build environment commit 4dc5bee98d5734b4f7113b961bafead1eb091bd0 Author: Juri Linkov Date: Sat Dec 24 20:04:56 2022 +0200 * lisp/tab-bar.el: Fix the recent removal of substring as a gv-place. (tab-bar-auto-width): Copy more logic from 'cl--set-substring' (bug#60297). diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 0bab3aba801..7433f5c8e51 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -1116,7 +1116,8 @@ tab-bar-auto-width (del-pos2 (if close-p -1 nil))) (while continue (setq name (concat (substring name 0 del-pos1) - (substring name del-pos2))) + (and del-pos2 + (substring name del-pos2)))) (setq curr-width (string-pixel-width name)) (if (and (> curr-width width) (< curr-width prev-width)) commit 677f6c79eb96e128399e8a0480769ec1fe8240ff Author: Eli Zaretskii Date: Sat Dec 24 18:46:58 2022 +0200 ; Update minimum requirements of MinGW-w64 * etc/PROBLEMS (Dumping): * nt/INSTALL.W64: Update the minimum OS version supported by MinGW-w64. diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 2169ed0f80b..634480cce7d 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -3479,6 +3479,18 @@ with development builds, since the .elc files are pre-compiled in releases. ** Dumping +*** temacs.exe fails to run when invoked by the build for dumping + +The error message might be something like + + make[2]: *** [Makefile:915: bootstrap-emacs.pdmp] Error 127 + +This happens if you try to build Emacs on versions of MS-Windows older +than the minimum version supported by MinGW-w64. As of Dec 2022, the +minimum supported Windows version is 8.1, and the computer hardware +(CPU, memory, disk) should also match the minimum Windows 8.1 +requirements. + *** Segfault during 'make' If Emacs segfaults when 'make' executes one of these commands: diff --git a/nt/INSTALL.W64 b/nt/INSTALL.W64 index 9261c82db1b..26420214b79 100644 --- a/nt/INSTALL.W64 +++ b/nt/INSTALL.W64 @@ -6,7 +6,7 @@ This document describes how to compile a 64-bit GNU Emacs using MSYS2 and MinGW-w64. For instructions for building a 32-bit Emacs using -MSYS and MinGW, see the file INSTALL in this directory. +MSYS and mingw.org's MinGW, see the file INSTALL in this directory. Do not use this recipe with Cygwin. For building on Cygwin, use the normal installation instructions in ../INSTALL. @@ -16,6 +16,11 @@ installation instructions in ../INSTALL. The total space required is 3GB: 1.8GB for MSYS2 / MinGW-w64 and 1.2GB for Emacs with the full repository, or less if you're using a release tarball. +As of December 2022, the minimum supported system, both for building +Emacs with the MSYS2/MinGW-w64 toolchain and for running the produced +binary, is Windows 8.1. The computer hardware should also match the +Microsoft requirements for Windows 8.1. + * Set up the MinGW-w64 / MSYS2 build environment MinGW-w64 provides a complete runtime for projects built with GCC for 64-bit commit 7723af5e4aa8304e244c285d489ca733b8a6cac3 Author: Mattias Engdegård Date: Sat Dec 24 17:01:36 2022 +0100 ; * lisp/progmodes/c-ts-mode.el: quote literal string in regexp diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 471d9a3dec0..d3291722331 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -636,7 +636,7 @@ c-ts-mode--fill-paragraph ;; filling region. (when (not end-marker) (goto-char end) - (when (looking-back "*/" 2) + (when (looking-back (rx "*/") 2) (backward-char 2) (skip-syntax-backward "-") (setq end (point)))) commit 1748361c68aeb3e18e6007369f153657227e6059 Author: Mattias Engdegård Date: Sat Dec 24 10:39:57 2022 +0100 Fix condition-case empty success handler misinterpretation (condition-case X E (:success)) should return nil; the compiler behaves correctly in this case. * src/eval.c (internal_lisp_condition_case): Evaluate an empty :success handler as nil instead of pretending it isn't there. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--test-cases): Add test case. diff --git a/src/eval.c b/src/eval.c index 99f3650fc9b..cff4b924778 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1367,7 +1367,7 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform, error ("Invalid condition handler: %s", SDATA (Fprin1_to_string (tem, Qt, Qnil))); if (CONSP (tem) && EQ (XCAR (tem), QCsuccess)) - success_handler = XCDR (tem); + success_handler = tem; else clausenb++; } @@ -1430,7 +1430,7 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform, if (!NILP (success_handler)) { if (NILP (var)) - return Fprogn (success_handler); + return Fprogn (XCDR (success_handler)); Lisp_Object handler_var = var; if (!NILP (Vinternal_interpreter_environment)) @@ -1442,7 +1442,7 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform, specpdl_ref count = SPECPDL_INDEX (); specbind (handler_var, result); - return unbind_to (count, Fprogn (success_handler)); + return unbind_to (count, Fprogn (XCDR (success_handler))); } return result; } diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 36f541e867c..47200de7a02 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -752,6 +752,11 @@ bytecomp-tests--test-cases (condition-case nil (characterp x) ; value (no :success, no var) (error 'bad))) + + (condition-case nil + (bytecomp-test-identity 3) + (error 'bad) + (:success)) ; empty handler ) "List of expressions for cross-testing interpreted and compiled code.") commit 8bb8cc5b49a0cb681327ce9abe38266d5e26d19c Author: Mattias Engdegård Date: Fri Dec 23 20:04:22 2022 +0100 Fix condition-case body for-effect miscompilation (condition-case x A (:success B)) should not compile A for-effect even if the entire form is in for-effect context. * lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Don't optimise the condition-case body form for effect (potentially discarding its value) if there is a success handler and a variable. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--test-cases): Add test cases. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 898dfffef63..ab35b0dde8f 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -410,7 +410,10 @@ byte-optimize-form-code-walker (`(condition-case ,var ,exp . ,clauses) `(,fn ,var ;Not evaluated. - ,(byte-optimize-form exp for-effect) + ,(byte-optimize-form exp + (if (assq :success clauses) + (null var) + for-effect)) ,@(mapcar (lambda (clause) (let ((byte-optimize--lexvars (and lexical-binding diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 3400128759a..36f541e867c 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -704,6 +704,54 @@ bytecomp-tests--test-cases (let ((bytecomp-tests--xx 1)) (set (make-local-variable 'bytecomp-tests--xx) 2) bytecomp-tests--xx) + + ;; Check for-effect optimisation of `condition-case' body form. + ;; With `condition-case' in for-effect context: + (let ((x (bytecomp-test-identity ?A)) + (r nil)) + (condition-case e + (characterp x) ; value (:success, var) + (error (setq r 'bad)) + (:success (setq r (list 'good e)))) + r) + (let ((x (bytecomp-test-identity ?B)) + (r nil)) + (condition-case nil + (characterp x) ; for-effect (:success, no var) + (error (setq r 'bad)) + (:success (setq r 'good))) + r) + (let ((x (bytecomp-test-identity ?C)) + (r nil)) + (condition-case e + (characterp x) ; for-effect (no :success, var) + (error (setq r (list 'bad e)))) + r) + (let ((x (bytecomp-test-identity ?D)) + (r nil)) + (condition-case nil + (characterp x) ; for-effect (no :success, no var) + (error (setq r 'bad))) + r) + ;; With `condition-case' in value context: + (let ((x (bytecomp-test-identity ?E))) + (condition-case e + (characterp x) ; for-effect (:success, var) + (error (list 'bad e)) + (:success (list 'good e)))) + (let ((x (bytecomp-test-identity ?F))) + (condition-case nil + (characterp x) ; for-effect (:success, no var) + (error 'bad) + (:success 'good))) + (let ((x (bytecomp-test-identity ?G))) + (condition-case e + (characterp x) ; value (no :success, var) + (error (list 'bad e)))) + (let ((x (bytecomp-test-identity ?H))) + (condition-case nil + (characterp x) ; value (no :success, no var) + (error 'bad))) ) "List of expressions for cross-testing interpreted and compiled code.") commit 38866510c7c76cd4f84d0ba02c0f0914a56a17f2 Author: Eli Zaretskii Date: Sat Dec 24 12:27:17 2022 +0200 ; * src/xdisp.c (redisplay_internal): Reinstate the FRAME_LIVE_P test. diff --git a/src/xdisp.c b/src/xdisp.c index 4e5250486f5..ea2d11e8b4e 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -16867,6 +16867,10 @@ #define AINC(a,i) \ else if (!REDISPLAY_SOME_P ()) f->redisplay = true; + /* The X error handler may have deleted that frame. */ + if (!FRAME_LIVE_P (f)) + continue; + /* Any scroll bars which redisplay_windows should have nuked should now go away. */ if (gcscrollbars && FRAME_TERMINAL (f)->judge_scroll_bars_hook) commit a825aa0b135b206682bd7f84baa0fd7a7b8f3845 Author: Eli Zaretskii Date: Sat Dec 24 12:08:43 2022 +0200 Fix definition of CNS 11643-15 charset * lisp/international/mule-conf.el (chinese-cns11643-15): Fix :code-offset value. (Bug#60275) * lisp/international/characters.el: Add chinese-cns11643-15 to charsets whose characters have categories c and C. diff --git a/lisp/international/characters.el b/lisp/international/characters.el index 9dcae187f21..42344d499cf 100644 --- a/lisp/international/characters.el +++ b/lisp/international/characters.el @@ -184,7 +184,7 @@ ?L (dolist (c '(chinese-cns11643-1 chinese-cns11643-2 chinese-cns11643-3 chinese-cns11643-4 chinese-cns11643-5 chinese-cns11643-6 - chinese-cns11643-7)) + chinese-cns11643-7 chinese-cns11643-15)) (map-charset-chars #'modify-category-entry c ?c) (if (eq c 'chinese-cns11643-1) (map-charset-chars #'modify-category-entry c ?C #x4421 #x7E7E) diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el index 3f3ac6064ae..65ba2370fcf 100644 --- a/lisp/international/mule-conf.el +++ b/lisp/international/mule-conf.el @@ -1268,7 +1268,7 @@ 'chinese-cns11643-15 :short-name "CNS11643-15" :long-name "CNS11643-15 (Chinese traditional)" :code-space [33 126 33 126] - :code-offset #x27A000 + :code-offset #x28083A ; Right after 'big5-hkscs. :unify-map "CNS-F") (unify-charset 'chinese-gb2312) commit cc2cc0c2971bf867283d1478bd0d99c2f420f982 Author: Paul Eggert Date: Sat Dec 24 01:08:21 2022 -0800 Assume make-directory handler follows new API Suggested by Michael Albinus (Bug#58919#56). * lisp/files.el (files--ensure-directory): Omit recently-added arg MKDIR, since it is now always make-directory again. All uses changed. (make-directory): Assume the make-directory handler follows the new API where it yields non-nil if DIR already exists. This reverts some of the recent changes in this area, and simplifies this funciton. diff --git a/lisp/files.el b/lisp/files.el index f352d3a9a7e..0fb080b53c0 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -6193,11 +6193,11 @@ rename-uniquely (rename-buffer (generate-new-buffer-name base-name)) (force-mode-line-update)))) -(defun files--ensure-directory (mkdir dir) - "Use function MKDIR to make directory DIR if it is not already a directory. +(defun files--ensure-directory (dir) + "Make directory DIR if it is not already a directory. Return non-nil if DIR is already a directory." (condition-case err - (funcall mkdir dir) + (make-directory-internal dir) (error (or (file-directory-p dir) (signal (car err) (cdr err)))))) @@ -6223,32 +6223,27 @@ make-directory ;; If default-directory is a remote directory, ;; make sure we find its make-directory handler. (setq dir (expand-file-name dir)) - (let ((mkdir (if-let ((handler (find-file-name-handler dir 'make-directory))) - #'(lambda (dir) - ;; Use 'ignore' since the handler might be designed for - ;; Emacs 28-, so it might return an (undocumented) - ;; non-nil value, whereas the Emacs 29+ convention is - ;; to return nil here. - (ignore (funcall handler 'make-directory dir))) - #'make-directory-internal))) - (if (not parents) - (funcall mkdir dir) - (let ((dir (directory-file-name (expand-file-name dir))) - already-dir create-list parent) - (while (progn - (setq parent (directory-file-name - (file-name-directory dir))) - (condition-case () - (ignore (setq already-dir - (files--ensure-directory mkdir dir))) - (error - ;; Do not loop if root does not exist (Bug#2309). - (not (string= dir parent))))) - (setq create-list (cons dir create-list) - dir parent)) - (dolist (dir create-list) - (setq already-dir (files--ensure-directory mkdir dir))) - already-dir)))) + (let ((handler (find-file-name-handler dir 'make-directory))) + (if handler + (funcall handler 'make-directory dir parents) + (if (not parents) + (make-directory-internal dir) + (let ((dir (directory-file-name (expand-file-name dir))) + already-dir create-list parent) + (while (progn + (setq parent (directory-file-name + (file-name-directory dir))) + (condition-case () + (ignore (setq already-dir + (files--ensure-directory dir))) + (error + ;; Do not loop if root does not exist (Bug#2309). + (not (string= dir parent))))) + (setq create-list (cons dir create-list) + dir parent)) + (dolist (dir create-list) + (setq already-dir (files--ensure-directory dir))) + already-dir))))) (defun make-empty-file (filename &optional parents) "Create an empty file FILENAME. commit a42b20dd95e4ca522c090f9edf110dcd132b616f Author: Yuan Fu Date: Sat Dec 24 00:16:45 2022 -0800 ; * lisp/progmodes/c-ts-mode.el: Add outline section headers. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 10f7bf58403..471d9a3dec0 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -39,6 +39,8 @@ (declare-function treesit-node-child-by-field-name "treesit.c") (declare-function treesit-node-type "treesit.c") +;;; Custom variables + (defcustom c-ts-mode-indent-offset 2 "Number of spaces for each indentation step in `c-ts-mode'." :version "29.1" @@ -91,6 +93,8 @@ c++-ts-mode--syntax-table table) "Syntax table for `c++-ts-mode'.") +;;; Indent + (defun c-ts-mode--indent-styles (mode) "Indent rules supported by `c-ts-mode'. MODE is either `c' or `cpp'." @@ -381,6 +385,8 @@ c-ts-mode--font-lock-settings @c-ts-mode--fontify-defun) (:match "^DEFUN$" @fn))))) +;;; Font-lock helpers + (defun c-ts-mode--fontify-declarator (node override start end &rest args) "Fontify a declarator (whatever under the \"declarator\" field). For NODE, OVERRIDE, START, END, and ARGS, see @@ -473,6 +479,8 @@ c-ts-mode--fontify-error (t 'font-lock-warning-face)) override start end))) +;;; Imenu + (defun c-ts-mode--imenu-1 (node) "Helper for `c-ts-mode--imenu'. Find string representation for NODE and set marker, then recurse @@ -537,6 +545,8 @@ c-ts-mode--imenu (when var-index `(("Variable" . ,var-index))) (when func-index `(("Function" . ,func-index)))))) +;;; Defun navigation + (defun c-ts-mode--end-of-defun () "`end-of-defun-function' of `c-ts-mode'." ;; A struct/enum/union_specifier node doesn't include the ; at the @@ -582,6 +592,8 @@ c-ts-mode-indent-defun (treesit-node-end node)) (goto-char orig-point))) +;;; Filling + (defun c-ts-mode--fill-paragraph (&optional arg) "Fillling function for `c-ts-mode'. ARG is passed to `fill-paragraph'." @@ -646,6 +658,8 @@ c-ts-mode--fill-paragraph ;; itself. t))) +;;; Modes + (defvar-keymap c-ts-mode-map :doc "Keymap for the C language with tree-sitter" :parent prog-mode-map commit e4e3634539920d14395b19121715c50b3f022909 Author: Yuan Fu Date: Sat Dec 24 00:15:48 2022 -0800 Improve c-ts-mode block comment indent (bug#60270) Now it handles stuff like /** * @some_func: * @arg1: */ * lisp/progmodes/c-ts-mode.el (c-ts-mode--indent-styles): Use new matcher and anchor. (c-ts-mode--looking-at-star): New matcher. (c-ts-mode--comment-start-after-first-star): New anchor. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 901b22e3c01..10f7bf58403 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -102,7 +102,8 @@ c-ts-mode--indent-styles ((node-is "else") parent-bol 0) ((node-is "case") parent-bol 0) ((node-is "preproc_arg") no-indent) - ((and (parent-is "comment") comment-end) comment-start -1) + ((and (parent-is "comment") c-ts-mode--looking-at-star) + c-ts-mode--comment-start-after-first-star -1) ((parent-is "comment") prev-adaptive-prefix 0) ((node-is "labeled_statement") parent-bol 0) ((parent-is "labeled_statement") parent-bol c-ts-mode-indent-offset) @@ -168,6 +169,24 @@ c-ts-mode--set-indent-style ('linux (alist-get 'linux (c-ts-mode--indent-styles mode))))))) `((,mode ,@style)))) +(defun c-ts-mode--looking-at-star (&rest _) + "A tree-sitter simple indent matcher. +Matches if there is a \"*\" after point (ignoring whitespace in +between)." + (looking-at (rx (* (syntax whitespace)) "*"))) + +(defun c-ts-mode--comment-start-after-first-star (_n parent &rest _) + "A tree-sitter simple indent anchor. +Finds the \"/*\" and returns the point after the \"*\". +Assumes PARENT is a comment node." + (save-excursion + (goto-char (treesit-node-start parent)) + (if (looking-at (rx "/*")) + (match-end 0) + (point)))) + +;;; Font-lock + (defvar c-ts-mode--preproc-keywords '("#define" "#if" "#ifdef" "#ifndef" "#else" "#elif" "#endif" "#include") commit e30621caa2c93018d137a5b75fb0db897b6db9a8 Author: Yuan Fu Date: Fri Dec 23 17:17:25 2022 -0800 ; Add treesit_recursion_limit * src/treesit.c (treesit_recursion_limit): New constant. (treesit_cursor_helper) (Ftreesit_search_subtree) (Ftreesit_induce_sparse_tree): Use the new constant. diff --git a/src/treesit.c b/src/treesit.c index dc2043e6109..ce8a2804439 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -404,6 +404,10 @@ #define ts_tree_root_node fn_ts_tree_root_node /*** Initialization */ +/* This is the limit on recursion levels for some tree-sitter + functions. Remember to update docstrings when changing this + value. */ +const ptrdiff_t treesit_recursion_limit = 1000; bool treesit_initialized = false; static bool @@ -2706,7 +2710,8 @@ treesit_cursor_helper (TSTreeCursor *cursor, TSNode node, Lisp_Object parser) uint32_t end_pos = ts_node_end_byte (node); TSNode root = ts_tree_root_node (XTS_PARSER (parser)->tree); *cursor = ts_tree_cursor_new (root); - bool success = treesit_cursor_helper_1 (cursor, &node, end_pos, 1000); + bool success = treesit_cursor_helper_1 (cursor, &node, end_pos, + treesit_recursion_limit); if (!success) ts_tree_cursor_delete (cursor); return success; @@ -2971,7 +2976,7 @@ DEFUN ("treesit-search-subtree", /* We use a default limit of 1000. See bug#59426 for the discussion. */ - ptrdiff_t the_limit = 1000; + ptrdiff_t the_limit = treesit_recursion_limit; if (!NILP (limit)) { CHECK_FIXNUM (limit); @@ -3150,7 +3155,7 @@ DEFUN ("treesit-induce-sparse-tree", /* We use a default limit of 1000. See bug#59426 for the discussion. */ - ptrdiff_t the_limit = 1000; + ptrdiff_t the_limit = treesit_recursion_limit; if (!NILP (limit)) { CHECK_FIXNUM (limit); commit 6a43af58802d46555d692d0934d85d22711e0b56 Author: Yuan Fu Date: Fri Dec 23 17:12:32 2022 -0800 Fix block comment indent and filling for c-ts-mode (bug#59763) Now indent and filling works like in c-mode. The only noticeable missing piece is that the "*/" is not attached to the last sentence when filling. c-mode does it by replacing whitespaces between the "*/" and the end of the last sentence with xxx, fill it, then change the xxx back. I don't know if we should do that in c-ts-mode's filling. * doc/lispref/modes.texi (Parser-based Indentation): Add new preset. * lisp/progmodes/c-ts-mode.el (c-ts-mode--indent-styles): Add new indent rule. (c-ts-mode--fill-paragraph): New function. (c-ts-base-mode): Setup paragraph-start, adaptive-fill, etc. * lisp/treesit.el (treesit-simple-indent-presets): Add new preset. diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index c44938f3929..736c2d6841f 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -5024,6 +5024,14 @@ Parser-based Indentation expression @code{comment-start-skip}. This function assumes @var{parent} is the comment node. +@item prev-adaptive-prefix +This anchor is a function that is called with 3 arguments: @var{node}, +@var{parent}, and @var{bol}. It tries to go to the beginning of the +previous non-empty line, and matches @code{adaptive-fill-regexp}. If +there is a match, this function returns the end of the match, +otherwise it returns nil. This anchor is useful for a +@code{indent-relative}-like indent behavior for block comments. + @end ftable @end defvar diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index ea9891f3345..901b22e3c01 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -103,6 +103,7 @@ c-ts-mode--indent-styles ((node-is "case") parent-bol 0) ((node-is "preproc_arg") no-indent) ((and (parent-is "comment") comment-end) comment-start -1) + ((parent-is "comment") prev-adaptive-prefix 0) ((node-is "labeled_statement") parent-bol 0) ((parent-is "labeled_statement") parent-bol c-ts-mode-indent-offset) ((match "preproc_ifdef" "compound_statement") point-min 0) @@ -562,6 +563,70 @@ c-ts-mode-indent-defun (treesit-node-end node)) (goto-char orig-point))) +(defun c-ts-mode--fill-paragraph (&optional arg) + "Fillling function for `c-ts-mode'. +ARG is passed to `fill-paragraph'." + (interactive "*P") + (save-restriction + (widen) + (let* ((node (treesit-node-at (point))) + (start (treesit-node-start node)) + (end (treesit-node-end node)) + ;; Bind to nil to avoid infinite recursion. + (fill-paragraph-function nil) + (orig-point (point-marker)) + (start-marker nil) + (end-marker nil) + (end-len 0)) + (when (equal (treesit-node-type node) "comment") + ;; We mask "/*" and the space before "*/" like + ;; `c-fill-paragraph' does. + (atomic-change-group + ;; Mask "/*". + (goto-char start) + (when (looking-at (rx (* (syntax whitespace)) + (group "/") "*")) + (goto-char (match-beginning 1)) + (setq start-marker (point-marker)) + (replace-match " " nil nil nil 1)) + ;; Mask spaces before "*/" if it is attached at the end + ;; of a sentence rather than on its own line. + (goto-char end) + (when (looking-back (rx (not (syntax whitespace)) + (group (+ (syntax whitespace))) + "*/") + (line-beginning-position)) + (goto-char (match-beginning 1)) + (setq end-marker (point-marker)) + (setq end-len (- (match-end 1) (match-beginning 1))) + (replace-match (make-string end-len ?x) + nil nil nil 1)) + ;; If "*/" is on its own line, don't included it in the + ;; filling region. + (when (not end-marker) + (goto-char end) + (when (looking-back "*/" 2) + (backward-char 2) + (skip-syntax-backward "-") + (setq end (point)))) + ;; Let `fill-paragraph' do its thing. + (goto-char orig-point) + (narrow-to-region start end) + (funcall #'fill-paragraph arg) + ;; Unmask. + (when start-marker + (goto-char start-marker) + (delete-char 1) + (insert "/")) + (when end-marker + (goto-char end-marker) + (delete-region (point) (+ end-len (point))) + (insert (make-string end-len ?\s)))) + (goto-char orig-point)) + ;; Return t so `fill-paragraph' doesn't attempt to fill by + ;; itself. + t))) + (defvar-keymap c-ts-mode-map :doc "Keymap for the C language with tree-sitter" :parent prog-mode-map @@ -593,6 +658,37 @@ c-ts-base-mode (when (eq c-ts-mode-indent-style 'linux) (setq-local indent-tabs-mode t)) + (setq-local adaptive-fill-mode t) + ;; This matches (1) empty spaces (the default), (2) "//", (3) "*", + ;; but do not match "/*", because we don't want to use "/*" as + ;; prefix when filling. (Actually, it doesn't matter, because + ;; `comment-start-skip' matches "/*" which will cause + ;; `fill-context-prefix' to use "/*" as a prefix for filling, that's + ;; why we mask the "/*" in `c-ts-mode--fill-paragraph'.) + (setq-local adaptive-fill-regexp + (concat (rx (* (syntax whitespace)) + (group (or (seq "/" (+ "/")) (* "*")))) + adaptive-fill-regexp)) + ;; Same as `adaptive-fill-regexp'. + (setq-local adaptive-fill-first-line-regexp + (rx bos + (seq (* (syntax whitespace)) + (group (or (seq "/" (+ "/")) (* "*"))) + (* (syntax whitespace))) + eos)) + ;; Same as `adaptive-fill-regexp'. + (setq-local paragraph-start + (rx (or (seq (* (syntax whitespace)) + (group (or (seq "/" (+ "/")) (* "*"))) + (* (syntax whitespace)) + ;; Add this eol so that in + ;; `fill-context-prefix', `paragraph-start' + ;; doesn't match the prefix. + eol) + "\f"))) + (setq-local paragraph-separate paragraph-start) + (setq-local fill-paragraph-function #'c-ts-mode--fill-paragraph) + ;; Electric (setq-local electric-indent-chars (append "{}():;," electric-indent-chars)) diff --git a/lisp/treesit.el b/lisp/treesit.el index ec5b3e399f9..845e6ab3883 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1107,6 +1107,22 @@ treesit-simple-indent-presets (re-search-forward comment-start-skip) (skip-syntax-backward "-") (point)))) + (cons 'prev-adaptive-prefix + (lambda (_n parent &rest _) + (save-excursion + (re-search-backward + (rx (not (or " " "\t" "\n"))) nil t) + (beginning-of-line) + (and (>= (point) (treesit-node-start parent)) + ;; `adaptive-fill-regexp' will not match "/*", + ;; so we need to also try `comment-start-skip'. + (or (and adaptive-fill-regexp + (looking-at adaptive-fill-regexp) + (> (- (match-end 0) (match-beginning 0)) 0) + (match-end 0)) + (and comment-start-skip + (looking-at comment-start-skip) + (match-end 0))))))) ;; TODO: Document. (cons 'grand-parent (lambda (_n parent &rest _) @@ -1229,7 +1245,14 @@ treesit-simple-indent-presets Goes to the position that `comment-start-skip' would return, skips whitespace backwards, and returns the resulting - position. Assumes PARENT is a comment node.") + position. Assumes PARENT is a comment node. + +prev-adaptive-prefix + + Goes to the beginning of previous non-empty line, and tries + to match `adaptive-fill-regexp'. If it matches, return the + end of the match, otherwise return nil. This is useful for a + `indent-relative'-like indent behavior for block comments.") (defun treesit--simple-indent-eval (exp) "Evaluate EXP. commit e492c21e81040b9539139b78f6baf98df17bbaab Author: Yuan Fu Date: Fri Dec 23 15:22:31 2022 -0800 Fix treesit_cursor_helper (bug#60267) The cause of that bug is that in a particular parse tree, the node treesit_cursor_helper tries to go to is a missing node, not only is it a missing node, it is the first node of a subtree. So when treesit_cursor_helper follows the algorithm and goes down the tree, it goes down the previous subtree (because that subtree's end = end_pos, because the target node has zero width). o | o--+-o | | +-+ +-+-+ | | | | | o x t o o (We ended up in x when the target is t, because t has zero width.) One way to solve it is to go back up the tree if we are at a leaf node and still haven't matched the target node. That's too ugly and finicky so I resorted to recursion. Now one more functions will return give up (treesit_node_parent) if we are in a werid parse tree that is super deep. But since we already kind of give up on this kind of parse trees (bug#59426), it doesn't really hurt. * src/treesit.c (treesit_cursor_helper_1): New function. (treesit_cursor_helper): Use the new function. Change return type to bool, and accept a cursor pointer. (Ftreesit_node_parent) (Ftreesit_search_subtree) (Ftreesit_search_forward) (Ftreesit_induce_sparse_tree): Use the new signature. diff --git a/src/treesit.c b/src/treesit.c index c882d455137..dc2043e6109 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -1762,7 +1762,7 @@ DEFUN ("treesit-node-string", return build_string (string); } -static TSTreeCursor treesit_cursor_helper (TSNode, Lisp_Object); +static bool treesit_cursor_helper (TSTreeCursor *, TSNode, Lisp_Object); DEFUN ("treesit-node-parent", Ftreesit_node_parent, Streesit_node_parent, 1, 1, 0, @@ -1778,7 +1778,10 @@ DEFUN ("treesit-node-parent", TSNode treesit_node = XTS_NODE (node)->node; Lisp_Object parser = XTS_NODE (node)->parser; - TSTreeCursor cursor = treesit_cursor_helper (treesit_node, parser); + TSTreeCursor cursor; + if (!treesit_cursor_helper (&cursor, treesit_node, parser)) + return return_value; + if (ts_tree_cursor_goto_parent (&cursor)) { TSNode parent = ts_tree_cursor_current_node (&cursor); @@ -2637,8 +2640,59 @@ treesit_assume_true (bool val) eassert (val == true); } +/* Tries to move CURSOR to point to TARGET. END_POS is the end of + TARGET. If success, return true, otherwise move CURSOR back to + starting position and return false. LIMIT is the recursion + limit. */ +static bool +treesit_cursor_helper_1 (TSTreeCursor *cursor, TSNode *target, + uint32_t end_pos, ptrdiff_t limit) +{ + if (limit <= 0) + return false; + + TSNode cursor_node = ts_tree_cursor_current_node (cursor); + if (ts_node_eq (cursor_node, *target)) + return true; + + if (!ts_tree_cursor_goto_first_child (cursor)) + return false; + + /* Skip nodes that definitely don't contain TARGET. */ + while (ts_node_end_byte (cursor_node) < end_pos) + { + if (!ts_tree_cursor_goto_next_sibling (cursor)) + break; + cursor_node = ts_tree_cursor_current_node (cursor); + } + + /* Go through each sibling that could contain TARGET. Because of + missing nodes (their width is 0), there could be multiple + siblings that could contain TARGET. */ + while (ts_node_start_byte (cursor_node) <= end_pos) + { + if (treesit_cursor_helper_1 (cursor, target, end_pos, limit - 1)) + return true; + + if (!ts_tree_cursor_goto_next_sibling (cursor)) + break; + cursor_node = ts_tree_cursor_current_node (cursor); + } + + /* Couldn't find TARGET, must be not in this subtree, move cursor + back and pray that other brothers and sisters can succeed. */ + treesit_assume_true (ts_tree_cursor_goto_parent (cursor)); + return false; +} + /* Create a TSTreeCursor pointing at NODE. PARSER is the lisp parser - that produced NODE. + that produced NODE. If success, return true, otherwise return + false. This function should almost always succeed, but if the parse + tree is strangely too deep and exceeds the recursion limit, this + function will fail and return false. + + If this function returns true, caller needs to free CURSOR; if + returns false, caller don't need to free CURSOR. The reason we need this instead of simply using ts_tree_cursor_new is that we have to create the cursor on the root node and traverse @@ -2646,56 +2700,16 @@ treesit_assume_true (bool val) Otherwise going to sibling or parent of NODE wouldn't work. (Wow perfect filling.) */ -static TSTreeCursor -treesit_cursor_helper (TSNode node, Lisp_Object parser) +static bool +treesit_cursor_helper (TSTreeCursor *cursor, TSNode node, Lisp_Object parser) { uint32_t end_pos = ts_node_end_byte (node); TSNode root = ts_tree_root_node (XTS_PARSER (parser)->tree); - TSTreeCursor cursor = ts_tree_cursor_new (root); - TSNode cursor_node = ts_tree_cursor_current_node (&cursor); - /* This is like treesit-node-at. We go down from the root node, - either to first child or next sibling, repeatedly, and finally - arrive at NODE. */ - while (!ts_node_eq (node, cursor_node)) - { - treesit_assume_true (ts_tree_cursor_goto_first_child (&cursor)); - cursor_node = ts_tree_cursor_current_node (&cursor); - /* ts_tree_cursor_goto_first_child_for_byte is not reliable, so - we just go through each sibling. */ - while (ts_node_is_missing (cursor_node) - || ts_node_end_byte (cursor_node) < end_pos) - { - /* A "missing" node has zero width, so it's possible that - its end = NODE.end but it's not NODE, so we skip them. - But we need to make sure this missing node is not the - node we are looking for before skipping it. */ - if (ts_node_is_missing (cursor_node) - && ts_node_eq (node, cursor_node)) - return cursor; - treesit_assume_true (ts_tree_cursor_goto_next_sibling (&cursor)); - cursor_node = ts_tree_cursor_current_node (&cursor); - } - /* Right now CURSOR.end >= NODE.end. But what if CURSOR.end = - NODE.end, and there are missing nodes after CURSOR, and the - missing node after CURSOR is the NODE we are looking for?? - Well, create a probe and look ahead. (This is tested by - treesit-cursor-helper-with-missing-node.) */ - TSTreeCursor probe = ts_tree_cursor_copy (&cursor); - TSNode probe_node; - while (ts_tree_cursor_goto_next_sibling (&probe)) - { - probe_node = ts_tree_cursor_current_node (&probe); - if (!ts_node_is_missing (probe_node)) - break; - if (ts_node_eq (probe_node, node)) - { - ts_tree_cursor_delete (&cursor); - return probe; - } - } - ts_tree_cursor_delete (&probe); - } - return cursor; + *cursor = ts_tree_cursor_new (root); + bool success = treesit_cursor_helper_1 (cursor, &node, end_pos, 1000); + if (!success) + ts_tree_cursor_delete (cursor); + return success; } /* Move CURSOR to the next/previous sibling. FORWARD controls the @@ -2968,7 +2982,10 @@ DEFUN ("treesit-search-subtree", Lisp_Object parser = XTS_NODE (node)->parser; Lisp_Object return_value = Qnil; - TSTreeCursor cursor = treesit_cursor_helper (XTS_NODE (node)->node, parser); + TSTreeCursor cursor; + if (!treesit_cursor_helper (&cursor, XTS_NODE (node)->node, parser)) + return return_value; + if (treesit_search_dfs (&cursor, predicate, parser, NILP (backward), NILP (all), the_limit, false)) { @@ -3022,7 +3039,10 @@ DEFUN ("treesit-search-forward", Lisp_Object parser = XTS_NODE (start)->parser; Lisp_Object return_value = Qnil; - TSTreeCursor cursor = treesit_cursor_helper (XTS_NODE (start)->node, parser); + TSTreeCursor cursor; + if (!treesit_cursor_helper (&cursor, XTS_NODE (start)->node, parser)) + return return_value; + if (treesit_search_forward (&cursor, predicate, parser, NILP (backward), NILP (all))) { @@ -3141,7 +3161,10 @@ DEFUN ("treesit-induce-sparse-tree", Lisp_Object parser = XTS_NODE (root)->parser; Lisp_Object parent = Fcons (Qnil, Qnil); - TSTreeCursor cursor = treesit_cursor_helper (XTS_NODE (root)->node, parser); + TSTreeCursor cursor; + if (!treesit_cursor_helper (&cursor, XTS_NODE (root)->node, parser)) + return Qnil; + treesit_build_sparse_tree (&cursor, parent, predicate, process_fn, the_limit, parser); ts_tree_cursor_delete (&cursor); commit 4437dbedf7bd9d7fc3612ce4ecd96d5a2c653df8 Author: Paul Eggert Date: Fri Dec 23 23:36:06 2022 -0800 Fix restart-emacs alarms (Bug#60220) * src/emacs.c (Fkill_emacs): Turn timers off before execing, so that the re-execed Emacs doesn’t get a timer alarm. diff --git a/src/emacs.c b/src/emacs.c index d8a2863fd9c..a2ba4b50f04 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -2910,6 +2910,7 @@ DEFUN ("kill-emacs", Fkill_emacs, Skill_emacs, 0, 2, "P", if (!NILP (restart)) { + turn_on_atimers (false); #ifdef WINDOWSNT if (w32_reexec_emacs (initial_cmdline, initial_wd) < 0) #else commit 6c1413d5ef0d1fea639b0d8c83a0c0065d99359b Author: Florian Weimer Date: Fri Dec 23 18:49:25 2022 +0100 configure: Remove obsolete check for -b i486-linuxaout If there are still a.out system arounds, they shouldn't need this anymore because the toolchain has been fixed. * configure.ac (emacs_cv_b_link): Remove obsolete check. diff --git a/configure.ac b/configure.ac index 6e9b11986c7..47a9065e547 100644 --- a/configure.ac +++ b/configure.ac @@ -2695,39 +2695,6 @@ AC_DEFUN export LD_RUN_PATH fi - if test "${opsys}" = "gnu-linux"; then - AC_CACHE_CHECK([whether X on GNU/Linux needs -b to link], [emacs_cv_b_link], - [AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], - [[XOpenDisplay ("foo");]])], - [xgnu_linux_first_failure=no], - [xgnu_linux_first_failure=yes]) - if test "${xgnu_linux_first_failure}" = "yes"; then - OLD_CPPFLAGS="$CPPFLAGS" - OLD_LIBS="$LIBS" - CPPFLAGS="$CPPFLAGS -b i486-linuxaout" - LIBS="$LIBS -b i486-linuxaout" - AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], - [[XOpenDisplay ("foo");]])], - [xgnu_linux_second_failure=no], - [xgnu_linux_second_failure=yes]) - if test "${xgnu_linux_second_failure}" = "yes"; then - # If we get the same failure with -b, there is no use adding -b. - # So leave it out. This plays safe. - emacs_cv_b_link=no - else - emacs_cv_b_link=yes - fi - CPPFLAGS=$OLD_CPPFLAGS - LIBS=$OLD_LIBS - else - emacs_cv_b_link=no - fi]) - if test "x$emacs_cv_b_link" = xyes ; then - LD_SWITCH_X_SITE="$LD_SWITCH_X_SITE -b i486-linuxaout" - C_SWITCH_X_SITE="$C_SWITCH_X_SITE -b i486-linuxaout" - fi - fi - # Reportedly, some broken Solaris systems have XKBlib.h but are missing # header files included from there. AC_CACHE_CHECK([for Xkb], [emacs_cv_xkb], commit 121a9ff9f6fc69066ce30c2dbe6cbfbfdca6aeaa Author: Florian Weimer Date: Fri Dec 23 18:51:08 2022 +0100 Fix alternate stack test in configure * configure.ac (emacs_cv_alternate_stack): Include for 'malloc's prototype. diff --git a/configure.ac b/configure.ac index ac29f351fb3..df19508d3d3 100644 --- a/configure.ac +++ b/configure.ac @@ -5248,6 +5248,7 @@ AC_DEFUN [emacs_cv_alternate_stack], [AC_COMPILE_IFELSE( [AC_LANG_PROGRAM([[#include + #include ]], [[stack_t ss; struct sigaction sa; commit 84888080eea51a150a87075ff1612209b46eda45 Author: Xi Lu Date: Fri Dec 23 23:50:39 2022 +0800 Add more functions to "string" shortdoc * lisp/emacs-lisp/shortdoc.el: Add 'string-or-null-p', 'char-or-string-p', 'char-uppercase-p'. (Bug#60279) diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 6704db3cc57..90f81d740f2 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -263,6 +263,12 @@ string :eval (stringp "a") :eval (stringp 'a) :eval "(stringp ?a)") + (string-or-null-p + :eval (string-or-null-p "a") + :eval (string-or-null-p nil)) + (char-or-string-p + :eval "(char-or-string-p ?a)" + :eval (char-or-string-p "a")) (string-empty-p :no-manual t :eval (string-empty-p "")) @@ -300,6 +306,9 @@ string :eval (string-to-number "2.5e+03")) (number-to-string :eval (number-to-string 42)) + (char-uppercase-p + :eval "(char-uppercase-p ?A)" + :eval "(char-uppercase-p ?a)") "Data About Strings" (length :eval (length "foo") commit c90f97d4e5d56ba7cad0205c3f60854ca575f180 Author: Yaraslau Tamashevich Date: Fri Dec 23 11:39:25 2022 +0200 Make the Contour terminal an alias of xterm-256color * lisp/faces.el (term-file-aliases): Make the Contour terminal an alias of xterm-256color. (Bug#60278) Copyright-paperwork-exempt: yes diff --git a/lisp/faces.el b/lisp/faces.el index c69339e2fdc..29e26e4c651 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -47,7 +47,8 @@ term-file-aliases ("vt400" . "vt200") ("vt420" . "vt200") ("alacritty" . "xterm") - ("foot" . "xterm")) + ("foot" . "xterm") + ("contour" . "xterm")) "Alist of terminal type aliases. Entries are of the form (TYPE . ALIAS), where both elements are strings. This means to treat a terminal of type TYPE as if it were of type ALIAS." commit c3fac9465fae680f08d07774dcf146b3917b8e08 Author: Eli Zaretskii Date: Sat Dec 24 09:40:56 2022 +0200 ; Fix punctuation in last change. diff --git a/doc/misc/info.texi b/doc/misc/info.texi index 5b1fae8f968..84c4eeba4b5 100644 --- a/doc/misc/info.texi +++ b/doc/misc/info.texi @@ -1098,7 +1098,7 @@ Go to node called @samp{Top} in this file. (This is equivalent to @kbd{t}, see @ref{Help-Int}.) @kbd{gGo to node@key{RET}} would come back here. - Like @kbd{m}, @kbd{g} allows the use of abbreviations. It also allows + Like @kbd{m}, @kbd{g} allows the use of abbreviations. It also allows completion, so you can type @key{TAB} to complete a partial node name. @cindex go to another Info file commit 756bb422a49a5d04ccc3bf022c8c5ac831ca02e4 Author: glacials Date: Thu Dec 22 12:09:08 2022 -0800 Correct wrong info in (info)Go to node The node (info)Go to node in the Info manual states that 'g' does not allow the use of abbreviations, however it does. To test this, type 'gt' from this node and see that it takes you to (info)Top, then type 'ggo' and see that it takes you back to (info)Go to node. Tested on emacs 28.2. * doc/misc/info.texi (Go to node): Fix inaccurate information. (Bug#60263) Copyright-paperwork-exempt: yes diff --git a/doc/misc/info.texi b/doc/misc/info.texi index 4db35ebf0fc..5b1fae8f968 100644 --- a/doc/misc/info.texi +++ b/doc/misc/info.texi @@ -1098,9 +1098,8 @@ Go to node called @samp{Top} in this file. (This is equivalent to @kbd{t}, see @ref{Help-Int}.) @kbd{gGo to node@key{RET}} would come back here. - Unlike @kbd{m}, @kbd{g} does not allow the use of abbreviations. -But it does allow completion, so you can type @key{TAB} to complete a -partial node name. + Like @kbd{m}, @kbd{g} allows the use of abbreviations. It also allows +completion, so you can type @key{TAB} to complete a partial node name. @cindex go to another Info file To go to a node in another file, you can include the file name in the commit a8c3424d28b247fa0a565994345dbb4555a2ab73 Author: Eli Zaretskii Date: Sat Dec 24 09:32:08 2022 +0200 Fix typo in TUTORIAL.fr (bug#60261) * etc/tutorials/TUTORIAL.fr: Fix typo. Reported by Clément Escude--Cotinat . diff --git a/etc/tutorials/TUTORIAL.fr b/etc/tutorials/TUTORIAL.fr index 5b080645e40..70d60fcae76 100644 --- a/etc/tutorials/TUTORIAL.fr +++ b/etc/tutorials/TUTORIAL.fr @@ -1219,7 +1219,7 @@ Les conditions de copie d'Emacs lui-même sont plus complexes, mais dans le même esprit. Lisez le fichier COPYING et donnez ensuite des copies de GNU Emacs à vos amis. Participez à l'éradication de l'obstructionnisme du logiciel (sa « propriétarisation ») en -utilisant, écrivant et partagent des logiciels libres ! +utilisant, écrivant et partageant des logiciels libres ! Cette traduction française a été effectuée par Éric Jacoboni et complétée par Bastien Guerry . commit 24cd2f0daf1363eef9847d5cc8ff342ca8ac342a Author: Daniel Martín Date: Thu Dec 22 19:10:24 2022 +0100 Add some diff-fixup-modifs tests * test/lisp/vc/diff-mode-tests.el (diff-mode-test-fixups-added-lines): Test that diff-mode fixes patches with added lines correctly. * test/lisp/vc/diff-mode-tests.el (diff-mode-test-fixups-empty-hunks): Ditto for patches with empty hunks. (Bug#60259) diff --git a/test/lisp/vc/diff-mode-tests.el b/test/lisp/vc/diff-mode-tests.el index 19e3dbb42a6..b67ccd4fe09 100644 --- a/test/lisp/vc/diff-mode-tests.el +++ b/test/lisp/vc/diff-mode-tests.el @@ -478,5 +478,84 @@ test-hunk-file-names (should (equal (diff-hunk-file-names) '("/tmp/ange-ftp1351895K.el" "/tmp/ange-ftp13518wvE.el"))))) +(ert-deftest diff-mode-test-fixups-added-lines () + "Check that `diff-fixup-modifs' works well with hunks with added lines." + (let ((patch "--- file ++++ file +@@ -0,0 +1,15 @@ ++1 ++2 ++3 ++4 +")) + (with-temp-buffer + (insert patch) + (diff-fixup-modifs (point-min) (point-max)) + (should (equal (buffer-string) "--- file ++++ file +@@ -0,0 +1,4 @@ ++1 ++2 ++3 ++4 +")))) + (let ((patch "--- file ++++ file +@@ -389,5 +398,6 @@ + while (1) + ; ++ # not needed + # at all + # stop +")) + (with-temp-buffer + (insert patch) + (diff-fixup-modifs (point-min) (point-max)) + (should (equal (buffer-string) "--- file ++++ file +@@ -389,4 +398,5 @@ + while (1) + ; ++ # not needed + # at all + # stop +"))))) + +(ert-deftest diff-mode-test-fixups-empty-hunks () + "Check that `diff-fixup-modifs' works well with empty hunks." + (let ((patch "--- file ++++ file +@@ -1 +1 @@ +-1 +@@ -10 +10 @@ +-1 ++1 +--- otherfile ++++ otherfile +@@ -1 +1 @@ ++2 +@@ -10 +10 @@ +-1 ++1 +")) + (with-temp-buffer + (insert patch) + (diff-fixup-modifs (point-min) (point-max)) + (should (equal (buffer-string) "--- file ++++ file +@@ -1,1 +1,0 @@ +-1 +@@ -10,1 +10,1 @@ +-1 ++1 +--- otherfile ++++ otherfile +@@ -1,0 +1,1 @@ ++2 +@@ -10,1 +10,1 @@ +-1 ++1 +"))))) + (provide 'diff-mode-tests) ;;; diff-mode-tests.el ends here commit d32091199ae5de590a83f1542a01d75fba000467 Author: Ulrich Müller Date: Mon Dec 19 16:51:20 2022 +0100 Fix quoted argument in emacsclient-mail.desktop Exec key Apparently the emacsclient-mail.desktop file doesn't conform to the Desktop Entry Specification at https://specifications.freedesktop.org/desktop-entry-spec/desktop-entry-spec-latest.html#exec-variables which says about the Exec key: | Field codes must not be used inside a quoted argument, the result of | field code expansion inside a quoted argument is undefined. However, the %u field code is used inside a quoted argument of the Exec key in both the [Desktop Entry] and [Desktop Action new-window] sections. * etc/emacsclient-mail.desktop (Exec): The Desktop Entry Specification does not allow field codes like %u inside a quoted argument. Work around it by passing %u as first parameter ($1) to the shell wrapper. * etc/emacsclient.desktop (Exec): Use `sh` rather than `placeholder` as the command name of the shell wrapper. (Bug#60204) diff --git a/etc/emacsclient-mail.desktop b/etc/emacsclient-mail.desktop index b575a41758a..91df122c594 100644 --- a/etc/emacsclient-mail.desktop +++ b/etc/emacsclient-mail.desktop @@ -1,7 +1,7 @@ [Desktop Entry] Categories=Network;Email; Comment=GNU Emacs is an extensible, customizable text editor - and more -Exec=sh -c "exec emacsclient --alternate-editor= --display=\\"\\$DISPLAY\\" --eval \\\\(message-mailto\\\\ \\\\\\"%u\\\\\\"\\\\)" +Exec=sh -c "exec emacsclient --alternate-editor= --display=\\"\\$DISPLAY\\" --eval \\"(message-mailto \\\\\\"\\$1\\\\\\")\\"" sh %u Icon=emacs Name=Emacs (Mail, Client) MimeType=x-scheme-handler/mailto; @@ -13,7 +13,7 @@ Actions=new-window;new-instance; [Desktop Action new-window] Name=New Window -Exec=emacsclient --alternate-editor= --create-frame --eval "(message-mailto \\"%u\\")" +Exec=sh -c "exec emacsclient --alternate-editor= --create-frame --eval \\"(message-mailto \\\\\\"\\$1\\\\\\")\\"" sh %u [Desktop Action new-instance] Name=New Instance diff --git a/etc/emacsclient.desktop b/etc/emacsclient.desktop index 1ecdecffafd..a9f840c7033 100644 --- a/etc/emacsclient.desktop +++ b/etc/emacsclient.desktop @@ -3,7 +3,7 @@ Name=Emacs (Client) GenericName=Text Editor Comment=Edit text MimeType=text/english;text/plain;text/x-makefile;text/x-c++hdr;text/x-c++src;text/x-chdr;text/x-csrc;text/x-java;text/x-moc;text/x-pascal;text/x-tcl;text/x-tex;application/x-shellscript;text/x-c;text/x-c++; -Exec=sh -c "if [ -n \\"\\$*\\" ]; then exec emacsclient --alternate-editor= --display=\\"\\$DISPLAY\\" \\"\\$@\\"; else exec emacsclient --alternate-editor= --create-frame; fi" placeholder %F +Exec=sh -c "if [ -n \\"\\$*\\" ]; then exec emacsclient --alternate-editor= --display=\\"\\$DISPLAY\\" \\"\\$@\\"; else exec emacsclient --alternate-editor= --create-frame; fi" sh %F Icon=emacs Type=Application Terminal=false commit 286c48137f69fa96b80d197da90c69a42df604a3 Author: Richard Hansen Date: Sat Dec 17 18:51:33 2022 -0500 ert-x: Move window selection logic to its own macro * lisp/emacs-lisp/ert-x.el (ert-with-buffer-selected): New macro to temporarily display a buffer in a selected window and evaluate a body. (ert-with-test-buffer-selected): Use the new macro. * test/lisp/whitespace-tests.el (ert-test-with-buffer-selected/current) (ert-test-with-buffer-selected/selected) (ert-test-with-buffer-selected/nil-buffer) (ert-test-with-buffer-selected/modification-hooks) (ert-test-with-buffer-selected/read-only) (ert-test-with-buffer-selected/return-value): Add tests. (Bug#60189) diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index 5f1c5c26acd..0614313809c 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -102,25 +102,36 @@ ert-with-test-buffer (indent 1)) `(ert--call-with-test-buffer ,name-form (lambda () ,@body))) -(cl-defmacro ert-with-test-buffer-selected ((&key name) - &body body) - "Create a test buffer, switch to it, and run BODY. +(cl-defmacro ert-with-buffer-selected (buffer-or-name &body body) + "Display a buffer in a temporary selected window and run BODY. + +If BUFFER-OR-NAME is nil, the current buffer is used. -This extends `ert-with-test-buffer' by displaying the test -buffer (whose name is derived from NAME) in a temporary window. -The temporary window becomes the `selected-window' before BODY is -evaluated. The modification hooks `before-change-functions' and +The buffer is made the current buffer, and the temporary window +becomes the `selected-window', before BODY is evaluated. The +modification hooks `before-change-functions' and `after-change-functions' are not inhibited during the evaluation of BODY, which makes it easier to use `execute-kbd-macro' to simulate user interaction. The window configuration is restored before returning, even if BODY exits nonlocally. The return value is the last form in BODY." - (declare (debug ((":name" form) body)) (indent 1)) - `(ert-with-test-buffer (:name ,name) - (save-window-excursion + (declare (debug (form body)) (indent 1)) + `(save-window-excursion + (with-current-buffer (or ,buffer-or-name (current-buffer)) (with-selected-window (display-buffer (current-buffer)) ,@body)))) +(cl-defmacro ert-with-test-buffer-selected ((&key name) &body body) + "Create a test buffer, switch to it, and run BODY. + +This combines `ert-with-test-buffer' and +`ert-with-buffer-selected'. The return value is the last form in +BODY." + (declare (debug ((":name" form) body)) (indent 1)) + `(ert-with-test-buffer (:name ,name) + (ert-with-buffer-selected (current-buffer) + ,@body))) + ;;;###autoload (defun ert-kill-all-test-buffers () "Kill all test buffers that are still live." diff --git a/test/lisp/emacs-lisp/ert-x-tests.el b/test/lisp/emacs-lisp/ert-x-tests.el index f14d54cd9f7..1cfd218592a 100644 --- a/test/lisp/emacs-lisp/ert-x-tests.el +++ b/test/lisp/emacs-lisp/ert-x-tests.el @@ -82,6 +82,40 @@ ert-test-test-buffers (should-not (buffer-live-p buffer-1)) (should (buffer-live-p buffer-2)))))) +(ert-deftest ert-test-with-buffer-selected/current () + (let ((origbuf (current-buffer))) + (ert-with-test-buffer () + (let ((buf (current-buffer))) + (should (not (eq buf origbuf))) + (with-current-buffer origbuf + (ert-with-buffer-selected buf + (should (eq (current-buffer) buf)))))))) + +(ert-deftest ert-test-with-buffer-selected/selected () + (ert-with-test-buffer () + (ert-with-buffer-selected (current-buffer) + (should (eq (window-buffer) (current-buffer)))))) + +(ert-deftest ert-test-with-buffer-selected/nil-buffer () + (ert-with-test-buffer () + (let ((buf (current-buffer))) + (ert-with-buffer-selected nil + (should (eq (window-buffer) buf)))))) + +(ert-deftest ert-test-with-buffer-selected/modification-hooks () + (ert-with-test-buffer () + (ert-with-buffer-selected (current-buffer) + (should (null inhibit-modification-hooks))))) + +(ert-deftest ert-test-with-buffer-selected/read-only () + (ert-with-test-buffer () + (ert-with-buffer-selected (current-buffer) + (should (null inhibit-read-only)) + (should (null buffer-read-only))))) + +(ert-deftest ert-test-with-buffer-selected/return-value () + (should (equal (ert-with-buffer-selected nil "foo") "foo"))) + (ert-deftest ert-test-with-test-buffer-selected/selected () (ert-with-test-buffer-selected () (should (eq (window-buffer) (current-buffer))))) commit 823c49cea851158bc4db5ab133ecd9bf3d0791d7 Author: Richard Hansen Date: Sat Dec 17 18:18:39 2022 -0500 ; ert-x: Simplify `ert-with-test-buffer-selected' * lisp/emacs-lisp/ert-x.el (ert-with-test-buffer-selected): Simplify using 'ert-with-test-buffer'. (Bug#60189) diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index 49f2a1d6965..5f1c5c26acd 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -115,29 +115,11 @@ ert-with-test-buffer-selected simulate user interaction. The window configuration is restored before returning, even if BODY exits nonlocally. The return value is the last form in BODY." - (declare (debug ((":name" form) def-body)) - (indent 1)) - (let ((ret (make-symbol "ert--with-test-buffer-selected-ret"))) - `(save-window-excursion - (let (,ret) - (ert-with-test-buffer (:name ,name) - (with-current-buffer-window (current-buffer) - `(display-buffer-below-selected - (body-function - . ,(lambda (window) - (select-window window t) - ;; body-function is intended to initialize the - ;; contents of a temporary read-only buffer, so - ;; it is executed with some convenience - ;; changes. Undo those changes so that the - ;; test buffer behaves more like an ordinary - ;; buffer while the body executes. - (let ((inhibit-modification-hooks nil) - (inhibit-read-only nil) - (buffer-read-only nil)) - (setq ,ret (progn ,@body)))))) - nil)) - ,ret)))) + (declare (debug ((":name" form) body)) (indent 1)) + `(ert-with-test-buffer (:name ,name) + (save-window-excursion + (with-selected-window (display-buffer (current-buffer)) + ,@body)))) ;;;###autoload (defun ert-kill-all-test-buffers () commit 38c6abe4d0b6bc6b5dfc32ab7b9b5095adf82da0 Author: Richard Hansen Date: Sat Dec 17 18:26:33 2022 -0500 ; ert-x: Add test for buffer read-only state This test should have been included with commit 29b7d740006fe2190a729bd1c30ccab9356cee36. * test/lisp/emacs-lisp/ert-x-tests.el (ert-test-with-test-buffer-selected/read-only): New test. (Bug#60189) diff --git a/test/lisp/emacs-lisp/ert-x-tests.el b/test/lisp/emacs-lisp/ert-x-tests.el index 63e7cd7608f..f14d54cd9f7 100644 --- a/test/lisp/emacs-lisp/ert-x-tests.el +++ b/test/lisp/emacs-lisp/ert-x-tests.el @@ -90,6 +90,11 @@ ert-test-with-test-buffer-selected/modification-hooks (ert-with-test-buffer-selected () (should (null inhibit-modification-hooks)))) +(ert-deftest ert-test-with-test-buffer-selected/read-only () + (ert-with-test-buffer-selected () + (should (null inhibit-read-only)) + (should (null buffer-read-only)))) + (ert-deftest ert-test-with-test-buffer-selected/return-value () (should (equal (ert-with-test-buffer-selected () "foo") "foo"))) commit 0e39ad6fa56d50b4710157f0b6f396e492da0dfb Author: Po Lu Date: Sat Dec 24 14:14:51 2022 +0800 Fix crash after X error * src/xdisp.c (redisplay_internal): Catch another crash if gcscrollbars after an X error. diff --git a/src/xdisp.c b/src/xdisp.c index 06c8b7730cd..4e5250486f5 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -16838,6 +16838,13 @@ #define AINC(a,i) \ /* Only GC scrollbars when we redisplay the whole frame. */ = f->redisplay || !REDISPLAY_SOME_P (); bool f_redisplay_flag = f->redisplay; + + /* The X error handler may have deleted that frame + before we went back to retry_frame. This must come + before any accesses to f->terminal. */ + if (!FRAME_LIVE_P (f)) + continue; + /* Mark all the scroll bars to be removed; we'll redeem the ones we want when we redisplay their windows. */ if (gcscrollbars && FRAME_TERMINAL (f)->condemn_scroll_bars_hook) @@ -16845,7 +16852,6 @@ #define AINC(a,i) \ if (FRAME_VISIBLE_P (f) && !FRAME_OBSCURED_P (f)) { - /* Don't allow freeing images and faces for this frame as long as the frame's update wasn't completed. This prevents crashes when some Lisp @@ -16861,10 +16867,6 @@ #define AINC(a,i) \ else if (!REDISPLAY_SOME_P ()) f->redisplay = true; - /* The X error handler may have deleted that frame. */ - if (!FRAME_LIVE_P (f)) - continue; - /* Any scroll bars which redisplay_windows should have nuked should now go away. */ if (gcscrollbars && FRAME_TERMINAL (f)->judge_scroll_bars_hook)