From: Eshel Yaron Date: Sat, 28 Oct 2023 18:27:08 +0000 (+0200) Subject: Initial commit X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=55a5c64837f77aa526e168bb94edacdd41a100f3;p=completion-preview.git Initial commit --- 55a5c64837f77aa526e168bb94edacdd41a100f3 diff --git a/completion-preview.el b/completion-preview.el new file mode 100644 index 0000000..f5a0125 --- /dev/null +++ b/completion-preview.el @@ -0,0 +1,166 @@ +;;; completion-preview.el --- Preview completion with inline overlay -*- lexical-binding: t; -*- + +;; Copyright (C) 2023 Eshel Yaron + +;; Author: Eshel Yaron +;; Keywords: 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 . + +;;; Commentary: + +;; This library provides the Completion Preview mode. This minor mode +;; displays the top completion candidate for the symbol at point in an +;; overlay after point. + +;;; 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 overlay when there is exactly one completion candidate +that matches the symbol at point, otherwise it shows the top +candidate also when there are multiple matching candidates." + :type 'boolean) + +(defcustom completion-preview-commands '(self-insert-command) + "List of commands that should trigger completion preview." + :type '(repeat (function :tag "Command" :value self-insert-command))) + +(defcustom completion-preview-minimum-symbol-length 3 + "Minimum length of the symbol at point for showing completion preview." + :type 'natnum) + +(defcustom completion-preview-hook + '(completion-preview-require-certain-commands + completion-preview-require-minimum-symbol-length) + "Hook for functions that determines whether to show preview completion. + +Completion Preview mode calls each of these functions in order +after each command, and only displays the completion preview when +all of the functions return non-nil." + :type 'hook) + +(defvar completion-preview-predicate #'always + "Completion predicate to use for completion preview.") + +(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 preview overlay.") + +(defface completion-preview-exact + '((t :underline t :inherit completion-preview)) + "Face for exact completion preview overlay.") + +(defvar-local completion-preview--overlay nil) + +(defun 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." + (pcase (bounds-of-thing-at-point 'symbol) + (`(,beg . ,end) + (<= completion-preview-minimum-symbol-length (- end beg))))) + +(defun completion-preview-show () + "Show completion preview with inline overlay after point." + (interactive) + (let ((res (run-hook-wrapped 'completion-at-point-functions + #'completion--capf-wrapper 'all))) + (pcase res + (`(,_ ,beg ,end ,table . ,plist) + (let* ((string (buffer-substring beg end)) + (md (completion-metadata string table completion-preview-predicate)) + (sort-fn (or (completion-metadata-get md 'cycle-sort-function) + (completion-metadata-get md 'display-sort-function) + completion-preview-sort-function)) + (all (completion-all-completions string table + (or (plist-get plist :predicate) + completion-preview-predicate) + (- (point) beg) md)) + (last (last all))) + (when last + (setcdr last nil) + (let* ((filtered (seq-filter (apply-partially #'string-prefix-p string) + all)) + (sorted (funcall sort-fn filtered)) + (multi (cadr sorted)) ; multiple candidates + (cand (car sorted))) + (when (and cand + (not (and multi completion-preview-exact-match-only))) + (let* ((face (if multi 'completion-preview 'completion-preview-exact)) + (after (propertize (substring cand (length string)) 'face face))) + (unless (string-empty-p after) + (add-text-properties 0 1 '(cursor 1) after)) + (setq completion-preview--overlay (make-overlay end end)) + (overlay-put completion-preview--overlay 'after-string after) + (overlay-put completion-preview--overlay 'completion-preview-plist plist) + (overlay-put completion-preview--overlay 'completion-preview-string cand)))))))))) + +(defun completion-preview--post-command () + "Delete the previous completion preview overlay, and maybe show a new one." + (when completion-preview--overlay + (delete-overlay completion-preview--overlay) + (setq completion-preview--overlay nil)) + (when (run-hook-with-args-until-failure 'completion-preview-hook) + (while-no-input + (completion-preview-show)))) + +(defun completion-preview-insert-or-complete (complete-p) + "Insert the completion preview candidate. +If there is no completion preview, or when COMPLETE-P is non-nil, +invoke `completion-at-point' instead. Interactively, COMPLETE-P +is the prefix argument." + (interactive "P") + (if (or complete-p (not completion-preview--overlay)) + (completion-at-point) + (let ((after (substring-no-properties + (overlay-get completion-preview--overlay 'after-string))) + (string (overlay-get completion-preview--overlay + 'completion-preview-string)) + (plist (overlay-get completion-preview--overlay + 'completion-preview-plist))) + (delete-overlay completion-preview--overlay) + (setq completion-preview--overlay nil) + (insert after) + (when-let ((exit-fn (plist-get plist :exit-function))) + (funcall exit-fn string 'finished))))) + +(defvar-keymap completion-preview-mode-map + :doc "Keymap for Completion Preview mode." + "C-M-i" #'completion-preview-insert-or-complete) + +(define-minor-mode completion-preview-mode + "Show in-buffer completion preview as you type." + :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) + (when completion-preview--overlay + (delete-overlay completion-preview--overlay) + (setq completion-preview--overlay nil)))) + +(provide 'completion-preview) +;;; completion-preview.el ends here