bug#10897: copy-directory create new directory when copying a symlink

[Marco Centurion]

I failed to document the new behaviour in the docstring.

The patch I sent didn't manage the creation of the new symlink correctly
either, as it created it with the same name as the target.  That is, in
the examples given the result was:

-------------------------
(copy-directory "~/tmp/foo" "~/Test" nil t)
=>
[mcenturion@localhost ~]$ ls -l Test
total 4
lrwxrwxrwx. 1 mcenturion mcenturion 26 ago 19 21:21 Test1 -> 
/home/mcenturion/tmp/Test1
-------------------------

This new patch corrects both mistakes.

Sorry for the misfire.

diff --git a/lisp/files.el b/lisp/files.el
index 875ac55316..0bf8a2ea8d 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -6165,6 +6165,9 @@ copy-directory
 parent directories if they don't exist.  Interactively, this
 happens by default.
 
+If DIRECTORY is a symlink, create a symlink with the same target
+as DIRECTORY.
+
 If NEWNAME is a directory name, copy DIRECTORY as a subdirectory
 there.  However, if called from Lisp with a non-nil optional
 argument COPY-CONTENTS, copy the contents of DIRECTORY directly
@@ -6193,42 +6196,52 @@ copy-directory
       (setq directory (directory-file-name (expand-file-name directory))
            newname (expand-file-name newname))
 
-      (cond ((not (directory-name-p newname))
-            ;; If NEWNAME is not a directory name, create it;
-            ;; that is where we will copy the files of DIRECTORY.
-            (make-directory newname parents))
-           ;; NEWNAME is a directory name.  If COPY-CONTENTS is non-nil,
-           ;; create NEWNAME if it is not already a directory;
-           ;; otherwise, create NEWNAME/[DIRECTORY-BASENAME].
-           ((if copy-contents
-                (or parents (not (file-directory-p newname)))
-              (setq newname (concat newname
-                                    (file-name-nondirectory directory))))
-            (make-directory (directory-file-name newname) parents))
-           (t (setq follow t)))
-
-      ;; Copy recursively.
-      (dolist (file
-              ;; We do not want to copy "." and "..".
-              (directory-files directory 'full
-                               directory-files-no-dot-files-regexp))
-       (let ((target (concat (file-name-as-directory newname)
-                             (file-name-nondirectory file)))
-             (filetype (car (file-attributes file))))
-         (cond
-          ((eq filetype t)       ; Directory but not a symlink.
-           (copy-directory file target keep-time parents t))
-          ((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))
-           (times (and keep-time (file-attribute-modification-time
-                                  (file-attributes directory))))
-           (follow-flag (unless follow 'nofollow)))
-       (if modes (set-file-modes newname modes follow-flag))
-       (if times (set-file-times newname times follow-flag))))))
+      ;; If DIRECTORY is a symlink, create a symlink with the same target.
+      (if (file-symlink-p directory)
+          (let ((target (car (file-attributes directory))))
+           (if (directory-name-p newname)
+               (make-symbolic-link target
+                                   (concat newname
+                                           (file-name-nondirectory directory))
+                                   t)
+             (make-symbolic-link target newname t)))
+        ;; Else proceed to copy as a regular directory
+        (cond ((not (directory-name-p newname))
+              ;; If NEWNAME is not a directory name, create it;
+              ;; that is where we will copy the files of DIRECTORY.
+              (make-directory newname parents))
+             ;; NEWNAME is a directory name.  If COPY-CONTENTS is non-nil,
+             ;; create NEWNAME if it is not already a directory;
+             ;; otherwise, create NEWNAME/[DIRECTORY-BASENAME].
+             ((if copy-contents
+                  (or parents (not (file-directory-p newname)))
+                (setq newname (concat newname
+                                      (file-name-nondirectory directory))))
+              (make-directory (directory-file-name newname) parents))
+             (t (setq follow t)))
+
+        ;; Copy recursively.
+        (dolist (file
+                ;; We do not want to copy "." and "..".
+                (directory-files directory 'full
+                                 directory-files-no-dot-files-regexp))
+         (let ((target (concat (file-name-as-directory newname)
+                               (file-name-nondirectory file)))
+               (filetype (car (file-attributes file))))
+           (cond
+            ((eq filetype t)       ; Directory but not a symlink.
+             (copy-directory file target keep-time parents t))
+            ((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))
+             (times (and keep-time (file-attribute-modification-time
+                                    (file-attributes directory))))
+             (follow-flag (unless follow 'nofollow)))
+         (if modes (set-file-modes newname modes follow-flag))
+         (if times (set-file-times newname times follow-flag)))))))
 
 
 ;; At time of writing, only info uses this.

-- 
Marco Centurion
Unidad de Recursos Informáticos
Facultad de Ingeniería - UdelaR