* 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).