From bcb83d7d2ad1d34a6683fc466654437b1e25ad16 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 1 Jul 2026 17:01:12 +0200 Subject: [PATCH 01/13] Fix error handling in Tramp delete-{file,directory} * lisp/net/tramp-smb.el (tramp-smb-handle-delete-directory): * lisp/net/tramp.el (tramp-skeleton-delete-directory): Fail if DIRECTORY is missing. (tramp-skeleton-delete-file): Don't fail if DIRECTORY is missing. * test/lisp/net/tramp-tests.el (tramp-test14-delete-directory): Adapt test. --- lisp/net/tramp-smb.el | 55 ++++++++++++++++++------------------ lisp/net/tramp.el | 24 ++++++++-------- test/lisp/net/tramp-tests.el | 10 +++++++ 3 files changed, 50 insertions(+), 39 deletions(-) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index ac54e47e376..6f88c7dedba 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -651,36 +651,35 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (defun tramp-smb-handle-delete-directory (directory &optional recursive trash) "Like `delete-directory' for Tramp files." (tramp-skeleton-delete-directory directory recursive trash - (when (file-exists-p directory) - (when recursive - (mapc - (lambda (file) - (if (file-directory-p file) - (delete-directory file recursive) - (delete-file file))) - ;; We do not want to delete "." and "..". - (directory-files directory 'full directory-files-no-dot-files-regexp))) + (when recursive + (mapc + (lambda (file) + (if (file-directory-p file) + (delete-directory file recursive) + (delete-file file))) + ;; We do not want to delete "." and "..". + (directory-files directory 'full directory-files-no-dot-files-regexp))) - ;; We must also flush the cache of the directory, because - ;; `file-attributes' reads the values from there. - (tramp-flush-directory-properties v localname) - (unless (tramp-smb-send-command - v (format - "%s %s" - (if (tramp-smb-get-cifs-capabilities v) - "posix_rmdir" "rmdir") - (tramp-smb-shell-quote-localname v))) - ;; Error. - (with-current-buffer (tramp-get-connection-buffer v) - (goto-char (point-min)) - (search-forward-regexp tramp-smb-errors nil t) - (tramp-error v 'file-error "%s `%s'" (match-string 0) directory))) + ;; We must also flush the cache of the directory, because + ;; `file-attributes' reads the values from there. + (tramp-flush-directory-properties v localname) + (unless (tramp-smb-send-command + v (format + "%s %s" + (if (tramp-smb-get-cifs-capabilities v) + "posix_rmdir" "rmdir") + (tramp-smb-shell-quote-localname v))) + ;; Error. + (with-current-buffer (tramp-get-connection-buffer v) + (goto-char (point-min)) + (search-forward-regexp tramp-smb-errors nil t) + (tramp-error v 'file-error "%s `%s'" (match-string 0) directory))) - ;; "rmdir" does not report an error. So we check ourselves. - ;; Deletion of a watched directory could be pending. - (when (and (not (tramp-directory-watched directory)) - (file-exists-p directory)) - (tramp-error v 'file-error "`%s' not removed" directory))))) + ;; "rmdir" does not report an error. So we check ourselves. + ;; Deletion of a watched directory could be pending. + (when (and (not (tramp-directory-watched directory)) + (file-exists-p directory)) + (tramp-error v 'file-error "`%s' not removed" directory)))) (defun tramp-smb-handle-delete-file (filename &optional trash) "Like `delete-file' for Tramp files." diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index c5ecbdd9675..78e1d34ebab 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3734,14 +3734,15 @@ BODY is the backend specific code." ;; This variable exists since Emacs 30.1. (not (bound-and-true-p remote-file-name-inhibit-delete-by-moving-to-trash))))) - (if (and delete-by-moving-to-trash ,trash) - ;; Move non-empty dir to trash only if recursive deletion was - ;; requested. - (if (not (or ,recursive (directory-empty-p ,directory))) - (tramp-error - v 'file-error "Directory is not empty, not moving to trash") - (move-file-to-trash ,directory)) - ,@body) + (tramp-barf-if-file-missing v ,directory + (if (and delete-by-moving-to-trash ,trash) + ;; Move non-empty dir to trash only if recursive deletion was + ;; requested. + (if (not (or ,recursive (directory-empty-p ,directory))) + (tramp-error + v 'file-error "Directory is not empty, not moving to trash") + (move-file-to-trash ,directory)) + ,@body)) (tramp-flush-directory-properties v localname)))) (defmacro tramp-skeleton-delete-file (filename &optional trash &rest body) @@ -3754,9 +3755,10 @@ BODY is the backend specific code." ;; This variable exists since Emacs 30.1. (not (bound-and-true-p remote-file-name-inhibit-delete-by-moving-to-trash))))) - (if (and delete-by-moving-to-trash ,trash) - (move-file-to-trash ,filename) - ,@body) + (ignore-errors + (if (and delete-by-moving-to-trash ,trash) + (move-file-to-trash ,filename) + ,@body)) (tramp-flush-file-properties v localname)))) (defmacro tramp-skeleton-directory-files diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index b622a08dce3..6badf064efe 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3322,6 +3322,16 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted)) (tmp-name2 (expand-file-name "foo" tmp-name1))) + ;; Deleting a non-existing file should not fail. + (delete-file tmp-name1) + (delete-file tmp-name1 'trash) + ;; Deleting a non-existing directory should fail. + (should-error + (delete-directory tmp-name1) + :type 'file-missing) + (should-error + (delete-directory tmp-name1 nil 'trash) + :type 'file-missing) ;; Delete empty directory. (make-directory tmp-name1) (should (file-directory-p tmp-name1)) From ba7d2b8232584bc1c67708b3cd01f9470ff1bc76 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 1 Jul 2026 17:01:30 +0200 Subject: [PATCH 02/13] * admin/notes/jargon: Add TTTT. --- admin/notes/jargon | 1 + 1 file changed, 1 insertion(+) diff --git a/admin/notes/jargon b/admin/notes/jargon index 35f7a8c1037..20ebf200e92 100644 --- a/admin/notes/jargon +++ b/admin/notes/jargon @@ -75,6 +75,7 @@ TIA - thanks in advance TIL - today I learned TL;DR - too long; didn't read TRT - the right thing +TTTT - to tell the truth WFM - works for me WIP - work in progress WRT - with respect to From 707b0ba0f4cc59b451ea039b01af5c977d96e46d Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Thu, 2 Jul 2026 07:33:09 +0300 Subject: [PATCH 03/13] Fix project--clear-cache and project--value-in-dir in special case * lisp/progmodes/project.el (project--clear-cache): Make sure to clear the 'project-vc-dir-locals' keys too. (project--value-in-dir): Predicate the cache lookup (and most importantly, write) on whether enable-dir-local-variables is non-nil. So its uses inside recursive 'project-try-vc--search' call do not not bust the value (bug#81317). --- lisp/progmodes/project.el | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index ebbaa7609ea..557d4260b77 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -647,7 +647,9 @@ It is used when `non-essential' is non-nil.") (obarray-map (lambda (sym) (if (get sym 'project-vc) - (put sym 'project-vc nil))) + (put sym 'project-vc nil)) + (if (get sym 'project-vc-dir-locals) + (put sym 'project-vc-dir-locals nil))) vc-file-prop-obarray)) (defun project-try-vc (dir) @@ -967,13 +969,15 @@ DIRS must contain directory names." (defun project--value-in-dir (var dir) (alist-get var - (let ((cached (project--get-cached dir 'project-vc-dir-locals))) - (if (eq cached 'none) - nil - (or cached - (let ((res (project--read-dir-locals dir))) - (project--set-cached dir 'project-vc-dir-locals (or res 'none)) - res)))) + (and + enable-dir-local-variables + (let ((cached (project--get-cached dir 'project-vc-dir-locals))) + (if (eq cached 'none) + nil + (or cached + (let ((res (project--read-dir-locals dir))) + (project--set-cached dir 'project-vc-dir-locals (or res 'none)) + res))))) (default-value var))) (defun project--read-dir-locals (dir) From 5fde9732b4be6fc2dbc9ba8ae67dad01572ffcad Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Thu, 2 Jul 2026 07:58:09 +0300 Subject: [PATCH 04/13] Localize cache invalidation to project-try-vc With other functions only using the cached values or populating when necessary. * lisp/progmodes/project.el: Update commentary (bug#81317). (project--get-cached): Add explicit parameter TIMEOUT, use it. (project-try-vc): Build its value from 'non-essential' and the values of two timeout variables. And pass them on. (project-try-vc--search, project--vc-merge-submodules-p) (project--value-in-dir): Also add TIMEOUT. (project-files, vc-git-project-list-files) (vc-hg-project-list-files, project-ignores, project-buffers) (project-name, project-uniquify-dirname-transform): Remove the binding of 'non-essential' as now redundant for cache duration. * test/lisp/progmodes/project-tests.el (project-try-vc-uses-cache) (project-try-vc-invalidates-cache) (project-name--reuses-cache) (project-name--obeys-cache-invalidation): New tests. (project-vc-supports-project-in-different-dir) (project-vc-ignores-in-external-directory): Use 'project--clear-cache' as the more reliable option. --- lisp/progmodes/project.el | 78 +++++++++++++-------------- test/lisp/progmodes/project-tests.el | 80 +++++++++++++++++++++++++++- 2 files changed, 115 insertions(+), 43 deletions(-) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 557d4260b77..9ecc1f910d2 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -84,11 +84,11 @@ ;; This project type can also be used for non-VCS controlled ;; directories, see the variable `project-vc-extra-root-markers'. ;; -;; Some of the methods on this backend cache their computations for time -;; determined either by variable `project-vc-cache-timeout' or +;; Some of the methods on this backend cache their computations. +;; Cache invalidation is done inside the `project-current' call, with +;; duration determined either by variable `project-vc-cache-timeout' or ;; `project-vc-non-essential-cache-timeout', depending on whether the -;; MAYBE-PROMPT argument to `project-current' is non-nil, or the value -;; of `non-essential' when project methods are called. +;; argument MAYBE-PROMPT is non-nil. ;; ;; Utils: ;; @@ -613,27 +613,21 @@ higher numbers, intended for \"background\" things like `project-mode-line' indicators and `project-uniquify-dirname-transform'. It is used when `non-essential' is non-nil.") -(defun project--get-cached (dir key) +(defun project--get-cached (dir key timeout) (let ((cached (vc-file-getprop dir key)) (current-time (float-time))) (when (and (numberp (cdr cached)) ;; Support package upgrade mid-session. - (let* ((project-vc-cache-timeout - (if non-essential - project-vc-non-essential-cache-timeout - project-vc-cache-timeout)) - (timeout + (let* ((timeout (cond - ((numberp project-vc-cache-timeout) - project-vc-cache-timeout) - ((null project-vc-cache-timeout) - nil) - ((listp project-vc-cache-timeout) + ((numberp timeout) + timeout) + ((listp timeout) (cdr (seq-find (lambda (pair) (and (functionp (car pair)) (funcall (car pair) dir))) - project-vc-cache-timeout))) + timeout))) (t nil)))) (or (null timeout) (< (- current-time (cdr cached)) timeout)))) @@ -658,15 +652,18 @@ It is used when `non-essential' is non-nil.") The value is cached, and depending on whether MAYBE-PROMPT was non-nil in the `project-current' call, the timeout is determined by `project-vc-cache-timeout' or `project-vc-non-essential-cache-timeout'." - (let ((cached (project--get-cached dir 'project-vc))) + (let* ((timeout (if non-essential + project-vc-non-essential-cache-timeout + project-vc-cache-timeout)) + (cached (project--get-cached dir 'project-vc timeout))) (if (eq cached 'none) nil (or cached - (let ((res (project-try-vc--search dir))) + (let ((res (project-try-vc--search dir timeout))) (project--set-cached dir 'project-vc (or res 'none)) res))))) -(defun project-try-vc--search (dir) +(defun project-try-vc--search (dir timeout) (let* ((backend-markers (delete nil @@ -679,7 +676,7 @@ in the `project-current' call, the timeout is determined by (mapconcat (lambda (m) (format "\\(%s\\)" (wildcard-to-regexp m))) (append backend-markers - (project--value-in-dir 'project-vc-extra-root-markers dir)) + (project--value-in-dir 'project-vc-extra-root-markers dir timeout)) "\\|") "\\'")) (locate-dominating-stop-dir-regexp @@ -704,7 +701,7 @@ in the `project-current' call, the timeout is determined by (while (and root (eq backend 'Git) - (project--vc-merge-submodules-p root) + (project--vc-merge-submodules-p root timeout) (project--submodule-p root)) (let* ((parent (file-name-directory (directory-file-name root)))) (setq root (vc-call-backend 'Git 'root parent)))) @@ -715,7 +712,7 @@ in the `project-current' call, the timeout is determined by (let* ((project-vc-extra-root-markers nil) ;; Avoid submodules scan. (enable-dir-local-variables nil) - (parent (project-try-vc--search root))) + (parent (project-try-vc--search root timeout))) (and parent (setq backend (nth 1 parent))))) (setq project (list 'vc backend root)) project))) @@ -764,7 +761,7 @@ in the `project-current' call, the timeout is determined by (cl-defmethod project-files ((project (head vc)) &optional dirs) (mapcan (lambda (dir) - (let ((ignores (project--value-in-dir 'project-vc-ignores dir)) + (let ((ignores (project--value-in-dir 'project-vc-ignores dir nil)) (backend (project-vc--backend project dir))) (if backend (vc-call-backend backend 'project-list-files dir ignores) @@ -792,7 +789,8 @@ in the `project-current' call, the timeout is determined by (vc-git-use-literal-pathspecs nil) (include-untracked (project--value-in-dir 'project-vc-include-untracked - dir)) + dir + nil)) (submodules (project--git-submodules)) (gitver (vc-git--program-version)) (dedup (and (version<= "2.31" gitver) '("--deduplicate"))) @@ -844,7 +842,7 @@ in the `project-current' call, the timeout is determined by (with-output-to-string (apply #'vc-git-command standard-output 0 nil "ls-files" args)) "\0" t)))) - (when (project--vc-merge-submodules-p default-directory) + (when (project--vc-merge-submodules-p default-directory nil) ;; Unfortunately, 'ls-files --recurse-submodules' conflicts with '-o'. (let ((sub-files (mapcar @@ -869,7 +867,8 @@ in the `project-current' call, the timeout is determined by (let* ((default-directory (expand-file-name (file-name-as-directory dir))) (include-untracked (project--value-in-dir 'project-vc-include-untracked - dir)) + dir + nil)) (args (list (concat "-mcard" (and include-untracked "u")) "--no-status" "-0")) @@ -889,10 +888,11 @@ in the `project-current' call, the timeout is determined by files))) files))) -(defun project--vc-merge-submodules-p (dir) +(defun project--vc-merge-submodules-p (dir timeout) (project--value-in-dir 'project-vc-merge-submodules - dir)) + dir + timeout)) (defun project--git-submodules () ;; 'git submodule foreach' is much slower. @@ -909,7 +909,7 @@ in the `project-current' call, the timeout is determined by (cl-defmethod project-ignores ((project (head vc)) dir) (project--vc-ignores dir (project-vc--backend project dir) - (project--value-in-dir 'project-vc-ignores dir))) + (project--value-in-dir 'project-vc-ignores dir nil))) (defun project--vc-ignores (dir backend extra-ignores) (require 'vc) ; Can be removed when we require Emacs 31.1. @@ -966,12 +966,14 @@ DIRS must contain directory names." ;; Sidestep the issue of expanded/abbreviated file names here. (cl-set-difference files dirs :test #'file-in-directory-p)) -(defun project--value-in-dir (var dir) +(defun project--value-in-dir (var dir timeout) + "Look up variable VAR's value in DIR, with cache duration TIMEOUT. +If TIMEOUT is nil, the cache is not invalidated." (alist-get var (and enable-dir-local-variables - (let ((cached (project--get-cached dir 'project-vc-dir-locals))) + (let ((cached (project--get-cached dir 'project-vc-dir-locals timeout))) (if (eq cached 'none) nil (or cached @@ -990,7 +992,7 @@ DIRS must contain directory names." (cl-defmethod project-buffers ((project (head vc))) (let* ((root (expand-file-name (file-name-as-directory (project-root project)))) - (modules (unless (or (project--vc-merge-submodules-p root) + (modules (unless (or (project--vc-merge-submodules-p root nil) (condition-case nil (project--submodule-p root) (file-missing nil))) @@ -1008,12 +1010,8 @@ DIRS must contain directory names." (nreverse bufs))) (cl-defmethod project-name ((project (head vc))) - "Returns the name of this VC-aware type PROJECT. - -The value is cached, and depending on whether `non-essential' is nil, -the timeout is determined by `project-vc-cache-timeout' or -`project-vc-non-essential-cache-timeout'." - (or (project--value-in-dir 'project-vc-name (project-root project)) + "Returns the name of this VC-aware type PROJECT." + (or (project--value-in-dir 'project-vc-name (project-root project) nil) (cl-call-next-method))) @@ -2735,8 +2733,7 @@ slash-separated components from `project-name' will be appended to the buffer's directory name when buffers from two different projects would otherwise have the same name." (if-let* ((proj (project-current nil dirname))) - (let ((root (project-root proj)) - (non-essential t)) + (let ((root (project-root proj))) (expand-file-name (file-name-concat (file-name-directory root) @@ -2782,7 +2779,6 @@ value is `non-remote', show the project name only for local files." ;; 'last-coding-system-used' when reading the project name ;; from .dir-locals.el also enables flyspell-mode (bug#66825). (when-let* ((last-coding-system-used last-coding-system-used) - (non-essential t) (project (project-current)) (project-name (project-name project))) (concat diff --git a/test/lisp/progmodes/project-tests.el b/test/lisp/progmodes/project-tests.el index 29aaaa1e502..f17ea46b411 100644 --- a/test/lisp/progmodes/project-tests.el +++ b/test/lisp/progmodes/project-tests.el @@ -150,7 +150,7 @@ When `project-ignores' includes a name matching project dir." "Check that it picks up dir-locals settings from somewhere else." (skip-unless (eq (vc-responsible-backend default-directory) 'Git)) (let* ((dir (ert-resource-directory)) - (_ (vc-file-clearprops dir)) + (_ (project--clear-cache)) (project-vc-extra-root-markers '(".dir-locals.el")) (project (project-current nil dir))) (should-not (null project)) @@ -181,7 +181,7 @@ When `project-ignores' includes a name matching project dir." "Check that it applies project-vc-ignores when DIR is external to root." (skip-unless (eq (vc-responsible-backend default-directory) 'Git)) (let* ((dir (ert-resource-directory)) - (_ (vc-file-clearprops dir)) + (_ (project--clear-cache)) ;; Do not detect VC backend. (project-vc-backend-markers-alist nil) (project-vc-extra-root-markers '("configure.ac")) @@ -259,4 +259,80 @@ When `project-ignores' includes a name matching project dir." (should (equal (sort (mapcar #'xref-item-summary matches) #'string<) '("((nil . ((project-vc-ignores . (\"etc\")))))" "etc")))))) +(ert-deftest project-try-vc-uses-cache () + "Check that it reuses the value that's already cached." + (skip-unless (eq (vc-responsible-backend default-directory) 'Git)) + ;; Prepare + (let* ((dir (file-name-directory project-tests--this-file)) + (_ (project--clear-cache)) + (project-vc-extra-root-markers '("files-x-tests.*")) + (project (project-current nil dir))) + (should (nth 1 project)) + (should (string-match-p "/test/lisp/\\'" (project-root project))) + (let* ((project-vc-extra-root-markers nil) + (project-vc-non-essential-cache-timeout 0.1) + (project-cached (project-current nil dir))) + (should (equal project project-cached))))) + +(ert-deftest project-try-vc-invalidates-cache () + "Check that it invalidates the cached value that's too old." + "Check that one can add wildcard entries." + (skip-unless (eq (vc-responsible-backend default-directory) 'Git)) + ;; Prepare + (let* ((dir (file-name-directory project-tests--this-file)) + (_ (project--clear-cache)) + (project-vc-extra-root-markers '("files-x-tests.*")) + (project (project-current nil dir))) + (should (nth 1 project)) + (should (string-match-p "/test/lisp/\\'" (project-root project))) + (let* ((project-vc-extra-root-markers nil) + (project-vc-non-essential-cache-timeout 0.0) + (project-fresh (project-current nil dir))) + (should (file-equal-p + (project-root project-fresh) + (expand-file-name "../../../" dir)))))) + +(ert-deftest project-name--reuses-cache () + "Check that it reuses the cached value." + (skip-unless (eq (vc-responsible-backend default-directory) 'Git)) + (project--clear-cache) + (ert-with-temp-directory dir + (write-region "((nil . ((project-vc-name . \"barbaz\"))))" + nil + (expand-file-name ".dir-locals.el" dir)) + (write-region "" nil (expand-file-name "project-marker" dir)) + (let* ((project-vc-extra-root-markers '("project-marker")) + (project (project-current nil dir))) + (should (equal (project-name project) + "barbaz")) + (let* ((project-vc-extra-root-markers nil) + (project-vc-non-essential-cache-timeout 0)) + ;; No change, even if the corresponding cache expired. + (should (equal (project-name project) + "barbaz")))))) + +(ert-deftest project-name--obeys-cache-invalidation () + "Check that project-name cache obeys invalidation in project-try-vc." + (skip-unless (eq (vc-responsible-backend default-directory) 'Git)) + (project--clear-cache) + (ert-with-temp-directory dir + (write-region "((nil . ((project-vc-name . \"barbaz\"))))" + nil + (expand-file-name ".dir-locals.el" dir)) + (write-region "" nil (expand-file-name "project-marker" dir)) + (let* ((project-vc-extra-root-markers '("project-marker")) + (project (project-current nil dir))) + (should (equal (project-name project) + "barbaz")) + (delete-file (expand-file-name ".dir-locals.el" dir)) + (let* ((project-vc-non-essential-cache-timeout 0) + (project-fresh (project-current nil dir))) + ;; Same project root. + (should (equal project project-fresh)) + ;; But the name is refreshed. + (should (not (equal (project-name project) "barbaz"))) + (should (equal (project-name project) + (file-name-nondirectory + (directory-file-name dir)))))))) + ;;; project-tests.el ends here From d1c3ba95cb1ee1059edd76956bf5ce1a08850315 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Thu, 2 Jul 2026 08:44:33 +0300 Subject: [PATCH 05/13] * lisp/progmodes/project.el: Update Commentary. --- lisp/progmodes/project.el | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 9ecc1f910d2..616962e3e2b 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -157,11 +157,9 @@ ;; force every project backend to be aware of the build tool(s) the ;; project is using. ;; -;; * Command to (re)build the tag files in all project roots. To that -;; end, we might need to add a way to provide file whitelist -;; wildcards for each root to limit etags to certain files (in -;; addition to the blacklist provided by ignores), and/or allow -;; specifying additional tag regexps. +;; * Minor mode to (re)build the tags across the current project: +;; `etags-regen-mode'. It would be straightforward to add support for +;; multiple roots, if someone works with a project organized this way. ;; ;; * UI for the user to be able to pick the current project for the ;; whole Emacs session, independent of the current directory. Or, From 727a57d9712c5cfb3a2afb11dab437332b3912f4 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 2 Jul 2026 11:37:06 +0300 Subject: [PATCH 06/13] ; Don't autoload 'define-multisession-variable' * lisp/emacs-lisp/multisession.el (define-multisession-variable): Don't autoload, since it calls a function that isn't autoloaded. (Bug#81299) --- lisp/emacs-lisp/multisession.el | 1 - 1 file changed, 1 deletion(-) diff --git a/lisp/emacs-lisp/multisession.el b/lisp/emacs-lisp/multisession.el index 8df3d9e4b22..fbd5452a71f 100644 --- a/lisp/emacs-lisp/multisession.el +++ b/lisp/emacs-lisp/multisession.el @@ -54,7 +54,6 @@ Valid methods are `sqlite' and `files'." :version "29.1" :group 'files) -;;;###autoload (defmacro define-multisession-variable (name initial-value &optional doc &rest args) "Make NAME into a multisession variable initialized from INITIAL-VALUE. From 6f9ac7ffdbaaf81152f38bca6194504f10bb88e8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Johan=20Myr=C3=A9en?= Date: Thu, 2 Jul 2026 10:41:31 +0200 Subject: [PATCH 07/13] Fix fullscreen state handling for PGTK (Bug#81165, Bug#81320) * src/pgtkterm.c (set_fullscreen_state): Unfullscreen frame in the FULLSCREEN_HEIGHT/_WIDTH case (Bug#81165, Bug#81320). Copyright-paperwork-exempt: yes --- src/pgtkterm.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/pgtkterm.c b/src/pgtkterm.c index 757ff57a9f2..66a42b9008a 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c @@ -4483,7 +4483,8 @@ set_fullscreen_state (struct frame *f) case FULLSCREEN_WIDTH: case FULLSCREEN_HEIGHT: - /* Not supported by gtk. Ignore them. */ + /* Restoring from fullscreen to tiled (Bug#81165, Bug#81320). */ + gtk_window_unfullscreen (widget); break; } From e560eacf6dc5dfc8be1be24568ad40ecb56a07a1 Mon Sep 17 00:00:00 2001 From: haiyang miao Date: Thu, 2 Jul 2026 10:55:24 +0200 Subject: [PATCH 08/13] In pgtk_free_frame_resources transfer keyboard focus to parent (Bug#64625) * src/pgtkterm.c (pgtk_new_focus_frame): Declare static. (pgtk_free_frame_resources): If this frame currently holds keyboard focus, explicitly transfer focus to its parent frame before releasing resources (Bug#64625). Copyright-paperwork-exempt: yes --- src/pgtkterm.c | 58 ++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 56 insertions(+), 2 deletions(-) diff --git a/src/pgtkterm.c b/src/pgtkterm.c index 66a42b9008a..733c7d27c4e 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c @@ -109,6 +109,7 @@ static bool current_drop_context_drop; static guint32 current_drop_time; static void pgtk_delete_display (struct pgtk_display_info *); +static void pgtk_new_focus_frame (struct pgtk_display_info *, struct frame *); static void pgtk_clear_frame_area (struct frame *, int, int, int, int); static void pgtk_fill_rectangle (struct frame *, unsigned long, int, int, int, int, bool); @@ -467,9 +468,62 @@ pgtk_free_frame_resources (struct frame *f) #define CLEAR_IF_EQ(FIELD) \ do { if (f == dpyinfo->FIELD) dpyinfo->FIELD = 0; } while (false) - CLEAR_IF_EQ (x_focus_frame); + /* If this frame currently holds keyboard focus, explicitly transfer + focus to its parent frame before releasing resources. + + On X11 the X server delivers a FocusIn event to the parent when a + child window is destroyed, so focus was restored automatically. + On Wayland there is no such mechanism: the compositor does nothing, + leaving Emacs with x_focus_frame == NULL permanently and ignoring + all keyboard input (bug#64625). + + IMPORTANT: we must clear highlight_frame from f BEFORE calling + pgtk_new_focus_frame. pgtk_new_focus_frame calls + pgtk_frame_rehighlight, which calls frame_unhighlight(old_highlight) + where old_highlight = dpyinfo->highlight_frame. If that is still f, + frame_unhighlight -> gui_update_cursor(f) would try to use f's face + cache, which was already freed by free_frame_faces(f) above -> + segfault. By clearing highlight_frame first, pgtk_frame_rehighlight + sees old_highlight == NULL and skips frame_unhighlight entirely. */ + if (f == dpyinfo->x_focus_frame) + { + struct frame *new_focus = FRAME_PARENT_FRAME (f); + + /* Clear highlight_frame from f so pgtk_frame_rehighlight will not + call frame_unhighlight on the dying frame whose faces are freed. */ + if (dpyinfo->highlight_frame == f) + dpyinfo->highlight_frame = NULL; + + if (new_focus != NULL + && FRAME_LIVE_P (new_focus) + && FRAME_GTK_WIDGET (new_focus) != NULL + && gtk_widget_get_realized (FRAME_GTK_WIDGET (new_focus))) + { + /* Transfer Emacs's internal focus/highlight to the parent. */ + pgtk_new_focus_frame (dpyinfo, new_focus); + /* Physically move the GTK/Wayland keyboard focus to the parent + widget. The Wayland compositor will not do this automatically + when the child widget is destroyed. */ + gtk_widget_grab_focus (FRAME_GTK_WIDGET (new_focus)); + } + else + { + /* Parent is gone or unrealized; just clear focus state. */ + dpyinfo->x_focus_frame = NULL; + pgtk_frame_rehighlight (dpyinfo); + } + } + + /* CLEAR_IF_EQ is now a no-op for highlight_frame if we already cleared + it above, which is correct. */ CLEAR_IF_EQ (highlight_frame); - CLEAR_IF_EQ (x_focus_event_frame); + + /* Clear x_focus_event_frame directly so that any focus-out event + emitted by gtk_widget_destroy below is a no-op in + pgtk_focus_changed, preventing a spurious + pgtk_new_focus_frame(dpyinfo, NULL) that would undo the transfer. */ + if (f == dpyinfo->x_focus_event_frame) + dpyinfo->x_focus_event_frame = NULL; CLEAR_IF_EQ (last_mouse_frame); CLEAR_IF_EQ (last_mouse_motion_frame); CLEAR_IF_EQ (last_mouse_glyph_frame); From 6b31360a3195ba9786df9767097961fcfa49b909 Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Mon, 29 Jun 2026 17:30:01 -0400 Subject: [PATCH 09/13] Fix c-pcm-try-completion with boundaries completion PCM try-completion could behavior incorrectly with completion tables using boundaries, such as file name completion. It would "grow" earlier path components as if point was at the end of each path component (rather than at its true location), which meant all path components would "grow" not only from the left \(which is correct) but also from the right (which can only work when point is there). * lisp/minibuffer.el (completion-pcm--find-all-completions): Drop the sub-pattern's trailing `point' (bug#80914). * test/lisp/minibuffer-tests.el (completion-pcm-test-9): New test. --- lisp/minibuffer.el | 5 +++++ test/lisp/minibuffer-resources/pcm/sources/clang | 0 test/lisp/minibuffer-resources/pcm/sys/class | 0 test/lisp/minibuffer-tests.el | 15 +++++++++++++++ 4 files changed, 20 insertions(+) create mode 100644 test/lisp/minibuffer-resources/pcm/sources/clang create mode 100644 test/lisp/minibuffer-resources/pcm/sys/class diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index a24b92cdae8..4db3d0d0bea 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -4608,6 +4608,11 @@ filter out additional entries (because TABLE might not obey PRED)." ;; Text that goes between the new submatches and the ;; completion substring. (between nil)) + ;; SUBPAT was computed with point=(length substring); remove + ;; the trailing `point' since that's not the real location of + ;; point (bug#80914). + (cl-assert (eq (car (last subpat)) 'point)) + (setq subpat (butlast subpat)) ;; Eliminate submatches that don't end with the separator. (dolist (submatch (prog1 suball (setq suball ()))) (when (eq sep (aref submatch (1- (length submatch)))) diff --git a/test/lisp/minibuffer-resources/pcm/sources/clang b/test/lisp/minibuffer-resources/pcm/sources/clang new file mode 100644 index 00000000000..e69de29bb2d diff --git a/test/lisp/minibuffer-resources/pcm/sys/class b/test/lisp/minibuffer-resources/pcm/sys/class new file mode 100644 index 00000000000..e69de29bb2d diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el index 16ee1753645..1db0c07f510 100644 --- a/test/lisp/minibuffer-tests.el +++ b/test/lisp/minibuffer-tests.el @@ -340,6 +340,21 @@ "" '("fooxbar" "fooybar") nil 0) '("foobar" . 3)))) +(ert-deftest completion-pcm-bug80914 () + ;; Completing a partial match in an earlier component (here "s" + ;; matches both "sys" and "sources", which contain "class" and + ;; "clang") should not leave a stray `point' in the middle of the + ;; merged pattern (bug#80914). + (let ((default-directory (ert-resource-directory)) + (input "pcm/s/cl")) + ;; The pattern has a single `point' at the end rather than an extra + ;; `point' after the "s". + (should (equal (completion-pcm--find-all-completions + input #'completion--file-name-table nil (length input)) + '(("s" any "/" "cl" point) + ("sources/clang" "sys/class") + "pcm/" ""))))) + (ert-deftest completion-pcm-test-anydelim () ;; After each delimiter is a special wildcard which matches any ;; sequence of delimiters. From 82009df4de536366097db9c28a139469b3e81ff0 Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Wed, 1 Jul 2026 15:39:31 -0400 Subject: [PATCH 10/13] Fix initials completion style after // in file name * lisp/minibuffer.el (completion-initials-expand): Change the heuristic to check for an empty previous field, not total string length (bug#81241). * test/lisp/minibuffer-tests.el (completion-initials): New test. --- lisp/minibuffer.el | 8 +++++--- test/lisp/minibuffer-tests.el | 12 ++++++++++++ 2 files changed, 17 insertions(+), 3 deletions(-) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 4db3d0d0bea..5b1486d2af4 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -5070,12 +5070,14 @@ usual. Returns (ALL PAT PREFIX SUFFIX)." ;; to /usr/share/a/e just because we mistyped "ae" for "ar", ;; so we probably don't want initials to touch anything that ;; looks like /usr/share/foo. As a heuristic, we just check that - ;; the text before the boundary char is at most 1 char. - ;; This allows both ~/eee and /eee and not much more. + ;; the previous completion field is empty. + ;; This allows ~/eee and /eee and /usr//eee and not much more. ;; FIXME: It sadly also disallows the use of ~/eee when that's ;; embedded within something else (e.g. "(~/eee" in Info node ;; completion or "ancestor:/eee" in bzr-revision completion). - (when (< (car bounds) 3) + (when (let ((str-without-last-field (substring str 0 (1- (car bounds))))) + (= (car (completion-boundaries str-without-last-field table pred "")) + (length str-without-last-field))) (let ((sep (substring str (1- (car bounds)) (car bounds)))) ;; FIXME: the above string-match checks the whole string, whereas ;; we end up only caring about the after-boundary part. diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el index 1db0c07f510..59ae6ae3758 100644 --- a/test/lisp/minibuffer-tests.el +++ b/test/lisp/minibuffer-tests.el @@ -355,6 +355,18 @@ ("sources/clang" "sys/class") "pcm/" ""))))) +(ert-deftest completion-initials () + ;; Should expand initials: + (should (equal (completion-initials-expand "/ttab" #'read-file-name-internal nil) + "/t/t/a/b")) + (should (equal (completion-initials-expand "~/ttab" #'read-file-name-internal nil) + "~/t/t/a/b")) + (should (equal (completion-initials-expand "/home//ttab" #'read-file-name-internal nil) + "/home//t/t/a/b")) ; bug#81241 + ;; Should not expand initials: + (should-not (completion-initials-expand "/x/ttab" #'read-file-name-internal nil)) + (should-not (completion-initials-expand "/usr/share/ttab" #'read-file-name-internal nil))) + (ert-deftest completion-pcm-test-anydelim () ;; After each delimiter is a special wildcard which matches any ;; sequence of delimiters. From ba7c04d26c7a61ef4c4ccc08b817534a8a071095 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Thu, 2 Jul 2026 19:27:26 +0300 Subject: [PATCH 11/13] ; Fix double docstring in a test --- test/lisp/progmodes/project-tests.el | 1 - 1 file changed, 1 deletion(-) diff --git a/test/lisp/progmodes/project-tests.el b/test/lisp/progmodes/project-tests.el index f17ea46b411..9516c2ad119 100644 --- a/test/lisp/progmodes/project-tests.el +++ b/test/lisp/progmodes/project-tests.el @@ -276,7 +276,6 @@ When `project-ignores' includes a name matching project dir." (ert-deftest project-try-vc-invalidates-cache () "Check that it invalidates the cached value that's too old." - "Check that one can add wildcard entries." (skip-unless (eq (vc-responsible-backend default-directory) 'Git)) ;; Prepare (let* ((dir (file-name-directory project-tests--this-file)) From 7746db313a61ed8809cf2be748da40c4ca6ca103 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Thu, 2 Jul 2026 10:26:39 +0000 Subject: [PATCH 12/13] CC Mode: Fix erroneous type: arguments to two defcustoms. This allows customize to set the variables directly to regular expressions as an alternative to a list of identifiers. It fixes bug#81339. * lisp/progmodes/cc-vars.el (c-noise-macro-with-parens-names) (c-noise-macro-names): Correct the type: arguments to defcustom to two `choice' constructs. --- lisp/progmodes/cc-vars.el | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index 4ac18869400..cfdbd73f20a 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -1737,7 +1737,9 @@ If you change this variable's value, call the function `c-make-noise-macro-regexps' to set the necessary internal variables (or do this implicitly by reinitializing C/C++/Objc Mode on any buffer)." :version "26.1" - :type '(repeat :tag "List of names" string) + :type '(choice + (repeat :tag "List of names (possibly empty)" string) + (regexp :tag "Names regexp")) :group 'c) (put 'c-noise-macro-names 'safe-local-variable #'c-string-list-p) (make-variable-buffer-local 'c-noise-macro-names) @@ -1754,7 +1756,9 @@ If you change this variable's value, call the function `c-make-noise-macro-regexps' to set the necessary internal variables (or do this implicitly by reinitializing C/C++/Objc Mode on any buffer)." :version "26.1" - :type '(repeat :tag "List of names (possibly empty)" string) + :type '(choice + (repeat :tag "List of names (possibly empty)" string) + (regexp :tag "Names regexp")) :group 'c) (put 'c-noise-macro-with-parens-names 'safe-local-variable #'c-string-list-p) (make-variable-buffer-local 'c-noise-macro-with-parens-names) From 388adcc570be1b6bef87f5da449b6bbef8854222 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Fri, 3 Jul 2026 10:42:22 +0100 Subject: [PATCH 13/13] Finish reverting experiment with proportional font on mode line This change Author: Lars Ingebrigtsen AuthorDate: Thu Dec 23 11:43:47 2021 +0100 Revert back to using monospaced fonts in the mode line * lisp/faces.el (mode-line-active, mode-line-inactive): Revert back to using monospaced fonts on the mode line (for now). The main remaining usability problem is clicking on the very small "-" characters in "U:--". didn't also undo these changes to bindings.el that were introduced along with the proportional font experiment, leading to bug#81336. * lisp/bindings.el (mode-line-position) (standard-mode-line-format): Don't set display minimum widths (bug#81336). --- lisp/bindings.el | 20 +++++--------------- 1 file changed, 5 insertions(+), 15 deletions(-) diff --git a/lisp/bindings.el b/lisp/bindings.el index b13dc0a705c..1dcf824f12e 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -726,7 +726,6 @@ mouse-1: Display Line and Column Mode Menu")) `((:propertize ("" mode-line-percent-position) local-map ,mode-line-column-line-number-mode-map - display (min-width (5.0)) mouse-face mode-line-highlight ;; XXX needs better description help-echo "Window Scroll Percentage @@ -745,31 +744,26 @@ mouse-1: Display Line and Column Mode Menu"))) (10 (:propertize mode-line-position-column-line-format - display (min-width (10.0)) ,@mode-line-position--column-line-properties)) (10 (:propertize (:eval (string-replace "%c" "%C" (car mode-line-position-column-line-format))) - display (min-width (10.0)) ,@mode-line-position--column-line-properties))) (6 (:propertize mode-line-position-line-format - display (min-width (6.0)) ,@mode-line-position--column-line-properties))) (column-number-mode (column-number-indicator-zero-based (6 (:propertize mode-line-position-column-format - display (min-width (6.0)) ,@mode-line-position--column-line-properties)) (6 (:propertize (:eval (string-replace "%c" "%C" (car mode-line-position-column-format))) - display (min-width (6.0)) ,@mode-line-position--column-line-properties)))))) "Mode line construct for displaying the position in the buffer. Normally displays the buffer percentage and, optionally, the @@ -824,15 +818,11 @@ By default, this shows the information specified by `global-mode-string'.") (let ((standard-mode-line-format (list "%e" 'mode-line-front-space - (list - :propertize - (list "" - 'mode-line-mule-info - 'mode-line-client - 'mode-line-modified - 'mode-line-remote - 'mode-line-window-dedicated) - 'display '(min-width (6.0))) + 'mode-line-mule-info + 'mode-line-client + 'mode-line-modified + 'mode-line-remote + 'mode-line-window-dedicated 'mode-line-frame-identification 'mode-line-buffer-identification " "