dired-async fails to overwrite directory when copying

[thierryvolpiatto]

There is actually a bug in copy-directory which is still not yet fixed in Emacs and affect of course dired-async when copying a directory to another directory that contain this same directory (overwrite directory to make it short).
See https://www.reddit.com/r/emacs/comments/yha104/merging_directories_in_dired_am_i_doing_it_wrong/
https://yhetil.org/emacs-bugs/[email protected]/T/
and https://yhetil.org/emacs-bugs/[email protected]/T/

To fix it the following code can be copied in a file e.g. "~/.emacs.d/fix-copy-directory.el" and make the var async-child-init point to this file. Here the code that advice copy-directory:

;; Fix bug in copy-directory


(defun dired-async--copy-directory (directory newname &optional keep-time parents copy-contents)
  (interactive
   (let ((dir (read-directory-name
	       "Copy directory: " default-directory default-directory t nil)))
     (list dir
	   (read-directory-name
	    (format "Copy directory %s to: " dir)
	    default-directory default-directory nil nil)
	   current-prefix-arg t nil)))
  (when (file-in-directory-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)))
	(follow parents))
    (if handler
	(funcall handler 'copy-directory directory
                 newname keep-time parents copy-contents)

      ;; Compute target name.
      (setq directory (directory-file-name (expand-file-name directory))
	    newname (expand-file-name newname))

      ;; 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.
              ((and copy-contents
                    (or parents (not (file-directory-p newname))))
               (make-directory (directory-file-name newname) parents))
              ;; Otherwise, create NEWNAME/[DIRECTORY-BASENAME].
              ((not copy-contents)
               (setq newname (concat newname
			             (file-name-nondirectory directory)))
               (let ((newname-isdir (file-directory-p newname)))
                 ;; This is needed only when running copy-directory
                 ;; interactively. When called from dired, error happens
                 ;; directly in first clause when trying to create a
                 ;; directory that have the same name as file NEWNAME.
                 (and (file-exists-p newname)
	              (not newname-isdir)
	              (error "Cannot overwrite non-directory %s with a directory"
		             newname))
                 (unless newname-isdir (make-directory newname t))))
              (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)))))))
(advice-add 'copy-directory :override #'dired-async--copy-directory)