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

* completion styles
  #+begin_src emacs-lisp
    (use-package emacs
      :init
      (setq completion-category-defaults nil
            completion-cycle-threshold 3
            completion-category-overrides
            '((file (styles . (partial-completion))))))
  #+end_src
* orderless
  #+begin_src emacs-lisp
    (use-package orderless
      :ensure t
      :init
      (setq completion-styles '(orderless)
            orderless-skip-highlighting t
            orderless-component-separator "[ -/]+"
            orderless-matching-styles
            '(orderless-literal orderless-regexp orderless-initialism)))
  #+end_src
* corfu
  #+begin_src emacs-lisp
    (use-package emacs
      :init (setq tab-always-indent 'complete))

    (use-package dabbrev
        ;; Swap M-/ and C-M-/
      :bind (("M-/" . dabbrev-completion)
             ("C-M-/" . dabbrev-expand)))

    (use-package corfu
      :ensure t
      :init (setq corfu-cycle t
                  corfu-min-width 20
                  corfu-max-width 100)
      :bind (:map corfu-map
             ("TAB" . corfu-next)
             ("S-TAB" . corfu-previous)))

    (corfu-global-mode)
  #+end_src
* vertico
  #+begin_src emacs-lisp
    (use-package vertico
      :ensure t
      :init (setq vertico-count 20
                  vertico-cycle t)

      :config
      ;; (defun jao--be-orderless (&rest _any)
      ;;   (setq-local completion-styles '(orderless)))
      ;; (unless (eq completion-styles '(orderless))
      ;;   (advice-add 'vertico--setup :before #'jao--be-orderless))

      (vertico-mode))
  #+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))))
    (marginalia-mode 1)
   #+end_src
* consult
*** package
    #+begin_src emacs-lisp
      (use-package consult
        :ensure t
        :bind (("C-x M-:" . consult-complex-command)
               ("C-x b" . consult-buffer)
               ("C-x C-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 I" . consult-project-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 m" . consult-mark)
               ("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)
               ("C-S-s" . consult-line)
               ("<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
        (require 'jao-compilation)
        (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
*** 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 candidates
                          :prompt "Go to hunk: "
                          :category 'consult--encode-location
                          :sort nil
                          :require-match t
                          :lookup #'consult--line-match
                          :state (consult--jump-state)))))

      (with-eval-after-load "consult"
        (add-to-list 'consult-config '(jao-consult-hunks :preview-key any))
        (global-set-key (kbd "C-x v c") #'jao-consult-hunks))
  #+end_src
*** narrowing w3m buffers
    #+begin_src emacs-lisp
      (with-eval-after-load "w3m"
        (defvar jao-consult-w3m-buffer-history nil)
        (setq jao-consult-w3m-source
          (list :name "w3m buffer"
                :category 'w3m-buffer
                :hidden t
                :narrow (cons ?w "w3m")
                :annotate (lambda (b) (get-text-property 0 'url b))
                :history 'jao-consult-w3m-buffer-history
                :action (lambda (b)
                          (jao-afio--goto-www)
                          (switch-to-buffer (get-text-property 0 'buffer b)))
                :items (lambda ()
                         (seq-map (lambda (b)
                                    (with-current-buffer b
                                      (propertize w3m-current-title
                                                  'buffer b
                                                  'url w3m-current-url)))
                                  (w3m-list-buffers)))))

        (defun jao-consult-initial-narrow ()
          (when (and (eq this-command #'consult-buffer)
                     (string-equal "Web" (jao-afio-current-frame)))
            (setq unread-command-events
                  (append unread-command-events (list ?w 32)))))

        (add-hook 'minibuffer-setup-hook #'jao-consult-initial-narrow)
        (add-to-list 'consult-buffer-sources 'jao-consult-w3m-source 'append))
    #+end_src
* embark
*** packages
    #+begin_src emacs-lisp
      (use-package embark
        :ensure t
        :custom ((embark-quit-after-action nil)
                 (prefix-help-command #'describe-prefix-bindings
                  ;; #'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 (or (bound-and-true-p selectrum-is-active)
                      (bound-and-true-p current-minibuffer-command))
              (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)
                                   (or (thing-at-point 'url) (eww-current-url)))
                              (jao-url-around-point))))
            (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 "e") #'jao-eww-browse-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
*** spotify
    #+begin_src emacs-lisp
      (with-eval-after-load "consult-spotify"
        (embark-define-keymap spotify-item-keymap
          "Actions for Spotify search results"
          ("y" espotify-yank-candidate-url)
          ("a" espotify-play-candidate-album)
          ("h" espotify-show-candidate-info))

        (add-to-list 'embark-keymap-alist
                     '(spotify-search-item . spotify-item-keymap)))
    #+end_src