[Emacs-diffs] /srv/bzr/emacs/trunk r107706: Fix copying of symlinks.

[Chong Yidong]

------------------------------------------------------------
revno: 107706
author: Thierry Volpiatto <address@hidden>
committer: Chong Yidong <address@hidden>
branch nick: trunk
timestamp: Sat 2012-03-31 00:49:29 +0800
message:
  Fix copying of symlinks.
  
  * dired-aux.el (dired-copy-file-recursive, dired-create-files):
  Check if file is a symlink (Bug#10489).
  
  * files.el (copy-directory): Likewise.
modified:
  lisp/ChangeLog
  lisp/dired-aux.el
  lisp/dired.el
  lisp/files.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2012-03-30 16:31:24 +0000
+++ b/lisp/ChangeLog    2012-03-30 16:49:29 +0000
@@ -1,3 +1,10 @@
+2012-03-30  Thierry Volpiatto  <address@hidden>
+
+       * dired-aux.el (dired-copy-file-recursive, dired-create-files):
+       Check if file is a symlink (Bug#10489).
+
+       * files.el (copy-directory): Likewise.
+
 2012-03-30  Chong Yidong  <address@hidden>
 
        * image.el (imagemagick-types-inhibit)

=== modified file 'lisp/dired-aux.el'
--- a/lisp/dired-aux.el 2012-02-24 18:04:03 +0000
+++ b/lisp/dired-aux.el 2012-03-30 16:49:29 +0000
@@ -1264,7 +1264,8 @@
 
 (defun dired-copy-file-recursive (from to ok-flag &optional
                                       preserve-time top recursive)
-  (when (file-subdir-of-p to from)
+  (when (and (eq t (car (file-attributes from)))
+            (file-subdir-of-p to from))
     (error "Cannot copy `%s' into its subdirectory `%s'" from to))
   (let ((attrs (file-attributes from)))
     (if (and recursive
@@ -1451,11 +1452,13 @@
                          (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)))
+             ;; If DESTNAME is a subdirectory of FROM, not a symlink,
+             ;; and the method in use is copying, signal an error.
+             (and (eq t (car (file-attributes destname)))
+                  (eq file-creator 'dired-copy-file)
+                  (file-subdir-of-p destname from)
+                  (error "Here:Cannot copy `%s' into its subdirectory `%s'"
+                         from to)))
             (condition-case err
                 (progn
                   (funcall file-creator from to dired-overwrite-confirmed)

=== modified file 'lisp/dired.el'
--- a/lisp/dired.el     2012-03-21 17:15:39 +0000
+++ b/lisp/dired.el     2012-03-30 16:49:29 +0000
@@ -3736,7 +3736,7 @@
 ;;;;;;  dired-run-shell-command dired-do-shell-command 
dired-do-async-shell-command
 ;;;;;;  dired-clean-directory dired-do-print dired-do-touch dired-do-chown
 ;;;;;;  dired-do-chgrp dired-do-chmod dired-compare-directories 
dired-backup-diff
-;;;;;;  dired-diff) "dired-aux" "dired-aux.el" 
"cab9b84177ac3555c24cf8e870a64095")
+;;;;;;  dired-diff) "dired-aux" "dired-aux.el" 
"aefbe886cce7b5436fd41a7c55c86f84")
 ;;; Generated autoloads from dired-aux.el
 
 (autoload 'dired-diff "dired-aux" "\

=== modified file 'lisp/files.el'
--- a/lisp/files.el     2012-03-26 01:35:47 +0000
+++ b/lisp/files.el     2012-03-30 16:49:29 +0000
@@ -5102,13 +5102,14 @@
               ;; We do not want to copy "." and "..".
               (directory-files directory 'full
                                directory-files-no-dot-files-regexp))
-       (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)))))
+       (let ((target (expand-file-name (file-name-nondirectory file) newname))
+             (filetype (car (file-attributes file))))
+         (cond
+          ((eq filetype t)       ; Directory but not a symlink.
+           (copy-directory file newname keep-time parents))
+          ((stringp filetype)    ; Symbolic link
+           (make-symbolic-link filetype target t))
+          ((copy-file file target t keep-time)))))
 
       ;; Set directory attributes.
       (let ((modes (file-modes directory))