make-thread 了,这么执行起来还是卡住了

就这个gist smart dired move · GitHub

my-dired-paste make-thread 用rsync复制文件, 不知为何,emacs会停止响应,直到复制结束。

Emacs 的多线程不是一个多现成的模型,而是每次只能执行一个线程。

所有耗时的任务还是多进程,IPC通讯吧。

1 个赞

只是调用rsync的话,可以用make-process或者async-shell-command

把rename-file注释掉呢?有些基础功能是没法make-thread了

看了下,你可以把call-process-shell-command改成start-process-shell-command。然后用emacs的异步进程机制处理

想要使用async.el,但是老是报错,专家能不能帮忙debug一下。 my-dired-move 实现下面功能

  1. 如果是git or git annex repo, use git mv
  2. 如果在同一个file system, use mv
  3. 如果不同file system, use rsync
  4. 可以多次把不同文件夹的文件添加到移动文件列表,一次全部mv

修改的版本在

用async.el,不知道怎么实现 子emacs在执行过程中把已经mv的文件数量返回给父emacs

async-startFINISH-FUNC可以接收 result。

Example:

(async-start
       ;; What to do in the child process
       (lambda ()
         (message "This is a test")
         (sleep-for 3)
         222)

       ;; What to do when it finishes
       (lambda (result)
         (message "Async process done, result should be 222: %s"
                  result)))

还是不会,就下面这个简单的函数,假设/tmp/mytest存在。

(setq tda/rsync-multiple-file-list '("/tmp/mytest"))
(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")
    (let* ((file-list tda/rsync-multiple-file-list)
            (target-directory tda/rsync-multiple-target-dir)
            moved-list failed-list exit-status)
        (dolist (it file-list)
        (ignore-errors
            (progn
            (rename-file it target-directory nil)
            (setq exit-status 0)))
        (if (= exit-status 0)
            (add-to-list 'moved-list it)
            (add-to-list 'failed-list it)))
        (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)))
    ;; revert affected dired buffers
    (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))))))))))

啊 找到原因了,原来 buffer 变量不能传递。

(require 'dash)
(require 'notify)

(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))

;;;###autoload
(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))))))

