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: Wed, 09 Feb 2011 17:11:06 +0100 Message-ID: <87aai5gpd1.fsf@gmail.com> References: <87ipxaidea.fsf@gmail.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> <87d3n8xkeq.fsf@gmail.com> <878vxw6r4m.fsf@gmx.de> <87pqr790b0.fsf@gmail.com> <87oc6r7gjc.fsf@gmx.de> <87ipwz8t92.fsf@gmail.com> <878vxt69k7.fsf@stupidchicken.com> <874o8hbc9q.fsf@gmx.de> <87tygh8ez6.fsf@stupidchicken.com> <87zkq7okvk.fsf@gmx.de> <87oc6myqzn.fsf@stupidchicken.com> <87sjvxznmt.fsf@gmail.com> <87aai58v63.fsf@gmx.de> <877hd99q32.fsf@stupidchicken.com> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: dough.gmane.org 1297267904 2736 80.91.229.12 (9 Feb 2011 16:11:44 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Wed, 9 Feb 2011 16:11:44 +0000 (UTC) Cc: Michael Albinus , emacs-devel@gnu.org To: Chong Yidong Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Wed Feb 09 17:11:39 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 1PnCdc-0002dA-52 for ged-emacs-devel@m.gmane.org; Wed, 09 Feb 2011 17:11:35 +0100 Original-Received: from localhost ([127.0.0.1]:52109 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1PnCda-0003xs-1o for ged-emacs-devel@m.gmane.org; Wed, 09 Feb 2011 11:11:26 -0500 Original-Received: from [140.186.70.92] (port=49605 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1PnCdO-0003rf-Jv for emacs-devel@gnu.org; Wed, 09 Feb 2011 11:11:18 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1PnCdL-0000Xf-1J for emacs-devel@gnu.org; Wed, 09 Feb 2011 11:11:12 -0500 Original-Received: from mail-ew0-f41.google.com ([209.85.215.41]:64972) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1PnCdK-0000Xb-KK for emacs-devel@gnu.org; Wed, 09 Feb 2011 11:11:10 -0500 Original-Received: by ewy27 with SMTP id 27so181147ewy.0 for ; Wed, 09 Feb 2011 08:11:10 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=gamma; h=domainkey-signature:from:to:cc:subject:references:date:in-reply-to :message-id:user-agent:mime-version:content-type; bh=6p5E+fx1EZmWpNeBZtqTo1VOo57zbxim2EAqxycbsT8=; b=XhymzSZ+vppX4XSe6DuRUmqIPgBUp/OdcvKDTW37pKQSJ8XqQTbzLQZqzJLgomzUvH 0DJQgb2LO5iJnRW7N9qEoHd5+uL1XRkS2PenPg8q4fNipAESavB/B8G0UMJqZSM8pEmV TL5tm9F3IZyCKAmButMtbpvx+abQejibVOKVc= DomainKey-Signature: a=rsa-sha1; c=nofws; d=gmail.com; s=gamma; h=from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version:content-type; b=ky7FxHCkVyZbA/yX+xV5wRRS3y+7DGrayJBxrRlXbEibjcahYOY0zxXx/ksN3/Zovs ik48qLw1Ly0JyLzVG25e0zrZVp0pI2u/d2Cf1Pi7UEvfvOLlEsPXVU6Tv3z7a2GB2wVr ziMH5q6ECpCJRZZMfnyyEp9tcEQ4dZKsuN9ZM= Original-Received: by 10.223.86.2 with SMTP id q2mr98356fal.139.1297267869862; Wed, 09 Feb 2011 08:11:09 -0800 (PST) Original-Received: from thierry-MM061 (131.78.88-79.rev.gaoland.net [79.88.78.131]) by mx.google.com with ESMTPS id 17sm231081far.19.2011.02.09.08.11.08 (version=TLSv1/SSLv3 cipher=RC4-MD5); Wed, 09 Feb 2011 08:11:09 -0800 (PST) In-Reply-To: <877hd99q32.fsf@stupidchicken.com> (Chong Yidong's message of "Wed, 09 Feb 2011 10:37:21 -0500") User-Agent: Gnus/5.110011 (No Gnus v0.11) Emacs/23.2.93 (gnu/linux) X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 2) X-Received-From: 209.85.215.41 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:135802 Archived-At: Chong Yidong writes: > Michael Albinus writes: > >> If this is not possible, we shall fall back to the Emacs 23.2 >> implementation, which is less broken compared with the current status. > > Explain again why the current status is more broken than Emacs 23.2. As > far as I can tell, if the copy-as-subdir arg is nil, the Lisp behavior > is identical to 23.2. > >> I would vote for continuing with the last patch from Thierry, not >> committed yet. Maybe it is possible to throw copy-directory-1 away, >> and to adapt the call of copy-directory in Dired instead of. > > Adding a separate copy-directory-1 function does nothing different from > adding an optional argument to copy-directory that modifies its > behavior. Not much point. I am actually trying something different, i sent patch to Michael and Stephane. I restart from the Chong version without extra arg. This version works outside of dired interactvely and not. Then i modify a little dired-create-files. dired-copy-file-recursive have to call now copy-directory as copy-directory-1 doesn't exists anymore. It works here in dired, all scenarios of copy-directory and i tried with sudo method from dired and it works also. Could you test on your side? --- lisp/dired-aux.el | 91 ++--------------------------------------------------- lisp/files.el | 53 +++++++++++++------------------ 2 files changed, 25 insertions(+), 119 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 28b285f..5bb9d73 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -1345,6 +1345,7 @@ Special value `always' suppresses confirmation." (when cons (setcar cons cur-dir)))))) ;; The basic function for half a dozen variations on cp/mv/ln/ln -s. + (defun dired-create-files (file-creator operation fn-list name-constructor &optional marker-char) @@ -1403,6 +1404,8 @@ ESC or `q' to not overwrite any of the remaining files, (cond ((integerp marker-char) marker-char) (marker-char (dired-file-marker from)) ; slow (t nil)))) + (when (and (file-directory-p from) (eq file-creator 'dired-copy-file)) + (setq to (file-name-directory to))) (condition-case err (progn (funcall file-creator from to dired-overwrite-confirmed) @@ -1445,94 +1448,6 @@ ESC or `q' to not overwrite any of the remaining files, (message "%s: %s file%s" operation success-count (dired-plural-s success-count))))) (dired-move-to-filename)) - -(defun dired-do-create-files (op-symbol file-creator operation arg - &optional marker-char op1 - how-to) - "Create a new file for each marked file. -Prompts user for target, which is a directory in which to create - the new files. Target may also be a plain file if only one marked - file exists. The way the default for the target directory is - computed depends on the value of `dired-dwim-target-directory'. -OP-SYMBOL is the symbol for the operation. Function `dired-mark-pop-up' - will determine whether pop-ups are appropriate for this OP-SYMBOL. -FILE-CREATOR and OPERATION as in `dired-create-files'. -ARG as in `dired-get-marked-files'. -Optional arg MARKER-CHAR as in `dired-create-files'. -Optional arg OP1 is an alternate form for OPERATION if there is - only one file. -Optional arg HOW-TO determiness how to treat the target. - If HOW-TO is nil, use `file-directory-p' to determine if the - target is a directory. If so, the marked file(s) are created - inside that directory. Otherwise, the target is a plain file; - an error is raised unless there is exactly one marked file. - If HOW-TO is t, target is always treated as a plain file. - Otherwise, HOW-TO should be a function of one argument, TARGET. - If its return value is nil, TARGET is regarded as a plain file. - If it return value is a list, TARGET is a generalized - directory (e.g. some sort of archive). The first element of - this list must be a function with at least four arguments: - operation - as OPERATION above. - rfn-list - list of the relative names for the marked files. - fn-list - list of the absolute names for the marked files. - target - the name of the target itself. - The rest of into-dir are optional arguments. - For any other return value, TARGET is treated as a directory." - (or op1 (setq op1 operation)) - (let* ((fn-list (dired-get-marked-files nil arg)) - (rfn-list (mapcar (function dired-make-relative) fn-list)) - (dired-one-file ; fluid variable inside dired-create-files - (and (consp fn-list) (null (cdr fn-list)) (car fn-list))) - (target-dir (dired-dwim-target-directory)) - (default (and dired-one-file - (expand-file-name (file-name-nondirectory (car fn-list)) - target-dir))) - (defaults (dired-dwim-target-defaults fn-list target-dir)) - (target (expand-file-name ; fluid variable inside dired-create-files - (minibuffer-with-setup-hook - (lambda () - (set (make-local-variable 'minibuffer-default-add-function) nil) - (setq minibuffer-default defaults)) - (dired-mark-read-file-name - (concat (if dired-one-file op1 operation) " %s to: ") - target-dir op-symbol arg rfn-list default)))) - (into-dir (cond ((null how-to) - ;; Allow DOS/Windows users to change the letter - ;; case of a directory. If we don't test these - ;; conditions up front, file-directory-p below - ;; will return t because the filesystem is - ;; case-insensitive, and Emacs will try to move - ;; foo -> foo/foo, which fails. - (if (and (memq system-type '(ms-dos windows-nt cygwin)) - (eq op-symbol 'move) - dired-one-file - (string= (downcase - (expand-file-name (car fn-list))) - (downcase - (expand-file-name target))) - (not (string= - (file-name-nondirectory (car fn-list)) - (file-name-nondirectory target)))) - nil - (file-directory-p target))) - ((eq how-to t) nil) - (t (funcall how-to target))))) - (if (and (consp into-dir) (functionp (car into-dir))) - (apply (car into-dir) operation rfn-list fn-list target (cdr into-dir)) - (if (not (or dired-one-file into-dir)) - (error "Marked %s: target must be a directory: %s" operation target)) - ;; rename-file bombs when moving directories unless we do this: - (or into-dir (setq target (directory-file-name target))) - (dired-create-files - file-creator operation fn-list - (if into-dir ; target is a directory - ;; This function uses fluid variable target when called - ;; inside dired-create-files: - (function - (lambda (from) - (expand-file-name (file-name-nondirectory from) target))) - (function (lambda (from) target))) - marker-char)))) ;; Read arguments for a marked-files command that wants a file name, ;; perhaps popping up the list of marked files. diff --git a/lisp/files.el b/lisp/files.el index 7ac88f8..d896020 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -4723,23 +4723,21 @@ 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-as-subdir) +(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. + This function always sets the file modes of the output files to match the corresponding input file. The third arg KEEP-TIME non-nil means give the output files the same last-modified time as the old ones. (This works on only some systems.) -A prefix arg makes KEEP-TIME non-nil. -Optional arg PARENTS says whether to create parent directories if -they don't exist. When called interactively, PARENTS is t. +A prefix arg makes KEEP-TIME non-nil. -When NEWNAME is an existing directory, copy DIRECTORY into a -subdirectory of NEWNAME if optional arg COPY-AS-SUBDIR is -non-nil, otherwise copy the contents of DIRECTORY into NEWNAME. -When called interactively, copy into a subdirectory by default." +Noninteractively, the last argument PARENTS says whether to +create parent directories if they don't exist. Interactively, +this happens by default." (interactive (let ((dir (read-directory-name "Copy directory: " default-directory default-directory t nil))) @@ -4747,7 +4745,7 @@ When called interactively, copy into a subdirectory by default." (read-file-name (format "Copy directory %s to: " dir) default-directory default-directory nil nil) - current-prefix-arg t t))) + 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) @@ -4759,17 +4757,12 @@ When called interactively, copy into a subdirectory by default." (setq directory (directory-file-name (expand-file-name directory)) newname (directory-file-name (expand-file-name newname))) - (unless (file-directory-p directory) - (error "%s is not a directory" directory)) - - (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)) - (copy-as-subdir - ;; If NEWNAME is an existing directory, and we are copying as - ;; a subdirectory, the target is NEWNAME/[DIRECTORY-BASENAME]. + (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)) @@ -4778,22 +4771,20 @@ When called interactively, copy into a subdirectory by default." (not (file-directory-p newname)) (error "Cannot overwrite non-directory %s with a directory" newname)) - (make-directory newname t))) + (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 ((file-directory-p file) - (copy-directory file target keep-time parents nil)) - ((stringp (car attrs)) ; Symbolic link - (make-symbolic-link (car attrs) target t)) - (t - (copy-file file target t keep-time))))) + (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)) -- A+ Thierry Get my Gnupg key: gpg --keyserver pgp.mit.edu --recv-keys 59F29997