path: root/custom/jao-custom-completion.el

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

;;; imenu
(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))
          ((derived-mode-p 'outline-mode) (outline-show-entry))))
  (add-hook 'imenu-after-jump-hook #'jao-imenu-hook))

;;; completion styles
;;;; completion configuration
(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))))

;;;; 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
  :init
  :config
  (orderless-define-completion-style orderless+initialism
    (orderless-matching-styles '(orderless-initialism
                                 orderless-prefixes
                                 orderless-literal
                                 orderless-regexp)))

  (defun jao-orderless--set-locally ()
    (setq-local completion-styles
                '(substring partial-completion orderless)

                completion-category-overrides
                '((file (styles partial-completion orderless))
                  (command (styles orderless+initialism)))
                orderless-matching-styles
                '(orderless-literal orderless-regexp orderless-prefixes)))
  (add-hook 'minibuffer-setup-hook #'jao-orderless--set-locally))

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

;;; company
(use-package company
  :ensure t
  :custom ((company-backends '(company-capf
                               ;; company-bbdb
                               company-files
                               company-dabbrev
                               company-keywords))
           (company-global-modes '(not slack-message-buffer-mode
                                       circe-channel-mode
                                       telega-chat-mode))
           (company-format-margin-function nil) ;; #'company-text-icons-margin
           (company-idle-delay 0.2)
           (company-lighter "")
           (company-lighter-base "")
           (company-show-numbers nil)
           (company-selection-wrap-around t)
           (company-tooltip-limit 15)
           (company-tooltip-align-annotations t)
           (company-tooltip-offset-display 'lines)) ;; 'scrollbar

  :config
  (defun jao-complete-at-point ()
    "Complete using company unless we're in the minibuffer."
    (interactive)
    (if (or (not company-mode) (window-minibuffer-p))
        (completion-at-point)
      (company-manual-begin)))

  (defun jao-company-use-in-tab ()
    (global-set-key [remap completion-at-point] #'jao-complete-at-point)
    (global-set-key [remap completion-symbol] #'jao-complete-at-point)
    (global-set-key (kbd "M-TAB") #'jao-complete-at-point))

  (jao-company-use-in-tab)

  :bind (:map company-active-map

         ("<tab>" . company-complete-common-or-cycle)
         ("TAB" . company-complete-common-or-cycle)

         ("C-h" . company-show-doc-buffer)
         ("M-." . company-show-location)
         ("C-<return>" . company-complete-selection)
         ([remap return] . company-abort)
         ("RET" . company-abort)

         :filter (or (not (derived-mode-p 'eshell-mode))
                     (company-explicit-action-p))
         ("<return>" . company-complete-selection)
         ("RET" . company-complete-selection))
  :diminish)

(unless (display-graphic-p) (global-company-mode 1))

;;; corfu
(use-package corfu
  :ensure 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--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 ()
  (when (not (bound-and-true-p vertico--input)) (corfu-mode 1)))

(when (display-graphic-p)
  (add-hook 'minibuffer-setup-hook #'corfu-in-minibuffer 1)
  (global-corfu-mode 1))

;;; vertico
(use-package vertico
  :ensure t
  :init
  (setq vertico-count 20
        vertico-cycle t
        vertico-resize t
        org-refile-use-outline-path t)

  :config

  ;; (setq completion-in-region-function
  ;;       (lambda (&rest args)
  ;;         (apply (if (and (not window-system) vertico-mode)
  ;;                    #'consult-completion-in-region
  ;;                  #'completion--in-region)
  ;;                args)))

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

(vertico-mode)

;;; consult
;;;; package
(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 o" . consult-outline)
         ("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-o" . consult-outline)
         ;; ("M-i" . consult-imenu)
         ("M-y" . consult-yank-pop)
         ("C-s" . isearch-forward)
         ("<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))

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

;;; embark
;;;; package
(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 t
        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-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)
    (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))

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

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

;;;; vc targets
(use-package embark-vc :ensure t)
;;; 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)

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

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