584 lines
27 KiB
EmacsLisp
584 lines
27 KiB
EmacsLisp
;;; completion-preview.el --- Preview completion with inline overlay -*- lexical-binding: t; -*-
|
|
|
|
;; Copyright (C) 2023-2024 Free Software Foundation, Inc.
|
|
|
|
;; Author: Eshel Yaron <me@eshelyaron.com>
|
|
;; Maintainer: Eshel Yaron <me@eshelyaron.com>
|
|
;; Keywords: abbrev convenience
|
|
|
|
;; This program is free software; you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
|
|
;; This program is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
|
|
;; This library provides the Completion Preview mode. This minor mode
|
|
;; displays a completion suggestion for the symbol at point in an
|
|
;; overlay after point. Check out the customization group
|
|
;; `completion-preview' for user options that you may want to tweak.
|
|
;;
|
|
;; To enable Completion Preview mode, use `completion-preview-mode'.
|
|
;; To accept the completion suggestion, press TAB. If you want to
|
|
;; ignore a completion suggestion, just go on editing or moving around
|
|
;; the buffer. Completion Preview mode continues to update the
|
|
;; suggestion as you type according to the text around point.
|
|
;;
|
|
;; The commands `completion-preview-next-candidate' and
|
|
;; `completion-preview-prev-candidate' allow you to cycle the
|
|
;; completion candidate that the preview suggests. These commands
|
|
;; don't have a default keybinding, but you can bind them, for
|
|
;; example, to M-n and M-p in `completion-preview-active-mode-map' to
|
|
;; have them handy whenever the preview is visible.
|
|
;;
|
|
;; When the completion candidate that the preview is showing shares a
|
|
;; common prefix with all other candidates, Completion Preview mode
|
|
;; underlines that common prefix. If you want to insert the common
|
|
;; prefix but with a different suffix than the one the preview is
|
|
;; showing, use the command `completion-preview-complete'. This command
|
|
;; inserts just the common prefix and lets you go on typing as usual.
|
|
;; If you invoke `completion-preview-complete' when there is no common
|
|
;; prefix (so nothing is underlined in the preview), it displays a list
|
|
;; of all matching completion candidates.
|
|
;;
|
|
;; If you set the user option `completion-preview-exact-match-only' to
|
|
;; non-nil, Completion Preview mode only suggests a completion
|
|
;; candidate when its the only possible completion for the (partial)
|
|
;; symbol at point. The user option `completion-preview-commands'
|
|
;; says which commands should trigger the completion preview. The
|
|
;; user option `completion-preview-minimum-symbol-length' specifies a
|
|
;; minimum number of consecutive characters with word or symbol syntax
|
|
;; that should appear around point for Emacs to suggest a completion.
|
|
;; By default, this option is set to 3, so Emacs suggests a completion
|
|
;; if you type "foo", but typing just "fo" doesn't show the preview.
|
|
|
|
;;; Code:
|
|
|
|
(defgroup completion-preview nil
|
|
"In-buffer completion preview."
|
|
:group 'completion)
|
|
|
|
(defcustom completion-preview-exact-match-only nil
|
|
"Whether to show completion preview only when there is an exact match.
|
|
|
|
If this option is non-nil, Completion Preview mode only shows the
|
|
preview when there is exactly one completion candidate that
|
|
matches the symbol at point. Otherwise, if this option is nil,
|
|
when there are multiple matching candidates the preview shows the
|
|
first candidate, and you can cycle between the candidates with
|
|
\\[completion-preview-next-candidate] and
|
|
\\[completion-preview-prev-candidate]."
|
|
:type 'boolean
|
|
:version "30.1")
|
|
|
|
(defcustom completion-preview-commands '(self-insert-command
|
|
insert-char
|
|
delete-backward-char
|
|
backward-delete-char-untabify
|
|
analyze-text-conversion
|
|
completion-preview-complete)
|
|
"List of commands that should trigger completion preview."
|
|
:type '(repeat (function :tag "Command" :value self-insert-command))
|
|
:version "30.1")
|
|
|
|
(defcustom completion-preview-minimum-symbol-length 3
|
|
"Minimum length of the symbol at point for showing completion preview."
|
|
:type 'natnum
|
|
:version "30.1")
|
|
|
|
(defcustom completion-preview-message-format
|
|
"Completion suggestion %i out of %n"
|
|
"Message to show after cycling the completion preview suggestion.
|
|
|
|
If the value is a string, `completion-preview-next-candidate' and
|
|
`completion-preview-prev-candidate' display this string in the
|
|
echo area, after substituting \"%i\" with the 1-based index of
|
|
the completion suggestion that the preview is showing, and \"%n\"
|
|
with the total number of available completion suggestions for the
|
|
text around point.
|
|
|
|
If this option is nil, these commands do not display any message."
|
|
:type '(choice (string :tag "Message format")
|
|
(const :tag "No message" nil))
|
|
:version "30.1")
|
|
|
|
(defvar completion-preview-sort-function #'minibuffer--sort-by-length-alpha
|
|
"Sort function to use for choosing a completion candidate to preview.")
|
|
|
|
(defface completion-preview
|
|
'((t :inherit shadow))
|
|
"Face for completion candidates in the completion preview overlay."
|
|
:version "30.1")
|
|
|
|
(defface completion-preview-common
|
|
'((((supports :underline t))
|
|
:underline t :inherit completion-preview)
|
|
(((supports :weight bold))
|
|
:weight bold :inherit completion-preview)
|
|
(t :background "gray"))
|
|
"Face for the longest common prefix in the completion preview."
|
|
:version "30.1")
|
|
|
|
(defface completion-preview-exact
|
|
;; An exact match is also the longest common prefix of all matches.
|
|
'((t :underline "gray25" :inherit completion-preview-common))
|
|
"Face for matches in the completion preview overlay."
|
|
:version "30.1")
|
|
|
|
(defface completion-preview-highlight
|
|
'((t :inherit highlight))
|
|
"Face for highlighting the completion preview when the mouse is over it."
|
|
:version "30.1")
|
|
|
|
(defvar-keymap completion-preview-active-mode-map
|
|
:doc "Keymap for Completion Preview Active mode."
|
|
"C-i" #'completion-preview-insert
|
|
;; FIXME: Should this have another/better binding by default?
|
|
"M-i" #'completion-preview-complete
|
|
;; "M-n" #'completion-preview-next-candidate
|
|
;; "M-p" #'completion-preview-prev-candidate
|
|
)
|
|
|
|
(defun completion-preview--ignore ()
|
|
"Do nothing, including updating the completion preview.
|
|
|
|
This is the same as `ignore', except that Completion Preview mode skips
|
|
hiding or updating the completion preview after this command runs."
|
|
(interactive)
|
|
nil)
|
|
|
|
(put 'completion-preview--ignore 'completion-predicate #'ignore)
|
|
|
|
(defvar-keymap completion-preview--mouse-map
|
|
:doc "Keymap for mouse clicks on the completion preview."
|
|
"<mouse-1>" #'completion-preview-insert
|
|
;; Ignore the corresponding button-down event.
|
|
"<down-mouse-1>" #'completion-preview--ignore
|
|
"C-<mouse-1>" #'completion-preview-complete
|
|
"C-<down-mouse-1>" #'completion-preview--ignore
|
|
"<mouse-2>" #'completion-preview-complete
|
|
"<down-mouse-2>" #'completion-preview--ignore
|
|
"<wheel-up>" #'completion-preview-prev-candidate
|
|
"<wheel-down>" #'completion-preview-next-candidate)
|
|
|
|
(defvar-local completion-preview--overlay nil)
|
|
|
|
(defvar completion-preview--internal-commands
|
|
'(completion-preview-next-candidate
|
|
completion-preview-prev-candidate
|
|
completion-preview--ignore
|
|
;; Don't dismiss or update the preview when the user scrolls.
|
|
mwheel-scroll)
|
|
"List of commands that manipulate the completion preview.
|
|
|
|
Completion Preview mode avoids updating the preview after these commands.")
|
|
|
|
(defvar-local completion-preview--inhibit-update-p nil
|
|
"Whether to inhibit updating the completion preview following this command.")
|
|
|
|
(defsubst completion-preview--inhibit-update ()
|
|
"Inhibit updating the completion preview following this command."
|
|
(setq completion-preview--inhibit-update-p t))
|
|
|
|
(defsubst completion-preview-require-certain-commands ()
|
|
"Check if `this-command' is one of `completion-preview-commands'."
|
|
(memq this-command completion-preview-commands))
|
|
|
|
(defun completion-preview-require-minimum-symbol-length ()
|
|
"Check if the length of symbol at point is at least above a certain threshold.
|
|
`completion-preview-minimum-symbol-length' determines that threshold."
|
|
(let ((bounds (bounds-of-thing-at-point 'symbol)))
|
|
(and bounds (<= completion-preview-minimum-symbol-length
|
|
(- (cdr bounds) (car bounds))))))
|
|
|
|
(defun completion-preview-hide ()
|
|
"Hide the completion preview."
|
|
(when completion-preview--overlay
|
|
(delete-overlay completion-preview--overlay)
|
|
(setq completion-preview--overlay nil
|
|
completion-preview--inhibit-update-p nil)))
|
|
|
|
(defun completion-preview--make-overlay (pos string)
|
|
"Make preview overlay showing STRING at POS, or move existing preview there."
|
|
(if completion-preview--overlay
|
|
(move-overlay completion-preview--overlay pos pos)
|
|
(setq completion-preview--overlay (make-overlay pos pos))
|
|
(overlay-put completion-preview--overlay 'window (selected-window)))
|
|
(add-text-properties 0 1 '(cursor 1) string)
|
|
(overlay-put completion-preview--overlay 'after-string string)
|
|
completion-preview--overlay)
|
|
|
|
(defsubst completion-preview--get (prop)
|
|
"Return property PROP of the completion preview overlay."
|
|
(overlay-get completion-preview--overlay prop))
|
|
|
|
(defun completion-preview--window-selection-change (window)
|
|
"Hide completion preview in WINDOW after switching to another window.
|
|
Completion Preview mode adds this function to
|
|
`window-selection-change-functions', which see."
|
|
(unless (or (eq window (selected-window))
|
|
(eq window (minibuffer-selected-window)))
|
|
(with-current-buffer (window-buffer window)
|
|
(completion-preview-active-mode -1))))
|
|
|
|
(define-minor-mode completion-preview-active-mode
|
|
"Mode for when the completion preview is shown."
|
|
:interactive nil
|
|
(if completion-preview-active-mode
|
|
(add-hook 'window-selection-change-functions
|
|
#'completion-preview--window-selection-change nil t)
|
|
(remove-hook 'window-selection-change-functions
|
|
#'completion-preview--window-selection-change t)
|
|
(completion-preview-hide)))
|
|
|
|
(defvar completion-preview-completion-styles '(basic)
|
|
"List of completion styles that Completion Preview mode uses.
|
|
|
|
Since Completion Preview mode shows prefix completion candidates, this
|
|
list should normally only include completion styles that perform prefix
|
|
completion, but other candidates are filtered out and cause no harm.
|
|
|
|
See also `completion-styles'.")
|
|
|
|
(defun completion-preview--try-table (table beg end props)
|
|
"Check TABLE for a completion matching the text between BEG and END.
|
|
|
|
PROPS is a property list with additional information about TABLE.
|
|
See `completion-at-point-functions' for more details.
|
|
|
|
If TABLE contains a matching candidate, return a list
|
|
\(BASE COMMON SUFFIXES) where BASE is a prefix of the text
|
|
between BEG and END that TABLE elided from the start of each candidate,
|
|
COMMON is the longest common prefix of all matching candidates,
|
|
SUFFIXES is a list of different suffixes that together with COMMON yield
|
|
the matching candidates. If TABLE does not contain matching
|
|
candidates or if there are multiple matching completions and
|
|
`completion-preview-exact-match-only' is non-nil, return nil instead."
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; ;;
|
|
;; | buffer text | preview | ;;
|
|
;; | | | ;;
|
|
;; beg end | ;;
|
|
;; |------+------|--+--------| Each of base, common and suffix ;;
|
|
;; | base | common | suffix | <- may be empty, except common and ;;
|
|
;; suffix cannot both be empty. ;;
|
|
;; ;;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(let* ((pred (plist-get props :predicate))
|
|
(string (buffer-substring beg end))
|
|
(md (completion-metadata string table pred))
|
|
(sort-fn (or (completion-metadata-get md 'cycle-sort-function)
|
|
(completion-metadata-get md 'display-sort-function)
|
|
completion-preview-sort-function))
|
|
(all (let ((completion-lazy-hilit t)
|
|
;; FIXME: This does not override styles prescribed
|
|
;; by the completion category via
|
|
;; e.g. `completion-category-defaults'.
|
|
(completion-styles completion-preview-completion-styles))
|
|
(completion-all-completions string table pred
|
|
(- (point) beg) md)))
|
|
(last (last all))
|
|
(base (or (cdr last) 0))
|
|
(prefix (substring string base)))
|
|
(when last
|
|
(setcdr last nil)
|
|
(when-let ((sorted (funcall sort-fn
|
|
(delete prefix (all-completions prefix all))))
|
|
(common (try-completion prefix sorted))
|
|
(lencom (length common))
|
|
(suffixes sorted))
|
|
(unless (and (cdr suffixes) completion-preview-exact-match-only)
|
|
;; Remove the common prefix from each candidate.
|
|
(while sorted
|
|
(setcar sorted (substring (car sorted) lencom))
|
|
(setq sorted (cdr sorted)))
|
|
(list (substring string 0 base) common suffixes))))))
|
|
|
|
(defun completion-preview--capf-wrapper (capf)
|
|
"Translate return value of CAPF to properties for completion preview overlay."
|
|
(let ((res (ignore-errors (funcall capf))))
|
|
(and (consp res)
|
|
(not (functionp res))
|
|
(seq-let (beg end table &rest plist) res
|
|
(or (when-let ((data (completion-preview--try-table
|
|
table beg end plist)))
|
|
`(,(+ beg (length (car data))) ,end ,plist ,@data))
|
|
(unless (eq 'no (plist-get plist :exclusive))
|
|
;; Return non-nil to exclude other capfs.
|
|
'(nil)))))))
|
|
|
|
(defun completion-preview--update ()
|
|
"Update completion preview."
|
|
(seq-let (beg end props base common suffixes)
|
|
(run-hook-wrapped
|
|
'completion-at-point-functions
|
|
#'completion-preview--capf-wrapper)
|
|
(when-let ((suffix (car suffixes)))
|
|
(set-text-properties 0 (length suffix)
|
|
(list 'face (if (cdr suffixes)
|
|
'completion-preview
|
|
'completion-preview-exact))
|
|
suffix)
|
|
(set-text-properties 0 (length common)
|
|
(list 'face (if (cdr suffixes)
|
|
'completion-preview-common
|
|
'completion-preview-exact))
|
|
common)
|
|
(let ((ov (completion-preview--make-overlay
|
|
end (propertize (concat (substring common (- end beg)) suffix)
|
|
'mouse-face 'completion-preview-highlight
|
|
'keymap completion-preview--mouse-map))))
|
|
(overlay-put ov 'completion-preview-beg beg)
|
|
(overlay-put ov 'completion-preview-end end)
|
|
(overlay-put ov 'completion-preview-index 0)
|
|
(overlay-put ov 'completion-preview-suffixes suffixes)
|
|
(overlay-put ov 'completion-preview-common common)
|
|
(overlay-put ov 'completion-preview-base base)
|
|
(overlay-put ov 'completion-preview-props props)
|
|
(completion-preview-active-mode)))))
|
|
|
|
(defun completion-preview--show ()
|
|
"Show a new completion preview.
|
|
|
|
Call `completion-at-point-functions' in order to obtain and
|
|
display a completion candidate for the text around point.
|
|
|
|
If the preview is already shown, first check whether the
|
|
suggested candidate remains a valid completion for the text at
|
|
point. If so, update the preview according the new text at
|
|
point, otherwise hide it."
|
|
(when completion-preview-active-mode
|
|
;; We were already showing a preview before this command, so we
|
|
;; check if the text before point is still a prefix of the
|
|
;; candidate that the preview suggested, and if so we first update
|
|
;; existing preview according to the changes made by this command,
|
|
;; and only then try to get a new candidate. This ensures that we
|
|
;; never display a stale preview and that the preview doesn't
|
|
;; flicker, even with slow completion backends.
|
|
(let* ((beg (completion-preview--get 'completion-preview-beg))
|
|
(end (max (point) (overlay-start completion-preview--overlay)))
|
|
(sufs (completion-preview--get 'completion-preview-suffixes))
|
|
(index (completion-preview--get 'completion-preview-index))
|
|
(common (completion-preview--get 'completion-preview-common))
|
|
(suffix (nth index sufs))
|
|
(cand nil))
|
|
(set-text-properties 0 (length suffix)
|
|
(list 'face (if (cdr sufs)
|
|
'completion-preview
|
|
'completion-preview-exact))
|
|
suffix)
|
|
(setq cand (concat common (nth index sufs)))
|
|
(if (and (<= beg (point) end (1- (+ beg (length cand))))
|
|
(string-prefix-p (buffer-substring beg end) cand))
|
|
;; The previous preview is still applicable, update it.
|
|
(overlay-put (completion-preview--make-overlay
|
|
end (propertize (substring cand (- end beg))
|
|
'mouse-face 'completion-preview-highlight
|
|
'keymap completion-preview--mouse-map))
|
|
'completion-preview-end end)
|
|
;; The previous preview is no longer applicable, hide it.
|
|
(completion-preview-active-mode -1))))
|
|
;; Run `completion-at-point-functions' to get a new candidate.
|
|
(while-no-input (completion-preview--update)))
|
|
|
|
(defun completion-preview--post-command ()
|
|
"Create, update or delete completion preview post last command."
|
|
(let ((internal-p (or completion-preview--inhibit-update-p
|
|
(memq this-command
|
|
completion-preview--internal-commands))))
|
|
(setq completion-preview--inhibit-update-p nil)
|
|
|
|
;; If we're called after a command that itself updates the
|
|
;; preview, don't do anything.
|
|
(unless internal-p
|
|
(if (and (completion-preview-require-certain-commands)
|
|
(completion-preview-require-minimum-symbol-length))
|
|
(completion-preview--show)
|
|
(completion-preview-active-mode -1)))))
|
|
|
|
(defun completion-preview-insert ()
|
|
"Insert the completion candidate that the preview is showing."
|
|
(interactive)
|
|
(if completion-preview-active-mode
|
|
(let* ((pre (completion-preview--get 'completion-preview-base))
|
|
(end (completion-preview--get 'completion-preview-end))
|
|
(ind (completion-preview--get 'completion-preview-index))
|
|
(all (completion-preview--get 'completion-preview-suffixes))
|
|
(com (completion-preview--get 'completion-preview-common))
|
|
(efn (plist-get (completion-preview--get 'completion-preview-props)
|
|
:exit-function))
|
|
(aft (completion-preview--get 'after-string))
|
|
(str (concat pre com (nth ind all))))
|
|
(completion-preview-active-mode -1)
|
|
(goto-char end)
|
|
(insert (substring-no-properties aft))
|
|
(when (functionp efn) (funcall efn str 'finished)))
|
|
(user-error "No current completion preview")))
|
|
|
|
(defun completion-preview-complete ()
|
|
"Complete up to the longest common prefix of all completion candidates.
|
|
|
|
If you call this command twice in a row, or otherwise if there is no
|
|
common prefix to insert, it displays the list of matching completion
|
|
candidates unless `completion-auto-help' is nil. If you repeat this
|
|
command again when the completions list is visible, it scrolls the
|
|
completions list."
|
|
(interactive)
|
|
(unless completion-preview-active-mode
|
|
(user-error "No current completion preview"))
|
|
(let* ((beg (completion-preview--get 'completion-preview-beg))
|
|
(end (completion-preview--get 'completion-preview-end))
|
|
(com (completion-preview--get 'completion-preview-common))
|
|
(cur (completion-preview--get 'completion-preview-index))
|
|
(all (completion-preview--get 'completion-preview-suffixes))
|
|
(base (completion-preview--get 'completion-preview-base))
|
|
(props (completion-preview--get 'completion-preview-props))
|
|
(efn (plist-get props :exit-function))
|
|
(ins (substring-no-properties com (- end beg))))
|
|
(goto-char end)
|
|
(if (string-empty-p ins)
|
|
;; If there's nothing to insert, call `completion-at-point' to
|
|
;; show the completions list (or just display a message when
|
|
;; `completion-auto-help' is nil).
|
|
(let* ((completion-styles completion-preview-completion-styles)
|
|
(sub (substring-no-properties com))
|
|
(col (mapcar (lambda (suf)
|
|
(concat sub (substring-no-properties suf)))
|
|
(append (nthcdr cur all) (take cur all))))
|
|
;; The candidates are already in order.
|
|
(props (plist-put props :display-sort-function #'identity))
|
|
;; The :exit-function might be slow, e.g. when the
|
|
;; backend is Eglot, so we ensure that the preview is
|
|
;; hidden before any original :exit-function is called.
|
|
(props (plist-put props :exit-function
|
|
(when (functionp efn)
|
|
(lambda (string status)
|
|
(completion-preview-active-mode -1)
|
|
(funcall efn string status)))))
|
|
;; The predicate is meant for the original completion
|
|
;; candidates, which may be symbols or cons cells, but
|
|
;; now we only have strings, so it might be unapplicable.
|
|
(props (plist-put props :predicate nil))
|
|
(completion-at-point-functions
|
|
(list (lambda () `(,beg ,end ,col ,@props)))))
|
|
(completion-preview--inhibit-update)
|
|
(completion-at-point))
|
|
;; Otherwise, insert the common prefix and update the preview.
|
|
(insert ins)
|
|
(let ((suf (nth cur all))
|
|
(pos (point)))
|
|
(if (or (string-empty-p suf) (null suf))
|
|
;; If we've inserted a full candidate, let the post-command
|
|
;; hook update the completion preview in case the candidate
|
|
;; can be completed further.
|
|
(when (functionp efn)
|
|
(funcall efn (concat base com) (if (cdr all) 'exact 'finished)))
|
|
;; Otherwise, remove the common prefix from the preview.
|
|
(completion-preview--inhibit-update)
|
|
(overlay-put (completion-preview--make-overlay
|
|
pos (propertize
|
|
suf 'mouse-face 'completion-preview-highlight
|
|
'keymap completion-preview--mouse-map))
|
|
'completion-preview-end pos))))))
|
|
|
|
(defun completion-preview-prev-candidate (n)
|
|
"Cycle the candidate the preview is showing N candidates backward.
|
|
|
|
If N is negative, cycle -N candidates forward. Interactively, N is the
|
|
prefix argument and defaults to 1."
|
|
(interactive "p")
|
|
(completion-preview-next-candidate (- n)))
|
|
|
|
(defun completion-preview-next-candidate (n)
|
|
"Cycle the candidate the preview is showing N candidates forward.
|
|
|
|
If N is negative, cycle -N candidates backward. Interactively, N is the
|
|
prefix argument and defaults to 1."
|
|
(interactive "p")
|
|
(when completion-preview-active-mode
|
|
(let* ((beg (completion-preview--get 'completion-preview-beg))
|
|
(end (completion-preview--get 'completion-preview-end))
|
|
(all (completion-preview--get 'completion-preview-suffixes))
|
|
(com (completion-preview--get 'completion-preview-common))
|
|
(cur (completion-preview--get 'completion-preview-index))
|
|
(len (length all))
|
|
(new (mod (+ cur n) len))
|
|
(suf (nth new all))
|
|
(lencom (length com)))
|
|
;; Skip suffixes that are no longer applicable. This may happen
|
|
;; when the user continues typing and immediately runs this
|
|
;; command, before the completion backend returns an updated set
|
|
;; of completions for the new (longer) prefix, so we still have
|
|
;; the previous (larger) set of candidates at hand.
|
|
(while (or (<= (+ beg lencom (length suf)) end)
|
|
(not (string-prefix-p (buffer-substring beg end)
|
|
(concat com suf))))
|
|
(setq new (mod (+ new n) len)
|
|
suf (nth new all)))
|
|
(set-text-properties 0 (length suf)
|
|
(list 'face (if (cdr all)
|
|
'completion-preview
|
|
'completion-preview-exact))
|
|
suf)
|
|
(let ((aft (propertize (substring (concat com suf) (- end beg))
|
|
'mouse-face 'completion-preview-highlight
|
|
'keymap completion-preview--mouse-map)))
|
|
(add-text-properties 0 1 '(cursor 1) aft)
|
|
(overlay-put completion-preview--overlay 'completion-preview-index new)
|
|
(overlay-put completion-preview--overlay 'after-string aft))
|
|
(when completion-preview-message-format
|
|
(message (format-spec completion-preview-message-format
|
|
`((?i . ,(1+ new)) (?n . ,len))))))))
|
|
|
|
(defun completion-preview--active-p (_symbol buffer)
|
|
"Check if the completion preview is currently shown in BUFFER."
|
|
(buffer-local-value 'completion-preview-active-mode buffer))
|
|
|
|
(dolist (cmd '(completion-preview-insert
|
|
completion-preview-complete
|
|
completion-preview-prev-candidate
|
|
completion-preview-next-candidate))
|
|
(put cmd 'completion-predicate #'completion-preview--active-p))
|
|
|
|
;;;###autoload
|
|
(define-minor-mode completion-preview-mode
|
|
"Show in-buffer completion suggestions in a preview as you type.
|
|
|
|
This mode automatically shows and updates the completion preview
|
|
according to the text around point.
|
|
\\<completion-preview-active-mode-map>\
|
|
When the preview is visible, \\[completion-preview-insert] accepts the
|
|
completion suggestion, \\[completion-preview-complete] completes up to
|
|
the longest common prefix of all completion candidates,
|
|
\\[completion-preview-next-candidate] cycles forward to the next
|
|
completion suggestion, and \\[completion-preview-prev-candidate] cycles
|
|
backward."
|
|
:lighter " CP"
|
|
(if completion-preview-mode
|
|
(add-hook 'post-command-hook #'completion-preview--post-command nil t)
|
|
(remove-hook 'post-command-hook #'completion-preview--post-command t)
|
|
(completion-preview-active-mode -1)))
|
|
|
|
;;;###autoload
|
|
(define-globalized-minor-mode global-completion-preview-mode
|
|
completion-preview-mode completion-preview-mode
|
|
:predicate '((not compilation-mode
|
|
diff-mode
|
|
dired-mode
|
|
minibuffer-mode
|
|
minibuffer-inactive-mode
|
|
special-mode
|
|
wdired-mode)
|
|
t))
|
|
|
|
(provide 'completion-preview)
|
|
;;; completion-preview.el ends here
|