From: Marco Centurion Date: Fri, 20 Aug 2021 13:43:41 +0000 (+0200) Subject: Allow copy-directory to copy the source as a symlink X-Git-Tag: emacs-28.0.90~1417 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=657fe8b9d87dd17d9b50dd8e15bfd917c6c630b2;p=emacs.git Allow copy-directory to copy the source as a symlink * doc/emacs/files.texi (Copying and Naming): Document it. * lisp/files.el (copy-directory): Allow copying symbolic links as is (bug#10897). (copy-directory-create-symlink): New user option. Copyright-paperwork-exempt: yes --- diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 8304e40706a..207c951a875 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -1728,12 +1728,16 @@ exists. @kbd{M-x copy-file} copies the contents of the file @var{old} to the file @var{new}. +@vindex copy-directory-create-symlink @findex copy-directory @kbd{M-x copy-directory} copies directories, similar to the @command{cp -r} shell command. If @var{new} is a directory name, it creates a copy of the @var{old} directory and puts it in @var{new}. Otherwise it copies all the contents of @var{old} into a new directory -named @var{new}. +named @var{new}. If @code{copy-directory-create-symlink} is +non-@code{nil} and @var{old} is a symbolic link, this command will +copy the symbolic link. If @code{nil}, this command will follow the +link and copy the contents instead. (This is the default.) @cindex renaming files @findex rename-file diff --git a/etc/NEWS b/etc/NEWS index b221f136241..7cd0c5fc4e1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2460,6 +2460,11 @@ images are marked. ** Miscellaneous ++++ +*** New user option 'copy-directory-create-symlink'. +If non-nil, will make `copy-directory' (when used on a symbolic +link) copy the link instead of following the link. + +++ *** New function 'replace-regexp-in-region'. diff --git a/lisp/files.el b/lisp/files.el index 77977f14116..90de1499340 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5437,6 +5437,15 @@ Used only by `save-buffer'." :type 'hook :group 'files) +(defcustom copy-directory-create-symlink nil + "This option influences the handling of symbolic links in `copy-directory'. +If non-nil, `copy-directory' will create a symbolic link if the +source directory is a symbolic link. If nil, it'll follow the +symbolic link and copy the contents instead." + :type 'boolean + :version "28.1" + :group 'files) + (defvar-local save-buffer-coding-system nil "If non-nil, use this coding system for saving the buffer. More precisely, use this coding system in place of the @@ -6165,6 +6174,9 @@ Noninteractively, the PARENTS argument says whether to create parent directories if they don't exist. Interactively, this happens by default. +If DIRECTORY is a symlink and `copy-directory-create-symlink' is +non-nil, 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 +6205,53 @@ into NEWNAME instead." (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 (and (file-symlink-p directory) + copy-directory-create-symlink) + (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.