master 3ca168b80ae: Merge from origin/emacs-31
Sean Whitton <[email protected]>
| Newsgroups | gmane.emacs.diffs |
|---|---|
| Message-ID | <[email protected]> |
branch: master commit 3ca168b80ae6d7b25fe55784dde3ad24faff7be2 Merge: eba26e9489f eb814fbb5cf Author: Sean Whitton <[email protected]> Commit: Sean Whitton <[email protected]> Merge from origin/emacs-31 eb814fbb5cf vc-hg-state-slow: Run from the repository root 3660bd3eb4f vc-dir-delete-file: Call vc-delete-file on FILESET-ONLY-F... a3a72ae355b Fix 'truncate-string-pixelwise' to restore the window buffer b6849229003 Restore progress-reporter suffix as update-text (bug#81134) e182c704c7f Rename recently added after-delete-frame-select-mru-frame e47bd3070aa Eglot: decode unhexed file URI paths as UTF-8 (bug#79897) e9403262500 ; * etc/NEWS: Mention limitation of diff-apply-buffer. 25084664ba0 Sync with Tramp 2.8.2 7be92efa5e1 Rename variable to macroexp-enable-preserve-posification 2066a0c9e86 New variable 'macroexp-enable-pos-preservation' (bug#79599) 00c290be853 Avoid infinite loop in some Dired marking commands # Conflicts: # etc/NEWS --- doc/lispref/display.texi | 15 ++++--- etc/NEWS.31 | 3 +- lisp/cus-start.el | 6 ++- lisp/dired-aux.el | 8 +++- lisp/dired-x.el | 1 + lisp/dired.el | 2 + lisp/emacs-lisp/elisp-scope.el | 1 + lisp/emacs-lisp/macroexp.el | 5 ++- lisp/emacs-lisp/subr-x.el | 79 +++++++++++++++++++--------------- lisp/net/tramp-cmds.el | 5 +-- lisp/net/tramp-compat.el | 18 ++++++-- lisp/net/tramp-message.el | 7 +++ lisp/net/tramp-smb.el | 5 --- lisp/net/tramp.el | 46 +++++++++++--------- lisp/progmodes/eglot.el | 3 +- lisp/subr.el | 63 ++++++++++++++------------- lisp/system-taskbar.el | 4 +- lisp/vc/vc-dir.el | 5 ++- lisp/vc/vc-hg.el | 4 +- src/frame.c | 12 +++--- test/lisp/emacs-lisp/macroexp-tests.el | 21 +++++++++ test/lisp/net/tramp-tests.el | 30 +++++++++---- 22 files changed, 214 insertions(+), 129 deletions(-) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 88654af4b09..0d0899e418c 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -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 diff --git a/etc/NEWS.31 b/etc/NEWS.31 index f5011312e03..6b2abe30aaa 100644 --- a/etc/NEWS.31 +++ b/etc/NEWS.31 @@ -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. diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 0ba77b197cc..bf5b331a30f 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -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 diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index a870f610094..50287a67129 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -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)) diff --git a/lisp/dired-x.el b/lisp/dired-x.el index ecd7c83e42a..128332bb0cf 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -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)) diff --git a/lisp/dired.el b/lisp/dired.el index 26e698341d8..53ec6779061 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -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))) diff --git a/lisp/emacs-lisp/elisp-scope.el b/lisp/emacs-lisp/elisp-scope.el index f95ea41e496..55e82001df9 100644 --- a/lisp/emacs-lisp/elisp-scope.el +++ b/lisp/emacs-lisp/elisp-scope.el @@ -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))) diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 6a16ebb0fd2..1d40e30bb08 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -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))))) diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 08ef9961c1e..8780a07a69d 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -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) diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index 1fc77f0e80d..e6ab0630d7a 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -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) diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 3f947ef1b2c..cd6cfdfe949 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -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 diff --git a/lisp/net/tramp-message.el b/lisp/net/tramp-message.el index 37628e2f001..7ae7408b745 100644 --- a/lisp/net/tramp-message.el +++ b/lisp/net/tramp-message.el @@ -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 diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 8eec0e1bd08..ac54e47e376 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -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) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 87ec55def37..c5ecbdd9675 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -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) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 457391572a0..2afb2b40094 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -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) diff --git a/lisp/subr.el b/lisp/subr.el index cea786ae64d..2f8870506bf 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -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. diff --git a/lisp/system-taskbar.el b/lisp/system-taskbar.el index 973b426e026..d1fe276844d 100644 --- a/lisp/system-taskbar.el +++ b/lisp/system-taskbar.el @@ -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 diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 8bf33836d3e..fad6b5a9ed8 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -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." diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index c00723af102..a3ede6ad0ac 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -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 diff --git a/src/frame.c b/src/frame.c index d17af6198be..a9ab769ead1 100644 --- a/src/frame.c +++ b/src/frame.c @@ -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); diff --git a/test/lisp/emacs-lisp/macroexp-tests.el b/test/lisp/emacs-lisp/macroexp-tests.el index 94bd1e98920..cad3ed84a07 100644 --- a/test/lisp/emacs-lisp/macroexp-tests.el +++ b/test/lisp/emacs-lisp/macroexp-tests.el @@ -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 diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 8edbb4ffe23..b622a08dce3 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -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))))