;;; dired-aux.el --- less commonly used parts of dired -*-byte-compile-dynamic: t;-*-
-;; Copyright (C) 1985, 1986, 1992, 1994, 1998, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1992, 1994, 1998, 2000, 2001
+;; Free Software Foundation, Inc.
;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>.
;; Maintainer: FSF
+;; Keywords: files
;; This file is part of GNU Emacs.
;;;###autoload
(defun dired-diff (file &optional switches)
"Compare file at point with file FILE using `diff'.
-FILE defaults to the file at the mark.
+FILE defaults to the file at the mark. (That's the mark set by
+\\[set-mark-command], not by Dired's \\[dired-mark] command.)
The prompted-for file is the first file given to `diff'.
With prefix arg, prompt for second argument SWITCHES,
which is options for `diff'."
(setq failures
(dired-bunch-files 10000
(function dired-check-process)
- (append
+ (append
(list operation program new-attribute)
(if (string-match "gnu" system-configuration)
'("--") nil))
"Change the group of the marked (or next ARG) files."
(interactive "P")
(if (memq system-type '(ms-dos windows-nt))
- (error "chgrp not supported on this system."))
+ (error "chgrp not supported on this system"))
(dired-do-chxxx "Group" "chgrp" 'chgrp arg))
;;;###autoload
"Change the owner of the marked (or next ARG) files."
(interactive "P")
(if (memq system-type '(ms-dos windows-nt))
- (error "chown not supported on this system."))
+ (error "chown not supported on this system"))
(dired-do-chxxx "Owner" dired-chown-program 'chown arg))
;; Process all the files in FILES in batches of a convenient size,
;; and this file won't fit in the length limit, process now.
(if (and pending (> (+ thislength pending-length) max))
(setq failures
- (nconc (apply function (append args pending))
+ (nconc (apply function (append args (nreverse pending)))
failures)
pending nil
pending-length 0))
(setq pending files)
(setq pending-length (+ thislength pending-length))
(setq files rest)))
- (nconc (apply function (append args pending))
+ (nconc (apply function (append args (nreverse pending)))
failures)))
;;;###autoload
nil op-symbol files
(function read-string)
(format prompt (dired-mark-prompt arg files)) initial))
-
+\f
;;; Cleaning a directory: flagging some backups for deletion.
(defvar dired-file-version-alist)
(progn (beginning-of-line)
(delete-char 1)
(insert dired-del-marker)))))
-
+\f
;;; Shell commands
(defun dired-read-shell-command (prompt arg files)
the next ARG files are used. Just \\[universal-argument] means the current file.
The prompt mentions the file(s) or the marker, as appropriate.
-If there is output, it goes to a separate buffer.
+If there is a `*' in COMMAND, surrounded by whitespace, this runs
+COMMAND just once with the entire file list substituted there.
+
+If there is no `*', but there is a `?' in COMMAND, surrounded by
+whitespace, this runs COMMAND on each file individually with the
+file name substituted for `?'.
+
+Otherwise, this runs COMMAND on each file individually with the
+file name added at the end of COMMAND (separated by a space).
-Normally the command is run on each file individually.
-However, if there is a `*' in the command then it is run
-just once with the entire file list substituted there.
+`*' and `?' when not surrounded by whitespace have no special
+significance for `dired-do-shell-command', and are passed through
+normally to the shell, but you must confirm first. To pass `*' by
+itself to the shell as a wildcard, type `*\"\"'.
-If there is no `*', but a `?' in the command then it is still run
-on each file individually but with the filename substituted there
-instead of att the end of the command.
+If COMMAND produces output, it goes to a separate buffer.
-No automatic redisplay of dired buffers is attempted, as there's no
-telling what files the command may have changed. Type
-\\[dired-do-redisplay] to redisplay the marked files.
+This feature does not try to redisplay Dired buffers afterward, as
+there's no telling what files COMMAND may have changed.
+Type \\[dired-do-redisplay] to redisplay the marked files.
-The shell command has the top level directory as working directory, so
-output files usually are created there instead of in a subdir.
+When COMMAND runs, its working directory is the top-level directory of
+the Dired buffer, so output files usually are created there 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."
files)
current-prefix-arg
files)))
- (let* ((on-each (not (string-match "\\*" command))))
- (if on-each
- (dired-bunch-files
- (- 10000 (length command))
- (function (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)))))
+ (let* ((on-each (not (string-match "\\(^\\|[ \t]\\)\\*\\([ \t]\\|$\\)" command)))
+ (subst (not (string-match "\\(^\\|[ \t]\\)\\?\\([ \t]\\|$\\)" command)))
+ (star (not (string-match "\\*" command)))
+ (qmark (not (string-match "\\?" command))))
+ ;; Get confirmation for wildcards that may have been meant
+ ;; to control substitution of a file name or the file name list.
+ (if (cond ((and star (not on-each))
+ (y-or-n-p "Confirm--do you mean to use `*' as a wildcard? "))
+ ((and qmark (not subst))
+ (y-or-n-p "Confirm--do you mean to use `?' as a wildcard? "))
+ (t))
+ (if on-each
+ (dired-bunch-files
+ (- 10000 (length command))
+ (function (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 ""
;; 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.
-;; See dired-trns.el for an approach to this.
- ;; Bug: There is no way to quote a * or a ?
- ;; On the other hand, you can never accidentally get a * or a ? into
- ;; your cmd.
(let ((stuff-it
- (cond ((string-match "\\*" command)
- (lambda (x) (replace-regexp-in-string "\\*" x command)))
- ((string-match "\\?" command)
- (lambda (x) (replace-regexp-in-string "\\?" x command)))
- (t (lambda (x) (concat command " " x))))))
+ (cond ((string-match "\\(^\\|[ \t]\\)\\*\\([ \t]\\|$\\)" command)
+ (lambda (x)
+ (string-match "\\(^\\|[ \t]\\)\\(\\*\\)\\([ \t]\\|$\\)" command)
+ (replace-match x t t command 2)))
+ ((string-match "\\(^\\|[ \t]\\)\\?\\([ \t]\\|$\\)" command)
+ (lambda (x)
+ (string-match "\\(^\\|[ \t]\\)\\(\\?\\)\\([ \t]\\|$\\)" command)
+ (replace-match x t t command 2)))
+ (t (lambda (x) (concat command dired-mark-separator x))))))
(if on-each
(mapconcat stuff-it (mapcar 'shell-quote-argument file-list) ";")
- (let ((fns (mapconcat 'shell-quote-argument
- file-list dired-mark-separator)))
+ (let ((files (mapconcat 'shell-quote-argument
+ file-list dired-mark-separator)))
(if (> (length file-list) 1)
- (setq fns (concat dired-mark-prefix fns dired-mark-postfix)))
- (funcall stuff-it fns)))))
+ (setq files (concat dired-mark-prefix files dired-mark-postfix)))
+ (funcall stuff-it files)))))
;; This is an extra function so that it can be redefined by ange-ftp.
(defun dired-run-shell-command (command)
(shell-command command)))
;; Return nil for sake of nconc in dired-bunch-files.
nil)
-
+\f
;; In Emacs 19 this will return program's exit status.
;; This is a separate function so that ange-ftp can redefine it.
(defun dired-call-process (program discard &rest arguments)
(kill-buffer err-buffer)
(message "%s...done" msg)
nil))))
-
+\f
;; Commands that delete or redisplay part of the dired buffer.
(defun dired-kill-line (&optional arg)
(while (/= 0 arg)
(setq file (dired-get-filename nil t))
(if (not file)
- (error "Can only kill file lines.")
+ (error "Can only kill file lines")
(save-excursion (and file
(dired-goto-subdir file)
(dired-kill-subdir)))
count))))
;;;###end dired-cmd.el
-
+\f
;;; 30K
;;;###begin dired-cp.el
(setq suffix (car suffixes) suffixes nil))
(setq suffixes (cdr suffixes))))
;; If so, compute desired new name.
- (if suffix
+ (if suffix
(setq newname (concat (substring file 0 (match-beginning 0))
(nth 1 suffix))))
(cond (handler
"compress" "-f" file))
;; Don't use NEWNAME with `compress'.
(concat file ".Z"))))))))
-
+\f
(defun dired-mark-confirm (op-symbol arg)
;; Request confirmation from the user that the operation described
;; by OP-SYMBOL is to be performed on the marked files.
(apply 'message qprompt qs-args)
(setq char (set qs-var (read-char))))
(memq (cdr elt) '(t y yes)))))))
-
+\f
;;;###autoload
(defun dired-do-compress (&optional arg)
"Compress or uncompress marked (or next ARG) files."
arg)
(dired-move-to-filename)
(message "Redisplaying...done")))
-
+\f
(defun dired-update-file-line (file)
;; Delete the current line, and insert an entry for FILE.
;; If FILE is nil, then just delete the current line.
(subst-char-in-region opoint (1+ opoint) ?\040 char))))
(dired-move-to-filename))
-(defun dired-fun-in-all-buffers (directory file fun &rest args)
- ;; In all buffers dired'ing DIRECTORY, run FUN with ARGS.
- ;; If the buffer has a wildcard pattern, check that it matches FILE.
- ;; (FILE does not include a directory component.)
- ;; FILE may be nil, in which case ignore it.
- ;; Return list of buffers where FUN succeeded (i.e., returned non-nil).
- (let ((buf-list (dired-buffers-for-dir (expand-file-name directory)
- file))
- (obuf (current-buffer))
- buf success-list)
- (while buf-list
- (setq buf (car buf-list)
- buf-list (cdr buf-list))
- (unwind-protect
- (progn
- (set-buffer buf)
- (if (apply fun args)
- (setq success-list (cons (buffer-name buf) success-list))))
- (set-buffer obuf)))
- success-list))
-
;;;###autoload
(defun dired-add-file (filename &optional marker-char)
(dired-fun-in-all-buffers
;; It inserts the file's absolute name, rather than
;; the relative one. That may be hard to fix since it
;; is probably controlled by something in ftp.
- (goto-char opoint)
+ (goto-char opoint)
(let ((inserted-name (dired-get-filename 'verbatim)))
(if (file-name-directory inserted-name)
(progn
(save-excursion (forward-line 1) (point))))
(setq file (directory-file-name file))
(dired-add-entry file (if (eq ?\040 marker) nil marker)))))
-
+\f
;;; Copy, move/rename, making hard and symbolic links
(defcustom dired-recursive-copies nil
"*Decide whether recursive copies are allowed.
-Nil means no recursive copies.
+nil means no recursive copies.
`always' means copy recursively without asking.
`top' means ask for each directory at top level.
Anything else means ask for each directory."
(if (and buffer-file-name
(dired-in-this-tree buffer-file-name expanded-from-dir))
(let ((modflag (buffer-modified-p))
- (to-file (replace-regexp-in-string
+ (to-file (dired-replace-in-string
(concat "^" (regexp-quote from-dir))
to-dir
buffer-file-name)))
;; Update buffer-local dired-subdir-alist
(setcar elt
(dired-normalize-subdir
- (replace-regexp-in-string regexp newtext (car elt)))))))
-
+ (dired-replace-in-string regexp newtext (car elt)))))))
+\f
;; 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)
(message "%s: %s file%s"
operation success-count (dired-plural-s success-count)))))
(dired-move-to-filename))
-
+\f
(defun dired-do-create-files (op-symbol file-creator operation arg
&optional marker-char op1
how-to)
"Create a new file for each marked file.
Prompts user for target, which is a directory in which to create
the new files. Target may be a plain file if only one marked
- file exists.
+ file exists. The way the default for the target directory is
+ computed depends on the value of `dired-dwim-target-directory'.
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'.
(dired-current-directory)))))
(or other-dir this-dir))
this-dir)))
-
+\f
;;;###autoload
(defun dired-create-directory (directory)
"Create a directory called DIRECTORY."
;; symlinks.
(defvar dired-copy-how-to-fn nil
- "Nil or a function used by `dired-do-copy' to determine target.
+ "nil or a function used by `dired-do-copy' to determine target.
See HOW-TO argument for `dired-do-create-files'.")
;;;###autoload
When operating on just the current file, you specify the new name.
When operating on multiple or marked files, you specify a directory,
and new copies of these files are made in that directory
-with the same names that the files currently have."
+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."
(interactive "P")
(let ((dired-recursive-copies dired-recursive-copies))
(dired-do-create-files 'copy (function dired-copy-file)
When operating on just the current file, you specify the new name.
When operating on multiple or marked files, you specify a directory
and new symbolic links are made in that directory
-with the same names that the files currently have."
+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."
(interactive "P")
(dired-do-create-files 'symlink (function make-symbolic-link)
"Symlink" arg dired-keep-marker-symlink))
When operating on just the current file, you specify the new name.
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."
+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."
(interactive "P")
(dired-do-create-files 'hardlink (function add-name-to-file)
"Hardlink" arg dired-keep-marker-hardlink))
(defun dired-do-rename (&optional arg)
"Rename current file or all marked (or next ARG) files.
When renaming just the current file, you specify the new name.
-When renaming multiple or marked files, you specify a directory."
+When renaming multiple or marked files, you specify a directory.
+The default suggested for the target directory depends on the value
+of `dired-dwim-target', which see."
(interactive "P")
(dired-do-create-files 'move (function dired-rename-file)
"Move" arg dired-keep-marker-rename "Rename"))
;;;###end dired-cp.el
-
+\f
;;; 5K
;;;###begin dired-re.el
(defun dired-do-create-files-regexp
;;;###autoload
(defun dired-do-rename-regexp (regexp newname &optional arg whole-path)
- "Rename marked files containing REGEXP to NEWNAME.
+ "Rename selected files whose names match REGEXP to NEWNAME.
+
+With non-zero prefix argument ARG, the command operates on the next ARG
+files. Otherwise, it operates on all the marked files, or the current
+file if none are marked.
+
As each match is found, the user must type a character saying
what to do with it. For directions, type \\[help-command] at that time.
NEWNAME may contain \\=\\<n> or \\& as in `query-replace-regexp'.
;;;###autoload
(defun dired-do-copy-regexp (regexp newname &optional arg whole-path)
- "Copy all marked files containing REGEXP to NEWNAME.
+ "Copy selected files whose names match REGEXP to NEWNAME.
See function `dired-do-rename-regexp' for more info."
(interactive (dired-mark-read-regexp "Copy"))
(let ((dired-recursive-copies nil)) ; No recursive copies.
;;;###autoload
(defun dired-do-hardlink-regexp (regexp newname &optional arg whole-path)
- "Hardlink all marked files containing REGEXP to NEWNAME.
+ "Hardlink selected files whose names match REGEXP to NEWNAME.
See function `dired-do-rename-regexp' for more info."
(interactive (dired-mark-read-regexp "HardLink"))
(dired-do-create-files-regexp
;;;###autoload
(defun dired-do-symlink-regexp (regexp newname &optional arg whole-path)
- "Symlink all marked files containing REGEXP to NEWNAME.
+ "Symlink selected files whose names match REGEXP to NEWNAME.
See function `dired-do-rename-regexp' for more info."
(interactive (dired-mark-read-regexp "SymLink"))
(dired-do-create-files-regexp
(dired-rename-non-directory (function downcase) "Rename downcase" arg))
;;;###end dired-re.el
-
+\f
;;; 13K
;;;###begin dired-ins.el
(dired-insert-subdir-newpos dirname)) ; else compute new position
(dired-insert-subdir-doupdate
dirname elt (dired-insert-subdir-doinsert dirname switches))
- (if switches-have-R (dired-build-subdir-alist))
+ (if switches-have-R (dired-build-subdir-alist switches))
(dired-initial-position dirname)
(save-excursion (dired-mark-remembered mark-alist))))
(message "Reading directory %s..." dirname)
(let ((dired-actual-switches
(or switches
- (replace-regexp-in-string "R" "" dired-actual-switches))))
+ (dired-replace-in-string "R" "" dired-actual-switches))))
(if (equal dirname (car (car (reverse dired-subdir-alist))))
;; top level directory may contain wildcards:
(dired-readin-insert dired-directory)
(setq result
(cons (substring str end) result)))
(nreverse result)))
-
+\f
;;; moving by subdirectories
;;;###autoload
;; at either \r or \n after this function succeeds.
(progn (skip-chars-forward "^\r\n")
(point)))))
-
+\f
;;;###autoload
(defun dired-mark-subdir-files ()
"Mark all files except `.' and `..' in current subdirectory.
dir (file-name-directory (directory-file-name dir))))
;;(setq dir (expand-file-name dir))
(or (dired-goto-subdir dir)
- (error "Cannot go up to %s - not in this tree." dir))))
+ (error "Cannot go up to %s - not in this tree" dir))))
;;;###autoload
(defun dired-tree-down ()
(if pos
(goto-char pos)
(error "At the bottom"))))
-
+\f
;;; hiding
(defun dired-unhide-subdir ()
;;;###end dired-ins.el
-
+\f
;; Functions for searching in tags style among marked files.
;;;###autoload
Stops when a match is found.
To continue searching for next match, use command \\[tags-loop-continue]."
(interactive "sSearch marked files (regexp): ")
- (tags-search regexp '(dired-get-marked-files)))
+ (tags-search regexp '(dired-get-marked-files nil nil 'dired-nondirectory-p)))
;;;###autoload
(defun dired-do-query-replace-regexp (from to &optional delimited)
"Do `query-replace-regexp' of FROM with TO, on all marked files.
Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
-If you exit (\\[keyboard-quit] or ESC), you can resume the query replace
+If you exit (\\[keyboard-quit], RET or q), you can resume the query replace
with the command \\[tags-loop-continue]."
(interactive
"sQuery replace in marked files (regexp): \nsQuery replace %s by: \nP")
- (tags-query-replace from to delimited '(dired-get-marked-files)))
+ (tags-query-replace from to delimited
+ '(dired-get-marked-files nil nil 'dired-nondirectory-p)))
+(defun dired-nondirectory-p (file)
+ (not (file-directory-p file)))
+\f
;;;###autoload
(defun dired-show-file-type (file &optional deref-symlinks)
"Print the type of FILE, according to the `file' command.
If FILE is a symbolic link and the optional argument DEREF-SYMLINKS is
-true then the type of the file linked to by FILE is printed instead."
+true then the type of the file linked to by FILE is printed instead."
(interactive (list (dired-get-filename t) current-prefix-arg))
- (with-temp-buffer
+ (with-temp-buffer
(if deref-symlinks
(call-process "file" nil t t "-L" file)
(call-process "file" nil t t file))