* Re: patch-copy-dir-with-stefan-changes [not found] ` <87r5bh2sf8.fsf@gmail.com> @ 2011-02-09 16:42 ` Stefan Monnier 2011-02-09 17:55 ` patch-copy-dir-with-stefan-changes Thierry Volpiatto 0 siblings, 1 reply; 6+ messages in thread From: Stefan Monnier @ 2011-02-09 16:42 UTC (permalink / raw) To: Thierry Volpiatto; +Cc: emacs-devel > here another approach to fix copy-directory and dired. Looks good. I'm not sure how it can get away with removing dired-do-create-files without removing any call to it, but other than that it looks like the best solution. Any other opinion? Stefan > --- > 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)))))) > \f > ;; The basic function for half a dozen variations on cp/mv/ln/ln -s. > +\f > (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)) > -\f > -(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 ^ permalink raw reply [flat|nested] 6+ messages in thread
* Re: patch-copy-dir-with-stefan-changes 2011-02-09 16:42 ` patch-copy-dir-with-stefan-changes Stefan Monnier @ 2011-02-09 17:55 ` Thierry Volpiatto 2011-02-10 8:38 ` patch-copy-dir-with-stefan-changes Michael Albinus 0 siblings, 1 reply; 6+ messages in thread From: Thierry Volpiatto @ 2011-02-09 17:55 UTC (permalink / raw) To: emacs-devel Stefan Monnier <monnier@iro.umontreal.ca> writes: >> here another approach to fix copy-directory and dired. > > Looks good. > > I'm not sure how it can get away with removing dired-do-create-files > without removing any call to it, OOPS! Of course we need it! It wouldn't work without it. I remove it in the patch by error, sorry. Here it is: --- lisp/dired-aux.el | 5 +++++ lisp/files.el | 53 ++++++++++++++++++++++------------------------------- 2 files changed, 27 insertions(+), 31 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 28b285f..7c991b7 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)))))) \f ;; The basic function for half a dozen variations on cp/mv/ln/ln -s. +\f (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,7 +1448,9 @@ 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)) + \f + (defun dired-do-create-files (op-symbol file-creator operation arg &optional marker-char op1 how-to) 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 ^ permalink raw reply related [flat|nested] 6+ messages in thread
* Re: patch-copy-dir-with-stefan-changes 2011-02-09 17:55 ` patch-copy-dir-with-stefan-changes Thierry Volpiatto @ 2011-02-10 8:38 ` Michael Albinus 2011-02-10 15:49 ` patch-copy-dir-with-stefan-changes Chong Yidong 0 siblings, 1 reply; 6+ messages in thread From: Michael Albinus @ 2011-02-10 8:38 UTC (permalink / raw) To: Thierry Volpiatto; +Cc: emacs-devel Thierry Volpiatto <thierry.volpiatto@gmail.com> writes: > Stefan Monnier <monnier@iro.umontreal.ca> writes: > >>> here another approach to fix copy-directory and dired. >> >> Looks good. >> >> I'm not sure how it can get away with removing dired-do-create-files >> without removing any call to it, > OOPS! Of course we need it! It wouldn't work without it. > I remove it in the patch by error, sorry. For what I can tell, this patch looks pretty good. I've tested all three scenarios Thierry has explained in a previous mail, and I've tested it with local directories as well as with Tramp's ssh and rsync methods. All results are as expected. I vote for installing the patch into the emacs-23 branch. Best regards, Michael. ^ permalink raw reply [flat|nested] 6+ messages in thread
* Re: patch-copy-dir-with-stefan-changes 2011-02-10 8:38 ` patch-copy-dir-with-stefan-changes Michael Albinus @ 2011-02-10 15:49 ` Chong Yidong 2011-02-10 16:18 ` patch-copy-dir-with-stefan-changes Michael Albinus 0 siblings, 1 reply; 6+ messages in thread From: Chong Yidong @ 2011-02-10 15:49 UTC (permalink / raw) To: Michael Albinus; +Cc: emacs-devel, Thierry Volpiatto Michael Albinus <michael.albinus@gmx.de> writes: > For what I can tell, this patch looks pretty good. I've tested all three > scenarios Thierry has explained in a previous mail, and I've tested it > with local directories as well as with Tramp's ssh and rsync > methods. All results are as expected. As I explained in an earlier email, this change removes the ability of a Lisp caller to copy the contents of one directory into another directory (as opposed to copying into a subdirectory). ^ permalink raw reply [flat|nested] 6+ messages in thread
* Re: patch-copy-dir-with-stefan-changes 2011-02-10 15:49 ` patch-copy-dir-with-stefan-changes Chong Yidong @ 2011-02-10 16:18 ` Michael Albinus 2011-02-11 23:47 ` patch-copy-dir-with-stefan-changes Chong Yidong 0 siblings, 1 reply; 6+ messages in thread From: Michael Albinus @ 2011-02-10 16:18 UTC (permalink / raw) To: Chong Yidong; +Cc: emacs-devel, Thierry Volpiatto Chong Yidong <cyd@stupidchicken.com> writes: > Michael Albinus <michael.albinus@gmx.de> writes: > >> For what I can tell, this patch looks pretty good. I've tested all three >> scenarios Thierry has explained in a previous mail, and I've tested it >> with local directories as well as with Tramp's ssh and rsync >> methods. All results are as expected. > > As I explained in an earlier email, this change removes the ability of a > Lisp caller to copy the contents of one directory into another directory > (as opposed to copying into a subdirectory). I said already, that I came late into the discussion, sorry ... I reread the thread. It didn't convince me, that we shall copy "the *contents* of one directory" with `copy-directory'. This would be a new behaviour. What is it good for? The beginning of the discussion was a bug report by Thierry. This bug seems to be fixed with his latest patch. Best regards, Michael. ^ permalink raw reply [flat|nested] 6+ messages in thread
* Re: patch-copy-dir-with-stefan-changes 2011-02-10 16:18 ` patch-copy-dir-with-stefan-changes Michael Albinus @ 2011-02-11 23:47 ` Chong Yidong 0 siblings, 0 replies; 6+ messages in thread From: Chong Yidong @ 2011-02-11 23:47 UTC (permalink / raw) To: Michael Albinus; +Cc: emacs-devel, Thierry Volpiatto Michael Albinus <michael.albinus@gmx.de> writes: > I reread the thread. It didn't convince me, that we shall copy "the > *contents* of one directory" with `copy-directory'. This would be a new > behaviour. What is it good for? How would you do "cp -r a/* b/"? ^ permalink raw reply [flat|nested] 6+ messages in thread
end of thread, other threads:[~2011-02-11 23:47 UTC | newest] Thread overview: 6+ messages (download: mbox.gz follow: Atom feed -- links below jump to the message on this page -- [not found] <87mxm7wnk2.fsf@gmail.com> [not found] ` <jwv7hdbtdip.fsf-monnier+emacs@gnu.org> [not found] ` <87mxm7c9ut.fsf@gmail.com> [not found] ` <jwvmxm6z56k.fsf-monnier+emacs@gnu.org> [not found] ` <87r5bh2sf8.fsf@gmail.com> 2011-02-09 16:42 ` patch-copy-dir-with-stefan-changes Stefan Monnier 2011-02-09 17:55 ` patch-copy-dir-with-stefan-changes Thierry Volpiatto 2011-02-10 8:38 ` patch-copy-dir-with-stefan-changes Michael Albinus 2011-02-10 15:49 ` patch-copy-dir-with-stefan-changes Chong Yidong 2011-02-10 16:18 ` patch-copy-dir-with-stefan-changes Michael Albinus 2011-02-11 23:47 ` patch-copy-dir-with-stefan-changes Chong Yidong
Code repositories for project(s) associated with this public inbox https://git.savannah.gnu.org/cgit/emacs.git This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).