share two functions for file operations in the background

gistfile1.txt

(require 'dash)

   (defun my-rename-file (file newname &optional ok-if-already-exists)
     "fix path for relative symlink"
     (let* ((file-name (file-name-nondirectory file))
            (new-dir-name (file-name-directory newname))
            (new-file-path (expand-file-name file-name new-dir-name))
            (relative-symlink (file-symlink-p new-file-path)))
       (when (and relative-symlink (string-equal system-type "gnu/linux"))
         (dired-make-relative-symlink
          ;; overwrite the invalid symlink
          (expand-file-name relative-symlink (file-name-directory file)) new-file-path t))))
   (advice-add #'rename-file :after #'my-rename-file)


(defun my-same-file-systemp (path1 path2)
  (let ((path1 (file-name-directory (expand-file-name path1)))
        (path2 (file-name-directory (expand-file-name path2))))
    (string= (shell-command-to-string
              (concat "df --output=target " (shell-quote-argument (expand-file-name path1))))
             (shell-command-to-string
              (concat "df --output=target " (shell-quote-argument (expand-file-name path2)))))))

(defvar my-dired-mutex (make-mutex "my-dired mutex"))

(defvar tda/rsync-multiple-file-list
  () "The list of the files to be copied")

(defvar tda/rsync-multiple-failed-list
  () "The alist (dir . failed-file-list) of the files to be manualled processed")

(defvar tda/rsync-modified-buffer-name-list
  ())

(defvar tda/rsync-multiple-target-dir nil)

(defun my-dired-utils-goto-line (filename)
  "Go to line describing FILENAME in listing.

Should be absolute file name matched against
`dired-get-filename'."
  (goto-char (point-min))
  (let (stop)
    (while (and (not stop)
                (= (forward-line) 0))
      (when (equal filename (dired-get-filename nil t))
        (setq stop t)
        (dired-move-to-filename)))
    stop))

(defun dired-ranger--revert-target (char target-directory files)
  "Revert the target buffer and mark the new files.

CHAR is the temporary value for `dired-marker-char'.

TARGET-DIRECTORY is the current dired directory.

FILES is the list of files (from the `dired-ranger-copy-ring') we
operated on."
  (let ((buf (dired-find-buffer-nocreate target-directory)))
    (when buf 
      (with-current-buffer buf
        (let ((current-file (dired-get-filename nil t)))
          (revert-buffer)
          (let ((dired-marker-char char))
            (--each (-map 'file-name-nondirectory files)
              (my-dired-utils-goto-line (concat target-directory it))
              (dired-mark 1)))
          (my-dired-utils-goto-line current-file))))))

(defun my-clean-failed-tasks ()
  "Create a dired buffer for tda/rsync-multiple-failed-list and process it manually"
  (interactive)
  (let* ((item (pop tda/rsync-multiple-failed-list)))
    (when item
      (dired (car item))
      (delete-other-windows)
      (split-window-right)
      (dired (cons "failed file list" (cdr item)))
      )))

(defun my-dired-move ()
  (interactive)
  (setq tda/rsync-multiple-target-dir default-directory)
  (async-start
   `(lambda ()
      ,(async-inject-variables "^load-path$")
      ,(async-inject-variables "^exec-path$")
      ,(async-inject-variables "^tda/rsync-multiple-file-list$")
      ,(async-inject-variables "^tda/rsync-multiple-target-dir$")
      ,(async-inject-variables "^tda/rsync-modified-buffer-name-list$")
            (require 'dired-x)
      (require 'notify)
      (setq notify-delay '(0 0 1))

      (defun my-dired-move-file (it target-directory)
        (let* ((file-name (file-name-nondirectory it))
               (symlink (file-symlink-p it))
               (new-file-path (expand-file-name file-name target-directory))
               exit-status)
          (setq exit-status
                (call-process-shell-command
                 (concat "git mv " (shell-quote-argument it) " " (shell-quote-argument (expand-file-name target-directory)))
                 nil " *git mv*"))
          (if (= 0 exit-status)
              (when symlink
                (dired-make-relative-symlink (expand-file-name symlink (file-name-directory it)) new-file-path t))
              (if (my-same-file-systemp it target-directory)
                  (condition-case err
                      (progn (if symlink
                                 (progn (dired-make-relative-symlink (expand-file-name symlink (file-name-directory it)) new-file-path)
                                        (dired-delete-file it))
                                 (rename-file it target-directory))
                             (setq exit-status 0))
                    ('error (notify "Error in renaming file: " (format "%s" err))
                            (setq exit-status 1)))
                  (notify "Moving files with rsync in the background!" "")
                  (setq exit-status
                        (call-process-shell-command
                         (concat "rsync -a --copy-links --partial --remove-source-files "
                                 (shell-quote-argument it) " " (shell-quote-argument (expand-file-name target-directory))) nil " *rsync*"))))
          exit-status))

      (defun my-dired-move-dir (dir target-directory)
        (let* ((dir-file-name (file-name-nondirectory (directory-file-name dir)))
               (new-target-directory (expand-file-name dir-file-name target-directory))
               exit-status)
          (condition-case err
              (progn
                (when (not (file-exists-p new-target-directory))
                  (make-directory new-target-directory t))
                (setq exit-status 0))
            ('error (notify "Error in mkdir: " (format "%s" err))
                    (setq exit-status 1)))
          (dolist (it (directory-files dir t "^[^\\.]"))
            (if (and (file-directory-p it) (not (file-symlink-p it)))
                (my-dired-move-dir it new-target-directory)
                (setq exit-status (my-dired-move-file it new-target-directory))))
          (delete-directory dir t t)
          exit-status))

      (let ((file-list tda/rsync-multiple-file-list)
            (modified-buffer-name-list tda/rsync-modified-buffer-name-list)
            (target-directory tda/rsync-multiple-target-dir)
            (notification-timer (timer-create))
            moved-list failed-list exit-status)
        (dolist (it file-list)
          (setq notification-timer
                (run-at-time 20 nil
                             (lambda ()
                               (notify "Move file in the background:" (format "%d/%d to %s"
                                                               (length moved-list)
                                                               (length file-list)
                                                               target-directory)))))
          (if (and (file-directory-p it) (not (file-symlink-p it)))
              (setq exit-status (my-dired-move-dir it target-directory))
              (setq exit-status (my-dired-move-file it target-directory)))
          (if (and exit-status (= exit-status 0))
              (add-to-list 'moved-list it)
              (add-to-list 'failed-list it)))
        (notify "All files moved!" "")
        ;; modified-buffer-name-list is a list of buffer names, async.el has problems in sending buffer variable
        (list target-directory moved-list failed-list modified-buffer-name-list)))

   (lambda (result)
     (let ((target-directory (nth 0 result))
           (moved-list (nth 1 result))
           (failed-list (nth 2 result))
           (modified-buffer-name-list (nth 3 result)))
       (with-mutex my-dired-mutex
         ;; mark moved files in target dir
         (when moved-list
           (dolist (it moved-list)
             (let ((buf (get-file-buffer it)))
               (when buf 
                 ;; redirect opened buffer to new file path see vc-rename-file
                 (with-current-buffer buf
                   (set-visited-file-name (concat target-directory (file-name-nondirectory it)) nil t)))))
           (dired-ranger--revert-target ?M target-directory moved-list))
         ;; add failed-list to tda/rsync-multiple-failed-list
         (if failed-list
             (progn
               (setf (alist-get target-directory tda/rsync-multiple-failed-list nil t 'equal)
                     (delete-dups (append failed-list (alist-get target-directory tda/rsync-multiple-failed-list nil nil 'equal))))
               (message "Warning: some tasks failed, please run my-clean-failed-tasks!"))
             (message (format "Moved %d/%d to %s"
                              (length moved-list)
                              (+ (length moved-list) (length failed-list))
                              target-directory)))
         ;; revert affected dired buffers
         (dolist (it modified-buffer-name-list nil)
           (when (get-buffer it)
             (with-current-buffer (get-buffer it) (revert-buffer))))))))

  (tda/rsync-multiple-empty-list))

(defun my-dired-paste ()
  (interactive)
  (setq tda/rsync-multiple-target-dir default-directory)
  (async-start
   `(lambda ()
      ,(async-inject-variables "^load-path$")
      ,(async-inject-variables "^exec-path$")
      ,(async-inject-variables "^tda/rsync-multiple-file-list$")
      ,(async-inject-variables "^tda/rsync-multiple-target-dir$")
            (require 'dired-x)
      (require 'dired+)
      (require 'notify)

      (defun my-dired-paste-file (it target-directory)
        (let* ((file-name (file-name-nondirectory it))
               (symlink (file-symlink-p it))
               (new-file-path (expand-file-name file-name target-directory))
               exit-status)
          (condition-case err
              (progn (if symlink
                         (dired-make-relative-symlink (expand-file-name symlink (file-name-directory it)) new-file-path)
                         (notify "Hardlinking!" "")
                         (dired-hardlink it new-file-path))
                     (setq exit-status 0))
            ('error (notify "Caught exception: " (format "%s" err))
                    (setq exit-status 1)))
          exit-status))

      (defun my-dired-paste-dir (dir target-directory)
        (let* ((dir-file-name (file-name-nondirectory (directory-file-name dir)))
               (new-target-directory (expand-file-name dir-file-name target-directory))
               exit-status)
          (condition-case err
              (progn
                (when (not (file-exists-p new-target-directory))
                  (make-directory new-target-directory t))
                (setq exit-status 0))
            ('error (notify "Error in mkdir: " (format "%s" err))
                    (setq exit-status 1)))
          (dolist (it (directory-files dir t "^[^\\.]"))
            (if (and (file-directory-p it) (not (file-symlink-p it)))
                (my-dired-paste-dir it new-target-directory)
                (setq exit-status (my-dired-paste-file it new-target-directory))))
          exit-status))

      ;; ensure all notification are sent
      (setq notify-delay '(0 0 1))
      (let ((file-list tda/rsync-multiple-file-list)
            (target-directory tda/rsync-multiple-target-dir)
            (notification-timer (timer-create))
            moved-list failed-list exit-status)
        (dolist (it file-list)
          (setq notification-timer
                  (notify "Copy file in the background:" (format "%d/%d to %s"
                                                   (length moved-list)
                                                   (length file-list)
                                                   target-directory)))

          (if (my-same-file-systemp it target-directory)
              (if (and (file-directory-p it) (not (file-symlink-p it)))
                  (setq exit-status (my-dired-paste-dir it target-directory))
                  (setq exit-status (my-dired-paste-file it target-directory)))
              (setq exit-status
                    (call-process-shell-command
                     (concat "rsync -a --partial --copy-links " (shell-quote-argument it) " "
                             (shell-quote-argument (expand-file-name target-directory))))))

        (if (and exit-status (= exit-status 0))
            (add-to-list 'moved-list it)
            (add-to-list 'failed-list it)))
        (notify "All files copied!" "")
        (list target-directory moved-list failed-list)))

   (lambda (result)
     (let ((target-directory (nth 0 result))
           (moved-list (nth 1 result))
           (failed-list (nth 2 result)))
       (with-mutex my-dired-mutex
         ;; mark moved files in target dir
         (when moved-list
           (dired-ranger--revert-target ?M target-directory moved-list))
         ;; add failed-list to tda/rsync-multiple-failed-list
         (if failed-list
             (progn
               (setf (alist-get target-directory tda/rsync-multiple-failed-list nil t 'equal)
                     (delete-dups (append failed-list (alist-get target-directory tda/rsync-multiple-failed-list nil nil 'equal))))
               (message "Warning: some tasks failed, please run my-clean-failed-tasks!"))
             (message (format "Moved %d/%d to %s"
                              (length moved-list)
                              (+ (length moved-list) (length failed-list))
                              target-directory)))))))
  (tda/rsync-multiple-empty-list))

(defun tda/rsync-multiple-mark-file ()
  "Add file to waiting list for copying"
  (interactive)
  ;; Add file to the list
  (let ((files (or (dired-get-marked-files nil current-prefix-arg) (list (dired-get-filename)))))
    (mapc (lambda (item) (add-to-list 'tda/rsync-multiple-file-list (expand-file-name item))) files)
    ;; Message for user
    (add-to-list 'tda/rsync-modified-buffer-name-list (buffer-name))
    (message "Marked file added to waiting list.")))

(defun tda/rsync-multiple-empty-list ()
  "Empty the waiting list"
  (interactive)
  ;; Empty the list
  (setq tda/rsync-multiple-file-list '())
  (setq tda/rsync-modified-buffer-name-list '())
  ;; message for the user
  (message "Waiting list empty."))

(defun tda/rsync-multiple-remove-item ()
  "Remove the file at point from the waiting list if it is in"
  (interactive)
  (let ((files (dired-get-filename)))
    ;; remove the item from the list
    (setq tda/rsync-multiple-file-list
          (dolist (file files)
            (remove file tda/rsync-multiple-file-list)))
    ;; message for the use
    (message
     (concat "Marked file(s) removed from the list."))))

(provide 'tmtxt-dired-async)