path: root/consult.org

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

* completion styles: orderless
  #+begin_src emacs-lisp
    (use-package orderless
      :ensure t
      :custom ((completion-styles '(orderless))
               (orderless-matching-styles
                '(orderless-regexp orderless-initialism orderless-literal)))
      :init
      :bind
      ((:map minibuffer-local-completion-map ("SPC" . self-insert-command))))
  #+end_src
* prescient
  #+begin_src emacs-lisp :load no
    (use-package prescient
      :ensure t
      :custom ((prescient-sort-full-matches-first t)))

    (use-package selectrum-prescient :ensure t)
  #+end_src
* selectrum
  #+begin_src emacs-lisp
    (use-package selectrum
      :ensure t
      :custom ((selectrum-complete-in-buffer t)
               (selectrum-extend-current-candidate-highlight t)
               (selectrum-fix-vertical-window-height nil)
               (selectrum-max-window-height 20)
               (selectrum-show-indices nil)
               (selectrum-count-style 'current/matches)) ;; 'matches
      :bind (("C-R" . selectrum-repeat)))
  #+end_src
* marginalia
  #+begin_src emacs-lisp
    (use-package marginalia
      :ensure t
      :bind (:map minibuffer-local-map ("C-M-a" . marginalia-cycle))

      :custom ((marginalia-align-offset 1)
               (marginalia-margin-threshold 200)
               (marginalia-separator-threshold 120)
               (marginalia-truncate-width 80)
               (marginalia-annotators
                '(marginalia-annotators-heavy marginalia-annotators-light nil))))
   #+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" . project-find-file)
             ("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))))

      :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
*** notmuch
    #+begin_src emacs-lisp
      (jao-load-path "consult-notmuch")
      (use-package consult-notmuch
        :config
        (add-to-list 'consult-config '(consult-notmuch :preview-key any)))
    #+end_src
*** recoll
    #+begin_src emacs-lisp
      (jao-load-path "consult-recoll")

      (defun jao-recoll-format (title url mtype)
        (let* ((u (replace-regexp-in-string "/home/jao/" "" url))
               (u (replace-regexp-in-string "\\(doc\\|org/doc\\|var/mail\\)/" "" u)))
          (format "%s (%s, %s)"
                  title
                  (propertize u 'face 'jao-themes-f00)
                  (propertize mtype 'face 'jao-themes-f01))))

      (use-package consult-recoll
        :init (setq consult-recoll-open-fns
                    '(("application/pdf" . jao-open-doc)
                      ("message/rfc822" . jao-org-links-open-mail))
                    consult-recoll-format-candidate #'jao-recoll-format)
        :bind (("C-c R" . #'consult-recoll)))

    #+end_src
*** 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)
                 (prefix-help-command #'embark-prefix-help-command))
        :bind (("C-;" . embark-act)
               ("C-'" . embark-default-action)
               (:map minibuffer-local-map
                     (("C-'" . embark-default-action)
                      ("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-keymap-help embark-become embark-isearch nil))

      (defun jao-embark--key-str (k)
        (if (numberp k) (single-key-description k) (key-description k)))

      (defun jao-embark--bind-desc (descs x prefix)
        (let ((k (car x)) (c (cdr x)))
          (cond ((keymapp c)
                 (let ((cds (jao-embark--keymap-descs c (jao-embark--key-str k))))
                   (cons (max (or (car cds) 0) (or (car descs) 0))
                         (cons (max (or (cadr cds) 0) (or (cadr descs) 0))
                               (append (cddr descs) (cddr cds))))))
                ((memq c jao-embark--excluded) descs)
                ((symbolp c)
                 (let* ((desc (jao-embark--key-str k))
                        (desc (format "%s%s" (or prefix "") 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 (message "i've skipped %S" x) descs))))

      (defun jao-embark--keymap-descs (k prefix)
        (seq-reduce `(lambda (descs x) (jao-embark--bind-desc descs x ,prefix))
                    (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 "\nAction 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)
            (when selectrum-active-p (select-window (minibuffer-window))))))

      (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?://.+" (or 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
*** url 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 (and (derived-mode-p 'w3m-mode)
                                   (or (w3m-anchor) w3m-current-url))
                              (and (derived-mode-p 'eww-mode)
                                   (jao-eww-buffer-url)))))
            (when (string-match-p "^https?.*" url)
              (cons 'url url)))))

      (add-to-list 'embark-target-finders #'jao-embark-targets--w3m-anchor)

      (defun jao-embark-url (url)
        "Browse URL, externally if we're already in emacs-w3m"
        (if (derived-mode-p 'w3m-mode 'eww-mode)
            (jao-browse-with-external-browser url)
          (browse-url url)))

      (define-key embark-url-map (kbd "RET") #'jao-embark-url)
      (define-key embark-url-map (kbd "f") #'browse-url-firefox)
      (define-key embark-url-map (kbd "m") 'jao-browse-with-external-browser)
    #+end_src
*** video url targets
    #+begin_src emacs-lisp
      (defvar jao-embark-targets-video-sites
        '("youtu.be" "youtube.com" "blip.tv" "vimeo.com" "infoq.com"))

      (defun jao-embark--video-url-rx (&optional sites)
        (format "^https?://\\(?:www\\.\\)?%s/.+"
                (regexp-opt (or sites jao-embark-targets-video-sites) t)))

      (defvar jao-embark-targets-video-url-rx (jao-embark--video-url-rx)
        "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
        ("RET" jao-embark-targets-mpv)
        ("v" jao-embark-targets-vlc))

      (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
* startup
  #+begin_src emacs-lisp
    ;; Use prescient, but only for sorting:
    ;; (setq selectrum-prescient-enable-filtering nil)
    ;; (selectrum-prescient-mode 1)
    ;; (prescient-persist-mode 1)

    ;; Highlighting only the visible matches:
    (setq orderless-skip-highlighting (lambda () selectrum-is-active))
    (setq selectrum-highlight-candidates-function #'orderless-highlight-matches)
    (add-hook 'after-init-hook #'selectrum-mode)
    (add-hook 'after-init-hook #'marginalia-mode)
  #+end_src