[Emacs-diffs] Changes to emacs/lisp/dired-aux.el,v

[Richard M. Stallman]

CVSROOT:        /cvsroot/emacs
Module name:    emacs
Changes by:     Richard M. Stallman <rms>       06/09/11 02:24:27

Index: dired-aux.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/dired-aux.el,v
retrieving revision 1.146
retrieving revision 1.147
diff -u -b -r1.146 -r1.147
--- dired-aux.el        17 Jul 2006 04:00:54 -0000      1.146
+++ dired-aux.el        11 Sep 2006 02:24:26 -0000      1.147
@@ -39,6 +39,11 @@
 ;; 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
@@ -1145,37 +1150,59 @@
 ;;;###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-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.
+         (unless dirfailed
          (if (file-exists-p to)
              (or top (dired-handle-overwrite to))
-           (make-directory 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)))))
          (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))))
+           (pop files)))
       ;; Not a directory.
       (or top (dired-handle-overwrite to))
+      (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)))))
+           (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))
+       (file-error
+        (push (dired-make-relative from)
+              dired-create-files-failures)
+        (dired-log "Copying error for %s:\n%s\n" from err))))))
 
 ;;;###autoload
 (defun dired-rename-file (file newname ok-if-already-exists)
@@ -1297,7 +1324,8 @@
 ;; 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
@@ -1340,16 +1368,25 @@
                    (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