branch: elpa/dirvish
commit 081b8df9c723f84d25faa65ef5c3a80caeb8780f
Author: Alex Lu <hellosimon1...@hotmail.com>
Commit: Alex Lu <hellosimon1...@hotmail.com>
feat: allow opening large directory with `fd` automatically
---
dirvish-widgets.el | 48 ++++++++++++++-----------
dirvish.el | 51 ++++++++++++++-------------
extensions/dirvish-fd.el | 92 ++++++++++++++++++++++--------------------------
3 files changed, 96 insertions(+), 95 deletions(-)
diff --git a/dirvish-widgets.el b/dirvish-widgets.el
index 95cb3b14d8..3062213bdf 100644
--- a/dirvish-widgets.el
+++ b/dirvish-widgets.el
@@ -45,6 +45,10 @@
This value is passed to function `format-time-string'."
:group 'dirvish :type 'string)
+(defcustom dirvish-file-count-overflow 15000
+ "Up limit for counting directory files, to improve performance."
+ :group 'dirvish :type 'natnum)
+
(defcustom dirvish-path-separators '(" ⌂" " ∀" " ⋗ ")
"Separators in path mode line segment.
The value is a list with 3 elements:
@@ -190,18 +194,20 @@ Audio;(Audio-codec . \"\"%CodecID%\"\")(Audio-bitrate .
\"\"%BitRate/String%\"\"
(defun dirvish--attr-size-human-readable (file-size kilo)
"Produce a string showing FILE-SIZE in human-readable form.
KILO is 1024.0 / 1000 for file size / counts respectively."
- (let ((prefixes '("" "k" "M" "G" "T" "P" "E" "Z" "Y")))
- (while (and (>= file-size kilo) (cdr prefixes))
- (setq file-size (/ file-size kilo)
- prefixes (cdr prefixes)))
- (substring (format (if (and (< file-size 10)
- (>= (mod file-size 1.0) 0.05)
- (< (mod file-size 1.0) 0.95))
- " %.1f%s%s"
- " %.0f%s%s")
- file-size (car prefixes)
- (if (dirvish-prop :gui) " " ""))
- -6)))
+ (if (and (eq kilo 1000) (> file-size (- dirvish-file-count-overflow 3)))
+ " MANY "
+ (let ((prefixes '("" "k" "M" "G" "T" "P" "E" "Z" "Y")))
+ (while (and (>= file-size kilo) (cdr prefixes))
+ (setq file-size (/ file-size kilo)
+ prefixes (cdr prefixes)))
+ (substring (format (if (and (< file-size 10)
+ (>= (mod file-size 1.0) 0.05)
+ (< (mod file-size 1.0) 0.95))
+ " %.1f%s%s"
+ " %.0f%s%s")
+ file-size (car prefixes)
+ (if (dirvish-prop :gui) " " ""))
+ -6))))
(defun dirvish--file-attr-size (name attrs)
"Get file size of file NAME from ATTRS."
@@ -211,20 +217,22 @@ KILO is 1024.0 / 1000 for file size / counts
respectively."
(if (dirvish-prop :gui) " " ""))
-6))
((stringp (file-attribute-type attrs))
- (let ((ct (dirvish-attribute-cache name :f-count
- (condition-case nil
- (let ((files (directory-files name nil nil t)))
- (dirvish--attr-size-human-readable
- (- (length files) 2) 1000))
- (file-error 'file)))))
+ (let* ((ovfl dirvish-file-count-overflow)
+ (ct (dirvish-attribute-cache name :f-count
+ (condition-case nil
+ (let ((files (directory-files name nil nil t ovfl)))
+ (dirvish--attr-size-human-readable
+ (- (length files) 2) 1000))
+ (file-error 'file)))))
(if (not (eq ct 'file)) ct
(dirvish-attribute-cache name :f-size
(dirvish--attr-size-human-readable
(file-attribute-size (file-attributes name)) 1024.0)))))
((file-attribute-type attrs)
- (let ((ct (dirvish-attribute-cache name :f-count
+ (let* ((ovfl dirvish-file-count-overflow)
+ (ct (dirvish-attribute-cache name :f-count
(condition-case nil
- (let ((files (directory-files name nil nil t)))
+ (let ((files (directory-files name nil nil t ovfl)))
(dirvish--attr-size-human-readable
(- (length files) 2) 1000))
(file-error 'no-permission)))))
diff --git a/dirvish.el b/dirvish.el
index 59cbe2a382..aa8c413b0d 100644
--- a/dirvish.el
+++ b/dirvish.el
@@ -102,6 +102,11 @@ the full-frame layout when file previews are needed."
(float :tag "max width of parent windows")
(float :tag "width of preview windows"))))
+(defcustom dirvish-large-directory-threshold nil
+ "Directories with file count greater than this are opened using
`dirvish-fd'."
+ :group 'dirvish :type '(choice (const :tag "Never use `dirvish-fd'" nil)
+ (natnum :tag "File counts in integer")))
+
(defface dirvish-hl-line
'((t :inherit highlight :extend t))
"Face used for Dirvish line highlighting in focused Dirvish window."
@@ -602,18 +607,10 @@ FROM-QUIT is used to signify the calling command."
(cl-defun dirvish--find-entry (find-fn entry)
"Find ENTRY using FIND-FN in current dirvish session.
FIND-FN can be one of `find-file', `find-alternate-file',
-`find-file-other-window' or `find-file-other-frame'. ENTRY can be a
-filename or a string with format of `dirvish-fd-bufname'."
+`find-file-other-window' or `find-file-other-frame'."
(let ((switch-to-buffer-preserve-window-point (null
dired-auto-revert-buffer))
(find-file-run-dired t) (dv (dirvish-curr))
- (directory? (file-directory-p entry)) (cur (current-buffer)) cache)
- (when (setq cache (and dv (alist-get entry (dv-roots dv) nil nil #'equal)))
- (cl-return-from dirvish--find-entry
- (dirvish-save-dedication (switch-to-buffer cache))))
- (when (string-prefix-p "🔍" entry)
- (setq find-fn (prog1 'dirvish-fd (require 'dirvish-fd nil t)))
- (pcase-let ((`(,re ,dir ,_) (split-string (substring entry 1) "📁")))
- (cl-return-from dirvish--find-entry (funcall find-fn dir re))))
+ (dir? (file-directory-p entry)) (cur (current-buffer)))
(and (run-hook-with-args-until-success
'dirvish-find-entry-hook entry find-fn)
(cl-return-from dirvish--find-entry))
@@ -621,13 +618,13 @@ filename or a string with format of `dirvish-fd-bufname'."
(unless dv (cl-return-from dirvish--find-entry (funcall find-fn entry)))
(and (dv-curr-layout dv) (eq find-fn 'find-file-other-window)
(dirvish-layout-toggle))
- (when (and directory? (eq find-fn 'find-alternate-file))
+ (when (and dir? (eq find-fn 'find-alternate-file))
(dirvish-save-dedication (find-file entry))
(with-current-buffer cur ; check if the buffer should be killed
(and (bound-and-true-p server-buffer-clients)
(cl-return-from dirvish--find-entry)))
(cl-return-from dirvish--find-entry (dirvish--kill-buffer cur)))
- (if directory? (dirvish-save-dedication (funcall find-fn entry))
+ (if dir? (dirvish-save-dedication (funcall find-fn entry))
(mapc #'dirvish--kill-buffer (dv-preview-buffers dv))
(funcall (dv-open-file dv) dv find-fn entry))))
@@ -1171,13 +1168,13 @@ Optionally, use CURSOR as the enabled cursor type."
do (push b rs) ; in case there is any lingering sessions
finally do (unless rs (setq dirvish--sessions
(dirvish--ht)))))))
-(defun dirvish--setup-dired (&optional revert-fn)
- "Initialize Dired buffers, set `revert-buffer-function' to REVERT-FN."
+(defun dirvish--setup-dired ()
+ "Initialize Dired buffers."
(use-local-map dirvish-mode-map)
(dirvish--hide-dired-header)
(dirvish--maybe-toggle-cursor 'box) ; restore from `wdired'
(setq-local dirvish--dir-data (or dirvish--dir-data (dirvish--ht))
- revert-buffer-function (or revert-fn #'dirvish-revert)
+ revert-buffer-function (or (dirvish-prop :revert)
#'dirvish-revert)
truncate-lines t dired-hide-details-hide-symlink-targets nil)
(add-hook 'pre-redisplay-functions #'dirvish-pre-redisplay-h nil t)
(add-hook 'window-buffer-change-functions #'dirvish-winbuf-change-h nil t)
@@ -1469,25 +1466,29 @@ With optional NOSELECT just find files but do not
select them."
(mapc #'dirvish--kill-buffer (dv-preview-buffers dv))
(dired-simultaneous-find-file files noselect)))
-(defun dirvish-dired-noselect-a (fn dir-or-list &optional flags)
+(defun dirvish-dired-noselect-a (fn dir-or-list &optional flags re)
"Return buffer for DIR-OR-LIST with FLAGS, FN is `dired-noselect'."
(let* ((dir (if (consp dir-or-list) (car dir-or-list) dir-or-list))
(key (file-name-as-directory (expand-file-name dir)))
(dv (or (dirvish-curr) (dirvish--get-session) (dirvish--new)))
- (bname buffer-file-name)
- (remote (file-remote-p dir))
+ (bname buffer-file-name) (remote (file-remote-p dir))
(flags (or flags (dv-ls-switches dv)))
+ (mc dirvish-large-directory-threshold)
(buffer (alist-get key (dv-roots dv) nil nil #'equal))
(new? (null buffer)) (dps (dv-preview-dispatchers dv))
- tramp-fn dired-buffers) ; disable reuse from dired
+ tramp fd dired-buffers) ; disable reuse from dired
(setf (dv-timestamp dv) (dirvish--timestamp))
- (when new?
- (if (not remote) (setq buffer (apply fn (list dir-or-list flags)))
- (setq tramp-fn (prog1 'dirvish-tramp-noselect (require 'dirvish-tramp))
- buffer (apply tramp-fn (list fn dir-or-list flags remote dps))))
- (with-current-buffer buffer (dirvish--setup-dired))
- (push (cons key buffer) (dv-roots dv)))
+ (cond ((and new? remote)
+ (setq tramp (prog1 'dirvish-tramp-noselect (require 'dirvish-tramp))
+ buffer (apply tramp (list fn dir-or-list flags remote dps))))
+ ((or re (and mc (length> (directory-files key nil nil t mc) (1-
mc))))
+ (setq fd (prog1 'dirvish-fd-noselect (require 'dirvish-fd nil t))
+ buffer (apply fd (list dv key (or re "")))
+ key (concat key "🔍" (or re ""))))
+ (new? (setq buffer (apply fn (list dir-or-list flags)))))
+ (cl-pushnew (cons key buffer) (dv-roots dv) :test #'equal)
(with-current-buffer buffer
+ (dirvish--setup-dired)
(cond (new? nil)
((and (not remote) (not (equal flags dired-actual-switches)))
(dired-sort-other flags))
diff --git a/extensions/dirvish-fd.el b/extensions/dirvish-fd.el
index 6bbfe92fa8..cfeca5fea7 100644
--- a/extensions/dirvish-fd.el
+++ b/extensions/dirvish-fd.el
@@ -61,10 +61,9 @@
"Listing program for `fd'."
:type '(string :tag "Listing program, such as `ls'") :group 'dirvish)
-
-(defconst dirvish-fd-bufname "🔍%s📁%s📁") ; TODO: remove this
-(defconst dirvish-fd-header ; TODO: refactor this
- (dirvish--mode-line-composer '(fd-info) '(fd-status) t))
+(defcustom dirvish-fd-header-line-format '(:left (fd-info) :right (fd-status))
+ "Header line format for `dirvish-fd'."
+ :group 'dirvish :type 'plist)
(defun dirvish-fd--ensure-fd (remote)
"Return fd executable on REMOTE or localhost.
@@ -275,65 +274,58 @@ Raise an error if fd executable is not available."
(process-put proc 'start (float-time))
(process-put proc 'target (current-buffer))))
+(defun dirvish-fd-noselect (dv dir pattern)
+ "Return the fd buffer for DV at DIR with search PATTERN."
+ (let* ((re (mapcan (lambda (x) `(,(format "--and=%s" x)))
+ (if (stringp pattern) (split-string pattern ",")
pattern)))
+ (ls-switches (or dired-actual-switches (dv-ls-switches dv)))
+ (key (file-name-nondirectory (directory-file-name dir)))
+ (buf (get-buffer-create (concat key "🔍" pattern "🔍" (dv-id dv))))
+ (fd (dirvish-prop :fd-info)) (re (or re (cadr fd)))
+ (switches (or (cddr fd) (split-string dirvish-fd-switches))))
+ (with-current-buffer buf
+ (let (buffer-read-only)
+ (erase-buffer)
+ (insert " " dir ":" (make-string (dirvish--subdir-offset) ?\n)))
+ (unless (derived-mode-p 'dired-mode) (dired-mode dir ls-switches))
+ (setq-local default-directory dir
+ dired-subdir-alist (list (cons dir (point-min-marker))))
+ (dirvish-fd--argparser re switches)
+ (dirvish-prop :revert
+ (lambda (&rest _)
+ (setq dired-subdir-alist (list (car (reverse dired-subdir-alist))))
+ (let (buffer-read-only)
+ (buffer-disable-undo)
+ (delete-region (goto-char (dirvish-prop :content-begin))
(point-max)))
+ (buffer-enable-undo)
+ (dirvish-fd--start-proc)))
+ (let* ((fmt dirvish-fd-header-line-format)
+ (l (plist-get fmt :left)) (r (plist-get fmt :right)))
+ (dirvish-prop :cus-header (dirvish--mode-line-composer l r t)))
+ (dirvish-prop :global-header t)
+ (dirvish--setup-dired)
+ (dirvish-fd--start-proc) buf)))
+
;;;###autoload
-(defun dirvish-fd (dir re)
+(defun dirvish-fd (dir pattern)
"Run `fd' on DIR and go into Dired mode on a buffer of the output.
The command run is essentially:
fd --color=never `dirvish-fd-switches'
- --and RE [--and RE1 --and RE2 … ]
+ --and PATTERN [--and PATTERN1 --and PATTERN2 … ]
--exec-batch `dirvish-fd-ls-program' `dired-listing-switches' --directory
If called with \\`C-u', prompt for the target directory,
`default-directory' is used. If prefixed with \\`C-u' twice, also
-prompt for the search regex RE as a comma separated list."
+prompt for the search regex PATTERN as a comma separated list."
(interactive (list (and current-prefix-arg
(read-directory-name "Fd target directory: " nil ""
t))
(and (equal current-prefix-arg '(16))
(completing-read-multiple "Pattern: " nil))))
- (setq dir (file-name-as-directory
- (expand-file-name (or dir default-directory)))
- re (mapcan (lambda (x) `(,(format "--and=%s" x)))
- (if (stringp re) (split-string re ",") re)))
- (or (file-directory-p dir) (user-error "'fd' requires a directory: %s" dir))
- (let* ((dv (or (dirvish-curr) (dirvish--get-session) (dirvish--new)))
- (ls-switches (or dired-actual-switches (dv-ls-switches dv)))
- (root (format dirvish-fd-bufname (or re "")
- (file-name-nondirectory (directory-file-name dir))))
- (buffer (get-buffer-create (concat root (dirvish--timestamp))))
- (fd (dirvish-prop :fd-info)) (re (or re (cadr fd)))
- (switches (or (cddr fd) (split-string dirvish-fd-switches)))
- remote)
- (setf (dv-index dv) (cons root buffer))
- (cl-pushnew (cons root buffer) (dv-roots dv) :test #'equal)
- (with-current-buffer buffer ; TODO: session independent?
- (let (buffer-read-only) (erase-buffer))
- (insert " " dir ":" (make-string (dirvish--subdir-offset) ?\n))
- (dired-mode dir ls-switches)
- (setq-local default-directory dir
- dired-subdir-alist (list (cons dir (point-min-marker))))
- (dirvish--setup-dired
- (lambda (&rest _)
- (setq dired-subdir-alist (list (car (reverse dired-subdir-alist))))
- (let (buffer-read-only)
- (buffer-disable-undo)
- (delete-region (goto-char (dirvish-prop :content-begin))
(point-max)))
- (buffer-enable-undo)
- (dirvish-fd--start-proc)))
- (dirvish-fd--argparser re switches)
- (dirvish-prop :root root)
- (dirvish-prop :dv (dv-id dv))
- (dirvish-prop :gui (display-graphic-p)) ; TODO: remove this
- (dirvish-prop :cus-header 'dirvish-fd-header)
- (dirvish-prop :remote (setq remote (file-remote-p dir)))
- (dirvish-prop :global-header t)
- (dirvish-prop :preview-dps (unless remote (dv-preview-dispatchers dv)))
- (dirvish-prop :attrs (dv-attributes dv))
- (cl-loop for (k v) on dirvish--scopes by 'cddr
- do (dirvish-prop k (and (functionp v) (funcall v))))
- (dirvish-save-dedication
- (switch-to-buffer buffer) (dirvish--build-layout dv))
- (dirvish-fd--start-proc))))
+ (let* ((dir (or dir default-directory))
+ (buf (dirvish-dired-noselect-a nil dir nil (or pattern "")))
+ (dv (with-current-buffer buf (dirvish-curr))))
+ (dirvish-save-dedication (switch-to-buffer buf) (dirvish--build-layout
dv))))
(define-obsolete-function-alias 'dirvish-fd-ask #'dirvish-fd "Apr 4, 2025")
