path: root/completion.org

#+property: header-args :lexical t :tangle yes :comments yes :results silent :shebang ";; -*- lexical-binding: t -*-" :tangle-mode (identity #o644)
#+title: Completion configuration
#+auto_tangle: t

* completion styles
  #+begin_src emacs-lisp
    (use-package emacs
      :init
      (setq completion-category-defaults nil
            completion-cycle-threshold nil
            completions-detailed t
            completion-show-inline-help nil
            completion-ignore-case t
            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 nil
            orderless-component-separator "[ -/]+"
            orderless-matching-styles
            '(orderless-literal orderless-regexp orderless-initialism)))
  #+end_src
* corfu
  #+begin_src emacs-lisp
    (use-package corfu
      :ensure t
      :demand t
      :init (setq tab-always-indent t ;; 'complete
                  corfu-echo-documentation 0.25
                  corfu-cycle t
                  corfu-count 15
                  corfu-quit-no-match t
                  corfu-auto t
                  corfu-commit-predicate nil
                  corfu-min-width 20
                  corfu-max-width 100)
      :config
      (defun jao-corfu-enable-no-auto ()
        (setq-local corfu-auto nil)
        (corfu-mode 1))

      (defmacro jao-corfu-no-auto (mode)
        (let ((mode-name (intern (format "%s-mode" mode)))
              (hook-name (intern (format "%s-mode-hook" mode))))
          `(with-eval-after-load ',mode
             (add-to-list 'corfu-excluded-modes ',mode-name)
             (add-hook ',hook-name #'jao-corfu-enable-no-auto))))

      (jao-corfu-no-auto eshell)
      (add-to-list 'corfu-excluded-modes 'notmuch-message-mode)

      :bind (:map corfu-map ("C-<return>" . newline)))

    (corfu-global-mode 1)

  #+end_src
* vertico
  #+begin_src emacs-lisp
    (jao-load-path "vertico/extensions")
    (use-package vertico-directory
      :after vertico)

    (use-package vertico-repeat
      :after vertico
      :config (add-hook 'minibuffer-setup-hook #'vertico-repeat-save)
      :bind (("M-R" . vertico-repeat)))

    (use-package vertico
      :ensure t
      :init
      (setq vertico-count 20
            vertico-cycle t
            vertico-group-format nil
            org-refile-use-outline-path t)
      :config
      (setq read-extended-command-predicate
            #'command-completion-default-include-p)

      :bind (:map vertico-map (("RET" . vertico-directory-enter)
                               ("M-<backspace>" . vertico-directory-delete-word)
                               ("<backspace>" . vertico-directory-delete-char))))

    (vertico-mode -1)
  #+end_src
* mct
  #+begin_src emacs-lisp
    (use-package mct
      :ensure t
      :init
      (setq mct-remove-shadowed-file-names t
            mct-hide-completion-mode-line nil
            mct-show-completion-line-numbers nil
            mct-apply-completion-stripes nil
            mct-minimum-input 3
            mct-live-completion t
            mct-live-update-delay 0.6
            mct-completion-passlist '(consult-rgrep
                                      imenu
 	                              Info-goto-node
 	                              Info-index
 	                              Info-menu
 	                              vc-retrieve-tag))
      :config
      (defun jao-mct-complete-and-go ()
        "Complete current input, as with `M-e' and accept the candidate."
        (interactive)
        (mct-edit-completion)
        (exit-minibuffer))

      :bind
      (:map mct-minibuffer-local-completion-map
            (("C-<return>" . jao-mct-complete-and-go))))

    (mct-mode 1)
  #+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 100)
               (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-c b" . project-find-file)
               ("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-h 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 "`")))

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

        :config

        (advice-add #'completing-read-multiple
                    :override #'consult-completing-read-multiple)

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

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

        (define-key consult-narrow-map (vconcat consult-narrow-key "?")
          #'consult-narrow-help)

        (consult-customize consult-mark :preview-key 'any)
        (add-hook 'completion-list-mode-hook #'consult-preview-at-point-mode))

    #+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-search-flags nil
                    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"
        (consult-customize '((jao-consult-hunks :preview-key any)))
        (global-set-key (kbd "C-x v c") #'jao-consult-hunks))
  #+end_src
*** narrow helpers
    #+begin_src emacs-lisp
      (defvar jao-consult-narrow nil)

      (defun jao-consult-initial-narrow ()
        (when-let (c (cond ((eq this-command #'consult-buffer)
                            (cdr (assoc (jao-afio-current-frame)
                                        jao-consult-narrow)))
                           ((eq this-command #'consult-mode-command) ?m)))
          (setq unread-command-events (append unread-command-events `(,c 32)))))

      (add-hook 'minibuffer-setup-hook #'jao-consult-initial-narrow)

      (defmacro jao-consult--mode-buffers (&rest modes)
        `(lambda ()
           (seq-map #'buffer-name
                    (seq-filter (lambda (b)
                                  (with-current-buffer b
                                    (derived-mode-p ,@modes)))
                                (buffer-list)))))

      (defun jao-consult-add-buffer-source (src &optional aframe key)
        (add-to-list 'consult-buffer-sources src t)
        (when (and aframe key)
          (add-to-list 'jao-consult-narrow (cons aframe key))))
    #+end_src
*** narrowing chats
    #+begin_src emacs-lisp
      (defvar jao-chat-buffer-source
        (list :name "chats"
              :category 'buffer
              :action #'pop-to-buffer
              :hidden t
              :narrow (cons ?c "chats")
              :items (jao-consult--mode-buffers 'erc-mode
                                                'circe-channel-mode
                                                'circe-query-mode
                                                'signel-chat-mode
                                                'slack-message-buffer-mode
                                                'slack-thread-message-buffer-mode
                                                'telega-root-mode
                                                'telega-chat-mode)))
      (jao-consult-add-buffer-source 'jao-chat-buffer-source)
    #+end_src

* consult dir
  #+begin_src emacs-lisp
    (use-package consult-dir
      :ensure t
      :bind (("C-x C-d" . consult-dir)
             :map minibuffer-local-completion-map
             (("C-x C-d" . consult-dir)
              ("C-x C-j" . consult-dir-jump-file))))
  #+end_src
* embark
*** packages
    #+begin_src emacs-lisp
      (use-package embark
        :ensure t
        :demand t
        :init
        (setq embark-quit-after-action nil
              embark-verbose-indicator-buffer-sections
              '(jao-embark--bindings "\n" target "  " jao-embark--other)
              embark-indicator #'embark-mixed-indicator
              embark-mixed-indicator-both nil
              embark-verbose-indicator-excluded-commands
              '(embark-become embark-export embark-collect)
              embark-verbose-indicator-nested t
              embark-verbose-indicator-display-action
              '((display-buffer-at-bottom)
                (window-parameters (mode-line-format . none))
                (window-height . fit-window-to-buffer)))

        (defvar jao-embark--brx
          "^\\(\\([^ ] \\)+\\|RET\\|TAB\\|SPC\\)\\( *\\)\\([^ ]+ +\\)\\(.*\\)$")

        (defun jao-embark--cmp (x y)
          (let* ((lxk (get-text-property 0 'kbd x))
                 (lyk (get-text-property 0 'kbd y)))
            (if (= lxk lyk) (string< x y) (< lxk lyk))))

        (defun jao-embark--cmd-doc (cmd)
          (propertize (car (split-string (or (embark--function-doc cmd) "") "\n"))
                      'face 'embark-verbose-indicator-documentation))

        (defun jao--max-len (strs)
          (seq-reduce (lambda (m x) (max m (length x))) strs 0))

        (cl-defun jao-embark--other (&key shadowed-targets &allow-other-keys)
          (propertize (format "%s" (or shadowed-targets ""))
                      'face 'embark-verbose-indicator-shadowed))

        (cl-defun jao-embark--bindings (&key bindings &allow-other-keys)
          (let* ((cmds (mapcar #'caddr bindings))
                 (docs (mapcar #'jao-embark--cmd-doc cmds))
                 (keys (mapcar (lambda (b)
                                 (propertize (car (last b))
                                             'face 'embark-keybinding))
                               bindings))
                 (cmds (mapcar (lambda (b)
                                 (propertize (cadr b) 'face 'embark-command))
                               bindings))
                 (fmt (format "%%-%ds   %%-%ds     %%s\n"
                              (jao--max-len cmds) (jao--max-len keys)))
                 (res (seq-mapn (lambda (c k d)
                                  (let ((n (if (string-prefix-p "embark-" c)
                                               10
                                             (length k))))
                                    (propertize (format fmt c k d) 'kbd n)))
                                cmds keys docs)))
            (apply #'concat (seq-sort #'jao-embark--cmp res))))

        :bind (("C-;" . embark-act)
               ("C-'" . embark-dwim)
               ("C-h b" . embark-bindings)
               (:map minibuffer-local-map
                     (("C-'" . embark-dwim)
                      ("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)))

    #+end_src
*** dict
    #+begin_src emacs-lisp
      (define-key embark-identifier-map "D" #'dictionary-search)
    #+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-bracket-re)
            (let ((lnk (match-string-no-properties 1)))
              (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))

      (defun jao-embark-targets--gl-org-link ()
        (when (org-in-regexp org-link-bracket-re)
          (cons 'gl-org-link (match-string-no-properties 0))))

      (embark-define-keymap jao-embark-targets-gl-org-link-map
        "Actions for exteranl org links"
        ((kbd "RET") org-open-at-point-global))

      (add-to-list 'embark-target-finders #'jao-embark-targets--gl-org-link)
      (add-to-list 'embark-keymap-alist
                   '(gl-org-link . jao-embark-targets-gl-org-link-map))

      (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 (jao-url-around-point)
                              (thing-at-point 'url)
                              (and (derived-mode-p 'w3m-mode)
                                   (or (w3m-anchor) w3m-current-url))
                              (and (derived-mode-p 'eww-mode)
                                   (eww-current-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 an emacs browser."
        (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 "x") #'jao-rss-subscribe)
      (define-key embark-url-map (kbd "m") 'jao-browse-with-external-browser)
      (define-key embark-url-map (kbd "p") 'jao-browse-add-url-to-mpc)

    #+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))))
          (jao-afio--goto-www)
          (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)
        ("RET" 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
*** 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
* avy and link hints
  [[https://karthinks.com/software/avy-can-do-anything/][Avy can do anything | Karthinks]]
  #+begin_src emacs-lisp

    (use-package avy
      :ensure t
      :init (setq avy-style 'pre
                  avy-background t
                  avy-timeout-seconds 0.6
                  avy-single-candidate-jump t)

      :config

      (defun avy-dictionary-act (pt)
        "Use dictionary lookup to act on the completion at PT."
        (save-excursion
          (goto-char pt)
          (dictionary-lookup-definition)))
      (add-to-list 'avy-dispatch-alist '(?d . avy-dictionary-act))

      :bind (("C-c a" . avy-goto-char-timer)
             ("s-j" . avy-goto-char-timer)))

    (use-package link-hint
      :ensure t
      :init (setq link-hint-avy-style 'pre)

      :config

      (defun avy-embark-act (pt)
        "Use Embark to act on the completion at PT."
        (save-excursion
          (goto-char pt)
          (embark-act)))
      (add-to-list 'avy-dispatch-alist '(?\; . avy-embark-act))

      (defun embark-on-link (def)
        (interactive "P")
        (let ((unread-command-events '(?\;)))
          (link-hint-open-link)))

      (defun jao-link-hint--notmuch-next-part (&optional bound)
        (when-let (p (next-single-property-change (point) :notmuch-part nil bound))
          (and (< p (or bound (point-max))) p)))

      (defun jao-link-hint--notmuch-part-p ()
        (and (get-text-property (point) :notmuch-part)
             (when-let (b (button-at (point))) (button-label b))))

      (link-hint-define-type 'notmuch-part
        :next #'jao-link-hint--notmuch-next-part
        :at-point-p #'jao-link-hint--notmuch-part-p
        :vars '(notmuch-show-mode)
        :open #'push-button
        :open-message "Toggled"
        :open-multiple t)

      (defun jao-link-hint--notmuch-next-url (&optional bound)
        (link-hint--next-property 'w3m-href-anchor bound))

      (defun jao-link-hint--notmuch-url-at-point ()
        (get-text-property (point) 'w3m-href-anchor))

      (link-hint-define-type 'notmuch-w3m-url
        :next #'jao-link-hint--notmuch-next-url
        :at-point-p #'jao-link-hint--notmuch-url-at-point
        :vars '(notmuch-show-mode)
        :open #'browse-url
        :open-multiple t
        :copy #'kill-new)

      (push 'link-hint-notmuch-part link-hint-types)
      (push 'link-hint-notmuch-w3m-url link-hint-types)

      :bind (("C-l" . link-hint-open-link)
             ("C-S-l" . recenter-top-bottom)
             ("C-c l" . link-hint-open-multiple-links)))

  #+end_src
* imenu
  #+begin_src emacs-lisp
    (use-package imenu
      :init (setq org-imenu-depth 7)
      :config
      (defun jao-imenu-hook ()
        (cond ((derived-mode-p 'org-mode) (org-reveal t))
              (outline-minor-mode (outline-show-entry))))
      (add-hook 'imenu-after-jump-hook #'jao-imenu-hook))
  #+end_src