Commit | Line | Data |
---|---|---|
e21766aa CY |
1 | ;;; sym-comp.el --- mode-dependent symbol completion |
2 | ||
4fe4d285 | 3 | ;; Copyright (C) 2004, 2008 Free Software Foundation, Inc. |
e21766aa CY |
4 | |
5 | ;; Author: Dave Love <fx@gnu.org> | |
6 | ;; Keywords: extensions | |
e21766aa CY |
7 | ;; URL: http://www.loveshack.ukfsn.org/emacs |
8 | ||
3d452bde GM |
9 | ;; This file is part of GNU Emacs. |
10 | ||
b1fc2b50 | 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
e21766aa | 12 | ;; it under the terms of the GNU General Public License as published by |
b1fc2b50 GM |
13 | ;; the Free Software Foundation, either version 3 of the License, or |
14 | ;; (at your option) any later version. | |
e21766aa | 15 | |
3d452bde | 16 | ;; GNU Emacs is distributed in the hope that it will be useful, |
e21766aa CY |
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | ;; GNU General Public License for more details. | |
20 | ||
21 | ;; You should have received a copy of the GNU General Public License | |
b1fc2b50 | 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
e21766aa CY |
23 | |
24 | ;;; Commentary: | |
25 | ||
26 | ;; This defines `symbol-complete', which is a generalization of the | |
27 | ;; old `lisp-complete-symbol'. It provides the following hooks to | |
28 | ;; allow major modes to set up completion appropriate for the mode: | |
29 | ;; `symbol-completion-symbol-function', | |
30 | ;; `symbol-completion-completions-function', | |
31 | ;; `symbol-completion-predicate-function', | |
32 | ;; `symbol-completion-transform-function'. Typically it is only | |
33 | ;; necessary for a mode to set | |
34 | ;; `symbol-completion-completions-function' locally and to bind | |
35 | ;; `symbol-complete' appropriately. | |
36 | ||
37 | ;; It's unfortunate that there doesn't seem to be a good way of | |
38 | ;; combining this with `complete-symbol'. | |
39 | ||
40 | ;; There is also `symbol-completion-try-complete', for use with | |
41 | ;; Hippie-exp. | |
42 | ||
43 | ;;; Code: | |
44 | ||
45 | ;;;; Mode-dependent symbol completion. | |
46 | ||
47 | (defun symbol-completion-symbol () | |
48 | "Default `symbol-completion-symbol-function'. | |
49 | Uses `current-word' with the buffer narrowed to the part before | |
50 | point." | |
51 | (save-restriction | |
52 | ;; Narrow in case point is in the middle of a symbol -- we want | |
53 | ;; just the preceeding part. | |
54 | (narrow-to-region (point-min) (point)) | |
55 | (current-word))) | |
56 | ||
57 | (defvar symbol-completion-symbol-function 'symbol-completion-symbol | |
58 | "Function to return a partial symbol before point for completion. | |
59 | The value it returns should be a string (or nil). | |
60 | Major modes may set this locally if the default isn't appropriate.") | |
61 | ||
62 | (defvar symbol-completion-completions-function nil | |
63 | "Function to return possible symbol completions. | |
64 | It takes an argument which is the string to be completed and | |
65 | returns a value suitable for the second argument of | |
66 | `try-completion'. This value need not use the argument, i.e. it | |
67 | may be all possible completions, such as `obarray' in the case of | |
68 | Emacs Lisp. | |
69 | ||
70 | Major modes may set this locally to allow them to support | |
71 | `symbol-complete'. See also `symbol-completion-symbol-function', | |
72 | `symbol-completion-predicate-function' and | |
73 | `symbol-completion-transform-function'.") | |
74 | ||
75 | (defvar symbol-completion-predicate-function nil | |
76 | "If non-nil, function to return a predicate for selecting symbol completions. | |
77 | The function gets two args, the positions of the beginning and | |
78 | end of the symbol to be completed. | |
79 | ||
80 | Major modes may set this locally if the default isn't | |
81 | appropriate. This is a function returning a predicate so that | |
82 | the predicate can be context-dependent, e.g. to select only | |
83 | function names if point is at a function call position. The | |
84 | function's args may be useful for determining the context.") | |
85 | ||
86 | (defvar symbol-completion-transform-function nil | |
87 | "If non-nil, function to transform symbols in the symbol-completion buffer. | |
88 | E.g., for Lisp, it may annotate the symbol as being a function, | |
89 | not a variable. | |
90 | ||
91 | The function takes the symbol name as argument. If it needs to | |
92 | annotate this, it should return a value suitable as an element of | |
93 | the list passed to `display-completion-list'. | |
94 | ||
95 | The predicate being used for selecting completions (from | |
96 | `symbol-completion-predicate-function') is available | |
97 | dynamically-bound as `symbol-completion-predicate' in case the | |
98 | transform needs it.") | |
99 | ||
100 | (defvar displayed-completions) | |
101 | ||
102 | ;;;###autoload | |
103 | (defun symbol-complete (&optional predicate) | |
104 | "Perform completion of the symbol preceding point. | |
105 | This is done in a way appropriate to the current major mode, | |
106 | perhaps by interrogating an inferior interpreter. Compare | |
107 | `complete-symbol'. | |
108 | If no characters can be completed, display a list of possible completions. | |
109 | Repeating the command at that point scrolls the list. | |
110 | ||
111 | When called from a program, optional arg PREDICATE is a predicate | |
112 | determining which symbols are considered. | |
113 | ||
114 | This function requires `symbol-completion-completions-function' | |
115 | to be set buffer-locally. Variables `symbol-completion-symbol-function', | |
116 | `symbol-completion-predicate-function' and | |
117 | `symbol-completion-transform-function' are also consulted." | |
118 | (interactive) | |
119 | ;; Fixme: Punt to `complete-symbol' in this case? | |
120 | (unless (functionp symbol-completion-completions-function) | |
121 | (error "symbol-completion-completions-function not defined")) | |
122 | (let ((window (get-buffer-window "*Completions*"))) | |
123 | (let* ((pattern (or (funcall symbol-completion-symbol-function) | |
124 | (error "No preceding symbol to complete"))) | |
125 | (predicate (or predicate | |
126 | (if symbol-completion-predicate-function | |
127 | (funcall symbol-completion-predicate-function | |
128 | (- (point) (length pattern)) | |
129 | (point))))) | |
130 | (completions (funcall symbol-completion-completions-function | |
131 | pattern)) | |
132 | (completion (try-completion pattern completions predicate))) | |
133 | ;; If this command was repeated, and there's a fresh completion | |
134 | ;; window with a live buffer and a displayed completion list | |
135 | ;; matching the current completions, then scroll the window. | |
136 | (unless (and (eq last-command this-command) | |
137 | window (window-live-p window) (window-buffer window) | |
138 | (buffer-name (window-buffer window)) | |
139 | (with-current-buffer (window-buffer window) | |
140 | (if (equal displayed-completions | |
141 | (all-completions pattern completions predicate)) | |
142 | (progn | |
143 | (if (pos-visible-in-window-p (point-max) window) | |
144 | (set-window-start window (point-min)) | |
145 | (save-selected-window | |
146 | (select-window window) | |
147 | (scroll-up))) | |
148 | t)))) | |
149 | ;; Otherwise, do completion. | |
150 | (cond ((eq completion t)) | |
151 | ((null completion) | |
152 | (message "Can't find completion for \"%s\"" pattern) | |
153 | (ding)) | |
154 | ((not (string= pattern completion)) | |
155 | (delete-region (- (point) (length pattern)) (point)) | |
156 | (insert completion)) | |
157 | (t | |
158 | (message "Making completion list...") | |
159 | (let* ((list (all-completions pattern completions predicate)) | |
160 | ;; In case the transform needs to access it. | |
161 | (symbol-completion-predicate predicate) | |
162 | ;; Copy since list is side-effected by sorting. | |
163 | (copy (copy-sequence list))) | |
164 | (setq list (sort list 'string<)) | |
165 | (if (functionp symbol-completion-transform-function) | |
166 | (setq list | |
167 | (mapcar (funcall | |
168 | symbol-completion-transform-function) | |
169 | list))) | |
170 | (with-output-to-temp-buffer "*Completions*" | |
171 | (condition-case () | |
172 | (display-completion-list list pattern) ; Emacs 22 | |
173 | (error (display-completion-list list)))) | |
174 | ;; Record the list for determining whether to scroll | |
175 | ;; (above). | |
176 | (with-current-buffer "*Completions*" | |
177 | (set (make-local-variable 'displayed-completions) copy))) | |
178 | (message "Making completion list...%s" "done"))))))) | |
179 | \f | |
180 | (eval-when-compile (require 'hippie-exp)) | |
181 | ||
182 | ;;;###autoload | |
183 | (defun symbol-completion-try-complete (old) | |
184 | "Completion function for use with `hippie-expand'. | |
185 | Uses `symbol-completion-symbol-function' and | |
186 | `symbol-completion-completions-function'. It is intended to be | |
187 | used something like this in a major mode which provides symbol | |
188 | completion: | |
189 | ||
190 | (if (featurep 'hippie-exp) | |
191 | (set (make-local-variable 'hippie-expand-try-functions-list) | |
192 | (cons 'symbol-completion-try-complete | |
193 | hippie-expand-try-functions-list)))" | |
194 | (when (and symbol-completion-symbol-function | |
195 | symbol-completion-completions-function) | |
196 | (unless old | |
197 | (let ((symbol (funcall symbol-completion-symbol-function))) | |
198 | (he-init-string (- (point) (length symbol)) (point)) | |
199 | (if (not (he-string-member he-search-string he-tried-table)) | |
200 | (push he-search-string he-tried-table)) | |
201 | (setq he-expand-list | |
202 | (and symbol | |
203 | (funcall symbol-completion-completions-function symbol))))) | |
204 | (while (and he-expand-list | |
205 | (he-string-member (car he-expand-list) he-tried-table)) | |
206 | (pop he-expand-list)) | |
207 | (if he-expand-list | |
208 | (progn | |
209 | (he-substitute-string (pop he-expand-list)) | |
210 | t) | |
211 | (if old (he-reset-string)) | |
212 | nil))) | |
213 | \f | |
214 | ;;; Emacs Lisp symbol completion. | |
215 | ||
216 | (defun lisp-completion-symbol () | |
217 | "`symbol-completion-symbol-function' for Lisp." | |
218 | (let ((end (point)) | |
219 | (beg (with-syntax-table emacs-lisp-mode-syntax-table | |
220 | (save-excursion | |
221 | (backward-sexp 1) | |
222 | (while (= (char-syntax (following-char)) ?\') | |
223 | (forward-char 1)) | |
224 | (point))))) | |
225 | (buffer-substring-no-properties beg end))) | |
226 | ||
227 | (defun lisp-completion-predicate (beg end) | |
228 | "`symbol-completion-predicate-function' for Lisp." | |
229 | (save-excursion | |
230 | (goto-char beg) | |
231 | (if (not (eq (char-before) ?\()) | |
232 | (lambda (sym) ;why not just nil ? -sm | |
233 | ;To avoid interned symbols with | |
234 | ;no slots. -- fx | |
235 | (or (boundp sym) (fboundp sym) | |
236 | (symbol-plist sym))) | |
237 | ;; Looks like a funcall position. Let's double check. | |
238 | (if (condition-case nil | |
239 | (progn (up-list -2) (forward-char 1) | |
240 | (eq (char-after) ?\()) | |
241 | (error nil)) | |
242 | ;; If the first element of the parent list is an open | |
243 | ;; parenthesis we are probably not in a funcall position. | |
244 | ;; Maybe a `let' varlist or something. | |
245 | nil | |
246 | ;; Else, we assume that a function name is expected. | |
247 | 'fboundp)))) | |
248 | ||
249 | (defvar symbol-completion-predicate) | |
250 | ||
251 | (defun lisp-symbol-completion-transform () | |
252 | "`symbol-completion-transform-function' for Lisp." | |
253 | (lambda (elt) | |
254 | (if (and (not (eq 'fboundp symbol-completion-predicate)) | |
255 | (fboundp (intern elt))) | |
256 | (list elt " <f>") | |
257 | elt))) | |
258 | ||
259 | (provide 'sym-comp) | |
28720621 MB |
260 | |
261 | ;; arch-tag: 6fcce616-f3c4-4751-94b4-710e83144124 | |
e21766aa | 262 | ;;; sym-comp.el ends here |