path: root/consult.org

#+title: Completion configuration using selectrum, consult and friends

* completion styles
  #+begin_src emacs-lisp
    (setq completion-styles '(basic partial-completion emacs22))
  #+end_src
* prescient
  #+begin_src emacs-lisp
    (use-package prescient :ensure t)
  #+end_src
* selectrum
  #+begin_src emacs-lisp
    (use-package selectrum
      :ensure t
      :custom ((selectrum-extend-current-candidate-highlight nil)
               (selectrum-fix-minibuffer-height nil)
               (selectrum-num-candidates-displayed 15)
               (selectrum-show-indices nil)
               (selectrum-count-style 'current/matches)) ;; 'matches
      :bind (("C-R" . selectrum-repeat)))

    (use-package selectrum-prescient :ensure t)
  #+end_src
* marginalia
  #+begin_src emacs-lisp
    (use-package marginalia
      :ensure t
      :bind (:map minibuffer-local-map ("C-M-a" . marginalia-cycle))

      :custom (marginalia-annotators
               '(marginalia-annotators-heavy marginalia-annotators-light nil))
      :config
      (with-eval-after-load "selectrum"
        (advice-add #'marginalia-cycle
                    :after
                    (lambda ()
                      (when (bound-and-true-p selectrum-mode)
                        (selectrum-exhibit))))))
   #+end_src
* consult
  #+begin_src emacs-lisp
    (use-package consult
      :ensure t
      :bind (("C-x M-:" . consult-complex-command)
             ("C-x b" . consult-buffer)
             ("C-x 4 b" . consult-buffer-other-window)
             ("C-x 5 b" . consult-buffer-other-frame)
             ("C-c b" . consult-bookmark)
             ("C-c B" . bookmark-set)
             ("C-c h" . consult-history)
             ("C-c i" . consult-imenu)
             ("C-c k" . consult-ripgrep)
             ("C-c K" . consult-git-grep)
             ("C-c l" . consult-locate)
             ("C-c m" . consult-mode-command)
             ("C-c s" . consult-line)
             ("C-x r x" . consult-register)
             ("C-x r b" . consult-bookmark)
             ("M-g b" . consult-bookmark)
             ("M-g g" . consult-goto-line)
             ("M-g M-g" . consult-goto-line)
             ("M-g o" . consult-outline)
             ("M-g s" . consult-line)
             ("M-g m" . consult-man)
             ("M-g M" . consult-mark)
             ("M-g K" . consult-git-grep)
             ("M-g k" . consult-ripgrep)
             ("M-g i" . consult-imenu)
             ("M-g I" . consult-project-imenu)
             ("M-g e" . consult-error)
             ("M-s m" . consult-multi-occur)
             ("M-s o" . consult-outline)
             ("M-y" . consult-yank-pop)
             ("C-s" . isearch-forward)
             ("<help> a" . consult-apropos))

      :custom ((consult-locate-command "locate --ignore-case --regexp ARG OPTS")
               (consult-preview-key (kbd "`"))
               (consult-config '((consult-mark :preview-key any)))
               (consult-narrow-key (kbd "<"))
               (consult-widen-key (kbd ">")))

      :init
      (fset 'multi-occur #'consult-multi-occur)

      :config
      (defun jao-consult-project-root ()
        (expand-file-name (or (jao-compilation-root) (vc-root-dir) "")))

      (setq consult-project-root-function #'jao-consult-project-root)

      (define-key consult-narrow-map (vconcat consult-narrow-key "?")
        #'consult-narrow-help))
   #+end_src
* consultors
*** dh-diff hunks
    #+begin_src emacs-lisp
      (defun jao-consult--diff-lines (&optional backward)
        (let ((candidates)
              (width (length (number-to-string
                              (line-number-at-pos (point-max)
                                                  consult-line-numbers-widen)))))
          (save-excursion
            (while (ignore-errors (diff-hl-next-hunk backward))
              (let* ((str (buffer-substring (line-beginning-position)
                                            (line-end-position)))
                     (no (line-number-at-pos (point)))
                     (no (consult--line-number-prefix (point-marker) no width)))
                (push (concat no str) candidates))))
          (if backward candidates (nreverse candidates))))

      (defun jao-consult-hunks ()
        (interactive)
        (let ((candidates (append (jao-consult--diff-lines)
                                  (jao-consult--diff-lines t))))
          (unless candidates (error "No changes!"))
          (consult--jump
           (consult--read "Go to hunk: " candidates
                          :category 'consult--encode-location
                          :sort nil
                          :require-match t
                          :lookup #'consult--line-match
                          :preview (consult--preview-position)))))

      (with-eval-after-load "consult"
        (add-to-list 'consult-config '(jao-consult-hunks :preview-key any)))
  #+end_src
* embark
*** packages
    #+begin_src emacs-lisp
      (use-package embark
        :ensure t
        :custom ((embark-quit-after-action nil))
        :bind (("C-;" . embark-act)
               (:map minibuffer-local-map
                     (("C-," . embark-become)
                      ("C-o" . embark-export)))))

      (use-package embark-consult
        :ensure t
        :after (embark consult))

      (with-eval-after-load 'consult
        (with-eval-after-load 'embark
          (require 'embark-consult)))
    (require 'embark)
    #+end_src
*** embark action indicator
    #+begin_src emacs-lisp
      (defvar jao-embark--actions-buffer "*Embark Actions*")

      (defvar jao-embark--default-display
        `((,(regexp-quote jao-embark--actions-buffer)
           (display-buffer-at-bottom)
           (window-parameters (mode-line-format . none))
           (window-height . fit-window-to-buffer))))

      (setq jao-embark--excluded
            '(embark-collect-snapshot embark-collect-live embark-export
              embark-become embark-isearch nil))

      (defun jao-embark--bind-desc (descs x)
        (let ((k (car x)) (c (cdr x)))
          (cond ((memq c jao-embark--excluded) descs)
                ((symbolp c)
                 (let* ((desc (if (numberp k)
                                  (single-key-description k)
                                (key-description k)))
                        (desc (format "%s" desc))
                        (doc (car (split-string
                                   (or (ignore-errors (documentation c)) "")
                                   "\n")))
                        (fun (symbol-name c)))
                   (cons (max (length desc) (car descs))
                         (cons (max (length fun) (cadr descs))
                               (cons (list desc fun doc) (cddr descs))))))
                (t descs))))

      (defun jao-embark--keymap-descs (k)
        (seq-reduce #'jao-embark--bind-desc (cdr (keymap-canonicalize k)) '(0 0)))

      (defun jao-embark--dstr (d)
        (let ((s (cadr d))) (if (string-prefix-p "embark" s) "" s)))

      (defun jao-embark--show-keymap (keymap &optional target)
        (with-current-buffer (get-buffer-create jao-embark--actions-buffer)
          (read-only-mode -1)
          (setq-local cursor-type nil)
          (delete-region (point-min) (point-max))
          (let* ((descs (jao-embark--keymap-descs keymap))
                 (fmt (format "%%-%ds  %%-%ds   %%s\n" (cadr descs) (car descs))))
            (seq-each (lambda (desc)
                        (insert (format fmt
                                        (propertize (cadr desc) 'face 'jao-themes-f00)
                                        (propertize (car desc) 'face 'embark-keybinding)
                                        (propertize (caddr desc) 'face 'italic))))
                      (seq-sort-by 'jao-embark--dstr 'string-greaterp (cddr descs))))
          (if target (insert (format "Action for '%s'" target)) (delete-char -1))
          (read-only-mode 1)
          (let ((display-buffer-alist
                 (append display-buffer-alist jao-embark--default-display)))
            (pop-to-buffer (current-buffer) nil t))
          (lambda () (embark-kill-buffer-and-window jao-embark--actions-buffer))))

      (setq embark-action-indicator #'jao-embark--show-keymap
            embark-become-indicator embark-action-indicator)

    #+end_src
*** org targets
    #+begin_src emacs-lisp
      (declare-function org-link-any-re "ol")
      (declare-function org-open-link-from-string "ol")
      (declare-function org-in-regexp "org-macs")

      (defun jao-embark-targets--org-link ()
        (when (derived-mode-p 'org-mode)
          (when (org-in-regexp org-link-any-re)
            (let ((lnk (match-string-no-properties 2)))
              (if (string-match-p "https?://.+" lnk)
                  (cons 'url lnk)
                (cons 'org-link (match-string-no-properties 0)))))))

      (embark-define-keymap jao-embark-targets-org-link-map
        "Actions for org links"
        ((kbd "RET") org-open-link-from-string))

      (add-to-list 'embark-target-finders #'jao-embark-targets--org-link)
      (add-to-list 'embark-keymap-alist '(org-link . jao-embark-targets-org-link-map))
    #+end_src
*** w3m targets
    #+begin_src emacs-lisp
      (declare-function w3m-anchor "w3m")

      (defun jao-embark-targets--w3m-anchor ()
        (when (not (region-active-p))
          (when-let ((url (or (w3m-anchor) w3m-current-url)))
            (when (string-match-p "^https?.*" url)
              (cons 'url url)))))

      (add-to-list 'embark-target-finders #'jao-embark-targets--w3m-anchor)
      (define-key embark-url-map (kbd "f") #'browse-url-firefox)
    #+end_src
*** video url targets
    #+begin_src emacs-lisp
      (defvar jao-embark-targets-video-url-rx
        (format "^https?://\\(?:www\\.\\)?%s/.+"
                (regexp-opt '("youtu.be"
                              "youtube.com"
                              "blip.tv"
                              "vimeo.com"
                              "infoq.com")
                            t))
        "A regular expression matching URLs that point to video streams")

      (defun jao-embark-targets--refine-url (url)
        (if (string-match-p jao-embark-targets-video-url-rx url)
            (cons 'video-url url)
          (cons 'url url)))

      (defun jao-embark-targets--play-video (player url)
        (interactive "sURL: ")
        (let ((cmd (format "%s %s" player (shell-quote-argument url))))
          (start-process-shell-command player nil cmd)))

      (defun jao-embark-targets-mpv (&optional url)
        "Play video stream with mpv"
        (interactive "sURL: ")
        (jao-embark-targets--play-video "mpv" url))

      (defun jao-embark-targets-vlc (&optional url)
        "Play video stream with vlc"
        (interactive "sURL: ")
        (jao-embark-targets--play-video "vlc" url))

      (embark-define-keymap jao-embark-targets-video-url-map
        "Actions on URLs pointing to remote video streams."
        :parent embark-url-map
        ("v" jao-embark-targets-vlc)
        ("m" jao-embark-targets-mpv))

      (add-to-list 'embark-transformer-alist '(url . jao-embark-targets--refine-url))
      (add-to-list 'embark-keymap-alist '(video-url . jao-embark-targets-video-url-map))
    #+end_src
*** embark as selectrum lite
    #+begin_src emacs-lisp
      (defun jao-embark--shrink-selectrum ()
        (when (eq embark-collect--kind :live)
          (with-selected-window (active-minibuffer-window)
            (when (bound-and-true-p selectrum-active-p)
              (setq-local selectrum-num-candidates-displayed 1)))))

      (add-to-list 'display-buffer-alist
                   '("\\`\\*Embark Collect.*\\*"
                     (display-buffer-below-selected)
                     (window-height . 0.25)
                     (window-parameters (mode-line-format . none))))

      (defun jao-embark-select-first-completion ()
        (interactive)
        (embark-switch-to-collect-completions)
        (push-button))

      (defun jao-embark-prescient-candidates ()
        (prescient-sort (cdr (embark-minibuffer-candidates))))

      (defun jao-remember-candidate-on-exit ()
        (prescient-remember (minibuffer-contents)))

      (defun jao-embark-remember-target (_action target &optional _exit)
        (prescient-remember target))

      (defun jao-embark-compui-enable ()
        (interactive)
        (setq completion-styles '(flex initials substring))

        (when (bound-and-true-p selectrum-mode)
          (selectrum-mode -1))
        (push #'jao-embark-prescient-candidates
              embark-candidate-collectors)
        (defalias 'switch-to-completions
          'embark-switch-to-collect-completions)
        (add-hook 'minibuffer-exit-hook
                  #'jao-remember-candidate-on-exit)
        (advice-add 'embark--act :before #'jao-embark-remember-target)
        (define-key minibuffer-local-map (kbd "C-SPC")
          #'embark-collect-completions)
        (define-key minibuffer-local-map (kbd "M-SPC")
          #'embark-collect-completions)
        (define-key minibuffer-local-map (kbd "C-n")
          #'embark-switch-to-collect-completions)
        (define-key minibuffer-local-map (kbd "RET")
          #'jao-embark-select-first-completion))

      (defun jao-embark-compui-disable ()
        (interactive)
        (setq completion-styles '(basic partial-completion emacs22))
        (remove-hook 'minibuffer-exit-hook
                     #'jao-remember-candidate-on-exit)
        (advice-remove 'embark--act #'jao-embark-remember-target)
        (when (boundp selectrum-mode)
          (define-key minibuffer-local-map (kbd "C-n")
            'selectrum-next-candidate)
          (selectrum-mode 1)))
    #+end_src
* startup
  #+begin_src emacs-lisp
    (selectrum-mode 1)
    (selectrum-prescient-mode 1)
    (prescient-persist-mode 1)
    (marginalia-mode 1)
  #+end_src