commit 6571b632ed1654a260a609ee3a5e9923dc5c25e3 (HEAD, refs/remotes/origin/master) Author: Eli Zaretskii Date: Fri Aug 22 09:57:28 2025 +0300 ; * admin/MAINTAINERS: Update entries for Dmitry and Spencer. diff --git a/admin/MAINTAINERS b/admin/MAINTAINERS index 945e69fc690..b942fb3ba38 100644 --- a/admin/MAINTAINERS +++ b/admin/MAINTAINERS @@ -96,6 +96,10 @@ Dmitry Gutov test/indent/ruby.rb lisp/progmodes/xref.el lisp/progmodes/project.el + lisp/thread.el + src/thread.c + + Thread-related code in src/process.c Ulf Jasper Newsticker @@ -381,6 +385,10 @@ Harald Jörg Spencer Baugh lisp/progmodes/flymake.el + lisp/thread.el + src/thread.c + + Thread-related code in src/process.c Yuan Fu lisp/progmodes/c-ts-mode.el commit a419e92bc6a8e36c14f881b411d3f2d48d1f3b83 Author: Harald Jörg Date: Fri Aug 22 01:26:28 2025 +0200 ; cperl-mode.el: Fix fontification error with signatures This fixes the second issue in Bug#79269. * lisp/progmodes/cperl-mode.el (cperl-init-faces): Move handling of signatures with initializers from the "anchor" to the "anchored" matcher * test/lisp/progmodes/cperl-mode-resources/proto-and-attrs.pl (sub_7): Test case for Bug#79269, wrong face report * test/lisp/progmodes/cperl-mode-tests.el (cperl-test-fontify-attrs-and-signatures): Make sure that the test catches sub_7 for Bug#79269 diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 1e2aca73161..fdb841cfffd 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -6374,9 +6374,7 @@ functions (which they are not). Inherits from `default'.") (sequence (eval cperl--signature-rx) (eval cperl--ws*-rx)) ;; ... or the start of a "sloppy" signature - (sequence (eval cperl--sloppy-signature-rx) - ;; arbitrarily continue "a few lines" - (repeat 0 200 (not (in "{")))) + (sequence (eval cperl--sloppy-signature-rx)) ;; make sure we have a reasonably ;; short match for an incomplete sub (not (in ";{(")) @@ -6392,7 +6390,13 @@ functions (which they are not). Inherits from `default'.") (group (eval cperl--basic-variable-rx)))) (progn (goto-char (match-beginning 2)) ; pre-match: Back to sig - (match-end 2)) + ;; While typing, forward-sexp might fail with a scan error. + ;; If so, stop looking for declarations at (match-end 2) + (condition-case nil + (save-excursion + (forward-sexp) + (point)) + (error (match-end 2)))) nil (1 font-lock-variable-name-face))) ;; -------- flow control diff --git a/test/lisp/progmodes/cperl-mode-resources/proto-and-attrs.pl b/test/lisp/progmodes/cperl-mode-resources/proto-and-attrs.pl index 1f898250252..d95b3d0a453 100644 --- a/test/lisp/progmodes/cperl-mode-resources/proto-and-attrs.pl +++ b/test/lisp/progmodes/cperl-mode-resources/proto-and-attrs.pl @@ -41,6 +41,13 @@ sub sub_6 { } +# Braces in initializers (Bug79269) +sub sub_7 + ($foo = { }, + $bar //= "baz") +{ +} + # Part 2: Same constructs for anonymous subs # A plain named subroutine without any optional stuff diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index 469345e74c9..424e89604b3 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -173,7 +173,7 @@ attributes, prototypes and signatures." (should (equal (get-text-property (match-beginning 0) 'face) 'font-lock-function-name-face)) (let ((start-of-sub (match-beginning 0)) - (end-of-sub (save-excursion (search-forward "}") (point)))) + (end-of-sub (save-excursion (search-forward "}\n") (point)))) ;; Prototypes are shown as strings (when (search-forward-regexp " ([$%@*]*) " end-of-sub t) commit 680ef7b5f0bdc1c215a66e165851a07177db7ed0 Author: Steven Allen Date: Thu Aug 21 11:15:02 2025 -0700 Fix 'submit-emacs-patch' MIME type * lisp/mail/emacsbug.el (submit-emacs-patch): Use the correct MIME type for patches. Otherwise, `mm-inline-media-tests' won't recognize and fontify the patch. (Bug#79287) diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index d43647a12ca..4872f721aa5 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -587,7 +587,7 @@ Message buffer where you can explain more about the patch." (message-goto-body) (insert "\n\n\n") (emacs-build-description) - (mml-attach-file file "text/patch" nil "attachment") + (mml-attach-file file "text/x-patch" nil "attachment") (message-goto-body) (message "Write a description of the patch and use %s to send it" (substitute-command-keys "\\[message-send-and-exit]")) commit ade6608e2587452c8ea565ce3057879379ebd0b5 Author: Elías Gabriel Pérez Date: Sat Jul 5 13:29:24 2025 -0600 project: Improve pruning of zombie projects. * etc/NEWS: Update 'project-prune-zombie-projects' entry. * lisp/progmodes/project.el (project-prune-zombie-projects): Change default value (bug#77566). (project--ensure-read-project-list, project--write-project-list) (project-prompt-project-dir, project-prompt-project-name): Rework for use 'project-prune-zombie-projects' value. (project-forget-zombie-projects): Move code... (project--delete-zombie-projects): ... to this new function. diff --git a/etc/NEWS b/etc/NEWS index e94464b203b..99026f936b6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -504,12 +504,13 @@ This user option controls the automatic deletion of projects from 'project-list-file' that cannot be accessed when prompting for a project. -The value can be a predicate which takes one argument and should return -non-nil if the project should be removed. If set to nil, all the -inaccessible projects will not be removed automatically. +The value must be an alist where each element must be in the form: -By default this is set to 'project-prune-zombies-default' function -which removes all non-remote projects. + (WHEN . PREDICATE) + +where WHEN specifies where the deletion will be performed, and PREDICATE +a function which takes one argument, and must return non-nil if the +project should be removed. --- *** New command 'project-save-some-buffers' bound to 'C-x p C-x s'. diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index efc00ac8733..8438060afa3 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1650,16 +1650,28 @@ general form of conditions." :group 'project :package-version '(project . "0.8.2")) -(defcustom project-prune-zombie-projects #'project-prune-zombies-default - "Remove automatically from project list all the projects that were removed. -The value can be a predicate function which takes one argument, and -should return non-nil if the project should be removed. -If set to nil, all the inaccessible projects will not be removed automatically." - :type '(choice (const :tag "Default (remove non-remote projects)" - project-prune-zombies-default) - (const :tag "Remove any project" identity) - (function :tag "Custom function") - (const :tag "Disable auto-deletion" nil)) +(defcustom project-prune-zombie-projects + '((prompt . project-prune-zombies-default)) + "Remove automatically from project list the projects that were removed. +Each element of this alist must be in the form: + (WHEN . PREDICATE) + +where WHEN specifies where the deletion will be performed, +the value can be: + + `list-first-read' - delete on the first reading of the list. + `list-write' - delete after saving project list to `project-list-file'. + `prompt' - delete before every prompting. + `interactively' - delete only when `project-forget-zombie-projects' + is called interactively. + +PREDICATE must be a function which takes one argument, and should return +non-nil if the project must be removed." + :type 'alist + :options '((list-first-read function) + (list-write function) + (prompt function) + (interactively function)) :version "31.1" :group 'project) @@ -2029,10 +2041,10 @@ With some possible metadata (to be decided).") "Initialize `project--list' if it isn't already initialized." (when (eq project--list 'unset) (project--read-project-list) - (if-let* (project-prune-zombie-projects + (if-let* ((pred (alist-get 'list-first-read project-prune-zombie-projects)) ((consp project--list)) (inhibit-message t)) - (project-forget-zombie-projects)))) + (project--delete-zombie-projects pred)))) (defun project--write-project-list () "Save `project--list' in `project-list-file'." @@ -2041,6 +2053,10 @@ With some possible metadata (to be decided).") (insert ";;; -*- lisp-data -*-\n") (let ((print-length nil) (print-level nil)) + (if-let* ((pred (alist-get 'list-write project-prune-zombie-projects)) + ((consp project--list)) + (inhibit-message t)) + (project--delete-zombie-projects pred)) (pp (mapcar (lambda (elem) (let ((name (car elem))) (list (if (file-remote-p name) name @@ -2124,9 +2140,9 @@ function; see `project-prompter' for more details. Unless REQUIRE-KNOWN is non-nil, it's also possible to enter an arbitrary directory not in the list of known projects." (project--ensure-read-project-list) - (if-let* (project-prune-zombie-projects + (if-let* ((pred (alist-get 'prompt project-prune-zombie-projects)) (inhibit-message t)) - (project-forget-zombie-projects)) + (project--delete-zombie-projects pred)) (let* ((dir-choice "... (choose a dir)") (choices ;; XXX: Just using this for the category (for the substring @@ -2165,9 +2181,9 @@ If PREDICATE is non-nil, filter possible project choices using this function; see `project-prompter' for more details. Unless REQUIRE-KNOWN is non-nil, it's also possible to enter an arbitrary directory not in the list of known projects." - (if-let* (project-prune-zombie-projects + (if-let* ((pred (alist-get 'prompt project-prune-zombie-projects)) (inhibit-message t)) - (project-forget-zombie-projects)) + (project--delete-zombie-projects pred)) (let* ((dir-choice "... (choose a dir)") project--name-history (choices @@ -2295,16 +2311,21 @@ Return the number of detected projects." count) count)) count)) -(defun project-forget-zombie-projects () - "Forget all known projects that don't exist any more." - (interactive) +(defun project--delete-zombie-projects (predicate) + "Helper function used by `project-forget-zombie-projects'. +PREDICATE can be a function with 1 argument which determines which +projects should be deleted." (dolist (proj (project-known-project-roots)) - (when (and (if project-prune-zombie-projects - (funcall project-prune-zombie-projects proj) - t) + (when (and (funcall (or predicate #'identity) proj) (not (file-exists-p proj))) (project-forget-project proj)))) +(defun project-forget-zombie-projects (&optional interactive) + "Forget all known projects that don't exist any more." + (interactive (list t)) + (let ((pred (when interactive (alist-get 'interactively project-prune-zombie-projects)))) + (project--delete-zombie-projects pred))) + (defun project-forget-projects-under (dir &optional recursive) "Forget all known projects below a directory DIR. Interactively, prompt for DIR. commit 3f7c16d858e579ed03a195841ba9805fbc2899ba Author: Spencer Baugh Date: Wed Aug 20 14:27:59 2025 -0400 Add minibuffer--completions-visible and use it At various places, instead of just checking that there's any window displaying a buffer named *Completions*, we should additionally check that that *Completions* buffer is actually for the current completion session. minibuffer--completions-visible does that. * lisp/comint.el (comint-complete-input-ring) (comint-dynamic-list-completions): Call minibuffer--completions-visible. * lisp/minibuffer.el (minibuffer--completions-visible): Add. (bug#77253) (completion--do-completion, completions--post-command-update) (completions--after-change, minibuffer-hide-completions) (minibuffer-visible-completions) (minibuffer-visible-completions--always-bind) (minibuffer-visible-completions--filter) (with-minibuffer-completions-window, minibuffer-complete-history) (minibuffer-complete-defaults): Call minibuffer--completions-visible. * lisp/pcomplete.el (pcomplete-show-completions): Call minibuffer--completions-visible. * lisp/simple.el (switch-to-completions): Call minibuffer--completions-visible. * test/lisp/minibuffer-tests.el (completion-auto-help-test) (completion-auto-select-test): Call minibuffer--completions-visible. diff --git a/lisp/comint.el b/lisp/comint.el index b9c910eff43..bbb9820c16a 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -1197,7 +1197,7 @@ This function makes `comint-dynamic-list-input-ring' obsolete." (ring-elements comint-input-ring) (user-error "No history available"))) (completion-in-region-mode-predicate - (lambda () (get-buffer-window "*Completions*" 0)))) + (lambda () (minibuffer--completions-visible)))) (completion-in-region (comint-line-beginning-position) (point-max) (completion-table-with-metadata @@ -3521,7 +3521,7 @@ The optional argument COMMON-SUBSTRING, if non-nil, should be a string specifying a common substring for adding the faces `completions-first-difference' and `completions-common-part' to the completions." - (let ((window (get-buffer-window "*Completions*" 0))) + (let ((window (minibuffer--completions-visible))) (setq completions (sort completions #'string-lessp)) (if (and (eq last-command this-command) window (window-live-p window) (window-buffer window) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 2dd5e09f8bb..3c80d606cfc 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1616,7 +1616,7 @@ when the buffer's text is already an exact match." (completed (cond ((pcase completion-auto-help - ('visible (get-buffer-window "*Completions*" 0)) + ('visible (minibuffer--completions-visible)) ('always t)) (minibuffer-completion-help beg end)) (t (minibuffer-hide-completions) @@ -2677,13 +2677,13 @@ so that the update is less likely to interfere with user typing." (defun completions--post-command-update () "Update displayed *Completions* buffer after command, once." (remove-hook 'post-command-hook #'completions--post-command-update) - (when (and completion-eager-update (get-buffer-window "*Completions*" 0)) + (when (and completion-eager-update (minibuffer--completions-visible)) (completions--background-update))) (defun completions--after-change (_start _end _old-len) "Update displayed *Completions* buffer after change in buffer contents." (when (or completion-auto-deselect completion-eager-update) - (when-let* ((window (get-buffer-window "*Completions*" 0))) + (when-let* ((window (minibuffer--completions-visible))) (when completion-auto-deselect (with-selected-window window (completions--deselect))) @@ -2885,7 +2885,7 @@ so that the update is less likely to interfere with user typing." ;; FIXME: We could/should use minibuffer-scroll-window here, but it ;; can also point to the minibuffer-parent-window, so it's a bit tricky. (interactive) - (when-let* ((win (get-buffer-window "*Completions*" 0))) + (when-let* ((win (minibuffer--completions-visible))) (with-selected-window win ;; Move point off any completions, so we don't move point there ;; again the next time `minibuffer-completion-help' is called. @@ -3332,18 +3332,26 @@ and `RET' accepts the input typed into the minibuffer." (defvar minibuffer-visible-completions--always-bind nil "If non-nil, force the `minibuffer-visible-completions' bindings on.") +(defun minibuffer--completions-visible () + "Return the window where the current *Completions* buffer is visible, if any." + (when-let* ((window (get-buffer-window "*Completions*" 0))) + (when (eq (buffer-local-value 'completion-reference-buffer + (window-buffer window)) + ;; If there's no active minibuffer, we call + ;; `window-buffer' on nil, assuming that completion is + ;; happening in the selected window. + (window-buffer (active-minibuffer-window))) + window))) + (defun minibuffer-visible-completions--filter (cmd) "Return CMD if `minibuffer-visible-completions' bindings should be active." (if minibuffer-visible-completions--always-bind cmd - (when-let* ((window (get-buffer-window "*Completions*" 0))) - (when (and (eq (buffer-local-value 'completion-reference-buffer - (window-buffer window)) - (window-buffer (active-minibuffer-window))) - (if (eq cmd #'minibuffer-choose-completion-or-exit) - (with-current-buffer (window-buffer window) - (get-text-property (point) 'completion--string)) - t)) + (when-let* ((window (minibuffer--completions-visible))) + (when (if (eq cmd #'minibuffer-choose-completion-or-exit) + (with-current-buffer (window-buffer window) + (get-text-property (point) 'completion--string)) + t) cmd)))) (defun minibuffer-visible-completions--bind (binding) @@ -5107,10 +5115,10 @@ the minibuffer was activated, and execute the forms." When used in a minibuffer window, select the window with completions, and execute the forms." (declare (indent 0) (debug t)) - `(let ((window (or (get-buffer-window "*Completions*" 0) + `(let ((window (or (minibuffer--completions-visible) ;; Make sure we have a completions window. (progn (minibuffer-completion-help) - (get-buffer-window "*Completions*" 0))))) + (minibuffer--completions-visible))))) (when window (with-selected-window window (completion--lazy-insert-strings) @@ -5205,7 +5213,7 @@ inputs for the prompting command, instead of the default completion table." (user-error "No history available")))) ;; FIXME: Can we make it work for CRM? (let ((completion-in-region-mode-predicate - (lambda () (get-buffer-window "*Completions*" 0)))) + (lambda () (minibuffer--completions-visible)))) (completion-in-region (minibuffer--completion-prompt-end) (point-max) (completion-table-with-metadata @@ -5223,7 +5231,7 @@ provided by the prompting command, instead of the completion table." minibuffer-default (funcall minibuffer-default-add-function))) (let ((completions (ensure-list minibuffer-default)) (completion-in-region-mode-predicate - (lambda () (get-buffer-window "*Completions*" 0)))) + (lambda () (minibuffer--completions-visible)))) (completion-in-region (minibuffer--completion-prompt-end) (point-max) (completion-table-with-metadata diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el index 43d149d5c90..c3b7f9d52d3 100644 --- a/lisp/pcomplete.el +++ b/lisp/pcomplete.el @@ -1150,7 +1150,7 @@ Typing SPC flushes the help buffer." ((or (eq event 'tab) ;; Needed on a terminal (eq event 9)) - (let ((win (or (get-buffer-window "*Completions*" 0) + (let ((win (or (minibuffer--completions-visible) (display-buffer "*Completions*" 'not-this-window)))) (with-selected-window win diff --git a/lisp/simple.el b/lisp/simple.el index f7f059793ca..b0f6621b37e 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -10598,10 +10598,10 @@ to move point between completions.\n\n"))))))) (defun switch-to-completions () "Select the completion list window." (interactive) - (when-let* ((window (or (get-buffer-window "*Completions*" 0) + (when-let* ((window (or (minibuffer--completions-visible) ;; Make sure we have a completions window. (progn (minibuffer-completion-help) - (get-buffer-window "*Completions*" 0))))) + (minibuffer--completions-visible))))) (select-window window) (completion--lazy-insert-strings) (when (bobp) diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el index 59b72899e22..c2c37e63012 100644 --- a/test/lisp/minibuffer-tests.el +++ b/test/lisp/minibuffer-tests.el @@ -454,21 +454,21 @@ '("a" "ab" "ac") (execute-kbd-macro (kbd "a TAB TAB")) (should (equal (car messages) "Complete, but not unique")) - (should-not (get-buffer-window "*Completions*" 0)) + (should-not (minibuffer--completions-visible)) (execute-kbd-macro (kbd "b TAB")) (should (equal (car messages) "Sole completion")))) (let ((completion-auto-help t)) (completing-read-with-minibuffer-setup '("a" "ab" "ac") (execute-kbd-macro (kbd "a TAB TAB")) - (should (get-buffer-window "*Completions*" 0)) + (should (minibuffer--completions-visible)) (execute-kbd-macro (kbd "b TAB")) (should (equal (car messages) "Sole completion")))) (let ((completion-auto-help 'visible)) (completing-read-with-minibuffer-setup '("a" "ab" "ac" "achoo") (execute-kbd-macro (kbd "a TAB TAB")) - (should (get-buffer-window "*Completions*" 0)) + (should (minibuffer--completions-visible)) (execute-kbd-macro (kbd "ch TAB")) (should (equal (car messages) "Sole completion"))))))) @@ -477,19 +477,19 @@ (completing-read-with-minibuffer-setup '("aa" "ab" "ac") (execute-kbd-macro (kbd "a TAB")) - (should (and (get-buffer-window "*Completions*" 0) + (should (and (minibuffer--completions-visible) (eq (current-buffer) (get-buffer "*Completions*")))) (execute-kbd-macro (kbd "TAB TAB TAB")) - (should (and (get-buffer-window "*Completions*" 0) + (should (and (minibuffer--completions-visible) (eq (current-buffer) (get-buffer " *Minibuf-1*")))) (execute-kbd-macro (kbd "S-TAB")) - (should (and (get-buffer-window "*Completions*" 0) + (should (and (minibuffer--completions-visible) (eq (current-buffer) (get-buffer "*Completions*")))))) (let ((completion-auto-select 'second-tab)) (completing-read-with-minibuffer-setup '("aa" "ab" "ac") (execute-kbd-macro (kbd "a TAB")) - (should (and (get-buffer-window "*Completions*" 0) + (should (and (minibuffer--completions-visible) (not (eq (current-buffer) (get-buffer "*Completions*"))))) (execute-kbd-macro (kbd "TAB TAB")) (should (eq (current-buffer) (get-buffer "*Completions*")))))) commit f0b987c32c358703d85d3be010bb2fe0299192be Author: Steven Allen Date: Tue Aug 19 11:12:01 2025 -0700 rust-ts-mode: handle invalid rust syntax without signaling Don't signal an error when encountering invalid rust syntax. Without this patch, invalid rust code would prevent a chunk of the buffer from being highlighted (bug#79272). * lisp/progmodes/rust-ts-mode.el (rust-ts-mode--fontify-scope): (rust-ts-mode--fontify-pattern): Avoid calling `string-match-p' on nil when a node is missing a parent. * test/lisp/progmodes/rust-ts-mode-resources/font-lock-no-parent.rs: Rust file that reproduces the issue. * test/lisp/progmodes/rust-ts-mode-tests.el: Test case to reproduce the issue. diff --git a/lisp/progmodes/rust-ts-mode.el b/lisp/progmodes/rust-ts-mode.el index a5c217c0a4b..a98d621af65 100644 --- a/lisp/progmodes/rust-ts-mode.el +++ b/lisp/progmodes/rust-ts-mode.el @@ -366,7 +366,8 @@ See https://doc.rust-lang.org/reference/tokens.html#suffixes.") tail-p (string-match-p "\\`\\(?:use_list\\|call_expression\\|use_as_clause\\|use_declaration\\)\\'" - (treesit-node-type (treesit-node-parent (treesit-node-parent node))))) + (or (treesit-node-type (treesit-node-parent (treesit-node-parent node))) + "no_parent"))) nil) (t 'font-lock-constant-face)))) (when face @@ -387,9 +388,9 @@ See https://doc.rust-lang.org/reference/tokens.html#suffixes.") ,(treesit-query-compile 'rust '((identifier) @id (shorthand_field_identifier) @id))))) (pcase-dolist (`(_name . ,id) captures) - (unless (string-match-p "\\`scoped_\\(?:type_\\)?identifier\\'" - (treesit-node-type - (treesit-node-parent id))) + (unless (string-match-p + "\\`scoped_\\(?:type_\\)?identifier\\'" + (or (treesit-node-type (treesit-node-parent id)) "no_parent")) (treesit-fontify-with-override (treesit-node-start id) (treesit-node-end id) 'font-lock-variable-name-face override start end))))))) diff --git a/test/lisp/progmodes/rust-ts-mode-resources/font-lock-no-parent.rs b/test/lisp/progmodes/rust-ts-mode-resources/font-lock-no-parent.rs new file mode 100644 index 00000000000..85d0ccc9bf3 --- /dev/null +++ b/test/lisp/progmodes/rust-ts-mode-resources/font-lock-no-parent.rs @@ -0,0 +1,7 @@ ++// intentionally invalid syntax ++const THING: [u8; 48] = []; + +// should recover here and highlight the text below +trait Foo() { +// ^ font-lock-keyword-face +} diff --git a/test/lisp/progmodes/rust-ts-mode-tests.el b/test/lisp/progmodes/rust-ts-mode-tests.el index d2e28dcfbd7..32d64260a87 100644 --- a/test/lisp/progmodes/rust-ts-mode-tests.el +++ b/test/lisp/progmodes/rust-ts-mode-tests.el @@ -39,6 +39,13 @@ (ert-font-lock-test-file (ert-resource-file "font-lock-number.rs") 'rust-ts-mode))) +(ert-deftest rust-ts-test-no-parent () + (skip-unless (treesit-ready-p 'rust)) + (let ((treesit-font-lock-level 4) + (rust-ts-mode-fontify-number-suffix-as-type t)) + (ert-font-lock-test-file (ert-resource-file "font-lock-no-parent.rs") + 'rust-ts-mode))) + (provide 'rust-ts-mode-tests) ;;; rust-ts-mode-tests.el ends here commit 1a549762ed9f7cb09a1269503566837f91794ed6 Author: Rahguzar Date: Sun Aug 17 16:06:54 2025 +0500 Correctly document the format of tabulated-list-groups * lisp/emacs-lisp/tabulated-list.el (tabulated-list-groups): Correct format in doc string (bug#79220). * doc/lispref/modes.texi (Tabulated List Mode): Correct format in manual. diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index ba86b2d7b13..33c02aaabe3 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -1289,10 +1289,11 @@ the Tabulated List buffer. Its value should be either a list or a function. If the value is a list, each list element corresponds to one group, and -should have the form @w{@code{(@var{group-name} @var{entries})}}, where +should have the form +@w{@code{(@var{group-name} @var{entry1} @var{entry2} @dots{})}}, where @var{group-name} is a string inserted before all group entries, and -@var{entries} have the same format as @code{tabulated-list-entries} -(see above). +@var{entry1}, @var{entry2} and so on each have the same format as an +element of @code{tabulated-list-entries} (see above). Otherwise, the value should be a function which returns a list of the above form when called with no arguments. diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index 40b2fb0886b..f4220501b35 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -142,13 +142,14 @@ arguments and must return a list of the above form.") (defvar-local tabulated-list-groups nil "Groups displayed in the current Tabulated List buffer. This should be either a function, or a list. -If a list, each element has the form (GROUP-NAME ENTRIES), +If a list, each element has the form (GROUP-NAME ENTRY1 ENTRY2 ...), where: - GROUP-NAME is a group name as a string, which is displayed at the top line of each group. - - ENTRIES is a list described in `tabulated-list-entries'. + - ENTRY1, ENTRY2 and so on each have the same format as an element + of `tabulated-list-entries'. If `tabulated-list-groups' is a function, it is called with no arguments and must return a list of the above form.") commit fdf5e5dc415ef692e86f34c7eb4f7fa5bd9b18cb Author: Harald Jörg Date: Thu Aug 21 17:52:30 2025 +0200 ; cperl-mode.el: fix indentation for multiline signatures This fixes the first (and more important) part of Bug#79269. * lisp/progmodes/cperl-mode.el (cperl-get-state): Replace `beginning-of-defun' by `beginning-of-defun-raw'. Also fix a typo in the docstring. * test/lisp/progmodes/cperl-mode-tests.el (test-indentation): Skip tests unless in cperl-mode. The test file cperl-indents.erts explicitly invokes cperl-mode. Due to different indentation defaults the tests do not pass in perl-mode. * test/lisp/progmodes/cperl-mode-resources/cperl-indents.erts: Add test cperl-subroutine-signatures for Bug#79269 diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 8643b69ef83..1e2aca73161 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -2766,7 +2766,7 @@ PARSE-DATA is used to save status between calls in a loop." START is a good place to start parsing, or equal to PARSE-START if preset. STATE is what is returned by `parse-partial-sexp'. -DEPTH is true is we are immediately after end of block +DEPTH is true if we are immediately after end of block which contains START. PRESTART is the position basing on which START was found. START-STATE should be a good guess for the start of a function." @@ -2775,7 +2775,7 @@ START-STATE should be a good guess for the start of a function." (if (and parse-start (<= parse-start start-point)) (goto-char parse-start) - (beginning-of-defun) + (beginning-of-defun-raw) (when (cperl-declaration-header-p (point)) (goto-char (cperl-beginning-of-property (point) 'syntax-type)) (beginning-of-line)) diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-indents.erts b/test/lisp/progmodes/cperl-mode-resources/cperl-indents.erts index ab00e9ce6d4..3a779442a8a 100644 --- a/test/lisp/progmodes/cperl-mode-resources/cperl-indents.erts +++ b/test/lisp/progmodes/cperl-mode-resources/cperl-indents.erts @@ -98,3 +98,28 @@ Name: cperl-keyword-without-space my %h = map{$_=>1} @ARGV; =-=-= + +Name: cperl-subroutine-signatures + +=-= +# -*- mode: cperl -*- +# John Ciolfi reported as Bug#79269 +use strict; +use warnings; +use experimental 'signatures'; + +foo(1); + +sub foo ( + $in1, + $optionsHPtr = {}, + $otherOption1 = 1, # Bug: wrong face for this option + ) { + + my $a = 1; # Bug: should be indented by 2 spaces + + # Bug: following are not indented due to use of signatures + my $b = 2; + return $a + $b + $in1; +} +=-=-= diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index 00116986b4b..469345e74c9 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -1605,6 +1605,9 @@ It must not be mistaken for \"$)\"." (forward-line 1)))) (ert-deftest test-indentation () + ;; The erts file explicitly invokes cperl-mode, so skip in perl-mode. + ;; Indentation defaults are different, so it won't pass in perl-mode + (skip-unless (eq cperl-test-mode #'cperl-mode)) (ert-test-erts-file (ert-resource-file "cperl-indents.erts"))) ;;; cperl-mode-tests.el ends here commit c04553f655a05810f02dd77dac4f544018158e94 Author: Mattias Engdegård Date: Wed Aug 6 15:29:58 2025 +0200 Speed up JSON parsing by not maintaining line and column (bug#79192) We use the current parsing position instead. The line and column in the error weren't used (nor very accurate to begin with) and the user can easily compute them when needed. The line number calculation is kept just in case but deprecated, for removal in Emacs 32. * src/json.c (struct json_parser, json_parser_init): Update parser state. (json_signal_error): New position computation. (json_skip_whitespace_internal): Remove. (is_json_whitespace): New. (json_skip_whitespace, json_skip_whitespace_if_possible) (json_parse_unicode, json_parse_string, json_parse_number) (json_parse_value): Simplify and rewrite for efficiency. (count_chars, count_newlines) (string_byte_to_pos, string_byte_to_line) (buffer_byte_to_pos, buffer_byte_to_line): New. (Fjson_parse_string, Fjson_parse_buffer): Adapt to new parser state. * test/src/json-tests.el (json-tests--parse-string-error-pos) (json-tests--parse-buffer-error-pos, json-parse-error-position): New. * etc/NEWS: Note deprecation of line and column. diff --git a/etc/NEWS b/etc/NEWS index f45ee437bf9..e94464b203b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3010,6 +3010,11 @@ a remote host. It must be used in conjunction with the function +++ ** 'read-directory-name' now accepts an optional PREDICATE argument. +--- +** JSON parse error line and column are now obsolete. +The column number is no longer available; the line number will be +removed in next Emacs release. + * Changes in Emacs 31.1 on Non-Free Operating Systems diff --git a/src/json.c b/src/json.c index 44eae653eb5..30a22dc8038 100644 --- a/src/json.c +++ b/src/json.c @@ -684,10 +684,6 @@ struct json_parser const unsigned char *secondary_input_begin; const unsigned char *secondary_input_end; - ptrdiff_t current_line; - ptrdiff_t current_column; - ptrdiff_t point_of_current_line; - /* The parser has a maximum allowed depth. available_depth decreases at each object/array begin. If reaches zero, then an error is generated */ @@ -717,15 +713,22 @@ struct json_parser unsigned char *byte_workspace; unsigned char *byte_workspace_end; unsigned char *byte_workspace_current; + + Lisp_Object obj; + ptrdiff_t (*byte_to_pos) (Lisp_Object obj, ptrdiff_t byte); + ptrdiff_t (*byte_to_line) (Lisp_Object obj, ptrdiff_t byte); }; static AVOID -json_signal_error (struct json_parser *parser, Lisp_Object error) -{ - xsignal3 (error, INT_TO_INTEGER (parser->current_line), - INT_TO_INTEGER (parser->current_column), - INT_TO_INTEGER (parser->point_of_current_line - + parser->current_column)); +json_signal_error (struct json_parser *p, Lisp_Object error) +{ + ptrdiff_t byte = (p->input_current - p->input_begin + + p->additional_bytes_count); + ptrdiff_t pos = p->byte_to_pos (p->obj, byte); + ptrdiff_t line = p->byte_to_line (p->obj, byte) + 1; + /* The line number here is deprecated and provided for compatibility only. + It is scheduled for removal in Emacs 32. */ + xsignal3 (error, INT_TO_INTEGER (line), Qnil, INT_TO_INTEGER (pos)); } static void @@ -734,7 +737,10 @@ json_parser_init (struct json_parser *parser, const unsigned char *input, const unsigned char *input_end, const unsigned char *secondary_input, - const unsigned char *secondary_input_end) + const unsigned char *secondary_input_end, + ptrdiff_t (*byte_to_pos) (Lisp_Object, ptrdiff_t), + ptrdiff_t (*byte_to_line) (Lisp_Object, ptrdiff_t), + Lisp_Object obj) { if (secondary_input >= secondary_input_end) { @@ -761,9 +767,6 @@ json_parser_init (struct json_parser *parser, parser->input_current = parser->input_begin; - parser->current_line = 1; - parser->current_column = 0; - parser->point_of_current_line = 0; parser->available_depth = 10000; parser->conf = conf; @@ -777,6 +780,9 @@ json_parser_init (struct json_parser *parser, parser->byte_workspace = parser->internal_byte_workspace; parser->byte_workspace_end = (parser->byte_workspace + JSON_PARSER_INTERNAL_BYTE_WORKSPACE_SIZE); + parser->byte_to_pos = byte_to_pos; + parser->byte_to_line = byte_to_line; + parser->obj = obj; } static void @@ -956,20 +962,9 @@ json_input_put_back (struct json_parser *parser) } static bool -json_skip_whitespace_internal (struct json_parser *parser, int c) +is_json_whitespace (int c) { - parser->current_column++; - if (c == 0x20 || c == 0x09 || c == 0x0d) - return false; - else if (c == 0x0a) - { - parser->current_line++; - parser->point_of_current_line += parser->current_column; - parser->current_column = 0; - return false; - } - else - return true; + return c == 0x20 || c == 0x09 || c == 0x0d || c == 0x0a; } /* Skips JSON whitespace, and returns with the first non-whitespace @@ -980,7 +975,7 @@ json_skip_whitespace (struct json_parser *parser) for (;;) { int c = json_input_get (parser); - if (json_skip_whitespace_internal (parser, c)) + if (!is_json_whitespace (c)) return c; } } @@ -994,9 +989,7 @@ json_skip_whitespace_if_possible (struct json_parser *parser) for (;;) { int c = json_input_get_if_possible (parser); - if (c < 0) - return c; - if (json_skip_whitespace_internal (parser, c)) + if (!is_json_whitespace (c) || c < 0) return c; } } @@ -1022,7 +1015,6 @@ json_parse_unicode (struct json_parser *parser) for (int i = 0; i < 4; i++) { int c = json_hex_value (json_input_get (parser)); - parser->current_column++; if (c < 0) json_signal_error (parser, Qjson_escape_sequence_error); v[i] = c; @@ -1068,13 +1060,11 @@ json_parse_string (struct json_parser *parser, bool intern, bool leading_colon) json_byte_workspace_put (parser, c2); json_byte_workspace_put (parser, c3); parser->input_current += 4; - parser->current_column += 4; continue; } } int c = json_input_get (parser); - parser->current_column++; if (json_plain_char[c]) { json_byte_workspace_put (parser, c); @@ -1137,7 +1127,6 @@ json_parse_string (struct json_parser *parser, bool intern, bool leading_colon) { /* Handle escape sequences */ c = json_input_get (parser); - parser->current_column++; if (c == '"') json_byte_workspace_put (parser, '"'); else if (c == '\\') @@ -1160,11 +1149,9 @@ json_parse_string (struct json_parser *parser, bool intern, bool leading_colon) /* is the first half of the surrogate pair */ if (num >= 0xd800 && num < 0xdc00) { - parser->current_column++; if (json_input_get (parser) != '\\') json_signal_error (parser, Qjson_invalid_surrogate_error); - parser->current_column++; if (json_input_get (parser) != 'u') json_signal_error (parser, Qjson_invalid_surrogate_error); @@ -1285,7 +1272,6 @@ json_parse_number (struct json_parser *parser, int c) negative = true; c = json_input_get (parser); json_byte_workspace_put (parser, c); - parser->current_column++; } if (c < '0' || c > '9') json_signal_error (parser, Qjson_parse_error); @@ -1317,7 +1303,6 @@ json_parse_number (struct json_parser *parser, int c) if (c < '0' || c > '9') break; json_byte_workspace_put (parser, c); - parser->current_column++; integer_overflow |= ckd_mul (&integer, integer, 10); integer_overflow |= ckd_add (&integer, integer, c - '0'); @@ -1328,12 +1313,10 @@ json_parse_number (struct json_parser *parser, int c) if (c == '.') { json_byte_workspace_put (parser, c); - parser->current_column++; is_float = true; c = json_input_get (parser); json_byte_workspace_put (parser, c); - parser->current_column++; if (c < '0' || c > '9') json_signal_error (parser, Qjson_parse_error); for (;;) @@ -1344,23 +1327,19 @@ json_parse_number (struct json_parser *parser, int c) if (c < '0' || c > '9') break; json_byte_workspace_put (parser, c); - parser->current_column++; } } if (c == 'e' || c == 'E') { json_byte_workspace_put (parser, c); - parser->current_column++; is_float = true; c = json_input_get (parser); json_byte_workspace_put (parser, c); - parser->current_column++; if (c == '-' || c == '+') { c = json_input_get (parser); json_byte_workspace_put (parser, c); - parser->current_column++; } if (c < '0' || c > '9') json_signal_error (parser, Qjson_parse_error); @@ -1372,7 +1351,6 @@ json_parse_number (struct json_parser *parser, int c) if (c < '0' || c > '9') break; json_byte_workspace_put (parser, c); - parser->current_column++; } } @@ -1605,57 +1583,67 @@ json_is_token_char (int c) || (c >= '0' && c <= '9') || (c == '-')); } -/* This is the entry point to the value parser, this parses a JSON - * value */ -Lisp_Object +static Lisp_Object json_parse_value (struct json_parser *parser, int c) { - if (c == '{') - return json_parse_object (parser); - else if (c == '[') - return json_parse_array (parser); - else if (c == '"') - return json_parse_string (parser, false, false); - else if ((c >= '0' && c <= '9') || (c == '-')) - return json_parse_number (parser, c); - else + switch (c) { - int c2 = json_input_get_if_possible (parser); - int c3 = json_input_get_if_possible (parser); - int c4 = json_input_get_if_possible (parser); - int c5 = json_input_get_if_possible (parser); - - if (c == 't' && c2 == 'r' && c3 == 'u' && c4 == 'e' - && (c5 < 0 || !json_is_token_char (c5))) + case '{': + return json_parse_object (parser); + case '[': + return json_parse_array (parser); + case '"': + return json_parse_string (parser, false, false); + case '0': case '1': case '2': case '3': case '4': + case '5': case '6': case '7': case '8': case '9': + case '-': + return json_parse_number (parser, c); + case 't': + if (json_input_get_if_possible (parser) == 'r' + && json_input_get_if_possible (parser) == 'u' + && json_input_get_if_possible (parser) == 'e') { - if (c5 >= 0) - json_input_put_back (parser); - parser->current_column += 3; - return Qt; + int c2 = json_input_get_if_possible (parser); + if (!json_is_token_char (c2)) + { + if (c2 >= 0) + json_input_put_back (parser); + return Qt; + } } - if (c == 'n' && c2 == 'u' && c3 == 'l' && c4 == 'l' - && (c5 < 0 || !json_is_token_char (c5))) + break; + case 'f': + if (json_input_get_if_possible (parser) == 'a' + && json_input_get_if_possible (parser) == 'l' + && json_input_get_if_possible (parser) == 's' + && json_input_get_if_possible (parser) == 'e') { - if (c5 >= 0) - json_input_put_back (parser); - parser->current_column += 3; - return parser->conf.null_object; + int c2 = json_input_get_if_possible (parser); + if (!json_is_token_char (c2)) + { + if (c2 >= 0) + json_input_put_back (parser); + return parser->conf.false_object; + } } - if (c == 'f' && c2 == 'a' && c3 == 'l' && c4 == 's' - && c5 == 'e') + break; + case 'n': + if (json_input_get_if_possible (parser) == 'u' + && json_input_get_if_possible (parser) == 'l' + && json_input_get_if_possible (parser) == 'l') { - int c6 = json_input_get_if_possible (parser); - if (c6 < 0 || !json_is_token_char (c6)) + int c2 = json_input_get_if_possible (parser); + if (!json_is_token_char (c2)) { - if (c6 >= 0) + if (c2 >= 0) json_input_put_back (parser); - parser->current_column += 4; - return parser->conf.false_object; + return parser->conf.null_object; } } - - json_signal_error (parser, Qjson_parse_error); + break; } + + json_signal_error (parser, Qjson_parse_error); } static Lisp_Object @@ -1664,6 +1652,42 @@ json_parse (struct json_parser *parser) return json_parse_value (parser, json_skip_whitespace (parser)); } +/* Count number of characters in the NBYTES bytes at S. */ +static ptrdiff_t +count_chars (const unsigned char *s, ptrdiff_t nbytes) +{ + ptrdiff_t nchars = 0; + for (ptrdiff_t i = 0; i < nbytes; i++) + nchars += (s[i] & 0xc0) != 0x80; + return nchars; +} + +/* Count number of newlines in the NBYTES bytes at S. */ +static ptrdiff_t +count_newlines (const unsigned char *s, ptrdiff_t nbytes) +{ + ptrdiff_t nls = 0; + for (ptrdiff_t i = 0; i < nbytes; i++) + nls += (s[i] == '\n'); + return nls; +} + +static ptrdiff_t +string_byte_to_pos (Lisp_Object obj, ptrdiff_t byte) +{ + eassert (STRINGP (obj)); + eassert (byte <= SBYTES (obj)); + return STRING_MULTIBYTE (obj) ? count_chars (SDATA (obj), byte) : byte; +} + +static ptrdiff_t +string_byte_to_line (Lisp_Object obj, ptrdiff_t byte) +{ + eassert (STRINGP (obj)); + eassert (byte <= SBYTES (obj)); + return count_newlines (SDATA (obj), byte); +} + DEFUN ("json-parse-string", Fjson_parse_string, Sjson_parse_string, 1, MANY, NULL, doc: /* Parse the JSON STRING into a Lisp value. @@ -1703,7 +1727,8 @@ usage: (json-parse-string STRING &rest ARGS) */) struct json_parser p; const unsigned char *begin = SDATA (string); - json_parser_init (&p, conf, begin, begin + SBYTES (string), NULL, NULL); + json_parser_init (&p, conf, begin, begin + SBYTES (string), NULL, NULL, + string_byte_to_pos, string_byte_to_line, string); record_unwind_protect_ptr (json_parser_done, &p); Lisp_Object result = json_parse (&p); @@ -1713,6 +1738,24 @@ usage: (json-parse-string STRING &rest ARGS) */) return unbind_to (count, result); } +static ptrdiff_t +buffer_byte_to_pos (Lisp_Object obj, ptrdiff_t byte) +{ + /* The position from the start of the parse (for compatibility). */ + return BYTE_TO_CHAR (PT_BYTE + byte) - PT; +} + +static ptrdiff_t +buffer_byte_to_line (Lisp_Object obj, ptrdiff_t byte) +{ + /* Line from start of the parse (for compatibility). */ + ptrdiff_t to_gap = GPT_BYTE - PT_BYTE; + return (to_gap > 0 && to_gap < byte + ? (count_newlines (PT_ADDR, to_gap) + + count_newlines (GAP_END_ADDR, byte - to_gap)) + : count_newlines (PT_ADDR, byte)); +} + DEFUN ("json-parse-buffer", Fjson_parse_buffer, Sjson_parse_buffer, 0, MANY, NULL, doc: /* Read a JSON value from current buffer starting at point. @@ -1766,8 +1809,8 @@ usage: (json-parse-buffer &rest args) */) secondary_end = ZV_ADDR; } - json_parser_init (&p, conf, begin, end, secondary_begin, - secondary_end); + json_parser_init (&p, conf, begin, end, secondary_begin, secondary_end, + buffer_byte_to_pos, buffer_byte_to_line, Qnil); record_unwind_protect_ptr (json_parser_done, &p); Lisp_Object result = json_parse (&p); @@ -1776,7 +1819,7 @@ usage: (json-parse-buffer &rest args) */) ptrdiff_t position = (NILP (BVAR (current_buffer, enable_multibyte_characters)) ? byte - : PT + p.point_of_current_line + p.current_column); + : BYTE_TO_CHAR (byte)); SET_PT_BOTH (position, byte); return unbind_to (count, result); diff --git a/test/src/json-tests.el b/test/src/json-tests.el index 1cb667ddeac..30cf32039f9 100644 --- a/test/src/json-tests.el +++ b/test/src/json-tests.el @@ -424,5 +424,34 @@ See also `with-temp-buffer'." (puthash 1 2 table) (should-error (json-serialize table) :type 'wrong-type-argument))) +(defun json-tests--parse-string-error-pos (s) + (condition-case e + (json-parse-string s) + (json-error (nth 3 e)) + (:success 'no-error))) + +(defun json-tests--parse-buffer-error-pos () + (condition-case e + (json-parse-buffer) + (json-error (nth 3 e)) + (:success 'no-error))) + +(ert-deftest json-parse-error-position () + (let* ((s "[\"*Ωßœ☃*\",,8]") + (su (encode-coding-string s 'utf-8-emacs))) + (should (equal (json-tests--parse-string-error-pos s) 11)) + (should (equal (json-tests--parse-string-error-pos su) 16)) + + (with-temp-buffer + (let ((junk "some leading junk")) + (insert junk) + (insert s) + (goto-char (1+ (length junk))) + (should (equal (json-tests--parse-buffer-error-pos) 11)) + + (set-buffer-multibyte nil) + (goto-char (1+ (length junk))) + (should (equal (json-tests--parse-buffer-error-pos) 16)))))) + (provide 'json-tests) ;;; json-tests.el ends here commit 3b80b706e552732825f80594c8459935a940a353 Author: Mattias Engdegård Date: Tue Aug 19 21:03:15 2025 +0200 Free tar-mode helper buffers after use in package.el (bug#79280) The auxiliary buffer used by tar-mode is normally destroyed when the parent buffer is, but package.el uses tar-mode in temporary buffers which inhibit kill-buffer-hook and this made package installation leave orphaned buffers behind. * lisp/emacs-lisp/package.el (package-untar-buffer) (package-install-file): Switch away from tar-mode before the buffer is killed, triggering a tar-data buffer purge. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index fe6bebc67ff..ba9999c20e6 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -995,18 +995,22 @@ Newer versions are always activated, regardless of FORCE." This uses `tar-untar-buffer' from Tar mode. All files should untar into a directory named DIR; otherwise, signal an error." (tar-mode) - ;; Make sure everything extracts into DIR. - (let ((regexp (concat "\\`" (regexp-quote (expand-file-name dir)) "/")) - (case-fold-search (file-name-case-insensitive-p dir))) - (dolist (tar-data tar-parse-info) - (let ((name (expand-file-name (tar-header-name tar-data)))) - (or (string-match regexp name) - ;; Tarballs created by some utilities don't list - ;; directories with a trailing slash (Bug#13136). - (and (string-equal (expand-file-name dir) name) - (eq (tar-header-link-type tar-data) 5)) - (error "Package does not untar cleanly into directory %s/" dir))))) - (tar-untar-buffer)) + (unwind-protect + (progn + ;; Make sure everything extracts into DIR. + (let ((regexp (concat "\\`" (regexp-quote (expand-file-name dir)) "/")) + (case-fold-search (file-name-case-insensitive-p dir))) + (dolist (tar-data tar-parse-info) + (let ((name (expand-file-name (tar-header-name tar-data)))) + (or (string-match regexp name) + ;; Tarballs created by some utilities don't list + ;; directories with a trailing slash (Bug#13136). + (and (string-equal (expand-file-name dir) name) + (eq (tar-header-link-type tar-data) 5)) + (error "Package does not untar cleanly into directory %s/" + dir))))) + (tar-untar-buffer)) + (fundamental-mode))) ; free auxiliary tar-mode data (defun package--alist-to-plist-args (alist) (mapcar #'macroexp-quote @@ -2455,7 +2459,9 @@ directory." (set-visited-file-name file) (set-buffer-modified-p nil) (when (string-match "\\.tar\\'" file) (tar-mode))) - (package-install-from-buffer))) + (unwind-protect + (package-install-from-buffer) + (fundamental-mode)))) ; free auxiliary data ;;;###autoload (defun package-install-selected-packages (&optional noconfirm) commit 14c2e5f1bec51523ec5d3793aa733a2f60d92fe4 Author: Mattias Engdegård Date: Fri Aug 8 21:23:23 2025 +0200 Eliminate some gratuitous string mutation * lisp/play/zone.el (zone-replace-char): * lisp/international/quail.el (quail-get-translations): * lisp/hippie-exp.el (he-capitalize-first): Clarify the code by removing mutation that is probably not resizing but just in case. diff --git a/lisp/hippie-exp.el b/lisp/hippie-exp.el index 3b89521e0fd..a7bb6ef92e9 100644 --- a/lisp/hippie-exp.el +++ b/lisp/hippie-exp.el @@ -334,11 +334,12 @@ undoes the expansion." (defun he-capitalize-first (str) (save-match-data - (if (string-match "\\Sw*\\(\\sw\\).*" str) - (let ((res (downcase str)) - (no (match-beginning 1))) - (aset res no (upcase (aref str no))) - res) + (if (string-match "\\Sw*\\(\\sw\\)" str) + (let ((b (match-beginning 1)) + (e (match-end 1))) + (concat (substring str 0 b) + (upcase (substring str b e)) + (downcase (substring str e)))) str))) (defun he-ordinary-case-p (str) diff --git a/lisp/international/quail.el b/lisp/international/quail.el index 20649082941..d015b73e955 100644 --- a/lisp/international/quail.el +++ b/lisp/international/quail.el @@ -2135,10 +2135,14 @@ minibuffer and the selected frame has no other windows)." (let ((guidance (quail-guidance))) (if (listp guidance) ;; We must replace the typed key with the specified PROMPT-KEY. - (dotimes (i (length str)) - (let ((prompt-key (cdr (assoc (aref str i) guidance)))) - (if prompt-key - (aset str i (aref prompt-key 0))))))) + (setq str (apply #'string + (mapcar + (lambda (c) + (let ((prompt-key (assq c guidance))) + (if prompt-key + (aref (cdr prompt-key) 0) + c))) + str))))) ;; Show followable keys. (if (and (> (length quail-current-key) 0) (cdr map)) diff --git a/lisp/play/zone.el b/lisp/play/zone.el index 39a33f1e2a0..5f817c10371 100644 --- a/lisp/play/zone.el +++ b/lisp/play/zone.el @@ -433,8 +433,9 @@ run a specific program. The program must be a member of (defsubst zone-replace-char (count del-count char-as-string new-value) (delete-char (or del-count (- count))) - (aset char-as-string 0 new-value) - (dotimes (_ count) (insert char-as-string))) + (let ((s (apply #'propertize (string new-value) + (text-properties-at 0 char-as-string)))) + (dotimes (_ count) (insert s)))) (defsubst zone-park/sit-for (pos seconds) (let ((p (point))) commit 475a5d56d06253c688d5481dd58d21a9844b33ae Author: Mattias Engdegård Date: Wed Aug 20 13:05:12 2025 +0200 ; * src/lread.c (from_buffer_p): New abstraction. diff --git a/src/lread.c b/src/lread.c index 80172dbe7c8..1a667ce163a 100644 --- a/src/lread.c +++ b/src/lread.c @@ -522,6 +522,12 @@ from_file_p (source_t *source) return source->get == source_file_get; } +static bool +from_buffer_p (source_t *source) +{ + return source->get == source_buffer_get; +} + static void skip_dyn_bytes (source_t *source, ptrdiff_t n) { @@ -630,7 +636,7 @@ unreadbyte_from_file (unsigned char c) static AVOID invalid_syntax_lisp (Lisp_Object s, source_t *source) { - if (source->get == source_buffer_get) + if (from_buffer_p (source)) { Lisp_Object buffer = source->object; /* Get the line/column in the buffer. */ @@ -2120,7 +2126,7 @@ end_of_file_error (source_t *source) /* Only Fload calls read on a file, and Fload always binds load-true-file-name around the call. */ xsignal1 (Qend_of_file, Vload_true_file_name); - else if (source->get == source_buffer_get) + else if (from_buffer_p (source)) xsignal1 (Qend_of_file, source->object); else xsignal0 (Qend_of_file);