Commit | Line | Data |
---|---|---|
aa8724ae | 1 | ;;; semantic/complete.el --- Routines for performing tag completion |
9573e58b | 2 | |
95df8112 | 3 | ;; Copyright (C) 2003-2005, 2007-2011 Free Software Foundation, Inc. |
9573e58b CY |
4 | |
5 | ;; Author: Eric M. Ludlam <zappo@gnu.org> | |
6 | ;; Keywords: syntax | |
7 | ||
8 | ;; This file is part of GNU Emacs. | |
9 | ||
10 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
11 | ;; it under the terms of the GNU General Public License as published by | |
12 | ;; the Free Software Foundation, either version 3 of the License, or | |
13 | ;; (at your option) any later version. | |
14 | ||
15 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;; GNU General Public License for more details. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
22 | ||
23 | ;;; Commentary: | |
24 | ;; | |
25 | ;; Completion of tags by name using tables of semantic generated tags. | |
26 | ;; | |
27 | ;; While it would be a simple matter of flattening all tag known | |
28 | ;; tables to perform completion across them using `all-completions', | |
29 | ;; or `try-completion', that process would be slow. In particular, | |
30 | ;; when a system database is included in the mix, the potential for a | |
31 | ;; ludicrous number of options becomes apparent. | |
32 | ;; | |
33 | ;; As such, dynamically searching across tables using a prefix, | |
34 | ;; regular expression, or other feature is needed to help find symbols | |
35 | ;; quickly without resorting to "show me every possible option now". | |
36 | ;; | |
37 | ;; In addition, some symbol names will appear in multiple locations. | |
9bf6c65c | 38 | ;; If it is important to distinguish, then a way to provide a choice |
9573e58b CY |
39 | ;; over these locations is important as well. |
40 | ;; | |
41 | ;; Beyond brute force offers for completion of plain strings, | |
42 | ;; using the smarts of semantic-analyze to provide reduced lists of | |
43 | ;; symbols, or fancy tabbing to zoom into files to show multiple hits | |
44 | ;; of the same name can be provided. | |
45 | ;; | |
46 | ;;; How it works: | |
47 | ;; | |
48 | ;; There are several parts of any completion engine. They are: | |
49 | ;; | |
50 | ;; A. Collection of possible hits | |
51 | ;; B. Typing or selecting an option | |
52 | ;; C. Displaying possible unique completions | |
53 | ;; D. Using the result | |
54 | ;; | |
55 | ;; Here, we will treat each section separately (excluding D) | |
56 | ;; They can then be strung together in user-visible commands to | |
c5e87d10 | 57 | ;; fulfill specific needs. |
9573e58b CY |
58 | ;; |
59 | ;; COLLECTORS: | |
60 | ;; | |
61 | ;; A collector is an object which represents the means by which tags | |
62 | ;; to complete on are collected. It's first job is to find all the | |
63 | ;; tags which are to be completed against. It can also rename | |
64 | ;; some tags if needed so long as `semantic-tag-clone' is used. | |
65 | ;; | |
66 | ;; Some collectors will gather all tags to complete against first | |
67 | ;; (for in buffer queries, or other small list situations). It may | |
68 | ;; choose to do a broad search on each completion request. Built in | |
69 | ;; functionality automatically focuses the cache in as the user types. | |
70 | ;; | |
71 | ;; A collector choosing to create and rename tags could choose a | |
72 | ;; plain name format, a postfix name such as method:class, or a | |
73 | ;; prefix name such as class.method. | |
74 | ;; | |
75 | ;; DISPLAYORS | |
76 | ;; | |
77 | ;; A displayor is in charge if showing the user interesting things | |
78 | ;; about available completions, and can optionally provide a focus. | |
79 | ;; The simplest display just lists all available names in a separate | |
80 | ;; window. It may even choose to show short names when there are | |
81 | ;; many to choose from, or long names when there are fewer. | |
82 | ;; | |
83 | ;; A complex displayor could opt to help the user 'focus' on some | |
84 | ;; range. For example, if 4 tags all have the same name, subsequent | |
85 | ;; calls to the displayor may opt to show each tag one at a time in | |
86 | ;; the buffer. When the user likes one, selection would cause the | |
87 | ;; 'focus' item to be selected. | |
88 | ;; | |
89 | ;; CACHE FORMAT | |
90 | ;; | |
91 | ;; The format of the tag lists used to perform the completions are in | |
92 | ;; semanticdb "find" format, like this: | |
93 | ;; | |
94 | ;; ( ( DBTABLE1 TAG1 TAG2 ...) | |
95 | ;; ( DBTABLE2 TAG1 TAG2 ...) | |
96 | ;; ... ) | |
97 | ;; | |
98 | ;; INLINE vs MINIBUFFER | |
99 | ;; | |
100 | ;; Two major ways completion is used in Emacs is either through a | |
101 | ;; minibuffer query, or via completion in a normal editing buffer, | |
102 | ;; encompassing some small range of characters. | |
103 | ;; | |
104 | ;; Structure for both types of completion are provided here. | |
105 | ;; `semantic-complete-read-tag-engine' will use the minibuffer. | |
106 | ;; `semantic-complete-inline-tag-engine' will complete text in | |
107 | ;; a buffer. | |
108 | ||
67d3ffe4 | 109 | (eval-when-compile (require 'cl)) |
3d9d8486 | 110 | (require 'semantic) |
b90caf50 | 111 | (require 'eieio-opt) |
9573e58b | 112 | (require 'semantic/analyze) |
9573e58b | 113 | (require 'semantic/ctxt) |
aa8724ae | 114 | (require 'semantic/decorate) |
3d9d8486 | 115 | (require 'semantic/format) |
aa8724ae | 116 | |
3d9d8486 CY |
117 | (eval-when-compile |
118 | ;; For the semantic-find-tags-for-completion macro. | |
119 | (require 'semantic/find)) | |
9573e58b | 120 | |
9573e58b CY |
121 | ;;; Code: |
122 | ||
9573e58b CY |
123 | (defvar semantic-complete-inline-overlay nil |
124 | "The overlay currently active while completing inline.") | |
125 | ||
126 | (defun semantic-completion-inline-active-p () | |
127 | "Non-nil if inline completion is active." | |
128 | (when (and semantic-complete-inline-overlay | |
129 | (not (semantic-overlay-live-p semantic-complete-inline-overlay))) | |
130 | (semantic-overlay-delete semantic-complete-inline-overlay) | |
131 | (setq semantic-complete-inline-overlay nil)) | |
132 | semantic-complete-inline-overlay) | |
133 | ||
134 | ;;; ------------------------------------------------------------ | |
135 | ;;; MINIBUFFER or INLINE utils | |
136 | ;; | |
137 | (defun semantic-completion-text () | |
138 | "Return the text that is currently in the completion buffer. | |
139 | For a minibuffer prompt, this is the minibuffer text. | |
140 | For inline completion, this is the text wrapped in the inline completion | |
141 | overlay." | |
142 | (if semantic-complete-inline-overlay | |
143 | (semantic-complete-inline-text) | |
b90caf50 | 144 | (minibuffer-contents))) |
9573e58b CY |
145 | |
146 | (defun semantic-completion-delete-text () | |
147 | "Delete the text that is actively being completed. | |
148 | Presumably if you call this you will insert something new there." | |
149 | (if semantic-complete-inline-overlay | |
150 | (semantic-complete-inline-delete-text) | |
b90caf50 | 151 | (delete-minibuffer-contents))) |
9573e58b CY |
152 | |
153 | (defun semantic-completion-message (fmt &rest args) | |
154 | "Display the string FMT formatted with ARGS at the end of the minibuffer." | |
155 | (if semantic-complete-inline-overlay | |
156 | (apply 'message fmt args) | |
157 | (message (concat (buffer-string) (apply 'format fmt args))))) | |
158 | ||
159 | ;;; ------------------------------------------------------------ | |
160 | ;;; MINIBUFFER: Option Selection harnesses | |
161 | ;; | |
162 | (defvar semantic-completion-collector-engine nil | |
163 | "The tag collector for the current completion operation. | |
164 | Value should be an object of a subclass of | |
165 | `semantic-completion-engine-abstract'.") | |
166 | ||
167 | (defvar semantic-completion-display-engine nil | |
168 | "The tag display engine for the current completion operation. | |
169 | Value should be a ... what?") | |
170 | ||
171 | (defvar semantic-complete-key-map | |
172 | (let ((km (make-sparse-keymap))) | |
173 | (define-key km " " 'semantic-complete-complete-space) | |
174 | (define-key km "\t" 'semantic-complete-complete-tab) | |
175 | (define-key km "\C-m" 'semantic-complete-done) | |
176 | (define-key km "\C-g" 'abort-recursive-edit) | |
177 | (define-key km "\M-n" 'next-history-element) | |
178 | (define-key km "\M-p" 'previous-history-element) | |
179 | (define-key km "\C-n" 'next-history-element) | |
180 | (define-key km "\C-p" 'previous-history-element) | |
181 | ;; Add history navigation | |
182 | km) | |
183 | "Keymap used while completing across a list of tags.") | |
184 | ||
185 | (defvar semantic-completion-default-history nil | |
186 | "Default history variable for any unhistoried prompt. | |
187 | Keeps STRINGS only in the history.") | |
188 | ||
189 | ||
190 | (defun semantic-complete-read-tag-engine (collector displayor prompt | |
191 | default-tag initial-input | |
192 | history) | |
193 | "Read a semantic tag, and return a tag for the selection. | |
045b9da7 | 194 | Argument COLLECTOR is an object which can be used to calculate |
9573e58b CY |
195 | a list of possible hits. See `semantic-completion-collector-engine' |
196 | for details on COLLECTOR. | |
9bf6c65c | 197 | Argument DISPLAYOR is an object used to display a list of possible |
9573e58b CY |
198 | completions for a given prefix. See`semantic-completion-display-engine' |
199 | for details on DISPLAYOR. | |
200 | PROMPT is a string to prompt with. | |
201 | DEFAULT-TAG is a semantic tag or string to use as the default value. | |
202 | If INITIAL-INPUT is non-nil, insert it in the minibuffer initially. | |
203 | HISTORY is a symbol representing a variable to story the history in." | |
204 | (let* ((semantic-completion-collector-engine collector) | |
205 | (semantic-completion-display-engine displayor) | |
206 | (semantic-complete-active-default nil) | |
207 | (semantic-complete-current-matched-tag nil) | |
208 | (default-as-tag (semantic-complete-default-to-tag default-tag)) | |
209 | (default-as-string (when (semantic-tag-p default-as-tag) | |
210 | (semantic-tag-name default-as-tag))) | |
211 | ) | |
212 | ||
213 | (when default-as-string | |
214 | ;; Add this to the prompt. | |
215 | ;; | |
216 | ;; I really want to add a lookup of the symbol in those | |
217 | ;; tags available to the collector and only add it if it | |
218 | ;; is available as a possibility, but I'm too lazy right | |
219 | ;; now. | |
220 | ;; | |
221 | ||
222 | ;; @todo - move from () to into the editable area | |
223 | (if (string-match ":" prompt) | |
224 | (setq prompt (concat | |
225 | (substring prompt 0 (match-beginning 0)) | |
ab2c15d4 | 226 | " (default " default-as-string ")" |
9573e58b CY |
227 | (substring prompt (match-beginning 0)))) |
228 | (setq prompt (concat prompt " (" default-as-string "): ")))) | |
229 | ;; | |
230 | ;; Perform the Completion | |
231 | ;; | |
232 | (unwind-protect | |
233 | (read-from-minibuffer prompt | |
234 | initial-input | |
235 | semantic-complete-key-map | |
236 | nil | |
237 | (or history | |
238 | 'semantic-completion-default-history) | |
239 | default-tag) | |
240 | (semantic-collector-cleanup semantic-completion-collector-engine) | |
241 | (semantic-displayor-cleanup semantic-completion-display-engine) | |
242 | ) | |
243 | ;; | |
244 | ;; Extract the tag from the completion machinery. | |
245 | ;; | |
246 | semantic-complete-current-matched-tag | |
247 | )) | |
248 | ||
249 | \f | |
250 | ;;; Util for basic completion prompts | |
251 | ;; | |
252 | ||
253 | (defvar semantic-complete-active-default nil | |
254 | "The current default tag calculated for this prompt.") | |
255 | ||
256 | (defun semantic-complete-default-to-tag (default) | |
257 | "Convert a calculated or passed in DEFAULT into a tag." | |
258 | (if (semantic-tag-p default) | |
259 | ;; Just return what was passed in. | |
260 | (setq semantic-complete-active-default default) | |
261 | ;; If none was passed in, guess. | |
262 | (if (null default) | |
263 | (setq default (semantic-ctxt-current-thing))) | |
264 | (if (null default) | |
265 | ;; Do nothing | |
266 | nil | |
267 | ;; Turn default into something useful. | |
268 | (let ((str | |
269 | (cond | |
270 | ;; Semantic-ctxt-current-symbol will return a list of | |
271 | ;; strings. Technically, we should use the analyzer to | |
272 | ;; fully extract what we need, but for now, just grab the | |
273 | ;; first string | |
274 | ((and (listp default) (stringp (car default))) | |
275 | (car default)) | |
276 | ((stringp default) | |
277 | default) | |
278 | ((symbolp default) | |
279 | (symbol-name default)) | |
280 | (t | |
281 | (signal 'wrong-type-argument | |
282 | (list default 'semantic-tag-p))))) | |
283 | (tag nil)) | |
284 | ;; Now that we have that symbol string, look it up using the active | |
285 | ;; collector. If we get a match, use it. | |
286 | (save-excursion | |
287 | (semantic-collector-calculate-completions | |
288 | semantic-completion-collector-engine | |
289 | str nil)) | |
290 | ;; Do we have the perfect match??? | |
291 | (let ((ml (semantic-collector-current-exact-match | |
292 | semantic-completion-collector-engine))) | |
293 | (when ml | |
294 | ;; We don't care about uniqueness. Just guess for convenience | |
295 | (setq tag (semanticdb-find-result-nth-in-buffer ml 0)))) | |
296 | ;; save it | |
297 | (setq semantic-complete-active-default tag) | |
298 | ;; Return it.. .whatever it may be | |
299 | tag)))) | |
300 | ||
301 | \f | |
302 | ;;; Prompt Return Value | |
303 | ;; | |
304 | ;; Getting a return value out of this completion prompt is a bit | |
305 | ;; challenging. The read command returns the string typed in. | |
306 | ;; We need to convert this into a valid tag. We can exit the minibuffer | |
307 | ;; for different reasons. If we purposely exit, we must make sure | |
308 | ;; the focused tag is calculated... preferably once. | |
309 | (defvar semantic-complete-current-matched-tag nil | |
310 | "Variable used to pass the tags being matched to the prompt.") | |
311 | ||
aa8724ae CY |
312 | ;; semantic-displayor-focus-abstract-child-p is part of the |
313 | ;; semantic-displayor-focus-abstract class, defined later in this | |
314 | ;; file. | |
84c23041 GM |
315 | (declare-function semantic-displayor-focus-abstract-child-p "semantic/complete" |
316 | t t) | |
aa8724ae | 317 | |
9573e58b CY |
318 | (defun semantic-complete-current-match () |
319 | "Calculate a match from the current completion environment. | |
320 | Save this in our completion variable. Make sure that variable | |
321 | is cleared if any other keypress is made. | |
322 | Return value can be: | |
323 | tag - a single tag that has been matched. | |
324 | string - a message to show in the minibuffer." | |
325 | ;; Query the environment for an active completion. | |
326 | (let ((collector semantic-completion-collector-engine) | |
327 | (displayor semantic-completion-display-engine) | |
328 | (contents (semantic-completion-text)) | |
329 | matchlist | |
330 | answer) | |
331 | (if (string= contents "") | |
332 | ;; The user wants the defaults! | |
333 | (setq answer semantic-complete-active-default) | |
334 | ;; This forces a full calculation of completion on CR. | |
335 | (save-excursion | |
336 | (semantic-collector-calculate-completions collector contents nil)) | |
337 | (semantic-complete-try-completion) | |
338 | (cond | |
339 | ;; Input match displayor focus entry | |
340 | ((setq answer (semantic-displayor-current-focus displayor)) | |
341 | ;; We have answer, continue | |
342 | ) | |
343 | ;; One match from the collector | |
344 | ((setq matchlist (semantic-collector-current-exact-match collector)) | |
345 | (if (= (semanticdb-find-result-length matchlist) 1) | |
346 | (setq answer (semanticdb-find-result-nth-in-buffer matchlist 0)) | |
347 | (if (semantic-displayor-focus-abstract-child-p displayor) | |
348 | ;; For focusing displayors, we can claim this is | |
349 | ;; not unique. Multiple focuses can choose the correct | |
350 | ;; one. | |
351 | (setq answer "Not Unique") | |
352 | ;; If we don't have a focusing displayor, we need to do something | |
353 | ;; graceful. First, see if all the matches have the same name. | |
354 | (let ((allsame t) | |
355 | (firstname (semantic-tag-name | |
356 | (car | |
357 | (semanticdb-find-result-nth matchlist 0))) | |
358 | ) | |
359 | (cnt 1) | |
360 | (max (semanticdb-find-result-length matchlist))) | |
361 | (while (and allsame (< cnt max)) | |
362 | (if (not (string= | |
363 | firstname | |
364 | (semantic-tag-name | |
365 | (car | |
366 | (semanticdb-find-result-nth matchlist cnt))))) | |
367 | (setq allsame nil)) | |
368 | (setq cnt (1+ cnt)) | |
369 | ) | |
370 | ;; Now we know if they are all the same. If they are, just | |
371 | ;; accept the first, otherwise complain. | |
372 | (if allsame | |
373 | (setq answer (semanticdb-find-result-nth-in-buffer | |
374 | matchlist 0)) | |
375 | (setq answer "Not Unique")) | |
376 | )))) | |
377 | ;; No match | |
378 | (t | |
379 | (setq answer "No Match"))) | |
380 | ) | |
381 | ;; Set it into our completion target. | |
382 | (when (semantic-tag-p answer) | |
383 | (setq semantic-complete-current-matched-tag answer) | |
384 | ;; Make sure it is up to date by clearing it if the user dares | |
385 | ;; to touch the keyboard. | |
386 | (add-hook 'pre-command-hook | |
387 | (lambda () (setq semantic-complete-current-matched-tag nil))) | |
388 | ) | |
389 | ;; Return it | |
390 | answer | |
391 | )) | |
392 | ||
393 | \f | |
394 | ;;; Keybindings | |
395 | ;; | |
045b9da7 | 396 | ;; Keys are bound to perform completion using our mechanisms. |
9573e58b CY |
397 | ;; Do that work here. |
398 | (defun semantic-complete-done () | |
399 | "Accept the current input." | |
400 | (interactive) | |
401 | (let ((ans (semantic-complete-current-match))) | |
402 | (if (stringp ans) | |
403 | (semantic-completion-message (concat " [" ans "]")) | |
404 | (exit-minibuffer))) | |
405 | ) | |
406 | ||
407 | (defun semantic-complete-complete-space () | |
408 | "Complete the partial input in the minibuffer." | |
409 | (interactive) | |
410 | (semantic-complete-do-completion t)) | |
411 | ||
412 | (defun semantic-complete-complete-tab () | |
413 | "Complete the partial input in the minibuffer as far as possible." | |
414 | (interactive) | |
415 | (semantic-complete-do-completion)) | |
416 | ||
417 | ;;; Completion Functions | |
418 | ;; | |
419 | ;; Thees routines are functional entry points to performing completion. | |
420 | ;; | |
421 | (defun semantic-complete-hack-word-boundaries (original new) | |
422 | "Return a string to use for completion. | |
423 | ORIGINAL is the text in the minibuffer. | |
424 | NEW is the new text to insert into the minibuffer. | |
425 | Within the difference bounds of ORIGINAL and NEW, shorten NEW | |
426 | to the nearest word boundary, and return that." | |
427 | (save-match-data | |
428 | (let* ((diff (substring new (length original))) | |
429 | (end (string-match "\\>" diff)) | |
430 | (start (string-match "\\<" diff))) | |
431 | (cond | |
432 | ((and start (> start 0)) | |
433 | ;; If start is greater than 0, include only the new | |
434 | ;; white-space stuff | |
435 | (concat original (substring diff 0 start))) | |
436 | (end | |
437 | (concat original (substring diff 0 end))) | |
438 | (t new))))) | |
439 | ||
440 | (defun semantic-complete-try-completion (&optional partial) | |
441 | "Try a completion for the current minibuffer. | |
442 | If PARTIAL, do partial completion stopping at spaces." | |
443 | (let ((comp (semantic-collector-try-completion | |
444 | semantic-completion-collector-engine | |
445 | (semantic-completion-text)))) | |
446 | (cond | |
447 | ((null comp) | |
448 | (semantic-completion-message " [No Match]") | |
449 | (ding) | |
450 | ) | |
451 | ((stringp comp) | |
452 | (if (string= (semantic-completion-text) comp) | |
453 | (when partial | |
454 | ;; Minibuffer isn't changing AND the text is not unique. | |
455 | ;; Test for partial completion over a word separator character. | |
456 | ;; If there is one available, use that so that SPC can | |
457 | ;; act like a SPC insert key. | |
458 | (let ((newcomp (semantic-collector-current-whitespace-completion | |
459 | semantic-completion-collector-engine))) | |
460 | (when newcomp | |
461 | (semantic-completion-delete-text) | |
462 | (insert newcomp)) | |
463 | )) | |
464 | (when partial | |
465 | (let ((orig (semantic-completion-text))) | |
466 | ;; For partial completion, we stop and step over | |
467 | ;; word boundaries. Use this nifty function to do | |
468 | ;; that calculation for us. | |
469 | (setq comp | |
470 | (semantic-complete-hack-word-boundaries orig comp)))) | |
471 | ;; Do the replacement. | |
472 | (semantic-completion-delete-text) | |
473 | (insert comp)) | |
474 | ) | |
475 | ((and (listp comp) (semantic-tag-p (car comp))) | |
476 | (unless (string= (semantic-completion-text) | |
477 | (semantic-tag-name (car comp))) | |
478 | ;; A fully unique completion was available. | |
479 | (semantic-completion-delete-text) | |
480 | (insert (semantic-tag-name (car comp)))) | |
481 | ;; The match is complete | |
482 | (if (= (length comp) 1) | |
483 | (semantic-completion-message " [Complete]") | |
484 | (semantic-completion-message " [Complete, but not unique]")) | |
485 | ) | |
486 | (t nil)))) | |
487 | ||
488 | (defun semantic-complete-do-completion (&optional partial inline) | |
489 | "Do a completion for the current minibuffer. | |
490 | If PARTIAL, do partial completion stopping at spaces. | |
491 | if INLINE, then completion is happening inline in a buffer." | |
492 | (let* ((collector semantic-completion-collector-engine) | |
493 | (displayor semantic-completion-display-engine) | |
494 | (contents (semantic-completion-text)) | |
495 | (ans nil)) | |
496 | ||
497 | (save-excursion | |
498 | (semantic-collector-calculate-completions collector contents partial)) | |
499 | (let* ((na (semantic-complete-next-action partial))) | |
500 | (cond | |
501 | ;; We're all done, but only from a very specific | |
502 | ;; area of completion. | |
503 | ((eq na 'done) | |
504 | (semantic-completion-message " [Complete]") | |
505 | (setq ans 'done)) | |
506 | ;; Perform completion | |
507 | ((or (eq na 'complete) | |
508 | (eq na 'complete-whitespace)) | |
509 | (semantic-complete-try-completion partial) | |
510 | (setq ans 'complete)) | |
511 | ;; We need to display the completions. | |
512 | ;; Set the completions into the display engine | |
513 | ((or (eq na 'display) (eq na 'displayend)) | |
514 | (semantic-displayor-set-completions | |
515 | displayor | |
516 | (or | |
1dc5c6f3 CY |
517 | ;; For the below - This caused problems for Chong Yidong |
518 | ;; when experimenting with the completion engine. I don't | |
519 | ;; remember what the problem was though, and I wasn't sure why | |
520 | ;; the below two lines were there since they obviously added | |
521 | ;; some odd behavior. -EML | |
522 | ;; (and (not (eq na 'displayend)) | |
523 | ;; (semantic-collector-current-exact-match collector)) | |
9573e58b CY |
524 | (semantic-collector-all-completions collector contents)) |
525 | contents) | |
526 | ;; Ask the displayor to display them. | |
527 | (semantic-displayor-show-request displayor)) | |
528 | ((eq na 'scroll) | |
529 | (semantic-displayor-scroll-request displayor) | |
530 | ) | |
531 | ((eq na 'focus) | |
532 | (semantic-displayor-focus-next displayor) | |
533 | (semantic-displayor-focus-request displayor) | |
534 | ) | |
535 | ((eq na 'empty) | |
536 | (semantic-completion-message " [No Match]")) | |
537 | (t nil))) | |
538 | ans)) | |
539 | ||
540 | \f | |
541 | ;;; ------------------------------------------------------------ | |
542 | ;;; INLINE: tag completion harness | |
543 | ;; | |
544 | ;; Unlike the minibuffer, there is no mode nor other traditional | |
545 | ;; means of reading user commands in completion mode. Instead | |
546 | ;; we use a pre-command-hook to inset in our commands, and to | |
547 | ;; push ourselves out of this mode on alternate keypresses. | |
548 | (defvar semantic-complete-inline-map | |
549 | (let ((km (make-sparse-keymap))) | |
550 | (define-key km "\C-i" 'semantic-complete-inline-TAB) | |
551 | (define-key km "\M-p" 'semantic-complete-inline-up) | |
552 | (define-key km "\M-n" 'semantic-complete-inline-down) | |
553 | (define-key km "\C-m" 'semantic-complete-inline-done) | |
554 | (define-key km "\C-\M-c" 'semantic-complete-inline-exit) | |
555 | (define-key km "\C-g" 'semantic-complete-inline-quit) | |
556 | (define-key km "?" | |
557 | (lambda () (interactive) | |
558 | (describe-variable 'semantic-complete-inline-map))) | |
559 | km) | |
acfad775 | 560 | "Keymap used while performing Semantic inline completion.") |
9573e58b CY |
561 | |
562 | (defface semantic-complete-inline-face | |
563 | '((((class color) (background dark)) | |
564 | (:underline "yellow")) | |
565 | (((class color) (background light)) | |
566 | (:underline "brown"))) | |
567 | "*Face used to show the region being completed inline. | |
568 | The face is used in `semantic-complete-inline-tag-engine'." | |
569 | :group 'semantic-faces) | |
570 | ||
571 | (defun semantic-complete-inline-text () | |
572 | "Return the text that is being completed inline. | |
573 | Similar to `minibuffer-contents' when completing in the minibuffer." | |
574 | (let ((s (semantic-overlay-start semantic-complete-inline-overlay)) | |
575 | (e (semantic-overlay-end semantic-complete-inline-overlay))) | |
576 | (if (= s e) | |
577 | "" | |
578 | (buffer-substring-no-properties s e )))) | |
579 | ||
580 | (defun semantic-complete-inline-delete-text () | |
581 | "Delete the text currently being completed in the current buffer." | |
582 | (delete-region | |
583 | (semantic-overlay-start semantic-complete-inline-overlay) | |
584 | (semantic-overlay-end semantic-complete-inline-overlay))) | |
585 | ||
586 | (defun semantic-complete-inline-done () | |
587 | "This completion thing is DONE, OR, insert a newline." | |
588 | (interactive) | |
589 | (let* ((displayor semantic-completion-display-engine) | |
590 | (tag (semantic-displayor-current-focus displayor))) | |
591 | (if tag | |
592 | (let ((txt (semantic-completion-text))) | |
593 | (insert (substring (semantic-tag-name tag) | |
594 | (length txt))) | |
595 | (semantic-complete-inline-exit)) | |
596 | ||
597 | ;; Get whatever binding RET usually has. | |
598 | (let ((fcn | |
599 | (condition-case nil | |
600 | (lookup-key (current-active-maps) (this-command-keys)) | |
601 | (error | |
602 | ;; I don't know why, but for some reason the above | |
603 | ;; throws an error sometimes. | |
604 | (lookup-key (current-global-map) (this-command-keys)) | |
605 | )))) | |
606 | (when fcn | |
607 | (funcall fcn))) | |
608 | ))) | |
609 | ||
610 | (defun semantic-complete-inline-quit () | |
611 | "Quit an inline edit." | |
612 | (interactive) | |
613 | (semantic-complete-inline-exit) | |
614 | (keyboard-quit)) | |
615 | ||
616 | (defun semantic-complete-inline-exit () | |
617 | "Exit inline completion mode." | |
618 | (interactive) | |
619 | ;; Remove this hook FIRST! | |
620 | (remove-hook 'pre-command-hook 'semantic-complete-pre-command-hook) | |
621 | ||
622 | (condition-case nil | |
623 | (progn | |
624 | (when semantic-completion-collector-engine | |
625 | (semantic-collector-cleanup semantic-completion-collector-engine)) | |
626 | (when semantic-completion-display-engine | |
627 | (semantic-displayor-cleanup semantic-completion-display-engine)) | |
628 | ||
629 | (when semantic-complete-inline-overlay | |
630 | (let ((wc (semantic-overlay-get semantic-complete-inline-overlay | |
631 | 'window-config-start)) | |
632 | (buf (semantic-overlay-buffer semantic-complete-inline-overlay)) | |
633 | ) | |
634 | (semantic-overlay-delete semantic-complete-inline-overlay) | |
635 | (setq semantic-complete-inline-overlay nil) | |
636 | ;; DONT restore the window configuration if we just | |
637 | ;; switched windows! | |
638 | (when (eq buf (current-buffer)) | |
639 | (set-window-configuration wc)) | |
640 | )) | |
641 | ||
642 | (setq semantic-completion-collector-engine nil | |
643 | semantic-completion-display-engine nil)) | |
644 | (error nil)) | |
645 | ||
646 | ;; Remove this hook LAST!!! | |
647 | ;; This will force us back through this function if there was | |
648 | ;; some sort of error above. | |
649 | (remove-hook 'post-command-hook 'semantic-complete-post-command-hook) | |
650 | ||
651 | ;;(message "Exiting inline completion.") | |
652 | ) | |
653 | ||
654 | (defun semantic-complete-pre-command-hook () | |
655 | "Used to redefine what commands are being run while completing. | |
656 | When installed as a `pre-command-hook' the special keymap | |
657 | `semantic-complete-inline-map' is queried to replace commands normally run. | |
658 | Commands which edit what is in the region of interest operate normally. | |
659 | Commands which would take us out of the region of interest, or our | |
660 | quit hook, will exit this completion mode." | |
661 | (let ((fcn (lookup-key semantic-complete-inline-map | |
662 | (this-command-keys) nil))) | |
663 | (cond ((commandp fcn) | |
664 | (setq this-command fcn)) | |
665 | (t nil))) | |
666 | ) | |
667 | ||
668 | (defun semantic-complete-post-command-hook () | |
669 | "Used to determine if we need to exit inline completion mode. | |
670 | If completion mode is active, check to see if we are within | |
671 | the bounds of `semantic-complete-inline-overlay', or within | |
672 | a reasonable distance." | |
673 | (condition-case nil | |
674 | ;; Exit if something bad happened. | |
675 | (if (not semantic-complete-inline-overlay) | |
676 | (progn | |
677 | ;;(message "Inline Hook installed, but overlay deleted.") | |
678 | (semantic-complete-inline-exit)) | |
679 | ;; Exit if commands caused us to exit the area of interest | |
680 | (let ((s (semantic-overlay-start semantic-complete-inline-overlay)) | |
681 | (e (semantic-overlay-end semantic-complete-inline-overlay)) | |
682 | (b (semantic-overlay-buffer semantic-complete-inline-overlay)) | |
683 | (txt nil) | |
684 | ) | |
685 | (cond | |
686 | ;; EXIT when we are no longer in a good place. | |
687 | ((or (not (eq b (current-buffer))) | |
688 | (< (point) s) | |
689 | (> (point) e)) | |
690 | ;;(message "Exit: %S %S %S" s e (point)) | |
691 | (semantic-complete-inline-exit) | |
692 | ) | |
693 | ;; Exit if the user typed in a character that is not part | |
694 | ;; of the symbol being completed. | |
695 | ((and (setq txt (semantic-completion-text)) | |
696 | (not (string= txt "")) | |
697 | (and (/= (point) s) | |
698 | (save-excursion | |
699 | (forward-char -1) | |
700 | (not (looking-at "\\(\\w\\|\\s_\\)"))))) | |
701 | ;;(message "Non symbol character.") | |
702 | (semantic-complete-inline-exit)) | |
703 | ((lookup-key semantic-complete-inline-map | |
704 | (this-command-keys) nil) | |
705 | ;; If the last command was one of our completion commands, | |
706 | ;; then do nothing. | |
707 | nil | |
708 | ) | |
709 | (t | |
710 | ;; Else, show completions now | |
711 | (semantic-complete-inline-force-display) | |
712 | ||
713 | )))) | |
714 | ;; If something goes terribly wrong, clean up after ourselves. | |
715 | (error (semantic-complete-inline-exit)))) | |
716 | ||
717 | (defun semantic-complete-inline-force-display () | |
718 | "Force the display of whatever the current completions are. | |
719 | DO NOT CALL THIS IF THE INLINE COMPLETION ENGINE IS NOT ACTIVE." | |
720 | (condition-case e | |
721 | (save-excursion | |
722 | (let ((collector semantic-completion-collector-engine) | |
723 | (displayor semantic-completion-display-engine) | |
724 | (contents (semantic-completion-text))) | |
725 | (when collector | |
726 | (semantic-collector-calculate-completions | |
727 | collector contents nil) | |
728 | (semantic-displayor-set-completions | |
729 | displayor | |
730 | (semantic-collector-all-completions collector contents) | |
731 | contents) | |
732 | ;; Ask the displayor to display them. | |
733 | (semantic-displayor-show-request displayor)) | |
734 | )) | |
735 | (error (message "Bug Showing Completions: %S" e)))) | |
736 | ||
737 | (defun semantic-complete-inline-tag-engine | |
738 | (collector displayor buffer start end) | |
739 | "Perform completion based on semantic tags in a buffer. | |
045b9da7 | 740 | Argument COLLECTOR is an object which can be used to calculate |
9573e58b CY |
741 | a list of possible hits. See `semantic-completion-collector-engine' |
742 | for details on COLLECTOR. | |
9bf6c65c | 743 | Argument DISPLAYOR is an object used to display a list of possible |
9573e58b CY |
744 | completions for a given prefix. See`semantic-completion-display-engine' |
745 | for details on DISPLAYOR. | |
746 | BUFFER is the buffer in which completion will take place. | |
747 | START is a location for the start of the full symbol. | |
748 | If the symbol being completed is \"foo.ba\", then START | |
749 | is on the \"f\" character. | |
750 | END is at the end of the current symbol being completed." | |
751 | ;; Set us up for doing completion | |
752 | (setq semantic-completion-collector-engine collector | |
753 | semantic-completion-display-engine displayor) | |
754 | ;; Create an overlay | |
755 | (setq semantic-complete-inline-overlay | |
756 | (semantic-make-overlay start end buffer nil t)) | |
757 | (semantic-overlay-put semantic-complete-inline-overlay | |
758 | 'face | |
759 | 'semantic-complete-inline-face) | |
760 | (semantic-overlay-put semantic-complete-inline-overlay | |
761 | 'window-config-start | |
762 | (current-window-configuration)) | |
763 | ;; Install our command hooks | |
764 | (add-hook 'pre-command-hook 'semantic-complete-pre-command-hook) | |
765 | (add-hook 'post-command-hook 'semantic-complete-post-command-hook) | |
766 | ;; Go! | |
767 | (semantic-complete-inline-force-display) | |
768 | ) | |
769 | ||
770 | ;;; Inline Completion Keymap Functions | |
771 | ;; | |
772 | (defun semantic-complete-inline-TAB () | |
773 | "Perform inline completion." | |
774 | (interactive) | |
775 | (let ((cmpl (semantic-complete-do-completion nil t))) | |
776 | (cond | |
777 | ((eq cmpl 'complete) | |
778 | (semantic-complete-inline-force-display)) | |
779 | ((eq cmpl 'done) | |
780 | (semantic-complete-inline-done)) | |
781 | )) | |
782 | ) | |
783 | ||
784 | (defun semantic-complete-inline-down() | |
785 | "Focus forwards through the displayor." | |
786 | (interactive) | |
787 | (let ((displayor semantic-completion-display-engine)) | |
788 | (semantic-displayor-focus-next displayor) | |
789 | (semantic-displayor-focus-request displayor) | |
790 | )) | |
791 | ||
792 | (defun semantic-complete-inline-up () | |
793 | "Focus backwards through the displayor." | |
794 | (interactive) | |
795 | (let ((displayor semantic-completion-display-engine)) | |
796 | (semantic-displayor-focus-previous displayor) | |
797 | (semantic-displayor-focus-request displayor) | |
798 | )) | |
799 | ||
800 | \f | |
801 | ;;; ------------------------------------------------------------ | |
802 | ;;; Interactions between collection and displaying | |
803 | ;; | |
804 | ;; Functional routines used to help collectors communicate with | |
805 | ;; the current displayor, or for the previous section. | |
806 | ||
807 | (defun semantic-complete-next-action (partial) | |
808 | "Determine what the next completion action should be. | |
809 | PARTIAL is non-nil if we are doing partial completion. | |
810 | First, the collector can determine if we should perform a completion or not. | |
811 | If there is nothing to complete, then the displayor determines if we are | |
812 | to show a completion list, scroll, or perhaps do a focus (if it is capable.) | |
813 | Expected return values are: | |
814 | done -> We have a singular match | |
815 | empty -> There are no matches to the current text | |
816 | complete -> Perform a completion action | |
817 | complete-whitespace -> Complete next whitespace type character. | |
818 | display -> Show the list of completions | |
819 | scroll -> The completions have been shown, and the user keeps hitting | |
820 | the complete button. If possible, scroll the completions | |
821 | focus -> The displayor knows how to shift focus among possible completions. | |
822 | Let it do that. | |
823 | displayend -> Whatever options the displayor had for repeating options, there | |
824 | are none left. Try something new." | |
825 | (let ((ans1 (semantic-collector-next-action | |
826 | semantic-completion-collector-engine | |
827 | partial)) | |
828 | (ans2 (semantic-displayor-next-action | |
829 | semantic-completion-display-engine)) | |
830 | ) | |
831 | (cond | |
832 | ;; No collector answer, use displayor answer. | |
833 | ((not ans1) | |
834 | ans2) | |
835 | ;; Displayor selection of 'scroll, 'display, or 'focus trumps | |
836 | ;; 'done | |
837 | ((and (eq ans1 'done) ans2) | |
838 | ans2) | |
839 | ;; Use ans1 when we have it. | |
840 | (t | |
841 | ans1)))) | |
842 | ||
843 | ||
844 | \f | |
845 | ;;; ------------------------------------------------------------ | |
846 | ;;; Collection Engines | |
847 | ;; | |
848 | ;; Collection engines can scan tags from the current environment and | |
849 | ;; provide lists of possible completions. | |
850 | ;; | |
851 | ;; General features of the abstract collector: | |
852 | ;; * Cache completion lists between uses | |
853 | ;; * Cache itself per buffer. Handle reparse hooks | |
854 | ;; | |
855 | ;; Key Interface Functions to implement: | |
856 | ;; * semantic-collector-next-action | |
857 | ;; * semantic-collector-calculate-completions | |
858 | ;; * semantic-collector-try-completion | |
859 | ;; * semantic-collector-all-completions | |
860 | ||
861 | (defvar semantic-collector-per-buffer-list nil | |
862 | "List of collectors active in this buffer.") | |
863 | (make-variable-buffer-local 'semantic-collector-per-buffer-list) | |
864 | ||
865 | (defvar semantic-collector-list nil | |
866 | "List of global collectors active this session.") | |
867 | ||
868 | (defclass semantic-collector-abstract () | |
869 | ((buffer :initarg :buffer | |
870 | :type buffer | |
871 | :documentation "Originating buffer for this collector. | |
872 | Some collectors use a given buffer as a starting place while looking up | |
873 | tags.") | |
874 | (cache :initform nil | |
875 | :type (or null semanticdb-find-result-with-nil) | |
876 | :documentation "Cache of tags. | |
877 | These tags are re-used during a completion session. | |
878 | Sometimes these tags are cached between completion sessions.") | |
879 | (last-all-completions :initarg nil | |
880 | :type semanticdb-find-result-with-nil | |
881 | :documentation "Last result of `all-completions'. | |
882 | This result can be used for refined completions as `last-prefix' gets | |
883 | closer to a specific result.") | |
884 | (last-prefix :type string | |
885 | :protection :protected | |
886 | :documentation "The last queried prefix. | |
887 | This prefix can be used to cache intermediate completion offers. | |
888 | making the action of homing in on a token faster.") | |
889 | (last-completion :type (or null string) | |
890 | :documentation "The last calculated completion. | |
891 | This completion is calculated and saved for future use.") | |
892 | (last-whitespace-completion :type (or null string) | |
893 | :documentation "The last whitespace completion. | |
4c36be58 | 894 | For partial completion, SPC will disambiguate over whitespace type |
9573e58b CY |
895 | characters. This is the last calculated version.") |
896 | (current-exact-match :type list | |
897 | :protection :protected | |
898 | :documentation "The list of matched tags. | |
899 | When tokens are matched, they are added to this list.") | |
900 | ) | |
901 | "Root class for completion engines. | |
902 | The baseclass provides basic functionality for interacting with | |
903 | a completion displayor object, and tracking the current progress | |
904 | of a completion." | |
905 | :abstract t) | |
906 | ||
907 | (defmethod semantic-collector-cleanup ((obj semantic-collector-abstract)) | |
908 | "Clean up any mess this collector may have." | |
909 | nil) | |
910 | ||
911 | (defmethod semantic-collector-next-action | |
912 | ((obj semantic-collector-abstract) partial) | |
913 | "What should we do next? OBJ can predict a next good action. | |
914 | PARTIAL indicates if we are doing a partial completion." | |
915 | (if (and (slot-boundp obj 'last-completion) | |
916 | (string= (semantic-completion-text) (oref obj last-completion))) | |
917 | (let* ((cem (semantic-collector-current-exact-match obj)) | |
918 | (cemlen (semanticdb-find-result-length cem)) | |
919 | (cac (semantic-collector-all-completions | |
920 | obj (semantic-completion-text))) | |
921 | (caclen (semanticdb-find-result-length cac))) | |
922 | (cond ((and cem (= cemlen 1) | |
923 | cac (> caclen 1) | |
924 | (eq last-command this-command)) | |
925 | ;; Defer to the displayor... | |
926 | nil) | |
927 | ((and cem (= cemlen 1)) | |
928 | 'done) | |
929 | ((and (not cem) (not cac)) | |
930 | 'empty) | |
931 | ((and partial (semantic-collector-try-completion-whitespace | |
932 | obj (semantic-completion-text))) | |
933 | 'complete-whitespace))) | |
934 | 'complete)) | |
935 | ||
936 | (defmethod semantic-collector-last-prefix= ((obj semantic-collector-abstract) | |
937 | last-prefix) | |
938 | "Return non-nil if OBJ's prefix matches PREFIX." | |
939 | (and (slot-boundp obj 'last-prefix) | |
940 | (string= (oref obj last-prefix) last-prefix))) | |
941 | ||
942 | (defmethod semantic-collector-get-cache ((obj semantic-collector-abstract)) | |
943 | "Get the raw cache of tags for completion. | |
944 | Calculate the cache if there isn't one." | |
945 | (or (oref obj cache) | |
946 | (semantic-collector-calculate-cache obj))) | |
947 | ||
948 | (defmethod semantic-collector-calculate-completions-raw | |
949 | ((obj semantic-collector-abstract) prefix completionlist) | |
950 | "Calculate the completions for prefix from completionlist. | |
951 | Output must be in semanticdb Find result format." | |
952 | ;; Must output in semanticdb format | |
0816d744 | 953 | (let ((table (with-current-buffer (oref obj buffer) |
9573e58b CY |
954 | semanticdb-current-table)) |
955 | (result (semantic-find-tags-for-completion | |
956 | prefix | |
957 | ;; To do this kind of search with a pre-built completion | |
958 | ;; list, we need to strip it first. | |
959 | (semanticdb-strip-find-results completionlist))) | |
960 | ) | |
961 | (if result | |
962 | (list (cons table result))))) | |
963 | ||
964 | (defmethod semantic-collector-calculate-completions | |
965 | ((obj semantic-collector-abstract) prefix partial) | |
966 | "Calculate completions for prefix as setup for other queries." | |
967 | (let* ((case-fold-search semantic-case-fold) | |
968 | (same-prefix-p (semantic-collector-last-prefix= obj prefix)) | |
969 | (completionlist | |
970 | (if (or same-prefix-p | |
971 | (and (slot-boundp obj 'last-prefix) | |
972 | (eq (compare-strings (oref obj last-prefix) 0 nil | |
973 | prefix 0 (length prefix)) | |
974 | t))) | |
975 | ;; New prefix is subset of old prefix | |
976 | (oref obj last-all-completions) | |
977 | (semantic-collector-get-cache obj))) | |
978 | ;; Get the result | |
979 | (answer (if same-prefix-p | |
980 | completionlist | |
981 | (semantic-collector-calculate-completions-raw | |
982 | obj prefix completionlist)) | |
983 | ) | |
984 | (completion nil) | |
985 | (complete-not-uniq nil) | |
986 | ) | |
987 | ;;(semanticdb-find-result-test answer) | |
988 | (when (not same-prefix-p) | |
989 | ;; Save results if it is interesting and beneficial | |
990 | (oset obj last-prefix prefix) | |
991 | (oset obj last-all-completions answer)) | |
992 | ;; Now calculate the completion. | |
993 | (setq completion (try-completion | |
994 | prefix | |
995 | (semanticdb-strip-find-results answer))) | |
996 | (oset obj last-whitespace-completion nil) | |
997 | (oset obj current-exact-match nil) | |
998 | ;; Only do this if a completion was found. Letting a nil in | |
999 | ;; could cause a full semanticdb search by accident. | |
1000 | (when completion | |
1001 | (oset obj last-completion | |
1002 | (cond | |
1003 | ;; Unique match in AC. Last completion is a match. | |
1004 | ;; Also set the current-exact-match. | |
1005 | ((eq completion t) | |
1006 | (oset obj current-exact-match answer) | |
1007 | prefix) | |
1008 | ;; It may be complete (a symbol) but still not unique. | |
1009 | ;; We can capture a match | |
1010 | ((setq complete-not-uniq | |
1011 | (semanticdb-find-tags-by-name | |
1012 | prefix | |
1013 | answer)) | |
1014 | (oset obj current-exact-match | |
1015 | complete-not-uniq) | |
1016 | prefix | |
1017 | ) | |
1018 | ;; Non unique match, return the string that handles | |
1019 | ;; completion | |
1020 | (t (or completion prefix)) | |
1021 | ))) | |
1022 | )) | |
1023 | ||
1024 | (defmethod semantic-collector-try-completion-whitespace | |
1025 | ((obj semantic-collector-abstract) prefix) | |
ee7683eb | 1026 | "For OBJ, do whitespace completion based on PREFIX. |
9573e58b | 1027 | This implies that if there are two completions, one matching |
e1dbe924 | 1028 | the test \"prefix\\>\", and one not, the one matching the full |
9573e58b CY |
1029 | word version of PREFIX will be chosen, and that text returned. |
1030 | This function requires that `semantic-collector-calculate-completions' | |
1031 | has been run first." | |
1032 | (let* ((ac (semantic-collector-all-completions obj prefix)) | |
1033 | (matchme (concat "^" prefix "\\>")) | |
1034 | (compare (semanticdb-find-tags-by-name-regexp matchme ac)) | |
1035 | (numtag (semanticdb-find-result-length compare)) | |
1036 | ) | |
1037 | (if compare | |
1038 | (let* ((idx 0) | |
1039 | (cutlen (1+ (length prefix))) | |
1040 | (twws (semanticdb-find-result-nth compare idx))) | |
1041 | ;; Is our tag with whitespace a match that has whitespace | |
1042 | ;; after it, or just an already complete symbol? | |
1043 | (while (and (< idx numtag) | |
1044 | (< (length (semantic-tag-name (car twws))) cutlen)) | |
1045 | (setq idx (1+ idx) | |
1046 | twws (semanticdb-find-result-nth compare idx))) | |
1047 | (when (and twws (car-safe twws)) | |
1048 | ;; If COMPARE has succeeded, then we should take the very | |
1049 | ;; first match, and extend prefix by one character. | |
1050 | (oset obj last-whitespace-completion | |
1051 | (substring (semantic-tag-name (car twws)) | |
1052 | 0 cutlen)))) | |
1053 | ))) | |
1054 | ||
1055 | ||
1056 | (defmethod semantic-collector-current-exact-match ((obj semantic-collector-abstract)) | |
1057 | "Return the active valid MATCH from the semantic collector. | |
1058 | For now, just return the first element from our list of available | |
1059 | matches. For semanticdb based results, make sure the file is loaded | |
1060 | into a buffer." | |
1061 | (when (slot-boundp obj 'current-exact-match) | |
1062 | (oref obj current-exact-match))) | |
1063 | ||
1064 | (defmethod semantic-collector-current-whitespace-completion ((obj semantic-collector-abstract)) | |
1065 | "Return the active whitespace completion value." | |
1066 | (when (slot-boundp obj 'last-whitespace-completion) | |
1067 | (oref obj last-whitespace-completion))) | |
1068 | ||
1069 | (defmethod semantic-collector-get-match ((obj semantic-collector-abstract)) | |
1070 | "Return the active valid MATCH from the semantic collector. | |
1071 | For now, just return the first element from our list of available | |
1072 | matches. For semanticdb based results, make sure the file is loaded | |
1073 | into a buffer." | |
1074 | (when (slot-boundp obj 'current-exact-match) | |
1075 | (semanticdb-find-result-nth-in-buffer (oref obj current-exact-match) 0))) | |
1076 | ||
1077 | (defmethod semantic-collector-all-completions | |
1078 | ((obj semantic-collector-abstract) prefix) | |
1079 | "For OBJ, retrieve all completions matching PREFIX. | |
1080 | The returned list consists of all the tags currently | |
1081 | matching PREFIX." | |
1082 | (when (slot-boundp obj 'last-all-completions) | |
1083 | (oref obj last-all-completions))) | |
1084 | ||
1085 | (defmethod semantic-collector-try-completion | |
1086 | ((obj semantic-collector-abstract) prefix) | |
1087 | "For OBJ, attempt to match PREFIX. | |
1088 | See `try-completion' for details on how this works. | |
1089 | Return nil for no match. | |
1090 | Return a string for a partial match. | |
1091 | For a unique match of PREFIX, return the list of all tags | |
1092 | with that name." | |
1093 | (if (slot-boundp obj 'last-completion) | |
1094 | (oref obj last-completion))) | |
1095 | ||
1096 | (defmethod semantic-collector-calculate-cache | |
1097 | ((obj semantic-collector-abstract)) | |
1098 | "Calculate the completion cache for OBJ." | |
1099 | nil | |
1100 | ) | |
1101 | ||
1102 | (defmethod semantic-collector-flush ((this semantic-collector-abstract)) | |
1103 | "Flush THIS collector object, clearing any caches and prefix." | |
1104 | (oset this cache nil) | |
1105 | (slot-makeunbound this 'last-prefix) | |
1106 | (slot-makeunbound this 'last-completion) | |
1107 | (slot-makeunbound this 'last-all-completions) | |
1108 | (slot-makeunbound this 'current-exact-match) | |
1109 | ) | |
1110 | ||
1111 | ;;; PER BUFFER | |
1112 | ;; | |
1113 | (defclass semantic-collector-buffer-abstract (semantic-collector-abstract) | |
1114 | () | |
1115 | "Root class for per-buffer completion engines. | |
1116 | These collectors track themselves on a per-buffer basis." | |
1117 | :abstract t) | |
1118 | ||
1119 | (defmethod constructor :STATIC ((this semantic-collector-buffer-abstract) | |
1120 | newname &rest fields) | |
1121 | "Reuse previously created objects of this type in buffer." | |
1122 | (let ((old nil) | |
1123 | (bl semantic-collector-per-buffer-list)) | |
1124 | (while (and bl (null old)) | |
1125 | (if (eq (object-class (car bl)) this) | |
1126 | (setq old (car bl)))) | |
1127 | (unless old | |
1128 | (let ((new (call-next-method))) | |
1129 | (add-to-list 'semantic-collector-per-buffer-list new) | |
1130 | (setq old new))) | |
1131 | (slot-makeunbound old 'last-completion) | |
1132 | (slot-makeunbound old 'last-prefix) | |
1133 | (slot-makeunbound old 'current-exact-match) | |
1134 | old)) | |
1135 | ||
1136 | ;; Buffer specific collectors should flush themselves | |
1137 | (defun semantic-collector-buffer-flush (newcache) | |
1138 | "Flush all buffer collector objects. | |
1139 | NEWCACHE is the new tag table, but we ignore it." | |
1140 | (condition-case nil | |
1141 | (let ((l semantic-collector-per-buffer-list)) | |
1142 | (while l | |
1143 | (if (car l) (semantic-collector-flush (car l))) | |
1144 | (setq l (cdr l)))) | |
1145 | (error nil))) | |
1146 | ||
1147 | (add-hook 'semantic-after-toplevel-cache-change-hook | |
1148 | 'semantic-collector-buffer-flush) | |
1149 | ||
1150 | ;;; DEEP BUFFER SPECIFIC COMPLETION | |
1151 | ;; | |
1152 | (defclass semantic-collector-buffer-deep | |
1153 | (semantic-collector-buffer-abstract) | |
1154 | () | |
1155 | "Completion engine for tags in the current buffer. | |
1156 | When searching for a tag, uses semantic deep searche functions. | |
1157 | Basics search only in the current buffer.") | |
1158 | ||
1159 | (defmethod semantic-collector-calculate-cache | |
1160 | ((obj semantic-collector-buffer-deep)) | |
1161 | "Calculate the completion cache for OBJ. | |
1162 | Uses `semantic-flatten-tags-table'" | |
1163 | (oset obj cache | |
1164 | ;; Must create it in SEMANTICDB find format. | |
1165 | ;; ( ( DBTABLE TAG TAG ... ) ... ) | |
1166 | (list | |
1167 | (cons semanticdb-current-table | |
1168 | (semantic-flatten-tags-table (oref obj buffer)))))) | |
1169 | ||
1170 | ;;; PROJECT SPECIFIC COMPLETION | |
1171 | ;; | |
1172 | (defclass semantic-collector-project-abstract (semantic-collector-abstract) | |
1173 | ((path :initarg :path | |
1174 | :initform nil | |
1175 | :documentation "List of database tables to search. | |
1176 | At creation time, it can be anything accepted by | |
1177 | `semanticdb-find-translate-path' as a PATH argument.") | |
1178 | ) | |
1179 | "Root class for project wide completion engines. | |
1180 | Uses semanticdb for searching all tags in the current project." | |
1181 | :abstract t) | |
1182 | ||
1183 | ;;; Project Search | |
1184 | (defclass semantic-collector-project (semantic-collector-project-abstract) | |
1185 | () | |
1186 | "Completion engine for tags in a project.") | |
1187 | ||
1188 | ||
1189 | (defmethod semantic-collector-calculate-completions-raw | |
1190 | ((obj semantic-collector-project) prefix completionlist) | |
1191 | "Calculate the completions for prefix from completionlist." | |
1192 | (semanticdb-find-tags-for-completion prefix (oref obj path))) | |
1193 | ||
1194 | ;;; Brutish Project search | |
1195 | (defclass semantic-collector-project-brutish (semantic-collector-project-abstract) | |
1196 | () | |
1197 | "Completion engine for tags in a project.") | |
1198 | ||
3d9d8486 CY |
1199 | (declare-function semanticdb-brute-deep-find-tags-for-completion |
1200 | "semantic/db-find") | |
1201 | ||
9573e58b CY |
1202 | (defmethod semantic-collector-calculate-completions-raw |
1203 | ((obj semantic-collector-project-brutish) prefix completionlist) | |
1204 | "Calculate the completions for prefix from completionlist." | |
3d9d8486 | 1205 | (require 'semantic/db-find) |
9573e58b CY |
1206 | (semanticdb-brute-deep-find-tags-for-completion prefix (oref obj path))) |
1207 | ||
dd9af436 CY |
1208 | ;;; Current Datatype member search. |
1209 | (defclass semantic-collector-local-members (semantic-collector-project-abstract) | |
1210 | ((scope :initform nil | |
1211 | :type (or null semantic-scope-cache) | |
1212 | :documentation | |
1213 | "The scope the local members are being completed from.")) | |
1214 | "Completion engine for tags in a project.") | |
1215 | ||
1216 | (defmethod semantic-collector-calculate-completions-raw | |
1217 | ((obj semantic-collector-local-members) prefix completionlist) | |
1218 | "Calculate the completions for prefix from completionlist." | |
1219 | (let* ((scope (or (oref obj scope) | |
1220 | (oset obj scope (semantic-calculate-scope)))) | |
1221 | (localstuff (oref scope scope))) | |
1222 | (list | |
1223 | (cons | |
1224 | (oref scope :table) | |
1225 | (semantic-find-tags-for-completion prefix localstuff))))) | |
1226 | ;(semanticdb-brute-deep-find-tags-for-completion prefix (oref obj path)))) | |
1227 | ||
1228 | ;;; Smart completion collector | |
9573e58b CY |
1229 | (defclass semantic-collector-analyze-completions (semantic-collector-abstract) |
1230 | ((context :initarg :context | |
1231 | :type semantic-analyze-context | |
1232 | :documentation "An analysis context. | |
1233 | Specifies some context location from whence completion lists will be drawn." | |
1234 | ) | |
1235 | (first-pass-completions :type list | |
1236 | :documentation "List of valid completion tags. | |
1237 | This list of tags is generated when completion starts. All searches | |
1238 | derive from this list.") | |
1239 | ) | |
1240 | "Completion engine that uses the context analyzer to provide options. | |
1241 | The only options available for completion are those which can be logically | |
1242 | inserted into the current context.") | |
1243 | ||
1244 | (defmethod semantic-collector-calculate-completions-raw | |
1245 | ((obj semantic-collector-analyze-completions) prefix completionlist) | |
1246 | "calculate the completions for prefix from completionlist." | |
1247 | ;; if there are no completions yet, calculate them. | |
1248 | (if (not (slot-boundp obj 'first-pass-completions)) | |
1249 | (oset obj first-pass-completions | |
1250 | (semantic-analyze-possible-completions (oref obj context)))) | |
1251 | ;; search our cached completion list. make it look like a semanticdb | |
1252 | ;; results type. | |
0816d744 | 1253 | (list (cons (with-current-buffer (oref (oref obj context) buffer) |
9573e58b CY |
1254 | semanticdb-current-table) |
1255 | (semantic-find-tags-for-completion | |
1256 | prefix | |
1257 | (oref obj first-pass-completions))))) | |
1258 | ||
1259 | \f | |
1260 | ;;; ------------------------------------------------------------ | |
1261 | ;;; Tag List Display Engines | |
1262 | ;; | |
1263 | ;; A typical displayor accepts a pre-determined list of completions | |
1264 | ;; generated by a collector. This format is in semanticdb search | |
1265 | ;; form. This vaguely standard form is a bit challenging to navigate | |
737b5223 | 1266 | ;; because the tags do not contain buffer info, but the file associated |
97610156 | 1267 | ;; with the tags precedes the tag in the list. |
9573e58b CY |
1268 | ;; |
1269 | ;; Basic displayors don't care, and can strip the results. | |
1270 | ;; Advanced highlighting displayors need to know when they need | |
1271 | ;; to load a file so that the tag in question can be highlighted. | |
1272 | ;; | |
1273 | ;; Key interface methods to a displayor are: | |
1274 | ;; * semantic-displayor-next-action | |
1275 | ;; * semantic-displayor-set-completions | |
1276 | ;; * semantic-displayor-current-focus | |
1277 | ;; * semantic-displayor-show-request | |
1278 | ;; * semantic-displayor-scroll-request | |
1279 | ;; * semantic-displayor-focus-request | |
1280 | ||
1281 | (defclass semantic-displayor-abstract () | |
1282 | ((table :type (or null semanticdb-find-result-with-nil) | |
1283 | :initform nil | |
1284 | :protection :protected | |
1285 | :documentation "List of tags this displayor is showing.") | |
1286 | (last-prefix :type string | |
1287 | :protection :protected | |
1288 | :documentation "Prefix associated with slot `table'") | |
1289 | ) | |
1290 | "Abstract displayor baseclass. | |
1291 | Manages the display of some number of tags. | |
1292 | Provides the basics for a displayor, including interacting with | |
1293 | a collector, and tracking tables of completion to display." | |
1294 | :abstract t) | |
1295 | ||
1296 | (defmethod semantic-displayor-cleanup ((obj semantic-displayor-abstract)) | |
1297 | "Clean up any mess this displayor may have." | |
1298 | nil) | |
1299 | ||
1300 | (defmethod semantic-displayor-next-action ((obj semantic-displayor-abstract)) | |
1301 | "The next action to take on the minibuffer related to display." | |
1302 | (if (and (slot-boundp obj 'last-prefix) | |
1303 | (string= (oref obj last-prefix) (semantic-completion-text)) | |
1304 | (eq last-command this-command)) | |
1305 | 'scroll | |
1306 | 'display)) | |
1307 | ||
1308 | (defmethod semantic-displayor-set-completions ((obj semantic-displayor-abstract) | |
1309 | table prefix) | |
1310 | "Set the list of tags to be completed over to TABLE." | |
1311 | (oset obj table table) | |
1312 | (oset obj last-prefix prefix)) | |
1313 | ||
1314 | (defmethod semantic-displayor-show-request ((obj semantic-displayor-abstract)) | |
1315 | "A request to show the current tags table." | |
1316 | (ding)) | |
1317 | ||
1318 | (defmethod semantic-displayor-focus-request ((obj semantic-displayor-abstract)) | |
1319 | "A request to for the displayor to focus on some tag option." | |
1320 | (ding)) | |
1321 | ||
1322 | (defmethod semantic-displayor-scroll-request ((obj semantic-displayor-abstract)) | |
1323 | "A request to for the displayor to scroll the completion list (if needed)." | |
1324 | (scroll-other-window)) | |
1325 | ||
1326 | (defmethod semantic-displayor-focus-previous ((obj semantic-displayor-abstract)) | |
1327 | "Set the current focus to the previous item." | |
1328 | nil) | |
1329 | ||
1330 | (defmethod semantic-displayor-focus-next ((obj semantic-displayor-abstract)) | |
1331 | "Set the current focus to the next item." | |
1332 | nil) | |
1333 | ||
1334 | (defmethod semantic-displayor-current-focus ((obj semantic-displayor-abstract)) | |
1335 | "Return a single tag currently in focus. | |
1336 | This object type doesn't do focus, so will never have a focus object." | |
1337 | nil) | |
1338 | ||
1339 | ;; Traditional displayor | |
1340 | (defcustom semantic-completion-displayor-format-tag-function | |
1341 | #'semantic-format-tag-name | |
1342 | "*A Tag format function to use when showing completions." | |
1343 | :group 'semantic | |
1344 | :type semantic-format-tag-custom-list) | |
1345 | ||
1346 | (defclass semantic-displayor-traditional (semantic-displayor-abstract) | |
1347 | () | |
1348 | "Display options in *Completions* buffer. | |
1349 | Traditional display mechanism for a list of possible completions. | |
1350 | Completions are showin in a new buffer and listed with the ability | |
1351 | to click on the items to aid in completion.") | |
1352 | ||
1353 | (defmethod semantic-displayor-show-request ((obj semantic-displayor-traditional)) | |
1354 | "A request to show the current tags table." | |
1355 | ||
4c36be58 | 1356 | ;; NOTE TO SELF. Find the character to type next, and emphasize it. |
9573e58b CY |
1357 | |
1358 | (with-output-to-temp-buffer "*Completions*" | |
1359 | (display-completion-list | |
1360 | (mapcar semantic-completion-displayor-format-tag-function | |
1361 | (semanticdb-strip-find-results (oref obj table)))) | |
1362 | ) | |
1363 | ) | |
1364 | ||
1365 | ;;; Abstract baseclass for any displayor which supports focus | |
1366 | (defclass semantic-displayor-focus-abstract (semantic-displayor-abstract) | |
1367 | ((focus :type number | |
1368 | :protection :protected | |
1369 | :documentation "A tag index from `table' which has focus. | |
1370 | Multiple calls to the display function can choose to focus on a | |
1371 | given tag, by highlighting its location.") | |
1372 | (find-file-focus | |
1373 | :allocation :class | |
1374 | :initform nil | |
1375 | :documentation | |
1376 | "Non-nil if focusing requires a tag's buffer be in memory.") | |
1377 | ) | |
1378 | "Abstract displayor supporting `focus'. | |
1379 | A displayor which has the ability to focus in on one tag. | |
4c36be58 | 1380 | Focusing is a way of differentiating among multiple tags |
9573e58b CY |
1381 | which have the same name." |
1382 | :abstract t) | |
1383 | ||
1384 | (defmethod semantic-displayor-next-action ((obj semantic-displayor-focus-abstract)) | |
1385 | "The next action to take on the minibuffer related to display." | |
1386 | (if (and (slot-boundp obj 'last-prefix) | |
1387 | (string= (oref obj last-prefix) (semantic-completion-text)) | |
1388 | (eq last-command this-command)) | |
1389 | (if (and | |
1390 | (slot-boundp obj 'focus) | |
1391 | (slot-boundp obj 'table) | |
1392 | (<= (semanticdb-find-result-length (oref obj table)) | |
1393 | (1+ (oref obj focus)))) | |
1394 | ;; We are at the end of the focus road. | |
1395 | 'displayend | |
1396 | ;; Focus on some item. | |
1397 | 'focus) | |
1398 | 'display)) | |
1399 | ||
1400 | (defmethod semantic-displayor-set-completions ((obj semantic-displayor-focus-abstract) | |
1401 | table prefix) | |
1402 | "Set the list of tags to be completed over to TABLE." | |
1403 | (call-next-method) | |
1404 | (slot-makeunbound obj 'focus)) | |
1405 | ||
1406 | (defmethod semantic-displayor-focus-previous ((obj semantic-displayor-focus-abstract)) | |
1407 | "Set the current focus to the previous item. | |
1408 | Not meaningful return value." | |
1409 | (when (and (slot-boundp obj 'table) (oref obj table)) | |
1410 | (with-slots (table) obj | |
1411 | (if (or (not (slot-boundp obj 'focus)) | |
1412 | (<= (oref obj focus) 0)) | |
1413 | (oset obj focus (1- (semanticdb-find-result-length table))) | |
1414 | (oset obj focus (1- (oref obj focus))) | |
1415 | ) | |
1416 | ))) | |
1417 | ||
1418 | (defmethod semantic-displayor-focus-next ((obj semantic-displayor-focus-abstract)) | |
1419 | "Set the current focus to the next item. | |
1420 | Not meaningful return value." | |
1421 | (when (and (slot-boundp obj 'table) (oref obj table)) | |
1422 | (with-slots (table) obj | |
1423 | (if (not (slot-boundp obj 'focus)) | |
1424 | (oset obj focus 0) | |
1425 | (oset obj focus (1+ (oref obj focus))) | |
1426 | ) | |
1427 | (if (<= (semanticdb-find-result-length table) (oref obj focus)) | |
1428 | (oset obj focus 0)) | |
1429 | ))) | |
1430 | ||
1431 | (defmethod semantic-displayor-focus-tag ((obj semantic-displayor-focus-abstract)) | |
1432 | "Return the next tag OBJ should focus on." | |
1433 | (when (and (slot-boundp obj 'table) (oref obj table)) | |
1434 | (with-slots (table) obj | |
1435 | (semanticdb-find-result-nth table (oref obj focus))))) | |
1436 | ||
1437 | (defmethod semantic-displayor-current-focus ((obj semantic-displayor-focus-abstract)) | |
1438 | "Return the tag currently in focus, or call parent method." | |
1439 | (if (and (slot-boundp obj 'focus) | |
1440 | (slot-boundp obj 'table) | |
1441 | ;; Only return the current focus IFF the minibuffer reflects | |
1442 | ;; the list this focus was derived from. | |
1443 | (slot-boundp obj 'last-prefix) | |
1444 | (string= (semantic-completion-text) (oref obj last-prefix)) | |
1445 | ) | |
1446 | ;; We need to focus | |
1447 | (if (oref obj find-file-focus) | |
1448 | (semanticdb-find-result-nth-in-buffer (oref obj table) (oref obj focus)) | |
1449 | ;; result-nth returns a cons with car being the tag, and cdr the | |
1450 | ;; database. | |
1451 | (car (semanticdb-find-result-nth (oref obj table) (oref obj focus)))) | |
1452 | ;; Do whatever | |
1453 | (call-next-method))) | |
1454 | ||
1455 | ;;; Simple displayor which performs traditional display completion, | |
1456 | ;; and also focuses with highlighting. | |
1457 | (defclass semantic-displayor-traditional-with-focus-highlight | |
1458 | (semantic-displayor-focus-abstract semantic-displayor-traditional) | |
1459 | ((find-file-focus :initform t)) | |
1460 | "Display completions in *Completions* buffer, with focus highlight. | |
1461 | A traditional displayor which can focus on a tag by showing it. | |
1462 | Same as `semantic-displayor-traditional', but with selection between | |
1463 | multiple tags with the same name done by 'focusing' on the source | |
1464 | location of the different tags to differentiate them.") | |
1465 | ||
1466 | (defmethod semantic-displayor-focus-request | |
1467 | ((obj semantic-displayor-traditional-with-focus-highlight)) | |
1468 | "Focus in on possible tag completions. | |
1469 | Focus is performed by cycling through the tags and highlighting | |
1470 | one in the source buffer." | |
1471 | (let* ((tablelength (semanticdb-find-result-length (oref obj table))) | |
1472 | (focus (semantic-displayor-focus-tag obj)) | |
1473 | ;; Raw tag info. | |
1474 | (rtag (car focus)) | |
1475 | (rtable (cdr focus)) | |
1476 | ;; Normalize | |
1477 | (nt (semanticdb-normalize-one-tag rtable rtag)) | |
1478 | (tag (cdr nt)) | |
1479 | (table (car nt)) | |
1480 | ) | |
40ba43b4 | 1481 | ;; If we fail to normalize, reset. |
9573e58b CY |
1482 | (when (not tag) (setq table rtable tag rtag)) |
1483 | ;; Do the focus. | |
1484 | (let ((buf (or (semantic-tag-buffer tag) | |
1485 | (and table (semanticdb-get-buffer table))))) | |
1486 | ;; If no buffer is provided, then we can make up a summary buffer. | |
1487 | (when (not buf) | |
0816d744 | 1488 | (with-current-buffer (get-buffer-create "*Completion Focus*") |
9573e58b CY |
1489 | (erase-buffer) |
1490 | (insert "Focus on tag: \n") | |
1491 | (insert (semantic-format-tag-summarize tag nil t) "\n\n") | |
1492 | (when table | |
1493 | (insert "From table: \n") | |
1494 | (insert (object-name table) "\n\n")) | |
1495 | (when buf | |
1496 | (insert "In buffer: \n\n") | |
1497 | (insert (format "%S" buf))) | |
1498 | (setq buf (current-buffer)))) | |
1499 | ;; Show the tag in the buffer. | |
1500 | (if (get-buffer-window buf) | |
1501 | (select-window (get-buffer-window buf)) | |
1502 | (switch-to-buffer-other-window buf t) | |
1503 | (select-window (get-buffer-window buf))) | |
1504 | ;; Now do some positioning | |
1505 | (unwind-protect | |
1506 | (if (semantic-tag-with-position-p tag) | |
1507 | ;; Full tag positional information available | |
1508 | (progn | |
1509 | (goto-char (semantic-tag-start tag)) | |
1510 | ;; This avoids a dangerous problem if we just loaded a tag | |
1511 | ;; from a file, but the original position was not updated | |
1512 | ;; in the TAG variable we are currently using. | |
1513 | (semantic-momentary-highlight-tag (semantic-current-tag)) | |
1514 | )) | |
1515 | (select-window (minibuffer-window))) | |
1516 | ;; Calculate text difference between contents and the focus item. | |
1517 | (let* ((mbc (semantic-completion-text)) | |
1518 | (ftn (semantic-tag-name tag)) | |
1519 | (diff (substring ftn (length mbc)))) | |
1520 | (semantic-completion-message | |
1521 | (format "%s [%d of %d matches]" diff (1+ (oref obj focus)) tablelength))) | |
1522 | ))) | |
1523 | ||
1524 | \f | |
1525 | ;;; Tooltip completion lister | |
1526 | ;; | |
1527 | ;; Written and contributed by Masatake YAMATO <jet@gyve.org> | |
1528 | ;; | |
1529 | ;; Modified by Eric Ludlam for | |
1530 | ;; * Safe compatibility for tooltip free systems. | |
1531 | ;; * Don't use 'avoid package for tooltip positioning. | |
1532 | ||
1533 | (defclass semantic-displayor-tooltip (semantic-displayor-traditional) | |
1534 | ((max-tags :type integer | |
1535 | :initarg :max-tags | |
1536 | :initform 5 | |
1537 | :custom integer | |
1538 | :documentation | |
1539 | "Max number of tags displayed on tooltip at once. | |
1540 | If `force-show' is 1, this value is ignored with typing tab or space twice continuously. | |
1541 | if `force-show' is 0, this value is always ignored.") | |
1542 | (force-show :type integer | |
1543 | :initarg :force-show | |
1544 | :initform 1 | |
1545 | :custom (choice (const | |
1546 | :tag "Show when double typing" | |
1547 | 1) | |
1548 | (const | |
1549 | :tag "Show always" | |
1550 | 0) | |
1551 | (const | |
1552 | :tag "Show if the number of tags is less than `max-tags'." | |
1553 | -1)) | |
1554 | :documentation | |
1555 | "Control the behavior of the number of tags is greater than `max-tags'. | |
1556 | -1 means tags are never shown. | |
1557 | 0 means the tags are always shown. | |
1558 | 1 means tags are shown if space or tab is typed twice continuously.") | |
1559 | (typing-count :type integer | |
1560 | :initform 0 | |
1561 | :documentation | |
1562 | "Counter holding how many times the user types space or tab continuously before showing tags.") | |
1563 | (shown :type boolean | |
1564 | :initform nil | |
1565 | :documentation | |
1566 | "Flag representing whether tags is shown once or not.") | |
1567 | ) | |
1568 | "Display completions options in a tooltip. | |
1569 | Display mechanism using tooltip for a list of possible completions.") | |
1570 | ||
1571 | (defmethod initialize-instance :AFTER ((obj semantic-displayor-tooltip) &rest args) | |
1572 | "Make sure we have tooltips required." | |
1573 | (condition-case nil | |
1574 | (require 'tooltip) | |
1575 | (error nil)) | |
1576 | ) | |
1577 | ||
1578 | (defmethod semantic-displayor-show-request ((obj semantic-displayor-tooltip)) | |
1579 | "A request to show the current tags table." | |
1580 | (if (or (not (featurep 'tooltip)) (not tooltip-mode)) | |
1581 | ;; If we cannot use tooltips, then go to the normal mode with | |
1582 | ;; a traditional completion buffer. | |
1583 | (call-next-method) | |
1584 | (let* ((tablelong (semanticdb-strip-find-results (oref obj table))) | |
1585 | (table (semantic-unique-tag-table-by-name tablelong)) | |
1586 | (l (mapcar semantic-completion-displayor-format-tag-function table)) | |
1587 | (ll (length l)) | |
1588 | (typing-count (oref obj typing-count)) | |
1589 | (force-show (oref obj force-show)) | |
1590 | (matchtxt (semantic-completion-text)) | |
1591 | msg) | |
1592 | (if (or (oref obj shown) | |
1593 | (< ll (oref obj max-tags)) | |
1594 | (and (<= 0 force-show) | |
1595 | (< (1- force-show) typing-count))) | |
1596 | (progn | |
1597 | (oset obj typing-count 0) | |
1598 | (oset obj shown t) | |
1599 | (if (eq 1 ll) | |
1600 | ;; We Have only one possible match. There could be two cases. | |
1601 | ;; 1) input text != single match. | |
1602 | ;; --> Show it! | |
1603 | ;; 2) input text == single match. | |
1604 | ;; --> Complain about it, but still show the match. | |
1605 | (if (string= matchtxt (semantic-tag-name (car table))) | |
1606 | (setq msg (concat "[COMPLETE]\n" (car l))) | |
1607 | (setq msg (car l))) | |
1608 | ;; Create the long message. | |
1609 | (setq msg (mapconcat 'identity l "\n")) | |
1610 | ;; If there is nothing, say so! | |
1611 | (if (eq 0 (length msg)) | |
1612 | (setq msg "[NO MATCH]"))) | |
1613 | (semantic-displayor-tooltip-show msg)) | |
1614 | ;; The typing count determines if the user REALLY REALLY | |
1615 | ;; wanted to show that much stuff. Only increment | |
1616 | ;; if the current command is a completion command. | |
1617 | (if (and (stringp (this-command-keys)) | |
1618 | (string= (this-command-keys) "\C-i")) | |
1619 | (oset obj typing-count (1+ typing-count))) | |
1620 | ;; At this point, we know we have too many items. | |
c7015153 | 1621 | ;; Let's be brave, and truncate l |
9573e58b CY |
1622 | (setcdr (nthcdr (oref obj max-tags) l) nil) |
1623 | (setq msg (mapconcat 'identity l "\n")) | |
1624 | (cond | |
1625 | ((= force-show -1) | |
1626 | (semantic-displayor-tooltip-show (concat msg "\n..."))) | |
1627 | ((= force-show 1) | |
1628 | (semantic-displayor-tooltip-show (concat msg "\n(TAB for more)"))) | |
1629 | ))))) | |
1630 | ||
1631 | ;;; Compatibility | |
1632 | ;; | |
1633 | (eval-and-compile | |
1634 | (if (fboundp 'window-inside-edges) | |
1635 | ;; Emacs devel. | |
1636 | (defalias 'semantic-displayor-window-edges | |
1637 | 'window-inside-edges) | |
1638 | ;; Emacs 21 | |
1639 | (defalias 'semantic-displayor-window-edges | |
1640 | 'window-edges) | |
1641 | )) | |
1642 | ||
1643 | (defun semantic-displayor-point-position () | |
1644 | "Return the location of POINT as positioned on the selected frame. | |
1645 | Return a cons cell (X . Y)" | |
1646 | (let* ((frame (selected-frame)) | |
1647 | (left (frame-parameter frame 'left)) | |
1648 | (top (frame-parameter frame 'top)) | |
1649 | (point-pix-pos (posn-x-y (posn-at-point))) | |
1650 | (edges (window-inside-pixel-edges (selected-window)))) | |
1651 | (cons (+ (car point-pix-pos) (car edges) left) | |
1652 | (+ (cdr point-pix-pos) (cadr edges) top)))) | |
1653 | ||
1654 | ||
1655 | (defun semantic-displayor-tooltip-show (text) | |
1656 | "Display a tooltip with TEXT near cursor." | |
1657 | (let ((point-pix-pos (semantic-displayor-point-position)) | |
1658 | (tooltip-frame-parameters | |
1659 | (append tooltip-frame-parameters nil))) | |
1660 | (push | |
1661 | (cons 'left (+ (car point-pix-pos) (frame-char-width))) | |
1662 | tooltip-frame-parameters) | |
1663 | (push | |
1664 | (cons 'top (+ (cdr point-pix-pos) (frame-char-height))) | |
1665 | tooltip-frame-parameters) | |
1666 | (tooltip-show text))) | |
1667 | ||
1668 | (defmethod semantic-displayor-scroll-request ((obj semantic-displayor-tooltip)) | |
1669 | "A request to for the displayor to scroll the completion list (if needed)." | |
1670 | ;; Do scrolling in the tooltip. | |
1671 | (oset obj max-tags 30) | |
1672 | (semantic-displayor-show-request obj) | |
1673 | ) | |
1674 | ||
1675 | ;; End code contributed by Masatake YAMATO <jet@gyve.org> | |
1676 | ||
1677 | \f | |
1678 | ;;; Ghost Text displayor | |
1679 | ;; | |
1680 | (defclass semantic-displayor-ghost (semantic-displayor-focus-abstract) | |
1681 | ||
1682 | ((ghostoverlay :type overlay | |
1683 | :documentation | |
1684 | "The overlay the ghost text is displayed in.") | |
1685 | (first-show :initform t | |
1686 | :documentation | |
1687 | "Non nil if we have not seen our first show request.") | |
1688 | ) | |
1689 | "Cycle completions inline with ghost text. | |
1690 | Completion displayor using ghost chars after point for focus options. | |
1691 | Whichever completion is currently in focus will be displayed as ghost | |
1692 | text using overlay options.") | |
1693 | ||
1694 | (defmethod semantic-displayor-next-action ((obj semantic-displayor-ghost)) | |
1695 | "The next action to take on the inline completion related to display." | |
1696 | (let ((ans (call-next-method)) | |
1697 | (table (when (slot-boundp obj 'table) | |
1698 | (oref obj table)))) | |
1699 | (if (and (eq ans 'displayend) | |
1700 | table | |
1701 | (= (semanticdb-find-result-length table) 1) | |
1702 | ) | |
1703 | nil | |
1704 | ans))) | |
1705 | ||
1706 | (defmethod semantic-displayor-cleanup ((obj semantic-displayor-ghost)) | |
1707 | "Clean up any mess this displayor may have." | |
1708 | (when (slot-boundp obj 'ghostoverlay) | |
1709 | (semantic-overlay-delete (oref obj ghostoverlay))) | |
1710 | ) | |
1711 | ||
1712 | (defmethod semantic-displayor-set-completions ((obj semantic-displayor-ghost) | |
1713 | table prefix) | |
1714 | "Set the list of tags to be completed over to TABLE." | |
1715 | (call-next-method) | |
1716 | ||
1717 | (semantic-displayor-cleanup obj) | |
1718 | ) | |
1719 | ||
1720 | ||
1721 | (defmethod semantic-displayor-show-request ((obj semantic-displayor-ghost)) | |
1722 | "A request to show the current tags table." | |
1723 | ; (if (oref obj first-show) | |
1724 | ; (progn | |
1725 | ; (oset obj first-show nil) | |
1726 | (semantic-displayor-focus-next obj) | |
1727 | (semantic-displayor-focus-request obj) | |
1728 | ; ) | |
1729 | ;; Only do the traditional thing if the first show request | |
1730 | ;; has been seen. Use the first one to start doing the ghost | |
1731 | ;; text display. | |
1732 | ; (call-next-method) | |
1733 | ; ) | |
1734 | ) | |
1735 | ||
1736 | (defmethod semantic-displayor-focus-request | |
1737 | ((obj semantic-displayor-ghost)) | |
1738 | "Focus in on possible tag completions. | |
1739 | Focus is performed by cycling through the tags and showing a possible | |
1740 | completion text in ghost text." | |
1741 | (let* ((tablelength (semanticdb-find-result-length (oref obj table))) | |
1742 | (focus (semantic-displayor-focus-tag obj)) | |
1743 | (tag (car focus)) | |
1744 | ) | |
1745 | (if (not tag) | |
1746 | (semantic-completion-message "No tags to focus on.") | |
1747 | ;; Display the focus completion as ghost text after the current | |
1748 | ;; inline text. | |
1749 | (when (or (not (slot-boundp obj 'ghostoverlay)) | |
1750 | (not (semantic-overlay-live-p (oref obj ghostoverlay)))) | |
1751 | (oset obj ghostoverlay | |
1752 | (semantic-make-overlay (point) (1+ (point)) (current-buffer) t))) | |
1753 | ||
1754 | (let* ((lp (semantic-completion-text)) | |
1755 | (os (substring (semantic-tag-name tag) (length lp))) | |
1756 | (ol (oref obj ghostoverlay)) | |
1757 | ) | |
1758 | ||
1759 | (put-text-property 0 (length os) 'face 'region os) | |
1760 | ||
1761 | (semantic-overlay-put | |
1762 | ol 'display (concat os (buffer-substring (point) (1+ (point))))) | |
1763 | ) | |
1764 | ;; Calculate text difference between contents and the focus item. | |
1765 | (let* ((mbc (semantic-completion-text)) | |
1766 | (ftn (concat (semantic-tag-name tag))) | |
1767 | ) | |
1768 | (put-text-property (length mbc) (length ftn) 'face | |
1769 | 'bold ftn) | |
1770 | (semantic-completion-message | |
1771 | (format "%s [%d of %d matches]" ftn (1+ (oref obj focus)) tablelength))) | |
1772 | ))) | |
1773 | ||
1774 | \f | |
1775 | ;;; ------------------------------------------------------------ | |
1776 | ;;; Specific queries | |
1777 | ;; | |
aa8724ae CY |
1778 | (defvar semantic-complete-inline-custom-type |
1779 | (append '(radio) | |
1780 | (mapcar | |
1781 | (lambda (class) | |
1782 | (let* ((C (intern (car class))) | |
1783 | (doc (documentation-property C 'variable-documentation)) | |
1784 | (doc1 (car (split-string doc "\n"))) | |
1785 | ) | |
1786 | (list 'const | |
1787 | :tag doc1 | |
1788 | C))) | |
1789 | (eieio-build-class-alist semantic-displayor-abstract t)) | |
1790 | ) | |
9bf6c65c | 1791 | "Possible options for inline completion displayors. |
aa8724ae CY |
1792 | Use this to enable custom editing.") |
1793 | ||
1794 | (defcustom semantic-complete-inline-analyzer-displayor-class | |
1795 | 'semantic-displayor-traditional | |
1796 | "*Class for displayor to use with inline completion." | |
1797 | :group 'semantic | |
1798 | :type semantic-complete-inline-custom-type | |
1799 | ) | |
1800 | ||
9573e58b CY |
1801 | (defun semantic-complete-read-tag-buffer-deep (prompt &optional |
1802 | default-tag | |
1803 | initial-input | |
1804 | history) | |
1805 | "Ask for a tag by name from the current buffer. | |
1806 | Available tags are from the current buffer, at any level. | |
1807 | Completion options are presented in a traditional way, with highlighting | |
1808 | to resolve same-name collisions. | |
1809 | PROMPT is a string to prompt with. | |
1810 | DEFAULT-TAG is a semantic tag or string to use as the default value. | |
1811 | If INITIAL-INPUT is non-nil, insert it in the minibuffer initially. | |
1812 | HISTORY is a symbol representing a variable to store the history in." | |
1813 | (semantic-complete-read-tag-engine | |
1814 | (semantic-collector-buffer-deep prompt :buffer (current-buffer)) | |
1815 | (semantic-displayor-traditional-with-focus-highlight "simple") | |
1816 | ;;(semantic-displayor-tooltip "simple") | |
1817 | prompt | |
1818 | default-tag | |
1819 | initial-input | |
1820 | history) | |
1821 | ) | |
1822 | ||
dd9af436 CY |
1823 | (defun semantic-complete-read-tag-local-members (prompt &optional |
1824 | default-tag | |
1825 | initial-input | |
1826 | history) | |
1827 | "Ask for a tag by name from the local type members. | |
9b053e76 | 1828 | Available tags are from the current scope. |
dd9af436 CY |
1829 | Completion options are presented in a traditional way, with highlighting |
1830 | to resolve same-name collisions. | |
1831 | PROMPT is a string to prompt with. | |
1832 | DEFAULT-TAG is a semantic tag or string to use as the default value. | |
1833 | If INITIAL-INPUT is non-nil, insert it in the minibuffer initially. | |
1834 | HISTORY is a symbol representing a variable to store the history in." | |
1835 | (semantic-complete-read-tag-engine | |
1836 | (semantic-collector-local-members prompt :buffer (current-buffer)) | |
1837 | (semantic-displayor-traditional-with-focus-highlight "simple") | |
1838 | ;;(semantic-displayor-tooltip "simple") | |
1839 | prompt | |
1840 | default-tag | |
1841 | initial-input | |
1842 | history) | |
1843 | ) | |
1844 | ||
9573e58b CY |
1845 | (defun semantic-complete-read-tag-project (prompt &optional |
1846 | default-tag | |
1847 | initial-input | |
1848 | history) | |
1849 | "Ask for a tag by name from the current project. | |
1850 | Available tags are from the current project, at the top level. | |
1851 | Completion options are presented in a traditional way, with highlighting | |
1852 | to resolve same-name collisions. | |
1853 | PROMPT is a string to prompt with. | |
1854 | DEFAULT-TAG is a semantic tag or string to use as the default value. | |
1855 | If INITIAL-INPUT is non-nil, insert it in the minibuffer initially. | |
1856 | HISTORY is a symbol representing a variable to store the history in." | |
1857 | (semantic-complete-read-tag-engine | |
1858 | (semantic-collector-project-brutish prompt | |
1859 | :buffer (current-buffer) | |
1860 | :path (current-buffer) | |
1861 | ) | |
1862 | (semantic-displayor-traditional-with-focus-highlight "simple") | |
1863 | prompt | |
1864 | default-tag | |
1865 | initial-input | |
1866 | history) | |
1867 | ) | |
1868 | ||
1869 | (defun semantic-complete-inline-tag-project () | |
1870 | "Complete a symbol name by name from within the current project. | |
1871 | This is similar to `semantic-complete-read-tag-project', except | |
1872 | that the completion interaction is in the buffer where the context | |
1873 | was calculated from. | |
1874 | Customize `semantic-complete-inline-analyzer-displayor-class' | |
1875 | to control how completion options are displayed. | |
1876 | See `semantic-complete-inline-tag-engine' for details on how | |
1877 | completion works." | |
1878 | (let* ((collector (semantic-collector-project-brutish | |
1879 | "inline" | |
1880 | :buffer (current-buffer) | |
1881 | :path (current-buffer))) | |
1882 | (sbounds (semantic-ctxt-current-symbol-and-bounds)) | |
1883 | (syms (car sbounds)) | |
1884 | (start (car (nth 2 sbounds))) | |
1885 | (end (cdr (nth 2 sbounds))) | |
1886 | (rsym (reverse syms)) | |
1887 | (thissym (nth 1 sbounds)) | |
1888 | (nextsym (car-safe (cdr rsym))) | |
1889 | (complst nil)) | |
1890 | (when (and thissym (or (not (string= thissym "")) | |
1891 | nextsym)) | |
1892 | ;; Do a quick calcuation of completions. | |
1893 | (semantic-collector-calculate-completions | |
1894 | collector thissym nil) | |
1895 | ;; Get the master list | |
1896 | (setq complst (semanticdb-strip-find-results | |
1897 | (semantic-collector-all-completions collector thissym))) | |
1898 | ;; Shorten by name | |
1899 | (setq complst (semantic-unique-tag-table-by-name complst)) | |
1900 | (if (or (and (= (length complst) 1) | |
1901 | ;; Check to see if it is the same as what is there. | |
1902 | ;; if so, we can offer to complete. | |
1903 | (let ((compname (semantic-tag-name (car complst)))) | |
1904 | (not (string= compname thissym)))) | |
1905 | (> (length complst) 1)) | |
1906 | ;; There are several options. Do the completion. | |
1907 | (semantic-complete-inline-tag-engine | |
1908 | collector | |
1909 | (funcall semantic-complete-inline-analyzer-displayor-class | |
1910 | "inline displayor") | |
1911 | ;;(semantic-displayor-tooltip "simple") | |
1912 | (current-buffer) | |
1913 | start end)) | |
1914 | ))) | |
1915 | ||
1916 | (defun semantic-complete-read-tag-analyzer (prompt &optional | |
1917 | context | |
1918 | history) | |
1919 | "Ask for a tag by name based on the current context. | |
1920 | The function `semantic-analyze-current-context' is used to | |
1921 | calculate the context. `semantic-analyze-possible-completions' is used | |
1922 | to generate the list of possible completions. | |
1923 | PROMPT is the first part of the prompt. Additional prompt | |
1924 | is added based on the contexts full prefix. | |
1925 | CONTEXT is the semantic analyzer context to start with. | |
9bf6c65c | 1926 | HISTORY is a symbol representing a variable to store the history in. |
9573e58b CY |
1927 | usually a default-tag and initial-input are available for completion |
1928 | prompts. these are calculated from the CONTEXT variable passed in." | |
1929 | (if (not context) (setq context (semantic-analyze-current-context (point)))) | |
1930 | (let* ((syms (semantic-ctxt-current-symbol (point))) | |
1931 | (inp (car (reverse syms)))) | |
1932 | (setq syms (nreverse (cdr (nreverse syms)))) | |
1933 | (semantic-complete-read-tag-engine | |
1934 | (semantic-collector-analyze-completions | |
1935 | prompt | |
1936 | :buffer (oref context buffer) | |
1937 | :context context) | |
1938 | (semantic-displayor-traditional-with-focus-highlight "simple") | |
0816d744 | 1939 | (with-current-buffer (oref context buffer) |
9573e58b CY |
1940 | (goto-char (cdr (oref context bounds))) |
1941 | (concat prompt (mapconcat 'identity syms ".") | |
1942 | (if syms "." "") | |
1943 | )) | |
1944 | nil | |
1945 | inp | |
1946 | history))) | |
1947 | ||
9573e58b CY |
1948 | (defun semantic-complete-inline-analyzer (context) |
1949 | "Complete a symbol name by name based on the current context. | |
1950 | This is similar to `semantic-complete-read-tag-analyze', except | |
1951 | that the completion interaction is in the buffer where the context | |
1952 | was calculated from. | |
1953 | CONTEXT is the semantic analyzer context to start with. | |
1954 | Customize `semantic-complete-inline-analyzer-displayor-class' | |
1955 | to control how completion options are displayed. | |
1956 | ||
1957 | See `semantic-complete-inline-tag-engine' for details on how | |
1958 | completion works." | |
1959 | (if (not context) (setq context (semantic-analyze-current-context (point)))) | |
1960 | (if (not context) (error "Nothing to complete on here")) | |
1961 | (let* ((collector (semantic-collector-analyze-completions | |
1962 | "inline" | |
1963 | :buffer (oref context buffer) | |
1964 | :context context)) | |
1965 | (syms (semantic-ctxt-current-symbol (point))) | |
1966 | (rsym (reverse syms)) | |
1967 | (thissym (car rsym)) | |
1968 | (nextsym (car-safe (cdr rsym))) | |
1969 | (complst nil)) | |
1970 | (when (and thissym (or (not (string= thissym "")) | |
1971 | nextsym)) | |
1972 | ;; Do a quick calcuation of completions. | |
1973 | (semantic-collector-calculate-completions | |
1974 | collector thissym nil) | |
1975 | ;; Get the master list | |
1976 | (setq complst (semanticdb-strip-find-results | |
1977 | (semantic-collector-all-completions collector thissym))) | |
1978 | ;; Shorten by name | |
1979 | (setq complst (semantic-unique-tag-table-by-name complst)) | |
1980 | (if (or (and (= (length complst) 1) | |
1981 | ;; Check to see if it is the same as what is there. | |
1982 | ;; if so, we can offer to complete. | |
1983 | (let ((compname (semantic-tag-name (car complst)))) | |
1984 | (not (string= compname thissym)))) | |
1985 | (> (length complst) 1)) | |
1986 | ;; There are several options. Do the completion. | |
1987 | (semantic-complete-inline-tag-engine | |
1988 | collector | |
1989 | (funcall semantic-complete-inline-analyzer-displayor-class | |
1990 | "inline displayor") | |
1991 | ;;(semantic-displayor-tooltip "simple") | |
1992 | (oref context buffer) | |
1993 | (car (oref context bounds)) | |
1994 | (cdr (oref context bounds)) | |
1995 | )) | |
1996 | ))) | |
1997 | ||
1998 | (defcustom semantic-complete-inline-analyzer-idle-displayor-class | |
1999 | 'semantic-displayor-ghost | |
2000 | "*Class for displayor to use with inline completion at idle time." | |
2001 | :group 'semantic | |
2002 | :type semantic-complete-inline-custom-type | |
2003 | ) | |
2004 | ||
2005 | (defun semantic-complete-inline-analyzer-idle (context) | |
2006 | "Complete a symbol name by name based on the current context for idle time. | |
2007 | CONTEXT is the semantic analyzer context to start with. | |
2008 | This function is used from `semantic-idle-completions-mode'. | |
2009 | ||
2010 | This is the same as `semantic-complete-inline-analyzer', except that | |
2011 | it uses `semantic-complete-inline-analyzer-idle-displayor-class' | |
2012 | to control how completions are displayed. | |
2013 | ||
2014 | See `semantic-complete-inline-tag-engine' for details on how | |
2015 | completion works." | |
2016 | (let ((semantic-complete-inline-analyzer-displayor-class | |
2017 | semantic-complete-inline-analyzer-idle-displayor-class)) | |
2018 | (semantic-complete-inline-analyzer context) | |
2019 | )) | |
2020 | ||
2021 | \f | |
479527de | 2022 | ;;;###autoload |
9573e58b | 2023 | (defun semantic-complete-jump-local () |
dd9af436 | 2024 | "Jump to a local semantic symbol." |
9573e58b | 2025 | (interactive) |
ab2c15d4 | 2026 | (let ((tag (semantic-complete-read-tag-buffer-deep "Jump to symbol: "))) |
9573e58b CY |
2027 | (when (semantic-tag-p tag) |
2028 | (push-mark) | |
2029 | (goto-char (semantic-tag-start tag)) | |
2030 | (semantic-momentary-highlight-tag tag) | |
2031 | (message "%S: %s " | |
2032 | (semantic-tag-class tag) | |
2033 | (semantic-tag-name tag))))) | |
2034 | ||
479527de | 2035 | ;;;###autoload |
9573e58b CY |
2036 | (defun semantic-complete-jump () |
2037 | "Jump to a semantic symbol." | |
2038 | (interactive) | |
ab2c15d4 | 2039 | (let* ((tag (semantic-complete-read-tag-project "Jump to symbol: "))) |
9573e58b CY |
2040 | (when (semantic-tag-p tag) |
2041 | (push-mark) | |
2042 | (semantic-go-to-tag tag) | |
2043 | (switch-to-buffer (current-buffer)) | |
2044 | (semantic-momentary-highlight-tag tag) | |
2045 | (message "%S: %s " | |
2046 | (semantic-tag-class tag) | |
2047 | (semantic-tag-name tag))))) | |
2048 | ||
dd9af436 CY |
2049 | ;;;###autoload |
2050 | (defun semantic-complete-jump-local-members () | |
2051 | "Jump to a semantic symbol." | |
2052 | (interactive) | |
2053 | (let* ((tag (semantic-complete-read-tag-local-members "Jump to symbol: "))) | |
2054 | (when (semantic-tag-p tag) | |
2055 | (let ((start (condition-case nil (semantic-tag-start tag) | |
2056 | (error nil)))) | |
2057 | (unless start | |
2058 | (error "Tag %s has no location" (semantic-format-tag-prototype tag))) | |
2059 | (push-mark) | |
2060 | (goto-char start) | |
2061 | (semantic-momentary-highlight-tag tag) | |
2062 | (message "%S: %s " | |
2063 | (semantic-tag-class tag) | |
2064 | (semantic-tag-name tag)))))) | |
2065 | ||
479527de | 2066 | ;;;###autoload |
9573e58b CY |
2067 | (defun semantic-complete-analyze-and-replace () |
2068 | "Perform prompt completion to do in buffer completion. | |
2069 | `semantic-analyze-possible-completions' is used to determine the | |
2070 | possible values. | |
2071 | The minibuffer is used to perform the completion. | |
2072 | The result is inserted as a replacement of the text that was there." | |
2073 | (interactive) | |
2074 | (let* ((c (semantic-analyze-current-context (point))) | |
2075 | (tag (save-excursion (semantic-complete-read-tag-analyzer "" c)))) | |
2076 | ;; Take tag, and replace context bound with its name. | |
2077 | (goto-char (car (oref c bounds))) | |
2078 | (delete-region (point) (cdr (oref c bounds))) | |
2079 | (insert (semantic-tag-name tag)) | |
2080 | (message "%S" (semantic-format-tag-summarize tag)))) | |
2081 | ||
479527de | 2082 | ;;;###autoload |
9573e58b CY |
2083 | (defun semantic-complete-analyze-inline () |
2084 | "Perform prompt completion to do in buffer completion. | |
2085 | `semantic-analyze-possible-completions' is used to determine the | |
2086 | possible values. | |
2087 | The function returns immediately, leaving the buffer in a mode that | |
2088 | will perform the completion. | |
2089 | Configure `semantic-complete-inline-analyzer-displayor-class' to change | |
2090 | how completion options are displayed." | |
2091 | (interactive) | |
2092 | ;; Only do this if we are not already completing something. | |
2093 | (if (not (semantic-completion-inline-active-p)) | |
2094 | (semantic-complete-inline-analyzer | |
2095 | (semantic-analyze-current-context (point)))) | |
2096 | ;; Report a message if things didn't startup. | |
2054a44c | 2097 | (if (and (called-interactively-p 'any) |
9573e58b CY |
2098 | (not (semantic-completion-inline-active-p))) |
2099 | (message "Inline completion not needed.") | |
2100 | ;; Since this is most likely bound to something, and not used | |
2101 | ;; at idle time, throw in a TAB for good measure. | |
2054a44c | 2102 | (semantic-complete-inline-TAB))) |
9573e58b | 2103 | |
479527de | 2104 | ;;;###autoload |
9573e58b CY |
2105 | (defun semantic-complete-analyze-inline-idle () |
2106 | "Perform prompt completion to do in buffer completion. | |
2107 | `semantic-analyze-possible-completions' is used to determine the | |
2108 | possible values. | |
2109 | The function returns immediately, leaving the buffer in a mode that | |
2110 | will perform the completion. | |
2111 | Configure `semantic-complete-inline-analyzer-idle-displayor-class' | |
2112 | to change how completion options are displayed." | |
2113 | (interactive) | |
2114 | ;; Only do this if we are not already completing something. | |
2115 | (if (not (semantic-completion-inline-active-p)) | |
2116 | (semantic-complete-inline-analyzer-idle | |
2117 | (semantic-analyze-current-context (point)))) | |
2118 | ;; Report a message if things didn't startup. | |
2054a44c | 2119 | (if (and (called-interactively-p 'interactive) |
9573e58b | 2120 | (not (semantic-completion-inline-active-p))) |
2054a44c | 2121 | (message "Inline completion not needed."))) |
9573e58b | 2122 | |
479527de | 2123 | ;;;###autoload |
9573e58b CY |
2124 | (defun semantic-complete-self-insert (arg) |
2125 | "Like `self-insert-command', but does completion afterwards. | |
2126 | ARG is passed to `self-insert-command'. If ARG is nil, | |
2127 | use `semantic-complete-analyze-inline' to complete." | |
2128 | (interactive "p") | |
2129 | ;; If we are already in a completion scenario, exit now, and then start over. | |
2130 | (semantic-complete-inline-exit) | |
2131 | ||
2132 | ;; Insert the key | |
2133 | (self-insert-command arg) | |
2134 | ||
2135 | ;; Prepare for doing completion, but exit quickly if there is keyboard | |
2136 | ;; input. | |
dd9af436 CY |
2137 | (when (save-window-excursion |
2138 | (save-excursion | |
2139 | (and (not (semantic-exit-on-input 'csi | |
2140 | (semantic-fetch-tags) | |
2141 | (semantic-throw-on-input 'csi) | |
2142 | nil)) | |
2143 | (= arg 1) | |
2144 | (not (semantic-exit-on-input 'csi | |
2145 | (semantic-analyze-current-context) | |
2146 | (semantic-throw-on-input 'csi) | |
2147 | nil))))) | |
9573e58b CY |
2148 | (condition-case nil |
2149 | (semantic-complete-analyze-inline) | |
2150 | ;; Ignore errors. Seems likely that we'll get some once in a while. | |
2151 | (error nil)) | |
2152 | )) | |
2153 | ||
9573e58b CY |
2154 | (provide 'semantic/complete) |
2155 | ||
479527de CY |
2156 | ;; Local variables: |
2157 | ;; generated-autoload-file: "loaddefs.el" | |
479527de CY |
2158 | ;; generated-autoload-load-name: "semantic/complete" |
2159 | ;; End: | |
2160 | ||
aa8724ae | 2161 | ;;; semantic/complete.el ends here |