add package dependencies
This commit is contained in:
174
lisp/dirvish/dirvish-narrow.el
Normal file
174
lisp/dirvish/dirvish-narrow.el
Normal file
@@ -0,0 +1,174 @@
|
||||
;;; 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
|
||||
Reference in New Issue
Block a user