175 lines
7.5 KiB
EmacsLisp
175 lines
7.5 KiB
EmacsLisp
;;; dirvish-narrow.el --- Live-narrowing of search results for Dirvish -*- lexical-binding: t -*-
|
|
|
|
;; Copyright (C) 2021-2025 Alex Lu
|
|
;; Author : Alex Lu <https://github.com/alexluigit>
|
|
;; Keywords: files, convenience
|
|
;; Homepage: https://github.com/alexluigit/dirvish
|
|
;; SPDX-License-Identifier: GPL-3.0-or-later
|
|
|
|
;;; Commentary:
|
|
|
|
;; This package provides live filtering of files in Dirvish buffers. It is a
|
|
;; stripped-down version of `dired-narrow'.
|
|
|
|
;;; Code:
|
|
|
|
(require 'dirvish-fd)
|
|
|
|
;; 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."
|
|
:group 'dirvish)
|
|
|
|
(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."
|
|
:group 'dirvish)
|
|
|
|
(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."
|
|
:group 'dirvish)
|
|
|
|
(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."
|
|
:group 'dirvish)
|
|
|
|
(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."
|
|
(save-excursion
|
|
(cl-loop
|
|
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))
|
|
(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--compiler (s)
|
|
"Compile `completion-regexp-list' from string S."
|
|
(if (fboundp 'orderless-compile) (cdr (orderless-compile s)) (split-string s)))
|
|
|
|
(defun dirvish-narrow-update-h ()
|
|
"Update the Dirvish buffer based on the input of the minibuffer."
|
|
(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 :narrow
|
|
(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 (gethash f files))))))
|
|
(when (dv-curr-layout (dirvish-curr)) (force-mode-line-update t))))))
|
|
|
|
(dirvish-define-attribute narrow-match
|
|
"Highlight matched part of narrowed files."
|
|
(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 (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))
|
|
(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
|
|
(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 :narrow)))))
|
|
|
|
(provide 'dirvish-narrow)
|
|
;;; dirvish-narrow.el ends here
|