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: Show first completion-at-point as an overlay
   5 ;; Author: jakanakaevangeli <jakanakaevangeli@chiru.no>
   6 ;; Created: 2021-07-13
   7 ;; Version: 1.0
   8 ;; URL: https://github.com/jakanakaevangeli/emacs-capf-autosuggest
   9
  10 ;; This file is not part of GNU Emacs.
  11
  12 ;; This program is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; This program is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  24
  25 ;;; Commentary:
  26
  27 ;;; Code:
  28
  29 (eval-when-compile (require 'subr-x))
  30
  31 (defface capf-autosuggest-face '((t :inherit file-name-shadow))
  32   "Face used for auto suggestions."
  33   :group 'completion)
  34
  35 (defvar-local capf-autosuggest-capf nil
  36   "`completion-at-point-functions', used by capf-autossugest.
  37 If nil, capf-autosuggest will use
  38 `completion-at-point-functions', otherwise it will use this hook
  39 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 variable `capf-autosuggest-active-mode' is
  58 inactive. NAME is suitable for binding 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 point is outside of the
  71 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   (if completion-in-region-mode
  98       (capf-autosuggest-active-mode -1)
  99     (when capf-autosuggest-active-mode
 100       ;; `identity' is used to generate slightly faster byte-code
 101       (pcase-let ((`(,beg . ,end) (identity capf-autosuggest--region)))
 102         (unless (< beg (point) end)
 103           (capf-autosuggest-active-mode -1))))
 104
 105     (unless capf-autosuggest-active-mode
 106       (pcase (run-hook-wrapped (if capf-autosuggest-capf
 107                                    'capf-autosuggest-capf
 108                                  'completion-at-point-functions)
 109                                #'completion--capf-wrapper 'all)
 110         (`(,_fun ,beg ,end ,table . ,plist)
 111          (let* ((pred (plist-get plist :predicate))
 112                 (string (buffer-substring-no-properties beg end))
 113                 ;; See `completion-emacs21-all-completions'
 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 Do not call this command if variable `capf-autosuggest-active-mode' is
 202 inactive."
 203   (interactive)
 204   (capf-autosuggest-call-partial-accept-cmd
 205    (lambda ()
 206      (interactive)
 207      (goto-char (overlay-start capf-autosuggest--overlay)))))
 208
 209 (defun capf-autosuggest--active-acf (beg end _length)
 210   "Deactivate auto-suggestion on completion region modifications.
 211 BEG and END denote the changed region."
 212   ;; `identity' is used to generate slightly faster byte-code
 213   (when (pcase-let ((`(,beg1 . ,end1) (identity capf-autosuggest--region)))
 214           (if (< beg beg1)
 215               (>= end beg1)
 216             (<= beg end1)))
 217     (capf-autosuggest-active-mode -1)))
 218
 219 (define-minor-mode capf-autosuggest-active-mode
 220   "Active when auto-suggested overlay is shown."
 221   :group 'completion
 222   (if capf-autosuggest-active-mode
 223       (add-hook 'after-change-functions #'capf-autosuggest--active-acf nil t)
 224     (remove-hook 'after-change-functions #'capf-autosuggest--active-acf t)
 225     (delete-overlay capf-autosuggest--overlay)))
 226
 227 (provide 'capf-autosuggest)
 228 ;;; capf-autosuggest.el ends here