Re: bug in copy-directory

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

[-- Attachment #1: Type: text/plain, Size: 1085 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.
???I would say revert to Emacs 23.2 bug...

> Go ahead and send the patch anytime it's ready.
Find it attached.

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

[-- Attachment #2: copy-only-contents --]
[-- Type: application/octet-stream, Size: 4625 bytes --]

Bugfix copy-directory

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/files.el |   77 +++++++++++++++++++++++++++++----------------------------
 1 files changed, 39 insertions(+), 38 deletions(-)

diff --git a/lisp/files.el b/lisp/files.el
index d896020..61131dc 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -4723,7 +4723,7 @@ 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)
+(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.
 
@@ -4753,43 +4753,44 @@ this happens 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)))
-
-      (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].
-	(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))
-      (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