emacs-config/custom/jao-custom-completion.el

;; -*- lexical-binding: t; -*-

;;; builtin completion
(setq tab-always-indent 'complete
      read-extended-command-predicate #'command-completion-default-include-p
      completion-auto-select 'second-tab
      completion-auto-help 'always
      completion-category-defaults nil
      completion-cycle-threshold 4
      completions-detailed t
      completions-header-format nil
      completion-ignore-case t
      completion-show-help nil
      completion-show-inline-help t
      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)))
      completion-wrap-movement t)

;;; crm indicator
(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)

;;; orderless
(use-package orderless
  :ensure t
  :demand t
  :config
  (orderless-define-completion-style orderless+initialism
    (orderless-matching-styles '(orderless-initialism
                                 orderless-prefixes
                                 orderless-literal
                                 orderless-regexp)))
  (defvar jao-orderless-overrides
    '((file (styles partial-completion orderless))
      (command (styles orderless+initialism))))

  (setq orderless-matching-styles
        '(orderless-literal orderless-regexp orderless-prefixes)))

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

;;; vertico
(use-package vertico
  :ensure t
  :init
  (defvar jao-vertico-reverse t)

  (setq vertico-count 20
        vertico-cycle t
        vertico-resize t
        vertico-multiform-categories nil
        vertico-multiform-commands
        `((".*"
           (completion-styles orderless basic)
           (completion-category-overrides . ,jao-orderless-overrides)))
        vertico-buffer-display-action
        `(display-buffer-below-selected (window-height . 0.5)))

  (dolist (c '(completion-at-point complete-symbol indent-for-tab-command))
    (let ((s `(,c buffer (vertico-resize) (jao-vertico-reverse))))
      (add-to-list 'vertico-multiform-commands s)))

  :config
  (defun jao-vertico--display (fun lines)
    (if (not jao-vertico-reverse)
        (funcall fun lines)
      (move-overlay vertico--candidates-ov (point-min) (point-min))
      (overlay-put vertico--candidates-ov 'after-string (apply #'concat lines))
      (vertico--resize)))

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

(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)
                           ("DEL" . vertico-directory-delete-char))))

(vertico-mode)
(vertico-multiform-mode)

;;; consult
;;;; package
(use-package consult
  :ensure t
  :bind (("C-x M-:" . consult-complex-command)
         ("C-x b" . consult-buffer)
         ("C-x C-b" . switch-to-buffer)
         ("C-x 4 b" . consult-buffer-other-window)
         ("C-c b" . project-find-file)
         ("C-c h" . nil)
         ("C-c i" . consult-imenu)
         ("C-c I" . consult-project-imenu)
         ("C-h I" . consult-info)
         ;; ("C-c o" . consult-outline)
         ("C-c k" . consult-ripgrep)
         ("C-c L" . consult-locate)
         ("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-y" . consult-yank-pop)
         ("C-s" . isearch-forward))

  :custom ((consult-preview-key (kbd "`")))

  :init
  (fset 'multi-occur #'consult-multi-occur)
  (setq org-refile-use-outline-path t
        org-imenu-depth 7)

  :config
  (defun jao-consult--completion-in-region (&rest args)
    (apply (if (and (not (bound-and-true-p corfu-mode))
                    (not (bound-and-true-p company-mode))
                    (bound-and-true-p vertico-mode))
               #'consult-completion-in-region
             #'completion--in-region)
           args))

  (setq completion-in-region-function #'jao-consult--completion-in-region)

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

  (with-eval-after-load "esh-mode"
    (define-key eshell-mode-map (kbd "C-c h") #'consult-history))

  (with-eval-after-load "comint"
    (define-key comint-mode-map (kbd "C-c h") #'consult-history))

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

;;;; consult-dir
;; (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))))

;;;; narrow helpers
(defvar jao-consult-narrow nil)

(defun jao-consult-initial-narrow ()
  (when-let (c (cond ((eq this-command #'consult-buffer)
                      (cdr (assoc (jao-afio-frame-name) 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))))

;;; embark
;;;; package
(use-package embark
  :ensure t
  :demand t
  :init
  (setq embark-quit-after-action nil
        embark-indicators '(embark-mixed-indicator
                            ;; embark-minimal-indicator
                            embark-highlight-indicator
                            embark-isearch-highlight-indicator)
        embark-mixed-indicator-both t
        embark-mixed-indicator-delay 1
        embark-verbose-indicator-buffer-sections '(bindings)
        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)))

  ;; (setq prefix-help-command #'describe-prefix-bindings)
  ;; (add-to-list 'vertico-multiform-categories '(embark-keybinding grid))

  :bind (("C-;" . embark-act)
         ("C-c ;" . embark-act)
         ("C-'" . embark-dwim)
         ("C-c '" . embark-dwim)
         (:map minibuffer-local-map
               (("C-'" . embark-dwim)
                ("C-c '" . embark-dwim)
                ("C-," . embark-become)
                ("C-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)))

;;;; randomsig
(defun jao-random-sig-read (_ignored)
  "Import region as signature and edit it."
  (randomsig-message-read-sig t))

(define-key embark-region-map "m" #'jao-random-sig-read)
(define-key embark-region-map "M" #'apply-macro-to-region-lines)

;;;; dict/say
(defun jao-say (&optional word)
  "Isn't it nice to have a computer that can talk to you?"
  (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)

;;;; org targets
(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)
    (let ((lnk (org-element-property :raw-link (org-element-context))))
      (and lnk (cons 'org-link lnk)))))

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

(defvar jao-embark-targets-gl-org-link-map
  (define-keymap "RET" #'org-open-at-point-global))

(defvar jao-embark-targets-org-link-map
  (define-keymap "RET" #'org-open-link-from-string))

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

;;;; url targets
(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-mpc-add-or-play-url)

;;;; video url targets
(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))

(defvar jao-embark-targets-video-url-map
  (define-keymap "v" #'jao-embark-targets-mpv "RET" #'jao-embark-targets-mpv)
  "Actions on URLs pointing to remote video streams.")

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

;;;; vc targets


;;; avy
(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)
         ("C-M-j" . avy-goto-char-timer)))

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

  :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-M-l" . jao-link-hint-open-link-ext)
         ("C-S-l" . jao-link-hint-open-link-ext)
         ("C-x C-l" . recenter-top-bottom)))

(with-eval-after-load "notmuch"
  (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)

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

;;; xref
(setq xref-show-definitions-function #'xref-show-definitions-completing-read)

;; (use-package dumb-jump
;;   :ensure t
;;   :after xref
;;   :config (add-hook 'xref-backend-functions #'dumb-jump-xref-activate))

;;; .
(provide 'jao-custom-completion)