emacs/gnu.emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2026-09-10 07:46:51 -04:00
Code Issues Actions Packages Projects Releases Wiki Activity

Merge from origin/emacs-31

Browse source 
388adcc570 Finish reverting experiment with proportional font on mod...
7746db313a CC Mode: Fix erroneous type: arguments to two defcustoms.
ba7c04d26c ; Fix double docstring in a test
82009df4de Fix initials completion style after // in file name
6b31360a31 Fix c-pcm-try-completion with boundaries completion
e560eacf6d In pgtk_free_frame_resources transfer keyboard focus to p...
6f9ac7ffdb Fix fullscreen state handling for PGTK (Bug#81165, Bug#81...
727a57d971 ; Don't autoload 'define-multisession-variable'
d1c3ba95cb * lisp/progmodes/project.el: Update Commentary.
5fde9732b4 Localize cache invalidation to project-try-vc
707b0ba0f4 Fix project--clear-cache and project--value-in-dir in spe...
ba7d2b8232 * admin/notes/jargon: Add TTTT.
bcb83d7d2a Fix error handling in Tramp delete-{file,directory}
This commit is contained in:
Eli Zaretskii 2026-07-04 04:28:26 -04:00
parent b1d827a428 388adcc570
commit 6b006c92f4
14 changed files with 285 additions and 118 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
admin/notes/jargon
View file

@ -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

20
lisp/bindings.el
View file

@ -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
" "

1
lisp/emacs-lisp/multisession.el
View file

@ -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.

13
lisp/minibuffer.el
View file

@ -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.

55
lisp/net/tramp-smb.el
View file

@ -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."

24
lisp/net/tramp.el
View file

@ -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

8
lisp/progmodes/cc-vars.el
View file

@ -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)

104
lisp/progmodes/project.el
View file

@ -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

61
src/pgtkterm.c
View file

@ -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;
}

0
test/lisp/minibuffer-resources/pcm/sources/clang Normal file
View file

0
test/lisp/minibuffer-resources/pcm/sys/class Normal file
View file

27
test/lisp/minibuffer-tests.el
View file

@ -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.

10
test/lisp/net/tramp-tests.el
View file

@ -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))

79
test/lisp/progmodes/project-tests.el
View file

@ -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