[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: bug in copy-directory
From: |
Thierry Volpiatto |
Subject: |
Re: bug in copy-directory |
Date: |
Wed, 09 Feb 2011 17:11:06 +0100 |
User-agent: |
Gnus/5.110011 (No Gnus v0.11) Emacs/23.2.93 (gnu/linux) |
Chong Yidong <address@hidden> writes:
> Michael Albinus <address@hidden> 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
- Re: bug in copy-directory, (continued)
- Re: bug in copy-directory, Thierry Volpiatto, 2011/02/08
- Re: bug in copy-directory, Michael Albinus, 2011/02/08
- Re: bug in copy-directory, Thierry Volpiatto, 2011/02/08
- Re: bug in copy-directory, Michael Albinus, 2011/02/08
- Re: bug in copy-directory, Michael Albinus, 2011/02/08
- Re: bug in copy-directory, Chong Yidong, 2011/02/08
- Re: bug in copy-directory, Thierry Volpiatto, 2011/02/09
- Re: bug in copy-directory, Michael Albinus, 2011/02/09
- Re: bug in copy-directory, Chong Yidong, 2011/02/09
- Re: bug in copy-directory, Michael Albinus, 2011/02/09
- Re: bug in copy-directory,
Thierry Volpiatto <=
- Re: bug in copy-directory, Chong Yidong, 2011/02/09
- Re: bug in copy-directory, Thierry Volpiatto, 2011/02/09
Re: bug in copy-directory, Thierry Volpiatto, 2011/02/02