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: Mon, 04 Sep 2006 13:19:02 -0400

Please try this patch instead.  It should proceed past an unreadable
directory.

*** dired-aux.el        17 Jul 2006 16:31:56 -0400      1.146
--- dired-aux.el        04 Sep 2006 12:43:21 -0400      
***************
*** 1142,1181 ****
          (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)
    (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)
--- 1142,1210 ----
          (rename-file to backup 0)     ; confirm overwrite of old backup
          (dired-relist-entry backup)))))
  
+ (defvar dired-copy-file-failures)
+ 
  ;;;###autoload
  (defun dired-copy-file (from to ok-flag)
    (dired-handle-overwrite to)
    (condition-case ()
!       (let (dired-copy-file-failures)
!       (progn
!         (dired-copy-file-recursive from to ok-flag dired-copy-preserve-time t
!                                    dired-recursive-copies)
!         (if dired-copy-file-failures
!             (dired-log-summary "Failed copies" dired-copy-file-failures))))
! ))
  
  (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-copy-file-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-copy-file-failures)
!                (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-copy-file-failures)
!        (dired-log "Can't set date on %s:\n%s\n" from err))
!       (file-error
!        (push (dired-make-relative from)
!              dired-copy-file-failures)
!        (dired-log "Copying error for %s:\n%s\n" from err))))))
  
  ;;;###autoload
  (defun dired-rename-file (file newname ok-if-already-exists)




reply via email to

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