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