about summary refs log tree commit diff
path: root/configs/shared/emacs/.emacs.d/elpa/async-20180527.1030/dired-async.el
diff options
context:
space:
mode:
authorWilliam Carroll <wpcarro@gmail.com>2018-09-10T18·51-0400
committerWilliam Carroll <wpcarro@gmail.com>2018-09-10T18·53-0400
commit17ee0e400bef47c371afcae76037f9ea6a44ad13 (patch)
tree0e5efee6f00e402890e91f3eceb4b29408a498b6 /configs/shared/emacs/.emacs.d/elpa/async-20180527.1030/dired-async.el
parent8b2fadf4776b7ddb4a67b4bc8ff6463770e56028 (diff)
Support Vim, Tmux, Emacs with Stow
After moving off of Meta, Dotfiles has a greater responsibility to
manage configs. Vim, Tmux, and Emacs are now within Stow's purview.
Diffstat (limited to 'configs/shared/emacs/.emacs.d/elpa/async-20180527.1030/dired-async.el')
-rw-r--r--configs/shared/emacs/.emacs.d/elpa/async-20180527.1030/dired-async.el405
1 files changed, 405 insertions, 0 deletions
diff --git a/configs/shared/emacs/.emacs.d/elpa/async-20180527.1030/dired-async.el b/configs/shared/emacs/.emacs.d/elpa/async-20180527.1030/dired-async.el
new file mode 100644
index 000000000000..bc406b390390
--- /dev/null
+++ b/configs/shared/emacs/.emacs.d/elpa/async-20180527.1030/dired-async.el
@@ -0,0 +1,405 @@
+;;; dired-async.el --- Asynchronous dired actions -*- lexical-binding: t -*-
+
+;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
+
+;; Authors: John Wiegley <jwiegley@gmail.com>
+;;          Thierry Volpiatto <thierry.volpiatto@gmail.com>
+
+;; Keywords: dired async network
+;; X-URL: https://github.com/jwiegley/dired-async
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This file provide a redefinition of `dired-create-file' function,
+;; performs copies, moves and all what is handled by `dired-create-file'
+;; in the background using a slave Emacs process,
+;; by means of the async.el module.
+;; To use it, put this in your .emacs:
+
+;;     (dired-async-mode 1)
+
+;; This will enable async copy/rename etc...
+;; in dired and helm.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'dired-aux)
+(require 'async)
+
+(eval-when-compile
+  (defvar async-callback))
+
+(defgroup dired-async nil
+  "Copy rename files asynchronously from dired."
+  :group 'dired)
+
+(defcustom dired-async-env-variables-regexp
+  "\\`\\(tramp-\\(default\\|connection\\|remote\\)\\|ange-ftp\\)-.*"
+  "Variables matching this regexp will be loaded on Child Emacs."
+  :type  'regexp
+  :group 'dired-async)
+
+(defcustom dired-async-message-function 'dired-async-mode-line-message
+  "Function to use to notify result when operation finish.
+Should take same args as `message'."
+  :group 'dired-async
+  :type  'function)
+
+(defcustom dired-async-log-file "/tmp/dired-async.log"
+  "File use to communicate errors from Child Emacs to host Emacs."
+  :group 'dired-async
+  :type 'string)
+
+(defcustom dired-async-mode-lighter '(:eval
+                                      (when (eq major-mode 'dired-mode)
+                                        " Async"))
+  "Mode line lighter used for `dired-async-mode'."
+  :group 'dired-async
+  :risky t
+  :type 'sexp)
+
+(defface dired-async-message
+    '((t (:foreground "yellow")))
+  "Face used for mode-line message."
+  :group 'dired-async)
+
+(defface dired-async-failures
+    '((t (:foreground "red")))
+  "Face used for mode-line message."
+  :group 'dired-async)
+
+(defface dired-async-mode-message
+    '((t (:foreground "Gold")))
+  "Face used for `dired-async--modeline-mode' lighter."
+  :group 'dired-async)
+
+(define-minor-mode dired-async--modeline-mode
+    "Notify mode-line that an async process run."
+  :group 'dired-async
+  :global t
+  :lighter (:eval (propertize (format " [%s Async job(s) running]"
+                                      (length (dired-async-processes)))
+                              'face 'dired-async-mode-message))
+  (unless dired-async--modeline-mode
+    (let ((visible-bell t)) (ding))))
+
+(defun dired-async-mode-line-message (text face &rest args)
+  "Notify end of operation in `mode-line'."
+  (message nil)
+  (let ((mode-line-format (concat
+                           " " (propertize
+                                (if args
+                                    (apply #'format text args)
+                                    text)
+                                'face face))))
+    (force-mode-line-update)
+    (sit-for 3)
+    (force-mode-line-update)))
+
+(defun dired-async-processes ()
+  (cl-loop for p in (process-list)
+           when (cl-loop for c in (process-command p) thereis
+                         (string= "async-batch-invoke" c))
+           collect p))
+
+(defun dired-async-kill-process ()
+  (interactive)
+  (let* ((processes (dired-async-processes))
+         (proc (car (last processes))))
+    (and proc (delete-process proc))
+    (unless (> (length processes) 1)
+      (dired-async--modeline-mode -1))))
+
+(defun dired-async-after-file-create (total operation failures skipped)
+  "Callback function used for operation handled by `dired-create-file'."
+  (unless (dired-async-processes)
+    ;; Turn off mode-line notification
+    ;; only when last process end.
+    (dired-async--modeline-mode -1))
+  (when operation
+    (if (file-exists-p dired-async-log-file)
+        (progn
+          (pop-to-buffer (get-buffer-create dired-log-buffer))
+          (goto-char (point-max))
+          (setq inhibit-read-only t)
+          (insert "Error: ")
+          (insert-file-contents dired-async-log-file)
+          (special-mode)
+          (shrink-window-if-larger-than-buffer)
+          (delete-file dired-async-log-file))
+        (run-with-timer
+         0.1 nil
+         (lambda ()
+           ;; First send error messages.
+           (cond (failures
+                  (funcall dired-async-message-function
+                           "%s failed for %d of %d file%s -- See *Dired log* buffer"
+                           'dired-async-failures
+                           (car operation) (length failures)
+                           total (dired-plural-s total)))
+                 (skipped
+                  (funcall dired-async-message-function
+                           "%s: %d of %d file%s skipped -- See *Dired log* buffer"
+                           'dired-async-failures
+                           (car operation) (length skipped) total
+                           (dired-plural-s total))))
+           (when dired-buffers
+             (cl-loop for (_f . b) in dired-buffers
+                      when (buffer-live-p b)
+                      do (with-current-buffer b (revert-buffer nil t))))
+           ;; Finally send the success message.
+           (funcall dired-async-message-function
+                    "Asynchronous %s of %s on %s file%s done"
+                    'dired-async-message
+                    (car operation) (cadr operation)
+                    total (dired-plural-s total)))))))
+
+(defun dired-async-maybe-kill-ftp ()
+  "Return a form to kill ftp process in child emacs."
+  (quote
+   (progn
+     (require 'cl-lib)
+     (let ((buf (cl-loop for b in (buffer-list)
+                         thereis (and (string-match
+                                       "\\`\\*ftp.*"
+                                       (buffer-name b)) b))))
+       (when buf (kill-buffer buf))))))
+
+(defvar overwrite-query)
+(defun dired-async-create-files (file-creator operation fn-list name-constructor
+                                 &optional _marker-char)
+  "Same as `dired-create-files' but asynchronous.
+
+See `dired-create-files' for the behavior of arguments."
+  (setq overwrite-query nil)
+  (let ((total (length fn-list))
+        failures async-fn-list skipped callback
+        async-quiet-switch)
+    (let (to)
+      (dolist (from fn-list)
+        (setq to (funcall name-constructor from))
+        (if (and (equal to from)
+                 (null (eq file-creator 'backup-file)))
+            (progn
+              (setq to nil)
+              (dired-log "Cannot %s to same file: %s\n"
+                         (downcase operation) from)))
+        (if (not to)
+            (setq skipped (cons (dired-make-relative from) skipped))
+            (let* ((overwrite (and (null (eq file-creator 'backup-file))
+                                   (file-exists-p to)))
+                   (dired-overwrite-confirmed ; for dired-handle-overwrite
+                    (and overwrite
+                         (let ((help-form `(format "\
+Type SPC or `y' to overwrite file `%s',
+DEL or `n' to skip to next,
+ESC or `q' to not overwrite any of the remaining files,
+`!' to overwrite all remaining files with no more questions." ,to)))
+                           (dired-query 'overwrite-query "Overwrite `%s'?" to)))))
+              ;; Handle the `dired-copy-file' file-creator specially
+              ;; When copying a directory to another directory or
+              ;; possibly to itself or one of its subdirectories.
+              ;; e.g "~/foo/" => "~/test/"
+              ;; or "~/foo/" =>"~/foo/"
+              ;; or "~/foo/ => ~/foo/bar/")
+              ;; In this case the 'name-constructor' have set the destination
+              ;; TO to "~/test/foo" because the old emacs23 behavior
+              ;; of `copy-directory' was to not create the subdirectory
+              ;; and instead copy the contents.
+              ;; With the new behavior of `copy-directory'
+              ;; (similar to the `cp' shell command) we don't
+              ;; need such a construction of the target directory,
+              ;; so modify the destination TO to "~/test/" instead of "~/test/foo/".
+              (let ((destname (file-name-directory to)))
+                (when (and (file-directory-p from)
+                           (file-directory-p to)
+                           (eq file-creator 'dired-copy-file))
+                  (setq to destname))
+                ;; If DESTNAME is a subdirectory of FROM, not a symlink,
+                ;; and the method in use is copying, signal an error.
+                (and (eq t (car (file-attributes destname)))
+                     (eq file-creator 'dired-copy-file)
+                     (file-in-directory-p destname from)
+                     (error "Cannot copy `%s' into its subdirectory `%s'"
+                            from to)))
+              (if overwrite
+                  (or (and dired-overwrite-confirmed
+                           (push (cons from to) async-fn-list))
+                      (progn
+                        (push (dired-make-relative from) failures)
+                        (dired-log "%s `%s' to `%s' failed\n"
+                                   operation from to)))
+                  (push (cons from to) async-fn-list)))))
+      ;; Fix tramp issue #80 with emacs-26, use "-q" only when needed.
+      (setq async-quiet-switch
+            (if (and (boundp 'tramp-cache-read-persistent-data)
+                     async-fn-list
+                     (cl-loop for (_from . to) in async-fn-list
+                              thereis (file-remote-p to)))
+                "-q" "-Q"))
+      ;; When failures have been printed to dired log add the date at bob.
+      (when (or failures skipped) (dired-log t))
+      ;; When async-fn-list is empty that's mean only one file
+      ;; had to be copied and user finally answer NO.
+      ;; In this case async process will never start and callback
+      ;; will have no chance to run, so notify failures here.
+      (unless async-fn-list
+        (cond (failures
+               (funcall dired-async-message-function
+                        "%s failed for %d of %d file%s -- See *Dired log* buffer"
+                        'dired-async-failures
+                        operation (length failures)
+                        total (dired-plural-s total)))
+              (skipped
+               (funcall dired-async-message-function
+                        "%s: %d of %d file%s skipped -- See *Dired log* buffer"
+                        'dired-async-failures
+                        operation (length skipped) total
+                        (dired-plural-s total)))))
+      ;; Setup callback.
+      (setq callback
+            (lambda (&optional _ignore)
+               (dired-async-after-file-create
+                total (list operation (length async-fn-list)) failures skipped)
+               (when (string= (downcase operation) "rename")
+                 (cl-loop for (file . to) in async-fn-list
+                          for bf = (get-file-buffer file)
+                          for destp = (file-exists-p to)
+                          do (and bf destp
+                                  (with-current-buffer bf
+                                    (set-visited-file-name to t t))))))))
+    ;; Start async process.
+    (when async-fn-list
+      (async-start `(lambda ()
+                      (require 'cl-lib) (require 'dired-aux) (require 'dired-x)
+                      ,(async-inject-variables dired-async-env-variables-regexp)
+                          (let ((dired-recursive-copies (quote always))
+                                (dired-copy-preserve-time
+                                 ,dired-copy-preserve-time))
+                            (setq overwrite-backup-query nil)
+                            ;; Inline `backup-file' as long as it is not
+                            ;; available in emacs.
+                            (defalias 'backup-file
+                                ;; Same feature as "cp -f --backup=numbered from to"
+                                ;; Symlinks are copied as file from source unlike
+                                ;; `dired-copy-file' which is same as cp -d.
+                                ;; Directories are omitted.
+                                (lambda (from to ok)
+                                  (cond ((file-directory-p from) (ignore))
+                                        (t (let ((count 0))
+                                             (while (let ((attrs (file-attributes to)))
+                                                      (and attrs (null (nth 0 attrs))))
+                                               (cl-incf count)
+                                               (setq to (concat (file-name-sans-versions to)
+                                                                (format ".~%s~" count)))))
+                                           (condition-case err
+                                               (copy-file from to ok dired-copy-preserve-time)
+                                             (file-date-error
+                                              (dired-log "Can't set date on %s:\n%s\n" from err)))))))
+                            ;; Now run the FILE-CREATOR function on files.
+                            (cl-loop with fn = (quote ,file-creator)
+                                     for (from . dest) in (quote ,async-fn-list)
+                                     do (condition-case err
+                                            (funcall fn from dest t)
+                                          (file-error
+                                           (dired-log "%s: %s\n" (car err) (cdr err)))
+                                          nil))
+                        (when (get-buffer dired-log-buffer)
+                          (dired-log t)
+                          (with-current-buffer dired-log-buffer
+                           (write-region (point-min) (point-max)
+                                         ,dired-async-log-file))))
+                      ,(dired-async-maybe-kill-ftp))
+                   callback)
+      ;; Run mode-line notifications while process running.
+      (dired-async--modeline-mode 1)
+      (message "%s proceeding asynchronously..." operation))))
+
+(defvar wdired-use-interactive-rename)
+(defun dired-async-wdired-do-renames (old-fn &rest args)
+  ;; Perhaps a better fix would be to ask for renaming BEFORE starting
+  ;; OLD-FN when `wdired-use-interactive-rename' is non-nil.  For now
+  ;; just bind it to nil to ensure no questions will be asked between
+  ;; each rename.
+  (let (wdired-use-interactive-rename)
+    (apply old-fn args)))
+
+(defadvice wdired-do-renames (around wdired-async)
+  (let (wdired-use-interactive-rename)
+    ad-do-it))
+
+(defadvice dired-create-files (around dired-async)
+  (dired-async-create-files file-creator operation fn-list
+                            name-constructor marker-char))
+
+;;;###autoload
+(define-minor-mode dired-async-mode
+  "Do dired actions asynchronously."
+  :group 'dired-async
+  :lighter dired-async-mode-lighter
+  :global t
+  (if dired-async-mode
+      (if (fboundp 'advice-add)
+          (progn (advice-add 'dired-create-files :override #'dired-async-create-files)
+                 (advice-add 'wdired-do-renames :around #'dired-async-wdired-do-renames))
+        (ad-activate 'dired-create-files)
+        (ad-activate 'wdired-do-renames))
+      (if (fboundp 'advice-remove)
+          (progn (advice-remove 'dired-create-files #'dired-async-create-files)
+                 (advice-remove 'wdired-do-renames #'dired-async-wdired-do-renames))
+          (ad-deactivate 'dired-create-files)
+          (ad-deactivate 'wdired-do-renames))))
+
+(defmacro dired-async--with-async-create-files (&rest body)
+  "Evaluate BODY with ‘dired-create-files’ set to ‘dired-async-create-files’."
+  (declare (indent 0))
+  `(cl-letf (((symbol-function 'dired-create-files) #'dired-async-create-files))
+     ,@body))
+
+;;;###autoload
+(defun dired-async-do-copy (&optional arg)
+  "Run ‘dired-do-copy’ asynchronously."
+  (interactive "P")
+  (dired-async--with-async-create-files
+    (dired-do-copy arg)))
+
+;;;###autoload
+(defun dired-async-do-symlink (&optional arg)
+  "Run ‘dired-do-symlink’ asynchronously."
+  (interactive "P")
+  (dired-async--with-async-create-files
+    (dired-do-symlink arg)))
+
+;;;###autoload
+(defun dired-async-do-hardlink (&optional arg)
+  "Run ‘dired-do-hardlink’ asynchronously."
+  (interactive "P")
+  (dired-async--with-async-create-files
+    (dired-do-hardlink arg)))
+
+;;;###autoload
+(defun dired-async-do-rename (&optional arg)
+  "Run ‘dired-do-rename’ asynchronously."
+  (interactive "P")
+  (dired-async--with-async-create-files
+    (dired-do-rename arg)))
+
+(provide 'dired-async)
+
+;;; dired-async.el ends here