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