* lisp/files.el (copy-directory): New arg COPY-AS-SUBDIR.

If nil, don't copy as a subdirectory.

2 files changed, 37 insertions, 22 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 6fcef76911c..8306a29846e 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,9 @@
+2011-02-06  Chong Yidong  <cyd@stupidchicken.com>
+            Thierry Volpiatto <thierry.volpiatto@gmail.com>
+
+	* files.el (copy-directory): New arg COPY-AS-SUBDIR.  If nil,
+	don't copy as a subdirectory.
+
 2011-02-05  Glenn Morris  <rgm@gnu.org>
 
 	* emacs-lisp/cl-macs.el (return-from): Fix doc typo.
diff --git a/lisp/files.el b/lisp/files.el
index d896020b27b..7ac88f88851 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -4723,21 +4723,23 @@ 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 copy-as-subdir)
   "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.
 
-Noninteractively, the last argument PARENTS says whether to
-create parent directories if they don't exist.  Interactively,
-this happens by default."
+Optional arg PARENTS says whether to create parent directories if
+they don't exist.  When called interactively, PARENTS is t.
+
+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."
   (interactive
    (let ((dir (read-directory-name
 	       "Copy directory: " default-directory default-directory t nil)))
@@ -4745,7 +4747,7 @@ this happens by default."
 	   (read-file-name
 	    (format "Copy directory %s to: " dir)
 	    default-directory default-directory nil nil)
-	   current-prefix-arg t)))
+	   current-prefix-arg t 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)
@@ -4757,12 +4759,17 @@ this happens by default."
       (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 (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))
@@ -4771,20 +4778,22 @@ this happens by default."
 	     (not (file-directory-p newname))
 	     (error "Cannot overwrite non-directory %s with a directory"
 		    newname))
-	(make-directory newname t))
+	(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)))))
+	(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))