[Top][All Lists]

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

Re: bug in copy-directory

From: Thierry Volpiatto
Subject: Re: bug in copy-directory
Date: Wed, 09 Feb 2011 17:11:06 +0100
User-agent: Gnus/5.110011 (No Gnus v0.11) Emacs/23.2.93 (gnu/linux)

Chong Yidong <address@hidden> writes:

> Michael Albinus <address@hidden> writes:
>> If this is not possible, we shall fall back to the Emacs 23.2
>> implementation, which is less broken compared with the current status.
> Explain again why the current status is more broken than Emacs 23.2.  As
> far as I can tell, if the copy-as-subdir arg is nil, the Lisp behavior
> is identical to 23.2.
>> I would vote for continuing with the last patch from Thierry, not
>> committed yet. Maybe it is possible to throw copy-directory-1 away,
>> and to adapt the call of copy-directory in Dired instead of.
> Adding a separate copy-directory-1 function does nothing different from
> adding an optional argument to copy-directory that modifies its
> behavior.  Not much point.

I am actually trying something different, i sent patch to Michael and
I restart from the Chong version without extra arg.
This version works outside of dired interactvely and not.

Then i modify a little dired-create-files.
dired-copy-file-recursive have to call now copy-directory as
copy-directory-1 doesn't exists anymore.

It works here in dired, all scenarios of copy-directory and i tried with
sudo method from dired and it works also.

Could you test on your side?

 lisp/dired-aux.el |   91 ++---------------------------------------------------
 lisp/files.el     |   53 +++++++++++++------------------
 2 files changed, 25 insertions(+), 119 deletions(-)

diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 28b285f..5bb9d73 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1345,6 +1345,7 @@ Special value `always' suppresses confirmation."
        (when cons (setcar cons cur-dir))))))
 ;; 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)
@@ -1403,6 +1404,8 @@ ESC or `q' to not overwrite any of the remaining files,
                   (cond  ((integerp marker-char) marker-char)
                          (marker-char (dired-file-marker from)) ; slow
                          (t nil))))
