From: Eshel Yaron Date: Mon, 30 Oct 2023 06:40:30 +0000 (+0100) Subject: Extract 'completion-preview' to a separate repository X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=1fdffc2e941a19e3375bd383753ef0b9edd6b79f;p=dotfiles.git Extract 'completion-preview' to a separate repository --- diff --git a/.emacs.d/init.el b/.emacs.d/init.el index 2492164..6da995d 100644 --- a/.emacs.d/init.el +++ b/.emacs.d/init.el @@ -125,6 +125,7 @@ ("emacs" "--batch" "-l" "ox-texinfo" "README.org" "--eval" "(setq org-babel-confirm-evaluate-answer-no t)" "-f" "org-texinfo-export-to-texinfo")))) +(elpaca (completion-preview :repo "git://git.eshelyaron.com/completion-preview.git")) (elpaca debbugs) (elpaca (devdocs :pre-build (("emacs" "--batch" "-l" "ox-texinfo" "README.org" @@ -471,7 +472,6 @@ (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/") diff --git a/.emacs.d/lisp/completion-preview.el b/.emacs.d/lisp/completion-preview.el deleted file mode 100644 index 46b45fa..0000000 --- a/.emacs.d/lisp/completion-preview.el +++ /dev/null @@ -1,164 +0,0 @@ -;;; 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* ((sorted (funcall sort-fn all)) - (multi (cadr sorted)) ; multiple candidates - (cand (car sorted))) - (when (and (not (and multi completion-preview-exact-match-only)) - (string-prefix-p string cand)) - (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