;; use thread
;;;###autoload
(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$")
    (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)
            moved-list failed-list exit-status)
        (dolist (it file-list)
        (let (exit-status)
            (setq exit-status
                (call-process-shell-command
                (concat "git mv " (shell-quote-argument it) " " (shell-quote-argument target-directory))
                nil " *git mv*"))
            (unless (= 0 exit-status)
            ;; https://gnu.huihoo.org/emacs/24.4/emacs-lisp/Standard-Errors.html
            (if (string= (shell-command-to-string
                            (concat "df --output=target " (shell-quote-argument it)))
                        (shell-command-to-string
                            (concat "df --output=target " (shell-quote-argument target-directory))))
                ;; on the same file system
                (ignore-errors
                    (progn
                    (rename-file it target-directory nil)
                    (setq exit-status 0)))
                ;; on different file systems
                (notify-via-dbus "Moving files:" (format "%d/%d to %s"
                                                        (length moved-list)
                                                        (length file-list)
                                                        target-directory))
                (setq exit-status
                        (call-process-shell-command
                        (concat "rsync -avz --progress --delete " (shell-quote-argument it) " " (shell-quote-argument target-directory))))
                ;; (with-current-buffer (dired-find-buffer-nocreate target-directory)
                ;;   (setq mode-line-process
                ;;         (format "%d/%d "
                ;;                 (length moved-list)
                ;;                 (length file-list))))
                ))
            (if (= exit-status 0)
                (add-to-list 'moved-list it)
                (add-to-list 'failed-list it))))
        ;; 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)
    ;; (message "result %s" 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)))
            (add-to-list 'moved-list 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))

;;; get file size
(defvar tda/get-files-size-command "du"
"The name of \"du\" command (or the path to the \"du\" command)")
(defvar tda/get-files-size-arguments "-hc"
"The arguments for passing into the \"du\" command")

;;; get file size
(defun tda/get-files-size ()
"Calculate files size for all the marked files"
(interactive)
(let ((files (dired-get-marked-files)) command)
    ;; the get files size command
    (setq command tda/get-files-size-command)
    (setq command (concat command " " tda/get-files-size-arguments " "))
    ;; add selected file names as arguments to the command
    (dolist (file files)
    (setq command (concat command (shell-quote-argument file) " ")))
    ;; execute the command
    (tat/execute-async command "file size")))

;;; ----------------------------------------------
;;; ----------------------------------------------
;;; Async Rsync
(defvar tda/rsync-command-name "rsync"
"The name of rsync command (or the path to the rsync command).")
(defvar tda/rsync-arguments "-avz --progress"
"The arguments for passing into the rsync command")

(defun tda/rsync (dest)
"Asynchronously copy file using Rsync for dired.
    This function runs only on Unix-based system.
    Usage: same as normal dired copy function."
(interactive ;; offer dwim target as the suggestion
(list (expand-file-name (read-file-name "Rsync to:" (dired-dwim-target-directory)))))
(let ((files (dired-get-marked-files nil current-prefix-arg))
        command)
    ;; the rsync command
    (setq command
        (concat tda/rsync-command-name " " tda/rsync-arguments " "))
    ;; add all selected file names as arguments to the rsync command
    (dolist (file files)
    (setq command (concat command (shell-quote-argument file) " ")))
    ;; append the destination to the rsync command
    (setq command (concat command (shell-quote-argument dest)))
    ;; execute the command asynchronously
    (tat/execute-async command "rsync")))

(defun tda/rsync-sudo (dest)
"Asynchronously copy file using Rsync for dired.
    This function runs only on Unix-based system.
    Usage: same as normal dired copy function."
(interactive ;; offer dwim target as the suggestion
(list (expand-file-name (read-file-name "Rsync to:" (dired-dwim-target-directory)))))
(let ((files (dired-get-marked-files nil current-prefix-arg))
        command)
    ;; the rsync command
    (setq command
        (concat "sudo " tda/rsync-command-name " " tda/rsync-arguments " "))
    ;; add all selected file names as arguments to the rsync command
    (dolist (file files)
    (setq command (concat command (shell-quote-argument file) " ")))
    ;; append the destination to the rsync command
    (setq command (concat command (shell-quote-argument dest)))
    ;; execute the command asynchronously
    (tat/execute-async command "rsync")))

(defun tda/rsync-delete (dest)
"Asynchronously copy file using Rsync for dired include the delete option
    This function runs only on Unix-based system.
    Usage: same as normal dired copy function."
(interactive ;; offer dwim target as the suggestion
(list (expand-file-name (read-file-name "Rsync delete to:" (dired-dwim-target-directory)))))
(let ((files (dired-get-marked-files nil current-prefix-arg))
        command)
    ;; the rsync command
    (setq command
        (concat tda/rsync-command-name " " tda/rsync-arguments " --delete "))
    ;; add all selected file names as arguments to the rsync command
    (dolist (file files)
    (setq command (concat command (shell-quote-argument file) " ")))
    ;; append the destination to the rsync command
    (setq command (concat command (shell-quote-argument dest)))
    ;; execute the command asynchronously
    (tat/execute-async command "rsync")))

(defun tda/rsync-delete-sudo (dest)
"Asynchronously copy file using Rsync for dired include the delete option
    This function runs only on Unix-based system.
    Usage: same as normal dired copy function."
(interactive ;; offer dwim target as the suggestion
(list (expand-file-name (read-file-name "Rsync delete to:" (dired-dwim-target-directory)))))
(let ((files (dired-get-marked-files nil current-prefix-arg))
        command)
    ;; the rsync command
    (setq command
        (concat "sudo " tda/rsync-command-name " " tda/rsync-arguments " --delete "))
    ;; add all selected file names as arguments to the rsync command
    (dolist (file files)
    (setq command (concat command (shell-quote-argument file) " ")))
    ;; append the destination to the rsync command
    (setq command (concat command (shell-quote-argument dest)))
    ;; execute the command asynchronously
    (tat/execute-async command "rsync")))

;;; ----------------------------------------------
;;; ----------------------------------------------
;;; async zip files
(defvar tda/zip-command "zip"
"The command name (or the path to the zip command")
(defvar tda/zip-arguments
"-ru9" "The compression level for dired async zip command, from 0-9. This variable is a string, so if you change this value, please set it as a string.")

(defun tda/zip (output)
"Asynchronously compress marked files to the output file"
(interactive
(list (expand-file-name (read-file-name "Add to file: "))))

(let (command
        (files (dired-get-marked-files nil current-prefix-arg)))
    ;; the zip command
    (setq command
        (concat tda/zip-command " " tda/zip-arguments " "))
    ;; append the output file
    (setq command
        (concat command (shell-quote-argument output) " "))
    ;; add all selected files as argument
    (dolist (file files)
    (setq command
            (concat command
                    (shell-quote-argument
                    (file-name-nondirectory file)) " ")))
    (message command)
    ;; execute the command asynchronously
    (tat/execute-async command "zip")))

;;; ----------------------------------------------
;;; ----------------------------------------------
;;; Uncompress function
(defvar tda/unzip-command "unzip"
"The command name (or path to the unzip command)")
(defvar tda/unzip-arguments ""
"The arguments for passing into the unzip command")

(defun tda/unzip ()
"Asynchronously decompress the zip file at point"
(interactive)

(let (command
        output-directory
        (file (dired-get-filename 'verbatim)))

    ;; new directory name for the output files
    (setq output-directory
        (file-name-sans-extension
        (dired-get-filename 'verbatim)))

    ;; the unzip command
    (setq command (concat tda/unzip-command " " tda/unzip-arguments " "))
    ;; append the file name
    (setq command
        (concat command
                (shell-quote-argument file) " "))
    ;; append the output directory name
    (setq command
        (concat command "-d "
                (shell-quote-argument output-directory)))

    ;; execute the command asynchronously
    (tat/execute-async command "unzip")))

;;; ----------------------------------------------
;;; ----------------------------------------------
;;; Rsync from multiple directories
(defun tda/rsync-multiple-mark-file ()
"Add file to waiting list for copying"
(interactive)
;; Add file to the list
(let ((files (dired-get-marked-files nil current-prefix-arg)))
    (mapc (lambda (item) (add-to-list 'tda/rsync-multiple-file-list 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."))))

;; Copy file from multiple directories
(defun tda/rsync-multiple ()
"Mark file in multiple places and then paste in 1 directory"
(interactive)

(let (command)
    (if (equal tda/rsync-multiple-file-list ())
        (progn
        (message "Please add file to the waiting list."))
    (progn
        ;; the rsync command
        (setq command (concat tda/rsync-command-name " " tda/rsync-arguments " "))
        ;; add all selected file names as arguments to the rsync command
        (dolist (file tda/rsync-multiple-file-list)
        (setq command
                (concat command (shell-quote-argument file) " ")))
        ;; append the destination to the rsync command
        (setq command
            (concat command
                    (shell-quote-argument (expand-file-name default-directory))))
        ;; execute the command asynchronously
        (tat/execute-async command "rsync")
        ;; empty the waiting list
        (tda/rsync-multiple-empty-list)))))

;; tda/rsync-multiple replacement
(defun my-dired-paste ()
(interactive)
(make-thread
(lambda ()
    (let* ((file-list tda/rsync-multiple-file-list)
            (modified-buffer-list tda/rsync-modified-buffer-name-list)
            (target-directory (dired-current-directory))
            moved-list failed-list)
    (tda/rsync-multiple-empty-list)

    (--each file-list
        (let (exit-status)
        (setq exit-status
                (call-process-shell-command
                (concat "rsync -avz --progress --delete " (shell-quote-argument it) " " (shell-quote-argument target-directory))))
        (if (= exit-status 0)
            (let ((buf (get-file-buffer it)))
                (add-to-list 'moved-list it)
                (with-current-buffer (dired-find-buffer-nocreate target-directory)
                (setq mode-line-process
                        (format "%d/%d "
                                (length moved-list)
                                (length file-list))))
                (message (format "Moved %d/%d to %s"
                                (length moved-list)
                                (length file-list)
                                target-directory))
                (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))))
            (add-to-list 'failed-list it))))

    (with-mutex my-dired-mutex
        ;; 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 "Copied %d/%d to %s"
                            (length moved-list)
                            (length file-list)
                            target-directory)))
        ;; add failed-list to tda/rsync-multiple-failed-list
        ;; mark moved files in target dir
        (when moved-list
        (dired-ranger--revert-target ?M target-directory moved-list))
        ;; revert affected dired buffers
        (--each modified-buffer-list
        (when (buffer-live-p it)
            (with-current-buffer it (revert-buffer)))))))))

;;; ----------------------------------------------
;;; ----------------------------------------------
;;; download file to current dir
(defvar tda/download-command "wget"
"The download program to download to current dir. The default is wget, ou can replace it to curl, aria2c,...")
(defun tda/download-to-current-dir (src)
"Read the link and download the file to current directory"
(interactive (list (read-from-minibuffer "Link: ")))
(let ((command ""))
    ;; create the command
    (setq command (concat command tda/download-command " "))
    ;; append the link
    (setq command (concat command (shell-quote-argument src)))
    ;; execute
    (tat/execute-async command "download")))
(defun tda/download-clipboard-link-to-current-dir ()
"Read the clipboard link and download it into the current dir"
(interactive)
(tda/download-to-current-dir (x-get-clipboard)))

(provide 'tmtxt-dired-async)

正解,子进程中找不到变量会报错的。