+            (when (and (file-directory-p from) (eq file-creator 
+              (setq to (file-name-directory to)))
             (condition-case err
                   (funcall file-creator from to dired-overwrite-confirmed)
@@ -1445,94 +1448,6 @@ ESC or `q' to not overwrite any of the remaining files,
       (message "%s: %s file%s"
               operation success-count (dired-plural-s success-count)))))
-(defun dired-do-create-files (op-symbol file-creator operation arg
-                                       &optional marker-char op1
-                                       how-to)
-  "Create a new file for each marked file.
-Prompts user for target, which is a directory in which to create
-  the new files.  Target may also be a plain file if only one marked
-  file exists.  The way the default for the target directory is
-  computed depends on the value of `dired-dwim-target-directory'.
-OP-SYMBOL is the symbol for the operation.  Function `dired-mark-pop-up'
-  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 HOW-TO determiness how to treat the target.
-  If HOW-TO is nil, use `file-directory-p' to determine if the
-   target is a directory.  If so, the marked file(s) are created
-   inside that directory.  Otherwise, the target is a plain file;
-   an error is raised unless there is exactly one marked file.
-  If HOW-TO is t, target is always treated as a plain file.
-  Otherwise, HOW-TO should be a function of one argument, TARGET.
-   If its return value is nil, TARGET is regarded as a plain file.
-   If it return value is a list, TARGET is a generalized
-    directory (e.g. some sort of archive).  The first element of
-    this list must be a function with at least four arguments:
-      operation - as OPERATION above.
-      rfn-list  - list of the relative names for the marked files.
-      fn-list   - list of the absolute names for the marked files.
-      target    - the name of the target itself.
-      The rest of into-dir are optional arguments.
-   For any other return value, TARGET is treated as a directory."
-  (or op1 (setq op1 operation))
-  (let* ((fn-list (dired-get-marked-files nil arg))
-        (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-dir (dired-dwim-target-directory))
-        (default (and dired-one-file
-                      (expand-file-name (file-name-nondirectory (car fn-list))
-                                        target-dir)))
-        (defaults (dired-dwim-target-defaults fn-list target-dir))
-        (target (expand-file-name ; fluid variable inside dired-create-files
-                 (minibuffer-with-setup-hook
-                     (lambda ()
-                       (set (make-local-variable 
'minibuffer-default-add-function) nil)
-                       (setq minibuffer-default defaults))
-                   (dired-mark-read-file-name
-                    (concat (if dired-one-file op1 operation) " %s to: ")
-                    target-dir op-symbol arg rfn-list default))))
-        (into-dir (cond ((null how-to)
-                         ;; Allow DOS/Windows users to change the letter
-                         ;; case of a directory.  If we don't test these
-                         ;; conditions up front, file-directory-p below
-                         ;; will return t because the filesystem is
-                         ;; case-insensitive, and Emacs will try to move
-                         ;; foo -> foo/foo, which fails.
-                         (if (and (memq system-type '(ms-dos windows-nt 
-                                  (eq op-symbol 'move)
-                                  dired-one-file
-                                  (string= (downcase
-                                            (expand-file-name (car fn-list)))
-                                           (downcase
-                                            (expand-file-name target)))
-                                  (not (string=
-                                        (file-name-nondirectory (car fn-list))
-                                        (file-name-nondirectory target))))
-                             nil
-                           (file-directory-p target)))
-                        ((eq how-to t) nil)
-                        (t (funcall how-to target)))))
-    (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.
diff --git a/lisp/files.el b/lisp/files.el
index 7ac88f8..d896020 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -4723,23 +4723,21 @@ If RECURSIVE is non-nil, all files in DIRECTORY are 
deleted as well."
                 directory 'full directory-files-no-dot-files-regexp)))
       (delete-directory-internal directory)))))
-(defun copy-directory (directory newname &optional keep-time
-                                parents copy-as-subdir)
+(defun copy-directory (directory newname &optional keep-time parents)
   "Copy DIRECTORY to NEWNAME.  Both args must be strings.
+If NEWNAME names an existing directory, copy DIRECTORY as subdirectory there.
 This function always sets the file modes of the output files to match
 the corresponding input file.
 The third arg KEEP-TIME non-nil means give the output files the same
 last-modified time as the old ones.  (This works on only some systems.)
-A prefix arg makes KEEP-TIME non-nil.
-Optional arg PARENTS says whether to create parent directories if
-they don't exist.  When called interactively, PARENTS is t.
+A prefix arg makes KEEP-TIME non-nil.
-When NEWNAME is an existing directory, copy DIRECTORY into a
-subdirectory of NEWNAME if optional arg COPY-AS-SUBDIR is
-non-nil, otherwise copy the contents of DIRECTORY into NEWNAME.
-When called interactively, copy into a subdirectory by default."
+Noninteractively, the last argument PARENTS says whether to
+create parent directories if they don't exist.  Interactively,
+this happens by default."
    (let ((dir (read-directory-name
               "Copy directory: " default-directory default-directory t nil)))
@@ -4747,7 +4745,7 @@ When called interactively, copy into a subdirectory by 
            (format "Copy directory %s to: " dir)
            default-directory default-directory nil nil)
-          current-prefix-arg t t)))
+          current-prefix-arg t)))
   ;; If default-directory is a remote directory, make sure we find its
   ;; copy-directory handler.
   (let ((handler (or (find-file-name-handler directory 'copy-directory)
@@ -4759,17 +4757,12 @@ When called interactively, copy into a subdirectory by 
       (setq directory (directory-file-name (expand-file-name directory))
            newname   (directory-file-name (expand-file-name newname)))
-      (unless (file-directory-p directory)
-       (error "%s is not a directory" directory))
-      (cond
-       ((not (file-directory-p newname))
-       ;; If NEWNAME is not an existing directory, create it;
-       ;; that is where we will copy the files of DIRECTORY.
-       (make-directory newname parents))
-       (copy-as-subdir
-       ;; If NEWNAME is an existing directory, and we are copying as
-       ;; a subdirectory, the target is NEWNAME/[DIRECTORY-BASENAME].
+      (if (not (file-directory-p newname))
+         ;; If NEWNAME is not an existing directory, create it; that
+         ;; is where we will copy the files of DIRECTORY.
+         (make-directory newname parents)
+       ;; If NEWNAME is an existing directory, we will copy into
        (setq newname (expand-file-name
                        (directory-file-name directory))
@@ -4778,22 +4771,20 @@ When called interactively, copy into a subdirectory by 
             (not (file-directory-p newname))
             (error "Cannot overwrite non-directory %s with a directory"
-       (make-directory newname t)))
+       (make-directory newname t))
       ;; Copy recursively.
       (dolist (file
               ;; We do not want to copy "." and "..".
               (directory-files directory 'full
-       (let ((target (expand-file-name
-                      (file-name-nondirectory file) newname))
-             (attrs (file-attributes file)))
-         (cond ((file-directory-p file)
-                (copy-directory file target keep-time parents nil))
-               ((stringp (car attrs)) ; Symbolic link
-                (make-symbolic-link (car attrs) target t))
-               (t
-                (copy-file file target t keep-time)))))
+       (if (file-directory-p file)
+           (copy-directory file newname keep-time parents)
+         (let ((target (expand-file-name (file-name-nondirectory file) 
+               (attrs (file-attributes file)))
+           (if (stringp (car attrs)) ; Symbolic link
+               (make-symbolic-link (car attrs) target t)
+             (copy-file file target t keep-time)))))
       ;; Set directory attributes.
       (set-file-modes newname (file-modes directory))

A+ Thierry
Get my Gnupg key:
gpg --keyserver pgp.mit.edu --recv-keys 59F29997 

reply via email to

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