From 470d996db4b850a0c4676e03de805e53703b80e0 Mon Sep 17 00:00:00 2001 From: Thierry Volpiatto Date: Sat, 12 Feb 2011 14:34:50 -0500 Subject: [PATCH] New optional arg COPY-CONTENTS to copy-directory. * files.el (copy-directory): New argument COPY-CONTENTS for copying directory contents into another existing directory. --- etc/NEWS | 5 +++++ lisp/ChangeLog | 5 +++++ lisp/files.el | 44 ++++++++++++++++++++++++-------------------- 3 files changed, 34 insertions(+), 20 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 11425c21342..6e9171e55c8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -633,6 +633,11 @@ Notifications API. It requires D-Bus for communication. * 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 e1bc8b94564..e80de4e9175 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2011-02-12 Thierry Volpiatto + + * files.el (copy-directory): New argument COPY-CONTENTS for + copying directory contents into another existing directory. + 2011-02-12 Tassilo Horn * minibuffer.el (completion-table-case-fold): New function for diff --git a/lisp/files.el b/lisp/files.el index 43b31cb0a7a..2d3dbc67d72 100644 --- 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 -- 2.39.5