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

If nil, don't copy as a subdirectory.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 6fcef76911cdf292d4e641dc4a9a31e19a5c1e40..8306a29846ebf91eb36c99a2e0dad6ae2f061c02 100644 (file)
--- 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 d896020b27bc2d146fc4dab551fbed2a4dc43747..7ac88f888510b1e03159b34b151c6d38baddbf8e 100644 (file)
--- 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))