From: Eshel Yaron Date: Wed, 25 Oct 2023 21:26:47 +0000 (+0200) Subject: Add 'completion-preview' Elisp library X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=4009e0788cc96443a332a2303e3641bd74be4edf;p=dotfiles.git Add 'completion-preview' Elisp library --- diff --git a/.emacs.d/init.el b/.emacs.d/init.el index f386e48..2492164 100644 --- a/.emacs.d/init.el +++ b/.emacs.d/init.el @@ -22,6 +22,7 @@ (pcase system-type ('darwin + (add-to-list 'exec-path "/usr/local/bin") (setq initial-frame-alist '((fullscreen . fullboth)) frame-title-format "Emacs") (set-fontset-font t '(?􀀀 . ?􏿽) "SF Pro Display")) @@ -470,6 +471,7 @@ (add-to-list 'load-path (expand-file-name "lisp/" user-emacs-directory)) (autoload 'some-button "some-button" nil t) (autoload 'completions-auto-update-mode "completions-auto-update" nil t) +(autoload 'completion-preview-mode "completion-preview" nil t) (unless (eq system-type 'android) (add-to-list 'load-path "~/checkouts/esy-publish/") @@ -844,6 +846,7 @@ Interactively, POINT is point and KILL is the prefix argument." display-line-numbers-mode flymake-mode ;; flyspell-prog-mode + completion-preview-mode )) (add-hook 'prog-mode-hook mode)) @@ -1124,18 +1127,6 @@ as the initial input for completion, and return that directory." ;;; Set up some global `completion-at-point-functions' -(defun esy/dabbrev-capf () - "Workaround for issue with `dabbrev-capf'." - (require 'dabbrev) - (dabbrev--reset-global-variables) - (setq dabbrev-case-fold-search nil) - (pcase (let ((inhibit-message t)) - (ignore-errors (dabbrev-capf))) - (`(,beg ,end ,table . ,_) - (list beg end table :exclusive 'no)))) - -(add-to-list 'completion-at-point-functions #'esy/dabbrev-capf) - (defun esy/file-capf () "File completion at point function." (let ((bs (bounds-of-thing-at-point 'filename))) diff --git a/.emacs.d/lisp/completion-preview.el b/.emacs.d/lisp/completion-preview.el new file mode 100644 index 0000000..c38b9c4 --- /dev/null +++ b/.emacs.d/lisp/completion-preview.el @@ -0,0 +1,153 @@ +;;; 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-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* ((sorted (funcall sort-fn all)) + (cand (car sorted))) + (when (string-prefix-p string cand) + (let* ((face (if (cadr sorted) '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