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