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

* 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
* completion styles
*** completion configuration
  #+begin_src emacs-lisp
    (setq tab-always-indent 'complete
          read-extended-command-predicate #'command-completion-default-include-p
          completion-category-defaults nil
          completion-cycle-threshold nil
          completions-detailed t
          completion-show-help nil
          completion-show-inline-help nil
          completion-ignore-case t
          completion-wrap-movement t
          completion-auto-select nil
          completions-format 'one-column
          completion-styles '(basic substring partial-completion emacs22)
          completion-category-overrides
          '((file (styles partial-completion))
            (command (styles initials substring partial-completion))
            (symbol (styles initials substring partial-completion))
            (variable (styles initials substring partial-completion))))

    ;; (setq completions-sort #'jao-completion--sort-by-length-alpha)
    (setq completions-sort #'jao-completion--sort-by-history)

    (defun jao-completion--sort-by-alpha-length (elems)
      (sort elems (lambda (c1 c2)
                    (or (string-version-lessp c1 c2)
                        (< (length c1) (length c2))))))

    (defun jao-completion--sort-by-history (elems)
      (let ((hist (and (not (eq minibuffer-history-variable t))
                       (symbol-value minibuffer-history-variable))))
        (if hist
            (minibuffer--sort-by-position hist elems)
          (jao-completion--sort-by-alpha-length elems))))

  #+end_src
*** crm indicator
    #+begin_src emacs-lisp
      (defun jao-completion--crm-indicator (args)
        "Add prompt indicator to `completing-read-multiple' filter ARGS."
        (cons (concat "[CRM] " (car args)) (cdr args)))
      (advice-add #'completing-read-multiple
                  :filter-args #'jao-completion--crm-indicator)
    #+end_src
*** directory navigation
    #+begin_src emacs-lisp
      (defun jao-completion-backward-updir ()
        "Delete char before point or go up a directory."
        (interactive nil mct-minibuffer-mode)
        (cond ((and (eq (char-before) ?/)
                    (eq (mct--completion-category) 'file))
               (when (string-equal (minibuffer-contents) "~/")
                 (delete-minibuffer-contents)
                 (insert (expand-file-name "~/"))
                 (goto-char (line-end-position)))
               (save-excursion
                 (goto-char (1- (point)))
                 (when (search-backward "/" (minibuffer-prompt-end) t)
                   (delete-region (1+ (point)) (point-max)))))
              (t (call-interactively 'backward-delete-char))))

      (define-key minibuffer-local-filename-completion-map (kbd "DEL")
                  #'jao-completion-backward-updir)
    #+end_src
* orderless
  #+begin_src emacs-lisp
    (use-package orderless
      :ensure t
      :init
      (setq completion-styles '(substring partial-completion orderless))
      :config
      (orderless-define-completion-style orderless+initialism
        (orderless-matching-styles '(orderless-initialism
                                     orderless-prefixes
                                     orderless-literal
                                     orderless-regexp)))
      (setq completion-category-overrides
            '((file (styles partial-completion orderless))
              (command (styles orderless+initialism)))
            orderless-matching-styles
            '(orderless-literal orderless-regexp orderless-prefixes)))

  #+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 'left)
               (marginalia-align-offset 1)
               (marginalia-field-width 200)
               (marginalia-annotators
                '(marginalia-annotators-heavy marginalia-annotators-light nil))
               (marginalia-separator "    ")))

    (marginalia-mode 1)
   #+end_src
* corfu
  #+begin_src emacs-lisp
    (use-package corfu
      :ensure t
      :demand t
      :init (setq corfu-echo-documentation 0.25
                  corfu-cycle t
                  corfu-count 15
                  corfu-quit-no-match t
                  corfu-auto t
                  corfu-commit-predicate nil
                  corfu-preview-current nil
                  corfu-preselect-first t
                  corfu-min-width 20
                  corfu-max-width 100)
      :config

      ;; show eldoc string immediately after accepted completion too
      (with-eval-after-load "eldoc"
        (eldoc-add-command-completions "corfu-"))

      (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)

      (defun jao-corfu--active-p ()
        (and (>= corfu--index 0) (/= corfu--index corfu--preselect)))

      (defun jao-corfu-quit-or-insert ()
        (interactive)
        (if (jao-corfu--active-p) (corfu-insert) (corfu-quit)))

      (defun jao-corfu-quit-or-previous ()
        (interactive)
        (if (jao-corfu--active-p)
            (corfu-previous)
          (corfu-quit)
          (previous-line)))

      :bind (:map corfu-map
                  ("C-<return>" . corfu-insert)
                  ("\r" . jao-corfu-quit-or-insert)
                  ("C-p" . jao-corfu-quit-or-previous)))

    (defun corfu-in-minibuffer ()
      "Enable Corfu in the minibuffer only if Mct/Vertico are not active."
      (unless (or (bound-and-true-p mct--active)
                  (bound-and-true-p vertico--input))
        (corfu-mode 1)))

    (add-hook 'minibuffer-setup-hook #'corfu-in-minibuffer 1)

    (global-corfu-mode 1)

  #+end_src
* vertico
  #+begin_src emacs-lisp
    (use-package vertico
      :ensure t
      :init
      (setq vertico-count 20
            vertico-cycle t
            vertico-resize t
            org-refile-use-outline-path t)

      :config

      (defun jao-vertico--display-candidates (lines)
        (move-overlay vertico--candidates-ov (point-min) (point-min))
        (overlay-put vertico--candidates-ov 'after-string (apply #'concat lines))
        (vertico--resize-window (length lines)))

      (advice-add 'vertico--display-candidates
                  :override #'jao-vertico--display-candidates))

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

   (vertico-mode)

  #+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-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-c L" . consult-locate)
               ;; ("C-h m" . consult-mode-command)
               ("C-c s" . consult-line)
               ("C-x r x" . consult-register)
               ("C-x r b" . consult-bookmark)
               ("C-x C-f" . jao-find-file)
               ("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-preview-key (kbd "`")))

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

        :config

        (defun jao-find-file (arg)
          (interactive "P")
          (call-interactively (if arg 'consult-file-externally 'find-file)))

        (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
*** 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
*** 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)))
      (with-eval-after-load "consult"
        (jao-consult-add-buffer-source 'jao-chat-buffer-source))
    #+end_src

*** exwm
    #+begin_src emacs-lisp :tangle no
      (with-eval-after-load "exwm"
        (defun consult-exwm-preview-fix (&rest _args)
          "Kludge to stop EXWM buffers from stealing focus during Consult previews."
          (when-let ((mini (active-minibuffer-window)))
            (select-window (active-minibuffer-window))))

        (advice-add #'consult--buffer-action :after #'consult-exwm-preview-fix))

    #+end_src
* embark
*** package
    #+begin_src emacs-lisp
      (use-package embark
        :ensure t
        :demand t
        :init
        (setq embark-quit-after-action nil
              embark-indicator #'embark-mixed-indicator
              embark-verbose-indicator-buffer-sections '(bindings)
              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)))

        :bind (("C-;" . embark-act)
               ("C-'" . embark-dwim)
               (: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/say
    #+begin_src emacs-lisp
      (defun jao-say (&optional word)
        (interactive "sWhat? ")
        (shell-command-to-string (format "say %s" word))
        "")

      (define-key embark-identifier-map "D" #'dictionary-search)
      (define-key embark-identifier-map "S" #'jao-say)
    #+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))
      (define-key embark-url-map "v" #'jao-embark-targets-vlc)
      (define-key embark-url-map "V" #'jao-embark-targets-vlc)

    #+end_src
*** spotify
    #+begin_src emacs-lisp
      (with-eval-after-load "consult-spotify"
        (defun jao-consult-spt-play (candidate)
          (when-let (url (espotify-candidate-url candidate))
            (jao-spt-play-uri url)))

        (embark-define-keymap spotify-item-keymap
          "Actions for Spotify search results"
          ("s" jao-consult-spt-play)
          ("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-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))

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

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

      :config
      (defun jao-link-hint-open-link-ext ()
        (interactive)
        (let ((jao-browse-url-function jao-browse-url-external-function))
          (link-hint-open-link)))

      :bind (("C-l" . link-hint-open-link)
             ("C-S-l" . jao-link-hint-open-link-ext)
             ("C-x C-l" . recenter-top-bottom)))

  #+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\\|.emacs.d/gnus/Mail\\|var/mail\\)/" "" u)))
        (format "%s (%s, %s)"
                title
                (propertize u 'face 'jao-themes-f00)
                (propertize mtype 'face 'jao-themes-f01))))

    (defun jao-recoll-open-html (file)
      (jao-afio--goto-www)
      (eww-open-file file))

    (defun jao-recoll-consult-messages ()
      (interactive)
      (consult-recoll "mime:message "))

    (defun jao-recoll-consult-docs ()
      (interactive)
      (consult-recoll (format "dir:%s/doc " jao-org-dir)))

    (defun jao-recoll-messages ()
      (interactive)
      (jao-recoll "mime:message "))

    (defun jao-recoll-docs ()
      (interactive)
      (jao-recoll (format "dir:%s/doc " jao-org-dir)))

    (defun jao-recoll-notes ()
      "Use consult-recoll to search notes."
      (interactive)
      (jao-recoll (format "dir:%s " jao-org-notes-dir)))

    (defun jao-recoll-open-with-notmuch (fname)
      (let ((id (with-temp-buffer
                  (insert-file fname)
                  (goto-char (point-min))
                  (when (re-search-forward "[Mm]essage-[Ii][Dd]: <?\\([^><]+\\)>?"
                                           nil t)
                    (match-string 1)))))
        (when id (notmuch-show (concat "id:" id)))))

    (use-package consult-recoll
      :init (setq consult-recoll-open-fns
                  '(("application/pdf" . jao-open-doc)
                    ("message/rfc822" . jao-recoll-open-with-notmuch)
                    ("text/html" . jao-recoll-open-html))
                  consult-recoll-search-flags nil
                  consult-recoll-format-candidate #'jao-recoll-format)
      :config
      (transient-define-prefix jao-recoll-transient ()
        [["Consult recoll queries"
          ("r" "consult recoll query" consult-recoll)
          ("n" "consult recoll on notes" jao-org-notes-consult-recoll)
          ("d" "consult recoll on docs" jao-recoll-consult-docs)
          ("m" "consult recoll on messages" jao-recoll-consult-messages)]
         ["Recoll queries"
          ("R" "recoll query" jao-recoll)
          ("N" "recoll on notes" jao-recoll-notes)
          ("D" "consult recoll on docs" jao-recoll-docs)
          ("M" "consult recoll on messages" jao-recoll-messages)]])

      :bind (("s-r" . #'jao-recoll-transient)))

  #+end_src