From: Thierry Volpiatto <thierry.volpiatto@gmail.com>
To: Stefan Monnier <monnier@iro.umontreal.ca>
Cc: emacs-devel@gnu.org
Subject: Re: bug in copy-directory
Date: Mon, 07 Feb 2011 17:02:17 +0100 [thread overview]
Message-ID: <87zkq7x27q.fsf@gmail.com> (raw)
In-Reply-To: <jwvipwvj2g2.fsf-monnier+emacs@gnu.org> (Stefan Monnier's message of "Mon, 07 Feb 2011 10:22:36 -0500")
[-- Attachment #1: Type: text/plain, Size: 2537 bytes --]
Stefan Monnier <monnier@iro.umontreal.ca> writes:
>> If you want to be able to do:
>> (copy-directory "/tmp/test" "~/")
>> We will have to fallback to a function copy-directory1 used by dired and
>> a copy-directory function/command that ALWAYS use last arg of
>> copy-directory1.
>
> That sounds to me like the right thing to do (copy-directory already
> has many arguments, and adding one which will (almost) always need to
> be passed doesn't sound too attractive).
>
> But you say it in a tone that seems to imply it's undesirable: could you
> explain why you think it's undesirable?
No, i agree to use copy-directory without adding extra arguments.
i.e (copy-directory "/tmp/test" "~/")
The problem we have actually is to make something that:
- work in interactive call to copy-directory (M-x copy-directory)
- work non--interactively ==> (copy-directory "/tmp/test" "~/")
- work from dired.
If you have only one function copy-directory that work fine in case 2,
it will fail in dired because dired already does a part of the job of
this function (maybe because long time ago dired-create-files has been
wrote on this bug), and if you make it work in dired it will fail in
directs calls to copy-directory.
So to achieve the 3 cases above i propose:
- Make a copy-directory1 function that work with dired (like ancient
code).
- call copy-directory1 in dired-copy-file-recursive.
- Make a copy-directory function/command that reuse copy-directory1
without extra args (like it was before, last arg is parents).
This actually works and is IMHO the best solution.(see patch)
Otherwise you have to call in dired-do-copy dired-create-files something
like this:
,----
| (dired-create-files
| fn (symbol-name action) files
| ;; CANDIDATE is the destination.
| (if (file-directory-p candidate)
| ;; When CANDIDATE is a directory, build file-name in this directory.
| ;; Else we use CANDIDATE.
| #'(lambda (from)
| (let ((target (expand-file-name (file-name-nondirectory from) candidate)))
| (if (file-directory-p target) candidate target)))
| #'(lambda (from) candidate))
| marker)
`----
but in this case the NAME-CONSTRUCTOR returns wrong value for message,
but not for executing code (it does the right thing)
So in this case a rewrite (partial) of dired-create-files is needed in
addition of modification of dired-do-copy call to dired-create-files.
(with possible breakage of symlinking etc...)
--
A+ Thierry
Get my Gnupg key:
gpg --keyserver pgp.mit.edu --recv-keys 59F29997
[-- Attachment #2: patch-copy-dir5 --]
[-- Type: application/octet-stream, Size: 4332 bytes --]
patch-copy-dir5
From: Thierry Volpiatto <thierry.volpiatto@gmail.com>
---
lisp/dired-aux.el | 2 +-
lisp/files.el | 54 ++++++++++++++++++++++++++++-------------------------
2 files changed, 30 insertions(+), 26 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 7ac88f8..32ce50b 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -4723,31 +4723,8 @@ 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
+(defun copy-directory1 (directory newname &optional keep-time
parents copy-as-subdir)
- "Copy DIRECTORY to NEWNAME. Both args must be strings.
-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.
-
-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."
- (interactive
- (let ((dir (read-directory-name
- "Copy directory: " default-directory default-directory t nil)))
- (list dir
- (read-file-name
- (format "Copy directory %s to: " dir)
- default-directory default-directory nil nil)
- current-prefix-arg t 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)
@@ -4789,7 +4766,7 @@ When called interactively, copy into a subdirectory by default."
(file-name-nondirectory file) newname))
(attrs (file-attributes file)))
(cond ((file-directory-p file)
- (copy-directory file target keep-time parents nil))
+ (copy-directory1 file target keep-time parents nil))
((stringp (car attrs)) ; Symbolic link
(make-symbolic-link (car attrs) target t))
(t
@@ -4799,6 +4776,33 @@ When called interactively, copy into a subdirectory by default."
(set-file-modes newname (file-modes directory))
(if keep-time
(set-file-times newname (nth 5 (file-attributes directory)))))))
+
+(defun copy-directory (directory newname &optional keep-time parents)
+ "Copy DIRECTORY to NEWNAME. Both args must be strings.
+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.
+
+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."
+ (interactive
+ (let ((dir (read-directory-name
+ "Copy directory: " default-directory default-directory t nil)))
+ (list dir
+ (read-file-name
+ (format "Copy directory %s to: " dir)
+ default-directory default-directory nil nil)
+ current-prefix-arg t)))
+ (copy-directory1 directory newname keep-time parents 'copy-as-subdir))
+
\f
(put 'revert-buffer-function 'permanent-local t)
(defvar revert-buffer-function nil
next prev parent reply other threads:[~2011-02-07 16:02 UTC|newest]
Thread overview: 92+ messages / expand[flat|nested] mbox.gz Atom feed top
2011-01-27 15:18 bug in copy-directory Thierry Volpiatto
2011-01-28 1:13 ` Chong Yidong
2011-01-28 9:05 ` Thierry Volpiatto
2011-01-28 15:02 ` Stefan Monnier
2011-01-28 16:30 ` Chong Yidong
2011-01-28 16:51 ` Lennart Borgman
2011-01-28 17:05 ` Andreas Schwab
2011-01-28 17:08 ` Lennart Borgman
2011-01-28 17:18 ` Andreas Schwab
2011-01-28 17:13 ` Thierry Volpiatto
2011-01-28 17:17 ` Lennart Borgman
2011-01-28 18:11 ` Thierry Volpiatto
2011-01-28 18:28 ` Lennart Borgman
2011-01-28 20:12 ` Jan Djärv
2011-01-28 20:48 ` Lennart Borgman
2011-01-28 22:44 ` Jan Djärv
2011-01-28 22:55 ` Lennart Borgman
2011-01-28 18:31 ` Eli Zaretskii
2011-01-28 18:33 ` Thierry Volpiatto
2011-01-28 18:35 ` Stefan Monnier
2011-01-29 22:12 ` Chong Yidong
2011-01-29 22:51 ` Thierry Volpiatto
2011-01-30 10:51 ` Michael Albinus
2011-01-30 13:54 ` Thierry Volpiatto
2011-01-30 14:05 ` Michael Albinus
2011-01-30 10:46 ` Michael Albinus
2011-01-30 13:51 ` Thierry Volpiatto
2011-01-30 14:12 ` Michael Albinus
2011-01-30 14:36 ` Thierry Volpiatto
2011-01-30 15:21 ` Thierry Volpiatto
2011-01-30 16:00 ` Thierry Volpiatto
2011-01-30 17:43 ` Michael Albinus
2011-01-30 18:07 ` Thierry Volpiatto
2011-01-30 18:32 ` Thierry Volpiatto
2011-01-30 18:36 ` Michael Albinus
2011-01-30 19:07 ` Thierry Volpiatto
2011-01-30 21:18 ` Thierry Volpiatto
2011-01-31 17:06 ` Chong Yidong
2011-02-01 9:44 ` Michael Albinus
2011-02-01 11:57 ` Thierry Volpiatto
2011-02-02 8:19 ` Thierry Volpiatto
2011-02-02 9:24 ` Thierry Volpiatto
2011-02-02 9:47 ` Michael Albinus
2011-02-02 20:48 ` Thierry Volpiatto
2011-02-04 8:40 ` Thierry Volpiatto
2011-02-04 10:17 ` Michael Albinus
2011-02-04 17:28 ` Thierry Volpiatto
2011-02-04 19:20 ` Michael Albinus
2011-02-04 20:00 ` Thierry Volpiatto
2011-02-06 5:01 ` Chong Yidong
2011-02-06 6:23 ` Thierry Volpiatto
2011-02-06 12:03 ` Michael Albinus
2011-02-06 13:33 ` Chong Yidong
2011-02-07 16:43 ` Michael Albinus
2011-02-07 17:32 ` Thierry Volpiatto
2011-02-08 9:18 ` Michael Albinus
2011-02-08 10:58 ` Thierry Volpiatto
2011-02-08 11:29 ` Michael Albinus
2011-02-08 15:06 ` Thierry Volpiatto
2011-02-08 15:22 ` Michael Albinus
2011-02-08 16:39 ` Michael Albinus
2011-02-09 0:46 ` Chong Yidong
2011-02-09 7:13 ` Thierry Volpiatto
2011-02-09 8:32 ` Michael Albinus
2011-02-09 15:37 ` Chong Yidong
2011-02-09 16:07 ` Michael Albinus
2011-02-09 16:11 ` Thierry Volpiatto
2011-02-09 16:50 ` Chong Yidong
2011-02-09 17:37 ` Thierry Volpiatto
2011-02-06 17:22 ` Thierry Volpiatto
2011-02-06 17:46 ` Thierry Volpiatto
2011-02-07 15:22 ` Stefan Monnier
2011-02-07 16:02 ` Thierry Volpiatto [this message]
2011-02-07 18:55 ` Stefan Monnier
2011-02-07 20:00 ` Thierry Volpiatto
2011-02-08 3:32 ` Stefan Monnier
2011-02-09 16:02 ` Chong Yidong
2011-02-09 21:42 ` Stefan Monnier
2011-02-11 8:12 ` Thierry Volpiatto
2011-02-11 8:32 ` Michael Albinus
2011-02-11 9:48 ` Thierry Volpiatto
2011-02-11 10:36 ` Michael Albinus
2011-02-11 23:58 ` Chong Yidong
2011-02-12 7:06 ` Thierry Volpiatto
2011-02-12 9:01 ` Michael Albinus
2011-02-12 18:42 ` Chong Yidong
2011-02-12 19:41 ` Chong Yidong
2011-02-12 21:55 ` Thierry Volpiatto
2011-02-12 22:46 ` Chong Yidong
2011-02-14 11:40 ` Thierry Volpiatto
2011-02-12 7:26 ` Thierry Volpiatto
2011-02-06 17:47 ` Michael Albinus
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87zkq7x27q.fsf@gmail.com \
--to=thierry.volpiatto@gmail.com \
--cc=emacs-devel@gnu.org \
--cc=monnier@iro.umontreal.ca \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.