Merge from origin/emacs-31

eb814fbb5c vc-hg-state-slow: Run from the repository root
3660bd3eb4 vc-dir-delete-file: Call vc-delete-file on FILESET-ONLY-F...
a3a72ae355 Fix 'truncate-string-pixelwise' to restore the window buffer
b684922900 Restore progress-reporter suffix as update-text (bug#81134)
e182c704c7 Rename recently added after-delete-frame-select-mru-frame
e47bd3070a Eglot: decode unhexed file URI paths as UTF-8 (bug#79897)
e940326250 ; * etc/NEWS: Mention limitation of diff-apply-buffer.
25084664ba Sync with Tramp 2.8.2
7be92efa5e Rename variable to macroexp-enable-preserve-posification
2066a0c9e8 New variable 'macroexp-enable-pos-preservation' (bug#79599)
00c290be85 Avoid infinite loop in some Dired marking commands

# Conflicts:
#	etc/NEWS
This commit is contained in:
Sean Whitton 2026-06-23 11:54:46 +01:00
commit 3ca168b80a
22 changed files with 214 additions and 129 deletions

View file

@ -531,7 +531,7 @@ This function calls @code{progress-reporter-update}, so the first
message is printed immediately.
@end defun
@defun progress-reporter-update reporter &optional value suffix
@defun progress-reporter-update reporter &optional value update-text
This function does the main work of reporting progress of your
operation. It displays the message of @var{reporter}, followed by
progress percentage determined by @var{value}. If percentage is zero,
@ -545,10 +545,11 @@ state of your operation and must be between @var{min-value} and
@code{make-progress-reporter}. For instance, if you scan a buffer,
then @var{value} should be the result of a call to @code{point}.
Optional argument @var{suffix} is a string to be displayed after
@var{reporter}'s main message and progress text. If @var{reporter} is
a non-numerical reporter, then @var{value} should be @code{nil}, or a
string to use instead of @var{suffix}.
Optional argument @var{update-text} is a string to be displayed after
@var{reporter}'s main message and progress text. One typical use is as
the ``step'' of a long-running process so the user knows where it is.
If @var{reporter} is a non-numerical reporter, then @var{value} should
be @code{nil}, or a string to use instead of @var{update-text}.
This function respects @var{min-change} and @var{min-time} as passed
to @code{make-progress-reporter} and so does not output new messages
@ -557,11 +558,11 @@ try to reduce the number of calls to it: resulting overhead will most
likely negate your effort.
@end defun
@defun progress-reporter-force-update reporter &optional value new-message suffix
@defun progress-reporter-force-update reporter &optional value new-message update-text
This function is similar to @code{progress-reporter-update} except
that it prints a message in the echo area unconditionally.
@var{reporter}, @var{value}, and @var{suffix} have the same meaning as for
@var{reporter}, @var{value}, and @var{update-text} have the same meaning as for
@code{progress-reporter-update}. Optional @var{new-message} allows
you to change the message of the @var{reporter}. Since this function
always updates the echo area, such a change will be immediately

View file

@ -523,7 +523,7 @@ single frame can be excluded, for example, the selected frame.
*** After deleting, 'delete-frame' now selects the most recently used frame.
Previously, after deleting a specified frame, 'delete-frame' would
select the oldest visible frame on the same terminal. To revert to the
old behavior, set the new user option 'after-delete-frame-select-mru-frame'
old behavior, set the new user option 'delete-frame-choose-selected'
to nil.
+++
@ -2587,6 +2587,7 @@ one as before. This makes them different from 'vc-diff' and
'vc-root-diff' when those are called without a prefix argument.
*** 'diff-apply-hunk' now supports creating and deleting files.
diff-apply-buffer supports creating files but not deleting them, yet.
+++
*** Diff mode's application and killing commands now consider the region.

View file

@ -378,7 +378,11 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
"26.1")
(tooltip-reuse-hidden-frame tooltip boolean "26.1")
(use-system-tooltips tooltip boolean "29.1")
(after-delete-frame-select-mru-frame frames boolean "31.1")
(delete-frame-choose-selected
frames
(choice (const :tag "Most recently used" mru)
(const :tag "Oldest visible " nil))
"31.1")
;; fringe.c
(overflow-newline-into-fringe fringe boolean)
;; image.c

View file

@ -361,12 +361,16 @@ only in the active region if `dired-mark-region' is non-nil."
dir1 nil
(lambda ()
(dired-mark-if
(member (dired-get-filename nil t) file-list1) nil)))
(and (not (dired--hidden-p))
(member (dired-get-filename nil t) file-list1))
nil)))
(dired-fun-in-all-buffers
dir2 nil
(lambda ()
(dired-mark-if
(member (dired-get-filename nil t) file-list2) nil)))
(and (not (dired--hidden-p))
(member (dired-get-filename nil t) file-list2))
nil)))
(message "Marked in dir1: %s, in dir2: %s"
(format-message (ngettext "%d file" "%d files" (length file-list1))
(length file-list1))

View file

@ -552,6 +552,7 @@ files in the active region if `dired-mark-region' is non-nil."
(let ((dired-marker-char (if unflag-p ?\s dired-marker-char)))
(dired-mark-if
(and
(not (dired--hidden-p))
(if unflag-p
;; Already marked.
(not (= (following-char) ?\s))

View file

@ -4766,6 +4766,7 @@ object files--just `.o' will mark more than you might think."
(dired-mark-if
(and (not (looking-at-p dired-re-dot))
(not (eolp)) ; empty line
(not (dired--hidden-p))
(let ((fn (dired-get-filename t t)))
(and fn (string-match-p regexp fn))))
"matching file")))
@ -4817,6 +4818,7 @@ since it was last visited."
(dired-mark-if
(and (not (looking-at-p dired-re-dot))
(not (eolp)) ; empty line
(not (dired--hidden-p))
(let ((fn (dired-get-filename nil t)))
(when (and fn (file-readable-p fn)
(not (file-directory-p fn)))

View file

@ -2794,6 +2794,7 @@ are analyzed."
(symbols-with-pos-enabled t)
(message-log-max nil)
(inhibit-message t)
(macroexp-enable-preserve-posification nil)
(macroexpand-all-environment
(append (mapcar #'list elisp-scope-unsafe-macros) macroexpand-all-environment)))
(ignore-errors (macroexpand-1 form macroexpand-all-environment)))

View file

@ -304,6 +304,9 @@ modified FORM."
(let ((new-form (macroexp--posify-form-1 form call-pos 10)))
(or new-form form)))
(defvar macroexp-enable-preserve-posification t
"Whether to attach position of a macro call to the expanded form.")
(defmacro macroexp-preserve-posification (pos-form &rest body)
"Evaluate BODY..., posifying the result with POS-FORM's position, if any.
If the result of body happens to have a position already, we do not
@ -316,7 +319,7 @@ change this."
((symbol-with-pos-p ,pos-form)
(symbol-with-pos-pos ,pos-form))))
(new-value (progn ,@body)))
(if (and call-pos
(if (and macroexp-enable-preserve-posification call-pos
(not (or (and (consp new-value)
(symbol-with-pos-p (car new-value)))
(and (symbol-with-pos-p new-value)))))

View file

@ -426,42 +426,51 @@ this function using the same ELLIPSIS."
string
;; Keeping a work buffer around is more efficient than creating a
;; new temporary buffer.
(let ((original-buffer (or buffer (current-buffer))))
(let* ((window (selected-window))
(original-buffer (window-buffer window))
(window-dedication (window-dedicated-p window))
(buffer-list-update-hook)
(window-scroll-functions)
(window-configuration-change-hook))
(with-work-buffer
(work-buffer--prepare-pixelwise string buffer)
(set-window-buffer nil (current-buffer) 'keep-margins)
;; Use a binary search to prune the number of calls to
;; `window-text-pixel-size'.
;; These are 1-based buffer indexes.
(let* ((low 1)
(high (1+ (length string)))
mid)
(when (> (car (window-text-pixel-size nil 1 high)) max-pixels)
(when (and ellipsis (not (stringp ellipsis)))
(setq ellipsis (truncate-string-ellipsis)))
(setq ellipsis-pixels (if ellipsis
(if ellipsis-pixels
ellipsis-pixels
(string-pixel-width ellipsis buffer))
0))
(let ((adjusted-pixels
(if (> max-pixels ellipsis-pixels)
(- max-pixels ellipsis-pixels)
max-pixels)))
(while (<= low high)
(setq mid (floor (+ low high) 2))
(if (<= (car (window-text-pixel-size nil 1 mid))
adjusted-pixels)
(setq low (1+ mid))
(setq high (1- mid))))))
(set-window-buffer nil original-buffer 'keep-margins)
(if mid
;; Binary search ran.
(if (and ellipsis (> max-pixels ellipsis-pixels))
(concat (substring string 0 (1- high)) ellipsis)
(substring string 0 (1- high)))
;; Fast path.
string))))))
;; Use a binary search to prune the number of calls to
;; `window-text-pixel-size'.
;; These are 1-based buffer indexes.
(unwind-protect
(let* ((low 1)
(high (1+ (length string)))
mid)
(work-buffer--prepare-pixelwise string buffer)
(set-window-dedicated-p window nil)
(set-window-buffer window (current-buffer) 'keep-margins)
(when (> (car (window-text-pixel-size nil 1 high)) max-pixels)
(when (and ellipsis (not (stringp ellipsis)))
(setq ellipsis (truncate-string-ellipsis)))
(setq ellipsis-pixels (if ellipsis
(if ellipsis-pixels
ellipsis-pixels
(string-pixel-width ellipsis buffer))
0))
(let ((adjusted-pixels
(if (> max-pixels ellipsis-pixels)
(- max-pixels ellipsis-pixels)
max-pixels)))
(while (<= low high)
(setq mid (floor (+ low high) 2))
(if (<= (car (window-text-pixel-size nil 1 mid))
adjusted-pixels)
(setq low (1+ mid))
(setq high (1- mid))))))
(if mid
;; Binary search ran.
(if (and ellipsis (> max-pixels ellipsis-pixels))
(concat (substring string 0 (1- high)) ellipsis)
(substring string 0 (1- high)))
;; Fast path.
string))
(set-window-buffer window original-buffer 'keep-margins)
(set-window-dedicated-p window window-dedication)
(unrecord-window-buffer window (current-buffer) t))))))
;;;###autoload
(defun string-glyph-split (string)

View file

@ -794,9 +794,8 @@ This is needed if there are compatibility problems."
(interactive)
;; We expect just one Tramp package is installed.
(when-let*
((dir (tramp-compat-funcall
'package-desc-dir
(car (alist-get 'tramp (bound-and-true-p package-alist))))))
((dir (tramp-compat-funcall 'package-desc-dir
(car (alist-get 'tramp (bound-and-true-p package-alist))))))
(dolist (elc (directory-files dir 'full (rx ".elc" eos)))
(delete-file elc))
(with-current-buffer (get-buffer-create byte-compile-log-buffer)

View file

@ -103,7 +103,7 @@ Add the extension of F, if existing."
dir-flag (file-name-extension f t)))
(defalias 'tramp-compat-error-type-p
(if (fboundp 'error-type-p) ;Emacs-31
(if (fboundp 'error-type-p) ; Emacs-31
#'error-type-p
(lambda (symbol) (get symbol 'error-conditions))))
@ -264,10 +264,20 @@ value is the default binding of the variable."
;; kept, for example when the HANDLER propagates the error with
;; `(signal (car err) (cdr err)'.
;;
;; * Starting with Emacs 31.1, use `(signal err)' instead of `(signal
;; (car err) (cdr err)'.
;;
;; * Starting with Emacs 30.1, use '(_ VALUEFORM)' instead of
;; '(VALUEFORM)' in 'if-let*/when-let*/and-let*'.
;;
;; * Starting with Emacs 30, use `static-if'. Starting with Emacs 31,
;; use `static-when' and `static-unless'.
;;
;; * Starting with Emacs 31.1, use `(signal err)' instead of `(signal
;; (car err) (cdr err)'. Use also the functions `error-type-p', `error-type',
;; `error-has-type-p', and `error-slot-value'.
;;
;; * Starting with Emacs 31.1, use `set-local' and `setopt-local'.
;;
;; * Starting with Emacs 31.1, use `plusp', `minusp', `oddp' and `evenp'.
;;
;; * Starting with Emacs 31.1, use `hash-table-contains-p'.
;;; tramp-compat.el ends here

View file

@ -211,6 +211,13 @@ They are completed by `M-x TAB' only in Tramp debug buffers."
(defvar tramp-trace-functions nil
"A list of non-Tramp functions to be traced with `tramp-verbose' > 10.")
(defun tramp-trace-add-package (package)
"Add all functions of PACKAGE to `tramp-trace-functions'."
(when (and (symbolp package) (require package nil 'noerror))
(dolist (elt (apropos-internal
(rx bos (literal (symbol-name package))) #'functionp))
(add-to-list 'tramp-trace-functions elt))))
(defun tramp-debug-message (vec fmt-string &rest arguments)
"Append message to debug buffer of VEC.
Message is formatted with FMT-STRING as control string and the remaining

View file

@ -2053,11 +2053,6 @@ If ARGUMENT is non-nil, use it as argument for
(let* (coding-system-for-read
(process-connection-type tramp-process-connection-type)
;; There might be some unfortunate values of
;; `tramp-smb-connection-local-default-system-variables'.
;(path-separator (default-value 'path-separator))
;(null-device (default-value 'null-device))
;(exec-suffixes (default-value 'exec-suffixes))
(p (apply #'tramp-start-process vec
(tramp-get-connection-name vec)
(tramp-get-connection-buffer vec)

View file

@ -571,7 +571,9 @@ interpreted as a regular expression which always matches."
;; <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=38079#20>.
(defcustom tramp-restricted-shell-hosts-alist
(when (and (eq system-type 'windows-nt)
(not (string-match-p (rx "sh" eol) tramp-encoding-shell)))
(not (string-match-p
(rx "sh" eol)
(file-name-sans-extension tramp-encoding-shell))))
(list (rx
bos (| (literal (downcase tramp-system-name))
(literal (upcase tramp-system-name)))
@ -2213,12 +2215,12 @@ If VAR is nil, then we bind `v' to the structure and `method', `user',
(ignore ,@(mapcar #'car bindings))
,@body)))
(defun tramp-progress-reporter-update (reporter &optional value suffix)
(defun tramp-progress-reporter-update (reporter &optional value update-text)
"Report progress of an operation for Tramp."
(let* ((parameters (cdr reporter))
(message (aref parameters 3)))
(when (string-search message (or (current-message) ""))
(progress-reporter-update reporter value suffix))))
(progress-reporter-update reporter value update-text))))
;;;###tramp-autoload
(defvar tramp-inhibit-progress-reporter nil
@ -3006,24 +3008,26 @@ not in completion mode."
"Like `expand-file-name' for partial Tramp files."
;; We need special handling only when a method is needed. Then we
;; check, whether DIRECTORY is "/method:" or "/[method/".
(let ((dir (or directory default-directory "/")))
(cond
((file-name-absolute-p filename)
;; FILENAME could be like "~/". We must expand this.
(tramp-run-real-handler #'expand-file-name (list filename directory)))
((and (eq tramp-syntax 'simplified)
(string-match-p (rx (regexp tramp-postfix-host-regexp) eos) dir))
(concat dir filename))
((string-match-p
(rx (regexp tramp-prefix-regexp)
(* (regexp tramp-remote-file-name-spec-regexp)
(regexp tramp-postfix-hop-regexp))
(? (regexp tramp-method-regexp) (regexp tramp-postfix-method-regexp)
(? (regexp tramp-user-regexp) (regexp tramp-postfix-user-regexp)))
eos)
dir)
(concat dir filename))
(t (tramp-run-real-handler #'expand-file-name (list filename directory))))))
(tramp-drop-volume-letter
(let ((dir (or directory default-directory "/")))
(cond
((file-name-absolute-p filename)
;; FILENAME could be like "~/". We must expand this.
(tramp-run-real-handler #'expand-file-name (list filename directory)))
((and (eq tramp-syntax 'simplified)
(string-match-p (rx (regexp tramp-postfix-host-regexp) eos) dir))
(concat dir filename))
((string-match-p
(rx (regexp tramp-prefix-regexp)
(* (regexp tramp-remote-file-name-spec-regexp)
(regexp tramp-postfix-hop-regexp))
(? (regexp tramp-method-regexp) (regexp tramp-postfix-method-regexp)
(? (regexp tramp-user-regexp) (regexp tramp-postfix-user-regexp)))
eos)
dir)
(concat dir filename))
(t (tramp-run-real-handler
#'expand-file-name (list filename directory)))))))
;; This is needed in pcomplete.el.
(defun tramp-completion-handle-file-directory-p (filename)

View file

@ -1264,7 +1264,8 @@ object."
;; `file-name-handler-alist' should know how to handle them
;; (bug#58790).
(if (string= "file" (url-type url))
(let* ((unhexed (url-unhex-string (url-filename url)))
(let* ((unhexed (decode-coding-string
(url-unhex-string (url-filename url)) 'utf-8-unix))
;; Remove the leading "/" for local MS Windows-style paths.
(norm (if (and (not remote-prefix)
(eq system-type 'windows-nt)

View file

@ -7108,7 +7108,8 @@ to deactivate this transient map, regardless of KEEP-PRED."
;; MESSAGE
;; MIN-CHANGE
;; MIN-TIME
;; MESSAGE-SUFFIX])
;; UNUSED (formerly SUFFIX)
;; CONTEXT])
;;
;; This weirdness is for optimization reasons: we want
;; `progress-reporter-update' to be as fast as possible, so
@ -7120,15 +7121,18 @@ to deactivate this transient map, regardless of KEEP-PRED."
(defvar progress-reporter-update-functions (list #'progress-reporter-echo-area)
"Special hook run on progress-reporter updates.
Each function is called with two arguments:
Each function is called with three arguments:
REPORTER is the result of a call to `make-progress-reporter'.
STATE can be one of:
- A float representing the percentage complete in the range 0.0-1.0
for a numeric reporter.
- A monotonically increasing integer for a pulsing reporter.
- The symbol `done' to indicate that the progress reporter is complete.")
- The symbol `done' to indicate that the progress reporter is complete.
UPDATE-TEXT is a string that a progress-reporter back-end might display
as a result of this update. A typical use is as the \"step\" of the
progress reporting process.")
(defsubst progress-reporter-update (reporter &optional value suffix)
(defsubst progress-reporter-update (reporter &optional value update-text)
"Report progress of an operation, by default, in the echo area.
REPORTER should be the result of a call to `make-progress-reporter'.
@ -7137,10 +7141,11 @@ made using non-nil MIN-VALUE and MAX-VALUE arguments to
`make-progress-reporter'---then VALUE should be a number between
MIN-VALUE and MAX-VALUE.
Optional argument SUFFIX is a string to be displayed after REPORTER's
main message and progress text. If REPORTER is a non-numerical
reporter, then VALUE should be nil, or a string to use instead of
SUFFIX.
Optional argument UPDATE-TEXT is a string that a progress-reporter
back-end might display as a result of this update. A typical use is as
the \"step\" of the progress reporting process. If REPORTER is a
non-numerical reporter, then VALUE should be nil, or a string to use
instead of UPDATE-TEXT.
See `progress-reporter-update-functions' for the list of functions
called on each update.
@ -7150,7 +7155,7 @@ last update is too small or insufficient time has passed, it does
nothing."
(when (or (not (numberp value)) ; For pulsing reporter
(>= value (car reporter))) ; For numerical reporter
(progress-reporter-do-update reporter value suffix)))
(progress-reporter-do-update reporter value update-text)))
(defun make-progress-reporter (message &optional min-value max-value
current-value min-change min-time
@ -7200,7 +7205,7 @@ the echo area progress reports may be muted if the echo area is busy."
message
(if min-change (max (min min-change 50) 1) 1)
min-time
;; SUFFIX
;; Unused (formerly SUFFIX).
nil
;;
context))))
@ -7218,24 +7223,26 @@ the echo area progress reports may be muted if the echo area is busy."
"Return REPORTER's context."
(aref (cdr reporter) 7))
(defun progress-reporter-force-update (reporter &optional value new-message suffix)
(defun progress-reporter-force-update (reporter &optional
value new-message update-text)
"Report progress of an operation in the echo area unconditionally.
REPORTER, VALUE, and SUFFIX are the same as in `progress-reporter-update'.
REPORTER, VALUE, and UPDATE-TEXT are the same as in
`progress-reporter-update'.
NEW-MESSAGE, if non-nil, sets a new message for the reporter."
(let ((parameters (cdr reporter)))
(when new-message
(aset parameters 3 new-message))
(when (aref parameters 0)
(aset parameters 0 (float-time)))
(progress-reporter-do-update reporter value suffix)))
(progress-reporter-do-update reporter value update-text)))
(defvar progress-reporter--pulse-characters ["-" "\\" "|" "/"]
"Characters to use for pulsing progress reporters.")
(defun progress-reporter-echo-area (reporter state)
(defun progress-reporter-echo-area (reporter state update-text)
"Progress reporter echo area update function.
REPORTER and STATE are the same as in
REPORTER, STATE, and UPDATE-TEXT are the same as in
`progress-reporter-update-functions'.
Do not emit a message if the reporter context is `async' and the echo
@ -7244,21 +7251,22 @@ area is busy with something else."
(unless (and (eq (progress-reporter-context reporter) 'async)
(current-message)
(not (string-prefix-p text (current-message))))
(setq update-text (concat (if update-text " " "") update-text))
(pcase state
((pred floatp)
(if (plusp state)
(message "%s%d%%" text (* state 100.0))
(message "%s" text)))
(message "%s%d%%%s" text (* state 100.0) update-text)
(message "%s%s" text update-text)))
((pred integerp)
(let ((message-log-max nil)
(pulse-char
(aref progress-reporter--pulse-characters
(mod state (length progress-reporter--pulse-characters)))))
(message "%s %s" text pulse-char)))
(message "%s %s%s" text pulse-char update-text)))
('done
(message "%sdone" text))))))
(defun progress-reporter-do-update (reporter value &optional suffix)
(defun progress-reporter-do-update (reporter value &optional update-text)
(let* ((parameters (cdr reporter))
(update-time (aref parameters 0))
(min-value (aref parameters 1))
@ -7292,31 +7300,26 @@ area is busy with something else."
(setcar reporter (ceiling (car reporter))))
;; Print message only if enough time has passed
(when enough-time-passed
(if suffix
(aset parameters 6 suffix)
(setq suffix (or (aref parameters 6) "")))
(run-hook-with-args 'progress-reporter-update-functions
reporter
(/ percentage 100.0)))))
(/ percentage 100.0)
update-text))))
;; Pulsing indicator
(enough-time-passed
(when (and value (not suffix))
(setq suffix value))
(if suffix
(aset parameters 6 suffix)
(setq suffix (or (aref parameters 6) "")))
(let ((index (1+ (car reporter))))
(setcar reporter index)
(run-hook-with-args 'progress-reporter-update-functions
reporter
index))))))
index
(or update-text value)))))))
(defun progress-reporter-done (reporter)
"Print reporter's message followed by word \"done\" in echo area.
Call the functions on `progress-reporter-update-functions`."
(run-hook-with-args 'progress-reporter-update-functions
reporter
'done))
'done
nil))
(defmacro dotimes-with-progress-reporter (spec reporter-or-message &rest body)
"Loop a certain number of times and report progress in the echo area.

View file

@ -273,9 +273,9 @@ If PROGRESS is nil, remove the progress indicator.")
;; `progress-reporter' support.
(defun system-taskbar--progress-reporter-update (_reporter state)
(defun system-taskbar--progress-reporter-update (_reporter state _update-text)
"Progress reporter system taskbar update function.
REPORTER and STATE are the same as in
REPORTER, STATE, and UPDATE-TEXT are the same as in
`progress-reporter-update-functions'."
(when system-taskbar-mode
(pcase state

View file

@ -1105,7 +1105,10 @@ tracked by a VCS."
The files will also be marked as deleted in the version control
system."
(interactive)
(vc-delete-file (or (vc-dir-marked-files) (vc-dir-current-file))))
(if-let* ((fileset-only-files
(nth 2 (vc-dir-deduce-fileset 'state-model-only-files))))
(vc-delete-file fileset-only-files)
(user-error "Nothing to delete here")))
(defun vc-dir-find-file ()
"Find the file on the current line."

View file

@ -236,7 +236,9 @@ A value of `default' means to use the value of `vc-resolve-conflicts'."
(setq file (expand-file-name file))
(let*
((status nil)
(default-directory (file-name-directory file))
(root (vc-hg-root file))
(file (file-relative-name file root))
(default-directory root)
(out
(with-output-to-string
(with-current-buffer

View file

@ -2745,7 +2745,7 @@ delete_frame (Lisp_Object frame, Lisp_Object force)
{
frame1 = Qnil;
if (after_delete_frame_select_mru_frame
if (EQ (delete_frame_choose_selected, Qmru)
&& !EQ (force, Qnoelisp))
{
/* Find the most recently used visible frame among all
@ -7221,6 +7221,7 @@ syms_of_frame (void)
DEFSYM (Qframe_monitor_attributes, "frame-monitor-attributes");
DEFSYM (Qwindow__pixel_to_total, "window--pixel-to-total");
DEFSYM (Qmake_initial_minibuffer_frame, "make-initial-minibuffer-frame");
DEFSYM (Qmru, "mru");
DEFSYM (Qget_mru_frame, "get-mru-frame");
DEFSYM (Qexplicit_name, "explicit-name");
DEFSYM (Qheight, "height");
@ -7794,12 +7795,13 @@ The default is \\+`inhibit' in NS builds and nil everywhere else. */);
alter_fullscreen_frames = Qnil;
#endif
DEFVAR_BOOL ("after-delete-frame-select-mru-frame",
after_delete_frame_select_mru_frame,
doc: /* Non-nil means `delete-frame' selects most recently used frame.
DEFVAR_LISP ("delete-frame-choose-selected",
delete_frame_choose_selected,
doc: /* What frame to select after frame deletion.
The value `mru' means `delete-frame' selects most recently used frame.
If this is nil, `delete-frame' will select the oldest visible frame on
the same terminal. */);
after_delete_frame_select_mru_frame = true;
delete_frame_choose_selected = Qmru;
defsubr (&Sframe_id);
defsubr (&Sframep);

View file

@ -182,4 +182,25 @@
(user-error (error-message-string err))))))
(should (and (stringp res) (string-match "new-replacement" res))))))
(defmacro macroexp--test-with-foo (&rest body)
"Eagerly macro-expand BODY."
(macroexpand-all `(progn . ,body) macroexpand-all-environment))
(ert-deftest macroexp--test-macroexp-enable-preserve-posification ()
(let* ((symbols-with-pos-enabled t)
(form (read-positioning-symbols
"(macroexp--test-with-foo (pop command-history))"))
(pop-pos (symbol-with-pos-pos (caadr form)))
(exp1 (macroexpand-1 form))
(macroexp-enable-preserve-posification nil)
(exp2 (macroexpand-1 form)))
;; Position of `pop' preserved in EXP1. There's no way to tell that
;; the position information in EXP1 is synthetic, which may confuse
;; consumers such as semantic highlighting.
(should (symbol-with-pos-p (caadr exp1)))
(should (= (symbol-with-pos-pos (caadr exp1)) pop-pos))
;; Position preservation was disabled, so EXP2 is clean of synthetic
;; position information.
(should-not (symbol-with-pos-p (caadr exp2)))))
;;; macroexp-tests.el ends here

View file

@ -263,15 +263,17 @@ If QUOTED is non-nil, the local part of the file name is quoted.
The temporary file is not created."
(make-temp-name (tramp--test-make-temp-prefix local quoted)))
;; Method "smb" supports `make-symbolic-link' only if the remote host
;; has CIFS capabilities. tramp-adb.el, tramp-gvfs.el, tramp-rclone.el
;; and tramp-sshfs.el do not support symbolic links at all.
;; If `system-type' is `windows-nt', making symbolic links is not
;; supported. Method "smb" supports `make-symbolic-link' only if the
;; remote host has CIFS capabilities. tramp-adb.el, tramp-gvfs.el,
;; tramp-rclone.el and tramp-sshfs.el do not support symbolic links at
;; all.
(defmacro tramp--test-ignore-make-symbolic-link-error (&rest body)
"Run BODY, ignoring \"make-symbolic-link not supported\" file error."
(declare (indent defun) (debug (body)))
`(condition-case err
(progn ,@body)
(remote-file-error
(file-error
(unless (string-match-p
(rx bol (| "make-symbolic-link not supported"
(: "Making symbolic link"
@ -282,7 +284,7 @@ The temporary file is not created."
;; Don't print messages in nested `tramp--test-instrument-test-case' calls.
(defvar tramp--test-instrument-test-case-p nil
"Whether `tramp--test-instrument-test-case' run.
This shall used dynamically bound only.")
This shall be used dynamically bound only.")
;; When `tramp-verbose' is greater than 10, and you want to trace
;; other functions as well, do something like
@ -2980,8 +2982,14 @@ This checks also `file-name-as-directory', `file-name-directory',
(should (string-equal (buffer-string) "foo\nbar\n")))))
;; Cleanup.
(ignore-errors (kill-buffer buffer1))
(ignore-errors (kill-buffer buffer2))
;; Modifying `read-from-minibuffer' doesn't work on MS Windows.
;; `kill-buffer--possibly-save' exists since Emacs 29.1.
(if (fboundp 'kill-buffer--possibly-save)
(cl-letf (((symbol-function #'kill-buffer--possibly-save) #'always))
(ignore-errors (kill-buffer buffer1))
(ignore-errors (kill-buffer buffer2)))
(ignore-errors (kill-buffer buffer1))
(ignore-errors (kill-buffer buffer2)))
(ignore-errors (delete-file tmp-file)))))
(ert-deftest tramp-test11-copy-file ()
@ -9081,8 +9089,12 @@ process sentinels. They shall not disturb each other."
(should
(string-equal (tramp--test-operation tramp-test-vec)
(tramp--handle-test-operation tramp-test-vec)))
(let ((vec (copy-tramp-file-name tramp-test-vec)))
(setf (tramp-file-name-method vec) (if (tramp--test-sh-p) "rclone" "sudo"))
(let ((vec (copy-tramp-file-name tramp-test-vec))
;; This is needed for the `simplified' syntax.
(tramp-default-method (if (tramp--test-sh-p) "rclone" "sudo"))
;; "rclone" is not multi-hop capable.
(tramp-multi-hop-p-hook #'always))
(setf (tramp-file-name-method vec) tramp-default-method)
(should-not
(string-equal (tramp--test-operation vec)
(tramp--handle-test-operation vec))))