summaryrefslogtreecommitdiff
path: root/lisp/dired-aux.el
diff options
context:
space:
mode:
authorStefan Monnier <monnier@iro.umontreal.ca>2022-09-25 16:15:16 -0400
committerStefan Monnier <monnier@iro.umontreal.ca>2022-09-25 16:15:16 -0400
commit650c20f1ca4e07591a727e1cfcc74b3363d15985 (patch)
tree85d11f6437cde22f410c25e0e5f71a3131ebd07d /lisp/dired-aux.el
parent8869332684c2302b5ba1ead4568bbc7ba1c0183e (diff)
parent4b85ae6a24380fb67a3315eaec9233f17a872473 (diff)
downloademacs-650c20f1ca4e07591a727e1cfcc74b3363d15985.tar.gz
emacs-650c20f1ca4e07591a727e1cfcc74b3363d15985.tar.bz2
emacs-650c20f1ca4e07591a727e1cfcc74b3363d15985.zip
Merge 'master' into noverlay
Diffstat (limited to 'lisp/dired-aux.el')
-rw-r--r--lisp/dired-aux.el2022
1 files changed, 1470 insertions, 552 deletions
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 7e2252fcf1b..9add96c2608 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1,6 +1,6 @@
;;; dired-aux.el --- less commonly used parts of dired -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1986, 1992, 1994, 1998, 2000-2017 Free Software
+;; Copyright (C) 1985-1986, 1992, 1994, 1998, 2000-2022 Free Software
;; Foundation, Inc.
;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>.
@@ -33,6 +33,7 @@
;; sorting by Sebastian Kremer <sk@thp.uni-koeln.de>.
;; Finished up by rms in 1992.
+
;;; Code:
(require 'cl-lib)
@@ -45,9 +46,8 @@
Functions that operate recursively can store additional names
into this list; they also should call `dired-log' to log the errors.")
-;;; 15K
-;;;###begin dired-cmd.el
-;; Diffing and compressing
+
+;;; Diffing and compressing
(defconst dired-star-subst-regexp "\\(^\\|[ \t]\\)\\*\\([ \t]\\|$\\)")
(defconst dired-quark-subst-regexp "\\(^\\|[ \t]\\)\\?\\([ \t]\\|$\\)")
@@ -60,24 +60,132 @@ Isolated means that STRING is surrounded by spaces or at the beginning/end
of a string followed/prefixed with an space.
The regexp capture the preceding blank, STRING and the following blank as
the groups 1, 2 and 3 respectively."
- (format "\\(\\`\\|[ \t]\\)\\(%s\\)\\([ \t]\\|\\'\\)" string))
+ (format "\\(?1:\\`\\|[ \t]\\)\\(?2:%s\\)\\(?3:[ \t]\\|\\'\\)" string))
-(defun dired--star-or-qmark-p (string match &optional keep)
+(defun dired--star-or-qmark-p (string match &optional keep start)
"Return non-nil if STRING contains isolated MATCH or `\\=`?\\=`'.
MATCH should be the strings \"?\", `\\=`?\\=`', \"*\" or nil. The latter
means STRING contains either \"?\" or `\\=`?\\=`' or \"*\".
If optional arg KEEP is non-nil, then preserve the match data. Otherwise,
this function changes it and saves MATCH as the second match group.
+START is the position to start matching from.
Isolated means that MATCH is surrounded by spaces or at the beginning/end
of STRING followed/prefixed with an space. A match to `\\=`?\\=`',
isolated or not, is also valid."
- (let ((regexps (list (dired-isolated-string-re (if match (regexp-quote match) "[*?]")))))
+ (let ((regexp (dired-isolated-string-re (if match (regexp-quote match) "[*?]"))))
(when (or (null match) (equal match "?"))
- (setq regexps (append (list "\\(\\)\\(`\\?`\\)\\(\\)") regexps)))
- (cl-some (lambda (x)
- (funcall (if keep #'string-match-p #'string-match) x string))
- regexps)))
+ (cl-callf concat regexp "\\|\\(?1:\\)\\(?2:`\\?`\\)\\(?3:\\)"))
+ (funcall (if keep #'string-match-p #'string-match) regexp string start)))
+
+(defun dired--need-confirm-positions (command string)
+ "Search for non-isolated matches of STRING in COMMAND.
+Return a list of positions that match STRING, but would not be
+considered \"isolated\" by `dired--star-or-qmark-p'."
+ (cl-assert (= (length string) 1))
+ (let ((start 0)
+ (isolated-char-positions nil)
+ (confirm-positions nil)
+ (regexp (regexp-quote string)))
+ ;; Collect all ? and * surrounded by spaces and `?`.
+ (while (dired--star-or-qmark-p command string nil start)
+ (push (cons (match-beginning 2) (match-end 2))
+ isolated-char-positions)
+ (setq start (match-end 2)))
+ ;; Now collect any remaining ? and *.
+ (setq start 0)
+ (while (string-match regexp command start)
+ (unless (cl-member (match-beginning 0) isolated-char-positions
+ :test (lambda (pos match)
+ (<= (car match) pos (cdr match))))
+ (push (match-beginning 0) confirm-positions))
+ (setq start (match-end 0)))
+ confirm-positions))
+
+(defun dired--mark-positions (positions)
+ (let ((markers (make-string
+ (1+ (apply #'max positions))
+ ?\s)))
+ (dolist (pos positions)
+ (setf (aref markers pos) ?^))
+ markers))
+
+(defun dired--highlight-no-subst-chars (positions command mark)
+ (cl-callf substring-no-properties command)
+ (dolist (pos positions)
+ (add-face-text-property pos (1+ pos) 'warning nil command))
+ (if mark
+ (concat command "\n" (dired--mark-positions positions))
+ command))
+
+(defun dired--no-subst-explain (buf char-positions command mark-positions)
+ (with-current-buffer buf
+ (erase-buffer)
+ (insert
+ (format-message "\
+If your command contains occurrences of `*' surrounded by
+whitespace, `dired-do-shell-command' substitutes them for the
+entire file list to process. Otherwise, if your command contains
+occurrences of `?' surrounded by whitespace or `%s', Dired will
+run the command once for each file, substituting `?' for each
+file name.
+
+Your command contains occurrences of `%s' that will not be
+substituted, and will be passed through normally to the shell.
+
+%s
+
+\(Press ^ to %s markers below these occurrences.)
+"
+ "`"
+ (string (aref command (car char-positions)))
+ (dired--highlight-no-subst-chars char-positions command mark-positions)
+ (if mark-positions "remove" "add")))))
+
+(defun dired--no-subst-ask (char nb-occur details)
+ (let ((hilit-char (propertize (string char) 'face 'warning))
+ (choices `(?y ?n ?? ,@(when details '(?^)))))
+ (read-char-choice
+ (format-message
+ (ngettext
+ "%d occurrence of `%s' will not be substituted. Proceed? (%s) "
+ "%d occurrences of `%s' will not be substituted. Proceed? (%s) "
+ nb-occur)
+ nb-occur hilit-char (mapconcat #'string choices ", "))
+ choices)))
+
+(defun dired--no-subst-confirm (char-positions command)
+ (let ((help-buf (get-buffer-create "*Dired help*"))
+ (char (aref command (car char-positions)))
+ (nb-occur (length char-positions))
+ (done nil)
+ (details nil)
+ (markers nil)
+ proceed)
+ (unwind-protect
+ (save-window-excursion
+ (while (not done)
+ (cl-case (dired--no-subst-ask char nb-occur details)
+ (?y
+ (setq done t
+ proceed t))
+ (?n
+ (setq done t
+ proceed nil))
+ (??
+ (if details
+ (progn
+ (quit-window nil details)
+ (setq details nil))
+ (dired--no-subst-explain
+ help-buf char-positions command markers)
+ (setq details (display-buffer help-buf))))
+ (?^
+ (setq markers (not markers))
+ (dired--no-subst-explain
+ help-buf char-positions command markers)))))
+ (kill-buffer help-buf))
+ proceed))
;;;###autoload
(defun dired-diff (file &optional switches)
@@ -134,21 +242,32 @@ the string of command switches used as the third argument of `diff'."
(file-name-directory default)
(dired-current-directory))
(dired-dwim-target-directory)))
- (defaults (dired-dwim-target-defaults (list current) target-dir)))
+ (defaults (append
+ (if (backup-file-name-p current)
+ ;; This is a backup file -- put the other
+ ;; main file, and the other backup files into
+ ;; the `M-n' list.
+ (delete (expand-file-name current)
+ (cons (expand-file-name
+ (file-name-sans-versions current))
+ (file-backup-file-names
+ (file-name-sans-versions current))))
+ ;; Non-backup file -- use the backup files as
+ ;; `M-n' candidates.
+ (file-backup-file-names current))
+ (dired-dwim-target-defaults (list current) target-dir))))
(list
(minibuffer-with-setup-hook
(lambda ()
- (set (make-local-variable 'minibuffer-default-add-function) nil)
+ (setq-local minibuffer-default-add-function nil)
(setq minibuffer-default defaults))
- (read-file-name
- (format "Diff %s with%s: " current
- (if default (format " (default %s)" default) ""))
- target-dir default t))
+ (read-file-name (format-prompt "Diff %s with" default current)
+ target-dir default t))
(if current-prefix-arg
(read-string "Options for diff: "
(if (stringp diff-switches)
diff-switches
- (mapconcat 'identity diff-switches " ")))))))
+ (mapconcat #'identity diff-switches " ")))))))
(let ((current (dired-get-filename t)))
(when (or (equal (expand-file-name file)
(expand-file-name current))
@@ -169,12 +288,12 @@ If this file is a backup, diff it with its original.
The backup file is the first file given to `diff'.
With prefix arg, prompt for argument SWITCHES which is options for `diff'."
(interactive
- (if current-prefix-arg
- (list (read-string "Options for diff: "
- (if (stringp diff-switches)
- diff-switches
- (mapconcat 'identity diff-switches " "))))
- nil))
+ (if current-prefix-arg
+ (list (read-string "Options for diff: "
+ (if (stringp diff-switches)
+ diff-switches
+ (mapconcat #'identity diff-switches " "))))
+ nil))
(diff-backup (dired-get-filename) switches))
;;;###autoload
@@ -200,16 +319,22 @@ Examples of PREDICATE:
(> mtime1 mtime2) - mark newer files
(not (= size1 size2)) - mark files with different sizes
- (not (string= (nth 8 fa1) (nth 8 fa2))) - mark files with different modes
- (not (and (= (nth 2 fa1) (nth 2 fa2)) - mark files with different UID
- (= (nth 3 fa1) (nth 3 fa2)))) and GID."
+ (not (string= (file-attribute-modes fa1) - mark files with different modes
+ (file-attribute-modes fa2)))
+ (not (and (= (file-attribute-user-id fa1) - mark files with different UID
+ (file-attribute-user-id fa2))
+ (= (file-attribute-group-id fa1) - and GID.
+ (file-attribute-group-id fa2))))
+
+If the region is active in Transient Mark mode, mark files
+only in the active region if `dired-mark-region' is non-nil."
(interactive
(list
(let* ((target-dir (dired-dwim-target-directory))
(defaults (dired-dwim-target-defaults nil target-dir)))
(minibuffer-with-setup-hook
(lambda ()
- (set (make-local-variable 'minibuffer-default-add-function) nil)
+ (setq-local minibuffer-default-add-function nil)
(setq minibuffer-default defaults))
(read-directory-name (format "Compare %s with: "
(dired-current-directory))
@@ -224,12 +349,12 @@ Examples of PREDICATE:
(setq file-alist2 (delq (assoc "." file-alist2) file-alist2))
(setq file-alist2 (delq (assoc ".." file-alist2) file-alist2))
(setq file-list1 (mapcar
- 'cadr
+ #'cadr
(dired-file-set-difference
file-alist1 file-alist2
predicate))
file-list2 (mapcar
- 'cadr
+ #'cadr
(dired-file-set-difference
file-alist2 file-alist1
predicate)))
@@ -243,9 +368,11 @@ Examples of PREDICATE:
(lambda ()
(dired-mark-if
(member (dired-get-filename nil t) file-list2) nil)))
- (message "Marked in dir1: %s files, in dir2: %s files"
- (length file-list1)
- (length file-list2))))
+ (message "Marked in dir1: %s, in dir2: %s"
+ (format-message (ngettext "%d file" "%d files" (length file-list1))
+ (length file-list1))
+ (format-message (ngettext "%d file" "%d files" (length file-list2))
+ (length file-list2)))))
(defun dired-file-set-difference (list1 list2 predicate)
"Combine LIST1 and LIST2 using a set-difference operation.
@@ -269,12 +396,12 @@ condition. Two file items are considered to match if they are equal
(eval predicate
`((fa1 . ,fa1)
(fa2 . ,fa2)
- (size1 . ,(nth 7 fa1))
- (size2 . ,(nth 7 fa2))
+ (size1 . ,(file-attribute-size fa1))
+ (size2 . ,(file-attribute-size fa2))
(mtime1
- . ,(float-time (nth 5 fa1)))
+ . ,(float-time (file-attribute-modification-time fa1)))
(mtime2
- . ,(float-time (nth 5 fa2)))
+ . ,(float-time (file-attribute-modification-time fa2)))
)))))
(setq list (cdr list)))
list)
@@ -291,6 +418,7 @@ List has a form of (file-name full-file-name (attribute-list))."
full-file-name
(file-attributes full-file-name))))
(directory-files dir)))
+
;;; Change file attributes
@@ -301,22 +429,25 @@ List has a form of (file-name full-file-name (attribute-list))."
;; PROGRAM is the program used to change the attribute.
;; OP-SYMBOL is the type of operation (for use in `dired-mark-pop-up').
;; ARG describes which files to use, as in `dired-get-marked-files'.
- (let* ((files (dired-get-marked-files t arg))
+ (let* ((files (dired-get-marked-files t arg nil nil t))
;; The source of default file attributes is the file at point.
(default-file (dired-get-filename t t))
(default (when default-file
(cond ((eq op-symbol 'touch)
(format-time-string
"%Y%m%d%H%M.%S"
- (nth 5 (file-attributes default-file))))
+ (file-attribute-modification-time
+ (file-attributes default-file))))
((eq op-symbol 'chown)
- (nth 2 (file-attributes default-file 'string)))
+ (file-attribute-user-id
+ (file-attributes default-file 'string)))
((eq op-symbol 'chgrp)
- (nth 3 (file-attributes default-file 'string))))))
- (prompt (concat "Change " attribute-name " of %s to"
- (if (eq op-symbol 'touch)
- " (default now): "
- ": ")))
+ (file-attribute-group-id
+ (file-attributes default-file 'string))))))
+ (prompt (format-prompt "Change %s of %%s to"
+ (when (eq op-symbol 'touch)
+ "now")
+ attribute-name))
(new-attribute (dired-mark-read-string prompt nil op-symbol
arg files default
(cond ((eq op-symbol 'chown)
@@ -357,19 +488,26 @@ List has a form of (file-name full-file-name (attribute-list))."
;;;###autoload
(defun dired-do-chmod (&optional arg)
"Change the mode of the marked (or next ARG) files.
-Symbolic modes like `g+w' are allowed.
-Type M-n to pull the file attributes of the file at point
-into the minibuffer."
+Both octal numeric modes like `644' and symbolic modes like `g+w'
+are supported. Type M-n to pull the file attributes of the file
+at point into the minibuffer.
+
+See Info node `(coreutils)File permissions' for more information.
+Alternatively, see the man page for \"chmod(1)\".
+
+Note that on MS-Windows only the `w' (write) bit is meaningful:
+resetting it makes the file read-only. Changing any other bit
+has no effect on MS-Windows."
(interactive "P")
- (let* ((files (dired-get-marked-files t arg))
+ (let* ((files (dired-get-marked-files t arg nil nil t))
;; The source of default file attributes is the file at point.
(default-file (dired-get-filename t t))
(modestr (when default-file
- (nth 8 (file-attributes default-file))))
+ (file-attribute-modes (file-attributes default-file))))
(default
(and (stringp modestr)
(string-match "^.\\(...\\)\\(...\\)\\(...\\)$" modestr)
- (replace-regexp-in-string
+ (string-replace
"-" ""
(format "u=%s,g=%s,o=%s"
(match-string 1 modestr)
@@ -393,7 +531,8 @@ into the minibuffer."
(set-file-modes
file
(if num-modes num-modes
- (file-modes-symbolic-to-number modes (file-modes file)))))
+ (file-modes-symbolic-to-number modes (file-modes file 'nofollow)))
+ 'nofollow))
(dired-do-redisplay arg)))
;;;###autoload
@@ -402,7 +541,8 @@ into the minibuffer."
Type M-n to pull the file attributes of the file at point
into the minibuffer."
(interactive "P")
- (if (memq system-type '(ms-dos windows-nt))
+ (if (and (memq system-type '(ms-dos windows-nt))
+ (not (file-remote-p default-directory)))
(error "chgrp not supported on this system"))
(dired-do-chxxx "Group" "chgrp" 'chgrp arg))
@@ -412,7 +552,8 @@ into the minibuffer."
Type M-n to pull the file attributes of the file at point
into the minibuffer."
(interactive "P")
- (if (memq system-type '(ms-dos windows-nt))
+ (if (and (memq system-type '(ms-dos windows-nt))
+ (not (file-remote-p default-directory)))
(error "chown not supported on this system"))
(dired-do-chxxx "Owner" dired-chown-program 'chown arg))
@@ -476,7 +617,7 @@ Uses the shell command coming from variables `lpr-command' and
`lpr-switches' as default."
(interactive "P")
(require 'lpr)
- (let* ((file-list (dired-get-marked-files t arg))
+ (let* ((file-list (dired-get-marked-files t arg nil nil t))
(lpr-switches
(if (and (stringp printer-name)
(string< "" printer-name))
@@ -485,7 +626,7 @@ Uses the shell command coming from variables `lpr-command' and
lpr-switches))
(command (dired-mark-read-string
"Print %s with: "
- (mapconcat 'identity
+ (mapconcat #'identity
(cons lpr-command
(if (stringp lpr-switches)
(list lpr-switches)
@@ -495,7 +636,7 @@ Uses the shell command coming from variables `lpr-command' and
(dired-run-shell-command (dired-shell-stuff-it command file-list nil))))
(defun dired-mark-read-string (prompt initial op-symbol arg files
- &optional default-value collection)
+ &optional default-value collection)
"Read args for a Dired marked-files command, prompting with PROMPT.
Return the user input (a string).
@@ -514,8 +655,9 @@ passed as the second arg to `completing-read'."
'completing-read
(format prompt (dired-mark-prompt arg files))
collection nil nil initial nil default-value nil))
+
-;;; Cleaning a directory: flagging some backups for deletion.
+;;; Cleaning a directory: flagging some backups for deletion
(defvar dired-file-version-alist)
@@ -558,7 +700,8 @@ with a prefix argument."
(dired-map-dired-file-lines #'dired-trample-file-versions)
(message "Cleaning numerical backups...done")))
-;;; Subroutines of dired-clean-directory.
+
+;;; Subroutines of dired-clean-directory
(defun dired-map-dired-file-lines (fun)
;; Perform FUN with point at the end of each non-directory line.
@@ -591,7 +734,7 @@ with a prefix argument."
(possibilities (file-name-all-completions
base-versions
(file-name-directory fn)))
- (versions (mapcar 'backup-extract-version possibilities)))
+ (versions (mapcar #'backup-extract-version possibilities)))
(if versions
(setq dired-file-version-alist
(cons (cons fn versions)
@@ -609,19 +752,22 @@ with a prefix argument."
(progn (beginning-of-line)
(delete-char 1)
(insert dired-del-marker)))))
+
;;; Shell commands
(declare-function mailcap-file-default-commands "mailcap" (files))
-(defun minibuffer-default-add-dired-shell-commands ()
+(defvar dired-aux-files)
+
+(defun dired-minibuffer-default-add-shell-commands ()
"Return a list of all commands associated with current dired files.
This function is used to add all related commands retrieved by `mailcap'
to the end of the list of defaults just after the default value."
(interactive)
- (let* ((files minibuffer-completion-table)
- (commands (and (require 'mailcap nil t)
- (mailcap-file-default-commands files))))
+ (let ((commands (and (boundp 'dired-aux-files)
+ (require 'mailcap nil t)
+ (mailcap-file-default-commands dired-aux-files))))
(if (listp minibuffer-default)
(append minibuffer-default commands)
(cons minibuffer-default commands))))
@@ -634,20 +780,25 @@ which is replaced by the value returned by `dired-mark-prompt',
with ARG and FILES as its arguments. FILES should be a list of
file names. The result is used as the prompt.
-This normally reads using `read-shell-command', but if the
-`dired-x' package is loaded, use `dired-guess-shell-command' to
-offer a smarter default choice of shell command."
+Use `dired-guess-shell-command' to offer a smarter default choice
+of shell command."
(minibuffer-with-setup-hook
(lambda ()
- (set (make-local-variable 'minibuffer-completion-table) files)
- (set (make-local-variable 'minibuffer-default-add-function)
- 'minibuffer-default-add-dired-shell-commands))
+ (setq-local dired-aux-files files)
+ (setq-local minibuffer-default-add-function
+ #'dired-minibuffer-default-add-shell-commands))
(setq prompt (format prompt (dired-mark-prompt arg files)))
- (if (functionp 'dired-guess-shell-command)
- (dired-mark-pop-up nil 'shell files
- 'dired-guess-shell-command prompt files)
- (dired-mark-pop-up nil 'shell files
- 'read-shell-command prompt nil nil))))
+ (dired-mark-pop-up nil 'shell files
+ 'dired-guess-shell-command prompt files)))
+
+;;;###autoload
+(defcustom dired-confirm-shell-command t
+ "Whether to prompt for confirmation for `dired-do-shell-command'.
+If non-nil, prompt for confirmation if the command contains potentially
+dangerous characters. If nil, never prompt for confirmation."
+ :type 'boolean
+ :group 'dired
+ :version "29.1")
;;;###autoload
(defun dired-do-async-shell-command (command &optional arg file-list)
@@ -664,9 +815,11 @@ are executed in the background on each file sequentially waiting
for each command to terminate before running the next command.
In shell syntax this means separating the individual commands with `;'.
-The output appears in the buffer `*Async Shell Command*'."
+The output appears in the buffer named by `shell-command-buffer-name-async'.
+
+Commands that are run asynchronously do not accept user input."
(interactive
- (let ((files (dired-get-marked-files t current-prefix-arg)))
+ (let ((files (dired-get-marked-files t current-prefix-arg nil nil t)))
(list
;; Want to give feedback whether this file or marked files are used:
(dired-read-shell-command "& on %s: " current-prefix-arg files)
@@ -702,16 +855,16 @@ it, write `*\"\"' in place of just `*'. This is equivalent to just
`*' in the shell, but avoids Dired's special handling.
If COMMAND ends in `&', `;', or `;&', it is executed in the
-background asynchronously, and the output appears in the buffer
-`*Async Shell Command*'. When operating on multiple files and COMMAND
-ends in `&', the shell command is executed on each file in parallel.
-However, when COMMAND ends in `;' or `;&' then commands are executed
-in the background on each file sequentially waiting for each command
-to terminate before running the next command. You can also use
-`dired-do-async-shell-command' that automatically adds `&'.
+background asynchronously, and the output appears in the buffer named
+by `shell-command-buffer-name-async'. When operating on multiple files
+and COMMAND ends in `&', the shell command is executed on each file
+in parallel. However, when COMMAND ends in `;' or `;&', then commands
+are executed in the background on each file sequentially waiting for
+each command to terminate before running the next command. You can
+also use `dired-do-async-shell-command' that automatically adds `&'.
Otherwise, COMMAND is executed synchronously, and the output
-appears in the buffer `*Shell Command Output*'.
+appears in the buffer named by `shell-command-buffer-name'.
This feature does not try to redisplay Dired buffers afterward, as
there's no telling what files COMMAND may have changed.
@@ -723,48 +876,48 @@ instead of in a subdir.
In a noninteractive call (from Lisp code), you must specify
the list of file names explicitly with the FILE-LIST argument, which
-can be produced by `dired-get-marked-files', for example."
-;;Functions dired-run-shell-command and dired-shell-stuff-it do the
-;;actual work and can be redefined for customization.
+can be produced by `dired-get-marked-files', for example.
+
+`dired-guess-shell-alist-default' and
+`dired-guess-shell-alist-user' are consulted when the user is
+prompted for the shell command to use interactively.
+
+Also see the `dired-confirm-shell-command' variable."
+ ;; Functions dired-run-shell-command and dired-shell-stuff-it do the
+ ;; actual work and can be redefined for customization.
(interactive
- (let ((files (dired-get-marked-files t current-prefix-arg)))
+ (let ((files (dired-get-marked-files t current-prefix-arg nil nil t)))
(list
;; Want to give feedback whether this file or marked files are used:
(dired-read-shell-command "! on %s: " current-prefix-arg files)
current-prefix-arg
files)))
- (cl-flet ((need-confirm-p
- (cmd str)
- (let ((res cmd)
- (regexp (regexp-quote str)))
- ;; Drop all ? and * surrounded by spaces and `?`.
- (while (and (string-match regexp res)
- (dired--star-or-qmark-p res str))
- (setq res (replace-match "" t t res 2)))
- (string-match regexp res))))
(let* ((on-each (not (dired--star-or-qmark-p command "*" 'keep)))
(no-subst (not (dired--star-or-qmark-p command "?" 'keep)))
+ (confirmations nil)
;; Get confirmation for wildcards that may have been meant
;; to control substitution of a file name or the file name list.
- (ok (cond ((not (or on-each no-subst))
- (error "You can not combine `*' and `?' substitution marks"))
- ((need-confirm-p command "*")
- (y-or-n-p (format-message
- "Confirm--do you mean to use `*' as a wildcard? ")))
- ((need-confirm-p command "?")
- (y-or-n-p (format-message
- "Confirm--do you mean to use `?' as a wildcard? ")))
- (t))))
- (when ok
- (if on-each
- (dired-bunch-files (- 10000 (length command))
- (lambda (&rest files)
- (dired-run-shell-command
- (dired-shell-stuff-it command files t arg)))
- nil file-list)
- ;; execute the shell command
- (dired-run-shell-command
- (dired-shell-stuff-it command file-list nil arg)))))))
+ (ok (cond
+ ((not (or on-each no-subst))
+ (error "You can not combine `*' and `?' substitution marks"))
+ ((not dired-confirm-shell-command)
+ t)
+ ((setq confirmations (dired--need-confirm-positions command "*"))
+ (dired--no-subst-confirm confirmations command))
+ ((setq confirmations (dired--need-confirm-positions command "?"))
+ (dired--no-subst-confirm confirmations command))
+ (t))))
+ (cond ((not ok) (message "Command canceled"))
+ (t
+ (if on-each
+ (dired-bunch-files (- 10000 (length command))
+ (lambda (&rest files)
+ (dired-run-shell-command
+ (dired-shell-stuff-it command files t arg)))
+ nil file-list)
+ ;; execute the shell command
+ (dired-run-shell-command
+ (dired-shell-stuff-it command file-list nil arg)))))))
;; Might use {,} for bash or csh:
(defvar dired-mark-prefix ""
@@ -775,13 +928,13 @@ can be produced by `dired-get-marked-files', for example."
"Separates marked files in dired shell commands.")
(defun dired-shell-stuff-it (command file-list on-each &optional _raw-arg)
-;; "Make up a shell command line from COMMAND and FILE-LIST.
-;; If ON-EACH is t, COMMAND should be applied to each file, else
-;; simply concat all files and apply COMMAND to this.
-;; FILE-LIST's elements will be quoted for the shell."
-;; Might be redefined for smarter things and could then use RAW-ARG
-;; (coming from interactive P and currently ignored) to decide what to do.
-;; Smart would be a way to access basename or extension of file names.
+ ;; "Make up a shell command line from COMMAND and FILE-LIST.
+ ;; If ON-EACH is t, COMMAND should be applied to each file, else
+ ;; simply concat all files and apply COMMAND to this.
+ ;; FILE-LIST's elements will be quoted for the shell."
+ ;; Might be redefined for smarter things and could then use RAW-ARG
+ ;; (coming from interactive P and currently ignored) to decide what to do.
+ ;; Smart would be a way to access basename or extension of file names.
(let* ((in-background (string-match "[ \t]*&[ \t]*\\'" command))
(command (if in-background
(substring command 0 (match-beginning 0))
@@ -794,15 +947,16 @@ can be produced by `dired-get-marked-files', for example."
(and in-background (not sequentially) (not (eq system-type 'ms-dos))))
(w32-shell (and (fboundp 'w32-shell-dos-semantics)
(w32-shell-dos-semantics)))
+ (file-remote (file-remote-p default-directory))
;; The way to run a command in background in Windows shells
;; is to use the START command. The /B switch means not to
;; create a new window for the command.
- (cmd-prefix (if w32-shell "start /b " ""))
+ (cmd-prefix (if (and w32-shell (not file-remote)) "start /b " ""))
;; Windows shells don't support chaining with ";", they use
;; "&" instead.
- (cmd-sep (if (and (not w32-shell) (not parallel-in-background))
- ";"
- "&"))
+ (cmd-sep (if (and (or (not w32-shell) file-remote)
+ (not parallel-in-background))
+ ";" "&"))
(stuff-it
(if (dired--star-or-qmark-p command nil 'keep)
(lambda (x)
@@ -811,29 +965,44 @@ can be produced by `dired-get-marked-files', for example."
(setq retval (replace-match x t t retval 2)))
retval))
(lambda (x) (concat cmd-prefix command dired-mark-separator x)))))
+ ;; If a file name starts with "-", add a "./" to avoid the command
+ ;; interpreting it as a command line switch.
+ (setq file-list (mapcar (lambda (file)
+ (if (string-match "\\`-" file)
+ (concat "./" file)
+ file))
+ file-list))
(concat
- (cond (on-each
- (format "%s%s"
- (mapconcat stuff-it (mapcar 'shell-quote-argument file-list)
- cmd-sep)
- ;; POSIX shells running a list of commands in the background
- ;; (LIST = cmd_1 & [cmd_2 & ... cmd_i & ... cmd_N &])
- ;; return once cmd_N ends, i.e., the shell does not
- ;; wait for cmd_i to finish before executing cmd_i+1.
- ;; That means, running (shell-command LIST) may not show
- ;; the output of all the commands (Bug#23206).
- ;; Add 'wait' to force those POSIX shells to wait until
- ;; all commands finish.
- (or (and parallel-in-background (not w32-shell)
- "&wait")
- "")))
- (t
- (let ((files (mapconcat 'shell-quote-argument
- file-list dired-mark-separator)))
- (when (cdr file-list)
- (setq files (concat dired-mark-prefix files dired-mark-postfix)))
- (funcall stuff-it files))))
- (or (and in-background "&") ""))))
+ (cond
+ (on-each
+ (format "%s%s"
+ (mapconcat stuff-it (mapcar #'shell-quote-argument file-list)
+ cmd-sep)
+ ;; POSIX shells running a list of commands in the background
+ ;; (LIST = cmd_1 & [cmd_2 & ... cmd_i & ... cmd_N &])
+ ;; return once cmd_N ends, i.e., the shell does not
+ ;; wait for cmd_i to finish before executing cmd_i+1.
+ ;; That means, running (shell-command LIST) may not show
+ ;; the output of all the commands (Bug#23206).
+ ;; Add 'wait' to force those POSIX shells to wait until
+ ;; all commands finish.
+ (or (and parallel-in-background (not w32-shell)
+ " &wait")
+ "")))
+ (t
+ (let ((files (mapconcat #'shell-quote-argument
+ file-list dired-mark-separator)))
+ (when (cdr file-list)
+ (setq files (concat dired-mark-prefix files dired-mark-postfix)))
+ (concat
+ (funcall stuff-it files)
+ ;; Be consistent in how we treat inputs to commands -- do
+ ;; the same here as in the `on-each' case.
+ (if (and in-background (not w32-shell))
+ " &wait"
+ "")))))
+ (or (and in-background "&")
+ ""))))
;; This is an extra function so that it can be redefined by ange-ftp.
;;;###autoload
@@ -845,15 +1014,17 @@ can be produced by `dired-get-marked-files', for example."
(shell-command command)))
;; Return nil for sake of nconc in dired-bunch-files.
nil)
-
+
(defun dired-check-process (msg program &rest arguments)
- "Display MSG while running PROGRAM, and check for output.
-Remaining arguments are strings passed as command arguments to PROGRAM.
-On error, insert output
-in a log buffer and return the offending ARGUMENTS or PROGRAM.
-Caller can cons up a list of failed args.
-Else returns nil for success."
+ "Display MSG, then run PROGRAM, and log any error messages from it.
+ARGUMENTS should be strings to be passed to PROGRAM as command-line
+arguments.
+
+If PROGRAM exits successfully, display \"MSG...done\" and return nil.
+If PROGRAM exits abnormally, save in `dired-log-buffer' the command
+that invoked PROGRAM and the messages it emitted, and return either
+the offending ARGUMENTS or PROGRAM if no ARGUMENTS were provided."
(let (err-buffer err (dir default-directory))
(message "%s..." msg)
(save-excursion
@@ -862,7 +1033,8 @@ Else returns nil for success."
(set-buffer err-buffer)
(erase-buffer)
(setq default-directory dir ; caller's default-directory
- err (not (eq 0 (apply 'process-file program nil t nil arguments))))
+ err (not (eq 0 (apply #'process-file program nil t nil arguments))))
+ (dired-uncache dir)
(if err
(progn
(dired-log (concat program " " (prin1-to-string arguments) "\n"))
@@ -880,19 +1052,285 @@ Return the result of `process-file' - zero for success."
(dir default-directory))
(with-current-buffer (get-buffer-create out-buffer)
(erase-buffer)
- (let* ((default-directory dir)
- (res (process-file
- shell-file-name
- nil
- t
- nil
- shell-command-switch
- cmd)))
- (unless (zerop res)
- (pop-to-buffer out-buffer))
- res))))
+ (let ((default-directory dir) res)
+ (with-connection-local-variables
+ (setq res (process-file
+ shell-file-name
+ nil
+ t
+ nil
+ shell-command-switch
+ cmd))
+ (dired-uncache dir)
+ (unless (zerop res)
+ (pop-to-buffer out-buffer))
+ res)))))
+
-;; Commands that delete or redisplay part of the dired buffer.
+;;; Guess shell command
+
+;; * `dired-guess-shell-command' provides smarter defaults for
+;; `dired-read-shell-command'.
+;;
+;; * `dired-guess-shell-command' calls `dired-guess-default' with list of
+;; marked files.
+;;
+;; * Parse `dired-guess-shell-alist-user' and
+;; `dired-guess-shell-alist-default' (in that order) for the first REGEXP
+;; that matches the first file in the file list.
+;;
+;; * If the REGEXP matches all the entries of the file list then evaluate
+;; COMMAND, which is either a string or a Lisp expression returning a
+;; string. COMMAND may be a list of commands.
+;;
+;; * Return this command to `dired-guess-shell-command' which prompts user
+;; with it. The list of commands is put into the list of default values.
+;; If a command is used successfully then it is stored permanently in
+;; `dired-shell-command-history'.
+
+;; Guess what shell command to apply to a file.
+(defvar dired-shell-command-history nil
+ "History list for commands that read dired-shell commands.")
+
+;; Default list of shell commands.
+
+;; NOTE: Use `gunzip -c' instead of `zcat' on `.gz' files. Some do not
+;; install GNU zip's version of zcat.
+
+(autoload 'Man-support-local-filenames "man")
+(autoload 'vc-responsible-backend "vc")
+
+(defvar dired-guess-shell-alist-default
+ (list
+ (list "\\.tar\\'"
+ '(if dired-guess-shell-gnutar
+ (concat dired-guess-shell-gnutar " xvf")
+ "tar xvf")
+ ;; Extract files into a separate subdirectory
+ '(if dired-guess-shell-gnutar
+ (concat "mkdir " (file-name-sans-extension file)
+ "; " dired-guess-shell-gnutar " -C "
+ (file-name-sans-extension file) " -xvf")
+ (concat "mkdir " (file-name-sans-extension file)
+ "; tar -C " (file-name-sans-extension file) " -xvf"))
+ ;; List archive contents.
+ '(if dired-guess-shell-gnutar
+ (concat dired-guess-shell-gnutar " tvf")
+ "tar tvf"))
+
+ ;; REGEXPS for compressed archives must come before the .Z rule to
+ ;; be recognized:
+ (list "\\.tar\\.Z\\'"
+ ;; Untar it.
+ '(if dired-guess-shell-gnutar
+ (concat dired-guess-shell-gnutar " zxvf")
+ (concat "zcat * | tar xvf -"))
+ ;; Optional conversion to gzip format.
+ '(concat "znew" (if dired-guess-shell-gzip-quiet " -q")
+ " " dired-guess-shell-znew-switches))
+
+ ;; gzip'ed archives
+ (list "\\.t\\(ar\\.\\)?gz\\'"
+ '(if dired-guess-shell-gnutar
+ (concat dired-guess-shell-gnutar " zxvf")
+ (concat "gunzip -qc * | tar xvf -"))
+ ;; Extract files into a separate subdirectory
+ '(if dired-guess-shell-gnutar
+ (concat "mkdir " (file-name-sans-extension file)
+ "; " dired-guess-shell-gnutar " -C "
+ (file-name-sans-extension file) " -zxvf")
+ (concat "mkdir " (file-name-sans-extension file)
+ "; gunzip -qc * | tar -C "
+ (file-name-sans-extension file) " -xvf -"))
+ ;; Optional decompression.
+ '(concat "gunzip" (if dired-guess-shell-gzip-quiet " -q" ""))
+ ;; List archive contents.
+ '(if dired-guess-shell-gnutar
+ (concat dired-guess-shell-gnutar " ztvf")
+ (concat "gunzip -qc * | tar tvf -")))
+
+ ;; bzip2'ed archives
+ (list "\\.t\\(ar\\.bz2\\|bz\\)\\'"
+ "bunzip2 -c * | tar xvf -"
+ ;; Extract files into a separate subdirectory
+ '(concat "mkdir " (file-name-sans-extension file)
+ "; bunzip2 -c * | tar -C "
+ (file-name-sans-extension file) " -xvf -")
+ ;; Optional decompression.
+ "bunzip2")
+
+ ;; xz'ed archives
+ (list "\\.t\\(ar\\.\\)?xz\\'"
+ "unxz -c * | tar xvf -"
+ ;; Extract files into a separate subdirectory
+ '(concat "mkdir " (file-name-sans-extension file)
+ "; unxz -c * | tar -C "
+ (file-name-sans-extension file) " -xvf -")
+ ;; Optional decompression.
+ "unxz")
+
+ ;; zstandard archives
+ `(,(rx (or ".tar.zst" ".tzst") eos) "unzstd -c %i | tar -xf -")
+ `(,(rx ".zst" eos) "unzstd --rm")
+
+ '("\\.shar\\.Z\\'" "zcat * | unshar")
+ '("\\.shar\\.g?z\\'" "gunzip -qc * | unshar")
+
+ '("\\.e?ps\\'" "ghostview" "xloadimage" "lpr")
+ (list "\\.e?ps\\.g?z\\'" "gunzip -qc * | ghostview -"
+ ;; Optional decompression.
+ '(concat "gunzip" (if dired-guess-shell-gzip-quiet " -q")))
+ (list "\\.e?ps\\.Z\\'" "zcat * | ghostview -"
+ ;; Optional conversion to gzip format.
+ '(concat "znew" (if dired-guess-shell-gzip-quiet " -q")
+ " " dired-guess-shell-znew-switches))
+
+ (list "\\.patch\\'"
+ '(if (eq (ignore-errors (vc-responsible-backend default-directory)) 'Git)
+ "cat * | git apply"
+ "cat * | patch"))
+ (list "\\.patch\\.g?z\\'" "gunzip -qc * | patch"
+ ;; Optional decompression.
+ '(concat "gunzip" (if dired-guess-shell-gzip-quiet " -q")))
+ (list "\\.patch\\.Z\\'" "zcat * | patch"
+ ;; Optional conversion to gzip format.
+ '(concat "znew" (if dired-guess-shell-gzip-quiet " -q")
+ " " dired-guess-shell-znew-switches))
+
+ ;; The following four extensions are useful with dired-man ("N" key)
+ ;; FIXME "man ./" does not work with dired-do-shell-command,
+ ;; because there seems to be no way for us to modify the filename,
+ ;; only the command. Hmph. `dired-man' works though.
+ (list "\\.\\(?:[0-9]\\|man\\)\\'"
+ '(let ((loc (Man-support-local-filenames)))
+ (cond ((eq loc 'man-db) "man -l")
+ ((eq loc 'man) "man ./")
+ (t
+ "cat * | tbl | nroff -man -h | col -b"))))
+ (list "\\.\\(?:[0-9]\\|man\\)\\.g?z\\'"
+ '(let ((loc (Man-support-local-filenames)))
+ (cond ((eq loc 'man-db)
+ "man -l")
+ ((eq loc 'man)
+ "man ./")
+ (t "gunzip -qc * | tbl | nroff -man -h | col -b")))
+ ;; Optional decompression.
+ '(concat "gunzip" (if dired-guess-shell-gzip-quiet " -q")))
+ (list "\\.[0-9]\\.Z\\'"
+ '(let ((loc (Man-support-local-filenames)))
+ (cond ((eq loc 'man-db) "man -l")
+ ((eq loc 'man) "man ./")
+ (t "zcat * | tbl | nroff -man -h | col -b")))
+ ;; Optional conversion to gzip format.
+ '(concat "znew" (if dired-guess-shell-gzip-quiet " -q")
+ " " dired-guess-shell-znew-switches))
+ '("\\.pod\\'" "perldoc" "pod2man * | nroff -man")
+
+ '("\\.dvi\\'" "xdvi" "dvips") ; preview and printing
+ '("\\.au\\'" "play") ; play Sun audiofiles
+ '("\\.mpe?g\\'\\|\\.avi\\'" "xine -p")
+ '("\\.ogg\\'" "ogg123")
+ '("\\.mp3\\'" "mpg123")
+ '("\\.wav\\'" "play")
+ '("\\.uu\\'" "uudecode") ; for uudecoded files
+ '("\\.hqx\\'" "mcvert")
+ '("\\.sh\\'" "sh") ; execute shell scripts
+ '("\\.xbm\\'" "bitmap") ; view X11 bitmaps
+ '("\\.gp\\'" "gnuplot")
+ '("\\.p[bgpn]m\\'" "xloadimage")
+ '("\\.gif\\'" "xloadimage") ; view gif pictures
+ '("\\.tif\\'" "xloadimage")
+ '("\\.png\\'" "display") ; xloadimage 4.1 doesn't grok PNG
+ '("\\.jpe?g\\'" "xloadimage")
+ '("\\.fig\\'" "xfig") ; edit fig pictures
+ '("\\.out\\'" "xgraph") ; for plotting purposes.
+ '("\\.tex\\'" "latex" "tex")
+ '("\\.texi\\(nfo\\)?\\'" "makeinfo" "texi2dvi")
+ '("\\.pdf\\'" "xpdf")
+ '("\\.doc\\'" "antiword" "strings")
+ '("\\.rpm\\'" "rpm -qilp" "rpm -ivh")
+ '("\\.dia\\'" "dia")
+ '("\\.mgp\\'" "mgp")
+
+ ;; Some other popular archivers.
+ (list "\\.zip\\'" "unzip" "unzip -l"
+ ;; Extract files into a separate subdirectory
+ '(concat "unzip" (if dired-guess-shell-gzip-quiet " -q")
+ " -d " (file-name-sans-extension file)))
+ '("\\.zoo\\'" "zoo x//")
+ '("\\.lzh\\'" "lharc x")
+ '("\\.arc\\'" "arc x")
+ '("\\.shar\\'" "unshar")
+ '("\\.rar\\'" "unrar x")
+ '("\\.7z\\'" "7z x")
+
+ ;; Compression.
+ (list "\\.g?z\\'" '(concat "gunzip" (if dired-guess-shell-gzip-quiet " -q")))
+ (list "\\.dz\\'" "dictunzip")
+ (list "\\.bz2\\'" "bunzip2")
+ (list "\\.xz\\'" "unxz")
+ (list "\\.Z\\'" "uncompress"
+ ;; Optional conversion to gzip format.
+ '(concat "znew" (if dired-guess-shell-gzip-quiet " -q")
+ " " dired-guess-shell-znew-switches))
+
+ '("\\.sign?\\'" "gpg --verify"))
+ "Default alist used for shell command guessing.
+See `dired-guess-shell-alist-user'.")
+
+(defun dired-guess-default (files)
+ "Return a shell command, or a list of commands, appropriate for FILES.
+See `dired-guess-shell-alist-user'."
+ (let* ((case-fold-search dired-guess-shell-case-fold-search)
+ (programs
+ (delete-dups
+ (mapcar
+ (lambda (command)
+ (eval command `((file . ,(car files)))))
+ (seq-reduce
+ #'append
+ (mapcar #'cdr
+ (seq-filter (lambda (elem)
+ (seq-every-p
+ (lambda (file)
+ (string-match-p (car elem) file))
+ files))
+ (append dired-guess-shell-alist-user
+ dired-guess-shell-alist-default)))
+ nil)))))
+ (if (length= programs 1)
+ (car programs)
+ programs)))
+
+;;;###autoload
+(defun dired-guess-shell-command (prompt files)
+ "Ask user with PROMPT for a shell command, guessing a default from FILES."
+ (let ((default (dired-guess-default files))
+ default-list val)
+ (if (null default)
+ ;; Nothing to guess
+ (read-shell-command prompt nil 'dired-shell-command-history)
+ (setq prompt (replace-regexp-in-string ": $" " " prompt))
+ (if (listp default)
+ ;; More than one guess
+ (setq default-list default
+ default (car default)
+ prompt (concat
+ prompt
+ (format "{%d guesses} " (length default-list))))
+ ;; Just one guess
+ (setq default-list (list default)))
+ ;; Put the first guess in the prompt but not in the initial value.
+ (setq prompt (concat prompt (format "[%s]: " default)))
+ ;; All guesses can be retrieved with M-n
+ (setq val (read-shell-command prompt nil
+ 'dired-shell-command-history
+ default-list))
+ ;; If we got a return, then return default.
+ (if (equal val "") default val))))
+
+
+;;; Commands that delete or redisplay part of the dired buffer
(defun dired-kill-line (&optional arg)
"Kill the current line (not the files).
@@ -917,41 +1355,49 @@ With a prefix argument, kill that many lines starting with the current line.
(dired-move-to-filename)))
;;;###autoload
-(defun dired-do-kill-lines (&optional arg fmt)
- "Kill all marked lines (not the files).
-With a prefix argument, kill that many lines starting with the current line.
-\(A negative argument kills backward.)
-If you use this command with a prefix argument to kill the line
-for a file that is a directory, which you have inserted in the
-Dired buffer as a subdirectory, then it deletes that subdirectory
-from the buffer as well.
-To kill an entire subdirectory \(without killing its line in the
-parent directory), go to its directory header line and use this
-command with a prefix argument (the value does not matter)."
- ;; Returns count of killed lines. FMT="" suppresses message.
+(defun dired-do-kill-lines (&optional arg fmt init-count)
+ "Remove all marked lines, or the next ARG lines.
+The files or directories on those lines are _not_ deleted. Only the
+Dired listing is affected. To restore the removals, use `\\[revert-buffer]'.
+
+With a numeric prefix arg, remove that many lines going forward,
+starting with the current line. (A negative prefix arg removes lines
+going backward.)
+
+If you use a prefix arg to remove the line for a subdir whose listing
+you have inserted into the Dired buffer, then that subdir listing is
+also removed.
+
+To remove a subdir listing _without_ removing the subdir's line in its
+parent listing, go to the header line of the subdir listing and use
+this command with any prefix arg.
+
+When called from Lisp, non-nil INIT-COUNT is added to the number of
+lines removed by this invocation, for the reporting message.
+
+A FMT of \"\" will suppress the messaging."
+ ;; Returns count of killed lines.
(interactive "P")
(if arg
(if (dired-get-subdir)
- (dired-kill-subdir)
- (dired-kill-line arg))
+ (dired-kill-subdir)
+ (dired-kill-line arg))
(save-excursion
(goto-char (point-min))
- (let (buffer-read-only
- (count 0)
- (regexp (dired-marker-regexp)))
- (while (and (not (eobp))
- (re-search-forward regexp nil t))
- (setq count (1+ count))
- (delete-region (line-beginning-position)
- (progn (forward-line 1) (point))))
- (or (equal "" fmt)
- (message (or fmt "Killed %d line%s.") count (dired-plural-s count)))
- count))))
-
-;;;###end dired-cmd.el
+ (let ((count (or init-count 0))
+ (regexp (dired-marker-regexp))
+ (inhibit-read-only t))
+ (while (and (not (eobp))
+ (re-search-forward regexp nil t))
+ (setq count (1+ count))
+ (delete-region (line-beginning-position)
+ (progn (forward-line 1) (point))))
+ (unless (equal "" fmt)
+ (message (or fmt "Killed %d line%s.") count (dired-plural-s count)))
+ count))))
+
-;;; 30K
-;;;###begin dired-cp.el
+;;; Compression
(defun dired-compress ()
;; Compress or uncompress the current file.
@@ -965,32 +1411,42 @@ command with a prefix argument (the value does not matter)."
(ignore-errors (dired-remove-entry new-file))
(goto-char start)
;; Now replace the current line with an entry for NEW-FILE.
- (dired-update-file-line new-file) nil)
- (dired-log (concat "Failed to compress" from-file))
+ ;; But don't remove the current line if either FROM-FILE or
+ ;; NEW-FILE is a directory, because compressing/uncompressing
+ ;; directories doesn't remove the original.
+ (if (or (file-directory-p from-file)
+ (file-directory-p new-file))
+ (dired-add-entry new-file nil t)
+ (dired-update-file-line new-file))
+ nil)
+ (dired-log (concat "Failed to (un)compress " from-file))
from-file)))
(defvar dired-compress-file-suffixes
'(
;; "tar -zxf" isn't used because it's not available on the
- ;; Solaris10 version of tar. Solaris10 becomes obsolete in 2021.
- ;; Same thing on AIX 7.1.
- ("\\.tar\\.gz\\'" "" "gzip -dc %i | tar -xv")
- ("\\.tgz\\'" "" "gzip -dc %i | tar -xv")
- ("\\.gz\\'" "" "gunzip")
+ ;; Solaris 10 version of tar (obsolete in 2024?).
+ ;; Same thing on AIX 7.1 (obsolete 2023?) and 7.2 (obsolete 2022?).
+ ("\\.tar\\.gz\\'" "" "gzip -dc %i | tar -xf -")
+ ("\\.tar\\.xz\\'" "" "xz -dc %i | tar -xf -")
+ ("\\.tgz\\'" "" "gzip -dc %i | tar -xf -")
+ ("\\.gz\\'" "" "gzip -d")
+ ("\\.lz\\'" "" "lzip -d")
("\\.Z\\'" "" "uncompress")
;; For .z, try gunzip. It might be an old gzip file,
;; or it might be from compact? pack? (which?) but gunzip handles both.
- ("\\.z\\'" "" "gunzip")
+ ("\\.z\\'" "" "gzip -d")
("\\.dz\\'" "" "dictunzip")
("\\.tbz\\'" ".tar" "bunzip2")
("\\.bz2\\'" "" "bunzip2")
("\\.xz\\'" "" "unxz")
("\\.zip\\'" "" "unzip -o -d %o %i")
+ ("\\.tar\\.zst\\'" "" "unzstd -c %i | tar -xf -")
+ ("\\.tzst\\'" "" "unzstd -c %i | tar -xf -")
+ ("\\.zst\\'" "" "unzstd --rm")
("\\.7z\\'" "" "7z x -aoa -o%o %i")
;; This item controls naming for compression.
- ("\\.tar\\'" ".tgz" nil)
- ;; This item controls the compression of directories
- (":" ".tar.gz" "tar -c %i | gzip -c9 > %o"))
+ ("\\.tar\\'" ".tgz" nil))
"Control changes in file name suffixes for compression and uncompression.
Each element specifies one transformation rule, and has the form:
(REGEXP NEW-SUFFIX PROGRAM)
@@ -1006,21 +1462,51 @@ output file.
Otherwise, the rule is a compression rule, and compression is done with gzip.
ARGS are command switches passed to PROGRAM.")
-(defvar dired-compress-files-alist
- '(("\\.tar\\.gz\\'" . "tar -c %i | gzip -c9 > %o")
- ("\\.tar\\.bz2\\'" . "tar -c %i | bzip2 -c9 > %o")
- ("\\.tar\\.xz\\'" . "tar -c %i | xz -c9 > %o")
- ("\\.zip\\'" . "zip %o -r --filesync %i"))
- "Control the compression shell command for `dired-do-compress-to'.
+(defcustom dired-compress-file-default-suffix nil
+ "Default suffix for compressing a single file.
+If nil, \".gz\" will be used."
+ :type '(choice (const :tag ".gz" nil) string)
+ :group 'dired
+ :version "28.1")
+
+(defvar dired-compress-file-alist
+ '(("\\.gz\\'" . "gzip -9f %i")
+ ("\\.bz2\\'" . "bzip2 -9f %i")
+ ("\\.xz\\'" . "xz -9f %i")
+ ("\\.zst\\'" . "zstd -qf -19 --rm -o %o %i"))
+ "Controls the compression shell command for `dired-do-compress-to'.
Each element is (REGEXP . CMD), where REGEXP is the name of the
-archive to which you want to compress, and CMD the the
+archive to which you want to compress, and CMD is the
corresponding command.
Within CMD, %i denotes the input file(s), and %o denotes the
-output file. %i path(s) are relative, while %o is absolute.")
+output file. %i path(s) are relative, while %o is absolute.")
-(declare-function format-spec "format-spec.el" (format specification))
+(defcustom dired-compress-directory-default-suffix nil
+ "Default suffix for compressing a directory.
+If nil, \".tar.gz\" will be used."
+ :type '(choice (const :tag ".tar.gz" nil) string)
+ :group 'dired
+ :version "28.1")
+
+(defvar dired-compress-files-alist
+ '(("\\.tar\\.gz\\'" . "tar -cf - %i | gzip -c9 > %o")
+ ("\\.tar\\.bz2\\'" . "tar -cf - %i | bzip2 -c9 > %o")
+ ("\\.tar\\.xz\\'" . "tar -cf - %i | xz -c9 > %o")
+ ("\\.tar\\.zst\\'" . "tar -cf - %i | zstd -19 -o %o")
+ ("\\.tar\\.lz\\'" . "tar -cf - %i | lzip -c9 > %o")
+ ("\\.tar\\.lzo\\'" . "tar -cf - %i | lzop -c9 > %o")
+ ("\\.zip\\'" . "zip %o -r --filesync %i")
+ ("\\.pax\\'" . "pax -wf %o %i"))
+ "Controls the compression shell command for `dired-do-compress-to'.
+
+Each element is (REGEXP . CMD), where REGEXP is the name of the
+archive to which you want to compress, and CMD is the
+corresponding command.
+
+Within CMD, %i denotes the input file(s), and %o denotes the
+output file. %i path(s) are relative, while %o is absolute.")
;;;###autoload
(defun dired-do-compress-to ()
@@ -1029,7 +1515,7 @@ Prompt for the archive file name.
Choose the archiving command based on the archive file-name extension
and `dired-compress-files-alist'."
(interactive)
- (let* ((in-files (dired-get-marked-files))
+ (let* ((in-files (dired-get-marked-files nil nil nil nil t))
(out-file (expand-file-name (read-file-name "Compress to: ")))
(rule (cl-find-if
(lambda (x)
@@ -1048,13 +1534,16 @@ and `dired-compress-files-alist'."
(when (zerop
(dired-shell-command
(format-spec (cdr rule)
- `((?\o . ,(shell-quote-argument out-file))
- (?\i . ,(mapconcat
- (lambda (file-desc)
- (shell-quote-argument (file-name-nondirectory
- file-desc)))
- in-files " "))))))
- (message "Compressed %d file(s) to %s"
+ `((?o . ,(shell-quote-argument
+ (file-local-name out-file)))
+ (?i . ,(mapconcat
+ (lambda (in-file)
+ (shell-quote-argument
+ (file-relative-name in-file)))
+ in-files " "))))))
+ (message (ngettext "Compressed %d file to %s"
+ "Compressed %d files to %s"
+ (length in-files))
(length in-files)
(file-name-nondirectory out-file)))))))
@@ -1086,58 +1575,91 @@ Return nil if no change in files."
(prog1 (setq newname (file-name-as-directory newname))
(dired-shell-command
(replace-regexp-in-string
- "%o" (shell-quote-argument newname)
+ "%o" (shell-quote-argument (file-local-name newname))
(replace-regexp-in-string
- "%i" (shell-quote-argument file)
+ "%i" (shell-quote-argument (file-local-name file))
command
nil t)
nil t)))
;; We found an uncompression rule.
- (when (not
- (dired-check-process
- (concat "Uncompressing " file)
- command
- file))
- newname)))
+ (let ((match (string-search " " command))
+ (msg (concat "Uncompressing " file)))
+ (unless (if match
+ (dired-check-process msg
+ (substring command 0 match)
+ (substring command (1+ match))
+ (file-local-name file))
+ (dired-check-process msg
+ command
+ (file-local-name file)))
+ newname))))
(t
;; We don't recognize the file as compressed, so compress it.
;; Try gzip; if we don't have that, use compress.
(condition-case nil
(if (file-directory-p file)
- (progn
- (setq suffix (cdr (assoc ":" dired-compress-file-suffixes)))
- (when suffix
- (let ((out-name (concat file (car suffix)))
- (default-directory (file-name-directory file)))
- (dired-shell-command
- (replace-regexp-in-string
- "%o" (shell-quote-argument out-name)
+ (let* ((suffix
+ (or dired-compress-directory-default-suffix
+ ".tar.gz"))
+ (rule (cl-find-if
+ (lambda (x) (string-match-p (car x) suffix))
+ dired-compress-files-alist)))
+ (if rule
+ (let ((out-name (concat file suffix))
+ (default-directory (file-name-directory file)))
+ (dired-shell-command
+ (replace-regexp-in-string
+ "%o" (shell-quote-argument
+ (file-local-name out-name))
+ (replace-regexp-in-string
+ "%i" (shell-quote-argument
+ (file-name-nondirectory file))
+ (cdr rule)
+ nil t)
+ nil t))
+ out-name)
+ (user-error
+ "No compression rule found for \
+`dired-compress-directory-default-suffix' %s, see `dired-compress-files-alist' for\
+ the supported suffixes list"
+ dired-compress-directory-default-suffix)))
+ (let* ((suffix (or dired-compress-file-default-suffix ".gz"))
+ (out-name (concat file suffix))
+ (rule (cl-find-if
+ (lambda (x) (string-match-p (car x) suffix))
+ dired-compress-file-alist)))
+ (if (not rule)
+ (user-error "No compression rule found for suffix %s, \
+see `dired-compress-file-alist' for the supported suffixes list"
+ dired-compress-file-default-suffix)
+ (and (file-exists-p file)
+ (or (not (file-exists-p out-name))
+ (y-or-n-p
+ (format
+ "File %s already exists. Really compress? "
+ out-name)))
+ (dired-shell-command
(replace-regexp-in-string
- "%i" (shell-quote-argument (file-name-nondirectory file))
- (cadr suffix)
- nil t)
- nil t))
- out-name)))
- (let ((out-name (concat file ".gz")))
- (and (or (not (file-exists-p out-name))
- (y-or-n-p
- (format "File %s already exists. Really compress? "
- out-name)))
- (not
- (dired-check-process (concat "Compressing " file)
- "gzip" "-f" file))
- (or (file-exists-p out-name)
- (setq out-name (concat file ".z")))
- ;; Rename the compressed file to NEWNAME
- ;; if it hasn't got that name already.
- (if (and newname (not (equal newname out-name)))
- (progn
- (rename-file out-name newname t)
- newname)
- out-name))))
+ "%o" (shell-quote-argument
+ (file-local-name out-name))
+ (replace-regexp-in-string
+ "%i" (shell-quote-argument (file-local-name file))
+ (cdr rule)
+ nil t)
+ nil t))
+ (or (file-exists-p out-name)
+ (setq out-name (concat file ".z")))
+ ;; Rename the compressed file to NEWNAME
+ ;; if it hasn't got that name already.
+ (if (and newname (not (equal newname out-name)))
+ (progn
+ (rename-file out-name newname t)
+ newname)
+ out-name)))))
(file-error
(if (not (dired-check-process (concat "Compressing " file)
- "compress" "-f" file))
+ "compress" "-f"
+ (file-local-name file)))
;; Don't use NEWNAME with `compress'.
(concat file ".Z"))))))))
@@ -1152,7 +1674,7 @@ Return nil if no change in files."
;; Pass t for DISTINGUISH-ONE-MARKED so that a single file which
;; is marked pops up a window. That will help the user see
;; it isn't the current line file.
- (let ((files (dired-get-marked-files t arg nil t))
+ (let ((files (dired-get-marked-files t arg nil t t))
(string (if (eq op-symbol 'compress) "Compress or uncompress"
(capitalize (symbol-name op-symbol)))))
(dired-mark-pop-up nil op-symbol files #'y-or-n-p
@@ -1160,19 +1682,19 @@ Return nil if no change in files."
(dired-mark-prompt arg files) "? ")))))
(defun dired-map-over-marks-check (fun arg op-symbol &optional show-progress)
-; "Map FUN over marked files (with second ARG like in dired-map-over-marks)
-; and display failures.
+ ;; "Map FUN over marked files (with second ARG like in dired-map-over-marks)
+ ;; and display failures.
-; FUN takes zero args. It returns non-nil (the offending object, e.g.
-; the short form of the filename) for a failure and probably logs a
-; detailed error explanation using function `dired-log'.
+ ;; FUN takes zero args. It returns non-nil (the offending object, e.g.
+ ;; the short form of the filename) for a failure and probably logs a
+ ;; detailed error explanation using function `dired-log'.
-; OP-SYMBOL is a symbol describing the operation performed (e.g.
-; `compress'). It is used with `dired-mark-pop-up' to prompt the user
-; (e.g. with `Compress * [2 files]? ') and to display errors (e.g.
-; `Failed to compress 1 of 2 files - type W to see why ("foo")')
+ ;; OP-SYMBOL is a symbol describing the operation performed (e.g.
+ ;; `compress'). It is used with `dired-mark-pop-up' to prompt the user
+ ;; (e.g. with `Compress * [2 files]? ') and to display errors (e.g.
+ ;; `Failed to compress 1 of 2 files - type W to see why ("foo")')
-; SHOW-PROGRESS if non-nil means redisplay dired after each file."
+ ;; SHOW-PROGRESS if non-nil means redisplay dired after each file."
(if (dired-mark-confirm op-symbol arg)
(let* ((total-list;; all of FUN's return values
(dired-map-over-marks (funcall fun) arg show-progress))
@@ -1182,12 +1704,14 @@ Return nil if no change in files."
(string (if (eq op-symbol 'compress) "Compress or uncompress"
(capitalize (symbol-name op-symbol)))))
(if (not failures)
- (message "%s: %d file%s."
- string total (dired-plural-s total))
+ (message (ngettext "%s: %d file." "%s: %d files." total)
+ string total)
;; end this bunch of errors:
(dired-log-summary
- (format "Failed to %s %d of %d file%s"
- (downcase string) count total (dired-plural-s total))
+ (format (ngettext "Failed to %s %d of %d file"
+ "Failed to %s %d of %d files"
+ total)
+ (downcase string) count total)
failures)))))
;;;###autoload
@@ -1221,11 +1745,17 @@ return t; if SYM is q or ESC, return nil."
;;;###autoload
(defun dired-do-compress (&optional arg)
- "Compress or uncompress marked (or next ARG) files."
+ "Compress or uncompress marked (or next ARG) files.
+If invoked on a directory, compress all of the files in
+the directory and all of its subdirectories, recursively,
+into a .tar.gz archive.
+If invoked on a .tar.gz or a .tgz or a .zip or a .7z archive,
+uncompress and unpack all the files in the archive."
(interactive "P")
(dired-map-over-marks-check #'dired-compress arg 'compress t))
-;; Commands for Emacs Lisp files - load and byte compile
+
+;;; Commands for Emacs Lisp files - load and byte compile
(defun dired-byte-compile ()
;; Return nil for success, offending file name else.
@@ -1257,7 +1787,7 @@ return t; if SYM is q or ESC, return nil."
;; Return nil for success, offending file name else.
(let ((file (dired-get-filename)) failure)
(condition-case err
- (load file nil nil t)
+ (load file nil nil t)
(error (setq failure err)))
(if (not failure)
nil
@@ -1317,6 +1847,7 @@ See Info node `(emacs)Subdir switches' for more details."
(interactive)
(setq dired-switches-alist nil)
(revert-buffer))
+
(defun dired-update-file-line (file)
;; Delete the current line, and insert an entry for FILE.
@@ -1334,7 +1865,7 @@ See Info node `(emacs)Subdir switches' for more details."
;; Replace space by old marker without moving point.
;; Faster than goto+insdel inside a save-excursion?
(when char
- (subst-char-in-region opoint (1+ opoint) ?\040 char)))))
+ (subst-char-in-region opoint (1+ opoint) ?\s char)))))
(dired-move-to-filename))
;;;###autoload
@@ -1388,8 +1919,8 @@ files matching `dired-omit-regexp'."
(catch 'not-found
(if (string= directory cur-dir)
(progn
- (skip-chars-forward "^\r\n")
- (if (eq (following-char) ?\r)
+ (end-of-line)
+ (if (dired--hidden-p)
(dired-unhide-subdir))
;; We are already where we should be, except when
;; point is before the subdir line or its total line.
@@ -1399,7 +1930,7 @@ files matching `dired-omit-regexp'."
;; else try to find correct place to insert
(if (dired-goto-subdir directory)
(progn ;; unhide if necessary
- (if (= (following-char) ?\r)
+ (if (dired--hidden-p)
;; Point is at end of subdir line.
(dired-unhide-subdir))
;; found - skip subdir and `total' line
@@ -1471,22 +2002,18 @@ files matching `dired-omit-regexp'."
(forward-line 1)
(while (and (not (eolp)) ; don't cross subdir boundary
(not (dired-move-to-filename)))
- (forward-line 1))
+ (forward-line 1))
(point)))
;;;###autoload
(defun dired-remove-file (file)
+ "Remove entry FILE on each dired buffer.
+Note this doesn't delete FILE in the file system.
+See `dired-delete-file' in case you wish that."
(dired-fun-in-all-buffers
(file-name-directory file) (file-name-nondirectory file)
#'dired-remove-entry file))
-(defun dired-remove-entry (file)
- (save-excursion
- (and (dired-goto-file file)
- (let (buffer-read-only)
- (delete-region (progn (beginning-of-line) (point))
- (line-beginning-position 2))))))
-
;;;###autoload
(defun dired-relist-file (file)
"Create or update the line for FILE in all Dired buffers it would belong in."
@@ -1508,7 +2035,8 @@ files matching `dired-omit-regexp'."
(point))
(line-beginning-position 2)))
(setq file (directory-file-name file))
- (dired-add-entry file (if (eq ?\040 marker) nil marker)))))
+ (dired-add-entry file (if (eq ?\s marker) nil marker)))))
+
;;; Copy, move/rename, making hard and symbolic links
@@ -1544,43 +2072,118 @@ Special value `always' suppresses confirmation."
(defun dired-copy-file (from to ok-flag)
(dired-handle-overwrite to)
(dired-copy-file-recursive from to ok-flag dired-copy-preserve-time t
- dired-recursive-copies))
+ dired-recursive-copies dired-copy-dereference))
(declare-function make-symbolic-link "fileio.c")
+(defcustom dired-create-destination-dirs nil
+ "Whether Dired should create destination dirs when copying/removing files.
+If nil, don't create them.
+If `always', create them without asking.
+If `ask', ask for user confirmation.
+
+Also see `dired-create-destination-dirs-on-trailing-dirsep'."
+ :type '(choice (const :tag "Never create non-existent dirs" nil)
+ (const :tag "Always create non-existent dirs" always)
+ (const :tag "Ask for user confirmation" ask))
+ :group 'dired
+ :version "27.1")
+
+(defcustom dired-create-destination-dirs-on-trailing-dirsep nil
+ "If non-nil, treat a trailing slash at queried destination dir specially.
+
+If this variable is non-nil and a single destination filename is
+queried which ends in a directory separator (/), it will be
+treated as a non-existent directory and acted on according to
+`dired-create-destination-dirs'.
+
+This option is only relevant if `dired-create-destination-dirs'
+is non-nil, too.
+
+For example, if both `dired-create-destination-dirs' and this
+option are non-nil, renaming a directory named `old_name' to
+`new_name/' (note the trailing directory separator) where
+`new_name' does not exists already, it will be created and
+`old_name' be moved into it. If only `new_name' (without the
+trailing /) is given or this option or
+`dired-create-destination-dirs' is `nil', `old_name' will be
+renamed to `new_name'."
+ :type '(choice
+ (const :tag
+ (concat "Do not treat destination dirs with a "
+ "trailing directory separator specially")
+ nil)
+ (const :tag
+ (concat "Treat destination dirs with trailing "
+ "directory separator specially")
+ t))
+ :group 'dired
+ :version "29.1")
+
+(defun dired-maybe-create-dirs (dir)
+ "Create DIR if doesn't exist according to `dired-create-destination-dirs'."
+ (when (and dired-create-destination-dirs (not (file-exists-p dir)))
+ (if (or (eq dired-create-destination-dirs 'always)
+ (yes-or-no-p (format "Create destination dir `%s'? " dir)))
+ (dired-create-directory dir))))
+
(defun dired-copy-file-recursive (from to ok-flag &optional
- preserve-time top recursive)
- (when (and (eq t (car (file-attributes from)))
+ preserve-time top recursive
+ dereference)
+ (when (and (eq t (file-attribute-type (file-attributes from)))
(file-in-directory-p to from))
(error "Cannot copy `%s' into its subdirectory `%s'" from to))
(let ((attrs (file-attributes from)))
(if (and recursive
- (eq t (car attrs))
+ (eq t (file-attribute-type attrs))
(or (eq recursive 'always)
- (yes-or-no-p (format "Recursive copies of %s? " from))))
+ (yes-or-no-p (format "Copy %s recursively? " from))))
(copy-directory from to preserve-time)
(or top (dired-handle-overwrite to))
(condition-case err
- (if (stringp (car attrs))
+ (if (and (not dereference)
+ (stringp (file-attribute-type attrs)))
;; It is a symlink
- (make-symbolic-link (car attrs) to ok-flag)
+ (make-symbolic-link (file-attribute-type attrs) to ok-flag)
+ (dired-maybe-create-dirs (file-name-directory to))
(copy-file from to ok-flag preserve-time))
(file-date-error
(push (dired-make-relative from)
dired-create-files-failures)
(dired-log "Can't set date on %s:\n%s\n" from err))))))
+(defcustom dired-vc-rename-file nil
+ "Whether Dired should register file renaming in underlying vc system.
+If nil, use default `rename-file'.
+If non-nil and the renamed files are under version control,
+rename them using `vc-rename-file'."
+ :type '(choice (const :tag "Use rename-file" nil)
+ (const :tag "Use vc-rename-file" t))
+ :group 'dired
+ :version "27.1")
+
;;;###autoload
(defun dired-rename-file (file newname ok-if-already-exists)
- (dired-handle-overwrite newname)
- (rename-file file newname ok-if-already-exists) ; error is caught in -create-files
- ;; Silently rename the visited file of any buffer visiting this file.
- (and (get-file-buffer file)
- (with-current-buffer (get-file-buffer file)
- (set-visited-file-name newname nil t)))
- (dired-remove-file file)
- ;; See if it's an inserted subdir, and rename that, too.
- (dired-rename-subdir file newname))
+ "Rename FILE to NEWNAME.
+Signal a `file-already-exists' error if a file NEWNAME already exists
+unless OK-IF-ALREADY-EXISTS is non-nil."
+ (let ((file-is-dir-p (file-directory-p file)))
+ (dired-handle-overwrite newname)
+ (dired-maybe-create-dirs (file-name-directory newname))
+ (if (and dired-vc-rename-file
+ (vc-backend file)
+ (ignore-errors (vc-responsible-backend newname)))
+ (vc-rename-file file newname)
+ ;; error is caught in -create-files
+ (rename-file file newname ok-if-already-exists))
+ ;; Silently rename the visited file of any buffer visiting this file.
+ (and (get-file-buffer file)
+ (with-current-buffer (get-file-buffer file)
+ (set-visited-file-name newname nil t)))
+ (dired-remove-file file)
+ ;; See if it's an inserted subdir, and rename that, too.
+ (when file-is-dir-p
+ (dired-rename-subdir file newname))))
(defun dired-rename-subdir (from-dir to-dir)
(setq from-dir (file-name-as-directory from-dir)
@@ -1593,9 +2196,9 @@ Special value `always' suppresses confirmation."
(while blist
(with-current-buffer (car blist)
(if (and buffer-file-name
- (dired-in-this-tree buffer-file-name expanded-from-dir))
+ (dired-in-this-tree-p buffer-file-name expanded-from-dir))
(let ((modflag (buffer-modified-p))
- (to-file (dired-replace-in-string
+ (to-file (replace-regexp-in-string
(concat "^" (regexp-quote from-dir))
to-dir
buffer-file-name)))
@@ -1612,7 +2215,7 @@ Special value `always' suppresses confirmation."
(while alist
(setq elt (car alist)
alist (cdr alist))
- (if (dired-in-this-tree (car elt) expanded-dir)
+ (if (dired-in-this-tree-p (car elt) expanded-dir)
;; ELT's subdir is affected by the rename
(dired-rename-subdir-2 elt dir to)))
(if (equal dir default-directory)
@@ -1647,7 +2250,7 @@ Special value `always' suppresses confirmation."
(let ((regexp (regexp-quote (directory-file-name dir)))
(newtext (directory-file-name to))
buffer-read-only)
- (goto-char (dired-get-subdir-min elt))
+ (goto-char (cdr elt))
;; Update subdir headerline in buffer
(if (not (looking-at dired-subdir-regexp))
(error "%s not found where expected - dired-subdir-alist broken?"
@@ -1659,7 +2262,7 @@ Special value `always' suppresses confirmation."
;; Update buffer-local dired-subdir-alist and dired-switches-alist
(let ((cons (assoc-string (car elt) dired-switches-alist))
(cur-dir (dired-normalize-subdir
- (dired-replace-in-string regexp newtext (car elt)))))
+ (replace-regexp-in-string regexp newtext (car elt)))))
(setcar elt cur-dir)
(when cons (setcar cons cur-dir))))))
@@ -1667,7 +2270,9 @@ Special value `always' suppresses confirmation."
(defvar overwrite-query)
(defvar overwrite-backup-query)
-;; The basic function for half a dozen variations on cp/mv/ln/ln -s.
+
+;;; The basic function for half a dozen variations on cp/mv/ln/ln -s
+
(defun dired-create-files (file-creator operation fn-list name-constructor
&optional marker-char)
"Create one or more new files from a list of existing files FN-LIST.
@@ -1697,6 +2302,9 @@ or with the current marker character if MARKER-CHAR is t."
(let (to overwrite-query
overwrite-backup-query) ; for dired-handle-overwrite
(dolist (from fn-list)
+ ;; Position point on the current file -- this is useful if
+ ;; handling a number of files to show where we're working at.
+ (dired-goto-file from)
(setq to (funcall name-constructor from))
(if (equal to from)
(progn
@@ -1708,11 +2316,12 @@ or with the current marker character if MARKER-CHAR is t."
(let* ((overwrite (file-exists-p to))
(dired-overwrite-confirmed ; for dired-handle-overwrite
(and overwrite
- (let ((help-form '(format-message "\
-Type SPC or `y' to overwrite file `%s',
-DEL or `n' to skip to next,
-ESC or `q' to not overwrite any of the remaining files,
-`!' to overwrite all remaining files with no more questions." to)))
+ (let ((help-form (format-message
+ (substitute-command-keys "\
+Type \\`SPC' or \\`y' to overwrite file `%s',
+\\`DEL' or \\`n' to skip to next,
+\\`ESC' or \\`q' to not overwrite any of the remaining files,
+\\`!' to overwrite all remaining files with no more questions.") to)))
(dired-query 'overwrite-query
"Overwrite `%s'?" to))))
;; must determine if FROM is marked before file-creator
@@ -1742,11 +2351,16 @@ ESC or `q' to not overwrite any of the remaining files,
(setq to destname))
;; If DESTNAME is a subdirectory of FROM, not a symlink,
;; and the method in use is copying, signal an error.
- (and (eq t (car (file-attributes destname)))
+ (and (eq t (file-attribute-type (file-attributes destname)))
(eq file-creator 'dired-copy-file)
(file-in-directory-p destname from)
(error "Cannot copy `%s' into its subdirectory `%s'"
from to)))
+ ;; Check, that `dired-do-symlink' does not create symlinks
+ ;; on different hosts.
+ (when (and (eq file-creator 'make-symbolic-link)
+ (not (equal (file-remote-p from) (file-remote-p to))))
+ (error "Cannot symlink `%s' to `%s' on another host" from to))
(condition-case err
(progn
(funcall file-creator from to dired-overwrite-confirmed)
@@ -1762,34 +2376,58 @@ ESC or `q' to not overwrite any of the remaining files,
(progn
(push (dired-make-relative from)
failures)
- (dired-log "%s `%s' to `%s' failed:\n%s\n"
+ (dired-log "%s: `%s' to `%s' failed:\n%s\n"
operation from to err))))))))
(cond
(dired-create-files-failures
(setq failures (nconc failures dired-create-files-failures))
(dired-log-summary
- (format "%s failed for %d file%s in %d requests"
- operation (length failures)
- (dired-plural-s (length failures))
- total)
+ (format (ngettext "%s failed for %d file in %d requests"
+ "%s failed for %d files in %d requests"
+ (length failures))
+ operation (length failures) total)
failures))
(failures
(dired-log-summary
- (format "%s failed for %d of %d file%s"
- operation (length failures)
- total (dired-plural-s total))
+ (format (ngettext "%s: %d of %d file failed"
+ "%s: %d of %d files failed"
+ total)
+ operation (length failures) total)
failures))
(skipped
(dired-log-summary
- (format "%s: %d of %d file%s skipped"
- operation (length skipped) total
- (dired-plural-s total))
+ (format (ngettext "%s: %d of %d file skipped"
+ "%s: %d of %d files skipped"
+ total)
+ operation (length skipped) total)
skipped))
(t
- (message "%s: %s file%s"
- operation success-count (dired-plural-s success-count)))))
+ (message (ngettext "%s: %d file done"
+ "%s: %d files done"
+ success-count)
+ operation success-count))))
(dired-move-to-filename))
+
+(defcustom dired-do-revert-buffer nil
+ "Automatically revert Dired buffers after `dired-do' operations.
+This option controls whether to refresh the directory listing in a
+Dired buffer that is the destination of one of these operations:
+`dired-do-copy', `dired-do-rename', `dired-do-symlink', `dired-do-hardlink'.
+If the value is t, always revert the Dired buffer updated in the result
+of these operations.
+If the value is a function, it is called with the destination directory name
+as a single argument, and the buffer is reverted after Dired operations
+if the function returns non-nil."
+ :type '(choice
+ (const :tag "Don't revert" nil)
+ (const :tag "Always revert destination directory" t)
+ (const :tag "Revert only local Dired buffers"
+ (lambda (dir) (not (file-remote-p dir))))
+ (function :tag "Predicate function"))
+ :group 'dired
+ :version "28.1")
+
(defun dired-do-create-files (op-symbol file-creator operation arg
&optional marker-char op1
how-to)
@@ -1799,18 +2437,23 @@ Prompt user for a target directory in which to create the new
one file is marked. The initial suggestion for target is the
Dired buffer's current directory (or, if `dired-dwim-target' is
non-nil, the current directory of a neighboring Dired window).
+
OP-SYMBOL is the symbol for the operation. Function `dired-mark-pop-up'
will determine whether pop-ups are appropriate for this OP-SYMBOL.
+
FILE-CREATOR and OPERATION as in `dired-create-files'.
+
ARG as in `dired-get-marked-files'.
+
Optional arg MARKER-CHAR as in `dired-create-files'.
+
Optional arg OP1 is an alternate form for OPERATION if there is
only one file.
+
Optional arg HOW-TO determines how to treat the target.
If HOW-TO is nil, use `file-directory-p' to determine if the
target is a directory. If so, the marked file(s) are created
- inside that directory. Otherwise, the target is a plain file;
- an error is raised unless there is exactly one marked file.
+ inside that directory.
If HOW-TO is t, target is always treated as a plain file.
Otherwise, HOW-TO should be a function of one argument, TARGET.
If its return value is nil, TARGET is regarded as a plain file.
@@ -1821,10 +2464,16 @@ Optional arg HOW-TO determines how to treat the target.
rfn-list - list of the relative names for the marked files.
fn-list - list of the absolute names for the marked files.
target - the name of the target itself.
- The rest of into-dir are optional arguments.
+ The rest of elements of the list returned by HOW-TO are optional
+ arguments for the function that is the first element of the list.
+
+ This can be useful because by default, copying a single file
+ would replace the tar file. But this could be overridden to
+ add or replace entries in the tar file.
+
For any other return value, TARGET is treated as a directory."
(or op1 (setq op1 operation))
- (let* ((fn-list (dired-get-marked-files nil arg))
+ (let* ((fn-list (dired-get-marked-files nil arg nil nil t))
(rfn-list (mapcar #'dired-make-relative fn-list))
(dired-one-file ; fluid variable inside dired-create-files
(and (consp fn-list) (null (cdr fn-list)) (car fn-list)))
@@ -1837,48 +2486,73 @@ Optional arg HOW-TO determines how to treat the target.
(target (expand-file-name ; fluid variable inside dired-create-files
(minibuffer-with-setup-hook
(lambda ()
- (set (make-local-variable 'minibuffer-default-add-function) nil)
+ (setq-local minibuffer-default-add-function nil)
(setq minibuffer-default defaults))
(dired-mark-read-file-name
- (concat (if dired-one-file op1 operation) " %s to: ")
+ (format "%s %%s %s: "
+ (if dired-one-file op1 operation)
+ (if (memq op-symbol '(symlink hardlink))
+ ;; Linking operations create links
+ ;; from the prompted file name; the
+ ;; other operations copy (etc) to the
+ ;; prompted file name.
+ "from" "to"))
target-dir op-symbol arg rfn-list default))))
- (into-dir (cond ((null how-to)
- ;; Allow users to change the letter case of
- ;; a directory on a case-insensitive
- ;; filesystem. If we don't test these
- ;; conditions up front, file-directory-p
- ;; below will return t on a case-insensitive
- ;; filesystem, and Emacs will try to move
- ;; foo -> foo/foo, which fails.
- (if (and (file-name-case-insensitive-p (car fn-list))
- (eq op-symbol 'move)
- dired-one-file
- (string= (downcase
- (expand-file-name (car fn-list)))
- (downcase
- (expand-file-name target)))
- (not (string=
- (file-name-nondirectory (car fn-list))
- (file-name-nondirectory target))))
- nil
- (file-directory-p target)))
- ((eq how-to t) nil)
- (t (funcall how-to target)))))
+ (into-dir
+ (progn
+ (when
+ (or
+ (not dired-one-file)
+ (and dired-create-destination-dirs-on-trailing-dirsep
+ (directory-name-p target)))
+ (dired-maybe-create-dirs target))
+ (cond ((null how-to)
+ ;; Allow users to change the letter case of
+ ;; a directory on a case-insensitive
+ ;; filesystem. If we don't test these
+ ;; conditions up front, file-directory-p
+ ;; below will return t on a case-insensitive
+ ;; filesystem, and Emacs will try to move
+ ;; foo -> foo/foo, which fails.
+ (if (and (file-name-case-insensitive-p (car fn-list))
+ (eq op-symbol 'move)
+ dired-one-file
+ (string= (downcase
+ (expand-file-name (car fn-list)))
+ (downcase
+ (expand-file-name target)))
+ (not (string=
+ (file-name-nondirectory (car fn-list))
+ (file-name-nondirectory target))))
+ nil
+ (file-directory-p target)))
+ ((eq how-to t) nil)
+ (t (funcall how-to target))))))
(if (and (consp into-dir) (functionp (car into-dir)))
(apply (car into-dir) operation rfn-list fn-list target (cdr into-dir))
(if (not (or dired-one-file into-dir))
(error "Marked %s: target must be a directory: %s" operation target))
+ (if (and (not (file-directory-p (car fn-list)))
+ (not (file-directory-p target))
+ (directory-name-p target))
+ (error "%s: Target directory does not exist: %s" operation target))
;; rename-file bombs when moving directories unless we do this:
(or into-dir (setq target (directory-file-name target)))
- (dired-create-files
- file-creator operation fn-list
- (if into-dir ; target is a directory
- ;; This function uses fluid variable target when called
- ;; inside dired-create-files:
- (lambda (from)
- (expand-file-name (file-name-nondirectory from) target))
- (lambda (_from) target))
- marker-char))))
+ (prog1
+ (dired-create-files
+ file-creator operation fn-list
+ (if into-dir ; target is a directory
+ ;; This function uses fluid variable target when called
+ ;; inside dired-create-files:
+ (lambda (from)
+ (expand-file-name (file-name-nondirectory from) target))
+ (lambda (_from) target))
+ marker-char)
+ (when (or (eq dired-do-revert-buffer t)
+ (and (functionp dired-do-revert-buffer)
+ (funcall dired-do-revert-buffer target)))
+ (dired-fun-in-all-buffers (file-name-directory target) nil
+ #'revert-buffer))))))
;; Read arguments for a marked-files command that wants a file name,
;; perhaps popping up the list of marked files.
@@ -1896,6 +2570,37 @@ Optional arg HOW-TO determines how to treat the target.
#'read-file-name
(format prompt (dired-mark-prompt arg files)) dir default))
+(defun dired-dwim-target-directories ()
+ (if (functionp dired-dwim-target)
+ (funcall dired-dwim-target)
+ (dired-dwim-target-next)))
+
+(defun dired-dwim-target-next (&optional all-frames)
+ ;; Return directories from all next windows with dired-mode buffers.
+ (mapcan (lambda (w)
+ (with-current-buffer (window-buffer w)
+ (when (eq major-mode 'dired-mode)
+ (list (dired-current-directory)))))
+ (delq (selected-window) (window-list-1
+ (next-window nil 'nomini all-frames)
+ 'nomini all-frames))))
+
+(defun dired-dwim-target-next-visible ()
+ ;; Return directories from all next visible windows with dired-mode buffers.
+ (dired-dwim-target-next 'visible))
+
+(defun dired-dwim-target-recent ()
+ ;; Return directories from all visible windows with dired-mode buffers
+ ;; ordered by most-recently-used.
+ (mapcar #'cdr (sort (mapcan (lambda (w)
+ (with-current-buffer (window-buffer w)
+ (when (eq major-mode 'dired-mode)
+ (list (cons (window-use-time w)
+ (dired-current-directory))))))
+ (delq (selected-window)
+ (window-list-1 nil 'nomini 'visible)))
+ (lambda (a b) (> (car a) (car b))))))
+
(defun dired-dwim-target-directory ()
;; Try to guess which target directory the user may want.
;; If there is a dired buffer displayed in one of the next windows,
@@ -1904,15 +2609,7 @@ Optional arg HOW-TO determines how to treat the target.
(dired-current-directory))))
;; non-dired buffer may want to profit from this function, e.g. vm-uudecode
(if dired-dwim-target
- (let* ((other-win (get-window-with-predicate
- (lambda (window)
- (with-current-buffer (window-buffer window)
- (eq major-mode 'dired-mode)))))
- (other-dir (and other-win
- (with-current-buffer (window-buffer other-win)
- (and (eq major-mode 'dired-mode)
- (dired-current-directory))))))
- (or other-dir this-dir))
+ (or (car (dired-dwim-target-directories)) this-dir)
this-dir)))
(defun dired-dwim-target-defaults (fn-list target-dir)
@@ -1930,15 +2627,11 @@ Optional arg HOW-TO determines how to treat the target.
(and (consp fn-list) (null (cdr fn-list)) (car fn-list)))
(current-dir (and (eq major-mode 'dired-mode)
(dired-current-directory)))
- dired-dirs)
- ;; Get a list of directories of visible buffers in dired-mode.
- (walk-windows (lambda (w)
- (with-current-buffer (window-buffer w)
- (and (eq major-mode 'dired-mode)
- (push (dired-current-directory) dired-dirs)))))
+ ;; Get a list of directories of visible buffers in dired-mode.
+ (dired-dirs (dired-dwim-target-directories)))
;; Force the current dir to be the first in the list.
(setq dired-dirs
- (delete-dups (delq nil (cons current-dir (nreverse dired-dirs)))))
+ (delete-dups (delq nil (cons current-dir dired-dirs))))
;; Remove the target dir (if specified) or the current dir from
;; default values, because it should be already in initial input.
(setq dired-dirs (delete (or target-dir current-dir) dired-dirs))
@@ -1962,25 +2655,52 @@ Optional arg HOW-TO determines how to treat the target.
dired-dirs)))
+;; We use this function in `dired-create-directory' and
+;; `dired-create-empty-file'; the return value is the new entry
+;; in the updated Dired buffer.
+(defun dired--find-topmost-parent-dir (filename)
+ "Return the topmost nonexistent parent dir of FILENAME.
+FILENAME is a full file name."
+ (let ((try filename) new)
+ (while (and try (not (file-exists-p try)) (not (equal new try)))
+ (setq new try
+ try (directory-file-name (file-name-directory try))))
+ new))
+
;;;###autoload
(defun dired-create-directory (directory)
"Create a directory called DIRECTORY.
+Parent directories of DIRECTORY are created as needed.
If DIRECTORY already exists, signal an error."
(interactive
(list (read-file-name "Create directory: " (dired-current-directory))))
(let* ((expanded (directory-file-name (expand-file-name directory)))
- (try expanded) new)
+ new)
(if (file-exists-p expanded)
(error "Cannot create directory %s: file exists" expanded))
- ;; Find the topmost nonexistent parent dir (variable `new')
- (while (and try (not (file-exists-p try)) (not (equal new try)))
- (setq new try
- try (directory-file-name (file-name-directory try))))
+ (setq new (dired--find-topmost-parent-dir expanded))
(make-directory expanded t)
(when new
(dired-add-file new)
(dired-move-to-filename))))
+;;;###autoload
+(defun dired-create-empty-file (file)
+ "Create an empty file called FILE.
+Add a new entry for the new file in the Dired buffer.
+Parent directories of FILE are created as needed.
+If FILE already exists, signal an error."
+ (interactive (list (read-file-name "Create empty file: ")))
+ (let* ((expanded (expand-file-name file))
+ new)
+ (if (file-exists-p expanded)
+ (error "Cannot create file %s: file exists" expanded))
+ (setq new (dired--find-topmost-parent-dir expanded))
+ (make-empty-file file 'parents)
+ (when new
+ (dired-add-file new)
+ (dired-move-to-filename))))
+
(defun dired-into-dir-with-symlinks (target)
(and (file-directory-p target)
(not (file-symlink-p target))))
@@ -1999,11 +2719,14 @@ If DIRECTORY already exists, signal an error."
(defvar dired-copy-how-to-fn nil
"Either nil or a function used by `dired-do-copy' to determine target.
-See HOW-TO argument for `dired-do-create-files'.")
+See HOW-TO argument for `dired-do-create-files' for an explanation.")
;;;###autoload
(defun dired-do-copy (&optional arg)
"Copy all marked (or next ARG) files, or copy the current file.
+ARG has to be numeric for above functionality. See
+`dired-get-marked-files' for more details.
+
When operating on just the current file, prompt for the new name.
When operating on multiple or marked files, prompt for a target
@@ -2017,10 +2740,24 @@ If `dired-copy-preserve-time' is non-nil, this command preserves
the modification time of each old file in the copy, similar to
the \"-p\" option for the \"cp\" shell command.
-This command copies symbolic links by creating new ones, similar
-to the \"-d\" option for the \"cp\" shell command."
+The `dired-keep-marker-copy' user option controls how this
+command handles file marking. The default is to mark all new
+copies of files with a \"C\" mark.
+
+This command copies symbolic links by creating new ones,
+similar to the \"-d\" option for the \"cp\" shell command.
+But if `dired-copy-dereference' is non-nil, the symbolic
+links are dereferenced and then copied, similar to the \"-L\"
+option for the \"cp\" shell command. If ARG is a cons with
+element 4 (`\\[universal-argument]'), the inverted value of
+`dired-copy-dereference' will be used.
+
+Also see `dired-do-revert-buffer'."
(interactive "P")
- (let ((dired-recursive-copies dired-recursive-copies))
+ (let ((dired-recursive-copies dired-recursive-copies)
+ (dired-copy-dereference (if (equal arg '(4))
+ (not dired-copy-dereference)
+ dired-copy-dereference)))
(dired-do-create-files 'copy #'dired-copy-file
"Copy"
arg dired-keep-marker-copy
@@ -2036,10 +2773,79 @@ with the same names that the files currently have. The default
suggested for the target directory depends on the value of
`dired-dwim-target', which see.
-For relative symlinks, use \\[dired-do-relsymlink]."
+For relative symlinks, use \\[dired-do-relsymlink].
+
+Also see `dired-do-revert-buffer'."
(interactive "P")
(dired-do-create-files 'symlink #'make-symbolic-link
- "Symlink" arg dired-keep-marker-symlink))
+ "Symlink" arg dired-keep-marker-symlink))
+
+;;;###autoload
+(defun dired-do-relsymlink (&optional arg)
+ "Relative symlink all marked (or next ARG) files into a directory.
+Otherwise make a relative symbolic link to the current file.
+This creates relative symbolic links like
+
+ foo -> ../bar/foo
+
+not absolute ones like
+
+ foo -> /ugly/file/name/that/may/change/any/day/bar/foo
+
+For absolute symlinks, use \\[dired-do-symlink]."
+ (interactive "P")
+ (dired-do-create-files 'relsymlink #'dired-make-relative-symlink
+ "RelSymLink" arg dired-keep-marker-relsymlink))
+
+(defun dired-make-relative-symlink (file1 file2 &optional ok-if-already-exists)
+ "Make a symbolic link (pointing to FILE1) in FILE2.
+The link is relative (if possible), for example
+
+ \"/vol/tex/bin/foo\" \"/vol/local/bin/foo\"
+
+results in
+
+ \"../../tex/bin/foo\" \"/vol/local/bin/foo\""
+ (interactive "FRelSymLink: \nFRelSymLink %s: \np")
+ (let (name1 name2 len1 len2 (index 0) sub)
+ (setq file1 (expand-file-name file1)
+ file2 (expand-file-name file2)
+ len1 (length file1)
+ len2 (length file2))
+ ;; Find common initial file name components:
+ (let (next)
+ (while (and (setq next (string-search "/" file1 index))
+ (< (setq next (1+ next)) (min len1 len2))
+ ;; For the comparison, both substrings must end in
+ ;; `/', so NEXT is *one plus* the result of the
+ ;; string-search.
+ ;; E.g., consider the case of linking "/tmp/a/abc"
+ ;; to "/tmp/abc" erroneously giving "/tmp/a" instead
+ ;; of "/tmp/" as common initial component
+ (string-equal (substring file1 0 next)
+ (substring file2 0 next)))
+ (setq index next))
+ (setq name2 file2
+ sub (substring file1 0 index)
+ name1 (substring file1 index)))
+ (if (string-equal sub "/")
+ ;; No common initial file name found
+ (setq name1 file1)
+ ;; Else they have a common parent directory
+ (let ((tem (substring file2 index))
+ (start 0)
+ (count 0))
+ ;; Count number of slashes we must compensate for ...
+ (while (setq start (string-search "/" tem start))
+ (setq count (1+ count)
+ start (1+ start)))
+ ;; ... and prepend a "../" for each slash found:
+ (dotimes (_ count)
+ (setq name1 (concat "../" name1)))))
+ (make-symbolic-link
+ (directory-file-name name1) ; must not link to foo/
+ ; (trailing slash!)
+ name2 ok-if-already-exists)))
;;;###autoload
(defun dired-do-hardlink (&optional arg)
@@ -2049,10 +2855,12 @@ When operating on multiple or marked files, you specify a directory
and new hard links are made in that directory
with the same names that the files currently have. The default
suggested for the target directory depends on the value of
-`dired-dwim-target', which see."
+`dired-dwim-target', which see.
+
+Also see `dired-do-revert-buffer'."
(interactive "P")
(dired-do-create-files 'hardlink #'dired-hardlink
- "Hardlink" arg dired-keep-marker-hardlink))
+ "Hardlink" arg dired-keep-marker-hardlink))
(defun dired-hardlink (file newname &optional ok-if-already-exists)
(dired-handle-overwrite newname)
@@ -2068,18 +2876,24 @@ When renaming just the current file, you specify the new name.
When renaming multiple or marked files, you specify a directory.
This command also renames any buffers that are visiting the files.
The default suggested for the target directory depends on the value
-of `dired-dwim-target', which see."
+of `dired-dwim-target', which see.
+
+Also see `dired-do-revert-buffer'."
(interactive "P")
+ (when (seq-find (lambda (file)
+ (member (file-name-nondirectory file) '("." "..")))
+ (dired-get-marked-files nil arg))
+ (user-error "Can't rename \".\" or \"..\" files"))
(dired-do-create-files 'move #'dired-rename-file
"Move" arg dired-keep-marker-rename "Rename"))
-;;;###end dired-cp.el
+
-;;; 5K
-;;;###begin dired-re.el
+;;; Operate on files matched by regexp
+
(defvar rename-regexp-query)
(defun dired-do-create-files-regexp
- (file-creator operation arg regexp newname &optional whole-name marker-char)
+ (file-creator operation arg regexp newname &optional whole-name marker-char)
;; Create a new file for each marked file using regexps.
;; FILE-CREATOR and OPERATION as in dired-create-files.
;; ARG as in dired-get-marked-files.
@@ -2090,11 +2904,12 @@ of `dired-dwim-target', which see."
;; Optional arg MARKER-CHAR as in dired-create-files.
(let* ((fn-list (dired-get-marked-files nil arg))
(operation-prompt (concat operation " `%s' to `%s'?"))
- (rename-regexp-help-form (format-message "\
-Type SPC or `y' to %s one match, DEL or `n' to skip to next,
-`!' to %s all remaining matches with no more questions."
- (downcase operation)
- (downcase operation)))
+ (rename-regexp-help-form (format-message
+ (substitute-command-keys "\
+Type \\`SPC' or \\`y' to %s one match, \\`DEL' or \\`n' to skip to next,
+\\`!' to %s all remaining matches with no more questions.")
+ (downcase operation)
+ (downcase operation)))
(regexp-name-constructor
;; Function to construct new filename using REGEXP and NEWNAME:
(if whole-name ; easy (but rare) case
@@ -2196,10 +3011,23 @@ See function `dired-do-rename-regexp' for more info."
#'make-symbolic-link
"SymLink" arg regexp newname whole-name dired-keep-marker-symlink))
+;;;###autoload
+(defun dired-do-relsymlink-regexp (regexp newname &optional arg whole-name)
+ "RelSymlink all marked files containing REGEXP to NEWNAME.
+See functions `dired-do-rename-regexp' and `dired-do-relsymlink'
+for more info."
+ (interactive (dired-mark-read-regexp "RelSymLink"))
+ (dired-do-create-files-regexp
+ #'dired-make-relative-symlink
+ "RelSymLink" arg regexp newname whole-name dired-keep-marker-relsymlink))
+
+
+;;; Change case of file names
+
(defvar rename-non-directory-query)
(defun dired-create-files-non-directory
- (file-creator basename-constructor operation arg)
+ (file-creator basename-constructor operation arg)
;; Perform FILE-CREATOR on the non-directory part of marked files
;; using function BASENAME-CONSTRUCTOR, with query for each file.
;; OPERATION like in dired-create-files, ARG as in dired-get-marked-files.
@@ -2212,11 +3040,12 @@ See function `dired-do-rename-regexp' for more info."
(let ((to (concat (file-name-directory from)
(funcall basename-constructor
(file-name-nondirectory from)))))
- (and (let ((help-form (format-message "\
-Type SPC or `y' to %s one file, DEL or `n' to skip to next,
-`!' to %s all remaining matches with no more questions."
- (downcase operation)
- (downcase operation))))
+ (and (let ((help-form (format-message
+ (substitute-command-keys "\
+Type \\`SPC' or \\`y' to %s one file, \\`DEL' or \\`n' to skip to next,
+\\`!' to %s all remaining matches with no more questions.")
+ (downcase operation)
+ (downcase operation))))
(dired-query 'rename-non-directory-query
(concat operation " `%s' to `%s'")
(dired-make-relative from)
@@ -2241,10 +3070,8 @@ Type SPC or `y' to %s one file, DEL or `n' to skip to next,
(interactive "P")
(dired-rename-non-directory #'downcase "Rename downcase" arg))
-;;;###end dired-re.el
-;;; 13K
-;;;###begin dired-ins.el
+;;; Insert subdirectory
;;;###autoload
(defun dired-maybe-insert-subdir (dirname &optional
@@ -2328,10 +3155,10 @@ This function takes some pains to conform to `ls -lR' output."
(push (cons dirname switches) dired-switches-alist)))
(when switches-have-R
(dired-build-subdir-alist switches)
- (setq switches (dired-replace-in-string "R" "" switches))
+ (setq switches (string-replace "R" "" switches))
(dolist (cur-ass dired-subdir-alist)
(let ((cur-dir (car cur-ass)))
- (and (dired-in-this-tree cur-dir dirname)
+ (and (dired-in-this-tree-p cur-dir dirname)
(let ((cur-cons (assoc-string cur-dir dired-switches-alist)))
(if cur-cons
(setcdr cur-cons switches)
@@ -2343,8 +3170,8 @@ This function takes some pains to conform to `ls -lR' output."
(defun dired-insert-subdir-validate (dirname &optional switches)
;; Check that it is valid to insert DIRNAME with SWITCHES.
;; Signal an error if invalid (e.g. user typed `i' on `..').
- (or (dired-in-this-tree dirname (expand-file-name default-directory))
- (error "%s: not in this directory tree" dirname))
+ (or (dired-in-this-tree-p dirname (expand-file-name default-directory))
+ (error "%s: Not in this directory tree" dirname))
(let ((real-switches (or switches dired-subdir-switches)))
(when real-switches
(let (case-fold-search)
@@ -2367,8 +3194,8 @@ This function takes some pains to conform to `ls -lR' output."
(setq dired-subdir-alist
(sort dired-subdir-alist
(lambda (elt1 elt2)
- (> (dired-get-subdir-min elt1)
- (dired-get-subdir-min elt2))))))
+ (> (cdr elt1)
+ (cdr elt2))))))
(defun dired-kill-tree (dirname &optional remember-marks kill-root)
"Kill all proper subdirs of DIRNAME, excluding DIRNAME itself.
@@ -2384,7 +3211,7 @@ of marked files. If KILL-ROOT is non-nil, kill DIRNAME as well."
(setq dir (car (car s-alist))
s-alist (cdr s-alist))
(and (or kill-root (not (string-equal dir dirname)))
- (dired-in-this-tree dir dirname)
+ (dired-in-this-tree-p dir dirname)
(dired-goto-subdir dir)
(setq m-alist (nconc (dired-kill-subdir remember-marks) m-alist))))
m-alist))
@@ -2411,7 +3238,7 @@ of marked files. If KILL-ROOT is non-nil, kill DIRNAME as well."
(defun dired-insert-subdir-del (element)
;; Erase an already present subdir (given by ELEMENT) from buffer.
;; Move to that buffer position. Return a mark-alist.
- (let ((begin-marker (dired-get-subdir-min element)))
+ (let ((begin-marker (cdr element)))
(goto-char begin-marker)
;; Are at beginning of subdir (and inside it!). Now determine its end:
(goto-char (dired-subdir-max))
@@ -2429,7 +3256,7 @@ of marked files. If KILL-ROOT is non-nil, kill DIRNAME as well."
(let ((dired-actual-switches
(or switches
dired-subdir-switches
- (dired-replace-in-string "R" "" dired-actual-switches))))
+ (string-replace "R" "" dired-actual-switches))))
(if (equal dirname (car (car (last dired-subdir-alist))))
;; If doing the top level directory of the buffer,
;; redo it as specified in dired-directory.
@@ -2442,7 +3269,7 @@ of marked files. If KILL-ROOT is non-nil, kill DIRNAME as well."
;; BEG-END is the subdir-region (as list of begin and end).
(if elt ; subdir was already present
;; update its position (should actually be unchanged)
- (set-marker (dired-get-subdir-min elt) (point-marker))
+ (set-marker (cdr elt) (point-marker))
(dired-alist-add dirname (point-marker)))
;; The hook may depend on the subdir-alist containing the just
;; inserted subdir, so run it after dired-alist-add:
@@ -2468,8 +3295,8 @@ of marked files. If KILL-ROOT is non-nil, kill DIRNAME as well."
;; if dired-actual-switches contained t.
(setq dir1 (file-name-as-directory dir1)
dir2 (file-name-as-directory dir2))
- (let ((components-1 (dired-split "/" dir1))
- (components-2 (dired-split "/" dir2)))
+ (let ((components-1 (split-string dir1 "/"))
+ (components-2 (split-string dir2 "/")))
(while (and components-1
components-2
(equal (car components-1) (car components-2)))
@@ -2488,16 +3315,16 @@ of marked files. If KILL-ROOT is non-nil, kill DIRNAME as well."
nil)
(t (error "This can't happen"))))))
-;; There should be a builtin split function - inverse to mapconcat.
(defun dired-split (pat str &optional limit)
"Splitting on regexp PAT, turn string STR into a list of substrings.
Optional third arg LIMIT (>= 1) is a limit to the length of the
resulting list.
Thus, if SEP is a regexp that only matches itself,
- (mapconcat 'identity (dired-split SEP STRING) SEP)
+ (mapconcat #\\='identity (dired-split SEP STRING) SEP)
is always equal to STRING."
+ (declare (obsolete split-string "29.1"))
(let* ((start (string-match pat str))
(result (list (substring str 0 start)))
(count 1)
@@ -2518,8 +3345,9 @@ is always equal to STRING."
(setq result
(cons (substring str end) result)))
(nreverse result)))
+
-;;; moving by subdirectories
+;;; Moving by subdirectories
;;;###autoload
(defun dired-prev-subdir (arg &optional no-error-if-not-found no-skip)
@@ -2533,33 +3361,29 @@ When called interactively and not on a subdir line, go to this subdir's line."
(if (dired-get-subdir) 1 0))))
(dired-next-subdir (- arg) no-error-if-not-found no-skip))
-(defun dired-subdir-min ()
- (save-excursion
- (if (not (dired-prev-subdir 0 t t))
- (error "Not in a subdir!")
- (point))))
-
;;;###autoload
(defun dired-goto-subdir (dir)
- "Go to end of header line of DIR in this dired buffer.
+ "Go to end of header line of inserted directory DIR in this Dired buffer.
+When called interactively, prompt for the inserted subdirectory
+to go to.
+
Return value of point on success, otherwise return nil.
-The next char is either \\n, or \\r if DIR is hidden."
+The next char is \\n."
(interactive
(prog1 ; let push-mark display its message
(list (expand-file-name
- (completing-read "Goto in situ directory: " ; prompt
- dired-subdir-alist ; table
- nil ; predicate
- t ; require-match
- (dired-current-directory))))
- (push-mark)))
+ (completing-read "Goto inserted directory: "
+ dired-subdir-alist nil t
+ (dired-current-directory))))
+ (push-mark))
+ dired-mode)
(setq dir (file-name-as-directory dir))
(let ((elt (assoc dir dired-subdir-alist)))
(and elt
- (goto-char (dired-get-subdir-min elt))
+ (goto-char (cdr elt))
;; dired-subdir-hidden-p and dired-add-entry depend on point being
- ;; at either \r or \n after this function succeeds.
- (progn (skip-chars-forward "^\r\n")
+ ;; at \n after this function succeeds.
+ (progn (end-of-line)
(point)))))
;;;###autoload
@@ -2622,28 +3446,15 @@ Lower levels are unaffected."
(while rest
(setq elt (car rest)
rest (cdr rest))
- (if (dired-in-this-tree (directory-file-name (car elt)) dir)
+ (if (dired-in-this-tree-p (directory-file-name (car elt)) dir)
(setq rest nil
pos (dired-goto-subdir (car elt))))))
(if pos
(goto-char pos)
(error "At the bottom"))))
-
-;;; hiding
-
-(defun dired-unhide-subdir ()
- (let (buffer-read-only)
- (subst-char-in-region (dired-subdir-min) (dired-subdir-max) ?\r ?\n)))
-(defun dired-hide-check ()
- (or selective-display
- (error "selective-display must be t for subdir hiding to work!")))
-
-(defun dired-subdir-hidden-p (dir)
- (and selective-display
- (save-excursion
- (dired-goto-subdir dir)
- (= (following-char) ?\r))))
+
+;;; Hiding
;;;###autoload
(defun dired-hide-subdir (arg)
@@ -2651,8 +3462,7 @@ Lower levels are unaffected."
Optional prefix arg is a repeat factor.
Use \\[dired-hide-all] to (un)hide all directories."
(interactive "p")
- (dired-hide-check)
- (let ((modflag (buffer-modified-p)))
+ (with-silent-modifications
(while (>= (setq arg (1- arg)) 0)
(let* ((cur-dir (dired-current-directory))
(hidden-p (dired-subdir-hidden-p cur-dir))
@@ -2660,13 +3470,12 @@ Use \\[dired-hide-all] to (un)hide all directories."
(end-pos (1- (dired-get-subdir-max elt)))
buffer-read-only)
;; keep header line visible, hide rest
- (goto-char (dired-get-subdir-min elt))
- (skip-chars-forward "^\n\r")
+ (goto-char (cdr elt))
+ (end-of-line)
(if hidden-p
- (subst-char-in-region (point) end-pos ?\r ?\n)
- (subst-char-in-region (point) end-pos ?\n ?\r)))
- (dired-next-subdir 1 t))
- (restore-buffer-modified-p modflag)))
+ (dired--unhide (point) end-pos)
+ (dired--hide (point) end-pos)))
+ (dired-next-subdir 1 t))))
;;;###autoload
(defun dired-hide-all (&optional ignored)
@@ -2674,33 +3483,23 @@ Use \\[dired-hide-all] to (un)hide all directories."
If there is already something hidden, make everything visible again.
Use \\[dired-hide-subdir] to (un)hide a particular subdirectory."
(interactive "P")
- (dired-hide-check)
- (let ((modflag (buffer-modified-p))
- buffer-read-only)
- (if (save-excursion
- (goto-char (point-min))
- (search-forward "\r" nil t))
- ;; unhide - bombs on \r in filenames
- (subst-char-in-region (point-min) (point-max) ?\r ?\n)
+ (with-silent-modifications
+ (if (text-property-any (point-min) (point-max) 'invisible 'dired)
+ (dired--unhide (point-min) (point-max))
;; hide
- (let ((pos (point-max)) ; pos of end of last directory
- (alist dired-subdir-alist))
- (while alist ; while there are dirs before pos
- (subst-char-in-region (dired-get-subdir-min (car alist)) ; pos of prev dir
- (save-excursion
- (goto-char pos) ; current dir
- ;; we're somewhere on current dir's line
- (forward-line -1)
- (point))
- ?\n ?\r)
- (setq pos (dired-get-subdir-min (car alist))) ; prev dir gets current dir
- (setq alist (cdr alist)))))
- (restore-buffer-modified-p modflag)))
-
-;;;###end dired-ins.el
+ (let ((pos (point-max))) ; pos of end of last directory
+ (dolist (subdir dired-subdir-alist)
+ (let ((start (cdr subdir)) ; pos of prev dir
+ (end (save-excursion
+ (goto-char pos) ; current dir
+ ;; we're somewhere on current dir's line
+ (forward-line -1)
+ (point))))
+ (dired--hide start end))
+ (setq pos (cdr subdir))))))) ; prev dir gets current dir
-;; Search only in file names in the Dired buffer.
+;;; Search only in file names in the Dired buffer
(defcustom dired-isearch-filenames nil
"Non-nil to Isearch in file names only.
@@ -2715,16 +3514,16 @@ a file name. Otherwise, it searches the whole buffer without restrictions."
(define-minor-mode dired-isearch-filenames-mode
"Toggle file names searching on or off.
-When on, Isearch skips matches outside file names using the predicate
-`dired-isearch-filter-filenames' that matches only at file names.
-When off, it uses the original predicate."
- nil nil nil
+When on, Isearch skips matches outside file names using the search function
+`dired-isearch-search-filenames' that matches only at file names.
+When off, it uses the default search function."
+ :lighter nil
(if dired-isearch-filenames-mode
- (add-function :before-while (local 'isearch-filter-predicate)
- #'dired-isearch-filter-filenames
- '((isearch-message-prefix . "filename ")))
- (remove-function (local 'isearch-filter-predicate)
- #'dired-isearch-filter-filenames))
+ (add-function :around (local 'isearch-search-fun-function)
+ #'dired-isearch-search-filenames
+ '((isearch-message-prefix . "filename ")))
+ (remove-function (local 'isearch-search-fun-function)
+ #'dired-isearch-search-filenames))
(when isearch-mode
(setq isearch-success t isearch-adjusted t)
(isearch-update)))
@@ -2738,85 +3537,108 @@ Intended to be added to `isearch-mode-hook'."
(get-text-property (point) 'dired-filename)))
(define-key isearch-mode-map "\M-sff" 'dired-isearch-filenames-mode)
(dired-isearch-filenames-mode 1)
- (add-hook 'isearch-mode-end-hook 'dired-isearch-filenames-end nil t)))
+ (add-hook 'isearch-mode-end-hook #'dired-isearch-filenames-end nil t)))
(defun dired-isearch-filenames-end ()
"Clean up the Dired file name search after terminating isearch."
(define-key isearch-mode-map "\M-sff" nil)
(dired-isearch-filenames-mode -1)
- (remove-hook 'isearch-mode-end-hook 'dired-isearch-filenames-end t))
-
-(defun dired-isearch-filter-filenames (beg end)
- "Test whether the current search hit is a file name.
-Return non-nil if the text from BEG to END is part of a file
-name (has the text property `dired-filename')."
- (text-property-not-all (min beg end) (max beg end)
- 'dired-filename nil))
+ (remove-hook 'isearch-mode-end-hook #'dired-isearch-filenames-end t)
+ (unless isearch-suspended
+ (kill-local-variable 'dired-isearch-filenames)))
+
+(defun dired-isearch-search-filenames (orig-fun)
+ "Return the function that searches inside file names.
+The returned function narrows the search to match the search string
+only as part of a file name enclosed by the text property `dired-filename'.
+It's intended to override the default search function."
+ (isearch-search-fun-in-text-property
+ (funcall orig-fun) '(dired-filename dired-symlink-filename)))
;;;###autoload
(defun dired-isearch-filenames ()
"Search for a string using Isearch only in file names in the Dired buffer."
(interactive)
- (let ((dired-isearch-filenames t))
- (isearch-forward nil t)))
+ (setq-local dired-isearch-filenames t)
+ (isearch-forward nil t))
;;;###autoload
(defun dired-isearch-filenames-regexp ()
"Search for a regexp using Isearch only in file names in the Dired buffer."
(interactive)
- (let ((dired-isearch-filenames t))
- (isearch-forward-regexp nil t)))
+ (setq-local dired-isearch-filenames t)
+ (isearch-forward-regexp nil t))
-;; Functions for searching in tags style among marked files.
+;;; Functions for searching in tags style among marked files
;;;###autoload
(defun dired-do-isearch ()
"Search for a string through all marked files using Isearch."
(interactive)
(multi-isearch-files
- (dired-get-marked-files nil nil 'dired-nondirectory-p)))
+ (dired-get-marked-files nil nil #'dired-nondirectory-p nil t)))
;;;###autoload
(defun dired-do-isearch-regexp ()
"Search for a regexp through all marked files using Isearch."
(interactive)
(multi-isearch-files-regexp
- (dired-get-marked-files nil nil 'dired-nondirectory-p)))
+ (dired-get-marked-files nil nil 'dired-nondirectory-p nil t)))
+
+(declare-function fileloop-continue "fileloop" ())
;;;###autoload
(defun dired-do-search (regexp)
"Search through all marked files for a match for REGEXP.
+If no files are marked, search through the file under point.
+
Stops when a match is found.
-To continue searching for next match, use command \\[tags-loop-continue]."
+
+To continue searching for next match, use command \\[fileloop-continue]."
(interactive "sSearch marked files (regexp): ")
- (tags-search regexp '(dired-get-marked-files nil nil 'dired-nondirectory-p)))
+ (fileloop-initialize-search
+ regexp
+ (dired-get-marked-files nil nil #'dired-nondirectory-p)
+ 'default)
+ (fileloop-continue))
;;;###autoload
(defun dired-do-query-replace-regexp (from to &optional delimited)
"Do `query-replace-regexp' of FROM with TO, on all marked files.
+As each match is found, the user must type a character saying
+what to do with it. Type SPC or `y' to replace the match,
+DEL or `n' to skip and go to the next match. For more directions,
+type \\[help-command] at that time.
+
Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
-If you exit (\\[keyboard-quit], RET or q), you can resume the query replace
-with the command \\[tags-loop-continue]."
+If you exit the query-replace loop (\\[keyboard-quit], RET or q), you can
+resume the query replace with the command \\[fileloop-continue]."
(interactive
(let ((common
(query-replace-read-args
"Query replace regexp in marked files" t t)))
(list (nth 0 common) (nth 1 common) (nth 2 common))))
- (dolist (file (dired-get-marked-files nil nil 'dired-nondirectory-p))
+ (dolist (file (dired-get-marked-files nil nil #'dired-nondirectory-p nil t))
(let ((buffer (get-file-buffer file)))
(if (and buffer (with-current-buffer buffer
buffer-read-only))
(error "File `%s' is visited read-only" file))))
- (tags-query-replace from to delimited
- '(dired-get-marked-files nil nil 'dired-nondirectory-p)))
+ (fileloop-initialize-replace
+ from to (dired-get-marked-files nil nil #'dired-nondirectory-p)
+ (if (equal from (downcase from)) nil 'default)
+ delimited)
+ (fileloop-continue))
-(declare-function xref--show-xrefs "xref")
(declare-function xref-query-replace-in-results "xref")
+(declare-function project--files-in-directory "project")
;;;###autoload
(defun dired-do-find-regexp (regexp)
"Find all matches for REGEXP in all marked files.
+
+If no files are marked, use the file under point.
+
For any marked directory, all of its files are searched recursively.
However, files matching `grep-find-ignored-files' and subdirectories
matching `grep-find-ignored-directories' are skipped in the marked
@@ -2825,38 +3647,69 @@ directories.
REGEXP should use constructs supported by your local `grep' command."
(interactive "sSearch marked files (regexp): ")
(require 'grep)
+ (require 'xref)
(defvar grep-find-ignored-files)
- (defvar grep-find-ignored-directories)
- (let* ((files (dired-get-marked-files))
+ (declare-function rgrep-find-ignored-directories "grep" (dir))
+ (let* ((marks (dired-get-marked-files nil nil nil nil t))
(ignores (nconc (mapcar
- (lambda (s) (concat s "/"))
- grep-find-ignored-directories)
+ #'file-name-as-directory
+ (rgrep-find-ignored-directories default-directory))
grep-find-ignored-files))
- (xrefs (mapcan
- (lambda (file)
- (xref-collect-matches regexp "*" file
- (and (file-directory-p file)
- ignores)))
- files)))
- (unless xrefs
- (user-error "No matches for: %s" regexp))
- (xref--show-xrefs xrefs nil t)))
+ (fetcher
+ (lambda ()
+ (let (files xrefs)
+ (mapc
+ (lambda (mark)
+ (if (file-directory-p mark)
+ (setq files (nconc
+ (project--files-in-directory mark ignores "*")
+ files))
+ (push mark files)))
+ (reverse marks))
+ (message "Searching...")
+ (setq xrefs
+ (xref-matches-in-files regexp files))
+ (unless xrefs
+ (user-error "No matches for: %s" regexp))
+ (message "Searching...done")
+ xrefs))))
+ (xref-show-xrefs fetcher nil)))
;;;###autoload
(defun dired-do-find-regexp-and-replace (from to)
"Replace matches of FROM with TO, in all marked files.
+
+As each match is found, the user must type a character saying
+what to do with it. Type SPC or `y' to replace the match,
+DEL or `n' to skip and go to the next match. For more directions,
+type \\[help-command] at that time.
+
+If no files are marked, use the file under point.
+
For any marked directory, matches in all of its files are replaced,
recursively. However, files matching `grep-find-ignored-files'
and subdirectories matching `grep-find-ignored-directories' are skipped
in the marked directories.
-REGEXP should use constructs supported by your local `grep' command."
+REGEXP should use constructs supported by your local `grep' command.
+
+Also see `query-replace' for user options that affect how this
+function works."
(interactive
(let ((common
(query-replace-read-args
"Query replace regexp in marked files" t t)))
(list (nth 0 common) (nth 1 common))))
- (with-current-buffer (dired-do-find-regexp from)
+ (require 'xref)
+ (defvar xref-show-xrefs-function)
+ (defvar xref-auto-jump-to-first-xref)
+ (with-current-buffer
+ (let ((xref-show-xrefs-function
+ ;; Some future-proofing (bug#44905).
+ (custom--standard-value 'xref-show-xrefs-function))
+ ;; Disable auto-jumping, it will mess up replacement logic.
+ xref-auto-jump-to-first-xref)
+ (dired-do-find-regexp from))
(xref-query-replace-in-results from to)))
(defun dired-nondirectory-p (file)
@@ -2878,10 +3731,75 @@ instead."
(backward-delete-char 1))
(message "%s" (buffer-string)))))
+
+;;; Version control from dired
+
+(declare-function vc-dir-unmark-all-files "vc-dir")
+(declare-function vc-dir-mark-files "vc-dir")
+
+;;;###autoload
+(defun dired-vc-next-action (verbose)
+ "Do the next version control operation on marked files/directories.
+When only files are marked then call `vc-next-action' with the
+same value of the VERBOSE argument.
+When also directories are marked then call `vc-dir' and mark
+the same files/directories in the VC-Dir buffer that were marked
+in the Dired buffer."
+ (interactive "P")
+ (let* ((marked-files
+ (dired-get-marked-files nil nil nil nil t))
+ (mark-files
+ (when (cl-some #'file-directory-p marked-files)
+ ;; Fix deficiency of Dired by adding slash to dirs
+ (mapcar (lambda (file)
+ (if (file-directory-p file)
+ (file-name-as-directory file)
+ file))
+ marked-files))))
+ (if mark-files
+ (let ((transient-hook (make-symbol "vc-dir-mark-files")))
+ (fset transient-hook
+ (lambda ()
+ (remove-hook 'vc-dir-refresh-hook transient-hook t)
+ (vc-dir-unmark-all-files t)
+ (vc-dir-mark-files mark-files)))
+ (vc-dir-root)
+ (add-hook 'vc-dir-refresh-hook transient-hook nil t))
+ (vc-next-action verbose))))
+
+(declare-function vc-compatible-state "vc")
+
+;;;###autoload
+(defun dired-vc-deduce-fileset (&optional state-model-only-files not-state-changing)
+ (let ((backend (vc-responsible-backend default-directory))
+ (files (dired-get-marked-files nil nil nil nil t))
+ only-files-list
+ state
+ model)
+ (when (and (not not-state-changing) (cl-some #'file-directory-p files))
+ (user-error "State changing VC operations on directories supported only in `vc-dir'"))
+
+ (when state-model-only-files
+ (setq only-files-list (mapcar (lambda (file) (cons file (vc-state file))) files))
+ (setq state (cdar only-files-list))
+ ;; Check that all files are in a consistent state, since we use that
+ ;; state to decide which operation to perform.
+ (dolist (crt (cdr only-files-list))
+ (unless (vc-compatible-state (cdr crt) state)
+ (error "When applying VC operations to multiple files, the files are required\nto be in similar VC states.\n%s in state %s clashes with %s in state %s"
+ (car crt) (cdr crt) (caar only-files-list) state)))
+ (setq only-files-list (mapcar 'car only-files-list))
+ (when (and state (not (eq state 'unregistered)))
+ (setq model (vc-checkout-model backend only-files-list))))
+ (list backend files only-files-list state model)))
+
+(define-obsolete-function-alias 'minibuffer-default-add-dired-shell-commands
+ #'dired-minibuffer-default-add-shell-commands "29.1")
+
+
(provide 'dired-aux)
;; Local Variables:
-;; byte-compile-dynamic: t
;; generated-autoload-file: "dired-loaddefs.el"
;; End:
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-26 13:55:31 +0000