1 ;;; fuel-completion.el -- completion utilities -*- lexical-binding: t -*-
3 ;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz
4 ;; See https://factorcode.org/license.txt for BSD license.
6 ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
7 ;; Keywords: languages, fuel, factor
8 ;; Start date: Sun Dec 14, 2008 21:17
12 ;; Code completion utilities.
19 (require 'factor-mode)
24 (defvar fuel-completion--minibuffer-map
25 (let ((map (make-keymap)))
26 (set-keymap-parent map minibuffer-local-completion-map)
27 (define-key map "?" 'self-insert-command)
31 ;;; Vocabs dictionary:
33 (defvar fuel-completion--vocabs nil)
35 (defun fuel-completion--vocabs (&optional reload)
36 (when (or reload (not fuel-completion--vocabs))
37 (fuel-respecting-message "Retrieving vocabs list")
38 (let ((fuel-log--inhibit-p t))
39 (setq fuel-completion--vocabs
40 (fuel-eval--retort-result
41 (fuel-eval--send/wait '(:fuel* (fuel-get-vocabs) "fuel" (:array)))))))
42 fuel-completion--vocabs)
44 (defvar fuel-completion--vocab-history nil)
46 (defun fuel-completion--read-vocab (&optional reload init-input history)
47 (let ((minibuffer-local-completion-map fuel-completion--minibuffer-map)
48 (vocabs (fuel-completion--vocabs reload)))
49 (completing-read "Vocab name: " vocabs nil nil
50 init-input (or history fuel-completion--vocab-history))))
52 (defun fuel-completion--words (prefix vocabs)
53 (let ((vs (if vocabs (cons :array vocabs) 'f))
55 (fuel-eval--retort-result
56 (fuel-eval--send/wait `(:fuel* (,prefix ,vs fuel-get-words) t ,us)))))
59 ;;; Completions window handling, heavily inspired in slime's:
61 (defvar fuel-completion--comp-buffer "*Completions*")
63 (defvar-local fuel-completion--window-cfg nil
64 "Window configuration before we show the *Completions* buffer.
65 This is buffer local in the buffer where the completion is
68 (defvar-local fuel-completion--completions-window nil
69 "The window displaying *Completions* after saving window configuration.
70 If this window is no longer active or displaying the completions
71 buffer then we can ignore `fuel-completion--window-cfg'.")
73 (defun fuel-completion--save-window-cfg ()
74 "Maybe save the current window configuration.
75 Return true if the configuration was saved."
76 (unless (or fuel-completion--window-cfg
77 (get-buffer-window fuel-completion--comp-buffer))
78 (setq fuel-completion--window-cfg
79 (current-window-configuration))
82 (defun fuel-completion--delay-restoration ()
83 (add-hook 'pre-command-hook
84 'fuel-completion--maybe-restore-window-cfg
87 (defun fuel-completion--forget-window-cfg ()
88 (setq fuel-completion--window-cfg nil)
89 (setq fuel-completion--completions-window nil))
91 (defun fuel-completion--restore-window-cfg ()
92 "Restore the window config if available."
93 (remove-hook 'pre-command-hook
94 'fuel-completion--maybe-restore-window-cfg)
95 (when (and fuel-completion--window-cfg
96 (fuel-completion--window-active-p))
98 (set-window-configuration fuel-completion--window-cfg))
99 (setq fuel-completion--window-cfg nil)
100 (when (buffer-live-p fuel-completion--comp-buffer)
101 (kill-buffer fuel-completion--comp-buffer))))
103 (defun fuel-completion--maybe-restore-window-cfg ()
104 "Restore the window configuration, if the following command
105 terminates a current completion."
106 (remove-hook 'pre-command-hook
107 'fuel-completion--maybe-restore-window-cfg)
109 (cond ((cl-find last-command-event "()\"'`,# \r\n:")
110 (fuel-completion--restore-window-cfg))
111 ((not (fuel-completion--window-active-p))
112 (fuel-completion--forget-window-cfg))
113 (t (fuel-completion--delay-restoration)))
115 ;; Because this is called on the pre-command-hook, we mustn't let
117 (message "Error in fuel-completion--restore-window-cfg: %S" err))))
119 (defun fuel-completion--window-active-p ()
120 "Is the completion window currently active?"
121 (and (window-live-p fuel-completion--completions-window)
122 (equal (buffer-name (window-buffer fuel-completion--completions-window))
123 fuel-completion--comp-buffer)))
125 (defun fuel-completion--display-comp-list (completions base)
126 (let ((savedp (fuel-completion--save-window-cfg)))
127 (with-output-to-temp-buffer fuel-completion--comp-buffer
128 (display-completion-list completions base)
129 (let ((offset (- (point) 1 (length base))))
130 (with-current-buffer standard-output
131 (setq completion-base-position offset)
132 (set-syntax-table factor-mode-syntax-table))))
134 (setq fuel-completion--completions-window
135 (get-buffer-window fuel-completion--comp-buffer)))))
137 (defun fuel-completion--display-or-scroll (completions base)
138 (cond ((and (eq last-command this-command) (fuel-completion--window-active-p))
139 (fuel-completion--scroll-completions))
140 (t (fuel-completion--display-comp-list completions base)))
141 (fuel-completion--delay-restoration))
143 (defun fuel-completion--scroll-completions ()
144 (let ((window fuel-completion--completions-window))
145 (with-current-buffer (window-buffer window)
146 (if (pos-visible-in-window-p (point-max) window)
147 (set-window-start window (point-min))
148 (save-selected-window
149 (select-window window)
153 ;;; Completion functionality:
155 (defun fuel-completion--word-list (prefix)
156 (let* ((fuel-log--inhibit-p t)
157 (cv (factor-current-vocab))
158 (vs (and cv `("syntax" ,cv ,@(factor-usings)))))
159 (fuel-completion--words prefix vs)))
161 (defsubst fuel-completion--all-words-list (prefix)
162 (fuel-completion--words prefix nil))
164 (defvar fuel-completion--word-list-func
165 (completion-table-dynamic 'fuel-completion--word-list))
167 (defvar fuel-completion--all-words-list-func
168 (completion-table-dynamic 'fuel-completion--all-words-list))
170 (defun fuel-completion--complete (prefix vocabs)
171 (let* ((words (if vocabs
172 (fuel-completion--vocabs)
173 (fuel-completion--word-list prefix)))
174 (completions (all-completions prefix words))
175 (partial (try-completion prefix words))
176 (partial (if (eq partial t) prefix partial)))
177 (cons completions partial)))
179 (defun fuel-completion--read-word (prompt &optional default history all)
180 (let ((minibuffer-local-completion-map fuel-completion--minibuffer-map))
181 (completing-read prompt
182 (if all fuel-completion--all-words-list-func
183 fuel-completion--word-list-func)
186 (or default (factor-symbol-at-point)))))
188 (defun fuel-completion--complete-symbol ()
189 "Complete the symbol at point.
190 Perform completion similar to Emacs' complete-symbol."
193 (beg (save-excursion (factor-beginning-of-symbol) (point)))
194 (prefix (buffer-substring-no-properties beg end))
195 (result (fuel-completion--complete prefix (factor-on-vocab)))
196 (completions (car result))
197 (partial (cdr result)))
198 (cond ((null completions)
199 (fuel-respecting-message "Can't find completion for %S" prefix)
200 (fuel-completion--restore-window-cfg))
201 (t (insert-and-inherit (substring partial (length prefix)))
202 (cond ((= (length completions) 1)
203 (fuel-respecting-message "Sole completion")
204 (fuel-completion--restore-window-cfg))
205 (t (fuel-respecting-message "Complete but not unique")
206 (fuel-completion--display-or-scroll completions
210 (provide 'fuel-completion)
211 ;;; fuel-completion.el ends here