-;; dired-aux.el --- all of dired except what people usually use
+;;; dired-aux.el --- less commonly used parts of dired -*-byte-compile-dynamic: t;-*-
-;; Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1992, 1994, 1998 Free Software Foundation, Inc.
;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>.
+;; Maintainer: FSF
;; This file is part of GNU Emacs.
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
;;; Commentary:
+;; The parts of dired mode not normally used. This is a space-saving hack
+;; to avoid having to load a large mode when all that's wanted are a few
+;; functions.
+
;; Rewritten in 1990/1991 to add tree features, file marking and
;; sorting by Sebastian Kremer <sk@thp.uni-koeln.de>.
;; Finished up by rms in 1992.
(defun dired-diff (file &optional switches)
"Compare file at point with file FILE using `diff'.
FILE defaults to the file at the mark.
-The prompted-for file is the first file given to `diff'."
+The prompted-for file is the first file given to `diff'.
+With prefix arg, prompt for second argument SWITCHES,
+ which is options for `diff'."
(interactive
- (let ((default (if (mark)
- (save-excursion (goto-char (mark))
+ (let ((default (if (mark t)
+ (save-excursion (goto-char (mark t))
(dired-get-filename t t)))))
+ (require 'diff)
(list (read-file-name (format "Diff %s with: %s"
(dired-get-filename t)
(if default
(concat "(default " default ") ")
""))
(dired-current-directory) default t)
- (if (fboundp 'diff-read-switches)
- (diff-read-switches "Options for diff: ")))))
- (if switches ; Emacs 19's diff has but two
- (diff file (dired-get-filename t) switches) ; args (yet ;-)
- (diff file (dired-get-filename t))))
+ (if current-prefix-arg
+ (read-string "Options for diff: "
+ (if (stringp diff-switches)
+ diff-switches
+ (mapconcat 'identity diff-switches " ")))))))
+ (diff file (dired-get-filename t) switches))
;;;###autoload
(defun dired-backup-diff (&optional switches)
"Diff this file with its backup file or vice versa.
Uses the latest backup, if there are several numerical backups.
If this file is a backup, diff it with its original.
-The backup file is the first file given to `diff'."
- (interactive (list (if (fboundp 'diff-read-switches)
- (diff-read-switches "Diff with switches: "))))
- (if switches
- (diff-backup (dired-get-filename) switches)
- (diff-backup (dired-get-filename))))
+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))
+ (diff-backup (dired-get-filename) switches))
(defun dired-do-chxxx (attribute-name program op-symbol arg)
;; Change file attributes (mode, group, owner) of marked files and
(setq failures
(dired-bunch-files 10000
(function dired-check-process)
- (list operation program new-attribute)
+ (append
+ (list operation program new-attribute)
+ (if (string-match "gnu" system-configuration)
+ '("--") nil))
files))
(dired-do-redisplay arg);; moves point if ARG is an integer
(if failures
"Change the mode of the marked (or next ARG) files.
This calls chmod, thus symbolic modes like `g+w' are allowed."
(interactive "P")
- (dired-do-chxxx "Mode" "chmod" 'chmod arg))
+ (dired-do-chxxx "Mode" dired-chmod-program 'chmod arg))
;;;###autoload
(defun dired-do-chgrp (&optional arg)
"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."))
(dired-do-chxxx "Group" "chgrp" 'chgrp arg))
;;;###autoload
(defun dired-do-chown (&optional arg)
"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."))
(dired-do-chxxx "Owner" dired-chown-program 'chown arg))
;; Process all the files in FILES in batches of a convenient size,
(let* ((file-list (dired-get-marked-files t arg))
(command (dired-mark-read-string
"Print %s with: "
- (apply 'concat lpr-command " " lpr-switches)
+ (mapconcat 'identity
+ (cons lpr-command
+ (if (stringp lpr-switches)
+ (list lpr-switches)
+ lpr-switches))
+ " ")
'print arg file-list)))
(dired-run-shell-command (dired-shell-stuff-it command file-list nil))))
(defun dired-map-dired-file-lines (fun)
;; Perform FUN with point at the end of each non-directory line.
- ;; FUN takes one argument, the filename (complete pathname).
+ ;; FUN takes one argument, the absolute filename.
(save-excursion
(let (file buffer-read-only)
(goto-char (point-min))
(forward-line 1)))))
(defun dired-collect-file-versions (fn)
- ;; "If it looks like file FN has versions, return a list of the versions.
- ;;That is a list of strings which are file names.
- ;;The caller may want to flag some of these files for deletion."
- (let* ((base-versions
- (concat (file-name-nondirectory fn) ".~"))
- (bv-length (length base-versions))
- (possibilities (file-name-all-completions
- base-versions
- (file-name-directory fn)))
- (versions (mapcar 'backup-extract-version possibilities)))
- (if versions
- (setq dired-file-version-alist (cons (cons fn versions)
- dired-file-version-alist)))))
+ (let ((fn (file-name-sans-versions fn)))
+ ;; Only do work if this file is not already in the alist.
+ (if (assoc fn dired-file-version-alist)
+ nil
+ ;; If it looks like file FN has versions, return a list of the versions.
+ ;;That is a list of strings which are file names.
+ ;;The caller may want to flag some of these files for deletion.
+ (let* ((base-versions
+ (concat (file-name-nondirectory fn) ".~"))
+ (backup-extract-version-start (length base-versions))
+ (possibilities (file-name-all-completions
+ base-versions
+ (file-name-directory fn)))
+ (versions (mapcar 'backup-extract-version possibilities)))
+ (if versions
+ (setq dired-file-version-alist
+ (cons (cons fn versions)
+ dired-file-version-alist)))))))
(defun dired-trample-file-versions (fn)
(let* ((start-vn (string-match "\\.~[0-9]+~$" fn))
(insert dired-del-marker)))))
\f
;;; Shell commands
-;;>>> install (move this function into simple.el)
-(defun dired-shell-quote (filename)
- "Quote a file name for inferior shell (see variable `shell-file-name')."
- ;; Quote everything except POSIX filename characters.
- ;; This should be safe enough even for really wierd shells.
- (let ((result "") (start 0) end)
- (while (string-match "[^---0-9a-zA-Z_./]" filename start)
- (setq end (match-beginning 0)
- result (concat result (substring filename start end)
- "\\" (substring filename end (1+ end)))
- start (1+ end)))
- (concat result (substring filename start))))
(defun dired-read-shell-command (prompt arg files)
;; "Read a dired shell command prompting with PROMPT (using read-string).
(dired-mark-pop-up
nil 'shell files
(function read-string)
- (format prompt (dired-mark-prompt arg files))))
+ (format prompt (dired-mark-prompt arg files))
+ nil 'shell-command-history))
;; The in-background argument is only needed in Emacs 18 where
;; shell-command doesn't understand an appended ampersand `&'.
;;;###autoload
-(defun dired-do-shell-command (command &optional arg)
+(defun dired-do-shell-command (command &optional arg file-list)
"Run a shell command COMMAND on the marked files.
If no files are marked or a specific numeric prefix arg is given,
the next ARG files are used. Just \\[universal-argument] means the current file.
However, if there is a `*' in the command then it is run
just once with the entire file list substituted there.
+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.
+
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.
The shell command has the top level directory as working directory, so
-output files usually are created there instead of in a subdir."
+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."
;;Functions dired-run-shell-command and dired-shell-stuff-it do the
;;actual work and can be redefined for customization.
- (interactive (list
- ;; Want to give feedback whether this file or marked files are used:
- (dired-read-shell-command (concat "! on "
- "%s: ")
- current-prefix-arg
- (dired-get-marked-files
- t current-prefix-arg))
- current-prefix-arg))
- (let* ((on-each (not (string-match "\\*" command)))
- (file-list (dired-get-marked-files t arg)))
+ (interactive
+ (let ((files (dired-get-marked-files t current-prefix-arg)))
+ (list
+ ;; Want to give feedback whether this file or marked files are used:
+ (dired-read-shell-command (concat "! on "
+ "%s: ")
+ current-prefix-arg
+ files)
+ current-prefix-arg
+ files)))
+ (let* ((on-each (not (string-match "\\*" command))))
(if on-each
(dired-bunch-files
(- 10000 (length command))
;; (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 *
- ;; On the other hand, you can never accidentally get a * into your cmd.
+ ;; 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
- (if (string-match "\\*" command)
- (function (lambda (x)
- (dired-replace-in-string "\\*" x command)))
- (function (lambda (x) (concat command " " x))))))
+ (cond ((string-match "\\*" command)
+ (function (lambda (x)
+ (dired-replace-in-string "\\*" x command))))
+ ((string-match "\\?" command)
+ (function (lambda (x)
+ (dired-replace-in-string "\\?" x command))))
+ (t (function (lambda (x) (concat command " " x)))))))
(if on-each
- (mapconcat stuff-it (mapcar 'dired-shell-quote file-list) ";")
- (let ((fns (mapconcat 'dired-shell-quote
+ (mapconcat stuff-it (mapcar 'shell-quote-argument file-list) ";")
+ (let ((fns (mapconcat 'shell-quote-argument
file-list dired-mark-separator)))
(if (> (length file-list) 1)
(setq fns (concat dired-mark-prefix fns dired-mark-postfix)))
;; This is an extra function so that it can be redefined by ange-ftp.
(defun dired-run-shell-command (command)
- (shell-command command)
+ (let ((handler
+ (find-file-name-handler (directory-file-name default-directory)
+ 'shell-command)))
+ (if handler (apply handler 'shell-command (list command))
+ (shell-command command)))
;; Return nil for sake of nconc in dired-bunch-files.
nil)
\f
(defun dired-call-process (program discard &rest arguments)
; "Run PROGRAM with output to current buffer unless DISCARD is t.
;Remaining arguments are strings passed as command arguments to PROGRAM."
- (apply 'call-process program nil (not discard) nil arguments))
+ ;; Look for a handler for default-directory in case it is a remote file name.
+ (let ((handler
+ (find-file-name-handler (directory-file-name default-directory)
+ 'dired-call-process)))
+ (if handler (apply handler 'dired-call-process
+ program discard arguments)
+ (apply 'call-process program nil (not discard) nil arguments))))
(defun dired-check-process (msg program &rest arguments)
; "Display MSG while running PROGRAM, and check for output.
(from-file (dired-get-filename))
(new-file (dired-compress-file from-file)))
(if new-file
- (progn (dired-update-file-line new-file) nil)
+ (let ((start (point)))
+ ;; Remove any preexisting entry for the name NEW-FILE.
+ (condition-case nil
+ (dired-remove-entry new-file)
+ (error nil))
+ (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))
from-file)))
+(defvar dired-compress-file-suffixes
+ '(("\\.gz\\'" "" "gunzip")
+ ("\\.tgz\\'" ".tar" "gunzip")
+ ("\\.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")
+ ("\\.bz2\\'" "" "bunzip2")
+ ;; This item controls naming for compression.
+ ("\\.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)
+The rule applies when the old file name matches REGEXP.
+The new file name is computed by deleting the part that matches REGEXP
+ (as well as anything after that), then adding NEW-SUFFIX in its place.
+If PROGRAM is non-nil, the rule is an uncompression rule,
+and uncompression is done by running PROGRAM.
+Otherwise, the rule is a compression rule, and compression is done with gzip.")
+
+;;;###autoload
(defun dired-compress-file (file)
;; Compress or uncompress FILE.
;; Return the name of the compressed or uncompressed file.
- ;; Rerurn nil if no change in files.
- (let (handler (handlers file-name-handler-alist))
- (while (and (consp handlers) (null handler))
- (if (and (consp (car handlers))
- (stringp (car (car handlers)))
- (string-match (car (car handlers)) file))
- (setq handler (cdr (car handlers))))
- (setq handlers (cdr handlers)))
+ ;; Return nil if no change in files.
+ (let ((handler (find-file-name-handler file 'dired-compress-file))
+ suffix newname
+ (suffixes dired-compress-file-suffixes))
+ ;; See if any suffix rule matches this file name.
+ (while suffixes
+ (let (case-fold-search)
+ (if (string-match (car (car suffixes)) file)
+ (setq suffix (car suffixes) suffixes nil))
+ (setq suffixes (cdr suffixes))))
+ ;; If so, compute desired new name.
+ (if suffix
+ (setq newname (concat (substring file 0 (match-beginning 0))
+ (nth 1 suffix))))
(cond (handler
(funcall handler 'dired-compress-file file))
((file-symlink-p file)
nil)
- ((string-match "\\.Z$" file)
- (if (dired-check-process (concat "Uncompressing " from-file)
- "uncompress" from-file)
- (substring file 0 -2)))
+ ((and suffix (nth 2 suffix))
+ ;; We found an uncompression rule.
+ (if (not (dired-check-process (concat "Uncompressing " file)
+ (nth 2 suffix) file))
+ newname))
(t
- (if (dired-check-process (concat "Compressing " from-file)
- "compress" "-f" from-file)
- (concat name ".Z"))))))
+ ;;; 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 (not (dired-check-process (concat "Compressing " file)
+ "gzip" "-f" file))
+ (let ((out-name
+ (if (file-exists-p (concat file ".gz"))
+ (concat file ".gz")
+ (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))
+ ;; 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
;; Confirmation consists in a y-or-n question with a file list
;; pop-up unless OP-SYMBOL is a member of `dired-no-confirm'.
;; The files used are determined by ARG (as in dired-get-marked-files).
- (or (memq op-symbol dired-no-confirm)
- (let ((files (dired-get-marked-files t arg)))
+ (or (eq dired-no-confirm t)
+ (memq op-symbol dired-no-confirm)
+ (let ((files (dired-get-marked-files t arg))
+ (string (if (eq op-symbol 'compress) "Compress or uncompress"
+ (capitalize (symbol-name op-symbol)))))
(dired-mark-pop-up nil op-symbol files (function y-or-n-p)
- (concat (capitalize (symbol-name op-symbol)) " "
+ (concat string " "
(dired-mark-prompt arg files) "? ")))))
(defun dired-map-over-marks-check (fun arg op-symbol &optional show-progress)
(dired-map-over-marks (funcall fun) arg show-progress))
(total (length total-list))
(failures (delq nil total-list))
- (count (length failures)))
+ (count (length failures))
+ (string (if (eq op-symbol 'compress) "Compress or uncompress"
+ (capitalize (symbol-name op-symbol)))))
(if (not failures)
(message "%s: %d file%s."
- (capitalize (symbol-name op-symbol))
- total (dired-plural-s total))
+ string total (dired-plural-s total))
;; end this bunch of errors:
(dired-log-summary
(format "Failed to %s %d of %d file%s"
- (symbol-name op-symbol) count total (dired-plural-s total))
+ (downcase string) count total (dired-plural-s total))
failures)))))
(defvar dired-query-alist
(defun dired-byte-compile ()
;; Return nil for success, offending file name else.
(let* ((filename (dired-get-filename))
- (elc-file
- (if (eq system-type 'vax-vms)
- (concat (substring filename 0 (string-match ";" filename)) "c")
- (concat filename "c")))
- buffer-read-only failure)
+ elc-file buffer-read-only failure)
(condition-case err
(save-excursion (byte-compile-file filename))
(error
(setq failure err)))
+ (setq elc-file (byte-compile-dest-file filename))
+ (or (file-exists-p elc-file)
+ (setq failure t))
(if failure
(progn
(dired-log "Byte compile error for %s:\n%s\n" filename failure)
(if arg (read-string "Switches for listing: " dired-actual-switches)))
(message "Redisplaying...")
;; message much faster than making dired-map-over-marks show progress
+ (dired-uncache
+ (if (consp dired-directory) (car dired-directory) dired-directory))
(dired-map-over-marks (let ((fname (dired-get-filename)))
(message "Redisplaying... %s" fname)
(dired-update-file-line fname))
(delete-region (point) (progn (forward-line 1) (point)))
(if file
(progn
- (dired-add-entry file)
+ (dired-add-entry file nil t)
;; Replace space by old marker without moving point.
;; Faster than goto+insdel inside a save-excursion?
(subst-char-in-region opoint (1+ opoint) ?\040 char))))
(dired-move-to-filename))
-(defun dired-fun-in-all-buffers (directory fun &rest args)
+(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 directory))
+ (let ((buf-list (dired-buffers-for-dir (expand-file-name directory)
+ file))
(obuf (current-buffer))
buf success-list)
(while buf-list
(set-buffer obuf)))
success-list))
+;;;###autoload
(defun dired-add-file (filename &optional marker-char)
(dired-fun-in-all-buffers
- (file-name-directory filename)
+ (file-name-directory filename) (file-name-nondirectory filename)
(function dired-add-entry) filename marker-char))
-(defun dired-add-entry (filename &optional marker-char)
+(defun dired-add-entry (filename &optional marker-char relative)
;; Add a new entry for FILENAME, optionally marking it
;; with MARKER-CHAR (a character, else dired-marker-char is used).
;; Note that this adds the entry `out of order' if files sorted by
;; Hidden subdirs are exposed if a file is added there.
(setq filename (directory-file-name filename))
;; Entry is always for files, even if they happen to also be directories
- (let ((opoint (point))
+ (let* ((opoint (point))
(cur-dir (dired-current-directory))
- (directory (file-name-directory filename))
+ (orig-file-name filename)
+ (directory (if relative cur-dir (file-name-directory filename)))
reason)
- (setq filename (file-name-nondirectory filename)
+ (setq filename
+ (if relative
+ (file-relative-name filename directory)
+ (file-name-nondirectory filename))
reason
(catch 'not-found
(if (string= directory cur-dir)
(dired-goto-next-nontrivial-file))
;; not found
(throw 'not-found "Subdir not found")))
- ;; found and point is at The Right Place:
- (let (buffer-read-only)
+ (let (buffer-read-only opoint)
(beginning-of-line)
+ (setq opoint (point))
(dired-add-entry-do-indentation marker-char)
- ;; don't expand `.' !
- (insert-directory (dired-make-absolute filename directory)
- (concat dired-actual-switches "d"))
+ ;; don't expand `.'. Show just the file name within directory.
+ (let ((default-directory directory))
+ (insert-directory filename
+ (concat dired-actual-switches "d")))
+ ;; Compensate for a bug in ange-ftp.
+ ;; 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)
+ (let ((inserted-name (dired-get-filename 'no-dir)))
+ (if (file-name-directory inserted-name)
+ (progn
+ (end-of-line)
+ (delete-char (- (length inserted-name)))
+ (insert filename)
+ (forward-char 1))
+ (forward-line 1)))
+ ;; Give each line a text property recording info about it.
+ (dired-insert-set-properties opoint (point))
(forward-line -1)
- ;; We want to have the non-directory part, only:
- (let* ((beg (dired-move-to-filename t)) ; error for strange output
- (end (dired-move-to-end-of-filename)))
- (setq filename (buffer-substring beg end))
- (delete-region beg end)
- (insert (file-name-nondirectory filename)))
(if dired-after-readin-hook;; the subdir-alist is not affected...
(save-excursion;; ...so we can run it right now:
(save-restriction
nil))
(if reason ; don't move away on failure
(goto-char opoint))
- (not reason))) ; return t on succes, nil else
+ (not reason))) ; return t on success, nil else
;; This is a separate function for the sake of nested dired format.
(defun dired-add-entry-do-indentation (marker-char)
(forward-line 1))
(point)))
+;;;###autoload
(defun dired-remove-file (file)
(dired-fun-in-all-buffers
- (file-name-directory file) (function dired-remove-entry) file))
+ (file-name-directory file) (file-name-nondirectory file)
+ (function dired-remove-entry) file))
(defun dired-remove-entry (file)
(save-excursion
(delete-region (progn (beginning-of-line) (point))
(save-excursion (forward-line 1) (point)))))))
+;;;###autoload
(defun dired-relist-file (file)
(dired-fun-in-all-buffers (file-name-directory file)
+ (file-name-nondirectory file)
(function dired-relist-entry) file))
(defun dired-relist-entry (file)
;; Relist the line for FILE, or just add it if it did not exist.
- ;; FILE must be an absolute pathname.
+ ;; FILE must be an absolute file name.
(let (buffer-read-only marker)
;; If cursor is already on FILE's line delete-region will cause
;; save-excursion to fail because of floating makers,
\f
;;; Copy, move/rename, making hard and symbolic links
-(defvar dired-backup-overwrite nil
+(defcustom dired-recursive-copies nil
+ "*Decide whether recursive copies are allowed.
+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."
+ :type '(choice :tag "Copy directories"
+ (const :tag "No recursive copies" nil)
+ (const :tag "Ask for each directory" t)
+ (const :tag "Ask for each top directory only" top)
+ (const :tag "Copy directories without asking" always))
+ :group 'dired)
+
+(defcustom dired-backup-overwrite nil
"*Non-nil if Dired should ask about making backups before overwriting files.
-Special value `always' suppresses confirmation.")
+Special value `always' suppresses confirmation."
+ :type '(choice (const :tag "off" nil)
+ (const :tag "suppress" always)
+ (other :tag "ask" t))
+ :group 'dired)
(defvar dired-overwrite-confirmed)
;; Save old version of a to be overwritten file TO.
;; `dired-overwrite-confirmed' and `overwrite-backup-query' are fluid vars
;; from dired-create-files.
- (if (and dired-backup-overwrite
- dired-overwrite-confirmed
- (or (eq 'always dired-backup-overwrite)
- (dired-query 'overwrite-backup-query
- (format "Make backup for existing file `%s'? " to))))
- (let ((backup (car (find-backup-file-name to))))
- (rename-file to backup 0) ; confirm overwrite of old backup
- (dired-relist-entry backup))))
+ (let (backup)
+ (if (and dired-backup-overwrite
+ dired-overwrite-confirmed
+ (setq backup (car (find-backup-file-name to)))
+ (or (eq 'always dired-backup-overwrite)
+ (dired-query 'overwrite-backup-query
+ (format "Make backup for existing file `%s'? "
+ to))))
+ (progn
+ (rename-file to backup 0) ; confirm overwrite of old backup
+ (dired-relist-entry backup)))))
+;;;###autoload
(defun dired-copy-file (from to ok-flag)
(dired-handle-overwrite to)
- (copy-file from to ok-flag dired-copy-preserve-time))
+ (condition-case ()
+ (dired-copy-file-recursive from to ok-flag dired-copy-preserve-time t
+ dired-recursive-copies)
+ (file-date-error (message "Can't set date")
+ (sit-for 1))))
+
+(defun dired-copy-file-recursive (from to ok-flag &optional
+ preserve-time top recursive)
+ (if (and recursive
+ (eq t (car (file-attributes from))) ; A directory, no symbolic link.
+ (or (eq recursive 'always)
+ (yes-or-no-p (format "Recursive copies of %s " from))))
+ (let ((files (directory-files from nil dired-re-no-dot)))
+ (if (eq recursive 'top) (setq recursive 'always)) ; Don't ask any more.
+ (if (file-exists-p to)
+ (or top (dired-handle-overwrite to))
+ (make-directory to))
+ (while files
+ (dired-copy-file-recursive
+ (expand-file-name (car files) from)
+ (expand-file-name (car files) to)
+ ok-flag preserve-time nil recursive)
+ (setq files (cdr files))))
+ (or top (dired-handle-overwrite to)) ; Just a file.
+ (copy-file from to ok-flag dired-copy-preserve-time)))
+;;;###autoload
(defun dired-rename-file (from to ok-flag)
(dired-handle-overwrite to)
(rename-file from to ok-flag) ; error is caught in -create-files
;; Silently rename the visited file of any buffer visiting this file.
(and (get-file-buffer from)
- (save-excursion
- (set-buffer (get-file-buffer from))
- (let ((modflag (buffer-modified-p)))
- (set-visited-file-name to)
- (set-buffer-modified-p modflag))))
+ (with-current-buffer (get-file-buffer from)
+ (set-visited-file-name to nil t)))
(dired-remove-file from)
;; See if it's an inserted subdir, and rename that, too.
(dired-rename-subdir from to))
(defun dired-rename-subdir (from-dir to-dir)
(setq from-dir (file-name-as-directory from-dir)
to-dir (file-name-as-directory to-dir))
- (dired-fun-in-all-buffers from-dir
+ (dired-fun-in-all-buffers from-dir nil
(function dired-rename-subdir-1) from-dir to-dir)
;; Update visited file name of all affected buffers
- (let ((blist (buffer-list)))
+ (let ((expanded-from-dir (expand-file-name from-dir))
+ (blist (buffer-list)))
(while blist
(save-excursion
- (set-buffer (car blist))
+ (set-buffer (car blist))
(if (and buffer-file-name
- (dired-in-this-tree buffer-file-name from-dir))
+ (dired-in-this-tree buffer-file-name expanded-from-dir))
(let ((modflag (buffer-modified-p))
(to-file (dired-replace-in-string
(concat "^" (regexp-quote from-dir))
(defun dired-rename-subdir-1 (dir to)
;; Rename DIR to TO in headerlines and dired-subdir-alist, if DIR or
;; one of its subdirectories is expanded in this buffer.
- (let ((alist dired-subdir-alist)
+ (let ((expanded-dir (expand-file-name dir))
+ (alist dired-subdir-alist)
(elt nil))
(while alist
(setq elt (car alist)
alist (cdr alist))
- (if (dired-in-this-tree (car elt) dir)
+ (if (dired-in-this-tree (car elt) expanded-dir)
;; ELT's subdir is affected by the rename
(dired-rename-subdir-2 elt dir to)))
(if (equal dir default-directory)
(dired-normalize-subdir
(dired-replace-in-string regexp newtext (car elt)))))))
\f
-;; Cloning replace-match to work on strings instead of in buffer:
-;; The FIXEDCASE parameter of replace-match is not implemented.
-;;;###autoload
-(defun dired-string-replace-match (regexp string newtext
- &optional literal global)
- "Replace first match of REGEXP in STRING with NEWTEXT.
-If it does not match, nil is returned instead of the new string.
-Optional arg LITERAL means to take NEWTEXT literally.
-Optional arg GLOBAL means to replace all matches."
- (if global
- (let ((result "") (start 0) mb me)
- (while (string-match regexp string start)
- (setq mb (match-beginning 0)
- me (match-end 0)
- result (concat result
- (substring string start mb)
- (if literal
- newtext
- (dired-expand-newtext string newtext)))
- start me))
- (if mb ; matched at least once
- (concat result (substring string start))
- nil))
- ;; not GLOBAL
- (if (not (string-match regexp string 0))
- nil
- (concat (substring string 0 (match-beginning 0))
- (if literal newtext (dired-expand-newtext string newtext))
- (substring string (match-end 0))))))
-
-(defun dired-expand-newtext (string newtext)
- ;; Expand \& and \1..\9 (referring to STRING) in NEWTEXT, using match data.
- ;; Note that in Emacs 18 match data are clipped to current buffer
- ;; size...so the buffer should better not be smaller than STRING.
- (let ((pos 0)
- (len (length newtext))
- (expanded-newtext ""))
- (while (< pos len)
- (setq expanded-newtext
- (concat expanded-newtext
- (let ((c (aref newtext pos)))
- (if (= ?\\ c)
- (cond ((= ?\& (setq c
- (aref newtext
- (setq pos (1+ pos)))))
- (substring string
- (match-beginning 0)
- (match-end 0)))
- ((and (>= c ?1) (<= c ?9))
- ;; return empty string if N'th
- ;; sub-regexp did not match:
- (let ((n (- c ?0)))
- (if (match-beginning n)
- (substring string
- (match-beginning n)
- (match-end n))
- "")))
- (t
- (char-to-string c)))
- (char-to-string c)))))
- (setq pos (1+ pos)))
- expanded-newtext))
-\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)
;; which will be added. The user will be queried if the file already
;; exists. If oldfile is removed by FILE-CREATOR (i.e, it is a
;; rename), it is FILE-CREATOR's responsibility to update dired
-;; buffers. FILE-CREATOR must abort by signalling a file-error if it
+;; buffers. FILE-CREATOR must abort by signaling a file-error if it
;; could not create newfile. The error is caught and logged.
;; OPERATION (a capitalized string, e.g. `Copy') describes the
;; operation performed. It is used for error logging.
-;; FN-LIST is the list of files to copy (full absolute pathnames).
+;; FN-LIST is the list of files to copy (full absolute file names).
;; NAME-CONSTRUCTOR returns a newfile for every oldfile, or nil to
;; skip. If it skips files for other reasons than a direct user
;; the new files. Target may be a plain file if only one marked
;; file exists.
;; OP-SYMBOL is the symbol for the operation. Function `dired-mark-pop-up'
- ;; will determine wether pop-ups are appropriate for this OP-SYMBOL.
+ ;; 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 MARKER-CHAR as in dired-create-files.
- ;; Optional arg HOW-TO determines how to treat target:
- ;; If HOW-TO is not given (or nil), and target is a directory, the
- ;; file(s) are created inside the target directory. If target
- ;; is not a directory, there must be exactly one marked file,
- ;; else error.
- ;; If HOW-TO is t, then target is not modified. There must be
- ;; exactly one marked file, else error.
- ;; Else HOW-TO is assumed to be a function of one argument, target,
+ ;; Optional arg HOW-TO is used to set the value of the into-dir variable
+ ;; which determines how to treat target.
+ ;; If into-dir is set to nil then target is not regarded as a directory,
+ ;; there must be exactly one marked file, else error.
+ ;; Else if into-dir is set to a list, then target is a genearlized
+ ;; directory (e.g. some sort of archive). The first element of into-dir
+ ;; must be a function with at least four arguments:
+ ;; operation as OPERATION above.
+ ;; rfn-list a list of the relative names for the marked files.
+ ;; fn-list a list of the absolute names for the marked files.
+ ;; target.
+ ;; The rest of into-dir are optional arguments.
+ ;; Else into-dir is not a list. Target is a directory.
+ ;; The marked file(s) are created inside the target directory.
+ ;;
+ ;; If HOW-TO is not given (or nil), then into-dir is set to true if
+ ;; target is a directory and otherwise to nil.
+ ;; Else if HOW-TO is t, then into-dir is set to nil.
+ ;; Else HOW-TO is assumed to be a function of one argument, target,
;; that looks at target and returns a value for the into-dir
;; variable. The function dired-into-dir-with-symlinks is provided
;; for the case (common when creating symlinks) that symbolic
;; (as file-directory-p would if HOW-TO had been nil).
(or op1 (setq op1 operation))
(let* ((fn-list (dired-get-marked-files nil arg))
- (fn-count (length fn-list))
- (target (expand-file-name
+ (rfn-list (mapcar (function 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)))
+ (target (expand-file-name ; fluid variable inside dired-create-files
(dired-mark-read-file-name
- (concat (if (= 1 fn-count) op1 operation) " %s to: ")
+ (concat (if dired-one-file op1 operation) " %s to: ")
(dired-dwim-target-directory)
- op-symbol arg (mapcar (function dired-make-relative) fn-list))))
+ op-symbol arg rfn-list)))
(into-dir (cond ((null how-to) (file-directory-p target))
((eq how-to t) nil)
(t (funcall how-to target)))))
- (if (and (> fn-count 1)
- (not into-dir))
- (error "Marked %s: target must be a directory: %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 vars into-dir and target when called
- ;; inside dired-create-files:
- (function (lambda (from)
- (expand-file-name (file-name-nondirectory from) target)))
- (function (lambda (from) target)))
- marker-char)))
+ (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))
+ ;; 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:
+ (function
+ (lambda (from)
+ (expand-file-name (file-name-nondirectory from) target)))
+ (function (lambda (from) target)))
+ marker-char))))
;; Read arguments for a marked-files command that wants a file name,
;; perhaps popping up the list of marked files.
;; just have to remove that symlink by hand before making your marked
;; symlinks.
+(defvar dired-copy-how-to-fn nil
+ "Nil or a function used by `dired-do-copy' to determine target.
+See HOW-TO argument for `dired-do-create-files'.")
+
;;;###autoload
(defun dired-do-copy (&optional arg)
"Copy all marked (or next ARG) files, or copy the current file.
This normally preserves the last-modified date when copying.
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
+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."
(interactive "P")
- (dired-do-create-files 'copy (function dired-copy-file)
- (if dired-copy-preserve-time "Copy [-p]" "Copy")
- arg dired-keep-marker-copy))
+n (let ((dired-recursive-copies dired-recursive-copies))
+ (dired-do-create-files 'copy (function dired-copy-file)
+ (if dired-copy-preserve-time "Copy [-p]" "Copy")
+ arg dired-keep-marker-copy
+ nil dired-copy-how-to-fn)))
;;;###autoload
(defun dired-do-symlink (&optional arg)
;; ARG as in dired-get-marked-files.
;; Matches each marked file against REGEXP and constructs the new
;; filename from NEWNAME (like in function replace-match).
- ;; Optional arg WHOLE-PATH means match/replace the whole pathname
+ ;; Optional arg WHOLE-PATH means match/replace the whole file name
;; instead of only the non-directory part of the file.
;; Optional arg MARKER-CHAR as in dired-create-files.
(let* ((fn-list (dired-get-marked-files nil arg))
(if whole-path nil current-prefix-arg))
(regexp
(dired-read-regexp
- (concat (if whole-path "Path " "") operation " from (regexp): ")
- dired-flagging-regexp))
+ (concat (if whole-path "Path " "") operation " from (regexp): ")))
(newname
(read-string
(concat (if whole-path "Path " "") operation " " regexp " to: "))))
what to do with it. For directions, type \\[help-command] at that time.
NEWNAME may contain \\=\\<n> or \\& as in `query-replace-regexp'.
REGEXP defaults to the last regexp used.
-With a zero prefix arg, renaming by regexp affects the complete
- pathname - usually only the non-directory part of file names is used
- and changed."
+
+With a zero prefix arg, renaming by regexp affects the absolute file name.
+Normally, only the non-directory part of the file name is used and changed."
(interactive (dired-mark-read-regexp "Rename"))
(dired-do-create-files-regexp
(function dired-rename-file)
;;;###autoload
(defun dired-do-copy-regexp (regexp newname &optional arg whole-path)
"Copy all marked files containing REGEXP to NEWNAME.
-See function `dired-rename-regexp' for more info."
+See function `dired-do-rename-regexp' for more info."
(interactive (dired-mark-read-regexp "Copy"))
- (dired-do-create-files-regexp
- (function dired-copy-file)
- (if dired-copy-preserve-time "Copy [-p]" "Copy")
- arg regexp newname whole-path dired-keep-marker-copy))
+ (let ((dired-recursive-copies nil)) ; No recursive copies.
+ (dired-do-create-files-regexp
+ (function dired-copy-file)
+ (if dired-copy-preserve-time "Copy [-p]" "Copy")
+ arg regexp newname whole-path dired-keep-marker-copy)))
;;;###autoload
(defun dired-do-hardlink-regexp (regexp newname &optional arg whole-path)
"Hardlink all marked files containing REGEXP to NEWNAME.
-See function `dired-rename-regexp' for more info."
+See function `dired-do-rename-regexp' for more info."
(interactive (dired-mark-read-regexp "HardLink"))
(dired-do-create-files-regexp
(function add-name-to-file)
;;;###autoload
(defun dired-do-symlink-regexp (regexp newname &optional arg whole-path)
"Symlink all marked files containing REGEXP to NEWNAME.
-See function `dired-rename-regexp' for more info."
+See function `dired-do-rename-regexp' for more info."
(interactive (dired-mark-read-regexp "SymLink"))
(dired-do-create-files-regexp
(function make-symbolic-link)
;; insert message so that the user sees the `Mark set' message.
(push-mark opoint)))
+;;;###autoload
(defun dired-insert-subdir (dirname &optional switches no-error-if-not-dir-p)
"Insert this subdirectory into the same dired buffer.
If it is already present, overwrites previous entry,
(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 default-directory)
+ (or (dired-in-this-tree dirname (expand-file-name default-directory))
(error "%s: not in this directory tree" dirname))
(if switches
(let (case-fold-search)
;;"Kill all proper subdirs of DIRNAME, excluding DIRNAME itself.
;; With optional arg REMEMBER-MARKS, return an alist of marked files."
(interactive "DKill tree below directory: ")
+ (setq dirname (expand-file-name dirname))
(let ((s-alist dired-subdir-alist) dir m-alist)
(while s-alist
(setq dir (car (car s-alist))
(if (equal dirname (car (car (reverse dired-subdir-alist))))
;; top level directory may contain wildcards:
(dired-readin-insert dired-directory)
- (insert-directory dirname dired-actual-switches nil t)))
+ (let ((opoint (point)))
+ (insert-directory dirname dired-actual-switches nil t)
+ (dired-insert-set-properties opoint (point)))))
(message "Reading directory %s...done" dirname)
(setq end (point-marker))
(indent-rigidly begin end 2)
;; moves point.
;; Need a marker for END as this inserts text.
(goto-char begin)
- (dired-insert-headerline dirname)
+ (if (not (looking-at "^ /.*:$"))
+ (dired-insert-headerline dirname))
;; point is now like in dired-build-subdir-alist
(prog1
(list begin (marker-position end))
(run-hooks 'dired-after-readin-hook))))))
(defun dired-tree-lessp (dir1 dir2)
- ;; Lexicographic order on pathname components, like `ls -lR':
+ ;; Lexicographic order on file name components, like `ls -lR':
;; DIR1 < DIR2 iff DIR1 comes *before* DIR2 in an `ls -lR' listing,
;; i.e., iff DIR1 is a (grand)parent dir of DIR2,
;; or DIR1 and DIR2 are in the same parentdir and their last
\f
;;;###autoload
(defun dired-mark-subdir-files ()
- "Mark all files except `.' and `..'."
- (interactive "P")
+ "Mark all files except `.' and `..' in current subdirectory.
+If the Dired buffer shows multiple directories, this command
+marks the files listed in the subdirectory that point is in."
+ (interactive)
(let ((p-min (dired-subdir-min)))
(dired-mark-files-in-region p-min (dired-subdir-max))))
;;;###end dired-ins.el
+\f
+;; Functions for searching in tags style among marked files.
+
+;;;###autoload
+(defun dired-do-search (regexp)
+ "Search through all marked files for a match for REGEXP.
+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)))
+
+;;;###autoload
+(defun dired-do-query-replace (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
+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)))
+\f
+
+(provide 'dired-aux)
+
;;; dired-aux.el ends here