emacs-pretest-bug
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: Recursive copies in dired abort on first error


From: Richard Stallman
Subject: Re: Recursive copies in dired abort on first error
Date: Sat, 09 Sep 2006 16:45:22 -0400

    The reason is that the variable was still inconsistently spelled;
    sometimes dired-create-file-failures and sometimes
    dired-create-files-failures.

Strange -- they are spelled consistently in my version.

Anyway, I think I fixed the confusing `29 out of 2 files' message.
Please try this:



*** dired-aux.el        17 Jul 2006 16:31:56 -0400      1.146
--- dired-aux.el        08 Sep 2006 16:48:37 -0400      
***************
*** 39,44 ****
--- 39,49 ----
  ;; 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,1181 ****
  ;;;###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))))
  
  (defun dired-copy-file-recursive (from to ok-flag &optional
                                       preserve-time top recursive)
!   (let ((attrs (file-attributes from)))
      (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)))
          (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))))
        ;; 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)))))
  
  ;;;###autoload
  (defun dired-rename-file (file newname ok-if-already-exists)
--- 1150,1208 ----
  ;;;###autoload
  (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))
  
  (defun dired-copy-file-recursive (from to ok-flag &optional
                                       preserve-time top recursive)
!   (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
!              (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))
!             (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)
!           (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))
!       (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,1303 ****
  ;; 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 (to overwrite-query
             overwrite-backup-query)    ; for dired-handle-overwrite
        (mapcar
--- 1324,1331 ----
  ;; newfile's entry, or t to use the current marker character if the
  ;; oldfile was marked.
  
!   (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,1355 ****
                    (dired-add-file to actual-marker-char))
                (file-error             ; FILE-CREATOR aborted
                 (progn
!                  (setq failures (cons (dired-make-relative from) failures))
                   (dired-log "%s `%s' to `%s' failed:\n%s\n"
                              operation from to err))))))))
         fn-list))
      (cond
       (failures
        (dired-log-summary
         (format "%s failed for %d of %d file%s"
!               operation (length failures) total
!               (dired-plural-s total))
         failures))
       (skipped
        (dired-log-summary
--- 1368,1392 ----
                    (dired-add-file to actual-marker-char))
                (file-error             ; FILE-CREATOR aborted
                 (progn
!                  (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 failures)
+               total)
+        failures))
       (failures
        (dired-log-summary
         (format "%s failed for %d of %d file%s"
!               operation (length failures)
!               total (dired-plural-s total))
         failures))
       (skipped
        (dired-log-summary




reply via email to

[Prev in Thread] Current Thread [Next in Thread]