|
0
|
1 ;;; -*- Mode: Emacs-Lisp -*-
|
|
|
2
|
|
|
3 ;;; ilisp-cmp.el --
|
|
|
4
|
|
|
5 ;;; This file is part of ILISP.
|
|
4
|
6 ;;; Version: 5.8
|
|
0
|
7 ;;;
|
|
|
8 ;;; Copyright (C) 1990, 1991, 1992, 1993 Chris McConnell
|
|
|
9 ;;; 1993, 1994 Ivan Vasquez
|
|
4
|
10 ;;; 1994, 1995, 1996 Marco Antoniotti and Rick Busdiecker
|
|
|
11 ;;; 1996 Marco Antoniotti and Rick Campbell
|
|
0
|
12 ;;;
|
|
|
13 ;;; Other authors' names for which this Copyright notice also holds
|
|
|
14 ;;; may appear later in this file.
|
|
|
15 ;;;
|
|
4
|
16 ;;; Send mail to 'ilisp-request@naggum.no' to be included in the
|
|
|
17 ;;; ILISP mailing list. 'ilisp@naggum.no' is the general ILISP
|
|
0
|
18 ;;; mailing list were bugs and improvements are discussed.
|
|
|
19 ;;;
|
|
|
20 ;;; ILISP is freely redistributable under the terms found in the file
|
|
|
21 ;;; COPYING.
|
|
|
22
|
|
|
23
|
|
|
24
|
|
|
25 ;;;
|
|
|
26 ;;; ILISP completion
|
|
|
27 ;;;
|
|
|
28 ;;;
|
|
|
29 ;;;%Completion
|
|
|
30 ;;; The basic idea behind the completion stuff is to use as much of
|
|
|
31 ;;; the standard Emacs stuff as possible. The extensions here go out
|
|
|
32 ;;; to the inferior LISP to complete symbols if necessary.
|
|
|
33 ;;;
|
|
|
34 (defun ilisp-display-choices (symbol choices)
|
|
|
35 "Display the possible choices for SYMBOL in alist CHOICES."
|
|
|
36 (with-output-to-temp-buffer "*Completions*"
|
|
|
37 (display-completion-list
|
|
|
38 (sort
|
|
|
39 (all-completions (lisp-symbol-name symbol) choices)
|
|
|
40 'string-lessp))))
|
|
|
41
|
|
|
42 ;;;%%ilisp-can-complete
|
|
|
43 (defun ilisp-can-complete (symbol function-p)
|
|
|
44 "Return T if ilisp completion can complete SYMBOL from the current table."
|
|
|
45 (and ilisp-original
|
|
|
46 (string= (lisp-symbol-package ilisp-original)
|
|
|
47 (lisp-symbol-package symbol))
|
|
|
48 (string= (lisp-symbol-delimiter ilisp-original)
|
|
|
49 (lisp-symbol-delimiter symbol))
|
|
|
50 (lisp-prefix-p (lisp-symbol-name ilisp-original)
|
|
|
51 (lisp-symbol-name symbol))
|
|
|
52 (eq function-p ilisp-original-function-p)))
|
|
|
53
|
|
|
54 ;;;%%ilisp-complete
|
|
|
55 (defun ilisp-complete (symbol &optional function-p)
|
|
|
56 "Return a list of the possible completions for symbol from the
|
|
|
57 inferior LISP. If FUNCTION-P is T, only symbols with function
|
|
|
58 bindings will be considered. If no package is specified the buffer
|
|
|
59 package will be used."
|
|
|
60 (let* ((choices
|
|
|
61 (ilisp-send
|
|
|
62 (format (ilisp-value 'ilisp-complete-command)
|
|
|
63 (lisp-symbol-name symbol) (lisp-symbol-package symbol)
|
|
|
64 function-p
|
|
|
65 (string= (lisp-symbol-delimiter symbol) ":")
|
|
|
66 ilisp-prefix-match)
|
|
|
67 (if (not ilisp-complete)
|
|
|
68 (concat "Complete "
|
|
|
69 (if function-p "function ")
|
|
|
70 (lisp-buffer-symbol symbol)))
|
|
|
71 'complete)))
|
|
|
72 (if (ilisp-value 'comint-errorp t)
|
|
|
73 (progn (lisp-display-output choices)
|
|
|
74 (error "Error completing %s" (lisp-buffer-symbol symbol)))
|
|
|
75 (setq choices (read choices)
|
|
|
76 choices (if (eq choices 'NIL) nil choices)))
|
|
|
77 (setq ilisp-original symbol
|
|
|
78 ilisp-original-function-p function-p
|
|
|
79 ilisp-original-table choices)))
|
|
|
80
|
|
|
81 ;;;%%ilisp-completion-table
|
|
|
82 (defun ilisp-completion-table (symbol function-p)
|
|
|
83 "Return the completion table for SYMBOL trying to use the current
|
|
|
84 one. If FUNCTION-P is T, only symbols with function cells will be
|
|
|
85 returned."
|
|
|
86 (if (ilisp-can-complete symbol function-p)
|
|
|
87 ilisp-original-table
|
|
|
88 (ilisp-complete symbol function-p)))
|
|
|
89
|
|
|
90 ;;;%%Minibuffer completion
|
|
|
91 (defun ilisp-restore-prefix ()
|
|
|
92 "Restore the prefix from ilisp-mini-prefix at the start of the
|
|
|
93 minibuffer."
|
|
|
94 (if ilisp-mini-prefix
|
|
|
95 (save-excursion
|
|
|
96 (goto-char (point-min))
|
|
|
97 (insert ilisp-mini-prefix)
|
|
|
98 (setq ilisp-mini-prefix nil))))
|
|
|
99
|
|
|
100 ;;;
|
|
|
101 (defun ilisp-current-choice ()
|
|
|
102 "Set up the minibuffer completion table for the current symbol.
|
|
|
103 If there is a paren at the start of the minibuffer, or there is not an
|
|
|
104 ilisp-table, this will be from the inferior LISP. Otherwise, it will
|
|
|
105 be the ilisp-table."
|
|
|
106 (if (or (null ilisp-table) (eq (char-after 1) ?\())
|
|
|
107 (progn
|
|
|
108 (let* ((symbol-info (lisp-previous-symbol))
|
|
|
109 (symbol (car symbol-info)))
|
|
|
110 (setq minibuffer-completion-table
|
|
|
111 (ilisp-completion-table symbol ilisp-completion-function-p)))
|
|
|
112 (save-excursion
|
|
|
113 (skip-chars-backward "^: \(")
|
|
|
114 (setq ilisp-mini-prefix (buffer-substring (point-min) (point)))
|
|
|
115 (delete-region (point-min) (point)))
|
|
|
116 ;; Nothing can match this table
|
|
|
117 (if (not minibuffer-completion-table)
|
|
|
118 (setq minibuffer-completion-table '((" ")))))
|
|
|
119 (setq minibuffer-completion-table ilisp-table
|
|
|
120 minibuffer-completion-predicate nil)))
|
|
|
121
|
|
|
122 ;;;%%Commands
|
|
|
123 (defvar ilisp-completion-help
|
|
|
124 (lookup-key minibuffer-local-must-match-map "?"))
|
|
|
125 (defun ilisp-completion-help ()
|
|
|
126 "Inferior LISP minibuffer completion help."
|
|
|
127 (interactive)
|
|
|
128 (ilisp-current-choice)
|
|
|
129 (funcall ilisp-completion-help)
|
|
|
130 (ilisp-restore-prefix))
|
|
|
131
|
|
|
132 ;;;
|
|
|
133 (defvar ilisp-completion
|
|
|
134 (lookup-key minibuffer-local-must-match-map "\t"))
|
|
|
135 (defun ilisp-completion ()
|
|
|
136 "Inferior LISP minibuffer complete."
|
|
|
137 (interactive)
|
|
|
138 (ilisp-current-choice)
|
|
|
139 (funcall ilisp-completion)
|
|
|
140 (ilisp-restore-prefix))
|
|
|
141
|
|
|
142 ;;;
|
|
|
143 (defvar ilisp-completion-word
|
|
|
144 (lookup-key minibuffer-local-must-match-map " "))
|
|
|
145 (defun ilisp-completion-word ()
|
|
|
146 "Inferior LISP minibuffer complete word."
|
|
|
147 (interactive)
|
|
|
148 (if (eq (char-after 1) ?\()
|
|
|
149 (insert " ")
|
|
|
150 (ilisp-current-choice)
|
|
|
151 (funcall ilisp-completion-word)
|
|
|
152 (ilisp-restore-prefix)))
|
|
|
153
|
|
|
154 ;;;
|
|
|
155 (defun ilisp-completion-paren ()
|
|
|
156 "Only allow a paren if ilisp-paren is T."
|
|
|
157 (interactive)
|
|
|
158 (if ilisp-paren
|
|
|
159 (if (or (eq last-input-char ?\() (eq (char-after 1) ?\())
|
|
|
160 (insert last-input-char)
|
|
|
161 (beep))
|
|
|
162 (beep)))
|
|
|
163
|
|
|
164 ;;;
|
|
|
165 (defvar ilisp-completion-exit
|
|
|
166 (lookup-key minibuffer-local-must-match-map "\n"))
|
|
|
167 (defun ilisp-completion-exit ()
|
|
|
168 "Inferior LISP completion complete and exit."
|
|
|
169 (interactive)
|
|
|
170 (if (eq (char-after 1) ?\()
|
|
|
171 (progn (find-unbalanced-lisp nil)
|
|
|
172 (exit-minibuffer))
|
|
|
173 (if ilisp-no-complete
|
|
|
174 (exit-minibuffer)
|
|
|
175 (if (= (point-min) (point-max))
|
|
|
176 (exit-minibuffer)
|
|
|
177 (ilisp-current-choice)
|
|
|
178 (unwind-protect (funcall ilisp-completion-exit)
|
|
|
179 (ilisp-restore-prefix))))))
|
|
|
180
|
|
|
181 ;;;%%ilisp-completer
|
|
|
182 (defun ilisp-completer (symbol function-p)
|
|
|
183 "Complete SYMBOL from the inferior LISP using only function symbols
|
|
|
184 if FUNCTION-P is T. Return (SYMBOL LCS-SYMBOL CHOICES UNIQUEP)."
|
|
|
185 (let* ((name (lisp-symbol-name symbol))
|
|
|
186 (table (ilisp-completion-table symbol function-p))
|
|
|
187 (choice (and table (try-completion name table))))
|
|
|
188 (cond ((eq choice t) ;Name is it
|
|
|
189 (list symbol symbol nil t))
|
|
|
190 ((string= name choice) ;Name is LCS
|
|
|
191 (list symbol symbol (all-completions name table) nil))
|
|
|
192 (choice ;New LCS
|
|
|
193 (let ((symbol
|
|
|
194 (lisp-symbol (lisp-symbol-package symbol)
|
|
|
195 (lisp-symbol-delimiter symbol)
|
|
|
196 choice)))
|
|
|
197 (list symbol symbol (all-completions choice table) nil)))
|
|
|
198 ((and (not ilisp-prefix-match) table) ;Try partial matches
|
|
|
199 (let ((matches
|
|
|
200 (completer name table nil (regexp-quote completer-words))))
|
|
|
201 (cons (lisp-symbol (lisp-symbol-package symbol)
|
|
|
202 (lisp-symbol-delimiter symbol)
|
|
|
203 (car matches))
|
|
|
204 (cons (lisp-symbol (lisp-symbol-package symbol)
|
|
|
205 (lisp-symbol-delimiter symbol)
|
|
|
206 (car (cdr matches)))
|
|
|
207 (cdr (cdr matches)))))))))
|
|
|
208
|
|
|
209
|
|
|
210 ;;;%%ilisp-read
|
|
|
211 (defun ilisp-completion-map ()
|
|
|
212 "Set up the ilisp-completion-map from lisp-mode-map for the ilisp
|
|
|
213 readers and return it."
|
|
|
214 (if (not ilisp-completion-map)
|
|
|
215 (progn
|
|
|
216 (if (fboundp 'set-keymap-parent)
|
|
|
217 (progn
|
|
|
218 (setq ilisp-completion-map (make-sparse-keymap))
|
|
|
219 (set-keymap-parent ilisp-completion-map lisp-mode-map))
|
|
|
220 (setq ilisp-completion-map (copy-keymap lisp-mode-map)))
|
|
|
221 (define-key ilisp-completion-map " " 'ilisp-completion-word)
|
|
|
222 (define-key ilisp-completion-map "\t" 'ilisp-completion)
|
|
|
223 (define-key ilisp-completion-map "?" 'ilisp-completion-help)
|
|
|
224 (define-key ilisp-completion-map "\M-\t" 'ilisp-completion)
|
|
|
225 (define-key ilisp-completion-map "\n" 'ilisp-completion-exit)
|
|
|
226 (define-key ilisp-completion-map "\r" 'ilisp-completion-exit)
|
|
|
227 (define-key ilisp-completion-map "\C-g" 'abort-recursive-edit)
|
|
|
228 (define-key ilisp-completion-map "(" 'ilisp-completion-paren)
|
|
|
229 (define-key ilisp-completion-map ")" 'ilisp-completion-paren)
|
|
|
230 (define-key ilisp-completion-map "'" nil)
|
|
|
231 (define-key ilisp-completion-map "#" nil)
|
|
|
232 (define-key ilisp-completion-map "\"" nil)))
|
|
|
233 ilisp-completion-map)
|
|
|
234
|
|
|
235 ;;;
|
|
|
236 (defun ilisp-read (prompt &optional initial-contents)
|
|
|
237 "PROMPT in the minibuffer with optional INITIAL-CONTENTS and return
|
|
|
238 the result. Completion of symbols though the inferior LISP is
|
|
|
239 allowed."
|
|
|
240 (let ((ilisp-complete t)
|
|
|
241 (ilisp-paren t)
|
|
|
242 (ilisp-no-complete t)
|
|
|
243 (ilisp-completion-package (lisp-buffer-package)))
|
|
|
244 (read-from-minibuffer prompt initial-contents
|
|
|
245 (ilisp-completion-map))))
|
|
|
246
|
|
|
247 ;;;%%lisp-read-program
|
|
|
248 (defvar lisp-program-map nil
|
|
|
249 "Minibuffer map for reading a program and arguments.")
|
|
|
250
|
|
|
251 ;;;
|
|
|
252 (defun lisp-read-program (prompt &optional initial)
|
|
|
253 "Read a program with PROMPT and INITIAL. TAB or Esc-TAB will complete
|
|
|
254 filenames."
|
|
|
255 (if (null lisp-program-map)
|
|
|
256 (progn
|
|
|
257 (if (fboundp 'set-keymap-parent)
|
|
|
258 (progn
|
|
|
259 (setq lisp-program-map (make-sparse-keymap))
|
|
|
260 (set-keymap-parent lisp-program-map minibuffer-local-map))
|
|
|
261 (setq lisp-program-map (copy-keymap minibuffer-local-map)))
|
|
|
262 (define-key lisp-program-map "\M-\t" 'comint-dynamic-complete)
|
|
|
263 (define-key lisp-program-map "\t" 'comint-dynamic-complete)
|
|
|
264 (define-key lisp-program-map "?" 'comint-dynamic-list-completions)))
|
|
|
265 (read-from-minibuffer prompt initial lisp-program-map))
|
|
|
266
|
|
|
267 ;;;%%ilisp-read-symbol
|
|
|
268 (defun ilisp-read-symbol (prompt &optional default function-p no-complete)
|
|
|
269 "PROMPT in the minibuffer with optional DEFAULT and return a symbol
|
|
|
270 from the inferior LISP. If FUNCTION-P is T, only symbols with
|
|
|
271 function values will be returned. If NO-COMPLETE is T, then
|
|
|
272 uncompleted symbols will be allowed."
|
|
|
273 (let* ((ilisp-complete t)
|
|
|
274 (ilisp-no-complete no-complete)
|
|
|
275 (ilisp-completion-package (lisp-buffer-package))
|
|
|
276 (ilisp-completion-function-p function-p)
|
|
|
277 (string (read-from-minibuffer prompt nil (ilisp-completion-map))))
|
|
|
278 (if (equal string "")
|
|
|
279 default
|
|
|
280 (lisp-string-to-symbol string))))
|
|
|
281
|
|
|
282 ;;;%%ilisp-completing-read
|
|
|
283 (defun ilisp-completing-read (prompt table &optional default)
|
|
|
284 "Read with PROMPT from an alist of TABLE. No input returns DEFAULT.
|
|
|
285 Symbols are from table, other specs are in parentheses."
|
|
|
286 (let* ((ilisp-complete t)
|
|
|
287 (ilisp-table table)
|
|
|
288 (ilisp-completion-package (lisp-buffer-package))
|
|
|
289 (ilisp-paren
|
|
|
290 (let ((entry table) (done nil))
|
|
|
291 (while (and entry (not done))
|
|
|
292 (setq done (= (elt (car (car entry)) 0) ?\()
|
|
|
293 entry (cdr entry)))
|
|
|
294 done))
|
|
|
295 (string (read-from-minibuffer prompt nil (ilisp-completion-map))))
|
|
|
296 (if (string= string "") default string)))
|
|
|
297
|
|
|
298
|
|
|
299
|
|
|
300 ;;;%%complete-lisp
|
|
|
301 (autoload 'complete "completion" "Complete previous symbol." t)
|
|
|
302 (defun complete-lisp (mode)
|
|
|
303 "Complete the current symbol using information from the current
|
|
|
304 ILISP buffer. If in a string, complete as a filename. If called with
|
|
|
305 a positive prefix force all symbols to be considered. If called with
|
|
|
306 a negative prefix, undo the last completion. Partial completion is
|
|
|
307 allowed unless ilisp-prefix-match is T. If a symbol starts after a
|
|
|
308 left paren or #', then only function symbols will be considered.
|
|
|
309 Package specifications are also allowed and the distinction between
|
|
|
310 internal and exported symbols is considered."
|
|
|
311 (interactive "P")
|
|
|
312 (if (< (prefix-numeric-value mode) 0)
|
|
|
313 (completer-undo)
|
|
|
314 (let* ((filep
|
|
|
315 (save-excursion
|
|
|
316 (skip-chars-backward "^ \t\n")
|
|
|
317 (= (char-after (point)) ?\"))))
|
|
|
318 (if filep
|
|
|
319 (comint-dynamic-complete)
|
|
|
320 (let* ((symbol-info (lisp-previous-symbol))
|
|
|
321 (symbol (car symbol-info))
|
|
|
322 (name (lisp-symbol-name symbol))
|
|
|
323 (choice (ilisp-completer
|
|
|
324 symbol
|
|
|
325 (if (not mode) (car (cdr symbol-info)))))
|
|
|
326 (match (lisp-buffer-symbol (car choice)))
|
|
|
327 (lcs (lisp-buffer-symbol (car (cdr choice))))
|
|
|
328 (choices (car (cdr (cdr choice))))
|
|
|
329 (unique (car (cdr (cdr (cdr choice))))))
|
|
|
330 (skip-chars-backward " \t\n")
|
|
|
331 (completer-goto match lcs choices unique
|
|
|
332 (ilisp-value 'ilisp-symbol-delimiters)
|
|
|
333 completer-words)))
|
|
|
334 (message "Completed"))))
|
|
|
335
|
