;;; +consult.el --- consult additions -*- lexical-binding: t -*-

;;; Code:

(defun +consult-project-root ()
  "Return either the current project, or the VC root, of current file."
  (if (and (functionp 'project-current)
           (project-current))
      (car (project-roots (project-current)))
    (vc-root-dir)))

;;; Cribbed functions
;; https://github.com/minad/consult/wiki

(defun consult--orderless-regexp-compiler (input type &rest _)
  (setq input (orderless-pattern-compiler input))
  (cons
   (mapcar (lambda (r) (consult--convert-regexp r type)) input)
   (lambda (str) (orderless--highlight input str))))

(defmacro consult-history-to-modes (map-hook-alist)
  (let (defuns)
    (dolist (map-hook map-hook-alist)
      (let ((map-name (symbol-name (car map-hook)))
            (key-defs `(progn (define-key
                                ,(car map-hook)
                                (kbd "M-r")
                                (function consult-history))
                              (define-key ,(car map-hook)
                                (kbd "M-s") nil))))
        (push (if (cdr map-hook)
                  `(add-hook ',(cdr map-hook)
                             (defun
                                 ,(intern (concat map-name
                                                  "@consult-history-bind"))
                                 nil
                               ,(concat
                                 "Bind `consult-history' to M-r in "
                                 map-name ".\n"
                                 "Defined by `consult-history-to-modes'.")
                               ,key-defs))
                key-defs)
              defuns)))
    `(progn ,@ (nreverse defuns))))

(provide '+consult)
;;; +consult.el ends here