1 ;;; semantic-complete.el --- Routines for performing tag completion
3 ;;; Copyright (C) 2003, 2004, 2005, 2007 Eric M. Ludlam
5 ;; Author: Eric M. Ludlam <zappo@gnu.org>
7 ;; X-RCS: $Id: semantic-complete.el,v 1.1 2007-11-26 15:10:33 michaels Exp $
9 ;; This file is not part of GNU Emacs.
11 ;; Semantic 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 2, or (at your option)
16 ;; This software 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.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24 ;; Boston, MA 02110-1301, USA.
28 ;; Completion of tags by name using tables of semantic generated tags.
30 ;; While it would be a simple matter of flattening all tag known
31 ;; tables to perform completion across them using `all-completions',
32 ;; or `try-completion', that process would be slow. In particular,
33 ;; when a system database is included in the mix, the potential for a
34 ;; ludicrous number of options becomes apparent.
36 ;; As such, dynamically searching across tables using a prefix,
37 ;; regular expression, or other feature is needed to help find symbols
38 ;; quickly without resorting to "show me every possible option now".
40 ;; In addition, some symbol names will appear in multiple locations.
41 ;; If it is important to distiguish, then a way to provide a choice
42 ;; over these locations is important as well.
44 ;; Beyond brute force offers for completion of plain strings,
45 ;; using the smarts of semantic-analyze to provide reduced lists of
46 ;; symbols, or fancy tabbing to zoom into files to show multiple hits
47 ;; of the same name can be provided.
51 ;; There are several parts of any completion engine. They are:
53 ;; A. Collection of possible hits
54 ;; B. Typing or selecting an option
55 ;; C. Displaying possible unique completions
56 ;; D. Using the result
58 ;; Here, we will treat each section separately (excluding D)
59 ;; They can then be strung together in user-visible commands to
60 ;; fullfill specific needs.
64 ;; A collector is an object which represents the means by which tags
65 ;; to complete on are collected. It's first job is to find all the
66 ;; tags which are to be completed against. It can also rename
67 ;; some tags if needed so long as `semantic-tag-clone' is used.
69 ;; Some collectors will gather all tags to complete against first
70 ;; (for in buffer queries, or other small list situations). It may
71 ;; choose to do a broad search on each completion request. Built in
72 ;; functionality automatically focuses the cache in as the user types.
74 ;; A collector choosing to create and rename tags could choose a
75 ;; plain name format, a postfix name such as method:class, or a
76 ;; prefix name such as class.method.
80 ;; A displayor is in charge if showing the user interesting things
81 ;; about available completions, and can optionally provide a focus.
82 ;; The simplest display just lists all available names in a separate
83 ;; window. It may even choose to show short names when there are
84 ;; many to choose from, or long names when there are fewer.
86 ;; A complex displayor could opt to help the user 'focus' on some
87 ;; range. For example, if 4 tags all have the same name, subsequent
88 ;; calls to the displayor may opt to show each tag one at a time in
89 ;; the buffer. When the user likes one, selection would cause the
90 ;; 'focus' item to be selected.
94 ;; The format of the tag lists used to perform the completions are in
95 ;; semanticdb "find" format, like this:
97 ;; ( ( DBTABLE1 TAG1 TAG2 ...)
98 ;; ( DBTABLE2 TAG1 TAG2 ...)
101 ;; INLINE vs MINIBUFFER
103 ;; Two major ways completion is used in Emacs is either through a
104 ;; minibuffer query, or via completion in a normal editing buffer,
105 ;; encompassing some small range of characters.
107 ;; Structure for both types of completion are provided here.
108 ;; `semantic-complete-read-tag-engine' will use the minibuffer.
109 ;; `semantic-complete-inline-tag-engine' will complete text in
113 (require 'semantic-tag)
114 (require 'semantic-find)
115 (require 'semantic-analyze)
116 (require 'semantic-format)
117 (require 'semantic-ctxt)
118 ;; Keep semanticdb optional.
120 (require 'semanticdb)
121 (require 'semanticdb-find))
125 ;; Tooltip not available in older emacsen.
134 (if (fboundp 'minibuffer-contents)
135 (eval-and-compile (defalias 'semantic-minibuffer-contents 'minibuffer-contents))
136 (eval-and-compile (defalias 'semantic-minibuffer-contents 'buffer-string)))
137 (if (fboundp 'delete-minibuffer-contents)
138 (eval-and-compile (defalias 'semantic-delete-minibuffer-contents 'delete-minibuffer-contents))
139 (eval-and-compile (defalias 'semantic-delete-minibuffer-contents 'erase-buffer)))
141 (defvar semantic-complete-inline-overlay nil
142 "The overlay currently active while completing inline.")
144 (defun semantic-completion-inline-active-p ()
145 "Non-nil if inline completion is active."
146 semantic-complete-inline-overlay)
148 ;;; ------------------------------------------------------------
149 ;;; MINIBUFFER or INLINE utils
151 (defun semantic-completion-text ()
152 "Return the text that is currently in the completion buffer.
153 For a minibuffer prompt, this is the minibuffer text.
154 For inline completion, this is the text wrapped in the inline completion
156 (if semantic-complete-inline-overlay
157 (semantic-complete-inline-text)
158 (semantic-minibuffer-contents)))
160 (defun semantic-completion-delete-text ()
161 "Delete the text that is actively being completed.
162 Presumably if you call this you will insert something new there."
163 (if semantic-complete-inline-overlay
164 (semantic-complete-inline-delete-text)
165 (semantic-delete-minibuffer-contents)))
167 (defun semantic-completion-message (fmt &rest args)
168 "Display the string FMT formatted with ARGS at the end of the minibuffer."
169 (if semantic-complete-inline-overlay
170 (apply 'message fmt args)
171 (message (concat (buffer-string) (apply 'format fmt args)))))
173 ;;; ------------------------------------------------------------
174 ;;; MINIBUFFER: Option Selection harnesses
176 (defvar semantic-completion-collector-engine nil
177 "The tag collector for the current completion operation.
178 Value should be an object of a subclass of
179 `semantic-completion-engine-abstract'.")
181 (defvar semantic-completion-display-engine nil
182 "The tag display engine for the current completion operation.
183 Value should be a ... what?")
185 (defvar semantic-complete-key-map
186 (let ((km (make-sparse-keymap)))
187 (define-key km " " 'semantic-complete-complete-space)
188 (define-key km "\t" 'semantic-complete-complete-tab)
189 (define-key km "\C-m" 'semantic-complete-done)
190 (define-key km "\C-g" 'abort-recursive-edit)
191 (define-key km "\M-n" 'next-history-element)
192 (define-key km "\M-p" 'previous-history-element)
193 (define-key km "\C-n" 'next-history-element)
194 (define-key km "\C-p" 'previous-history-element)
195 ;; Add history navigation
197 "Keymap used while completing across a list of tags.")
199 (defvar semantic-completion-default-history nil
200 "Default history variable for any unhistoried prompt.
201 Keeps STRINGS only in the history.")
205 (defun semantic-complete-read-tag-engine (collector displayor prompt
206 default-tag initial-input
208 "Read a semantic tag, and return a tag for the selection.
209 Argument COLLECTOR is an object which can be used to to calculate
210 a list of possible hits. See `semantic-completion-collector-engine'
211 for details on COLLECTOR.
212 Argumeng DISPLAYOR is an object used to display a list of possible
213 completions for a given prefix. See`semantic-completion-display-engine'
214 for details on DISPLAYOR.
215 PROMPT is a string to prompt with.
216 DEFAULT-TAG is a semantic tag or string to use as the default value.
217 If INITIAL-INPUT is non-nil, insert it in the minibuffer initially.
218 HISTORY is a symbol representing a variable to story the history in."
219 (let* ((semantic-completion-collector-engine collector)
220 (semantic-completion-display-engine displayor)
221 (semantic-complete-active-default nil)
222 (semantic-complete-current-matched-tag nil)
225 (default-as-tag (semantic-complete-default-to-tag default-tag))
226 (default-as-string (when (semantic-tag-p default-as-tag)
227 (semantic-tag-name default-as-tag)))
230 (when default-as-string
231 ;; Add this to the prompt.
233 ;; I really want to add a lookup of the symbol in those
234 ;; tags available to the collector and only add it if it
235 ;; is available as a possibility, but I'm too lazy right
238 (if (string-match ":" prompt)
240 (substring prompt 0 (match-beginning 0))
241 " (" default-as-string ")"
242 (substring prompt (match-beginning 0))))
243 (setq prompt (concat prompt " (" default-as-string "): "))))
245 ;; Perform the Completion
248 (read-from-minibuffer prompt
250 semantic-complete-key-map
253 'semantic-completion-default-history)
256 ;; Extract the tag from the completion machinery.
258 semantic-complete-current-matched-tag
262 ;;; Util for basic completion prompts
265 (defvar semantic-complete-active-default nil
266 "The current default tag calculated for this prompt.")
268 (defun semantic-complete-default-to-tag (default)
269 "Convert a calculated or passed in DEFAULT into a tag."
270 (if (semantic-tag-p default)
271 ;; Just return what was passed in.
272 (setq semantic-complete-active-default default)
273 ;; If none was passed in, guess.
275 (setq default (semantic-ctxt-current-thing)))
279 ;; Turn default into something useful.
282 ;; Semantic-ctxt-current-symbol will return a list of
283 ;; strings. Technically, we should use the analyzer to
284 ;; fully extract what we need, but for now, just grab the
286 ((and (listp default) (stringp (car default)))
291 (symbol-name default))
293 (signal 'wrong-type-argument
294 (list default 'semantic-tag-p)))))
296 ;; Now that we have that symbol string, look it up using the active
297 ;; collector. If we get a match, use it.
299 (semantic-collector-calculate-completions
300 semantic-completion-collector-engine
302 ;; Do we have the perfect match???
303 (let ((ml (semantic-collector-current-exact-match
304 semantic-completion-collector-engine)))
306 ;; We don't care about uniqueness. Just guess for convenience
307 (setq tag (semanticdb-find-result-nth-in-buffer ml 0))))
309 (setq semantic-complete-active-default tag)
310 ;; Return it.. .whatever it may be
314 ;;; Prompt Return Value
316 ;; Getting a return value out of this completion prompt is a bit
317 ;; challenging. The read command returns the string typed in.
318 ;; We need to convert this into a valid tag. We can exit the minibuffer
319 ;; for different reasons. If we purposely exit, we must make sure
320 ;; the focused tag is calculated... preferably once.
321 (defvar semantic-complete-current-matched-tag nil
322 "Variable used to pass the tags being matched to the prompt.")
324 (defun semantic-complete-current-match ()
325 "Calculate a match from the current completion environment.
326 Save this in our completion variable. Make sure that variable
327 is cleared if any other keypress is made.
329 tag - a single tag that has been matched.
330 string - a message to show in the minibuffer."
331 ;; Query the environment for an active completion.
332 (let ((collector semantic-completion-collector-engine)
333 (displayor semantic-completion-display-engine)
334 (contents (semantic-completion-text))
338 (if (string= contents "")
339 ;; The user wants the defaults!
340 (setq answer semantic-complete-active-default)
341 ;; This forces a full calculation of completion on CR.
343 (semantic-collector-calculate-completions collector contents nil))
344 (semantic-complete-try-completion)
346 ;; Input match displayor focus entry
347 ((setq answer (semantic-displayor-current-focus displayor))
348 ;; We have answer, continue
350 ;; One match from the collector
351 ((setq matchlist (semantic-collector-current-exact-match collector))
352 (if (= (semanticdb-find-result-length matchlist) 1)
353 (setq answer (semanticdb-find-result-nth-in-buffer matchlist 0))
354 (if (semantic-displayor-focus-abstract-child-p displayor)
355 ;; For focusing displayors, we can claim this is
356 ;; not unique. Multiple focuses can choose the correct
358 (setq answer "Not Unique")
359 ;; If we don't have a focusing displayor, we need to do something
360 ;; graceful. First, see if all the matches have the same name.
362 (firstname (semantic-tag-name
364 (semanticdb-find-result-nth matchlist 0)))
367 (max (semanticdb-find-result-length matchlist)))
368 (while (and allsame (< cnt max))
373 (semanticdb-find-result-nth matchlist cnt)))))
377 ;; Now we know if they are all the same. If they are, just
378 ;; accept the first, otherwise complain.
380 (setq answer (semanticdb-find-result-nth-in-buffer
382 (setq answer "Not Unique"))
386 (setq answer "No Match")))
388 ;; Set it into our completion target.
389 (when (semantic-tag-p answer)
390 (setq semantic-complete-current-matched-tag answer)
391 ;; Make sure it is up to date by clearing it if the user dares
392 ;; to touch the keyboard.
393 (add-hook 'pre-command-hook
394 (lambda () (setq semantic-complete-current-matched-tag nil)))
403 ;; Keys are bound to to perform completion using our mechanisms.
404 ;; Do that work here.
405 (defun semantic-complete-done ()
406 "Accept the current input."
408 (let ((ans (semantic-complete-current-match)))
410 (semantic-completion-message (concat " [" ans "]"))
414 (defun semantic-complete-complete-space ()
415 "Complete the partial input in the minibuffer."
417 (semantic-complete-do-completion t))
419 (defun semantic-complete-complete-tab ()
420 "Complete the partial input in the minibuffer as far as possible."
422 (semantic-complete-do-completion))
424 ;;; Completion Functions
426 ;; Thees routines are functional entry points to performing completion.
428 (defun semantic-complete-hack-word-boundaries (original new)
429 "Return a string to use for completion.
430 ORIGINAL is the text in the minibuffer.
431 NEW is the new text to insert into the minibuffer.
432 Within the difference bounds of ORIGINAL and NEW, shorten NEW
433 to the nearest word boundary, and return that."
435 (let* ((diff (substring new (length original)))
436 (end (string-match "\\>" diff))
437 (start (string-match "\\<" diff)))
439 ((and start (> start 0))
440 ;; If start is greater than 0, include only the new
442 (concat original (substring diff 0 start)))
444 (concat original (substring diff 0 end)))
447 (defun semantic-complete-try-completion (&optional partial)
448 "Try a completion for the current minibuffer.
449 If PARTIAL, do partial completion stopping at spaces."
450 (let ((comp (semantic-collector-try-completion
451 semantic-completion-collector-engine
452 (semantic-completion-text))))
455 (semantic-completion-message " [No Match]")
459 (if (string= (semantic-completion-text) comp)
461 ;; Minibuffer isn't changing AND the text is not unique.
462 ;; Test for partial completion over a word separator character.
463 ;; If there is one available, use that so that SPC can
464 ;; act like a SPC insert key.
465 (let ((newcomp (semantic-collector-current-whitespace-completion
466 semantic-completion-collector-engine)))
468 (semantic-completion-delete-text)
472 (let ((orig (semantic-completion-text)))
473 ;; For partial completion, we stop and step over
474 ;; word boundaries. Use this nifty function to do
475 ;; that calculation for us.
477 (semantic-complete-hack-word-boundaries orig comp))))
478 ;; Do the replacement.
479 (semantic-completion-delete-text)
482 ((and (listp comp) (semantic-tag-p (car comp)))
483 (unless (string= (semantic-completion-text)
484 (semantic-tag-name (car comp)))
485 ;; A fully unique completion was available.
486 (semantic-completion-delete-text)
487 (insert (semantic-tag-name (car comp))))
488 ;; The match is complete
489 (if (= (length comp) 1)
490 (semantic-completion-message " [Complete]")
491 (semantic-completion-message " [Complete, but not unique]"))
495 (defun semantic-complete-do-completion (&optional partial inline)
496 "Do a completion for the current minibuffer.
497 If PARTIAL, do partial completion stopping at spaces.
498 if INLINE, then completion is happing inline in a buffer."
499 (let* ((collector semantic-completion-collector-engine)
500 (displayor semantic-completion-display-engine)
501 (contents (semantic-completion-text)))
504 (semantic-collector-calculate-completions collector contents partial))
505 (let* ((na (semantic-complete-next-action partial)))
507 ;; We're all done, but only from a very specific
508 ;; area of completion.
510 (semantic-completion-message " [Complete]"))
511 ;; Perform completion
512 ((or (eq na 'complete)
513 (eq na 'complete-whitespace))
514 (semantic-complete-try-completion partial)
516 ;; We need to display the completions.
517 ;; Set the completions into the display engine
518 ((or (eq na 'display) (eq na 'displayend))
519 (semantic-displayor-set-completions
522 (and (not (eq na 'displayend))
523 (semantic-collector-current-exact-match collector))
524 (semantic-collector-all-completions collector contents))
526 ;; Ask the displayor to display them.
527 (semantic-displayor-show-request displayor)
530 (semantic-displayor-scroll-request displayor)
533 (semantic-displayor-focus-request displayor)
536 (semantic-completion-message " [No Match]"))
540 ;;; ------------------------------------------------------------
541 ;;; INLINE: tag completion harness
543 ;; Unlike the minibuffer, there is no mode nor other traditional
544 ;; means of reading user commands in completion mode. Instead
545 ;; we use a pre-command-hook to inset in our commands, and to
546 ;; push ourselves out of this mode on alternate keypresses.
547 (defvar semantic-complete-inline-map
548 (let ((km (make-sparse-keymap)))
549 (define-key km "\C-i" 'semantic-complete-inline-TAB)
550 (define-key km "\M-p" 'semantic-complete-inline-up)
551 (define-key km "\M-n" 'semantic-complete-inline-down)
552 (define-key km "\C-\M-c" 'semantic-complete-inline-exit)
553 (define-key km "\C-g" 'semantic-complete-inline-quit)
555 "Keymap used while performing inline completion..")
557 (defface semantic-complete-inline-face
558 '((((class color) (background dark))
559 (:underline "yellow"))
560 (((class color) (background light))
561 (:underline "brown")))
562 "*Face used to show the region being completed inline.
563 The face is used in `semantic-complete-inline-tag-engine'."
566 (defun semantic-complete-inline-text ()
567 "Return the text that is being completed inline.
568 Similar to `minibuffer-contents' when completing in the minibuffer."
569 (let ((s (semantic-overlay-start semantic-complete-inline-overlay))
570 (e (semantic-overlay-end semantic-complete-inline-overlay)))
573 (buffer-substring-no-properties s e ))))
575 (defun semantic-complete-inline-delete-text ()
576 "Delete the text currently being completed in the current buffer."
578 (semantic-overlay-start semantic-complete-inline-overlay)
579 (semantic-overlay-end semantic-complete-inline-overlay)))
581 (defun semantic-complete-inline-quit ()
582 "Quit an inline edit."
584 (semantic-complete-inline-exit)
587 (defun semantic-complete-inline-exit ()
588 "Exit inline completion mode."
590 ;; Remove this hook FIRST!
591 (remove-hook 'pre-command-hook 'semantic-complete-pre-command-hook)
595 (when semantic-complete-inline-overlay
596 (let ((wc (semantic-overlay-get semantic-complete-inline-overlay
597 'window-config-start)))
598 (semantic-overlay-delete semantic-complete-inline-overlay)
599 (setq semantic-complete-inline-overlay nil)
600 (set-window-configuration wc)
602 (setq semantic-completion-collector-engine nil
603 semantic-completion-display-engine nil))
606 ;; Remove this hook LAST!!!
607 ;; This will force us back through this function.
608 (remove-hook 'post-command-hook 'semantic-complete-post-command-hook)
610 ;;(message "Exiting inline completion.")
614 (defun semantic-complete-pre-command-hook ()
615 "Used to redefine what commands are being run while completing.
616 When installed as a `pre-command-hook' the special keymap
617 `semantic-complete-inline-map' is queried to replace commands normally run.
618 Commands which edit what is in the region of interest operate normally.
619 Commands which would take us out of the region of interest, or our
620 quit hook, will exit this completion mode."
621 (let ((fcn (lookup-key semantic-complete-inline-map
622 (this-command-keys) nil)))
623 (cond ((commandp fcn)
624 (setq this-command fcn))
628 (defun semantic-complete-post-command-hook ()
629 "Used to determine if we need to exit inline completion mode.
630 If completion mode is active, check to see if we are within
631 the bounds of `semantic-complete-inline-overlay', or within
632 a reasonable distance."
634 ;; Exit if something bad happened.
635 (if (not semantic-complete-inline-overlay)
637 ;;(message "Inline Hook installed, but overlay deleted.")
638 (semantic-complete-inline-exit))
639 ;; Exit if commands caused us to exit the area of interest
640 (let ((s (semantic-overlay-start semantic-complete-inline-overlay))
641 (e (semantic-overlay-end semantic-complete-inline-overlay))
642 (b (semantic-overlay-buffer semantic-complete-inline-overlay))
646 ;; EXIT when we are no longer in a good place.
647 ((or (not (eq b (current-buffer)))
650 ;;(message "Exit: %S %S %S" s e (point))
651 (semantic-complete-inline-exit)
653 ;; Exit if the user typed in a character that is not part
654 ;; of the symbol being completed.
655 ((and (setq txt (semantic-completion-text))
656 (not (string= txt ""))
660 (not (looking-at "\\(\\w\\|\\s_\\)")))))
661 ;;(message "Non symbol character.")
662 (semantic-complete-inline-exit))
664 ;; Else, show completions now
665 (semantic-complete-inline-force-display)
668 ;; If something goes terribly wrong, clean up after ourselves.
669 (error (semantic-complete-inline-exit))))
672 (defun semantic-complete-inline-force-display ()
673 "Force the display of whatever the current completions are.
674 DO NOT CALL THIS IF THE INLINE COMPLETION ENGINE IS NOT ACTIVE."
677 (let ((collector semantic-completion-collector-engine)
678 (displayor semantic-completion-display-engine)
679 (contents (semantic-completion-text)))
681 (semantic-collector-calculate-completions
682 collector contents nil)
683 (semantic-displayor-set-completions
685 (semantic-collector-all-completions collector contents)
687 ;; Ask the displayor to display them.
688 (semantic-displayor-show-request displayor))
690 (error (message "Bug Showing Completions: %S" e))))
692 (defun semantic-complete-inline-tag-engine
693 (collector displayor buffer start end)
694 "Perform completion based on semantic tags in a buffer.
695 Argument COLLECTOR is an object which can be used to to calculate
696 a list of possible hits. See `semantic-completion-collector-engine'
697 for details on COLLECTOR.
698 Argumeng DISPLAYOR is an object used to display a list of possible
699 completions for a given prefix. See`semantic-completion-display-engine'
700 for details on DISPLAYOR.
701 BUFFER is the buffer in which completion will take place.
702 START is a location for the start of the full symbol.
703 If the symbol being completed is \"foo.ba\", then START
704 is on the \"f\" character.
705 END is at the end of the current symbol being completed."
706 ;; Set us up for doing completion
707 (setq semantic-completion-collector-engine collector
708 semantic-completion-display-engine displayor)
710 (setq semantic-complete-inline-overlay
711 (semantic-make-overlay start end buffer nil t))
712 (semantic-overlay-put semantic-complete-inline-overlay
714 'semantic-complete-inline-face)
715 (semantic-overlay-put semantic-complete-inline-overlay
717 (current-window-configuration))
718 ;; Install our command hooks
719 (add-hook 'pre-command-hook 'semantic-complete-pre-command-hook)
720 (add-hook 'post-command-hook 'semantic-complete-post-command-hook)
724 ;;; Inline Completion Keymap Functions
726 (defun semantic-complete-inline-TAB ()
727 "Perform inline completion."
729 (semantic-complete-do-completion nil t)
732 (defun semantic-complete-inline-down(arg)
733 "Focus forwards through the displayor ARG amount."
738 (defun semantic-complete-inline-up (arg)
739 "Focus backwards through the displayor ARG amount."
741 (semantic-complete-inline-down (- 0 (or arg 0)))
745 ;;; ------------------------------------------------------------
746 ;;; Interactions between collection and displaying
748 ;; Functional routines used to help collectors communicate with
749 ;; the current displayor, or for the previous section.
751 (defun semantic-complete-next-action (partial)
752 "Determine what the next completion action should be.
753 PARTIAL is non-nil if we are doing partial completion.
754 First, the collector can determine if we should perform a completion or not.
755 If there is nothing to complete, then the displayor determines if we are
756 to show a completion list, scroll, or perhaps do a focus (if it is capable.)
757 Expected return values are:
758 done -> We have a singular match
759 empty -> There are no matches to the current text
760 complete -> Perform a completion action
761 complete-whitespace -> Complete next whitespace type character.
762 display -> Show the list of completions
763 scroll -> The completions have been shown, and the user keeps hitting
764 the complete button. If possible, scroll the completions
765 focus -> The displayor knows how to shift focus among possible completions.
767 displayend -> Whatever options the displayor had for repeating options, there
768 are none left. Try something new."
769 (let ((ans1 (semantic-collector-next-action
770 semantic-completion-collector-engine
772 (ans2 (semantic-displayor-next-action
773 semantic-completion-display-engine))
776 ;; No collector answer, use displayor answer.
779 ;; Displayor selection of 'scroll, 'display, or 'focus trumps
781 ((and (eq ans1 'done) ans2)
783 ;; Use ans1 when we have it.
789 ;;; ------------------------------------------------------------
790 ;;; Collection Engines
792 ;; Collection engines can scan tags from the current environment and
793 ;; provide lists of possible completions.
795 ;; General features of the abstract collector:
796 ;; * Cache completion lists between uses
797 ;; * Cache itself per buffer. Handle reparse hooks
799 ;; Key Interface Functions to implement:
800 ;; * semantic-collector-next-action
801 ;; * semantic-collector-calculate-completions
802 ;; * semantic-collector-try-completion
803 ;; * semantic-collector-all-completions
805 (defvar semantic-collector-per-buffer-list nil
806 "List of collectors active in this buffer.")
807 (make-variable-buffer-local 'semantic-collector-per-buffer-list)
809 (defvar semantic-collector-list nil
810 "List of global collectors active this session.")
812 (defclass semantic-collector-abstract ()
813 ((buffer :initarg :buffer
815 :documentation "Originating buffer for this collector.
816 Some collectors use a given buffer as a starting place while looking up
819 :type (or null semanticdb-find-result-with-nil)
820 :documentation "Cache of tags.
821 These tags are re-used during a completion session.
822 Sometimes these tags are cached between completion sessions.")
823 (last-all-completions :initarg nil
824 :type semanticdb-find-result-with-nil
825 :documentation "Last result of `all-completions'.
826 This result can be used for refined completions as `last-prefix' gets
827 closer to a specific result.")
828 (last-prefix :type string
829 :protection :protected
830 :documentation "The last queried prefix.
831 This prefix can be used to cache intermediate completion offers.
832 making the action of homing in on a token faster.")
833 (last-completion :type (or null string)
834 :documentation "The last calculated completion.
835 This completion is calculated and saved for future use.")
836 (last-whitespace-completion :type (or null string)
837 :documentation "The last whitespace completion.
838 For partial completion, SPC will disabiguate over whitespace type
839 characters. This is the last calculated version.")
840 (current-exact-match :type list
841 :protection :protected
842 :documentation "The list of matched tags.
843 When tokens are matched, they are added to this list.")
845 "Root class for completion engines.
846 The baseclass provides basic functionality for interacting with
847 a completion displayor object, and tracking the current progress
851 (defmethod semantic-collector-next-action
852 ((obj semantic-collector-abstract) partial)
853 "What should we do next? OBJ can predict a next good action.
854 PARTIAL indicates if we are doing a partial completion."
855 (if (and (slot-boundp obj 'last-completion)
856 (string= (semantic-completion-text) (oref obj last-completion)))
857 (let* ((cem (semantic-collector-current-exact-match obj))
858 (cemlen (semanticdb-find-result-length cem))
859 (cac (semantic-collector-all-completions
860 obj (semantic-completion-text)))
861 (caclen (semanticdb-find-result-length cac)))
862 (cond ((and cem (= cemlen 1)
864 (eq last-command this-command))
865 ;; Defer to the displayor...
867 ((and cem (= cemlen 1))
869 ((and (not cem) (not cac))
871 ((and partial (semantic-collector-try-completion-whitespace
872 obj (semantic-completion-text)))
873 'complete-whitespace)))
876 (defmethod semantic-collector-last-prefix= ((obj semantic-collector-abstract)
878 "Return non-nil if OBJ's prefix matches PREFIX."
879 (and (slot-boundp obj 'last-prefix)
880 (string= (oref obj last-prefix) last-prefix)))
882 (defmethod semantic-collector-get-cache ((obj semantic-collector-abstract))
883 "Get the raw cache of tags for completion.
884 Calculate the cache if there isn't one."
886 (semantic-collector-calculate-cache obj)))
888 (defmethod semantic-collector-calculate-completions-raw
889 ((obj semantic-collector-abstract) prefix completionlist)
890 "Calculate the completions for prefix from completionlist.
891 Output must be in semanticdb Find result format."
892 ;; Must output in semanticdb format
893 (let ((table (save-excursion
894 (set-buffer (oref obj buffer))
895 semanticdb-current-table))
896 (result (semantic-find-tags-for-completion
898 ;; To do this kind of search with a pre-built completion
899 ;; list, we need to strip it first.
900 (semanticdb-strip-find-results completionlist)))
903 (list (cons table result)))))
905 (defmethod semantic-collector-calculate-completions
906 ((obj semantic-collector-abstract) prefix partial)
907 "Calculate completions for prefix as setup for other queries."
908 (let* ((case-fold-search semantic-case-fold)
909 (same-prefix-p (semantic-collector-last-prefix= obj prefix))
911 (if (or same-prefix-p
912 (and (slot-boundp obj 'last-prefix)
913 (eq (compare-strings (oref obj last-prefix) 0 nil
914 prefix 0 (length prefix))
916 ;; New prefix is subset of old prefix
917 (oref obj last-all-completions)
918 (semantic-collector-get-cache obj)))
920 (answer (if same-prefix-p
922 (semantic-collector-calculate-completions-raw
923 obj prefix completionlist))
926 (complete-not-uniq nil)
928 ;;(semanticdb-find-result-test answer)
929 (when (not same-prefix-p)
930 ;; Save results if it is interesting and beneficial
931 (oset obj last-prefix prefix)
932 (oset obj last-all-completions answer))
933 ;; Now calculate the completion.
934 (setq completion (try-completion
936 (semanticdb-strip-find-results answer)))
937 (oset obj last-whitespace-completion nil)
938 (oset obj current-exact-match nil)
939 ;; Only do this if a completion was found. Letting a nil in
940 ;; could cause a full semanticdb search by accident.
942 (oset obj last-completion
944 ;; Unique match in AC. Last completion is a match.
945 ;; Also set the current-exact-match.
947 (oset obj current-exact-match answer)
949 ;; It may be complete (a symbol) but still not unique.
950 ;; We can capture a match
951 ((setq complete-not-uniq
952 (semanticdb-find-tags-by-name
955 (oset obj current-exact-match
959 ;; Non unique match, return the string that handles
961 (t (or completion prefix))
965 (defmethod semantic-collector-try-completion-whitespace
966 ((obj semantic-collector-abstract) prefix)
967 "For OBJ, do whatepsace completion based on PREFIX.
968 This implies that if there are two completions, one matching
969 the test \"preifx\\>\", and one not, the one matching the full
970 word version of PREFIX will be chosen, and that text returned.
971 This function requires that `semantic-collector-calculate-completions'
973 (let* ((ac (semantic-collector-all-completions obj prefix))
974 (matchme (concat "^" prefix "\\>"))
975 (compare (semanticdb-find-tags-by-name-regexp matchme ac))
976 (numtag (semanticdb-find-result-length compare))
980 (cutlen (1+ (length prefix)))
981 (twws (semanticdb-find-result-nth compare idx)))
982 ;; Is our tag with whitespace a match that has whitespace
983 ;; after it, or just an already complete symbol?
984 (while (and (< idx numtag)
985 (< (length (semantic-tag-name (car twws))) cutlen))
987 twws (semanticdb-find-result-nth compare idx)))
988 (when (and twws (car-safe twws))
989 ;; If COMPARE has succeeded, then we should take the very
990 ;; first match, and extend prefix by one character.
991 (oset obj last-whitespace-completion
992 (substring (semantic-tag-name (car twws))
997 (defmethod semantic-collector-current-exact-match ((obj semantic-collector-abstract))
998 "Return the active valid MATCH from the semantic collector.
999 For now, just return the first element from our list of available
1000 matches. For semanticdb based results, make sure the file is loaded
1002 (when (slot-boundp obj 'current-exact-match)
1003 (oref obj current-exact-match)))
1005 (defmethod semantic-collector-current-whitespace-completion ((obj semantic-collector-abstract))
1006 "Return the active whitespace completion value."
1007 (when (slot-boundp obj 'last-whitespace-completion)
1008 (oref obj last-whitespace-completion)))
1010 (defmethod semantic-collector-get-match ((obj semantic-collector-abstract))
1011 "Return the active valid MATCH from the semantic collector.
1012 For now, just return the first element from our list of available
1013 matches. For semanticdb based results, make sure the file is loaded
1015 (when (slot-boundp obj 'current-exact-match)
1016 (semanticdb-find-result-nth-in-buffer (oref obj current-exact-match) 0)))
1018 (defmethod semantic-collector-all-completions
1019 ((obj semantic-collector-abstract) prefix)
1020 "For OBJ, retrieve all completions matching PREFIX.
1021 The returned list consists of all the tags currently
1023 (when (slot-boundp obj 'last-all-completions)
1024 (oref obj last-all-completions)))
1026 (defmethod semantic-collector-try-completion
1027 ((obj semantic-collector-abstract) prefix)
1028 "For OBJ, attempt to match PREFIX.
1029 See `try-completion' for details on how this works.
1030 Return nil for no match.
1031 Return a string for a partial match.
1032 For a unique match of PREFIX, return the list of all tags
1034 (if (slot-boundp obj 'last-completion)
1035 (oref obj last-completion)))
1037 (defmethod semantic-collector-calculate-cache
1038 ((obj semantic-collector-abstract))
1039 "Calculate the completion cache for OBJ."
1043 (defmethod semantic-collector-flush ((this semantic-collector-abstract))
1044 "Flush THIS collector object, clearing any caches and prefix."
1045 (oset this cache nil)
1046 (slot-makeunbound this 'last-prefix)
1047 (slot-makeunbound this 'last-completion)
1048 (slot-makeunbound this 'last-all-completions)
1049 (slot-makeunbound this 'current-exact-match)
1054 (defclass semantic-collector-buffer-abstract (semantic-collector-abstract)
1056 "Root class for per-buffer completion engines.
1057 These collectors track themselves on a per-buffer basis."
1060 (defmethod constructor :STATIC ((this semantic-collector-buffer-abstract)
1061 newname &rest fields)
1062 "Reuse previously created objects of this type in buffer."
1064 (bl semantic-collector-per-buffer-list))
1065 (while (and bl (null old))
1066 (if (eq (object-class (car bl)) this)
1067 (setq old (car bl))))
1069 (let ((new (call-next-method)))
1070 (add-to-list 'semantic-collector-per-buffer-list new)
1072 (slot-makeunbound old 'last-completion)
1073 (slot-makeunbound old 'last-prefix)
1074 (slot-makeunbound old 'current-exact-match)
1077 ;; Buffer specific collectors should flush themselves
1078 (defun semantic-collector-buffer-flush (newcache)
1079 "Flush all buffer collector objects.
1080 NEWCACHE is the new tag table, but we ignore it."
1082 (let ((l semantic-collector-per-buffer-list))
1084 (if (car l) (semantic-collector-flush (car l)))
1088 (add-hook 'semantic-after-toplevel-cache-change-hook
1089 'semantic-collector-buffer-flush)
1091 ;;; DEEP BUFFER SPECIFIC COMPLETION
1093 (defclass semantic-collector-buffer-deep
1094 (semantic-collector-buffer-abstract)
1096 "Completion engine for tags in the current buffer.
1097 When searching for a tag, uses semantic deep searche functions.
1098 Basics search only in the current buffer.")
1100 (defmethod semantic-collector-calculate-cache
1101 ((obj semantic-collector-buffer-deep))
1102 "Calculate the completion cache for OBJ.
1103 Uses `semantic-flatten-tags-table'"
1105 ;; Must create it in SEMANTICDB find format.
1106 ;; ( ( DBTABLE TAG TAG ... ) ... )
1108 (cons semanticdb-current-table
1109 (semantic-flatten-tags-table (oref obj buffer))))))
1111 ;;; PROJECT SPECIFIC COMPLETION
1113 (defclass semantic-collector-project-abstract (semantic-collector-abstract)
1114 ((path :initarg :path
1116 :documentation "List of database tables to search.
1117 At creation time, it can be anything accepted by
1118 `semanticdb-find-translate-path' as a PATH argument.")
1120 "Root class for project wide completion engines.
1121 Uses semanticdb for searching all tags in the current project."
1125 (defclass semantic-collector-project (semantic-collector-project-abstract)
1127 "Completion engine for tags in a project.")
1130 (defmethod semantic-collector-calculate-completions-raw
1131 ((obj semantic-collector-project) prefix completionlist)
1132 "Calculate the completions for prefix from completionlist."
1133 (semanticdb-find-tags-for-completion prefix (oref obj path)))
1135 ;;; Brutish Project search
1136 (defclass semantic-collector-project-brutish (semantic-collector-project-abstract)
1138 "Completion engine for tags in a project.")
1140 (defmethod semantic-collector-calculate-completions-raw
1141 ((obj semantic-collector-project-brutish) prefix completionlist)
1142 "Calculate the completions for prefix from completionlist."
1143 (semanticdb-brute-deep-find-tags-for-completion prefix (oref obj path)))
1145 (defclass semantic-collector-analyze-completions (semantic-collector-abstract)
1146 ((context :initarg :context
1147 :type semantic-analyze-context
1148 :documentation "An analysis context.
1149 Specifies some context location from whence completion lists will be drawn."
1151 (first-pass-completions :type list
1152 :documentation "List of valid completion tags.
1153 This list of tags is generated when completion starts. All searches
1154 derive from this list.")
1156 "Completion engine that uses the context analyzer to provide options.
1157 The only options available for completion are those which can be logically
1158 inserted into the current context.")
1160 (defmethod semantic-collector-calculate-completions-raw
1161 ((obj semantic-collector-analyze-completions) prefix completionlist)
1162 "calculate the completions for prefix from completionlist."
1163 ;; if there are no completions yet, calculate them.
1164 (if (not (slot-boundp obj 'first-pass-completions))
1165 (oset obj first-pass-completions
1166 (semantic-analyze-possible-completions (oref obj context))))
1167 ;; search our cached completion list. make it look like a semanticdb
1169 (list (cons (save-excursion
1170 (set-buffer (oref (oref obj context) buffer))
1171 semanticdb-current-table)
1172 (semantic-find-tags-for-completion
1174 (oref obj first-pass-completions)))))
1177 ;;; ------------------------------------------------------------
1178 ;;; Tag List Display Engines
1180 ;; A typical displayor accepts a pre-determined list of completions
1181 ;; generated by a collector. This format is in semanticdb search
1182 ;; form. This vaguely standard form is a bit challenging to navigate
1183 ;; because the tags do not contain buffer info, but the file assocated
1184 ;; with the tags preceed the tag in the list.
1186 ;; Basic displayors don't care, and can strip the results.
1187 ;; Advanced highlighting displayors need to know when they need
1188 ;; to load a file so that the tag in question can be highlighted.
1190 ;; Key interface methods to a displayor are:
1191 ;; * semantic-displayor-next-action
1192 ;; * semantic-displayor-set-completions
1193 ;; * semantic-displayor-current-focus
1194 ;; * semantic-displayor-show-request
1195 ;; * semantic-displayor-scroll-request
1196 ;; * semantic-displayor-focus-request
1198 (defclass semantic-displayor-abstract ()
1199 ((table :type (or null semanticdb-find-result-with-nil)
1201 :protection :protected
1202 :documentation "List of tags this displayor is showing.")
1203 (last-prefix :type string
1204 :protection :protected
1205 :documentation "Prefix associated with slot `table'")
1207 "Manages the display of some number of tags.
1208 Provides the basics for a displayor, including interacting with
1209 a collector, and tracking tables of completion to display."
1212 (defmethod semantic-displayor-next-action ((obj semantic-displayor-abstract))
1213 "The next action to take on the minibuffer related to display."
1214 (if (and (slot-boundp obj 'last-prefix)
1215 (string= (oref obj last-prefix) (semantic-completion-text))
1216 (eq last-command this-command))
1220 (defmethod semantic-displayor-set-completions ((obj semantic-displayor-abstract)
1222 "Set the list of tags to be completed over to TABLE."
1223 (oset obj table table)
1224 (oset obj last-prefix prefix))
1226 (defmethod semantic-displayor-show-request ((obj semantic-displayor-abstract))
1227 "A request to show the current tags table."
1230 (defmethod semantic-displayor-focus-request ((obj semantic-displayor-abstract))
1231 "A request to for the displayor to focus on some tag option."
1234 (defmethod semantic-displayor-scroll-request ((obj semantic-displayor-abstract))
1235 "A request to for the displayor to scroll the completion list (if needed)."
1236 (scroll-other-window))
1238 (defmethod semantic-displayor-current-focus ((obj semantic-displayor-abstract))
1239 "Return a single tag currently in focus.
1240 This object type doesn't do focus, so will never have a focus object."
1243 ;; Traditional displayor
1244 (defcustom semantic-completion-displayor-format-tag-function
1245 #'semantic-format-tag-name
1246 "*A Tag format function to use when showing completions."
1248 :type semantic-format-tag-custom-list)
1250 (defclass semantic-displayor-traditional (semantic-displayor-abstract)
1252 "Traditional display mechanism for a list of possible completions.
1253 Completions are showin in a new buffer and listed with the ability
1254 to click on the items to aid in completion.")
1256 (defmethod semantic-displayor-show-request ((obj semantic-displayor-abstract))
1257 "A request to show the current tags table."
1259 ;; NOTE TO SELF. Find the character to type next, and emphesize it.
1261 (with-output-to-temp-buffer "*Completions*"
1262 (display-completion-list
1263 (mapcar semantic-completion-displayor-format-tag-function
1264 (semanticdb-strip-find-results (oref obj table))))
1268 ;;; Abstract baseclass for any displayor which supports focus
1269 (defclass semantic-displayor-focus-abstract (semantic-displayor-abstract)
1270 ((focus :type number
1271 :protection :protected
1272 :documentation "A tag index from `table' which has focus.
1273 Multiple calls to the display function can choose to focus on a
1274 given tag, by highlighting its location.")
1279 "Non-nil if focusing requires a tag's buffer be in memory.")
1281 "A displayor which has the ability to focus in on one tag.
1282 Focusing is a way of differentiationg between multiple tags
1283 which have the same name."
1286 (defmethod semantic-displayor-next-action ((obj semantic-displayor-focus-abstract))
1287 "The next action to take on the minibuffer related to display."
1288 (if (and (slot-boundp obj 'last-prefix)
1289 (string= (oref obj last-prefix) (semantic-completion-text))
1290 (eq last-command this-command))
1292 (slot-boundp obj 'focus)
1293 (slot-boundp obj 'table)
1294 (<= (semanticdb-find-result-length (oref obj table))
1295 (1+ (oref obj focus))))
1296 ;; We are at the end of the focus road.
1298 ;; Focus on some item.
1302 (defmethod semantic-displayor-set-completions ((obj semantic-displayor-focus-abstract)
1304 "Set the list of tags to be completed over to TABLE."
1306 (slot-makeunbound obj 'focus))
1308 (defmethod semantic-displayor-focus-next-tag ((obj semantic-displayor-focus-abstract))
1309 "Return the next tag OBJ should focus on."
1310 (when (and (slot-boundp obj 'table) (oref obj table))
1311 (with-slots (table) obj
1312 (if (not (slot-boundp obj 'focus))
1314 (oset obj focus (1+ (oref obj focus)))
1316 (if (<= (semanticdb-find-result-length table) (oref obj focus))
1318 (semanticdb-find-result-nth table (oref obj focus)))))
1320 (defmethod semantic-displayor-current-focus ((obj semantic-displayor-focus-abstract))
1321 "Return the tag currently in focus, or call parent method."
1322 (if (and (slot-boundp obj 'focus)
1323 (slot-boundp obj 'table)
1324 ;; Only return the current focus IFF the minibuffer reflects
1325 ;; the list this focus was derived from.
1326 (slot-boundp obj 'last-prefix)
1327 (string= (semantic-completion-text) (oref obj last-prefix))
1330 (if (oref obj find-file-focus)
1331 (semanticdb-find-result-nth-in-buffer (oref obj table) (oref obj focus))
1332 (semanticdb-find-result-nth (oref obj table) (oref obj focus)))
1334 (call-next-method)))
1336 ;;; Simple displayor which performs traditional display completion,
1337 ;; and also focuses with highlighting.
1338 (defclass semantic-displayor-traditional-with-focus-highlight
1339 (semantic-displayor-traditional semantic-displayor-focus-abstract)
1340 ((find-file-focus :initform t))
1341 "A traditional displayor which can focus on a tag by showing it.
1342 Same as `semantic-displayor-traditional', but with selection between
1343 multiple tags with the same name done by 'focusing' on the source
1344 location of the different tags to differentiate them.")
1346 (defmethod semantic-displayor-focus-request
1347 ((obj semantic-displayor-traditional-with-focus-highlight))
1348 "Focus in on possible tag completions.
1349 Focus is performed by cycling through the tags and highlighting
1350 one in the source buffer."
1351 (let* ((tablelength (semanticdb-find-result-length (oref obj table)))
1352 (focus (semantic-displayor-focus-next-tag obj))
1356 (let ((buf (or (semantic-tag-buffer tag)
1357 (and table (semanticdb-get-buffer table)))))
1358 ;; If no buffer is provided, then we can make up a summary buffer.
1361 (set-buffer (get-buffer-create "*Completion Focus*"))
1363 (insert "Focus on tag: \n")
1364 (insert (semantic-format-tag-summarize tag nil t) "\n\n")
1366 (insert "From table: \n")
1367 (insert (object-name table) "\n\n"))
1369 (insert "In buffer: \n\n")
1370 (insert (format "%S" buf)))
1371 (setq buf (current-buffer))))
1372 ;; Show the tag in the buffer.
1373 (if (get-buffer-window buf)
1374 (select-window (get-buffer-window buf))
1375 (switch-to-buffer-other-window buf t)
1376 (select-window (get-buffer-window buf)))
1377 ;; Now do some positioning
1379 (if (semantic-tag-with-position-p tag)
1380 ;; Full tag positional information available
1382 (goto-char (semantic-tag-start tag))
1383 ;; This avoids a dangerous problem if we just loaded a tag
1384 ;; from a file, but the original position was not updated
1385 ;; in the TAG variable we are currently using.
1386 (semantic-momentary-highlight-tag (semantic-current-tag))
1388 (select-window (minibuffer-window)))
1389 ;; Calculate text difference between contents and the focus item.
1390 (let* ((mbc (semantic-completion-text))
1391 (ftn (semantic-tag-name tag))
1392 (diff (substring ftn (length mbc))))
1393 (semantic-completion-message
1394 (format "%s [%d of %d matches]" diff (1+ (oref obj focus)) tablelength)))
1397 ;;; Tooltip completion lister
1399 ;; Written and contributed by Masatake YAMATO <jet@gyve.org>
1401 ;; Modified by Eric Ludlam for
1402 ;; * Safe compatibility for tooltip free systems.
1403 ;; * Don't use 'avoid package for tooltip positioning.
1405 (defclass semantic-displayor-tooltip (semantic-displayor-traditional)
1406 ((max-tags :type integer
1411 "Max number of tags displayed on tooltip at once.
1412 If `force-show' is 1, this value is ignored with typing tab or space twice continuously.
1413 if `force-show' is 0, this value is always ignored.")
1414 (force-show :type integer
1415 :initarg :force-show
1417 :custom (choice (const
1418 :tag "Show when double typing"
1424 :tag "Show if the number of tags is less than `max-tags'."
1427 "Control the behavior of the number of tags is greater than `max-tags'.
1428 -1 means tags are never shown.
1429 0 means the tags are always shown.
1430 1 means tags are shown if space or tab is typed twice continuously.")
1431 (typing-count :type integer
1434 "Counter holding how many times the user types space or tab continuously before showing tags.")
1435 (shown :type boolean
1438 "Flag representing whether tags is shown once or not.")
1440 "Display mechanism using tooltip for a list of possible completions.")
1442 (defmethod initialize-instance :AFTER ((obj semantic-displayor-tooltip) &rest args)
1443 "Make sure we have tooltips required."
1449 (defmethod semantic-displayor-show-request ((obj semantic-displayor-tooltip))
1450 "A request to show the current tags table."
1451 (if (or (not (featurep 'tooltip)) (not tooltip-mode))
1452 ;; If we cannot use tooltips, then go to the normal mode with
1453 ;; a traditional completion buffer.
1455 (let* ((tablelong (semanticdb-strip-find-results (oref obj table)))
1456 (table (semantic-unique-tag-table-by-name tablelong))
1457 (l (mapcar semantic-completion-displayor-format-tag-function table))
1459 (typing-count (oref obj typing-count))
1460 (force-show (oref obj force-show))
1461 (matchtxt (semantic-completion-text))
1463 (if (or (oref obj shown)
1464 (< ll (oref obj max-tags))
1465 (and (<= 0 force-show)
1466 (< (1- force-show) typing-count)))
1468 (oset obj typing-count 0)
1471 ;; We Have only one possible match. There could be two cases.
1472 ;; 1) input text != single match.
1474 ;; 2) input text == single match.
1475 ;; --> Complain about it, but still show the match.
1476 (if (string= matchtxt (semantic-tag-name (car table)))
1477 (setq msg (concat "[COMPLETE]\n" (car l)))
1479 ;; Create the long message.
1480 (setq msg (mapconcat 'identity l "\n"))
1481 ;; If there is nothing, say so!
1482 (if (eq 0 (length msg))
1483 (setq msg "[NO MATCH]")))
1484 (semantic-displayor-tooltip-show msg))
1485 ;; The typing count determines if the user REALLY REALLY
1486 ;; wanted to show that much stuff. Only increment
1487 ;; if the current command is a completion command.
1488 (if (and (stringp (this-command-keys))
1489 (string= (this-command-keys) "\C-i"))
1490 (oset obj typing-count (1+ typing-count)))
1491 ;; At this point, we know we have too many items.
1492 ;; Lets be brave, and truncate l
1493 (setcdr (nthcdr (oref obj max-tags) l) nil)
1494 (setq msg (mapconcat 'identity l "\n"))
1497 (semantic-displayor-tooltip-show (concat msg "\n...")))
1499 (semantic-displayor-tooltip-show (concat msg "\n(TAB for more)")))
1505 (if (fboundp 'window-inside-edges)
1507 (defalias 'semantic-displayor-window-edges
1508 'window-inside-edges)
1510 (defalias 'semantic-displayor-window-edges
1514 (defun semantic-displayor-point-position ()
1515 "Return the location of POINT as positioned on the selected frame.
1516 Return a cons cell (X . Y)"
1517 (let* ((w (selected-window))
1518 (f (selected-frame))
1519 (edges (semantic-displayor-window-edges w))
1520 (col (current-column))
1521 (row (count-lines (window-start w) (point)))
1522 (x (+ (car edges) col))
1523 (y (+ (car (cdr edges)) row)))
1527 (defun semantic-displayor-tooltip-show (text)
1528 "Display a tooltip with TEXT near cursor."
1529 (let* ((P (semantic-displayor-point-position))
1530 (frame (selected-frame))
1533 (oP (mouse-pixel-position))
1534 (tooltip-x-offset 0)
1535 (tooltip-y-offset -40)
1537 (set-mouse-position frame x y)
1539 (set-mouse-pixel-position (nth 0 oP) (nth 1 oP) (nthcdr 2 oP))
1542 (defmethod semantic-displayor-scroll-request ((obj semantic-displayor-tooltip))
1543 "A request to for the displayor to scroll the completion list (if needed)."
1544 ;; Do scrolling in the tooltip.
1545 (oset obj max-tags 30)
1546 (semantic-displayor-show-request obj)
1549 ;; End code contributed by Masatake YAMATO <jet@gyve.org>
1552 ;;; ------------------------------------------------------------
1553 ;;; Specific queries
1556 (defun semantic-complete-read-tag-buffer-deep (prompt &optional
1560 "Ask for a tag by name from the current buffer.
1561 Available tags are from the current buffer, at any level.
1562 Completion options are presented in a traditional way, with highlighting
1563 to resolve same-name collisions.
1564 PROMPT is a string to prompt with.
1565 DEFAULT-TAG is a semantic tag or string to use as the default value.
1566 If INITIAL-INPUT is non-nil, insert it in the minibuffer initially.
1567 HISTORY is a symbol representing a variable to store the history in."
1568 (semantic-complete-read-tag-engine
1569 (semantic-collector-buffer-deep prompt :buffer (current-buffer))
1570 (semantic-displayor-traditional-with-focus-highlight "simple")
1571 ;;(semantic-displayor-tooltip "simple")
1579 (defun semantic-complete-read-tag-project (prompt &optional
1583 "Ask for a tag by name from the current project.
1584 Available tags are from the current project, at the top level.
1585 Completion options are presented in a traditional way, with highlighting
1586 to resolve same-name collisions.
1587 PROMPT is a string to prompt with.
1588 DEFAULT-TAG is a semantic tag or string to use as the default value.
1589 If INITIAL-INPUT is non-nil, insert it in the minibuffer initially.
1590 HISTORY is a symbol representing a variable to store the history in."
1591 (semantic-complete-read-tag-engine
1592 (semantic-collector-project-brutish prompt
1593 :buffer (current-buffer)
1594 :path (current-buffer)
1596 (semantic-displayor-traditional-with-focus-highlight "simple")
1604 (defun semantic-complete-read-tag-analyzer (prompt &optional
1607 "Ask for a tag by name based on the current context.
1608 The function `semantic-analyze-current-context' is used to
1609 calculate the context. `semantic-analyze-possible-completions' is used
1610 to generate the list of possible completions.
1611 PROMPT is the first part of the prompt. Additional prompt
1612 is added based on the contexts full prefix.
1613 CONTEXT is the semantic analyzer context to start with.
1614 HISTORY is a symbol representing a variable to stor the history in.
1615 usually a default-tag and initial-input are available for completion
1616 prompts. these are calculated from the CONTEXT variable passed in."
1617 (if (not context) (setq context (semantic-analyze-current-context (point))))
1618 (let* ((syms (semantic-ctxt-current-symbol (point)))
1619 (inp (car (reverse syms))))
1620 (setq syms (nreverse (cdr (nreverse syms))))
1621 (semantic-complete-read-tag-engine
1622 (semantic-collector-analyze-completions
1624 :buffer (oref context buffer)
1626 (semantic-displayor-traditional-with-focus-highlight "simple")
1628 (set-buffer (oref context buffer))
1629 (goto-char (cdr (oref context bounds)))
1630 (concat prompt (mapconcat 'identity syms ".")
1638 (defcustom semantic-complete-inline-analyzer-displayor-class
1639 'semantic-displayor-tooltip
1640 "*Class for displayor to use with inline completion.
1642 'semantic-displayor-tooltip - show options in a tooltip.
1643 'semantic-displayor-traditional - In a buffer."
1645 :type '(radio (const :tag "Tooltip" semantic-displayor-tooltip)
1646 (const :tag "Traditional" semantic-displayor-traditional)
1647 (const :tag "Traditional with Focus"
1648 semantic-displayor-traditional-with-focus-highlight))
1652 (defun semantic-complete-inline-analyzer (context)
1653 "Complete a symbol name by name based on the current context.
1654 This is similar to `semantic-complete-read-tag-analyze', except
1655 that the completion interaction is in the buffer where the context
1656 was calculated from.
1657 CONTEXT is the semantic analyzer context to start with.
1658 See `semantic-complete-inline-tag-engine' for details on how
1660 (if (not context) (setq context (semantic-analyze-current-context (point))))
1661 (let* ((collector (semantic-collector-analyze-completions
1663 :buffer (oref context buffer)
1665 (syms (semantic-ctxt-current-symbol (point)))
1666 (rsym (reverse syms))
1667 (thissym (car rsym))
1668 (nextsym (car-safe (cdr rsym)))
1670 (when (and thissym (or (not (string= thissym ""))
1672 ;; Do a quick calcuation of completions.
1673 (semantic-collector-calculate-completions
1674 collector thissym nil)
1675 ;; Get the master list
1676 (setq complst (semanticdb-strip-find-results
1677 (semantic-collector-all-completions collector thissym)))
1679 (setq complst (semantic-unique-tag-table-by-name complst))
1680 (if (or (and (= (length complst) 1)
1681 ;; Check to see if it is the same as what is there.
1682 ;; if so, we can offer to complete.
1683 (let ((compname (semantic-tag-name (car complst))))
1684 (not (string= compname thissym))))
1685 (> (length complst) 1))
1686 ;; There are several options. Do the completion.
1687 (semantic-complete-inline-tag-engine
1689 (funcall semantic-complete-inline-analyzer-displayor-class
1691 ;;(semantic-displayor-tooltip "simple")
1692 (oref context buffer)
1693 (car (oref context bounds))
1694 (cdr (oref context bounds))
1699 ;;; ------------------------------------------------------------
1702 (defun semantic-complete-test ()
1703 "Test completion mechanisms."
1706 (semantic-format-tag-prototype
1707 (semantic-complete-read-tag-project "Symbol: ")
1711 (defun semantic-complete-jump-local ()
1712 "Jump to a semantic symbol."
1714 (let ((tag (semantic-complete-read-tag-buffer-deep "Symbol: ")))
1715 (when (semantic-tag-p tag)
1717 (goto-char (semantic-tag-start tag))
1718 (semantic-momentary-highlight-tag tag)
1719 (working-message "%S: %s "
1720 (semantic-tag-class tag)
1721 (semantic-tag-name tag)))))
1724 (defun semantic-complete-jump ()
1725 "Jump to a semantic symbol."
1727 (let* ((semanticdb-search-system-databases nil)
1728 (tag (semantic-complete-read-tag-project "Symbol: ")))
1729 (when (semantic-tag-p tag)
1731 (semantic-go-to-tag tag)
1732 (switch-to-buffer (current-buffer))
1733 (semantic-momentary-highlight-tag tag)
1734 (working-message "%S: %s "
1735 (semantic-tag-class tag)
1736 (semantic-tag-name tag)))))
1739 (defun semantic-complete-analyze-and-replace ()
1740 "Perform prompt completion to do in buffer completion.
1741 `semantic-analyze-possible-completions' is used to determine the
1743 The minibuffer is used to perform the completion.
1744 The result is inserted as a replacement of the text that was there."
1746 (let* ((c (semantic-analyze-current-context (point)))
1747 (tag (save-excursion (semantic-complete-read-tag-analyzer "" c))))
1748 ;; Take tag, and replace context bound with its name.
1749 (goto-char (car (oref c bounds)))
1750 (delete-region (point) (cdr (oref c bounds)))
1751 (insert (semantic-tag-name tag))
1752 (message "%S" (semantic-format-tag-summarize tag))))
1755 (defun semantic-complete-analyze-inline ()
1756 "Perform prompt completion to do in buffer completion.
1757 `semantic-analyze-possible-completions' is used to determine the
1759 The function returns immediately, leaving the buffer in a mode that
1760 will perform the completion."
1762 ;; Only do this if we are not already completing something.
1763 (if (not (semantic-completion-inline-active-p))
1764 (semantic-complete-inline-analyzer
1765 (semantic-analyze-current-context (point))))
1766 ;; Report a message if things didn't startup.
1767 (if (and (interactive-p)
1768 (not (semantic-completion-inline-active-p)))
1769 (message "Inline completion not needed."))
1773 (defun semantic-complete-self-insert (arg)
1774 "Like `self-insert-command', but does completion afterwards.
1775 ARG is passed to `self-insert-command'. If ARG is nil,
1776 use `semantic-complete-analyze-inline' to complete."
1778 (self-insert-command arg)
1779 (when (and (= arg 1)
1780 (semantic-analyze-current-context))
1781 (semantic-complete-analyze-inline)
1785 (provide 'semantic-complete)
1787 ;;; semantic-complete.el ends here