branch: elpa/dirvish
commit e59c4f501ff595e7ae1df1543176d0ea25e050db
Author: Alex Lu <[email protected]>
Commit: Alex Lu <[email protected]>
feat(narrow): asynchronous filtering
everything.exe
---
dirvish-extras.el | 2 +-
dirvish-widgets.el | 17 ++-
dirvish.el | 18 ++-
extensions/dirvish-collapse.el | 2 +-
extensions/dirvish-emerge.el | 2 +-
extensions/dirvish-fd.el | 327 ++++++++++++++++++-----------------------
extensions/dirvish-narrow.el | 147 +++++++++---------
7 files changed, 254 insertions(+), 261 deletions(-)
diff --git a/dirvish-extras.el b/dirvish-extras.el
index 4a8bcad303..ec1f8dc576 100644
--- a/dirvish-extras.el
+++ b/dirvish-extras.el
@@ -426,7 +426,7 @@ current layout defined in `dirvish-layout-recipes'."
("s" "Sort current buffer" dirvish-quicksort)
("l" "Setup listing switches" dirvish-ls-switches-menu)
("f" "Setup fd-find switches" dirvish-fd-switches-menu
- :if (lambda () (dirvish-prop :fd-arglist)))
+ :if (lambda () (dirvish-prop :fd-info)))
("S" "Setup rsync switches" dirvish-rsync-switches-menu)
("m" "Manage marks" dirvish-mark-menu)
("e" "Manage emerged groups" dirvish-emerge-menu)
diff --git a/dirvish-widgets.el b/dirvish-widgets.el
index 8f34562ecb..95cb3b14d8 100644
--- a/dirvish-widgets.el
+++ b/dirvish-widgets.el
@@ -426,16 +426,19 @@ GROUP-TITLES is a list of group titles."
(propertize truename 'face 'dired-symlink))))
(dirvish-define-mode-line index
- "Current file's index and total files count."
- (let* ((ct (dirvish-prop :count)) (cpos (- (line-number-at-pos (point)) 1))
- (fpos (- (line-number-at-pos (point-max)) 2))
- (cur (if ct "" (format "%3d " cpos)))
- (end (if ct (format " found %s matches " ct) (format "/%3d " fpos))))
- (if (or (dirvish--selected-p) ct)
+ "Cursor file's index and total files count within current subdir."
+ (let* ((count (if (cdr dired-subdir-alist)
+ (format "[ %s subdirs ] " (length dired-subdir-alist)) ""))
+ (smin (line-number-at-pos (dired-subdir-min)))
+ (cpos (- (line-number-at-pos (point)) smin))
+ (fpos (- (line-number-at-pos (dired-subdir-max)) smin 1))
+ (cur (format "%3d " cpos)) (end (format "/%3d " fpos)))
+ (if (dirvish--selected-p)
(put-text-property 0 (length end) 'face 'bold end)
+ (put-text-property 0 (length count) 'face 'dirvish-inactive count)
(put-text-property 0 (length cur) 'face 'dirvish-inactive cur)
(put-text-property 0 (length end) 'face 'dirvish-inactive end))
- (format "%s%s" cur end)))
+ (format "%s%s%s" cur end count)))
(dirvish-define-mode-line free-space
"Amount of free space on `default-directory''s file system."
diff --git a/dirvish.el b/dirvish.el
index 02381104b7..59cbe2a382 100644
--- a/dirvish.el
+++ b/dirvish.el
@@ -117,6 +117,21 @@ the full-frame layout when file previews are needed."
"Face used for mode-line segments in unfocused Dirvish windows."
:group 'dirvish)
+(defface dirvish-proc-running
+ '((t :inherit warning))
+ "Face used if asynchronous process is running."
+ :group 'dirvish)
+
+(defface dirvish-proc-finished
+ '((t :inherit success))
+ "Face used if asynchronous process has finished."
+ :group 'dirvish)
+
+(defface dirvish-proc-failed
+ '((t :inherit error))
+ "Face used if asynchronous process has failed."
+ :group 'dirvish)
+
(defcustom dirvish-use-mode-line t
"Whether to display mode line in dirvish buffers.
The valid value are:
@@ -903,6 +918,7 @@ When the attribute does not exist, set it with BODY."
for (k . v) = (funcall fn f-beg f-end f-str f-name
f-attrs f-type l-beg l-end hl-face w-width)
do (pcase k ('ov (overlay-put v 'dirvish-a-ov t))
+ ('ovs (dolist (ov v) (overlay-put ov 'dirvish-a-ov t)))
('left (setq left (concat v left)))
('right (setq right (concat v right))))
finally
@@ -1061,7 +1077,7 @@ use `car'. If HEADER, use `dirvish-header-line-height'
instead."
(defun dirvish--apply-hiding-p (ctx)
"Return t when it should hide cursor/details within context CTX."
(cond ((booleanp ctx) ctx)
- ((dirvish-prop :fd-arglist)
+ ((dirvish-prop :fd-info)
(memq 'dirvish-fd ctx))
((and (dirvish-curr) (dv-curr-layout (dirvish-curr)))
(memq 'dirvish ctx))
diff --git a/extensions/dirvish-collapse.el b/extensions/dirvish-collapse.el
index 528b62bed7..bf3a914812 100644
--- a/extensions/dirvish-collapse.el
+++ b/extensions/dirvish-collapse.el
@@ -71,7 +71,7 @@
(dirvish-define-attribute collapse
"Collapse unique nested paths."
- :when (and (not (dirvish-prop :fd-arglist))
+ :when (and (not (dirvish-prop :fd-info))
(not (dirvish-prop :remote)))
(when-let* ((cache (dirvish-collapse--cache f-name))
(head (car cache))
diff --git a/extensions/dirvish-emerge.el b/extensions/dirvish-emerge.el
index 4e2633527c..fb87f34890 100644
--- a/extensions/dirvish-emerge.el
+++ b/extensions/dirvish-emerge.el
@@ -454,7 +454,7 @@ PREDS are locally composed predicates."
(defun dirvish-emerge--apply ()
"Readin `dirvish-emerge-groups' and apply them."
- (when (and (not (dirvish-prop :fd-arglist))
+ (when (and (not (dirvish-prop :fd-info))
(or (dirvish-prop :force-emerge)
(< (hash-table-count dirvish--dir-data)
dirvish-emerge-max-file-count)))
diff --git a/extensions/dirvish-fd.el b/extensions/dirvish-fd.el
index e250dd0177..6bbfe92fa8 100644
--- a/extensions/dirvish-fd.el
+++ b/extensions/dirvish-fd.el
@@ -61,14 +61,10 @@
"Listing program for `fd'."
:type '(string :tag "Listing program, such as `ls'") :group 'dirvish)
-(defcustom dirvish-fd-default-dir "/"
- "Default directory for `dirvish-fd-jump'."
- :group 'dirvish :type 'directory)
-(defconst dirvish-fd-bufname "π%sπ%sπ")
-(defconst dirvish-fd-header
- (dirvish--mode-line-composer '(fd-switches) '(fd-took) t))
-(defvar-local dirvish-fd--input "" "Last used fd user input.")
+(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))
(defun dirvish-fd--ensure-fd (remote)
"Return fd executable on REMOTE or localhost.
@@ -79,46 +75,36 @@ Raise an error if fd executable is not available."
(defun dirvish-fd--apply-switches ()
"Apply fd SWITCHES to current buffer."
(interactive)
- (let* ((args (transient-args transient-current-command))
- (switches (string-join args " ")))
- (dirvish-prop :fd-switches switches)
- (revert-buffer)))
+ (cl-loop with (re . args) = nil
+ for arg in (transient-args transient-current-command)
+ if (string-prefix-p "--and=" arg) do (push arg re)
+ else do (push arg args)
+ finally do (dirvish-fd--argparser re args))
+ (revert-buffer))
(transient-define-infix dirvish-fd--extensions-switch ()
:description "Filter results by file extensions"
:class 'transient-option
:argument "--extension="
- :multi-value 'repeat
- :prompt
- (lambda (o)
- (let* ((val (oref o value))
- (str (if val (format "(current: %s) " (mapconcat #'concat val ","))
"")))
- (format "%sFile exts separated with comma: " str))))
+ :multi-value 'repeat)
(transient-define-infix dirvish-fd--exclude-switch ()
:description "Exclude files/dirs that match the glob pattern"
:class 'transient-option
:argument "--exclude="
- :multi-value 'repeat
- :prompt
- (lambda (o)
- (let* ((val (oref o value))
- (str (if val (format "(current: %s) " (mapconcat #'concat val ","))
"")))
- (format "%sGlob patterns (such as *.pyc) separated with comma: " str))))
+ :multi-value 'repeat)
(transient-define-infix dirvish-fd--search-pattern-infix ()
- "Change search pattern."
- :description "Change search pattern"
- :class 'transient-lisp-variable
- :variable 'dirvish-fd--input
- :reader (lambda (_prompt init hist)
- (completing-read "Regex for fd: " nil nil nil init hist)))
+ :description "Change search patterns"
+ :class 'transient-option
+ :argument "--and="
+ :multi-value 'repeat)
;;;###autoload (autoload 'dirvish-fd-switches-menu "dirvish-fd" nil t)
(transient-define-prefix dirvish-fd-switches-menu ()
"Setup fd switches."
- :init-value
- (lambda (o) (oset o value (split-string (or (dirvish-prop :fd-switches)
""))))
+ :init-value (lambda (o) (let ((args (dirvish-prop :fd-info)))
+ (oset o value (append (cadr args) (cddr args)))))
[:description
(lambda () (dirvish--format-menu-heading
"Setup FD Switches"
@@ -171,35 +157,40 @@ Raise an error if fd executable is not available."
""
"Actions"
("r" dirvish-fd--search-pattern-infix)
- ("RET" "Apply switches" dirvish-fd--apply-switches)]])
+ ("RET" "Rerun" dirvish-fd--apply-switches)]])
-(defun dirvish-fd--argparser (args)
- "Parse fd args to a list of flags from ARGS."
+(defun dirvish-fd--argparser (re args)
+ "Parse fd args to a list of flags from ARGS and search regexp RE."
(let* ((globp (member "--glob" args))
(casep (member "--case-sensitive" args))
- (ign-range (cond ((member "--no-ignore" args) "no")
- ((member "--no-ignore-vcs" args) "no_vcs")
- (t "all")))
- types exts excludes)
+ (ign (cond ((member "--no-ignore" args) "no")
+ ((member "--no-ignore-vcs" args) "no_vcs")
+ (t "all")))
+ (status (propertize " β " 'face 'dirvish-proc-running))
+ comp types exts exc)
(dolist (arg args)
- (cond ((string-prefix-p "--type=" arg) (push (substring arg 8) types))
+ (cond ((string-prefix-p "--type=" arg) (push (substring arg 7) types))
((string-prefix-p "--extension=" arg) (push (substring arg 12)
exts))
- ((string-prefix-p "--exclude=" arg) (push (substring arg 10)
excludes))))
+ ((string-prefix-p "--exclude=" arg) (push (substring arg 10)
exc))))
+ (dolist (r re) (push (substring r 6) comp))
(setq types (mapconcat #'concat types ","))
(setq exts (mapconcat #'concat exts ","))
- (setq excludes (mapconcat #'concat excludes ","))
- (dirvish-prop :fd-arglist (list globp casep ign-range types exts
excludes))))
-
-(dirvish-define-mode-line fd-switches
- "Return a formatted string showing the DIRVISH-FD-ACTUAL-SWITCHES."
- (pcase-let ((`(,globp ,casep ,ign-range ,types ,exts ,excludes)
- (dirvish-prop :fd-arglist))
+ (setq exc (mapconcat #'concat exc ","))
+ (setq comp (mapconcat #'concat comp ","))
+ (dirvish-prop :fd-info
+ (cons (list comp globp casep ign types exts exc status) (cons re
args)))))
+
+(dirvish-define-mode-line fd-info
+ "Return a formatted string showing the actual fd command line arguments."
+ (pcase-let ((`(,re ,globp ,casep ,ign-range ,types ,exts ,excludes ,_)
+ (car (dirvish-prop :fd-info)))
(face (if (dirvish--selected-p) 'dired-header
'dirvish-inactive)))
- (format " π β π: %s [ %s \"%s\" | %s %s | %s %s | %s %s | %s %s | %s %s ]"
+ (format " π β %s [ %s \"%s\" | %s %s | %s %s | %s %s | %s %s | %s %s ]"
(propertize
- (abbreviate-file-name default-directory) 'face 'dired-directory)
+ (abbreviate-file-name (directory-file-name default-directory))
+ 'face 'dired-directory)
(propertize (if globp "glob:" "regex:") 'face face)
- (propertize (or dirvish-fd--input "")
+ (propertize (or re "")
'face 'font-lock-regexp-grouping-construct)
(propertize "type:" 'face face)
(propertize (if (equal types "") "all" types)
@@ -216,167 +207,135 @@ Raise an error if fd executable is not available."
(propertize (if (equal excludes "") "none" excludes)
'face 'font-lock-string-face))))
-(dirvish-define-mode-line fd-took
- "Time took by last fd search."
- (or (dirvish-prop :fd-time)
- (format "%s %s %s"
- (propertize "Fd indexing⦠" 'face 'warning)
- (substitute-command-keys "\\[kill-current-buffer]")
- (propertize "to abort" 'face 'warning))))
-
-;;;###autoload
-(defun dirvish-fd-jump (&optional current-dir-p)
- "Browse directories using `fd' command.
-This command takes a while to index all the directories the first time
-you run it. After the indexing, it fires up instantly except for those
-huge directories such as root. It is recommended to setup your
-.fdignore properly before using this command.
-
-If called with \\`C-u' or if CURRENT-DIR-P holds the value 4,
-search for directories in the current directory. Otherwise,
-search for directories in `dirvish-fd-default-dir'.
-
-If prefixed twice with \\`C-u' or if CURRENT-DIR-P holds the
-value 16, let the user choose the root directory of their search."
- (interactive "p")
- (let* ((base-dir (cond
- ((eq current-dir-p 4) default-directory)
- ((eq current-dir-p 16)
- (let ((dir (car (find-file-read-args
- "Select root directory: " nil))))
- (if (file-directory-p dir)
- (file-name-as-directory dir)
- (dirvish--get-parent-path dir))))
- (t dirvish-fd-default-dir)))
- (remote (file-remote-p base-dir))
- (fd-program (dirvish-fd--ensure-fd remote)))
- (let* ((command (concat fd-program " -H -td --color=never -0 . "
- (file-local-name base-dir)))
- (default-directory base-dir)
- (output (shell-command-to-string command))
- (files-raw (split-string output "\0" t))
- (files (dirvish--completion-table-with-metadata
- files-raw '((category . file))))
- (file (completing-read "Go to: " files))
- (full-file (concat remote file)))
- (dired-jump nil full-file))))
-
-(defun dirvish-fd-proc-filter (proc string)
- "Filter for output STRING of `dirvish-fd''s processes PROC."
- (let ((buf (process-buffer proc)))
- (if (not (buffer-name buf)) (delete-process proc)
- (with-current-buffer buf
- (save-excursion
- (save-restriction
- (widen)
- (let ((data (dirvish-prop :fd-cache)) buffer-read-only last file)
- (goto-char (point-max)) (insert string)
- (goto-char (process-mark proc))
- (or (looking-at "^") (forward-line 1))
- ;; strip " ./" prefix and collect data on complete lines
- (while-let ((fb (search-forward " ./" nil t))
- (le (line-end-position)) ((eq (char-after le) 10)))
- (delete-region fb (- fb 2))
- (setq file (buffer-substring (- fb 2) (- le 2)) last le)
- (beginning-of-line) (insert " ")
- (puthash file (buffer-substring (- (point) 2) (1+ le)) data)
- (forward-line 1))
- (when last (move-marker (process-mark proc) (1+ last))))))))))
-
-(defsubst dirvish-fd-revert (&rest _)
- "Revert buffer function for fd buffer."
- (dirvish-fd default-directory (or dirvish-fd--input "")))
-
-(defun dirvish-fd-proc-sentinel (proc _)
- "Sentinel for `dirvish-fd' process PROC."
- (when-let* ((buf (process-buffer proc))
- ((buffer-live-p buf))
- (status (process-exit-status proc))
- (took (float-time (time-since (process-get proc 'start)))))
- (unless (eq status 0) (user-error "`fd' exited with status: %s" status))
- (if (< took 1.0)
- (setq took (format "%s ms" (round took 0.001)))
- (setq took (format "%s secs" (/ (round took 0.001) 1000.0))))
- (with-current-buffer buf
- (dirvish-prop :fd-time
- (format " %s %s "
- (propertize "Took:" 'face 'font-lock-doc-face)
- (propertize took 'face 'success)))
+(dirvish-define-mode-line fd-status
+ "Status and time took by last fd search."
+ (car (last (car (dirvish-prop :fd-info)))))
+
+(defun dirvish-fd--proc-filter (proc string)
+ "Filter for output STRING of `dirvish-fd''s process PROC."
+ (when-let* (((buffer-name (process-buffer proc)))
+ (target (process-get proc 'target)) ((buffer-live-p target)))
+ (with-current-buffer target
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (cdar dired-subdir-alist)) (goto-char (dired-subdir-max))
+ (cl-loop
+ with buffer-read-only = nil
+ with (_ regexps case-fold-search) = (dirvish-prop :narrow-info)
+ with string = (concat (process-get proc 'tail) string)
+ with splits = (split-string string "\n" t)
+ with tail = (car (last splits))
+ with comp? = (string-suffix-p "\n" string)
+ for file in (if comp? splits (butlast splits))
+ for f-beg = (string-match " ./" file)
+ for f-name = (substring file (+ f-beg 3))
+ for f-line = (concat " " (substring file 0 f-beg) " " f-name "\n")
+ do (if (not regexps) (insert f-line)
+ (cl-loop for re in regexps
+ unless (string-match re f-name) return nil
+ finally do (insert f-line)))
+ finally do (process-put proc 'tail (unless comp? tail))))))))
+
+(defun dirvish-fd--proc-sentinel (proc status)
+ "Sentinel for `dirvish-fd' process PROC and its STATUS."
+ (when-let* (((buffer-live-p (process-buffer proc)))
+ (took (float-time (time-since (process-get proc 'start))))
+ (target (process-get proc 'target)) ((buffer-live-p target)))
+ (setq took (if (< took 1.0) (format "%s ms" (round took 0.001))
+ (format "%s secs" (/ (round took 0.001) 1000.0))))
+ (with-current-buffer target
+ (setf (car (last (car (dirvish-prop :fd-info))))
+ (cond ((string-prefix-p "killed" status)
+ (propertize " β " 'face 'dirvish-proc-failed))
+ ((string-prefix-p "finished" status)
+ (propertize (format "%s β " took)
+ 'face 'dirvish-proc-finished))
+ (t (propertize " β " 'face 'dirvish-proc-failed))))
(run-hooks 'dirvish-fd-setup-hook))
(force-mode-line-update t)))
+(defun dirvish-fd--start-proc ()
+ "Start fd process."
+ (let* ((remote (file-remote-p default-directory))
+ (fd (dirvish-fd--ensure-fd remote))
+ (ls (dirvish-fd--find-gnu-ls remote))
+ (fd-args (dirvish-prop :fd-info))
+ (buf (get-buffer-create "*dirvish-fd*"))
+ process-connection-type proc)
+ (when-let* ((op (get-buffer-process buf))) (delete-process op))
+ (setq proc (apply #'start-file-process "fd" buf
+ `(,fd "--color=never" ,@(cddr fd-args) ,@(cadr fd-args)
+ "--exec-batch" ,ls
+ ,@(or (split-string dired-actual-switches) "")
+ "--quoting-style=literal" "--directory")))
+ (set-process-filter proc #'dirvish-fd--proc-filter)
+ (set-process-sentinel proc #'dirvish-fd--proc-sentinel)
+ (set-process-query-on-exit-flag proc nil)
+ (process-put proc 'start (float-time))
+ (process-put proc 'target (current-buffer))))
+
;;;###autoload
-(defun dirvish-fd (dir pattern)
+(defun dirvish-fd (dir re)
"Run `fd' on DIR and go into Dired mode on a buffer of the output.
The command run is essentially:
- fd --color=never -0 `dirvish-fd-switches' PATTERN
- --exec-batch `dirvish-fd-ls-program' `dired-listing-switches'
--directory."
+ fd --color=never `dirvish-fd-switches'
+ --and RE [--and RE1 --and RE2 β¦ ]
+ --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."
(interactive (list (and current-prefix-arg
(read-directory-name "Fd target directory: " nil ""
t))
- nil))
+ (and (equal current-prefix-arg '(16))
+ (completing-read-multiple "Pattern: " nil))))
(setq dir (file-name-as-directory
- (expand-file-name (or dir default-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* ((remote (file-remote-p dir))
- (fd-program (dirvish-fd--ensure-fd remote))
- (ls-program (dirvish-fd--find-gnu-ls remote))
- (dv (or (dirvish-curr) (dirvish--get-session) (dirvish--new)))
- (fd-switches (or (dirvish-prop :fd-switches) dirvish-fd-switches ""))
+ (let* ((dv (or (dirvish-curr) (dirvish--get-session) (dirvish--new)))
(ls-switches (or dired-actual-switches (dv-ls-switches dv)))
- (buffer (get-buffer-create "*dirvish-fd*"))
- (root (format dirvish-fd-bufname (or pattern "")
+ (root (format dirvish-fd-bufname (or re "")
(file-name-nondirectory (directory-file-name dir))))
- (bname (concat root (dirvish--timestamp))) process-connection-type
proc)
- (with-current-buffer buffer
+ (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-fd--input (or pattern ""))
- (dirvish--setup-dired #'dirvish-fd-revert)
- (dirvish-prop :fd-cache (dirvish--ht))
+ 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))
- (dirvish-prop :fd-switches fd-switches)
+ (dirvish-prop :gui (display-graphic-p)) ; TODO: remove this
(dirvish-prop :cus-header 'dirvish-fd-header)
- (dirvish-prop :remote remote)
+ (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-fd--argparser (split-string (or fd-switches "")))
(dirvish-save-dedication
(switch-to-buffer buffer) (dirvish--build-layout dv))
- (setq proc (apply #'start-file-process "fd" buffer
- `(,fd-program "--color=never"
- ,@(or (split-string fd-switches) "")
- ,(or pattern "")
- "--exec-batch" ,ls-program
- ,@(or (split-string ls-switches) "")
- "--quoting-style=literal"
"--directory")))
- (move-marker (process-mark proc) (point) buffer)
- (set-process-filter proc #'dirvish-fd-proc-filter)
- (set-process-sentinel proc #'dirvish-fd-proc-sentinel)
- (set-process-query-on-exit-flag proc nil)
- (process-put proc 'start (float-time))
- (setf (dv-index dv) (cons root buffer))
- (cl-pushnew (cons root buffer) (dv-roots dv) :test #'equal)
- (cl-loop for (_ . b) in (dv-roots dv)
- when (equal (with-current-buffer b (dirvish-prop :root)) root)
- do (dirvish--kill-buffer b))
- (dirvish-prop :root root)
- (rename-buffer bname))))
+ (dirvish-fd--start-proc))))
-;;;###autoload
-(defun dirvish-fd-ask (dir pattern)
- "The same as `dirvish-fd' but ask initial DIR and PATTERN via prompt."
- (interactive (list (and current-prefix-arg
- (read-directory-name "Fd target directory: " nil ""
t))
- (read-from-minibuffer "Pattern: ")))
- (dirvish-fd dir pattern))
+(define-obsolete-function-alias 'dirvish-fd-ask #'dirvish-fd "Apr 4, 2025")
(provide 'dirvish-fd)
;;; dirvish-fd.el ends here
diff --git a/extensions/dirvish-narrow.el b/extensions/dirvish-narrow.el
index 1bd50af655..b45ae1ee60 100644
--- a/extensions/dirvish-narrow.el
+++ b/extensions/dirvish-narrow.el
@@ -57,37 +57,18 @@
"Face for matches of components numbered 3 mod 4."
:group 'dirvish)
-(defun dirvish-narrow--compile-regex (string)
- "Compile `completion-regexp-list' from STRING."
- (if (fboundp 'orderless-compile) (cdr (orderless-compile string))
- (split-string string)))
-
-(defun dirvish-narrow--highlight (regexps ignore-case string)
- "Destructively propertize STRING to highlight a match of each of the REGEXPS.
-The search is case insensitive if IGNORE-CASE is non-nil."
- (cl-loop with case-fold-search = ignore-case
- with n = (length dirvish-narrow-match-faces)
- for regexp in regexps and i from 0
- when (string-match regexp string) do
- (cl-loop
- for (x y) on (let ((m (match-data))) (or (cddr m) m)) by #'cddr
- when x do (add-face-text-property
- x y (aref dirvish-narrow-match-faces (mod i n))
- nil string)))
- string)
+(defface dirvish-narrow-split
+ '((t :inherit font-lock-negation-char-face))
+ "Face used to highlight punctuation character."
+ :group 'dirvish)
(defun dirvish-narrow--build-indices ()
"Update the Dirvish buffer based on the input of the minibuffer."
- (declare-function dirvish-subtree--revert "dirvish-subtree")
- (when (bound-and-true-p dirvish-subtree--overlays)
- (dirvish-subtree--revert t))
(save-excursion
(cl-loop
- for (dir . beg) in dired-subdir-alist
- if (and (equal dir (expand-file-name default-directory))
- (dirvish-prop :fd-arglist))
- do (puthash (md5 dir) (dirvish-prop :fd-cache) dirvish--dir-data)
- else do (goto-char beg)
+ for (dir . beg) in dired-subdir-alist and idx from 0
+ unless (and (eq idx 0) (dirvish-prop :fd-info))
+ do (goto-char beg)
(let ((end (dired-subdir-max)) (files (dirvish--ht)))
(while (< (point) end)
(when-let* ((f-beg (dired-move-to-filename))
@@ -100,64 +81,98 @@ The search is case insensitive if IGNORE-CASE is non-nil."
(forward-line 1))
(puthash (md5 dir) files dirvish--dir-data)))))
+(defun dirvish-narrow--compiler (s)
+ "Compile `completion-regexp-list' from string S."
+ (if (fboundp 'orderless-compile) (cdr (orderless-compile s)) (split-string
s)))
+
;; use a separate timer here, otherwise it would be overrided by the default
one
(defvar dirvish-narrow--delay-timer `(,(timer-create) ,(float-time) nil))
(defun dirvish-narrow-update-h ()
"Update the Dirvish buffer based on the input of the minibuffer."
- (dirvish--run-with-delay
- (minibuffer-contents-no-properties) dirvish-narrow--delay-timer
- (lambda (action)
- (with-current-buffer (window-buffer (minibuffer-selected-window))
- (save-excursion
- (cl-loop with regs = (dirvish-narrow--compile-regex action)
- for (dir . pos) in dired-subdir-alist and idx from 0
- do (dirvish-narrow--subdir dir pos regs idx)))))))
-
-(defun dirvish-narrow--subdir (dir pos regexs idx &optional all)
- "Narrow subdir DIR at index IDX in POS with REGEXS."
- (delete-region
- (progn (goto-char pos) (forward-line (dirvish--subdir-offset)) (point))
- (- (dired-subdir-max) (if (eq idx 0) 0 1)))
- (cl-loop with completion-regexp-list = regexs
- with completion-ignore-case =
- (cl-loop for re in (ensure-list regexs)
- always (isearch-no-upper-case-p re t))
- with files = (gethash (md5 dir) dirvish--dir-data)
- and fr-h = (+ (frame-height) 5) and count = 0
- with pred = (if all #'always (lambda (&rest _) (<= (cl-incf count)
fr-h)))
- for f in (all-completions "" files pred)
- for l = (concat (gethash f files)) ; use copy, not reference
- do (insert (if all l (dirvish-narrow--highlight ; lazy highlighting
- regexs completion-ignore-case l)))
- finally do (dirvish-prop :count count)))
+ (let* ((mc (minibuffer-contents-no-properties))
+ (filter mc) async rel igc)
+ (save-match-data
+ (when-let* (((string-match "^#\\([^ #]*\\)\\(.*\\)" mc))
+ (beg (minibuffer-prompt-end)))
+ (add-text-properties beg (1+ beg) '(rear-nonsticky t))
+ (add-face-text-property beg (1+ beg) 'dirvish-narrow-split)
+ (setq async (match-string 1 mc) filter (match-string 2 mc))))
+ (with-current-buffer (cdr (dv-index (dirvish-curr)))
+ (when (and async (dirvish-prop :fd-info))
+ (dirvish-fd--argparser (mapcan (lambda (x) `(,(format "--and=%s" x)))
+ (split-string async "," t))
+ (cddr (dirvish-prop :fd-info))))
+ (setq rel (dirvish-narrow--compiler filter)
+ igc (cl-loop for re in (ensure-list rel)
+ always (isearch-no-upper-case-p re t)))
+ (dirvish-prop :narrow-info (list async rel igc)))
+ (dirvish--run-with-delay mc dirvish-narrow--delay-timer
+ (lambda (action)
+ (with-current-buffer (cdr (dv-index (dirvish-curr)))
+ (when (dirvish-prop :fd-info) (dirvish-fd--start-proc))
+ (save-excursion
+ (cl-loop for (dir . pos) in dired-subdir-alist and idx from 0
+ do (delete-region
+ (progn (goto-char pos)
+ (forward-line (dirvish--subdir-offset))
(point))
+ (- (dired-subdir-max) (if (eq idx 0) 0 1)))
+ unless (and (eq idx 0) (dirvish-prop :fd-info))
+ do (cl-loop with files = (gethash (md5 dir)
dirvish--dir-data)
+ with completion-regexp-list = rel
+ with completion-ignore-case = igc
+ for f in (all-completions "" files)
+ do (insert (concat (gethash f files)))))))
+ (when (dv-curr-layout (dirvish-curr)) (force-mode-line-update t))))))
+
+(dirvish-define-attribute narrow-match
+ "NARROW MATCH."
+ (cl-loop with (_ regexps case-fold-search) = (dirvish-prop :narrow-info)
+ with n = (length dirvish-narrow-match-faces) with ovs = nil
+ for regexp in regexps and i from 0
+ when (string-match regexp f-str) do
+ (cl-loop
+ for (x y) on (let ((m (match-data))) (or (cddr m) m)) by #'cddr
+ when x do (let ((ov (make-overlay (+ f-beg x) (+ f-beg y)))
+ (face (aref dirvish-narrow-match-faces (mod i n))))
+ (overlay-put ov 'face face)
+ (push ov ovs)))
+ finally return `(ovs . ,ovs)))
;;;###autoload
(defun dirvish-narrow ()
"Narrow a Dirvish buffer to the files matching a regex."
(interactive nil dired-mode)
- (when (get-buffer-process (current-buffer))
- (user-error "Current buffer has unfinished jobs"))
+ (when (bound-and-true-p dirvish-subtree--overlays)
+ (declare-function dirvish-subtree--revert "dirvish-subtree")
+ (dirvish-subtree--revert t))
(require 'orderless nil t)
(dirvish-narrow--build-indices)
- (let ((dv (dirvish-prop :dv)) (restore (dirvish-prop :index))
- input buffer-read-only)
- (font-lock-mode -1) (buffer-disable-undo)
+ (let ((dv (dirvish-prop :dv))
+ (idx (dirvish-prop :index))
+ (fd (dirvish-prop :fd-info))
+ (attrs (mapcar #'car (dirvish-prop :attrs)))
+ buffer-read-only)
+ (when fd
+ (setq dired-subdir-alist (list (car (reverse dired-subdir-alist))))
+ (delete-region (goto-char (dirvish-prop :content-begin)) (point-max)))
+ (dirvish-prop :attrs
+ (dirvish--attrs-expand (append '(narrow-match) attrs)))
(minibuffer-with-setup-hook
(lambda ()
(dirvish-prop :dv dv)
(add-hook 'post-command-hook #'dirvish-narrow-update-h nil t))
(unwind-protect
- (setq input (read-from-minibuffer "Focus on files: "))
- (save-excursion
- (cl-loop with re = (dirvish-narrow--compile-regex (or input ""))
- for (d . p) in dired-subdir-alist and i from 0
- do (dirvish-narrow--subdir d p re i (or input ""))))
- (dirvish-prop :count nil)
- (when restore (dired-goto-file restore))
+ (read-from-minibuffer "Focus on files: " (if fd "#" ""))
+ (when idx (dired-goto-file idx))
+ (dirvish-prop :attrs (dirvish--attrs-expand attrs))
+ (when-let* (((not (eq (dv-type (dirvish-curr)) 'side)))
+ (query (caar (dirvish-prop :fd-info)))
+ (key (file-name-nondirectory
+ (directory-file-name default-directory))))
+ (rename-buffer (concat key "π" query "π" (dv-id (dirvish-curr)))))
(dirvish--run-with-delay 'reset)
- (dirvish--run-with-delay 'reset dirvish-narrow--delay-timer)
- (font-lock-mode 1) (buffer-enable-undo)))))
+ (dirvish--run-with-delay 'reset dirvish-narrow--delay-timer)))))
(provide 'dirvish-narrow)
;;; dirvish-narrow.el ends here
