[elpa] externals/async 53799e7368 1/2: Skip async for fast operations

[ELPA Syncer]

branch: externals/async
commit 53799e7368876074054714d10c64a7388239f916
Author: Allen Li <darkfeline@felesatra.moe>
Commit: Allen Li <darkfeline@felesatra.moe>

    Skip async for fast operations
    
    Starting an async process for fast operations is clunky, so add a new
    option/feature for skipping async if the operation is fast.  Same
    device renames are fast (since it's just a directory entry change) and
    renames and copys of small files are fast (arbitrarily picking 5 MB as
    the cutoff for modern computers/disks, can be configured).
---
 dired-async.el | 62 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 60 insertions(+), 2 deletions(-)

diff --git a/dired-async.el b/dired-async.el
index 91b705d488..3b535209b5 100644
--- a/dired-async.el
+++ b/dired-async.el
@@ -70,6 +70,19 @@ Should take same args as `message'."
   :risky t
   :type 'sexp)
 
+(defcustom dired-async-skip-fast t
+  "If non-nil, skip async for fast operations.
+Same device renames and copying and renaming files smaller than
+`dired-async-large-file' are considered fast."
+  :risky t
+  :type 'bool)
+
+(defcustom dired-async-small-file-max 5000000
+  "Files smaller than this in bytes are considered fast to copy
+or rename for `dired-async-skip-fast'."
+  :risky t
+  :type 'int)
+
 (defface dired-async-message
     '((t (:foreground "yellow")))
   "Face used for mode-line message.")
@@ -176,6 +189,51 @@ Should take same args as `message'."
                                        (buffer-name b)) b))))
        (when buf (kill-buffer buf))))))
 
+(defsubst dired-async--directory-p (attributes)
+  "Return non-nil if ATTRIBUTES is for a directory.
+See `file-attributes'."
+  ;; Can also be a string for symlinks, so check for t explicitly.
+  (eq (file-attribute-type attributes) t))
+
+(defsubst dired-async--same-device-p (f1 f2)
+  "Return non-nil if F1 and F2 have the same device number."
+  (= (file-attribute-device-number (file-attributes f1))
+     (file-attribute-device-number (file-attributes f2))))
+
+(defun dired-async--small-file-p (file)
+  "Return non-nil if FILE is small (can create quickly)."
+  (let ((a (file-attributes file)))
+    ;; Directories are always large since we can't easily figure out
+    ;; their total size.
+    (and (not (dired-async--directory-p a))
+         ;; 5 MB
+         (< (file-attribute-size a) dired-async-small-file-max))))
+
+(defun dired-async--skip-async-p (file-creator file name-constructor)
+  "Return non-nil if we should skip async for FILE.
+See `dired-create-files' for FILE-CREATOR and NAME-CONSTRUCTOR."
+  ;; Skip async for small files.
+  (or (dired-async--small-file-p file)
+      ;; Also skip async for same device renames.
+      (and (eq file-creator 'dired-rename-file)
+           (let ((new (funcall name-constructor file)))
+             (dired-async--same-device-p file (file-name-directory new))))))
+
+(defun dired-async--smart-create-files (old-func file-creator operation 
fn-list name-constructor
+                                                 &optional marker-char)
+  "Around advice for `dired-create-files'.
+Uses async like `dired-async-create-files' but skips certain fast
+cases if `dired-async-skip-fast' is non-nil."
+  (let (async-list quick-list)
+    (dolist (old fn-list)
+      (if (dired-async--skip-async-p file-creator old name-constructor)
+          (push old quick-list)
+        (push old async-list)))
+    (when async-list
+      (dired-async-create-files file-creator operation (nreverse async-list) 
name-constructor marker-char))
+    (when quick-list
+      (funcall old-func file-creator operation (nreverse quick-list) 
name-constructor marker-char))))
+
 (defvar overwrite-query)
 (defun dired-async-create-files (file-creator operation fn-list 
name-constructor
                                               &optional _marker-char)
@@ -342,10 +400,10 @@ ESC or `q' to not overwrite any of the remaining files,
   :global t
   (if dired-async-mode
       (progn
-        (advice-add 'dired-create-files :override #'dired-async-create-files)
+        (advice-add 'dired-create-files :around 
#'dired-async--smart-create-files)
         (advice-add 'wdired-do-renames :around 
#'dired-async-wdired-do-renames))
     (progn
-      (advice-remove 'dired-create-files #'dired-async-create-files)
+      (advice-remove 'dired-create-files #'dired-async--smart-create-files)
       (advice-remove 'wdired-do-renames #'dired-async-wdired-do-renames))))
 
 (defmacro dired-async--with-async-create-files (&rest body)