New optional arg COPY-CONTENTS to copy-directory.

* files.el (copy-directory): New argument COPY-CONTENTS for
copying directory contents into another existing directory.

diff --git a/etc/NEWS b/etc/NEWS
index 11425c21342a8e13f75f9a3818434de6b35cc16a..6e9171e55c8e55c5a9934c46caf37e2d2f35b86c 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -633,6 +633,11 @@ Notifications API.  It requires D-Bus for communication.
 \f
 * Incompatible Lisp Changes in Emacs 24.1
 
+** `copy-directory' now copies the source directory as a subdirectory
+of the target directory, if the latter is an existing directory.  The
+new optional arg COPY-CONTENTS, if non-nil, makes the function copy
+the contents directly into a pre-existing target directory.
+
 ** `compose-mail' now accepts an optional 8th arg, RETURN-ACTION, and
 passes it to the mail user agent function.  This argument specifies an
 action for returning to the caller after finishing with the mail.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index e1bc8b9456403eede6a1c5bc86f8e727db3a9969..e80de4e9175b5d0ecd17ef77fcd98e1438e41d36 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,8 @@
+2011-02-12  Thierry Volpiatto  <thierry.volpiatto@gmail.com>
+
+       * files.el (copy-directory): New argument COPY-CONTENTS for
+       copying directory contents into another existing directory.
+
 2011-02-12  Tassilo Horn  <tassilo@member.fsf.org>
 
        * minibuffer.el (completion-table-case-fold): New function for

diff --git a/lisp/files.el b/lisp/files.el
index 43b31cb0a7ad2491b9f973a1378d52222c9e34c4..2d3dbc67d728f97d5364d6dcb8fb35d3c5433356 100644 (file)
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -4826,10 +4826,8 @@ given.  With a prefix argument, TRASH is nil."
                 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-contents)
   "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.
 
@@ -4840,7 +4838,12 @@ 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."
+this happens by default.
+
+If NEWNAME names an existing directory, copy DIRECTORY as a
+subdirectory there.  However, if called from Lisp with a non-nil
+optional argument COPY-CONTENTS, copy the contents of DIRECTORY
+directly into NEWNAME instead."
   (interactive
    (let ((dir (read-directory-name
               "Copy directory: " default-directory default-directory t nil)))
@@ -4848,7 +4851,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 nil)))
   ;; 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)
@@ -4860,21 +4863,22 @@ 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].
-       (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))
+      (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))
+           ;; If NEWNAME is an existing directory and COPY-CONTENTS
+           ;; is nil, copy into NEWNAME/[DIRECTORY-BASENAME].
+           ((not copy-contents)
+            (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