;;; dired-aux.el --- less commonly used parts of dired -*-byte-compile-dynamic: t;-*-
;; Copyright (C) 1985, 1986, 1992, 1994, 1998, 2000, 2001, 2002, 2003,
-;; 2004, 2005 Free Software Foundation, Inc.
+;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>.
;; Maintainer: FSF
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; We need macros in dired.el to compile properly.
(eval-when-compile (require 'dired))
+(defvar dired-create-files-failures nil
+ "Variable where `dired-create-files' records failing file names.
+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
in a subdir.
In a noninteractive call (from Lisp code), you must specify
-the list of file names explicitly with the FILE-LIST argument."
+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.
(interactive
;;; 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)))
+ (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)))
(file-error
(if (not (dired-check-process (concat "Compressing " file)
"compress" "-f" file))
may have to reset some subdirectory switches after a `dired-undo'.
You can reset all subdirectory switches to the default using
\\<dired-mode-map>\\[dired-reset-subdir-switches].
-See Info node `(emacs-xtra)Subdir switches' for more details."
+See Info node `(emacs)Subdir switches' for more details."
;; Moves point if the next ARG files are redisplayed.
(interactive "P\np")
(if (and test-for-subdir (dired-get-subdir))
;;;###autoload
(defun dired-copy-file (from to ok-flag)
(dired-handle-overwrite to)
- (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))))
+ (dired-copy-file-recursive from to ok-flag dired-copy-preserve-time t
+ dired-recursive-copies))
(defun dired-copy-file-recursive (from to ok-flag &optional
preserve-time top recursive)
- (let ((attrs (file-attributes from)))
+ (let ((attrs (file-attributes from))
+ dirfailed)
(if (and recursive
(eq t (car attrs))
(or (eq recursive 'always)
(yes-or-no-p (format "Recursive copies of %s? " from))))
;; This is a directory.
- (let ((files (directory-files from nil dired-re-no-dot)))
+ (let ((files
+ (condition-case err
+ (directory-files from nil dired-re-no-dot)
+ (file-error
+ (push (dired-make-relative from)
+ dired-create-files-failures)
+ (dired-log "Copying error for %s:\n%s\n" from err)
+ (setq dirfailed t)
+ nil))))
(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))))
+ (unless dirfailed
+ (if (file-exists-p to)
+ (or top (dired-handle-overwrite to))
+ (condition-case err
+ (make-directory to)
+ (file-error
+ (push (dired-make-relative from)
+ dired-create-files-failures)
+ (setq files nil)
+ (dired-log "Copying error for %s:\n%s\n" from err)))))
+ (dolist (file files)
+ (let ((thisfrom (expand-file-name file from))
+ (thisto (expand-file-name file to)))
+ ;; Catch errors copying within a directory,
+ ;; and report them through the dired log mechanism
+ ;; just as our caller will do for the top level files.
+ (condition-case err
+ (dired-copy-file-recursive
+ thisfrom thisto
+ ok-flag preserve-time nil recursive)
+ (file-error
+ (push (dired-make-relative thisfrom)
+ dired-create-files-failures)
+ (dired-log "Copying error for %s:\n%s\n" thisfrom err))))))
;; Not a directory.
(or top (dired-handle-overwrite to))
- (if (stringp (car attrs))
- ;; It is a symlink
- (make-symbolic-link (car attrs) to ok-flag)
- (copy-file from to ok-flag dired-copy-preserve-time)))))
+ (condition-case err
+ (if (stringp (car attrs))
+ ;; It is a symlink
+ (make-symbolic-link (car attrs) to ok-flag)
+ (copy-file from to ok-flag dired-copy-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))))))
;;;###autoload
(defun dired-rename-file (file newname ok-if-already-exists)
;; newfile's entry, or t to use the current marker character if the
;; oldfile was marked.
- (let (failures skipped (success-count 0) (total (length fn-list)))
+ (let (dired-create-files-failures failures
+ skipped (success-count 0) (total (length fn-list)))
(let (to overwrite-query
overwrite-backup-query) ; for dired-handle-overwrite
(mapcar
(dired-add-file to actual-marker-char))
(file-error ; FILE-CREATOR aborted
(progn
- (setq failures (cons (dired-make-relative from) failures))
+ (push (dired-make-relative from)
+ failures)
(dired-log "%s `%s' to `%s' failed:\n%s\n"
operation from to err))))))))
fn-list))
(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)
+ failures))
(failures
(dired-log-summary
(format "%s failed for %d of %d file%s"
- operation (length failures) total
- (dired-plural-s total))
+ operation (length failures)
+ total (dired-plural-s total))
failures))
(skipped
(dired-log-summary
and new copies of these files 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.
+
+This command copies symbolic links by creating new ones,
+like `cp -d'."
(interactive "P")
(let ((dired-recursive-copies dired-recursive-copies))
(dired-do-create-files 'copy (function dired-copy-file)
and new symbolic 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.
+
+For relative symlinks, use \\[dired-do-relsymlink]."
(interactive "P")
(dired-do-create-files 'symlink (function make-symbolic-link)
"Symlink" arg dired-keep-marker-symlink))
may have to reset some subdirectory switches after a `dired-undo'.
You can reset all subdirectory switches to the default using
\\<dired-mode-map>\\[dired-reset-subdir-switches].
-See Info node `(emacs-xtra)Subdir switches' for more details."
+See Info node `(emacs)Subdir switches' for more details."
(interactive
(list (dired-get-filename)
(if current-prefix-arg
(defun dired-tree-lessp (dir1 dir2)
;; 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,
+ ;; DIR1 < DIR2 if DIR1 comes *before* DIR2 in an `ls -lR' listing,
+ ;; i.e., if DIR1 is a (grand)parent dir of DIR2,
;; or DIR1 and DIR2 are in the same parentdir and their last
;; components are string-lessp.
;; Thus ("/usr/" "/usr/bin") and ("/usr/a/" "/usr/b/") are tree-lessp.