From 2c047660fab0931d127242aea2119e69e6354aed Mon Sep 17 00:00:00 2001
From: Magic_RB <magic_rb@redalder.org>
Date: Sat, 16 Sep 2023 19:31:06 +0200
Subject: [PATCH] Replace hacky ~consult-fd~ code with other hacky code

Signed-off-by: Magic_RB <magic_rb@redalder.org>
---
 emacs-lisp/cosult.org | 84 ++++++++++++++++++++++++++++++++-----------
 1 file changed, 63 insertions(+), 21 deletions(-)

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