path: root/lisp/ravi-init-completion.el

;;; ravi-init-completion.el --- selectrum/prescient/orderless/marginalia/embark/consult  -*- lexical-binding: t; -*-

;; Copyright (C) 2021  Ravi R Kiran

;; Author: Ravi R Kiran <aine.marina@gmail.com>
;; Keywords:

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; Try out newfangled completion UI

;;; Code:

;; Use selectrum as completion UI with orderless for filtering and
;; prescient for frecency sorting

(use-package vlf
  :commands (vlf))
(use-package sudo-edit
  :commands (sudo-edit))

(use-package orderless
  :if (member ravi/use-selection-system '(selectrum vertico))
  :config
  (when (equal ravi/use-selection-system 'selectrum)
    (setq completion-styles '(orderless))
    (setq orderless-skip-highlighting (lambda () selectrum-is-active)))
  (when (equal ravi/use-selection-system 'vertico)
    ;; From the consult wiki: https://github.com/minad/consult/wiki
    (defvar +orderless-dispatch-alist
      '((?% . char-fold-to-regexp)
        (?! . orderless-without-literal)
        (?`. orderless-initialism)
        (?= . orderless-literal)
        (?~ . orderless-flex)))

    ;; Recognizes the following patterns:
    ;; * ~flex flex~
    ;; * =literal literal=
    ;; * %char-fold char-fold%
    ;; * `initialism initialism`
    ;; * !without-literal without-literal!
    ;; * .ext (file extension)
    ;; * regexp$ (regexp matching at end)
    (defun +orderless-dispatch (pattern index _total)
      (cond
       ;; Ensure that $ works with Consult commands, which add disambiguation suffixes
       ((string-suffix-p "$" pattern)
        `(orderless-regexp . ,(concat (substring pattern 0 -1) "[\x200000-\x300000]*$")))
       ;; File extensions
       ((and
         ;; Completing filename or eshell
         (or minibuffer-completing-file-name
             (derived-mode-p 'eshell-mode))
         ;; File extension
         (string-match-p "\\`\\.." pattern))
        `(orderless-regexp . ,(concat "\\." (substring pattern 1) "[\x200000-\x300000]*$")))
       ;; Ignore single !
       ((string= "!" pattern) `(orderless-literal . ""))
       ;; Prefix and suffix
       ((if-let (x (assq (aref pattern 0) +orderless-dispatch-alist))
            (cons (cdr x) (substring pattern 1))
          (when-let (x (assq (aref pattern (1- (length pattern))) +orderless-dispatch-alist))
            (cons (cdr x) (substring pattern 0 -1)))))))

    ;; Define orderless style with initialism by default
    (orderless-define-completion-style +orderless-with-initialism
      (orderless-matching-styles '(orderless-initialism orderless-literal orderless-regexp)))
    (setq completion-styles '(orderless basic)
        completion-category-defaults nil
        ;;; Enable partial-completion for files.
        ;;; Either give orderless precedence or partial-completion.
        ;;; Note that completion-category-overrides is not really an override,
        ;;; but rather prepended to the default completion-styles.
        ;; completion-category-overrides '((file (styles orderless partial-completion))) ;; orderless is tried first
        completion-category-overrides '((file (styles partial-completion)) ;; partial-completion is tried first
                                        ;; enable initialism by default for symbols
                                        (command (styles +orderless-with-initialism))
                                        (variable (styles +orderless-with-initialism))
                                        (symbol (styles +orderless-with-initialism)))
        orderless-component-separator #'orderless-escapable-split-on-space ;; allow escaping space with backslash!
        orderless-style-dispatchers '(+orderless-dispatch))
    )
  )

(use-package selectrum
  :if (equal ravi/use-selection-system 'selectrum)
  :config
  (setq selectrum-highlight-candidates-function #'orderless-highlight-matches)
  (setq selectrum-max-window-height 22)
  (selectrum-mode +1)
  (bind-key "C-l" 'backward-kill-word selectrum-minibuffer-map)

  (autoload 'ffap-guesser "ffap")
  (setq minibuffer-default-add-function
        (defun minibuffer-default-add-function+ ()
          (with-selected-window (minibuffer-selected-window)
            (delete-dups
             (delq nil
                   (list (thing-at-point 'symbol)
                           (thing-at-point 'list)
                           (ffap-guesser)
                           (thing-at-point-url-at-point))))))))
(use-package selectrum-prescient
  :if (equal ravi/use-selection-system 'selectrum)
  :config
  (setq selectrum-prescient-enable-filtering nil)
  (selectrum-prescient-mode +1)
  (prescient-persist-mode +1))

(use-package vertico
  :if (equal ravi/use-selection-system 'vertico)
  :init
  (vertico-mode)
  :config
  (bind-key [remap forward-list] 'vertico-next-group)
  (bind-key [remap backward-list] 'vertico-previous-group)
  (defun +vertico-crm-exit ()
    (interactive)
    (run-at-time 0 nil #'vertico-exit)
    (funcall #'vertico-exit)))

(defun ravi/bind-key-selection-system-map (key func)
  "Bind to appropriate minibuffer completion map"
  (bind-key key func
            (pcase ravi/use-selection-system
              ('selectrum selectrum-minibuffer-map)
              ('vertico vertico-map))))

(use-package marginalia
  :if (member ravi/use-selection-system '(selectrum vertico))
  :after (:any selectrum vertico)
  :config (marginalia-mode))

(use-package embark
  :if (member ravi/use-selection-system '(selectrum vertico))
  :commands (embark-act)
  :bind (("H-t" . embark-act)
         :map
         embark-file-map
         ("s" . sudo-edit)
         ("l" . vlf)
         ("G" . embark-magit-status))
  :init
  ;; Optionally replace the key help with a completing-read interface
  (setq prefix-help-command #'embark-prefix-help-command)
  (ravi/bind-key-selection-system-map "C-t" #'embark-act)

  ;; Integrate embark with avy, by adding to avy dispatch list
  (with-eval-after-load 'avy
    (defun avy-action-embark (pt)
      (unwind-protect
          (save-excursion
            (goto-char pt)
            (embark-act))
        (select-window (cdr (ring-ref avy-ring 0))))
      t)
    (setf (alist-get ?E avy-dispatch-alist) 'avy-action-embark))

  :config
  (defun embark-magit-status (file)
    "Run `magit-status` on repo containing the embark target."
    (interactive "GFile: ")
    (magit-status (locate-dominating-file file ".git")))

  ;; Ace window dispatch on embark actions
  ;; Different implementation, but the idea is from:
  ;;   https://karthinks.com/software/fifteen-ways-to-use-embark/
  (eval-when-compile
    (defun ravi/embark-ace-action (fn)
      `(defun ,(intern (concat "ravi/embark-ace-" (symbol-name fn))) ()
         (interactive)
         (with-demoted-errors "%s"
           (require 'ace-window)
           (aw-switch-to-window (aw-select nil))
           (call-interactively (symbol-function ',fn)))))
    (defun ravi/embark-ace-split-action (fn split-type)
      `(defun ,(intern (concat "ravi/embark-"
                               (symbol-name fn)
                               "-"
                               (car (last  (split-string
                                            (symbol-name split-type) "-"))))) ()
         (interactive)
         (when-let ((new-window (funcall #',split-type)))
           (select-window new-window))
         (call-interactively #',fn)))
    (defun ravi/make-embark-ace-actions (keymap-func)
      (let* ((keymap (car keymap-func))
             (func (cadr keymap-func))
             (func-name (symbol-name func)))
        `(progn
           (define-key ,keymap (kbd "o") ,(ravi/embark-ace-action func))
           (define-key ,keymap (kbd "2") ,(ravi/embark-ace-split-action func #'split-window-right))
           (define-key ,keymap (kbd "3") ,(ravi/embark-ace-split-action func #'split-window-below)))))
    (defmacro ravi/make-embark-ace-actions-all-macro (keymap-func-list)
      `(progn
         ,@(mapcar #'ravi/make-embark-ace-actions keymap-func-list))))
  (with-eval-after-load 'ace-window
    (ravi/make-embark-ace-actions-all-macro ((embark-file-map find-file)
                                             (embark-buffer-map switch-to-buffer)
                                             (embark-bookmark-map bookmark-jump))))
  ;; For debugging below:
  ;; (pp (macroexpand '(ravi/make-embark-ace-actions-all-macro
  ;;                    ((embark-file-map find-file)))))

  ;; Hide the mode line of the Embark live/completions buffers
  (add-to-list 'display-buffer-alist
               '("\\`\\*Embark Collect \\(Live\\|Completions\\)\\*"
                 nil
                 (window-parameters (mode-line-format . none)))))

(use-package consult
  :if (member ravi/use-selection-system '(selectrum vertico))
  :bind (;; C-c bindings (mode-specific-map)
         ("C-c h" . consult-history)
         ("C-c m" . consult-mode-command)
         ("C-c b" . consult-bookmark)
         ("C-c k" . consult-kmacro)
         ;; C-x bindings (ctl-x-map)
         ("C-x M-:" . consult-complex-command)     ;; orig. repeat-complex-command
         ("C-x b" . consult-buffer)                ;; orig. switch-to-buffer
         ("C-x 4 b" . consult-buffer-other-window) ;; orig. switch-to-buffer-other-window
         ("C-x 5 b" . consult-buffer-other-frame)  ;; orig. switch-to-buffer-other-frame
         ;; Custom M-# bindings for fast register access
         ("M-#" . consult-register-load)
         ("M-'" . consult-register-store)          ;; orig. abbrev-prefix-mark (unrelated)
         ("C-M-#" . consult-register)
         ;; Other custom bindings
         ("M-y" . consult-yank-pop)                ;; orig. yank-pop
         ("<help> a" . consult-apropos)            ;; orig. apropos-command
         ;; M-g bindings (goto-map)
         ("M-g e" . consult-compile-error)
         ("M-g f" . consult-flymake)               ;; Alternative: consult-flycheck
         ;; Don't use consult-goto-line because avy-goto-line keeps fingers on home row
         ;; ("M-g g" . consult-goto-line)             ;; orig. goto-line
         ;; ("M-g M-g" . consult-goto-line)           ;; orig. goto-line
         ("M-g o" . consult-outline)               ;; Alternative: consult-org-heading
         ("M-g m" . consult-mark)
         ("M-g k" . consult-global-mark)
         ("M-g i" . consult-imenu)
         ("M-g I" . consult-imenu-multi)
         ;; M-s bindings (search-map)
         ("M-s f" . consult-find)
         ("M-s F" . consult-locate)
         ("M-s g" . consult-grep)
         ("M-s G" . consult-git-grep)
         ;; ("M-s r" . consult-ripgrep)
         ("M-i" . consult-line)
         ("M-s l" . consult-line)
         ("M-s L" . consult-line-multi)
         ("M-s m" . consult-multi-occur)
         ("M-s k" . consult-keep-lines)
         ("M-s u" . consult-focus-lines)
         ;; Isearch integration
         ("M-s e" . consult-isearch)
         :map isearch-mode-map
         ("M-e" . consult-isearch)                 ;; orig. isearch-edit-string
         ("M-s e" . consult-isearch)               ;; orig. isearch-edit-string
         ("M-s l" . consult-line)                  ;; needed by consult-line to detect isearch
         ("M-s L" . consult-line-multi)            ;; needed by consult-line to detect isearch
         :map consult-narrow-map
         ("C-r" . consult-narrow-cycle-backward)
         ("C-s" . consult-narrow-cycle-forward))

  ;; Enable automatic preview at point in the *Completions* buffer.
  ;; This is relevant when you use the default completion UI,
  ;; and not necessary for Vertico, Selectrum, etc.
  ;; :hook (completion-list-mode . consult-preview-at-point-mode)

  ;; The :init configuration is always executed (Not lazy)
  :init

  ;; Optionally configure the register formatting. This improves the register
  ;; preview for `consult-register', `consult-register-load',
  ;; `consult-register-store' and the Emacs built-ins.
  (setq register-preview-delay 0
        register-preview-function #'consult-register-format)

  ;; Optionally tweak the register preview window.
  ;; This adds thin lines, sorting and hides the mode line of the window.
  (advice-add #'register-preview :override #'consult-register-window)

  ;; Optionally replace `completing-read-multiple' with an enhanced version.
  (advice-add #'completing-read-multiple :override #'consult-completing-read-multiple)

  ;; Use Consult to select xref locations with preview
  (setq xref-show-xrefs-function #'consult-xref
        xref-show-definitions-function #'consult-xref)

  ;; Configure other variables and modes in the :config section,
  ;; after lazily loading the package.
  :config

  ;; Optionally configure preview. The default value
  ;; is 'any, such that any key triggers the preview.
  ;; (setq consult-preview-key 'any)
  (setq consult-preview-key "C-o")
  ;; (setq consult-preview-key (list (kbd "<S-down>") (kbd "<S-up>")))
  ;; For some commands and buffer sources it is useful to configure the
  ;; :preview-key on a per-command basis using the `consult-customize' macro.
  (consult-customize
   consult-theme
   :preview-key '(:debounce 0.2 any)
   consult-ripgrep consult-git-grep consult-grep consult-xref
   :preview-key 'any
   consult-bookmark consult-recent-file
   consult--source-recent-file consult--source-project-recent-file consult--source-bookmark
   :preview-key "C-o")
  (consult-customize consult-buffer :preview-key nil) ; preview is just too intrusive
  (consult-customize
   consult-isearch consult-line consult-grep consult-git-grep consult-apropos consult-xref
   :initial (thing-at-point 'symbol))

  ;; Optionally configure the narrowing key.
  ;; Both < and C-+ work reasonably well.
  (setq consult-narrow-key "<") ;; (kbd "C-+")

  ;; Optionally make narrowing help available in the minibuffer.
  ;; You may want to use `embark-prefix-help-command' or which-key instead.
  (define-key consult-narrow-map (vconcat consult-narrow-key "?") #'consult-narrow-help)

  ;; Optionally configure a function which returns the project root directory.
  ;; There are multiple reasonable alternatives to chose from.
  ;;;; 1. project.el (project-roots)
  ;; (setq consult-project-root-function
  ;;       (lambda ()
  ;;         (when-let (project (project-current))
  ;;           (car (project-roots project)))))
  ;;;; 2. projectile.el (projectile-project-root)
  (autoload 'projectile-project-root "projectile")
  (setq consult-project-root-function #'projectile-project-root)
  ;;;; 3. vc.el (vc-root-dir)
  ;; (setq consult-project-root-function #'vc-root-dir)
  ;;;; 4. locate-dominating-file
  ;; (setq consult-project-root-function (lambda () (locate-dominating-file "." ".git")))

  ;; First line as default is entirely useless
  (consult-customize
   consult-line consult-line-multi
   :default nil)

  ;; Replace by embark-prefix-help-command?
  (require 'which-key)
  (defun immediate-which-key-for-narrow (fun &rest args)
    (let* ((refresh t)
           (timer (and consult-narrow-key
                       (memq :narrow args)
                       (run-at-time 0.05 0.05
                                    (lambda ()
                                      (if (eq last-input-event (elt consult-narrow-key 0))
                                          (when refresh
                                            (setq refresh nil)
                                            (which-key--update))
                                        (setq refresh t)))))))
      (unwind-protect
          (apply fun args)
        (when timer
          (cancel-timer timer)))))
  (advice-add #'consult--read :around #'immediate-which-key-for-narrow)

  (defun consult-narrow-cycle-backward ()
    "Cycle backward through the narrowing keys."
    (interactive)
    (when consult--narrow-keys
      (consult-narrow
       (if consult--narrow
           (let ((idx (seq-position consult--narrow-keys
                                    (assq consult--narrow consult--narrow-keys))))
             (unless (eq idx 0)
               (car (nth (1- idx) consult--narrow-keys))))
         (caar (last consult--narrow-keys))))))

  (defun consult-narrow-cycle-forward ()
    "Cycle forward through the narrowing keys."
    (interactive)
    (when consult--narrow-keys
      (consult-narrow
       (if consult--narrow
           (let ((idx (seq-position consult--narrow-keys
                                    (assq consult--narrow consult--narrow-keys))))
             (unless (eq idx (1- (length consult--narrow-keys)))
               (car (nth (1+ idx) consult--narrow-keys))))
         (caar consult--narrow-keys)))))
  )

(use-package embark-consult
  :if (member ravi/use-selection-system '(selectrum vertico))
  :after (embark consult)
  :demand t ; only necessary if you have the hook below
  ;; if you want to have consult previews as you move around an
  ;; auto-updating embark collect buffer
  :hook
  (embark-collect-mode . consult-preview-at-point-mode))

(use-package dash-docs
  :defer t)
(use-package consult-dash
  :if (member ravi/use-selection-system '(selectrum vertico))
  :bind (("M-s d" . consult-dash))
  :init
  (with-eval-after-load 'avy
    (defun avy-action-dash (pt)
      (save-excursion
        (goto-char pt)
        (consult-dash))
      (select-window (cdr (ring-ref avy-ring 0)))
      t)
    (setf (alist-get ?D avy-dispatch-alist) 'avy-action-dash))

  :config
  ;; Ensure that niceties are loaded too
  (require 'embark)
  (require 'marginalia)
  (consult-customize consult-dash :initial (thing-at-point 'symbol)))

(use-package consult-projectile
  :if (member ravi/use-selection-system '(selectrum vertico))
  :commands (consult-projectile
             consult-projectile-find-file
             consult-projectile-recentf
             consult-projectile-switch-project
             consult-projectile-switch-to-buffer
             consult-projectile-find-dir)
  :init
  (with-eval-after-load "projectile"
    (dolist (command '((projectile-find-file-dwim . consult-projectile)
                       (projectile-find-file . consult-projectile-find-file)
                       (projectile-recentf . consult-projectile-recentf)
                       (projectile-switch-project . consult-projectile-switch-project)
                       (projectile-switch-to-buffer . consult-projectile-switch-to-buffer)
                       (projectile-find-dir . consult-projectile-find-dir)))
      (let ((before (car command))
            (after (cdr command)))
        (bind-key (vector 'remap before) after)))))

(use-package consult-dir
  :commands (consult-dir)
  :after (:any selectrum vertico)
  :init
  (ravi/bind-key-selection-system-map "C-x C-d" #'consult-dir)
  (ravi/bind-key-selection-system-map "C-x C-j" #'consult-dir-jump-file)
  :bind (("C-x C-d" . consult-dir))
  :config
  (setq consult-dir-project-list-function #'consult-dir-projectile-dirs)

  ;; Since we use fasd, use it as a directory source too
  (when-let ((fasd (executable-find "fasd")))
    (defun consult-dir--fasd-dirs ()
      "Return list of fasd dirs."
      (split-string (shell-command-to-string (concat fasd " -ld")) "\n" t))
    (defvar consult-dir--source-fasd
      `(:name "Fasd dirs"
              :narrow   ?f
              :category file
              :face     consult-file
              :history  file-name-history
              :items    ,#'consult-dir--fasd-dirs)
      "Fasd directory source for `consult-dir'.")
    (add-to-list 'consult-dir-sources 'consult-dir--source-fasd t)))

(provide 'ravi-init-completion)
;;; ravi-init-completion.el ends here