master 6b006c92f4d 5/7: Merge from origin/emacs-31
Eli Zaretskii <[email protected]> Sat, 4 Jul 2026 04:30:55 -0400 (EDT)
| Newsgroups | gmane.emacs.diffs |
|---|---|
| Message-ID | <[email protected]> |
branch: master commit 6b006c92f4d2dc48bd0235c763ab5daf7c41f31d Merge: b1d827a428d 388adcc570b Author: Eli Zaretskii <[email protected]> Commit: Eli Zaretskii <[email protected]> Merge from origin/emacs-31 388adcc570b Finish reverting experiment with proportional font on mod... 7746db313a6 CC Mode: Fix erroneous type: arguments to two defcustoms. ba7c04d26c7 ; Fix double docstring in a test 82009df4de5 Fix initials completion style after // in file name 6b31360a319 Fix c-pcm-try-completion with boundaries completion e560eacf6dc In pgtk_free_frame_resources transfer keyboard focus to p... 6f9ac7ffdba Fix fullscreen state handling for PGTK (Bug#81165, Bug#81... 727a57d9712 ; Don't autoload 'define-multisession-variable' d1c3ba95cb1 * lisp/progmodes/project.el: Update Commentary. 5fde9732b4b Localize cache invalidation to project-try-vc 707b0ba0f4c Fix project--clear-cache and project--value-in-dir in spe... ba7d2b82325 * admin/notes/jargon: Add TTTT. bcb83d7d2ad Fix error handling in Tramp delete-{file,directory} --- admin/notes/jargon | 1 + lisp/bindings.el | 20 ++--- lisp/emacs-lisp/multisession.el | 1 - lisp/minibuffer.el | 13 ++- lisp/net/tramp-smb.el | 57 ++++++------- lisp/net/tramp.el | 24 +++--- lisp/progmodes/cc-vars.el | 8 +- lisp/progmodes/project.el | 104 +++++++++++------------ src/pgtkterm.c | 61 ++++++++++++- test/lisp/minibuffer-resources/pcm/sources/clang | 0 test/lisp/minibuffer-resources/pcm/sys/class | 0 test/lisp/minibuffer-tests.el | 27 ++++++ test/lisp/net/tramp-tests.el | 10 +++ test/lisp/progmodes/project-tests.el | 79 ++++++++++++++++- 14 files changed, 286 insertions(+), 119 deletions(-) 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 diff --git a/lisp/bindings.el b/lisp/bindings.el index 198ad12c5c6..123f6615e65 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 " " 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. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 00ce306ba67..0ef28bd2558 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -4631,6 +4631,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)))) @@ -5088,12 +5093,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/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/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) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 4dbcc2607a4..6ccb0ce0558 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: ;; @@ -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, @@ -613,27 +611,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)))) @@ -647,7 +639,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) @@ -656,15 +650,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 @@ -677,7 +674,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 @@ -702,7 +699,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)))) @@ -713,7 +710,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))) @@ -762,7 +759,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) @@ -790,7 +787,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"))) @@ -842,7 +840,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 @@ -867,7 +865,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")) @@ -887,10 +886,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. @@ -907,7 +907,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. @@ -964,16 +964,20 @@ 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 - (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 timeout))) + (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) @@ -986,7 +990,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))) @@ -1004,12 +1008,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 +2735,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 +2781,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/src/pgtkterm.c b/src/pgtkterm.c index 6362f795eff..9a9ebef418c 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); @@ -4483,7 +4537,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; } 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..59ae6ae3758 100644 --- a/test/lisp/minibuffer-tests.el +++ b/test/lisp/minibuffer-tests.el @@ -340,6 +340,33 @@ "" '("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-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. 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)) diff --git a/test/lisp/progmodes/project-tests.el b/test/lisp/progmodes/project-tests.el index 29aaaa1e502..9516c2ad119 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,79 @@ 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." + (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-<vc>-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-<vc>-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