+2012-02-24 Thierry Volpiatto <thierry.volpiatto@gmail.com>
+
+ * lisp/files.el (files-equal-p): New, simple equality check between two filename.
+ (file-subdir-of-p): New, Check if dir1 is subdir of dir2.
+ (copy-directory): Return error when trying to copy a directory on itself.
+ Add missing copy-contents arg to tramp handler.
+
+ * lisp/dired-aux.el (dired-copy-file-recursive): Same.
+ (dired-create-files): Modify destination when source is equal to dest when copying files.
+ Return also when dest is a subdir of source.
+ (bug#10489)
+
2012-02-24 Michael Albinus <michael.albinus@gmx.de>
* net/ange-ftp.el (ange-ftp-parse-netrc): Suppress comment lines.
(defun dired-copy-file-recursive (from to ok-flag &optional
preserve-time top recursive)
+ (when (file-subdir-of-p to from)
+ (error "Cannot copy `%s' into its subdirectory `%s'" from to))
(let ((attrs (file-attributes from)))
(if (and recursive
(eq t (car attrs))
(cond ((integerp marker-char) marker-char)
(marker-char (dired-file-marker from)) ; slow
(t nil))))
- (when (and (file-directory-p from)
- (file-directory-p to)
- (eq file-creator 'dired-copy-file))
- (setq to (file-name-directory to)))
+ ;; Handle the `dired-copy-file' file-creator specially
+ ;; When copying a directory to another directory or
+ ;; possibly to itself or one of its subdirectories.
+ ;; e.g "~/foo/" => "~/test/"
+ ;; or "~/foo/" =>"~/foo/"
+ ;; or "~/foo/ => ~/foo/bar/")
+ ;; In this case the 'name-constructor' have set the destination
+ ;; TO to "~/test/foo" because the old emacs23 behavior
+ ;; of `copy-directory' was to not create the subdirectory
+ ;; and instead copy the contents.
+ ;; With the new behavior of `copy-directory'
+ ;; (similar to the `cp' shell command) we don't
+ ;; need such a construction of the target directory,
+ ;; so modify the destination TO to "~/test/" instead of "~/test/foo/".
+ (let ((destname (file-name-directory to)))
+ (when (and (file-directory-p from)
+ (file-directory-p to)
+ (eq file-creator 'dired-copy-file))
+ (setq to destname))
+ ;; If DESTNAME and FROM are the same directory or
+ ;; If DESTNAME is a subdirectory of FROM, return error.
+ (and (file-subdir-of-p destname from)
+ (error "Cannot copy `%s' into its subdirectory `%s'"
+ from to)))
(condition-case err
(progn
(funcall file-creator from to dired-overwrite-confirmed)
directory 'full directory-files-no-dot-files-regexp)))
(delete-directory-internal directory)))))
+(defun files-equal-p (file1 file2)
+ "Return non-nil if FILE1 and FILE2 name the same file."
+ (let ((handler (or (find-file-name-handler file1 'files-equal-p)
+ (find-file-name-handler file2 'files-equal-p))))
+ (if handler
+ (funcall handler 'files-equal-p file1 file2)
+ (equal (file-attributes (file-truename file1))
+ (file-attributes (file-truename file2))))))
+
+(defun file-subdir-of-p (dir1 dir2)
+ "Return non-nil if DIR1 is a subdirectory of DIR2.
+Note that a directory is treated by this function as a subdirectory of itself.
+This function only works when its two arguments already exist,
+when they don't, it returns nil."
+ (let ((handler (or (find-file-name-handler dir1 'file-subdir-of-p)
+ (find-file-name-handler dir2 'file-subdir-of-p))))
+ (if handler
+ (funcalll handler 'file-subdir-of-p dir1 dir2)
+ (when (and (file-directory-p dir1)
+ (file-directory-p dir2))
+ (loop with f1 = (file-truename dir1)
+ with f2 = (file-truename dir2)
+ with ls1 = (or (split-string f1 "/" t) (list "/"))
+ with ls2 = (or (split-string f2 "/" t) (list "/"))
+ for p = (string-match "^/" f1)
+ for i in ls1
+ for j in ls2
+ when (string= i j)
+ concat (if p (concat "/" i) (concat i "/"))
+ into root
+ finally return
+ (files-equal-p (file-truename root) f2))))))
+
(defun copy-directory (directory newname &optional keep-time parents copy-contents)
"Copy DIRECTORY to NEWNAME. Both args must be strings.
This function always sets the file modes of the output files to match
(format "Copy directory %s to: " dir)
default-directory default-directory nil nil)
current-prefix-arg t nil)))
+ (when (file-subdir-of-p newname directory)
+ (error "Cannot copy `%s' into its subdirectory `%s'"
+ directory newname))
;; 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)
(find-file-name-handler newname 'copy-directory))))
(if handler
- (funcall handler 'copy-directory directory newname keep-time parents)
+ (funcall handler 'copy-directory directory
+ newname keep-time parents copy-contents)
;; Compute target name.
(setq directory (directory-file-name (expand-file-name 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))
+ (make-directory newname parents)
+ ;; `file-subdir-of-p' doesn't handle non--existing directories,
+ ;; so double check now if NEWNAME is not a subdir of DIRECTORY.
+ (and (file-subdir-of-p newname directory)
+ (error "Cannot copy `%s' into its subdirectory `%s'"
+ directory newname)))
;; If NEWNAME is an existing directory and COPY-CONTENTS
;; is nil, copy into NEWNAME/[DIRECTORY-BASENAME].
((not copy-contents)
HCoop / bpt / emacs.git / commitdiff