Re: bug in copy-directory

[Thierry Volpiatto <thierry.volpiatto@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 1100 bytes --]

Chong Yidong <cyd@stupidchicken.com> writes:

> Thierry Volpiatto <thierry.volpiatto@gmail.com> writes:
>
>> Michael Albinus <michael.albinus@gmx.de> writes:
>>
>>>> (defun copy-directory (directory newname &optional keep-time
>>> parents copy-contents-only)
>>>
>>> I'm in favor of this proposal (compared with the recently introduced
>>> `copy-as-subdir'). Thierry's proposal keeps the semantics of
>>> `copy-directory', and the changed semantics are activated by the
>>> optional argument.
>>
>> So when everybody is ok, i can send patch with this modification.
>> Tell me also if copy-contents-only as arg name is ok for you (if you
>> have better idea i take).
>
> This is OK for the trunk.  If we go this route, I'd prefer to revert the
> branch to the Emacs 23.2 behavior, since it requires non-local changes
> and is backward incompatible; then we'll make the change for Emacs 24.
>
> Go ahead and send the patch anytime it's ready.
Sorry, last patch apply on my precedent patch, this one should be correct.

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

[-- Attachment #2: dired-create-files --]
[-- Type: application/octet-stream, Size: 7603 bytes --]

Bugfix copy-directory,dired-create-files

From: Thierry Volpiatto <thierry.volpiatto@gmail.com>

lisp/files.el (copy-directory): new arg copy-only-contents Allow to copy contents of directory whitout subdir.

lisp/dired-aux.el (dired-create-files): Don't create subdirectory in dired-copy-file.
---
 lisp/dired-aux.el |    5 +++
 lisp/files.el     |  100 ++++++++++++++++++++++++-----------------------------
 2 files changed, 51 insertions(+), 54 deletions(-)

diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 28b285f..7c991b7 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))))))
 \f
 ;; The basic function for half a dozen variations on cp/mv/ln/ln -s.
+\f
 (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 'dired-copy-file))
+              (setq to (file-name-directory to)))
             (condition-case err
                 (progn
                   (funcall file-creator from to dired-overwrite-confirmed)
@@ -1445,7 +1448,9 @@ ESC or `q' to not overwrite any of the remaining files,
       (message "%s: %s file%s"
 	       operation success-count (dired-plural-s success-count)))))
   (dired-move-to-filename))
+
 \f
+
 (defun dired-do-create-files (op-symbol file-creator operation arg
 					&optional marker-char op1
 					how-to)
diff --git a/lisp/files.el b/lisp/files.el
index 7ac88f8..61131dc 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 contents-only)
   "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."
   (interactive
    (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 default."
 	   (read-file-name
 	    (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)
@@ -4755,50 +4753,44 @@ When called interactively, copy into a subdirectory by default."
     (if handler
 	(funcall handler 'copy-directory directory newname keep-time parents)
 
-      ;; Compute target name.
-      (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].
-	(setq newname (expand-file-name
-		       (file-name-nondirectory
-			(directory-file-name directory))
-		       newname))
-	(and (file-exists-p newname)
-	     (not (file-directory-p newname))
-	     (error "Cannot overwrite non-directory %s with a directory"
-		    newname))
-	(make-directory newname t)))
-
-      ;; Copy recursively.
-      (dolist (file
-	       ;; We do not want to copy "." and "..".
-	       (directory-files directory 'full
-				directory-files-no-dot-files-regexp))
-	(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)))))
-
-      ;; Set directory attributes.
-      (set-file-modes newname (file-modes directory))
-      (if keep-time
-	  (set-file-times newname (nth 5 (file-attributes directory)))))))
+        ;; Compute target name.
+        (setq directory (directory-file-name (expand-file-name directory))
+              newname   (directory-file-name (expand-file-name newname)))
+
+        (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
+            ;; NEWNAME/[DIRECTORY-BASENAME].
+            (unless contents-only
+              (setq newname (expand-file-name
+                             (file-name-nondirectory
+                              (directory-file-name directory))
+                             newname))
+              (and (file-exists-p newname)
+                   (not (file-directory-p newname))
+                   (error "Cannot overwrite non-directory %s with a directory"
+                          newname))
+              (make-directory newname t)))
+
+        ;; Copy recursively.
+        (dolist (file
+                  ;; We do not want to copy "." and "..".
+                  (directory-files directory 'full
+                                   directory-files-no-dot-files-regexp))
+          (if (file-directory-p file)
+              (copy-directory file newname keep-time parents)
+              (let ((target (expand-file-name (file-name-nondirectory file) newname))
+                    (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))
+        (when keep-time
+          (set-file-times newname (nth 5 (file-attributes directory)))))))
 \f
 (put 'revert-buffer-function 'permanent-local t)
 (defvar revert-buffer-function nil