branch: elpa/dirvish
commit b5e131dae0e36c85b684ffae3e82d1e00d7c97cb
Author: Alex Lu <hellosimon1...@hotmail.com>
Commit: Alex Lu <hellosimon1...@hotmail.com>
refactor(fd|narrow): clearer separation
Refactor `dirvish-fd` and `dirvish-narrow` for clearer separation.
Previously, `dirvish-fd` automatically prompted for a query to filter its
results, which overlapped with the functionality of
`dirvish-narrow`. Furthermore, using `revert-buffer` in a `dirvish-fd`
buffer
could be confusing, as the underlying `fd` shell command and Emacs Lisp
handle
regular expressions differently.
This commit removes the automatic prompt from `dirvish-fd`, clarifying its
purpose as displaying raw `fd` output, while `dirvish-narrow` remains
responsible for interactive filtering. Consequently, it is now possible to
add
the `dirvish-fd-listing-finish-hook` to run when the fd process exits.
These enhancements/fixes were also included:
* Parse `fd` output incrementally to avoid blocking user input.
* Fix the orderless pattern compiler.
* Highlight matches found by `dirvish-narrow`.
Ref: #207
---
dirvish.el | 40 ++++---
docs/CUSTOMIZING.org | 10 +-
docs/EXTENSIONS.org | 23 ++--
extensions/dirvish-fd.el | 280 +++++++++++++++++--------------------------
extensions/dirvish-narrow.el | 148 +++++++++++++++--------
5 files changed, 239 insertions(+), 262 deletions(-)
diff --git a/dirvish.el b/dirvish.el
index de9e96e841..a72f3a590c 100644
--- a/dirvish.el
+++ b/dirvish.el
@@ -356,7 +356,8 @@ RECORD defaults to `dirvish--delay-timer'."
(timer-relative-time
nil (max debounce (- (+ (nth 1 record) throttle) (float-time)))))
(setf (nth 2 record) action)
- (timer-activate (car record))))))
+ (timer-activate (car record))))
+ ('reset (setf (nth 2 record) nil))))
(defmacro dirvish-save-dedication (&rest body)
"Run BODY after undedicating window, restore dedication afterwards."
@@ -878,7 +879,7 @@ When the attribute does not exist, set it with BODY."
(l-beg (line-beginning-position)) (l-end (line-end-position))
(f-wid 0) f-str f-name f-attrs f-type hl-face left right)
(setq hl-face (and (eq (or f-beg l-beg) pos) hl))
- (when f-beg
+ (when (and f-beg f-end) ; `f-end' is nil in a incomplete line
(setq f-str (buffer-substring f-beg f-end)
f-wid (string-width f-str)
f-name (concat (if remote (dired-current-directory)
@@ -898,7 +899,7 @@ When the attribute does not exist, set it with BODY."
(unless (get-text-property f-beg 'mouse-face)
(dired-insert-set-properties l-beg l-end)))
(cl-loop
- for fn in (if f-beg fns '(dirvish-attribute-hl-line-rd))
+ for fn in (if (and f-beg f-end) fns '(dirvish-attribute-hl-line-rd))
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))
@@ -929,25 +930,22 @@ When the attribute does not exist, set it with BODY."
(setq selected (or selected (frame-selected-window)))
(with-selected-window window
(cl-loop with attrs = (dirvish-prop :attrs) unless attrs do (cl-return)
- with remote = (and (dirvish-prop :remote)
- (not (dirvish-prop :sudo)))
- with gui = (dirvish-prop :gui)
- with fns = () with height = (frame-height)
+ with ww = (window-width) and pm = (point-min) and pM = (point-max)
+ with rmt = (and (dirvish-prop :remote) (not (dirvish-prop :sudo)))
+ with fns = () with height = (frame-height) with gui = nil
with hl = (and (dirvish--apply-hiding-p dirvish-hide-cursor)
(if (eq selected window)
'dirvish-hl-line 'dirvish-hl-line-inactive))
- with ww = (window-width) with pm = (point-min) with pM =
(point-max)
- with remain = (- ww (if gui 1 2))
+ with remain = (- ww (if (setq gui (dirvish-prop :gui)) 1 2))
for (_ width _ pred setup render) in attrs
when (eval pred `((win-width . ,remain)))
do (eval setup) (setq remain (- remain width)) (push render fns)
initially (dolist (ov '(dirvish-a-ov dirvish-l-ov dirvish-r-ov))
(remove-overlays pm pM ov t))
- finally
- (with-silent-modifications
- (save-excursion
- (dirvish--render-attrs-1
- height remain (point) remote fns (if gui 0 2) hl ww))))))
+ finally (with-silent-modifications
+ (save-excursion
+ (dirvish--render-attrs-1
+ height remain (point) rmt fns (if gui 0 2) hl
ww))))))
(dirvish-define-attribute hl-line
"Highlight current line.
@@ -1063,7 +1061,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-switches)
+ ((dirvish-prop :fd-arglist)
(memq 'dirvish-fd ctx))
((and (dirvish-curr) (dv-curr-layout (dirvish-curr)))
(memq 'dirvish ctx))
@@ -1071,6 +1069,10 @@ use `car'. If HEADER, use `dirvish-header-line-height'
instead."
(memq 'dirvish-side ctx))
(t (memq 'dired ctx))))
+(defun dirvish--subdir-offset ()
+ "Return number of lines occupied by subdir header."
+ (if (eq (bound-and-true-p dired-free-space) 'separate) 2 1))
+
(defun dirvish--maybe-toggle-cursor (&optional cursor)
"Toggle cursor's invisibility according to context.
Optionally, use CURSOR as the enabled cursor type."
@@ -1153,14 +1155,14 @@ 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 ()
- "Initialize a Dired buffer for Dirvish."
+(defun dirvish--setup-dired (&optional revert-fn)
+ "Initialize Dired buffers, set `revert-buffer-function' to REVERT-FN."
(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 #'dirvish-revert truncate-lines t
- dired-hide-details-hide-symlink-targets nil)
+ revert-buffer-function (or revert-fn #'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)
(add-hook 'post-command-hook #'dirvish-post-command-h nil t)
diff --git a/docs/CUSTOMIZING.org b/docs/CUSTOMIZING.org
index 8635f059d2..3150d299f9 100644
--- a/docs/CUSTOMIZING.org
+++ b/docs/CUSTOMIZING.org
@@ -271,9 +271,9 @@ enables you to configure different pane ratios as needed.
For instance, you
might use a 1:3 ratio for image previews or a 1:3:5 ratio for more detailed
file
previews.
-When a layout is active, you can use ~M-x other-window~ to switch focus between
-the main file listing window and the preview window. Note that the contents of
-the preview buffers are generally read-only.
+When a layout is active, you can use ~C-x o~ (~other-window~) to switch focus
+between the main file listing window and the preview window. Note that the
+contents of the preview buffers are generally read-only.
** Install dependencies for an enhanced preview experience
@@ -497,12 +497,13 @@ you don't have to require them explicitly if you
installed dirvish from MELPA or
:map dirvish-mode-map ; Dirvish inherits `dired-mode-map'
(";" . dired-up-directory) ; So you can adjust `dired' bindings
here
("?" . dirvish-dispatch) ; [?] a helpful cheatsheet
- ("a" . dirvish-setup-menu) ; [a]ttributes settings: press `a' +
`t' toggles mtime, etc.
+ ("a" . dirvish-setup-menu) ; [a]ttributes settings:`t' toggles
mtime, `f' toggles fullframe, etc.
("f" . dirvish-file-info-menu) ; [f]ile info
("o" . dirvish-quick-access) ; [o]pen `dirvish-quick-access-entries'
("s" . dirvish-quicksort) ; [s]ort flie list
("r" . dirvish-history-jump) ; [r]ecent visited
("l" . dirvish-ls-switches-menu) ; [l]s command flags
+ ("v" . dirvish-vc-menu) ; [v]ersion control commands
("*" . dirvish-mark-menu)
("y" . dirvish-yank-menu)
("N" . dirvish-narrow)
@@ -510,7 +511,6 @@ you don't have to require them explicitly if you installed
dirvish from MELPA or
("TAB" . dirvish-subtree-toggle)
("M-f" . dirvish-history-go-forward)
("M-b" . dirvish-history-go-backward)
- ("M-t" . dirvish-layout-toggle)
("M-e" . dirvish-emerge-menu)))
#+end_src
diff --git a/docs/EXTENSIONS.org b/docs/EXTENSIONS.org
index b8557144bb..14b04614e8 100644
--- a/docs/EXTENSIONS.org
+++ b/docs/EXTENSIONS.org
@@ -258,16 +258,9 @@ Too fast? Let's break it down:
Feel free to experiment with other switches. A bonus tip: ~dirvish-quicksort~
and
~dirvish-ls-switches-menu~ also works in this buffer.
-TODO: add ~dirvish-fd-refine-function~ for sorting
TODO: fix #207
-TODO: achieve incremental string insertion
TODO: try implementing #213
-If you have [[https://github.com/oantolin/orderless][orderless]] installed,
you can have an input string that looks like /test
-~Emacs .\(py\|yaml\)$/, by doing this you can skip the =-e= and =-E= steps in
the
-above example. The actual matching styles being applied are determined by your
-orderless config. Also see ~dirvish-fd-regex-builder~.
-
This extension also provides the ~dirvish-fd-jump~ command which allows you to
go
to any directory in the file system using results from =fd= command as
completions.
@@ -330,13 +323,13 @@ See also:
[[https://github.com/alexluigit/dirvish/blob/main/docs/FAQ.org#dired-c
* Live-narrowing of Dirvish buffer (dirvish-narrow.el)
-This extension provides live filtering of files in dirvish buffers. In
general,
-after calling ~dirvish-narrow~ you type a filter string into the minibuffer.
-After each change the changes automatically reflect in the buffer. Typing =RET=
-will exit the live filtering mode and leave the dired buffer in the narrowed
-state. Typing =C-g= will cancel the narrowing and restore the original view.
To
-bring it back to the original view after the narrowing, just call
~revert-buffer~
-(usually bound to =g=).
+This extension provides live filtering of files within Dirvish buffers. Invoke
+~dirvish-narrow~, then type a filter string in the minibuffer, the buffer
updates
+automatically as you type. Press =RET= to finalize the narrowed view, or =C-g=
to
+cancel and restore the original buffer. To restore the full view after
+finalizing with =RET=, use ~revert-buffer~ (typically bound to =g=).
+
+https://github.com/alexluigit/binaries/raw/refs/heads/main/dirvish/assets/narrow.mp4
If you have [[https://github.com/oantolin/orderless][orderless]] installed,
you can have an input string that looks like /test
~Emacs .\(py\|yaml\)$/, meaning:
@@ -346,4 +339,4 @@ If you have
[[https://github.com/oantolin/orderless][orderless]] installed, you
- exclude results containing /Emacs/
The actual matching styles being applied are determined by your orderless
-config. Also see ~dirvish-narrow-regex-builder~.
+config. See ~dirvish-narrow-regex-builder~.
diff --git a/extensions/dirvish-fd.el b/extensions/dirvish-fd.el
index cabb918cc9..1dec7d1010 100644
--- a/extensions/dirvish-fd.el
+++ b/extensions/dirvish-fd.el
@@ -57,24 +57,13 @@
"Listing program for `fd'."
:type '(string :tag "Listing program, such as `ls'") :group 'dirvish)
-(defcustom dirvish-fd-regex-builder
- (if (fboundp 'orderless-pattern-compiler)
- #'orderless-pattern-compiler
- #'split-string)
- "Function used to compose the regex list for narrowing.
-The function takes the input string as its sole argument and
-should return a list of regular expressions."
- :group 'dirvish :type 'function)
-
(defcustom dirvish-fd-default-dir "/"
"Default directory for `dirvish-fd-jump'."
:group 'dirvish :type 'directory)
-(defconst dirvish-fd-bufname "π%sπ%sπ%s")
+(defconst dirvish-fd-bufname "π%sπ%sπ")
(defconst dirvish-fd-header
- (dirvish--mode-line-composer '(fd-switches) '(fd-timestamp fd-pwd " ") t))
-(defvar dirvish-fd-input-history nil "History list of fd input in the
minibuffer.")
-(defvar-local dirvish-fd--output "")
+ (dirvish--mode-line-composer '(fd-switches) '(fd-took) t))
(defvar-local dirvish-fd--input "" "Last used fd user input.")
(defun dirvish-fd--ensure-fd (remote)
@@ -83,18 +72,6 @@ Raise an error if fd executable is not available."
(or (and remote (dirvish-fd--find-fd-program remote)) dirvish-fd-program
(user-error "`dirvish-fd' requires `fd', please install it")))
-(defsubst dirvish-fd--header-offset ()
- "Return # of header lines in a fd buffer."
- (if (or (not (boundp 'dired-free-space))
- (eq (bound-and-true-p dired-free-space) 'separate))
- 2 1))
-
-(defsubst dirvish-fd--bufname (input dir dv)
- "Return fd buffer name of DV with user INPUT at DIR."
- (format dirvish-fd-bufname (or input "")
- (file-name-nondirectory (directory-file-name dir))
- (dv-id dv)))
-
(defun dirvish-fd--apply-switches ()
"Apply fd SWITCHES to current buffer."
(interactive)
@@ -130,9 +107,8 @@ Raise an error if fd executable is not available."
:description "Change search pattern"
:class 'transient-lisp-variable
:variable 'dirvish-fd--input
- :reader (lambda (_prompt _init _hist)
- (completing-read "Input search pattern: "
- dirvish-fd-input-history nil nil
dirvish-fd--input)))
+ :reader (lambda (_prompt init hist)
+ (completing-read "Regex for fd: " nil nil nil init hist)))
;;;###autoload (autoload 'dirvish-fd-switches-menu "dirvish-fd" nil t)
(transient-define-prefix dirvish-fd-switches-menu ()
@@ -141,8 +117,8 @@ Raise an error if fd executable is not available."
(lambda (o) (oset o value (split-string (or (dirvish-prop :fd-switches)
""))))
[:description
(lambda () (dirvish--format-menu-heading
- "Setup FD Switches"
- "Ignore Range [by default ignore ALL]
+ "Setup FD Switches"
+ "Ignore Range [by default ignore ALL]
VCS: .gitignore + .git/info/exclude + $HOME/.config/git/ignore
ALL: VCS + .ignore + .fdignore + $HOME/.config/fd/ignore"))
["File types (multiple types can be included)"
@@ -215,37 +191,34 @@ Raise an error if fd executable is not available."
(pcase-let ((`(,globp ,casep ,ign-range ,types ,exts ,excludes)
(dirvish-prop :fd-arglist))
(face (if (dirvish--selected-p) 'dired-header
'dirvish-inactive)))
- (format " %s | %s"
- (propertize "FD" 'face face)
- (if (not (dirvish-prop :fd-time))
- (substitute-command-keys
- "Processing... press \\[dirvish-fd-kill] to abort the search")
- (format "%s \"%s\" | %s %s | %s %s | %s %s | %s %s | %s %s |"
- (propertize (if globp "glob:" "regex:") 'face face)
- (propertize (or dirvish-fd--input "")
- 'face 'font-lock-regexp-grouping-construct)
- (propertize "type:" 'face face)
- (propertize (if (equal types "") "all" types)
- 'face 'font-lock-variable-name-face)
- (propertize "case:" 'face face)
- (propertize (if casep "sensitive" "smart")
- 'face 'font-lock-type-face)
- (propertize "ignore:" 'face face)
- (propertize ign-range 'face 'font-lock-comment-face)
- (propertize "exts:" 'face face)
- (propertize (if (equal exts "") "all" exts)
- 'face 'font-lock-string-face)
- (propertize "excludes:" 'face face)
- (propertize (if (equal excludes "") "none" excludes)
- 'face 'font-lock-string-face))))))
-
-(dirvish-define-mode-line fd-timestamp
- "Timestamp of search finished."
- (when (dv-curr-layout (dirvish-curr)) (dirvish-prop :fd-time)))
-
-(dirvish-define-mode-line fd-pwd
- "Current working directory."
- (propertize (abbreviate-file-name default-directory) 'face 'dired-directory))
+ (format " π β π: %s [ %s \"%s\" | %s %s | %s %s | %s %s | %s %s | %s %s ]"
+ (propertize
+ (abbreviate-file-name default-directory) 'face 'dired-directory)
+ (propertize (if globp "glob:" "regex:") 'face face)
+ (propertize (or dirvish-fd--input "")
+ 'face 'font-lock-regexp-grouping-construct)
+ (propertize "type:" 'face face)
+ (propertize (if (equal types "") "all" types)
+ 'face 'font-lock-variable-name-face)
+ (propertize "case:" 'face face)
+ (propertize (if casep "sensitive" "smart")
+ 'face 'font-lock-type-face)
+ (propertize "ignore:" 'face face)
+ (propertize ign-range 'face 'font-lock-comment-face)
+ (propertize "exts:" 'face face)
+ (propertize (if (equal exts "") "all" exts)
+ 'face 'font-lock-string-face)
+ (propertize "excludes:" 'face face)
+ (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)
@@ -286,100 +259,54 @@ value 16, let the user choose the root directory of
their search."
(defun dirvish-fd-proc-filter (proc string)
"Filter for `dirvish-fd' processes PROC and output STRING."
- (let ((buf (process-buffer proc)))
- (if (buffer-name buf)
- (with-current-buffer buf
- (setq dirvish-fd--output (concat dirvish-fd--output string)))
- (delete-process proc))))
-
-(defun dirvish-fd--read-input ()
- "Setup INPUT reader for fd."
- (minibuffer-with-setup-hook
- (lambda () (add-hook 'post-command-hook #'dirvish-fd-minibuffer-update-h
nil t))
- (condition-case nil
- (read-string "π: " nil dirvish-fd-input-history)
- (quit (prog1 'cancelled (message "Fd search cancelled"))))))
-
-(defun dirvish-fd--parse-output ()
- "Parse fd command output."
- (goto-char (dirvish-prop :content-begin))
- (cl-loop
- with res = () with buffer-read-only = nil
- for file in (split-string dirvish-fd--output "\n" t)
- for idx = (string-match " ./" file)
- for f-name = (substring file (+ idx 3))
- for f-full = (concat " " (substring file 0 idx) " " f-name "\n") do
- (progn (insert f-full) (push (cons f-name f-full) res))
- finally return (prog1 (nreverse res) (goto-char (point-min)))))
+ (let ((buf (process-buffer proc))
+ (start (process-get proc 'start)) (now (float-time)))
+ (if (not (buffer-name buf)) (delete-process proc)
+ (with-current-buffer buf
+ (save-excursion
+ (save-restriction
+ (widen)
+ (let ((beg (point-max)) (data (dirvish-prop :fd-cache))
+ (lazy (> (- now start) 0.5)) buffer-read-only lb le fname)
+ (goto-char beg)
+ (insert string)
+ (goto-char (process-mark proc))
+ (or (looking-at "^") (forward-line 1))
+ (while-let ((fb (search-forward " ./" nil t))
+ ((search-forward "\n" nil t))) ; skip incomplete
lines
+ (delete-region fb (- fb 2))
+ (forward-line -1)
+ (setq fname (buffer-substring (- fb 2) (line-end-position)))
+ (beginning-of-line) (insert " ")
+ (setq lb (line-beginning-position) le (line-end-position))
+ (unless lazy (dired-insert-set-properties lb le))
+ (puthash fname (buffer-substring lb (1+ le)) data)
+ (forward-line 1))
+ (goto-char (point-max))
+ (when (search-backward "\n" (process-mark proc) t)
+ (move-marker (process-mark proc) (1+ (point)))))))))))
(defsubst dirvish-fd-revert (&rest _)
"Revert buffer function for fd buffer."
(dirvish-fd default-directory (or dirvish-fd--input "")))
-(cl-defun dirvish-fd-proc-sentinel (proc _)
+(defun dirvish-fd-proc-sentinel (proc _)
"Sentinel for `dirvish-fd' process PROC."
- (pcase-let* ((buf (process-buffer proc))
- (success (eq (process-exit-status proc) 0))
- (`(,input ,dir ,dv) (process-get proc 'info)))
- (when (not success)
- (user-error "Dirvish fd error: %s" dirvish-fd--output))
- (unless (buffer-live-p buf)
- (cl-return-from dirvish-fd-proc-sentinel
- (message "`fd' process terminated")))
- (with-selected-window (dv-root-window dv)
- (unless (eq (current-buffer) buf)
- (dirvish-save-dedication (switch-to-buffer buf))))
+ (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 (buffer-live-p buf) (cl-return-from dirvish-fd-proc-sentinel))
+ (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
- (setq-local dirvish-fd--input input
- dirvish-fd--output (dirvish-fd--parse-output)
- revert-buffer-function #'dirvish-fd-revert)
(dirvish-prop :fd-time
(format " %s %s "
- (propertize "Finished at:" 'face 'font-lock-doc-face)
- (propertize (current-time-string)
- 'face (if success 'success 'error))))
- (cond ((not input) (setq input (dirvish-fd--read-input)))
- (t (dirvish--redisplay)))
- (when (eq input 'cancelled)
- (kill-buffer buf)
- (setf (dv-index dv) (car (dv-roots dv)))
- (cl-return-from dirvish-fd-proc-sentinel))
- (let ((bufname (dirvish-fd--bufname input dir dv)))
- (dirvish-prop :root bufname)
- (setf (dv-index dv) (cons bufname buf))
- (push (cons bufname buf) (dv-roots dv))
- (dirvish--kill-buffer (get-buffer bufname))
- (rename-buffer bufname)))))
-
-(defun dirvish-fd-minibuffer-update-h ()
- "Minibuffer update function for `dirvish-fd'."
- (dirvish-run-with-delay (minibuffer-contents-no-properties)
- (lambda (action)
- (with-current-buffer (window-buffer (minibuffer-selected-window))
- (setq dirvish-fd--input action)
- (let ((regexs (cond ((eq (length action) 0) nil)
- ((car (dirvish-prop :fd-arglist))
- (mapcar #'dired-glob-regexp
- (funcall dirvish-fd-regex-builder
action)))
- (t (funcall dirvish-fd-regex-builder action))))
- buffer-read-only)
- (goto-char (cdar dired-subdir-alist))
- (forward-line (dirvish-fd--header-offset))
- (dirvish-prop :content-begin (point))
- (delete-region (point) (dired-subdir-max))
- (save-excursion
- (if (not regexs)
- (cl-loop for (_ . line) in dirvish-fd--output do (insert line))
- (cl-loop for (file . line) in dirvish-fd--output
- unless (cl-loop for regex in regexs
- thereis (not (string-match regex file)))
- do (insert line))))
- (force-mode-line-update t))))))
-
-(defun dirvish-fd-kill ()
- "Kill the `fd' process running in the current buffer."
- (interactive)
- (dirvish--kill-buffer (current-buffer)))
+ (propertize "Took:" 'face 'font-lock-doc-face)
+ (propertize took 'face (if (eq status 0) 'success 'error)))))
+ (force-mode-line-update t)))
;;;###autoload
(defun dirvish-fd (dir pattern)
@@ -393,28 +320,26 @@ The command run is essentially:
nil))
(setq dir (file-name-as-directory
(expand-file-name (or dir default-directory))))
- (or (file-directory-p dir)
- (user-error "'fd' command requires a directory: %s" dir))
+ (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)
- (progn (dirvish dir) (dirvish--get-session 'type 'default))))
+ (dv (or (dirvish-curr) (dirvish--get-session) (dirvish--new)))
(fd-switches (or (dirvish-prop :fd-switches) dirvish-fd-switches ""))
(ls-switches (or dired-actual-switches (dv-ls-switches dv)))
- (buffer (get-buffer-create (format "*fd@%s*" (current-time-string)))))
- (dirvish--kill-buffer (get-buffer (dirvish-fd--bufname pattern dir dv)))
+ (buffer (get-buffer-create "*dirvish-fd*"))
+ (root (format dirvish-fd-bufname (or pattern "")
+ (file-name-nondirectory (directory-file-name dir))))
+ (bname (concat root (dirvish--timestamp))) process-connection-type
proc)
(with-current-buffer buffer
- (erase-buffer)
- (insert " " dir ":" (make-string (dirvish-fd--header-offset) ?\n))
+ (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)
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map (current-local-map))
- (define-key map "\C-c\C-k" #'dirvish-fd-kill)
- (use-local-map map))
+ 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))
(dirvish-prop :dv (dv-id dv))
(dirvish-prop :gui (display-graphic-p))
(dirvish-prop :fd-switches fd-switches)
@@ -425,19 +350,28 @@ The command run is essentially:
(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))))
- (let ((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"))))
- (set-process-filter proc #'dirvish-fd-proc-filter)
- (set-process-sentinel proc #'dirvish-fd-proc-sentinel)
- (dirvish-fd--argparser (split-string (or fd-switches "")))
- (process-put proc 'info (list pattern dir dv))))
- (dirvish-save-dedication (switch-to-buffer buffer))))
+ (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))))
;;;###autoload
(defun dirvish-fd-ask (dir pattern)
diff --git a/extensions/dirvish-narrow.el b/extensions/dirvish-narrow.el
index 81590a16ee..2fa461801a 100644
--- a/extensions/dirvish-narrow.el
+++ b/extensions/dirvish-narrow.el
@@ -15,28 +15,89 @@
;;; Code:
(require 'dirvish)
-(declare-function dirvish-subtree--revert "dirvish-subtree")
(defcustom dirvish-narrow-regex-builder
- (if (functionp 'orderless-pattern-compiler)
- #'orderless-pattern-compiler
+ (if (fboundp 'orderless-compile) (lambda (s) (cdr (orderless-compile s)))
#'split-string)
- "Function used to compose the regex list for narrowing.
+ "Function used to generate the `completion-regexp-list' for narrowing.
The function takes the input string as its sole argument and
should return a list of regular expressions."
:group 'dirvish :type 'function)
-(defvar-local dirvish-narrow--subdir-alist '())
+;; Credit: copied from `orderless.el'
+(defcustom dirvish-narrow-match-faces
+ [dirvish-narrow-match-face-0
+ dirvish-narrow-match-face-1
+ dirvish-narrow-match-face-2
+ dirvish-narrow-match-face-3]
+ "Vector of faces used (cyclically) for component matches."
+ :group 'dirvish :type '(vector face))
+
+(defface dirvish-narrow-match-face-0
+ '((default :weight bold)
+ (((class color) (min-colors 88) (background dark)) :foreground "#72a4ff")
+ (((class color) (min-colors 88) (background light)) :foreground "#223fbf")
+ (t :foreground "blue"))
+ "Face for matches of components numbered 0 mod 4.")
+
+(defface dirvish-narrow-match-face-1
+ '((default :weight bold)
+ (((class color) (min-colors 88) (background dark)) :foreground "#ed92f8")
+ (((class color) (min-colors 88) (background light)) :foreground "#8f0075")
+ (t :foreground "magenta"))
+ "Face for matches of components numbered 1 mod 4.")
+
+(defface dirvish-narrow-match-face-2
+ '((default :weight bold)
+ (((class color) (min-colors 88) (background dark)) :foreground "#90d800")
+ (((class color) (min-colors 88) (background light)) :foreground "#145a00")
+ (t :foreground "green"))
+ "Face for matches of components numbered 2 mod 4.")
+
+(defface dirvish-narrow-match-face-3
+ '((default :weight bold)
+ (((class color) (min-colors 88) (background dark)) :foreground "#f0ce43")
+ (((class color) (min-colors 88) (background light)) :foreground "#804000")
+ (t :foreground "yellow"))
+ "Face for matches of components numbered 3 mod 4.")
+
+(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)
(defun dirvish-narrow--build-indices ()
"Update the Dirvish buffer based on the input of the minibuffer."
- (setq dirvish-narrow--subdir-alist '())
+ (declare-function dirvish-subtree--revert "dirvish-subtree")
(when (bound-and-true-p dirvish-subtree--overlays)
(dirvish-subtree--revert t))
(save-excursion
- (with-current-buffer (window-buffer (minibuffer-selected-window))
- (cl-loop for (dir . beg) in dired-subdir-alist do
- (dirvish-narrow--index-subdir dir beg)))))
+ (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)
+ (let ((end (dired-subdir-max)) (files (dirvish--ht)))
+ (while (< (point) end)
+ (when-let* ((f-beg (dired-move-to-filename))
+ (f-end (dired-move-to-end-of-filename))
+ (f-name (buffer-substring-no-properties f-beg f-end))
+ (l-beg (line-beginning-position))
+ (l-end (1+ (line-end-position)))
+ (l-str (buffer-substring l-beg l-end)))
+ (puthash f-name l-str files))
+ (forward-line 1))
+ (puthash (md5 dir) files dirvish--dir-data)))))
(defun dirvish-narrow-update-h ()
"Update the Dirvish buffer based on the input of the minibuffer."
@@ -49,57 +110,44 @@ should return a list of regular expressions."
for (dir . pos) in dired-subdir-alist
do (dirvish-narrow--filter-subdir dir pos regs idx)))))))
-(defun dirvish-narrow--revert ()
- "Revert Dirvish buffer with empty narrowing filter."
- (cl-loop for idx from 0
- for (dir . pos) in dired-subdir-alist
- do (dirvish-narrow--filter-subdir dir pos nil idx)))
-
-(cl-defun dirvish-narrow--index-subdir (subdir beg)
- "Filter the SUBDIR from BEG to END."
- (goto-char beg)
- (let ((end (dired-subdir-max)) files)
- (while (< (point) end)
- (when-let* ((f-beg (dired-move-to-filename))
- (f-end (dired-move-to-end-of-filename))
- (f-name (buffer-substring-no-properties f-beg f-end))
- (l-beg (line-beginning-position))
- (l-end (1+ (line-end-position)))
- (l-str (buffer-substring l-beg l-end)))
- (push (cons f-name l-str) files))
- (forward-line 1))
- (push (cons subdir (reverse files)) dirvish-narrow--subdir-alist)))
-
(defun dirvish-narrow--filter-subdir (dir pos regexs idx)
"Filter the subdir DIR in POS with REGEXS.
IDX the index of DIR in `dired-subdir-alist'."
- (goto-char pos)
- (let* ((files (alist-get dir dirvish-narrow--subdir-alist nil nil #'equal))
- (end (- (dired-subdir-max) (if (eq idx 0) 0 1)))
- (offset (1- (line-number-at-pos (dirvish-prop :content-begin))))
- (beg (progn (forward-line offset) (point)))
- buffer-read-only)
- (delete-region beg end)
- (if (not regexs)
- (cl-loop for (_ . line) in files do (insert line))
- (cl-loop for (file . line) in files
- unless (cl-loop for regex in regexs
- thereis (not (string-match regex file)))
- do (insert line)))))
+ (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 files = (gethash (md5 dir) dirvish--dir-data)
+ and fr-h = (+ (frame-height) 5) and count = 0
+ for f in (all-completions "" files)
+ for l = (concat (gethash f files)) ; use copy, not reference
+ for hl = (if (> (cl-incf count) fr-h) l ; lazy highlighting
+ (dirvish-narrow--highlight regexs t l))
+ do (insert hl)))
;;;###autoload
(defun dirvish-narrow ()
"Narrow a Dirvish buffer to the files matching a regex."
- (interactive)
+ (interactive nil dired-mode)
+ (when (get-buffer-process (current-buffer))
+ (user-error "Current buffer has unfinished jobs"))
(dirvish-narrow--build-indices)
- (when (minibufferp) (user-error "`%s' called inside the minibuffer"
this-command))
- (let ((old-f (dirvish-prop :index)) final-input)
+ (let ((dv (dirvish-prop :dv))
+ (of (dirvish-prop :index))
+ (bstr (buffer-string))
+ input buffer-read-only)
+ (font-lock-mode -1) (buffer-disable-undo)
(minibuffer-with-setup-hook
- (lambda () (add-hook 'post-command-hook #'dirvish-narrow-update-h nil
t))
+ (lambda ()
+ (dirvish-prop :dv dv)
+ (add-hook 'post-command-hook #'dirvish-narrow-update-h nil t))
(unwind-protect
- (setq final-input (read-from-minibuffer "Focus on files: "))
- (when (= (length final-input) 0) (dirvish-narrow--revert))
- (dired-goto-file old-f)))))
+ (setq input (read-from-minibuffer "Focus on files: "))
+ (when (= (length input) 0)
+ (erase-buffer) (insert bstr)
+ (unless (cdr dired-subdir-alist) (dirvish--hide-dired-header)))
+ (dired-goto-file of)
+ (font-lock-mode 1) (buffer-enable-undo)))))
(provide 'dirvish-narrow)
;;; dirvish-narrow.el ends here
