[Emacs-diffs] /srv/bzr/emacs/trunk r103237: New optional arg COPY-CONTENTS to copy-directory.

[Chong Yidong]

------------------------------------------------------------
revno: 103237
author: Thierry Volpiatto <address@hidden>
committer: Chong Yidong <address@hidden>
branch nick: trunk
timestamp: Sat 2011-02-12 14:34:50 -0500
message:
  New optional arg COPY-CONTENTS to copy-directory.
  
  * files.el (copy-directory): New argument COPY-CONTENTS for
  copying directory contents into another existing directory.
modified:
  etc/NEWS
  lisp/ChangeLog
  lisp/files.el

=== modified file 'etc/NEWS'
--- a/etc/NEWS  2011-02-08 20:45:53 +0000
+++ b/etc/NEWS  2011-02-12 19:34:50 +0000
@@ -633,6 +633,11 @@
 
 * 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.

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2011-02-12 18:30:13 +0000
+++ b/lisp/ChangeLog    2011-02-12 19:34:50 +0000
@@ -1,3 +1,8 @@
+2011-02-12  Thierry Volpiatto  <address@hidden>
+
+       * files.el (copy-directory): New argument COPY-CONTENTS for
+       copying directory contents into another existing directory.
+
 2011-02-12  Tassilo Horn  <address@hidden>
 
        * minibuffer.el (completion-table-case-fold): New function for

=== modified file 'lisp/files.el'
--- a/lisp/files.el     2011-02-11 17:35:37 +0000
+++ b/lisp/files.el     2011-02-12 19:34:50 +0000
@@ -4826,10 +4826,8 @@
                 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 @@
 
 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 @@
           (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 @@
       (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