diff --git a/emacs-lisp/cosult.org b/emacs-lisp/cosult.org index a44ff1c..76a98f1 100644 --- a/emacs-lisp/cosult.org +++ b/emacs-lisp/cosult.org @@ -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