576 lines
20 KiB
EmacsLisp
576 lines
20 KiB
EmacsLisp
;;; mono-complete.el --- Completion suggestions -*- lexical-binding: t -*-
|
|
|
|
;; SPDX-License-Identifier: GPL-2.0-or-later
|
|
;; Copyright (C) 2019 Campbell Barton
|
|
|
|
;; Author: Campbell Barton <ideasman42@gmail.com>
|
|
|
|
;; URL: https://codeberg.org/ideasman42/emacs-mono-complete
|
|
;; Version: 0.1
|
|
;; Package-Requires: ((emacs "27.1"))
|
|
|
|
;;; Commentary:
|
|
|
|
;; Configurable completion suggestions while typing.
|
|
|
|
;;; Usage
|
|
|
|
;; (mono-complete)
|
|
|
|
;;; Code:
|
|
|
|
;; ---------------------------------------------------------------------------
|
|
;; Custom Variables
|
|
|
|
(defgroup mono-complete nil
|
|
"Complete while typing with configurable back-ends."
|
|
:group 'convenience)
|
|
|
|
(defcustom mono-complete-preview-delay 0.235
|
|
"How long to wait until displaying the preview after a keystroke (in seconds)."
|
|
:type 'float)
|
|
|
|
(defcustom mono-complete-self-insert-commands '(self-insert-command org-self-insert-command)
|
|
"A list of commands after which to show a preview."
|
|
:type '(repeat function))
|
|
|
|
(defcustom mono-complete-literal-input t
|
|
"Simulate literal text input.
|
|
|
|
When enabled replaying this action as a macro re-inserts the literal text
|
|
instead of performing the completion action (which may give different results)."
|
|
:type 'boolean)
|
|
|
|
(defface mono-complete-preview-face '((t (:background "#000000"))) "Face for the preview.")
|
|
|
|
;; ---------------------------------------------------------------------------
|
|
;; Custom Callbacks
|
|
|
|
(defcustom mono-complete-fallback-command 'insert-tab
|
|
"Command to run when no preview is available."
|
|
:type 'function)
|
|
|
|
(defcustom mono-complete-backends 'mono-complete-backends-default
|
|
"A function which returns a list of back-ends."
|
|
:type 'function)
|
|
|
|
(defcustom mono-complete-debug-logging 'stdout
|
|
"Debug logging (intended for back-end developers)."
|
|
:type
|
|
(list
|
|
'choice
|
|
(list 'const :tag "Disabled" nil)
|
|
(list 'const :tag "Buffer" t)
|
|
(list 'const :tag "Standard Output" 'stdout)))
|
|
|
|
|
|
;; ---------------------------------------------------------------------------
|
|
;; Internal Variables
|
|
|
|
;; Cache for back-end presets, avoid requiring them and calling their function.
|
|
(defvar mono-complete--backend-require-cache nil)
|
|
|
|
;; The preview overlay or nil.
|
|
(defvar-local mono-complete--preview-overlay nil)
|
|
|
|
;; The preview overlay state or nil when the command.
|
|
(defvar-local mono-complete--preview-overlay-was-visible nil)
|
|
|
|
;; The preview idle timer.
|
|
(defvar-local mono-complete--preview-timer nil)
|
|
|
|
;; Hash where:
|
|
;; - The key is `complete-fn'.
|
|
;; - The value is a cons cell where:
|
|
;; - The CAR is the prefix,
|
|
;; - The CDR is the cache value defined by the completion implementation
|
|
;; (passed to and return from `complete-fn').
|
|
(defvar-local mono-complete--backend-runtime-cache nil)
|
|
|
|
;; ---------------------------------------------------------------------------
|
|
;; Internal Constants
|
|
|
|
(defconst mono-complete--commands '(mono-complete-expand mono-complete-expand-or-fallback))
|
|
|
|
;; Use this to prevent simulated input running command hooks
|
|
;; (which would trigger the idle timer).
|
|
(defconst mono-complete--suppress-command-hooks nil)
|
|
|
|
;; ---------------------------------------------------------------------------
|
|
;; Internal Logging
|
|
|
|
(defsubst mono-complete--debug-log (&rest args)
|
|
"Log format ARGS."
|
|
(when mono-complete-debug-logging
|
|
(let ((str (apply 'format args)))
|
|
(cond
|
|
((eq 'stdout mono-complete-debug-logging)
|
|
(princ str #'external-debugging-output)
|
|
(external-debugging-output ?\n))
|
|
(t
|
|
(let ((buf (get-buffer-create "*mono-complete-log*")))
|
|
(with-current-buffer buf (insert str "\n"))))))))
|
|
|
|
|
|
;; ---------------------------------------------------------------------------
|
|
;; Internal Macro Utilities
|
|
|
|
(defun mono-complete--interactive-or-non-literal-input ()
|
|
"Return non-nil if this command is interactive or literal input is disabled."
|
|
(cond
|
|
(mono-complete-literal-input
|
|
;; Interactive only, when non-interactive,
|
|
;; the macros called here will be in-lined
|
|
;; and there is no need to perform any functionality in that case.
|
|
(not (or executing-kbd-macro noninteractive)))
|
|
(t
|
|
t)))
|
|
|
|
(defun mono-complete--key-from-command (fn &optional descriptionp)
|
|
"Return the key for command symbol FN.
|
|
When DESCRIPTIONP is non-nil, return it's description."
|
|
(unless (commandp fn)
|
|
(error "Not a command: %s" fn))
|
|
(let
|
|
((key (car (where-is-internal (or (command-remapping fn) fn) overriding-local-map nil nil))))
|
|
(cond
|
|
((null key)
|
|
nil)
|
|
(descriptionp
|
|
(key-description key))
|
|
(t
|
|
key))))
|
|
|
|
(defun mono-complete--call-interactively-macro (command-symbol)
|
|
"Call COMMAND-SYMBOL as a macro."
|
|
(let
|
|
(
|
|
(command (symbol-name command-symbol))
|
|
(binding (mono-complete--key-from-command command-symbol t)))
|
|
(unless binding
|
|
;; Attempt to run "M-x command" if there is no direct shortcut.
|
|
(setq binding
|
|
(concat
|
|
(or (mono-complete--key-from-command 'execute-extended-command t) "M-x")
|
|
" "
|
|
command)))
|
|
(execute-kbd-macro (read-kbd-macro binding))))
|
|
|
|
(defun mono-complete--insert-with-literal-input (text)
|
|
"Helper function to simulate input using TEXT."
|
|
(dolist (ch (string-to-list text))
|
|
(execute-kbd-macro (char-to-string ch))))
|
|
|
|
|
|
;; ---------------------------------------------------------------------------
|
|
;; Internal Back-end Functions
|
|
|
|
(defun mono-complete--backend-load (id &optional quiet)
|
|
"Load a pre-defined back-end ID.
|
|
When QUIET is non-nil, report an error on failure to load."
|
|
|
|
(unless mono-complete--backend-require-cache
|
|
(setq mono-complete--backend-require-cache (make-hash-table :test #'eq)))
|
|
|
|
(let ((result (gethash id mono-complete--backend-require-cache :unset)))
|
|
(when (eq result :unset)
|
|
(setq result nil)
|
|
|
|
(let ((preset-sym (intern (concat "mono-complete-backend-" (symbol-name id)))))
|
|
(when
|
|
(condition-case err
|
|
(progn
|
|
(require preset-sym)
|
|
t)
|
|
(error
|
|
(unless quiet
|
|
(message "mono-complete: back-end %S not found! (%S)" preset-sym err))
|
|
nil))
|
|
(setq result (funcall preset-sym))))
|
|
|
|
;; Put the result in the hash even when it's nil, not to regenerate.
|
|
(puthash id result mono-complete--backend-require-cache))
|
|
|
|
result))
|
|
|
|
|
|
;; ---------------------------------------------------------------------------
|
|
;; Public Function Implementations
|
|
|
|
(defun mono-complete-backends-default ()
|
|
"Back-end defaults."
|
|
(list
|
|
;;
|
|
;; (mono-complete--backend-load 'dabbrev)
|
|
(mono-complete--backend-load 'filesystem)
|
|
;;
|
|
;; (mono-complete--backend-load 'whole-line)
|
|
;;
|
|
))
|
|
|
|
;; ---------------------------------------------------------------------------
|
|
;; Internal Functions
|
|
|
|
(defun mono-complete--is-mono-complete-command (command)
|
|
"[internal] Return non-nil if COMMAND is a mono-complete command."
|
|
(memq command mono-complete--commands))
|
|
|
|
(defun mono-complete--is-self-insert-command (command)
|
|
"Return non-nil if COMMAND is a \"self-insert command\"."
|
|
(memq command mono-complete-self-insert-commands))
|
|
|
|
|
|
(defun mono-complete--preview-text-at-point ()
|
|
"Test me."
|
|
(let
|
|
(
|
|
(result nil)
|
|
(backends (funcall mono-complete-backends))
|
|
(prefix-cache (list)))
|
|
(while backends
|
|
(when-let ((backend-item (pop backends)))
|
|
(pcase-let
|
|
((`(,prefix-fn ,complete-fn) (mono-complete--backend-items-or-warn backend-item)))
|
|
(let ((prefix nil))
|
|
(let ((prefix-fn-result-cons (assq prefix-fn prefix-cache)))
|
|
(cond
|
|
(prefix-fn-result-cons
|
|
(setq prefix (cdr prefix-fn-result-cons)))
|
|
(t
|
|
(setq prefix (funcall prefix-fn))
|
|
(push (cons prefix-fn prefix) prefix-cache))))
|
|
|
|
;; There may be no prefix, in this case skip.
|
|
(when prefix
|
|
(let ((backend-cache (mono-complete--backend-cache-ensure complete-fn)))
|
|
(cond
|
|
( ;; When the prefix was previously ignored, do nothing.
|
|
(and
|
|
(stringp (car backend-cache))
|
|
(string-prefix-p (car backend-cache) prefix)))
|
|
|
|
;; Call the completion function.
|
|
(
|
|
(let
|
|
(
|
|
(result-suffix
|
|
(mono-complete--backend-call-and-update
|
|
complete-fn prefix backend-cache)))
|
|
(when result-suffix
|
|
(setq result (cons prefix result-suffix))))
|
|
|
|
;; Break.
|
|
(setq backends nil))
|
|
(t
|
|
;; Skip this prefix in the future to prevent excessive calculation.
|
|
(setcar backend-cache prefix)))))))))
|
|
result))
|
|
|
|
(defun mono-complete--on-exit ()
|
|
"Function run when executing another command.
|
|
|
|
That is, if `this-command' is not one of `mono-complete--commands'."
|
|
|
|
(mono-complete--backend-cache-clear))
|
|
|
|
|
|
;; ---------------------------------------------------------------------------
|
|
;; Internal Back-End Functions
|
|
|
|
(defun mono-complete--backend-call-and-update (complete-fn prefix backend-cache)
|
|
"Call COMPLETE-FN with PREFIX & update BACKEND-CACHE."
|
|
(pcase-let ((`(,result . ,backend-cache-next) (funcall complete-fn prefix (cdr backend-cache))))
|
|
(setcdr backend-cache backend-cache-next)
|
|
result))
|
|
|
|
(defun mono-complete--backend-cache-set (complete-fn val)
|
|
"Set VAL for COMPLETE-FN."
|
|
(unless mono-complete--backend-runtime-cache
|
|
(setq mono-complete--backend-runtime-cache (make-hash-table :test #'eq)))
|
|
(puthash complete-fn val mono-complete--backend-runtime-cache))
|
|
|
|
(defun mono-complete--backend-cache-ensure (complete-fn)
|
|
"Ensure COMPLETE-FN has an entry in `mono-complete--backend-runtime-cache'."
|
|
(or
|
|
;; Existing.
|
|
(and
|
|
mono-complete--backend-runtime-cache
|
|
(gethash complete-fn mono-complete--backend-runtime-cache))
|
|
;; Add new.
|
|
(mono-complete--backend-cache-set complete-fn (cons nil nil))))
|
|
|
|
(defun mono-complete--backend-cache-clear ()
|
|
"Clear back-end cache."
|
|
(when mono-complete--backend-runtime-cache
|
|
(clrhash mono-complete--backend-runtime-cache)))
|
|
|
|
(defun mono-complete--backend-items-or-warn (item)
|
|
"Extract back-end callbacks from ITEM, returning a list or nil."
|
|
(let
|
|
(
|
|
(prefix-fn nil)
|
|
(complete-fn nil))
|
|
(while item
|
|
(let*
|
|
(
|
|
(key (pop item))
|
|
(val (pop item)))
|
|
(cond
|
|
((eq key :prefix)
|
|
(setq prefix-fn val))
|
|
((eq key :complete)
|
|
(setq complete-fn val))
|
|
(t
|
|
(message "Unexpected keyword %S found!" key)))))
|
|
|
|
(cond
|
|
((null complete-fn)
|
|
(message "Missing :complete function!")
|
|
nil)
|
|
((null prefix-fn)
|
|
(message "Missing :prefix function!")
|
|
nil)
|
|
(t
|
|
(list prefix-fn complete-fn)))))
|
|
|
|
|
|
;; ---------------------------------------------------------------------------
|
|
;; Internal Preview Functions
|
|
|
|
(defun mono-complete--preview-state-from-overlay ()
|
|
"Return the state of the overlay: (position . (prefix . expansion))."
|
|
(when (and mono-complete--preview-overlay (overlay-buffer mono-complete--preview-overlay))
|
|
(cons
|
|
(overlay-start mono-complete--preview-overlay)
|
|
(cons
|
|
(overlay-get mono-complete--preview-overlay 'mono-complete-prefix)
|
|
(overlay-get mono-complete--preview-overlay 'after-string)))))
|
|
|
|
(defun mono-complete--preview-refresh-from-state (state)
|
|
"Detect when text insertion follows the current preview allowing it to be used.
|
|
Argument STATE is the result of `mono-complete--preview-state-from-overlay'."
|
|
(let ((result nil))
|
|
(when state
|
|
(pcase-let ((`(,pos-prev . (,prefix-prev . ,expansion-prev)) state))
|
|
;; Ensure the point didn't move backwards.
|
|
(when (<= pos-prev (point))
|
|
;; When the length is equal, the entire word was manually typed in.
|
|
(when (> (length expansion-prev) (- (point) pos-prev))
|
|
(let
|
|
(
|
|
(prefix-in-buffer
|
|
(buffer-substring-no-properties (- pos-prev (length prefix-prev)) pos-prev)))
|
|
;; Sanity check that the buffer prefix has not changed.
|
|
(when (string-equal prefix-prev prefix-in-buffer)
|
|
(let ((overlap (buffer-substring-no-properties pos-prev (point))))
|
|
(when (or (string-empty-p overlap) (string-prefix-p overlap expansion-prev))
|
|
;; The modifications made don't impact the
|
|
(let
|
|
(
|
|
(prefix (concat prefix-prev overlap))
|
|
(expansion (substring-no-properties expansion-prev (length overlap))))
|
|
|
|
(when mono-complete--preview-overlay
|
|
;; Should never happen, just sanity check.
|
|
(error "Invalid internal state"))
|
|
|
|
(setq mono-complete--preview-overlay (make-overlay (point) (point)))
|
|
(add-text-properties 0 1 '(cursor 1) expansion)
|
|
(add-face-text-property
|
|
0
|
|
(length expansion)
|
|
'mono-complete-preview-face
|
|
nil
|
|
expansion)
|
|
|
|
(overlay-put mono-complete--preview-overlay 'after-string expansion)
|
|
(overlay-put mono-complete--preview-overlay 'mono-complete-prefix prefix)
|
|
|
|
(setq result t)))))))))
|
|
|
|
;; Don't refresh, use the timer instead.
|
|
result)))
|
|
|
|
(defun mono-complete--preview-text-from-command ()
|
|
"Return the expansion text for the preview displayed when the command began."
|
|
(when mono-complete--preview-overlay-was-visible
|
|
(substring-no-properties (cdr (cdr mono-complete--preview-overlay-was-visible)))))
|
|
|
|
(defun mono-complete--preview (buf)
|
|
"Show the preview for BUF."
|
|
(when (buffer-live-p buf)
|
|
(with-current-buffer buf
|
|
(cancel-timer mono-complete--preview-timer)
|
|
(setq mono-complete--preview-timer nil)
|
|
|
|
(let ((expansion-pair (mono-complete--preview-text-at-point)))
|
|
(when expansion-pair
|
|
(pcase-let ((`(,prefix . ,expansion-list) expansion-pair))
|
|
(let ((expansion (car expansion-list)))
|
|
(setq mono-complete--preview-overlay (make-overlay (point) (point)))
|
|
(add-text-properties 0 1 '(cursor 1) expansion)
|
|
(add-face-text-property
|
|
0
|
|
(length expansion)
|
|
'mono-complete-preview-face
|
|
nil
|
|
expansion)
|
|
|
|
(overlay-put mono-complete--preview-overlay 'after-string expansion)
|
|
(overlay-put mono-complete--preview-overlay 'mono-complete-prefix prefix))))))))
|
|
|
|
|
|
;; ---------------------------------------------------------------------------
|
|
;; Internal Hooks
|
|
|
|
(defun mono-complete--pre-command-hook ()
|
|
"Function run from `pre-command-hook'."
|
|
(unless mono-complete--suppress-command-hooks
|
|
(cond
|
|
(mono-complete--preview-overlay
|
|
(setq mono-complete--preview-overlay-was-visible
|
|
(mono-complete--preview-state-from-overlay))
|
|
(delete-overlay mono-complete--preview-overlay)
|
|
(setq mono-complete--preview-overlay nil))
|
|
(t
|
|
(setq mono-complete--preview-overlay-was-visible nil)))))
|
|
|
|
(defun mono-complete--post-command-hook ()
|
|
"Function run from `post-command-hook'."
|
|
(unless mono-complete--suppress-command-hooks
|
|
(let
|
|
(
|
|
(do-reset :unset)
|
|
(do-clear-timer t))
|
|
|
|
(when (mono-complete--is-self-insert-command this-command)
|
|
(cond
|
|
((mono-complete--preview-refresh-from-state mono-complete--preview-overlay-was-visible)
|
|
(mono-complete--debug-log "idle-timer: no-reset, use overlay in-place.")
|
|
(setq do-reset nil))
|
|
(t
|
|
;; Keep cache when inserting text,
|
|
;; each completion must choose if cache should be reused or not.
|
|
(when mono-complete--preview-overlay-was-visible
|
|
(setq do-reset nil))
|
|
|
|
(cond
|
|
(mono-complete--preview-timer
|
|
(mono-complete--debug-log "idle-timer: reuse (reset time).")
|
|
(timer-set-idle-time mono-complete--preview-timer mono-complete-preview-delay nil))
|
|
(t
|
|
(mono-complete--debug-log "idle-timer: create.")
|
|
(setq mono-complete--preview-timer
|
|
(run-with-idle-timer
|
|
mono-complete-preview-delay
|
|
nil
|
|
#'mono-complete--preview
|
|
(current-buffer)))))
|
|
|
|
(setq do-clear-timer nil))))
|
|
|
|
(when (eq do-reset :unset)
|
|
(setq do-reset (not (mono-complete--is-mono-complete-command this-command))))
|
|
|
|
(when do-clear-timer
|
|
(when (timerp mono-complete--preview-timer)
|
|
(cancel-timer mono-complete--preview-timer)
|
|
(setq mono-complete--preview-timer nil)))
|
|
|
|
(when do-reset
|
|
(mono-complete--on-exit)))))
|
|
|
|
|
|
;; ---------------------------------------------------------------------------
|
|
;; Internal Mode Management
|
|
|
|
(defun mono-complete--mode-enable ()
|
|
"Turn on option `mono-complete-mode' for the current buffer."
|
|
|
|
(add-hook 'pre-command-hook #'mono-complete--pre-command-hook nil t)
|
|
(add-hook 'post-command-hook #'mono-complete--post-command-hook nil t))
|
|
|
|
(defun mono-complete--mode-disable ()
|
|
"Turn off option `mono-complete-mode' for the current buffer."
|
|
|
|
(mono-complete--on-exit)
|
|
|
|
(remove-hook 'pre-command-hook #'mono-complete--pre-command-hook t)
|
|
(remove-hook 'post-command-hook #'mono-complete--post-command-hook t)
|
|
|
|
(when mono-complete--preview-overlay
|
|
(delete-overlay mono-complete--preview-overlay))
|
|
(when mono-complete--preview-timer
|
|
(cancel-timer mono-complete--preview-timer))
|
|
|
|
(kill-local-variable 'mono-complete--preview-overlay)
|
|
(kill-local-variable 'mono-complete--preview-overlay-was-visible)
|
|
(kill-local-variable 'mono-complete--preview-timer))
|
|
|
|
|
|
(defun mono-complete--expand-impl ()
|
|
"Expand the completion, return non-nil on success."
|
|
(let ((text (mono-complete--preview-text-from-command)))
|
|
(cond
|
|
(text
|
|
(cond
|
|
(mono-complete-literal-input
|
|
(let ((mono-complete--suppress-command-hooks t))
|
|
(mono-complete--insert-with-literal-input text)))
|
|
(t
|
|
(insert text)))
|
|
|
|
;; This would be called anyway in the post-command hook,
|
|
;; nevertheless, call early as this is known to be invalid at this point.
|
|
(mono-complete--on-exit)
|
|
|
|
t)
|
|
|
|
(t
|
|
nil))))
|
|
|
|
|
|
;; ---------------------------------------------------------------------------
|
|
;; Public API
|
|
|
|
;;;###autoload
|
|
(defun mono-complete-expand ()
|
|
"Expand the completion, return non-nil on success."
|
|
(interactive)
|
|
(when (mono-complete--interactive-or-non-literal-input)
|
|
(mono-complete--expand-impl)))
|
|
|
|
;;;###autoload
|
|
(defun mono-complete-expand-or-fallback ()
|
|
"Expand the completion, return non-nil on success.
|
|
Otherwise run `mono-complete-callback-fn' and return it's result."
|
|
(interactive)
|
|
(when (mono-complete--interactive-or-non-literal-input)
|
|
(let ((result (mono-complete--expand-impl)))
|
|
(cond
|
|
(result
|
|
result)
|
|
(t
|
|
(cond
|
|
(mono-complete-literal-input
|
|
(let ((mono-complete--suppress-command-hooks t))
|
|
(mono-complete--call-interactively-macro mono-complete-fallback-command)))
|
|
(t
|
|
(call-interactively mono-complete-fallback-command))))))))
|
|
|
|
;;;###autoload
|
|
(define-minor-mode mono-complete-mode
|
|
"Enable enhanced compilation."
|
|
:global nil
|
|
|
|
(cond
|
|
(mono-complete-mode
|
|
(mono-complete--mode-enable))
|
|
(t
|
|
(mono-complete--mode-disable))))
|
|
|
|
|
|
(provide 'mono-complete)
|
|
|
|
;;; mono-complete.el ends here
|