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: Fri, 04 Feb 2011 09:40:13 +0100 Message-ID: <87d3n8xkeq.fsf@gmail.com> References: <87ipxaidea.fsf@gmail.com> <87k4hp96g0.fsf@stupidchicken.com> <878vy59ejz.fsf@stupidchicken.com> <87lj23ickn.fsf@stupidchicken.com> <87sjway8i3.fsf@gmx.de> <87wrll2ebe.fsf@stupidchicken.com> <87hbcot7gq.fsf@gmx.de> <87ei7qrdp0.fsf@gmail.com> <87ipx2dayh.fsf@gmx.de> <87y65yyxfu.fsf@gmail.com> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: dough.gmane.org 1296808893 5884 80.91.229.12 (4 Feb 2011 08:41:33 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Fri, 4 Feb 2011 08:41:33 +0000 (UTC) To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Fri Feb 04 09:41:29 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 1PlHEN-0006k1-Qb for ged-emacs-devel@m.gmane.org; Fri, 04 Feb 2011 09:41:28 +0100 Original-Received: from localhost ([127.0.0.1]:36727 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1PlHEN-0000Et-0L for ged-emacs-devel@m.gmane.org; Fri, 04 Feb 2011 03:41:27 -0500 Original-Received: from [140.186.70.92] (port=34948 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1PlHDS-0008E3-T9 for emacs-devel@gnu.org; Fri, 04 Feb 2011 03:40:32 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1PlHDQ-0007nk-Gg for emacs-devel@gnu.org; Fri, 04 Feb 2011 03:40:30 -0500 Original-Received: from lo.gmane.org ([80.91.229.12]:37194) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1PlHDQ-0007mO-0Y for emacs-devel@gnu.org; Fri, 04 Feb 2011 03:40:28 -0500 Original-Received: from list by lo.gmane.org with local (Exim 4.69) (envelope-from ) id 1PlHDO-0006AR-KG for emacs-devel@gnu.org; Fri, 04 Feb 2011 09:40:26 +0100 Original-Received: from 95.78.88-79.rev.gaoland.net ([79.88.78.95]) by main.gmane.org with esmtp (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Fri, 04 Feb 2011 09:40:26 +0100 Original-Received: from thierry.volpiatto by 95.78.88-79.rev.gaoland.net with local (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Fri, 04 Feb 2011 09:40:26 +0100 X-Injected-Via-Gmane: http://gmane.org/ Original-Lines: 193 Original-X-Complaints-To: usenet@dough.gmane.org X-Gmane-NNTP-Posting-Host: 95.78.88-79.rev.gaoland.net User-Agent: Gnus/5.110011 (No Gnus v0.11) Emacs/23.2.93 (gnu/linux) Cancel-Lock: sha1:8AFvQShZsi1bROpikt1OA6BH3/4= 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:135561 Archived-At: Thierry Volpiatto writes: > Michael Albinus writes: > >> Thierry Volpiatto writes: >> >>> What we could do also is create a function copy-directory-contents, that >>> reuse the code of precedent version of copy-directory (but not >>> interactive this time) and call this function in >>> dired-copy-file-recursive instead of copy-directory. >>> >>> In this case we could rewrite copy-directory to avoid duplicate code, >>> possibly: (no urge in this case as actual copy-directory works fine) >>> >>> 1) Writing copy-directory-contents (or whatever name) to allow >>> creating the structure like actual copy-directory, or not like ancient >>> version leaving this job to dired-create-files. >>> >>> 2) Writing a copy-directory that reuse dired code (i.e dired-create-files). >>> In this case it would have all interactive messages, ask etc.. >>> >>> WDYT? >> >> I would prefer option 2). There is no need to have an extra dired >> implementation, now we have copy-directory. > > So i made first steps: > > - Create new function copy-directory-contents based on old > copy-directory code. > > - Use it in dired-copy-file-recursive instead of copy-directory. > > Seems to work fine. There was an error though. Now the last fix. (sent to Chong) I think that's correct: Use a new function copy-directory1 that can be reused by copy-directory, avoiding duplicate code. This function use an extra arg `create-struct'. When this arg is used copy-directory1 works like actual copy-directory. Otherwise it does like before and doesn't break dired. As i am using dired code in anything, i have inlined this changes in anything-config.el waiting this patch is applied or maybe another fix if you have better idea. Thanks Michael and Chong. Here the patch: --- lisp/dired-aux.el | 2 +- lisp/files.el | 98 ++++++++++++++++++++++++++++------------------------- 2 files changed, 53 insertions(+), 47 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 28b285f..b26ce0a 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -1242,7 +1242,7 @@ Special value `always' suppresses confirmation." (or (eq recursive 'always) (yes-or-no-p (format "Recursive copies of %s? " from)))) ;; This is a directory. - (copy-directory from to dired-copy-preserve-time) + (copy-directory1 from to dired-copy-preserve-time) ;; Not a directory. (or top (dired-handle-overwrite to)) (condition-case err diff --git a/lisp/files.el b/lisp/files.el index d896020..c75a330 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -4723,7 +4723,56 @@ 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-directory1 (directory newname &optional keep-time parents create-struct) + ;; 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)))) + (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]. + (when create-struct + (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 + ;; We do not want to copy "." and "..". + (directory-files directory 'full + directory-files-no-dot-files-regexp)) + (let ((target (expand-file-name (file-name-nondirectory file) newname)) + (attrs (file-attributes file))) + (cond ((and (file-directory-p file) create-struct) + (copy-directory1 file newname keep-time parents create-struct)) + ((file-directory-p file) + (copy-directory1 file target keep-time parents create-struct)) + ((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)) + (when keep-time + (set-file-times newname (nth 5 (file-attributes directory))))))) + +(defun copy-directory (directory newname &optional keep-time parents create-struct) "Copy DIRECTORY to NEWNAME. Both args must be strings. If NEWNAME names an existing directory, copy DIRECTORY as subdirectory there. @@ -4745,51 +4794,8 @@ this happens by default." (read-file-name (format "Copy directory %s to: " dir) default-directory default-directory nil nil) - 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)))) - (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)) - (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 - ;; 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))))) - - ;; Set directory attributes. - (set-file-modes newname (file-modes directory)) - (if keep-time - (set-file-times newname (nth 5 (file-attributes directory))))))) + current-prefix-arg t t))) + (copy-directory1 directory newname keep-time parents create-struct)) (put 'revert-buffer-function 'permanent-local t) (defvar revert-buffer-function nil -- 1.7.1 -- A+ Thierry Get my Gnupg key: gpg --keyserver pgp.mit.edu --recv-keys 59F29997