From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Thierry Volpiatto Newsgroups: gmane.emacs.devel Subject: Re: bug in copy-directory Date: Sun, 30 Jan 2011 19:32:51 +0100 Message-ID: <8739oap7ho.fsf@gmail.com> References: <87ipxaidea.fsf@gmail.com> <87k4hp96g0.fsf@stupidchicken.com> <878vy59ejz.fsf@stupidchicken.com> <87lj23ickn.fsf@stupidchicken.com> <87sjway8i3.fsf@gmx.de> <87bp2yts8m.fsf@gmail.com> <87fwsaxyy0.fsf@gmx.de> <87y662sbjs.fsf@gmail.com> <87k4hmpgdf.fsf@gmail.com> <874o8qs2xj.fsf@gmx.de> <87bp2yp8nk.fsf@gmail.com> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: dough.gmane.org 1296412406 5445 80.91.229.12 (30 Jan 2011 18:33:26 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Sun, 30 Jan 2011 18:33:26 +0000 (UTC) To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Sun Jan 30 19:33:22 2011 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1Pjc5R-0008SG-Gw for ged-emacs-devel@m.gmane.org; Sun, 30 Jan 2011 19:33:21 +0100 Original-Received: from localhost ([127.0.0.1]:46868 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1Pjc5Q-0007H8-QE for ged-emacs-devel@m.gmane.org; Sun, 30 Jan 2011 13:33:20 -0500 Original-Received: from [140.186.70.92] (port=56814 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1Pjc5G-0007FP-NQ for emacs-devel@gnu.org; Sun, 30 Jan 2011 13:33:11 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Pjc5E-0006DX-FV for emacs-devel@gnu.org; Sun, 30 Jan 2011 13:33:10 -0500 Original-Received: from lo.gmane.org ([80.91.229.12]:38284) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Pjc5D-0006DQ-Vh for emacs-devel@gnu.org; Sun, 30 Jan 2011 13:33:08 -0500 Original-Received: from list by lo.gmane.org with local (Exim 4.69) (envelope-from ) id 1Pjc5C-0008Lb-OL for emacs-devel@gnu.org; Sun, 30 Jan 2011 19:33:06 +0100 Original-Received: from 63.211.85-79.rev.gaoland.net ([79.85.211.63]) by main.gmane.org with esmtp (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Sun, 30 Jan 2011 19:33:06 +0100 Original-Received: from thierry.volpiatto by 63.211.85-79.rev.gaoland.net with local (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Sun, 30 Jan 2011 19:33:06 +0100 X-Injected-Via-Gmane: http://gmane.org/ Original-Lines: 142 Original-X-Complaints-To: usenet@dough.gmane.org X-Gmane-NNTP-Posting-Host: 63.211.85-79.rev.gaoland.net User-Agent: Gnus/5.110011 (No Gnus v0.11) Emacs/23.2.92 (gnu/linux) Cancel-Lock: sha1:MdJ2rFjOjLwQ4ZBTyieVXaGdqTY= X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 3) X-Received-From: 80.91.229.12 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:135253 Archived-At: Thierry Volpiatto writes: > Michael Albinus writes: > >> Thierry Volpiatto writes: >> >>>> Ah! yes didn't notice it create a third /test nested in the second one. >>> Can you try this one now (interactively and not): >>> It should work. >> >> I doesn't. > Sorry, this one work now interactively and not. Just a little error remaining when answering no for recursive copy of dir. It is now fixed, will send in next patch. > --- > lisp/files.el | 98 ++++++++++++++++++++++++++++++++------------------------- > 1 files changed, 55 insertions(+), 43 deletions(-) > > diff --git a/lisp/files.el b/lisp/files.el > index 4659742..464f00a 100644 > --- a/lisp/files.el > +++ b/lisp/files.el > @@ -4723,6 +4723,7 @@ 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) > "Copy DIRECTORY to NEWNAME. Both args must be strings. > If NEWNAME names an existing directory, copy DIRECTORY as subdirectory there. > @@ -4748,50 +4749,61 @@ this happens by default." > current-prefix-arg 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) > - (find-file-name-handler newname 'copy-directory)))) > + (let ((handler (or (find-file-name-handler directory 'copy-directory) > + (find-file-name-handler newname 'copy-directory))) > + (dir-files (directory-files directory 'full directory-files-no-dot-files-regexp))) > (if handler > - (funcall handler 'copy-directory directory newname keep-time parents) > - > - ;; Compute target name. > - (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)) > - (if (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. > - (mapc > - (lambda (file) > - (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)) > - ((stringp (car attrs)) ; Symbolic link > - (make-symbolic-link (car attrs) target t)) > - (t > - (copy-file file target t keep-time))))) > - ;; We do not want to copy "." and "..". > - (directory-files directory 'full directory-files-no-dot-files-regexp)) > - > - ;; Set directory attributes. > - (set-file-modes newname (file-modes directory)) > - (if keep-time > - (set-file-times newname (nth 5 (file-attributes directory))))))) > + (funcall handler 'copy-directory directory newname keep-time parents) > + ;; Else Compute target name. > + (setq directory (directory-file-name (expand-file-name directory))) > + (setq newname (directory-file-name > + (if (file-directory-p newname) > + (expand-file-name > + (file-relative-name > + directory (file-name-directory directory)) > + newname) > + newname))) > + (if (file-directory-p newname) > + (if (interactive-p) > + (if (y-or-n-p (format "Directory `%s' exists, overwrite? " > + newname)) > + (progn > + (delete-directory newname t) > + (make-directory newname 'parents)) > + (error "Abort copying directory")) > + (delete-directory newname t) > + (make-directory newname 'parents)) > + (if (file-exists-p newname) > + (error "Cannot overwrite non-directory %s with a directory" > + newname) > + (make-directory newname 'parents))) > + > + (when (> (length dir-files) 0) > + (let ((allow-recurse (or (and (interactive-p) > + (y-or-n-p > + (format "Recursive copies of `%s'? " > + directory))) > + t))) ; always allow recursive copy in non--interactive calls. > + (when allow-recurse > + ;; Copy recursively. > + (mapc > + (lambda (file) > + (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)) > + ((stringp (car attrs)) ; Symbolic link > + (make-symbolic-link (car attrs) target t)) > + (t > + (copy-file file target t keep-time))))) > + dir-files)))) > + > + ;; Set directory attributes. > + (set-file-modes newname (file-modes directory)) > + (when keep-time > + (set-file-times newname (nth 5 (file-attributes directory))))))) > + > > (put 'revert-buffer-function 'permanent-local t) > (defvar revert-buffer-function nil -- A+ Thierry Get my Gnupg key: gpg --keyserver pgp.mit.edu --recv-keys 59F29997