dotfiles/emacs-lisp/cosult.org

:PROPERTIES:
:ID:       db1d0122-58d6-4dec-84f6-afcb52937fc7
:END:
#+title: Consult
#+filetags: emacs-load

# SPDX-FileCopyrightText: 2022 Richard Brežák <richard@brezak.sk>
#
# SPDX-License-Identifier: LGPL-3.0-or-later

#+BEGIN_QUOTE
Consult provides practical commands based on the Emacs completion function completing-read. Completion allows you to quickly select an item from a list of candidates.
#+END_QUOTE

#+BEGIN_SRC emacs-lisp :results none
  (use-package consult
    :straight t
    :bind (("C-x b" . consult-buffer)
           ("C-x 4 b" . consult-buffer-other-window)
           ("C-x 5 b" . consult-buffer-other-frame)
           ;; M-s bindings (search-map)
           ("M-s r" . consult-ripgrep)
           ("M-s f" . consult-find))
    :init
    (defun compat-string-width (&rest args)
      (apply #'string-width args))
    (setq
     consult-project-root-function #'projectile-project-root
     consult-ripgrep-args "rg --null --line-buffered --color=never --max-columns=1000 --path-separator /   --smart-case --no-heading --line-number --hidden ."
     consult-find-args "find ."))
#+END_SRC

Also enable ~fd~ support, as that ignores paths listed in .gitignore unlike ~find~..

#+begin_src emacs-lisp
  (use-package consult-fd
    :no-require t
    :after (consult)
    :init
    (defvar consult--fd-command "fd")

    (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