magic_rb/dotfiles
1
0
Fork 0
mirror of https://git.sr.ht/~magic_rb/dotfiles synced 2024-11-21 23:54:22 +01:00
Code Issues Packages Projects Releases Wiki Activity

Replace hacky ~consult-fd~ code with other hacky code

Browse source 
Signed-off-by: Magic_RB <magic_rb@redalder.org>
This commit is contained in:
Magic_RB 2023-09-16 19:31:06 +02:00
parent 2ed6b1fc6e
commit 2c047660fa
1 changed files with 63 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

84
emacs-lisp/cosult.org
View file

@ -38,26 +38,68 @@ Also enable ~fd~ support, as that ignores paths listed in .gitignore unlike ~fin
:after (consult)
:init
(defvar consult--fd-command "fd")
(defun consult--fd-builder (input)
(unless consult--fd-command
(setq consult--fd-command
(if (eq 0 (call-process-shell-command "fdfind"))
"fdfind"
"fd")))
(pcase-let* ((`(,arg . ,opts) (consult--command-split input))
(`(,re . ,hl) (funcall consult--regexp-compiler
arg 'extended t)))
(when re
(list :command (append
(list consult--fd-command
"--color=never" "--full-path"
(consult--join-regexps re 'extended))
opts)
:highlight hl))))
(defun consult-fd (&optional dir initial)
(interactive "P")
(let* ((prompt-dir (consult--directory-prompt "Fd" dir))
(default-directory (cdr prompt-dir)))
(find-file (consult--find (car prompt-dir) #'consult--fd-builder initial)))))
(defun list-interject (list separator)
(let ((next list))
(dotimes (_ (length (cdr list)))
(setcdr next (cons separator (cdr next)))
(setq next (cddr next)))))
(defmacro uncons (car-name cdr-name cell)
`(progn
(setq ,car-name (car ,cell))
(setq ,cdr-name (cdr ,cell))
nil))
(defmacro let-uncons-1 (car-name cdr-name cell &rest body)
`(let ((--let-uncons-1-- ,cell) ,car-name ,cdr-name)
(uncons ,car-name ,cdr-name --let-uncons-1--)
,@body))
(defmacro let-uncons (uncons-list &rest body)
(let* ((forms (list 'unused)) (next-form nil) (last-form forms))
(while uncons-list
(let-unpack-1 (car-name cdr-name cell) uncons-list
(setq next-form `(let-uncons-1 ,car-name ,cdr-name ,cell))
(setcdr (last last-form) (list next-form))
(setq last-form next-form))
(setq uncons-list (cdddr uncons-list)))
(setcdr (last last-form) body)
(cadr forms)))
(defmacro unpack (names list)
`(let ((--unpack-- ,list))
(dolist (name ',names)
(eval (list 'setq name '(car --unpack--)))
(setq --unpack-- (cdr --unpack--)))))
(defmacro let-unpack-1 (names list &rest body)
`(let ((--let-unpack-1-- ,list) ,@names)
(unpack ,names --let-unpack-1--)
,@body))
(defmacro let-unpack (unpack-list &rest body)
(let* ((forms (list 'unused)) (next-form nil) (last-form forms))
(while unpack-list
(let-unpack-1 (names list) unpack-list
(setq next-form `(let-unpack-1 ,names ,list))
(setcdr (last last-form) (list next-form))
(setq last-form next-form))
(setq unpack-list (cddr unpack-list)))
(setcdr (last last-form) body)
(cadr forms)))
(defun consult-fd (&optional directory initial-query) (interactive "P")
(let-unpack ((prompt paths directory)
(consult--directory-prompt "Fd" directory))
(let* ((default-directory directory)
(file (consult--find
prompt 'consult--fd-builder initial-query)))
(find-file file))))
(defun consult--fd-builder (query)
(let-uncons (patterns options (consult--command-split query)
patterns highlight-function (funcall
consult--regexp-compiler patterns 'extended t))
(when patterns
(list-interject patterns "--and")
(cons
`(,consult--fd-command "--color=never" "--full-path" ,@patterns ,@options)
highlight-function)))))
#+end_src