capf-autosuggest.el

   1 ;;; capf-autosuggest.el --- Show first completion-at-point as an overlay -*- lexical-binding: t; -*-
   2
   3 ;; Filename: capf-autosuggest.el
   4 ;; Description: Mitigate frame creation performance.
   5 ;; Author: jakanakaevangeli <jakanakaevangeli@chiru.no>
   6 ;; Created: 2021-04-23
   7 ;; Version: 1.0
   8 ;; Keywords: frames
   9 ;; URL: https://github.com/jakanakaevangeli/emacs-capf-autosuggest
  10
  11 ;; This file is not part of GNU Emacs.
  12
  13 ;; This program is free software: you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation, either version 3 of the License, or
  16 ;; (at your option) any later version.
  17
  18 ;; This program is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  25
  26 ;;; Commentary:
  27
  28 ;;; Code:
  29
  30 (eval-when-compile (require 'subr-x))
  31
  32 (defface capf-autosuggest-face '((t :inherit file-name-shadow))
  33   "Face used for auto suggestions."
  34   :group 'completion)
  35
  36 (defvar-local capf-autosuggest-capf t
  37   "`completion-at-point-functions', used by capf-autossugest.
  38 If t, capf-autosuggest will use `completion-at-point-functions', otherwise it
  39 will use this variable.")
  40
  41 (defvar capf-autosuggest-all-completions-only-one nil
  42   "Non-nil if only the first result of `all-completions' is of interest.
  43 capf-autosuggest binds this to t around calls to `all-completions'. A dynamic
  44 completion table can take this as a hint to only return a list of one element
  45 for optimization.")
  46
  47 (defvar-local capf-autosuggest--overlay nil)
  48 (defvar-local capf-autosuggest--str "")
  49 (defvar-local capf-autosuggest--region '(nil)
  50   "Region of `completion-at-point'.")
  51
  52 ;;;###autoload
  53 (defmacro capf-autosuggest-define-partial-accept-cmd (name command)
  54   "Define a command NAME.
  55 It will call COMMAND interactively, allowing it to move point
  56 into an auto-suggested overlay. COMMAND must not modify buffer.
  57 NAME must not be called if `capf-autosuggest-active-mode' in
  58 inactive. Usually, NAME is bound in
  59 `capf-autosuggest-active-mode-map'."
  60   `(defun ,name ()
  61      ,(format "`%s', possibly moving point into an auto-suggested overlay."
  62               command)
  63      (interactive)
  64      (capf-autosuggest-call-partial-accept-cmd #',command)))
  65
  66 (defun capf-autosuggest-call-partial-accept-cmd (command)
  67   "Call COMMAND interactively, stepping into auto-suggested overlay.
  68 Temporarily convert the overlay to buffer text and call COMMAND
  69 interactively. Afterwards, the added text is deleted, but only
  70 the portion after point. Additionally, if the point is outside of
  71 the added text, the whole text is deleted."
  72   (let (beg end text)
  73     (with-silent-modifications
  74       (catch 'cancel-atomic-change
  75         (atomic-change-group
  76           (save-excursion
  77             (goto-char (overlay-start capf-autosuggest--overlay))
  78             (setq beg (point))
  79             (insert capf-autosuggest--str)
  80             (setq end (point)))
  81           (call-interactively command)
  82           (and (> (point) beg)
  83                (<= (point) end)
  84                (setq text (buffer-substring beg (point))))
  85           (throw 'cancel-atomic-change nil))))
  86     (when text
  87       (if (= (point) beg)
  88           (insert text)
  89         (save-excursion
  90           (goto-char beg)
  91           (insert text))))))
  92
  93 (defvar capf-autosuggest-active-mode)
  94
  95 (defun capf-autosuggest--post-h ()
  96   "Create an auto-suggest overlay.
  97 Remove text inserted by `capf-autosuggest--pre-h', but only from
  98 point forward."
  99   (if completion-in-region-mode
 100       (capf-autosuggest-active-mode -1)
 101     (when capf-autosuggest-active-mode
 102       (unless (< (car capf-autosuggest--region) (point)
 103                  (cdr capf-autosuggest--region))
 104         (capf-autosuggest-active-mode -1)))
 105
 106     (unless capf-autosuggest-active-mode
 107       (pcase (run-hook-wrapped (if (eq capf-autosuggest-capf t)
 108                                    'completion-at-point-functions
 109                                  'capf-autosuggest-capf)
 110                                #'completion--capf-wrapper 'all)
 111         (`(,_fun ,beg ,end ,table . ,plist)
 112          (let* ((pred (plist-get plist :predicate))
 113                 (string (buffer-substring-no-properties beg end))
 114                 (base (car (completion-boundaries string table pred ""))))
 115            (when-let*
 116                ((completions
 117                  (let ((capf-autosuggest-all-completions-only-one t))
 118                    ;; Use `all-completions' rather than
 119                    ;; `completion-all-completions' to bypass completion styles
 120                    ;; and strictly match only on prefix. This makes sense here
 121                    ;; as we only use the string without the prefix for the
 122                    ;; overlay.
 123                    (all-completions string table pred)))
 124                 ;; `all-completions' may return strings that don't strictly
 125                 ;; match on our prefix. Ignore them.
 126                 ((string-prefix-p (substring string base) (car completions)))
 127                 (str (substring (car completions) (- end beg base)))
 128                 ((/= 0 (length str))))
 129              (setq capf-autosuggest--region (cons beg end)
 130                    capf-autosuggest--str (copy-sequence str))
 131              (move-overlay capf-autosuggest--overlay end end)
 132              (when (eq ?\n (aref str 0))
 133                (setq str (concat " " str)))
 134              (add-text-properties 0 1 (list 'cursor (length str)) str)
 135              (add-face-text-property 0 (length str) 'capf-autosuggest-face t str)
 136              (overlay-put capf-autosuggest--overlay 'after-string str)
 137              (capf-autosuggest-active-mode))))))))
 138
 139 ;;;###autoload
 140 (define-minor-mode capf-autosuggest-mode
 141   "Auto-suggest first completion at point with an overlay."
 142   :group 'completion
 143   (if capf-autosuggest-mode
 144       (progn
 145         (setq capf-autosuggest--overlay (make-overlay (point) (point) nil t t))
 146         (add-hook 'post-command-hook #'capf-autosuggest--post-h nil t)
 147         (add-hook 'completion-in-region-mode-hook #'capf-autosuggest--post-h nil t))
 148     (remove-hook 'post-command-hook #'capf-autosuggest--post-h t)
 149     (remove-hook 'completion-in-region-mode-hook #'capf-autosuggest--post-h t)
 150     (capf-autosuggest-active-mode -1)))
 151
 152 (declare-function evil-forward-char "ext:evil-commands" nil t)
 153 (declare-function evil-end-of-line "ext:evil-commands" nil t)
 154 (declare-function evil-end-of-visual-line "ext:evil-commands" nil t)
 155 (declare-function evil-end-of-line-or-visual-line "ext:evil-commands" nil t)
 156 (declare-function evil-middle-of-visual-line "ext:evil-commands" nil t)
 157 (declare-function evil-last-non-blank "ext:evil-commands" nil t)
 158 (declare-function evil-forward-word-begin "ext:evil-commands" nil t)
 159 (declare-function evil-forward-word-end "ext:evil-commands" nil t)
 160 (declare-function evil-forward-WORD-begin "ext:evil-commands" nil t)
 161 (declare-function evil-forward-WORD-end "ext:evil-commands" nil t)
 162
 163 (capf-autosuggest-define-partial-accept-cmd capf-autosuggest-forward-word forward-word)
 164 (capf-autosuggest-define-partial-accept-cmd capf-autosuggest-forward-char forward-char)
 165 (capf-autosuggest-define-partial-accept-cmd capf-autosuggest-end-of-line end-of-line)
 166 (capf-autosuggest-define-partial-accept-cmd capf-autosuggest-move-end-of-line move-end-of-line)
 167 (capf-autosuggest-define-partial-accept-cmd capf-autosuggest-end-of-visual-line end-of-visual-line)
 168 (capf-autosuggest-define-partial-accept-cmd capf-autosuggest-evil-forward-char evil-forward-char)
 169 (capf-autosuggest-define-partial-accept-cmd capf-autosuggest-evil-end-of-line evil-end-of-line)
 170 (capf-autosuggest-define-partial-accept-cmd capf-autosuggest-evil-end-of-visual-line evil-end-of-visual-line)
 171 (capf-autosuggest-define-partial-accept-cmd capf-autosuggest-evil-end-of-line-or-visual-line evil-end-of-line-or-visual-line)
 172 (capf-autosuggest-define-partial-accept-cmd capf-autosuggest-evil-middle-of-visual-line evil-middle-of-visual-line)
 173 (capf-autosuggest-define-partial-accept-cmd capf-autosuggest-evil-last-non-blank evil-last-non-blank)
 174 (capf-autosuggest-define-partial-accept-cmd capf-autosuggest-evil-forward-word-begin evil-forward-word-begin)
 175 (capf-autosuggest-define-partial-accept-cmd capf-autosuggest-evil-forward-word-end evil-forward-word-end)
 176 (capf-autosuggest-define-partial-accept-cmd capf-autosuggest-evil-forward-WORD-begin evil-forward-WORD-begin)
 177 (capf-autosuggest-define-partial-accept-cmd capf-autosuggest-evil-forward-WORD-end evil-forward-WORD-end)
 178
 179 (defvar capf-autosuggest-active-mode-map
 180   (let ((map (make-sparse-keymap)))
 181     (define-key map [remap forward-word] #'capf-autosuggest-forward-word)
 182     (define-key map [remap forward-char] #'capf-autosuggest-forward-char)
 183     (define-key map [remap end-of-line] #'capf-autosuggest-end-of-line)
 184     (define-key map [remap move-end-of-line] #'capf-autosuggest-move-end-of-line)
 185     (define-key map [remap end-of-visual-line] #'capf-autosuggest-end-of-visual-line)
 186     (define-key map [remap evil-forward-char] #'capf-autosuggest-evil-forward-char)
 187     (define-key map [remap evil-end-of-line] #'capf-autosuggest-evil-end-of-line)
 188     (define-key map [remap evil-end-of-visual-line] #'capf-autosuggest-evil-end-of-visual-line)
 189     (define-key map [remap evil-end-of-line-or-visual-line] #'capf-autosuggest-evil-end-of-line-or-visual-line)
 190     (define-key map [remap evil-middle-of-visual-line] #'capf-autosuggest-evil-middle-of-visual-line)
 191     (define-key map [remap evil-last-non-blank] #'capf-autosuggest-evil-last-non-blank)
 192     (define-key map [remap evil-forward-word-begin] #'capf-autosuggest-evil-forward-word-begin)
 193     (define-key map [remap evil-forward-word-end] #'capf-autosuggest-evil-forward-word-end)
 194     (define-key map [remap evil-forward-WORD-begin] #'capf-autosuggest-evil-forward-WORD-begin)
 195     (define-key map [remap evil-forward-WORD-end] #'capf-autosuggest-evil-forward-WORD-end)
 196     map)
 197   "Keymap active when an auto-suggestion is shown.")
 198
 199 (defun capf-autosuggest-accept ()
 200   "Accept current auto-suggestion."
 201   (interactive)
 202   (capf-autosuggest-call-partial-accept-cmd
 203    (lambda ()
 204      (interactive)
 205      (goto-char (overlay-start capf-autosuggest--overlay)))))
 206
 207 (defun capf-autosuggest--active-acf (beg end _length)
 208   "Deactivate auto-suggestion on completion region changes."
 209   ;; `identity' is used to generate slightly faster byte-code
 210   (when (pcase-let ((`(,beg1 . ,end1) (identity capf-autosuggest--region)))
 211           (if (< beg beg1)
 212               (>= end beg1)
 213             (<= beg end1)))
 214     (capf-autosuggest-active-mode -1)))
 215
 216 (define-minor-mode capf-autosuggest-active-mode
 217   "Active when auto-suggested overlay is shown."
 218   :group 'completion
 219   (if capf-autosuggest-active-mode
 220       (add-hook 'after-change-functions #'capf-autosuggest--active-acf nil t)
 221     (remove-hook 'after-change-functions #'capf-autosuggest--active-acf t)
 222     (delete-overlay capf-autosuggest--overlay)))
 223
 224 (provide 'capf-autosuggest)
 225 ;;; capf-autosuggest.el ends here