]> code.delx.au - gnu-emacs/blob - lisp/cedet/semantic/analyze.el
43b9c45132f246cca2a1e97eba1be3c8295a99af
[gnu-emacs] / lisp / cedet / semantic / analyze.el
1 ;;; semantic/analyze.el --- Analyze semantic tags against local context
2
3 ;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2007, 2008, 2009
4 ;; Free Software Foundation, Inc.
5
6 ;; Author: Eric M. Ludlam <zappo@gnu.org>
7
8 ;; This file is part of GNU Emacs.
9
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
14
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
22
23 ;;; Commentary:
24 ;;
25 ;; Semantic, as a tool, provides a nice list of searchable tags.
26 ;; That information can provide some very accurate answers if the current
27 ;; context of a position is known.
28 ;;
29 ;; Semantic-ctxt provides ways of analyzing, and manipulating the
30 ;; semantic context of a language in code.
31 ;;
32 ;; This library provides routines for finding intelligent answers to
33 ;; tough problems, such as if an argument to a function has the correct
34 ;; return type, or all possible tags that fit in a given local context.
35 ;;
36
37 ;;; Vocabulary:
38 ;;
39 ;; Here are some words used to describe different things in the analyzer:
40 ;;
41 ;; tag - A single entity
42 ;; prefix - The beginning of a symbol, usually used to look up something
43 ;; incomplete.
44 ;; type - The name of a datatype in the langauge.
45 ;; metatype - If a type is named in a declaration like:
46 ;; struct moose somevariable;
47 ;; that name "moose" can be turned into a concrete type.
48 ;; tag sequence - In C code, a list of dereferences, such as:
49 ;; this.that.theother();
50 ;; parent - For a datatype in an OO language, another datatype
51 ;; inherited from. This excludes interfaces.
52 ;; scope - A list of tags that can be dereferenced that cannot
53 ;; be found from the global namespace.
54 ;; scopetypes - A list of tags which are datatype that contain
55 ;; the scope. The scopetypes need to have the scope extracted
56 ;; in a way that honors the type of inheritance.
57 ;; nest/nested - When one tag is contained entirely in another.
58 ;;
59 ;; context - A semantic datatype representing a point in a buffer.
60 ;;
61 ;; constriant - If a context specifies a specific datatype is needed,
62 ;; that is a constraint.
63 ;; constants - Some datatypes define elements of themselves as a
64 ;; constant. These need to be returned as there would be no
65 ;; other possible completions.
66
67 (eval-when-compile (require 'cl))
68 (require 'semantic)
69 (require 'semantic/format)
70 (require 'semantic/ctxt)
71 (require 'semantic/scope)
72 (require 'semantic/sort)
73 (require 'semantic/analyze/fcn)
74
75 (eval-when-compile (require 'semantic/find))
76
77 (declare-function data-debug-new-buffer "data-debug")
78 (declare-function data-debug-insert-object-slots "eieio-datadebug")
79
80 ;;; Code:
81 (defvar semantic-analyze-error-stack nil
82 "Collection of any errors thrown during analysis.")
83
84 (defun semantic-analyze-push-error (err)
85 "Push the error in ERR-DATA onto the error stack.
86 Argument ERR"
87 (push err semantic-analyze-error-stack))
88
89 ;;; Analysis Classes
90 ;;
91 ;; These classes represent what a context is. Different types
92 ;; of contexts provide differing amounts of information to help
93 ;; provide completions.
94 ;;
95 (defclass semantic-analyze-context ()
96 ((bounds :initarg :bounds
97 :type list
98 :documentation "The bounds of this context.
99 Usually bound to the dimension of a single symbol or command.")
100 (prefix :initarg :prefix
101 :type list
102 :documentation "List of tags defining local text.
103 This can be nil, or a list where the last element can be a string
104 representing text that may be incomplete. Preceeding elements
105 must be semantic tags representing variables or functions
106 called in a dereference sequence.")
107 (prefixclass :initarg :prefixclass
108 :type list
109 :documentation "Tag classes expected at this context.
110 These are clases for tags, such as 'function, or 'variable.")
111 (prefixtypes :initarg :prefixtypes
112 :type list
113 :documentation "List of tags defining types for :prefix.
114 This list is one shorter than :prefix. Each element is a semantic
115 tag representing a type matching the semantic tag in the same
116 position in PREFIX.")
117 (scope :initarg :scope
118 :type (or null semantic-scope-cache)
119 :documentation "List of tags available in scopetype.
120 See `semantic-analyze-scoped-tags' for details.")
121 (buffer :initarg :buffer
122 :type buffer
123 :documentation "The buffer this context is derived from.")
124 (errors :initarg :errors
125 :documentation "Any errors thrown an caught during analysis.")
126 )
127 "Base analysis data for a any context.")
128
129 (defclass semantic-analyze-context-assignment (semantic-analyze-context)
130 ((assignee :initarg :assignee
131 :type list
132 :documentation "A sequence of tags for an assignee.
133 This is a variable into which some value is being placed. The last
134 item in the list is the variable accepting the value. Earlier
135 tags represent the variables being derefernece to get to the
136 assignee."))
137 "Analysis class for a value in an assignment.")
138
139 (defclass semantic-analyze-context-functionarg (semantic-analyze-context)
140 ((function :initarg :function
141 :type list
142 :documentation "A sequence of tags for a function.
143 This is a function being called. The cursor will be in the position
144 of an argument.
145 The last tag in :function is the function being called. Earlier
146 tags represent the variables being dereferenced to get to the
147 function.")
148 (index :initarg :index
149 :type integer
150 :documentation "The index of the argument for this context.
151 If a function takes 4 arguments, this value should be bound to
152 the values 1 through 4.")
153 (argument :initarg :argument
154 :type list
155 :documentation "A sequence of tags for the :index argument.
156 The argument can accept a value of some type, and this contains the
157 tag for that definition. It should be a tag, but might
158 be just a string in some circumstances.")
159 )
160 "Analysis class for a value as a function argument.")
161
162 (defclass semantic-analyze-context-return (semantic-analyze-context)
163 () ; No extra data.
164 "Analysis class for return data.
165 Return data methods identify the requred type by the return value
166 of the parent function.")
167
168 ;;; METHODS
169 ;;
170 ;; Simple methods against the context classes.
171 ;;
172 (defmethod semantic-analyze-type-constraint
173 ((context semantic-analyze-context) &optional desired-type)
174 "Return a type constraint for completing :prefix in CONTEXT.
175 Optional argument DESIRED-TYPE may be a non-type tag to analyze."
176 (when (semantic-tag-p desired-type)
177 ;; Convert the desired type if needed.
178 (if (not (eq (semantic-tag-class desired-type) 'type))
179 (setq desired-type (semantic-tag-type desired-type)))
180 ;; Protect against plain strings
181 (cond ((stringp desired-type)
182 (setq desired-type (list desired-type 'type)))
183 ((and (stringp (car desired-type))
184 (not (semantic-tag-p desired-type)))
185 (setq desired-type (list (car desired-type) 'type)))
186 ((semantic-tag-p desired-type)
187 ;; We have a tag of some sort. Yay!
188 nil)
189 (t (setq desired-type nil))
190 )
191 desired-type))
192
193 (defmethod semantic-analyze-type-constraint
194 ((context semantic-analyze-context-functionarg))
195 "Return a type constraint for completing :prefix in CONTEXT."
196 (call-next-method context (car (oref context argument))))
197
198 (defmethod semantic-analyze-type-constraint
199 ((context semantic-analyze-context-assignment))
200 "Return a type constraint for completing :prefix in CONTEXT."
201 (call-next-method context (car (reverse (oref context assignee)))))
202
203 (defmethod semantic-analyze-interesting-tag
204 ((context semantic-analyze-context))
205 "Return a tag from CONTEXT that would be most interesting to a user."
206 (let ((prefix (reverse (oref context :prefix))))
207 ;; Go back through the prefix until we find a tag we can return.
208 (while (and prefix (not (semantic-tag-p (car prefix))))
209 (setq prefix (cdr prefix)))
210 ;; Return the found tag, or nil.
211 (car prefix)))
212
213 (defmethod semantic-analyze-interesting-tag
214 ((context semantic-analyze-context-functionarg))
215 "Try the base, and if that fails, return what we are assigning into."
216 (or (call-next-method) (car-safe (oref context :function))))
217
218 (defmethod semantic-analyze-interesting-tag
219 ((context semantic-analyze-context-assignment))
220 "Try the base, and if that fails, return what we are assigning into."
221 (or (call-next-method) (car-safe (oref context :assignee))))
222
223 ;;; ANALYSIS
224 ;;
225 ;; Start out with routines that will calculate useful parts of
226 ;; the general analyzer function. These could be used directly
227 ;; by an application that doesn't need to calculate the full
228 ;; context.
229
230 (define-overloadable-function semantic-analyze-find-tag-sequence (sequence &optional
231 scope typereturn throwsym)
232 "Attempt to find all tags in SEQUENCE.
233 Optional argument LOCALVAR is the list of local variables to use when
234 finding the details on the first element of SEQUENCE in case
235 it is not found in the global set of tables.
236 Optional argument SCOPE are additional terminals to search which are currently
237 scoped. These are not local variables, but symbols available in a structure
238 which doesn't need to be dereferneced.
239 Optional argument TYPERETURN is a symbol in which the types of all found
240 will be stored. If nil, that data is thrown away.
241 Optional argument THROWSYM specifies a symbol the throw on non-recoverable error.")
242
243 (defun semantic-analyze-find-tag-sequence-default (sequence &optional
244 scope typereturn
245 throwsym)
246 "Attempt to find all tags in SEQUENCE.
247 SCOPE are extra tags which are in scope.
248 TYPERETURN is a symbol in which to place a list of tag classes that
249 are found in SEQUENCE.
250 Optional argument THROWSYM specifies a symbol the throw on non-recoverable error."
251 (let ((s sequence) ; copy of the sequence
252 (tmp nil) ; tmp find variable
253 (tag nil) ; tag return list
254 (tagtype nil) ; tag types return list
255 (fname nil)
256 (miniscope (clone scope))
257 )
258 ;; First order check. Is this wholely contained in the typecache?
259 (setq tmp (semanticdb-typecache-find sequence))
260
261 (if tmp
262 (progn
263 ;; We are effectively done...
264 (setq s nil)
265 (setq tag (list tmp)))
266
267 ;; For the first entry, it better be a variable, but it might
268 ;; be in the local context too.
269 ;; NOTE: Don't forget c++ namespace foo::bar.
270 (setq tmp (or
271 ;; Is this tag within our scope. Scopes can sometimes
272 ;; shadow other things, so it goes first.
273 (and scope (semantic-scope-find (car s) nil scope))
274 ;; Find the tag out there... somewhere, but not in scope
275 (semantic-analyze-find-tag (car s))
276 ))
277
278 (if (and (listp tmp) (semantic-tag-p (car tmp)))
279 (setq tmp (semantic-analyze-select-best-tag tmp)))
280 (if (not (semantic-tag-p tmp))
281 (if throwsym
282 (throw throwsym "Cannot find definition")
283 (error "Cannot find definition for \"%s\"" (car s))))
284 (setq s (cdr s))
285 (setq tag (cons tmp tag)) ; tag is nil here...
286 (setq fname (semantic-tag-file-name tmp))
287 )
288
289 ;; For the middle entries
290 (while s
291 ;; Using the tag found in TMP, lets find the tag
292 ;; representing the full typeographic information of its
293 ;; type, and use that to determine the search context for
294 ;; (car s)
295 (let* ((tmptype
296 ;; In some cases the found TMP is a type,
297 ;; and we can use it directly.
298 (cond ((semantic-tag-of-class-p tmp 'type)
299 ;; update the miniscope when we need to analyze types directly.
300 (let ((rawscope
301 (apply 'append
302 (mapcar 'semantic-tag-type-members
303 tagtype))))
304 (oset miniscope fullscope rawscope))
305 ;; Now analayze the type to remove metatypes.
306 (or (semantic-analyze-type tmp miniscope)
307 tmp))
308 (t
309 (semantic-analyze-tag-type tmp scope))))
310 (typefile
311 (when tmptype
312 (semantic-tag-file-name tmptype)))
313 (slots nil))
314
315 ;; Get the children
316 (setq slots (semantic-analyze-scoped-type-parts tmptype scope))
317
318 ;; find (car s) in the list o slots
319 (setq tmp (semantic-find-tags-by-name (car s) slots))
320
321 ;; If we have lots
322 (if (and (listp tmp) (semantic-tag-p (car tmp)))
323 (setq tmp (semantic-analyze-select-best-tag tmp)))
324
325 ;; Make sure we have a tag.
326 (if (not (semantic-tag-p tmp))
327 (if (cdr s)
328 ;; In the middle, we need to keep seeking our types out.
329 (error "Cannot find definition for \"%s\"" (car s))
330 ;; Else, it's ok to end with a non-tag
331 (setq tmp (car s))))
332
333 (setq fname (or typefile fname))
334 (when (and fname (semantic-tag-p tmp)
335 (not (semantic-tag-in-buffer-p tmp)))
336 (semantic--tag-put-property tmp :filename fname))
337 (setq tag (cons tmp tag))
338 (setq tagtype (cons tmptype tagtype))
339 )
340 (setq s (cdr s)))
341
342 (if typereturn (set typereturn (nreverse tagtype)))
343 ;; Return the mess
344 (nreverse tag)))
345
346 (defun semantic-analyze-find-tag (name &optional tagclass scope)
347 "Return the first tag found with NAME or nil if not found.
348 Optional argument TAGCLASS specifies the class of tag to return, such
349 as 'function or 'variable.
350 Optional argument SCOPE specifies a scope object which has
351 additional tags which are in SCOPE and do not need prefixing to
352 find.
353
354 This is a wrapper on top of semanticdb, semanticdb-typecache,
355 semantic-scope, and semantic search functions. Almost all
356 searches use the same arguments."
357 (let ((namelst (if (consp name) name ;; test if pre-split.
358 (semantic-analyze-split-name name))))
359 (cond
360 ;; If the splitter gives us a list, use the sequence finder
361 ;; to get the list. Since this routine is expected to return
362 ;; only one tag, return the LAST tag found from the sequence
363 ;; which is supposedly the nested reference.
364 ;;
365 ;; Of note, the SEQUENCE function below calls this function
366 ;; (recursively now) so the names that we get from the above
367 ;; fcn better not, in turn, be splittable.
368 ((listp namelst)
369 ;; If we had a split, then this is likely a c++ style namespace::name sequence,
370 ;; so take a short-cut through the typecache.
371 (or (semanticdb-typecache-find namelst)
372 ;; Ok, not there, try the usual...
373 (let ((seq (semantic-analyze-find-tag-sequence
374 namelst scope nil)))
375 (semantic-analyze-select-best-tag seq tagclass)
376 )))
377 ;; If NAME is solo, then do our searches for it here.
378 ((stringp namelst)
379 (let ((retlist (and scope (semantic-scope-find name tagclass scope))))
380 (if retlist
381 (semantic-analyze-select-best-tag
382 retlist tagclass)
383 (if (eq tagclass 'type)
384 (semanticdb-typecache-find name)
385 ;; Search in the typecache. First entries in a sequence are
386 ;; often there.
387 (setq retlist (semanticdb-typecache-find name))
388 (if retlist
389 retlist
390 (semantic-analyze-select-best-tag
391 (semanticdb-strip-find-results
392 (semanticdb-find-tags-by-name name)
393 'name)
394 tagclass)
395 )))))
396 )))
397
398 ;;; SHORT ANALYSIS
399 ;;
400 ;; Create a mini-analysis of just the symbol under point.
401 ;;
402 (define-overloadable-function semantic-analyze-current-symbol
403 (analyzehookfcn &optional position)
404 "Call ANALYZEHOOKFCN after analyzing the symbol under POSITION.
405 The ANALYZEHOOKFCN is called with the current symbol bounds, and the
406 analyzed prefix. It should take the arguments (START END PREFIX).
407 The ANALYZEHOOKFCN is only called if some sort of prefix with bounds was
408 found under POSITION.
409
410 The results of ANALYZEHOOKFCN is returned, or nil if there was nothing to
411 call it with.
412
413 For regular analysis, you should call `semantic-analyze-current-context'
414 to calculate the context information. The purpose for this function is
415 to provide a large number of non-cached analysis for filtering symbols."
416 ;; Only do this in a Semantic enabled buffer.
417 (when (not (semantic-active-p))
418 (error "Cannot analyze buffers not supported by Semantic"))
419 ;; Always refresh out tags in a safe way before doing the
420 ;; context.
421 (semantic-refresh-tags-safe)
422 ;; Do the rest of the analysis.
423 (save-match-data
424 (save-excursion
425 (:override)))
426 )
427
428 (defun semantic-analyze-current-symbol-default (analyzehookfcn position)
429 "Call ANALYZEHOOKFCN on the analyzed symbol at POSITION."
430 (let* ((semantic-analyze-error-stack nil)
431 (LLstart (current-time))
432 (prefixandbounds (semantic-ctxt-current-symbol-and-bounds (or position (point))))
433 (prefix (car prefixandbounds))
434 (bounds (nth 2 prefixandbounds))
435 (scope (semantic-calculate-scope position))
436 (end nil)
437 )
438 ;; Only do work if we have bounds (meaning a prefix to complete)
439 (when bounds
440
441 (if debug-on-error
442 (catch 'unfindable
443 ;; If debug on error is on, allow debugging in this fcn.
444 (setq prefix (semantic-analyze-find-tag-sequence
445 prefix scope 'prefixtypes 'unfindable)))
446 ;; Debug on error is off. Capture errors and move on
447 (condition-case err
448 ;; NOTE: This line is duplicated in
449 ;; semantic-analyzer-debug-global-symbol
450 ;; You will need to update both places.
451 (setq prefix (semantic-analyze-find-tag-sequence
452 prefix scope 'prefixtypes))
453 (error (semantic-analyze-push-error err))))
454
455 (setq end (current-time))
456 ;;(message "Analysis took %.2f sec" (semantic-elapsed-time LLstart end))
457
458 )
459 (when prefix
460 (prog1
461 (funcall analyzehookfcn (car bounds) (cdr bounds) prefix)
462 ;;(setq end (current-time))
463 ;;(message "hookfcn took %.5f sec" (semantic-elapsed-time LLstart end))
464 )
465
466 )))
467
468 ;;; MAIN ANALYSIS
469 ;;
470 ;; Create a full-up context analysis.
471 ;;
472 ;;;###autoload
473 (define-overloadable-function semantic-analyze-current-context (&optional position)
474 "Analyze the current context at optional POSITION.
475 If called interactively, display interesting information about POSITION
476 in a separate buffer.
477 Returns an object based on symbol `semantic-analyze-context'.
478
479 This function can be overriden with the symbol `analyze-context'.
480 When overriding this function, your override will be called while
481 cursor is at POSITION. In addition, your function will not be called
482 if a cached copy of the return object is found."
483 (interactive "d")
484 ;; Only do this in a Semantic enabled buffer.
485 (when (not (semantic-active-p))
486 (error "Cannot analyze buffers not supported by Semantic"))
487 ;; Always refresh out tags in a safe way before doing the
488 ;; context.
489 (semantic-refresh-tags-safe)
490 ;; Do the rest of the analysis.
491 (if (not position) (setq position (point)))
492 (save-excursion
493 (goto-char position)
494 (let* ((answer (semantic-get-cache-data 'current-context)))
495 (with-syntax-table semantic-lex-syntax-table
496 (when (not answer)
497 (setq answer (:override))
498 (when (and answer (oref answer bounds))
499 (with-slots (bounds) answer
500 (semantic-cache-data-to-buffer (current-buffer)
501 (car bounds)
502 (cdr bounds)
503 answer
504 'current-context
505 'exit-cache-zone)))
506 ;; Check for interactivity
507 (when (interactive-p)
508 (if answer
509 (semantic-analyze-pop-to-context answer)
510 (message "No Context."))
511 ))
512
513 answer))))
514
515 (defun semantic-analyze-current-context-default (position)
516 "Analyze the current context at POSITION.
517 Returns an object based on symbol `semantic-analyze-context'."
518 (let* ((semantic-analyze-error-stack nil)
519 (context-return nil)
520 (prefixandbounds (semantic-ctxt-current-symbol-and-bounds (or position (point))))
521 (prefix (car prefixandbounds))
522 (bounds (nth 2 prefixandbounds))
523 ;; @todo - vv too early to really know this answer! vv
524 (prefixclass (semantic-ctxt-current-class-list))
525 (prefixtypes nil)
526 (scope (semantic-calculate-scope position))
527 (function nil)
528 (fntag nil)
529 arg fntagend argtag
530 assign asstag
531 )
532
533 ;; Pattern for Analysis:
534 ;;
535 ;; Step 1: Calculate DataTypes in Scope:
536 ;;
537 ;; a) Calculate the scope (above)
538 ;;
539 ;; Step 2: Parse context
540 ;;
541 ;; a) Identify function being called, or variable assignment,
542 ;; and find source tags for those references
543 ;; b) Identify the prefix (text cursor is on) and find the source
544 ;; tags for those references.
545 ;;
546 ;; Step 3: Assemble an object
547 ;;
548
549 ;; Step 2 a:
550
551 (setq function (semantic-ctxt-current-function))
552
553 (when function
554 ;; Calculate the argument for the function if there is one.
555 (setq arg (semantic-ctxt-current-argument))
556
557 ;; Find a tag related to the function name.
558 (condition-case err
559 (setq fntag
560 (semantic-analyze-find-tag-sequence function scope))
561 (error (semantic-analyze-push-error err)))
562
563 ;; fntag can have the last entry as just a string, meaning we
564 ;; could not find the core datatype. In this case, the searches
565 ;; below will not work.
566 (when (stringp (car (last fntag)))
567 ;; Take a wild guess!
568 (setcar (last fntag) (semantic-tag (car (last fntag)) 'function))
569 )
570
571 (when fntag
572 (let ((fcn (semantic-find-tags-by-class 'function fntag)))
573 (when (not fcn)
574 (let ((ty (semantic-find-tags-by-class 'type fntag)))
575 (when ty
576 ;; We might have a constructor with the same name as
577 ;; the found datatype.
578 (setq fcn (semantic-find-tags-by-name
579 (semantic-tag-name (car ty))
580 (semantic-tag-type-members (car ty))))
581 (if fcn
582 (let ((lp fcn))
583 (while lp
584 (when (semantic-tag-get-attribute (car lp)
585 :constructor)
586 (setq fcn (cons (car lp) fcn)))
587 (setq lp (cdr lp))))
588 ;; Give up, go old school
589 (setq fcn fntag))
590 )))
591 (setq fntagend (car (reverse fcn))
592 argtag
593 (when (semantic-tag-p fntagend)
594 (nth (1- arg) (semantic-tag-function-arguments fntagend)))
595 fntag fcn))))
596
597 ;; Step 2 b:
598
599 ;; Only do work if we have bounds (meaning a prefix to complete)
600 (when bounds
601
602 (if debug-on-error
603 (catch 'unfindable
604 ;; If debug on error is on, allow debugging in this fcn.
605 (setq prefix (semantic-analyze-find-tag-sequence
606 prefix scope 'prefixtypes 'unfindable)))
607 ;; Debug on error is off. Capture errors and move on
608 (condition-case err
609 ;; NOTE: This line is duplicated in
610 ;; semantic-analyzer-debug-global-symbol
611 ;; You will need to update both places.
612 (setq prefix (semantic-analyze-find-tag-sequence
613 prefix scope 'prefixtypes))
614 (error (semantic-analyze-push-error err))))
615 )
616
617 ;; Step 3:
618
619 (cond
620 (fntag
621 ;; If we found a tag for our function, we can go into
622 ;; functional context analysis mode, meaning we have a type
623 ;; for the argument.
624 (setq context-return
625 (semantic-analyze-context-functionarg
626 "functionargument"
627 :buffer (current-buffer)
628 :function fntag
629 :index arg
630 :argument (list argtag)
631 :scope scope
632 :prefix prefix
633 :prefixclass prefixclass
634 :bounds bounds
635 :prefixtypes prefixtypes
636 :errors semantic-analyze-error-stack)))
637
638 ;; No function, try assignment
639 ((and (setq assign (semantic-ctxt-current-assignment))
640 ;; We have some sort of an assignment
641 (condition-case err
642 (setq asstag (semantic-analyze-find-tag-sequence
643 assign scope))
644 (error (semantic-analyze-push-error err)
645 nil)))
646
647 (setq context-return
648 (semantic-analyze-context-assignment
649 "assignment"
650 :buffer (current-buffer)
651 :assignee asstag
652 :scope scope
653 :bounds bounds
654 :prefix prefix
655 :prefixclass prefixclass
656 :prefixtypes prefixtypes
657 :errors semantic-analyze-error-stack)))
658
659 ;; TODO: Identify return value condition.
660 ;;((setq return .... what to do?)
661 ;; ...)
662
663 (bounds
664 ;; Nothing in particular
665 (setq context-return
666 (semantic-analyze-context
667 "context"
668 :buffer (current-buffer)
669 :scope scope
670 :bounds bounds
671 :prefix prefix
672 :prefixclass prefixclass
673 :prefixtypes prefixtypes
674 :errors semantic-analyze-error-stack)))
675
676 (t (setq context-return nil))
677 )
678
679 ;; Return our context.
680 context-return))
681
682 \f
683 (defun semantic-adebug-analyze (&optional ctxt)
684 "Perform `semantic-analyze-current-context'.
685 Display the results as a debug list.
686 Optional argument CTXT is the context to show."
687 (interactive)
688 (require 'data-debug)
689 (let ((start (current-time))
690 (ctxt (or ctxt (semantic-analyze-current-context)))
691 (end (current-time)))
692 (if (not ctxt)
693 (message "No Analyzer Results")
694 (message "Analysis took %.2f seconds."
695 (semantic-elapsed-time start end))
696 (semantic-analyze-pulse ctxt)
697 (if ctxt
698 (progn
699 (data-debug-new-buffer "*Analyzer ADEBUG*")
700 (data-debug-insert-object-slots ctxt "]"))
701 (message "No Context to analyze here.")))))
702
703 \f
704 ;;; DEBUG OUTPUT
705 ;;
706 ;; Friendly output of a context analysis.
707 ;;
708 (declare-function pulse-momentary-highlight-region "pulse")
709
710 (defmethod semantic-analyze-pulse ((context semantic-analyze-context))
711 "Pulse the region that CONTEXT affects."
712 (require 'pulse)
713 (with-current-buffer (oref context :buffer)
714 (let ((bounds (oref context :bounds)))
715 (when bounds
716 (pulse-momentary-highlight-region (car bounds) (cdr bounds))))))
717
718 (defcustom semantic-analyze-summary-function 'semantic-format-tag-prototype
719 "Function to use when creating items in Imenu.
720 Some useful functions are found in `semantic-format-tag-functions'."
721 :group 'semantic
722 :type semantic-format-tag-custom-list)
723
724 (defun semantic-analyze-princ-sequence (sequence &optional prefix buff)
725 "Send the tag SEQUENCE to standard out.
726 Use PREFIX as a label.
727 Use BUFF as a source of override methods."
728 (while sequence
729 (princ prefix)
730 (cond
731 ((semantic-tag-p (car sequence))
732 (princ (funcall semantic-analyze-summary-function
733 (car sequence))))
734 ((stringp (car sequence))
735 (princ "\"")
736 (princ (semantic--format-colorize-text (car sequence) 'variable))
737 (princ "\""))
738 (t
739 (princ (format "'%S" (car sequence)))))
740 (princ "\n")
741 (setq sequence (cdr sequence))
742 (setq prefix (make-string (length prefix) ? ))
743 ))
744
745 (defmethod semantic-analyze-show ((context semantic-analyze-context))
746 "Insert CONTEXT into the current buffer in a nice way."
747 (semantic-analyze-princ-sequence (oref context prefix) "Prefix: " )
748 (semantic-analyze-princ-sequence (oref context prefixclass) "Prefix Classes: ")
749 (semantic-analyze-princ-sequence (oref context prefixtypes) "Prefix Types: ")
750 (semantic-analyze-princ-sequence (oref context errors) "Encountered Errors: ")
751 (princ "--------\n")
752 ;(semantic-analyze-princ-sequence (oref context scopetypes) "Scope Types: ")
753 ;(semantic-analyze-princ-sequence (oref context scope) "Scope: ")
754 ;(semantic-analyze-princ-sequence (oref context localvariables) "LocalVars: ")
755 (when (oref context scope)
756 (semantic-analyze-show (oref context scope)))
757 )
758
759 (defmethod semantic-analyze-show ((context semantic-analyze-context-assignment))
760 "Insert CONTEXT into the current buffer in a nice way."
761 (semantic-analyze-princ-sequence (oref context assignee) "Assignee: ")
762 (call-next-method))
763
764 (defmethod semantic-analyze-show ((context semantic-analyze-context-functionarg))
765 "Insert CONTEXT into the current buffer in a nice way."
766 (semantic-analyze-princ-sequence (oref context function) "Function: ")
767 (princ "Argument Index: ")
768 (princ (oref context index))
769 (princ "\n")
770 (semantic-analyze-princ-sequence (oref context argument) "Argument: ")
771 (call-next-method))
772
773 (defun semantic-analyze-pop-to-context (context)
774 "Display CONTEXT in a temporary buffer.
775 CONTEXT's content is described in `semantic-analyze-current-context'."
776 (semantic-analyze-pulse context)
777 (with-output-to-temp-buffer "*Semantic Context Analysis*"
778 (princ "Context Type: ")
779 (princ (object-name context))
780 (princ "\n")
781 (princ "Bounds: ")
782 (princ (oref context bounds))
783 (princ "\n")
784 (semantic-analyze-show context)
785 )
786 (shrink-window-if-larger-than-buffer
787 (get-buffer-window "*Semantic Context Analysis*"))
788 )
789
790 (provide 'semantic/analyze)
791
792 ;; Local variables:
793 ;; generated-autoload-file: "loaddefs.el"
794 ;; generated-autoload-load-name: "semantic/analyze"
795 ;; End:
796
797 ;; arch-tag: 1102143a-1c05-4631-83e8-45aafc6b4a59
798 ;;; semantic/analyze.el ends here