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