Mercurial > emacs
comparison lisp/cedet/semantic/ia-sb.el @ 104435:52067a6bf088
semantic/cedet/db-global.el, semantic/cedet/ia-sb.el,
semantic/cedet/sb.el, semantic/cedet/scope.el: New files.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Sun, 30 Aug 2009 14:36:00 +0000 |
parents | |
children | de6e9d927035 |
comparison
equal
deleted
inserted
replaced
104434:dcacd65a31ec | 104435:52067a6bf088 |
---|---|
1 ;;; semantic/ia-sb.el --- Speedbar analysis display interactor | |
2 | |
3 ;;; Copyright (C) 2002, 2003, 2004, 2006, 2008, 2009 | |
4 ;;; Free Software Foundation, Inc. | |
5 | |
6 ;; Author: Eric M. Ludlam <zappo@gnu.org> | |
7 ;; Keywords: syntax | |
8 | |
9 ;; This file is part of GNU Emacs. | |
10 | |
11 ;; GNU Emacs is free software: you can redistribute it and/or modify | |
12 ;; it under the terms of the GNU General Public License as published by | |
13 ;; the Free Software Foundation, either version 3 of the License, or | |
14 ;; (at your option) any later version. | |
15 | |
16 ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 ;; GNU General Public License for more details. | |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
23 | |
24 ;;; Commentary: | |
25 ;; | |
26 ;; Speedbar node for displaying derived context information. | |
27 ;; | |
28 | |
29 (require 'semantic/analyze) | |
30 (require 'speedbar) | |
31 | |
32 ;;; Code: | |
33 (defvar semantic-ia-sb-key-map nil | |
34 "Keymap used when in semantic analysis display mode.") | |
35 | |
36 (if semantic-ia-sb-key-map | |
37 nil | |
38 (setq semantic-ia-sb-key-map (speedbar-make-specialized-keymap)) | |
39 | |
40 ;; Basic featuers. | |
41 (define-key semantic-ia-sb-key-map "\C-m" 'speedbar-edit-line) | |
42 (define-key semantic-ia-sb-key-map "I" 'semantic-ia-sb-show-tag-info) | |
43 ) | |
44 | |
45 (defvar semantic-ia-sb-easymenu-definition | |
46 '( "---" | |
47 ; [ "Expand" speedbar-expand-line nil ] | |
48 ; [ "Contract" speedbar-contract-line nil ] | |
49 [ "Tag Information" semantic-ia-sb-show-tag-info t ] | |
50 [ "Jump to Tag" speedbar-edit-line t ] | |
51 [ "Complete" speedbar-edit-line t ] | |
52 ) | |
53 "Extra menu items Analysis mode.") | |
54 | |
55 ;; Make sure our special speedbar major mode is loaded | |
56 (speedbar-add-expansion-list '("Analyze" | |
57 semantic-ia-sb-easymenu-definition | |
58 semantic-ia-sb-key-map | |
59 semantic-ia-speedbar)) | |
60 | |
61 (speedbar-add-mode-functions-list | |
62 (list "Analyze" | |
63 ;;'(speedbar-item-info . eieio-speedbar-item-info) | |
64 '(speedbar-line-directory . semantic-ia-sb-line-path))) | |
65 | |
66 (defun semantic-speedbar-analysis () | |
67 "Start Speedbar in semantic analysis mode. | |
68 The analyzer displays information about the current context, plus a smart | |
69 list of possible completions." | |
70 (interactive) | |
71 ;; Make sure that speedbar is active | |
72 (speedbar-frame-mode 1) | |
73 ;; Now, throw us into Analyze mode on speedbar. | |
74 (speedbar-change-initial-expansion-list "Analyze") | |
75 ) | |
76 | |
77 (defun semantic-ia-speedbar (directory zero) | |
78 "Create buttons in speedbar which define the current analysis at POINT. | |
79 DIRECTORY is the current directory, which is ignored, and ZERO is 0." | |
80 (let ((analysis nil) | |
81 (scope nil) | |
82 (buffer nil) | |
83 (completions nil) | |
84 (cf (selected-frame)) | |
85 (cnt nil) | |
86 (mode-local-active-mode nil) | |
87 ) | |
88 ;; Try and get some sort of analysis | |
89 (condition-case nil | |
90 (progn | |
91 (speedbar-select-attached-frame) | |
92 (setq buffer (current-buffer)) | |
93 (setq mode-local-active-mode major-mode) | |
94 (save-excursion | |
95 ;; Get the current scope | |
96 (setq scope (semantic-calculate-scope (point))) | |
97 ;; Get the analysis | |
98 (setq analysis (semantic-analyze-current-context (point))) | |
99 (setq cnt (semantic-find-tag-by-overlay)) | |
100 (when analysis | |
101 (setq completions (semantic-analyze-possible-completions analysis)) | |
102 ) | |
103 )) | |
104 (error nil)) | |
105 (select-frame cf) | |
106 (save-excursion | |
107 (set-buffer speedbar-buffer) | |
108 ;; If we have something, do something spiff with it. | |
109 (erase-buffer) | |
110 (speedbar-insert-separator "Buffer/Function") | |
111 ;; Note to self: Turn this into an expandable file name. | |
112 (speedbar-make-tag-line 'bracket ? nil nil | |
113 (buffer-name buffer) | |
114 nil nil 'speedbar-file-face 0) | |
115 | |
116 (when cnt | |
117 (semantic-ia-sb-string-list cnt | |
118 'speedbar-tag-face | |
119 'semantic-sb-token-jump)) | |
120 (when analysis | |
121 ;; If this analyzer happens to point at a complete symbol, then | |
122 ;; see if we can dig up some documentation for it. | |
123 (semantic-ia-sb-show-doc analysis)) | |
124 | |
125 (when analysis | |
126 ;; Let different classes draw more buttons. | |
127 (semantic-ia-sb-more-buttons analysis) | |
128 (when completions | |
129 (speedbar-insert-separator "Completions") | |
130 (semantic-ia-sb-completion-list completions | |
131 'speedbar-tag-face | |
132 'semantic-ia-sb-complete)) | |
133 ) | |
134 | |
135 ;; Show local variables | |
136 (when scope | |
137 (semantic-ia-sb-show-scope scope)) | |
138 | |
139 ))) | |
140 | |
141 (defmethod semantic-ia-sb-show-doc ((context semantic-analyze-context)) | |
142 "Show documentation about CONTEXT iff CONTEXT points at a complete symbol." | |
143 (let ((sym (car (reverse (oref context prefix)))) | |
144 (doc nil)) | |
145 (when (semantic-tag-p sym) | |
146 (setq doc (semantic-documentation-for-tag sym)) | |
147 (when doc | |
148 (speedbar-insert-separator "Documentation") | |
149 (insert doc) | |
150 (insert "\n") | |
151 )) | |
152 )) | |
153 | |
154 (defun semantic-ia-sb-show-scope (scope) | |
155 "Show SCOPE information." | |
156 (let ((localvars (when scope | |
157 (oref scope localvar))) | |
158 ) | |
159 (when localvars | |
160 (speedbar-insert-separator "Local Variables") | |
161 (semantic-ia-sb-string-list localvars | |
162 'speedbar-tag-face | |
163 ;; This is from semantic-sb | |
164 'semantic-sb-token-jump)))) | |
165 | |
166 (defmethod semantic-ia-sb-more-buttons ((context semantic-analyze-context)) | |
167 "Show a set of speedbar buttons specific to CONTEXT." | |
168 (let ((prefix (oref context prefix))) | |
169 (when prefix | |
170 (speedbar-insert-separator "Prefix") | |
171 (semantic-ia-sb-string-list prefix | |
172 'speedbar-tag-face | |
173 'semantic-sb-token-jump)) | |
174 )) | |
175 | |
176 (defmethod semantic-ia-sb-more-buttons ((context semantic-analyze-context-assignment)) | |
177 "Show a set of speedbar buttons specific to CONTEXT." | |
178 (call-next-method) | |
179 (let ((assignee (oref context assignee))) | |
180 (when assignee | |
181 (speedbar-insert-separator "Assignee") | |
182 (semantic-ia-sb-string-list assignee | |
183 'speedbar-tag-face | |
184 'semantic-sb-token-jump)))) | |
185 | |
186 (defmethod semantic-ia-sb-more-buttons ((context semantic-analyze-context-functionarg)) | |
187 "Show a set of speedbar buttons specific to CONTEXT." | |
188 (call-next-method) | |
189 (let ((func (oref context function))) | |
190 (when func | |
191 (speedbar-insert-separator "Function") | |
192 (semantic-ia-sb-string-list func | |
193 'speedbar-tag-face | |
194 'semantic-sb-token-jump) | |
195 ;; An index for the argument the prefix is in: | |
196 (let ((arg (oref context argument)) | |
197 (args (semantic-tag-function-arguments (car func))) | |
198 (idx 0) | |
199 ) | |
200 (speedbar-insert-separator | |
201 (format "Argument #%d" (oref context index))) | |
202 (if args | |
203 (semantic-ia-sb-string-list args | |
204 'speedbar-tag-face | |
205 'semantic-sb-token-jump | |
206 (oref context index) | |
207 'speedbar-selected-face) | |
208 ;; Else, no args list, so use what the context had. | |
209 (semantic-ia-sb-string-list arg | |
210 'speedbar-tag-face | |
211 'semantic-sb-token-jump)) | |
212 )))) | |
213 | |
214 (defun semantic-ia-sb-string-list (list face function &optional idx idxface) | |
215 "Create some speedbar buttons from LIST. | |
216 Each button will use FACE, and be activated with FUNCTION. | |
217 Optional IDX is an index into LIST to apply IDXFACE instead." | |
218 (let ((count 1)) | |
219 (while list | |
220 (let* ((usefn nil) | |
221 (string (cond ((stringp (car list)) | |
222 (car list)) | |
223 ((semantic-tag-p (car list)) | |
224 (setq usefn (semantic-tag-with-position-p (car list))) | |
225 (semantic-format-tag-uml-concise-prototype (car list))) | |
226 (t "<No Tag>"))) | |
227 (localface (if (or (not idx) (/= idx count)) | |
228 face | |
229 idxface)) | |
230 ) | |
231 (if (semantic-tag-p (car list)) | |
232 (speedbar-make-tag-line 'angle ?i | |
233 'semantic-ia-sb-tag-info (car list) | |
234 string (if usefn function) (car list) localface | |
235 0) | |
236 (speedbar-make-tag-line 'statictag ?? | |
237 nil nil | |
238 string (if usefn function) (car list) localface | |
239 0)) | |
240 (setq list (cdr list) | |
241 count (1+ count))) | |
242 ))) | |
243 | |
244 (defun semantic-ia-sb-completion-list (list face function) | |
245 "Create some speedbar buttons from LIST. | |
246 Each button will use FACE, and be activated with FUNCTION." | |
247 (while list | |
248 (let* ((documentable nil) | |
249 (string (cond ((stringp (car list)) | |
250 (car list)) | |
251 ((semantic-tag-p (car list)) | |
252 (setq documentable t) | |
253 (semantic-format-tag-uml-concise-prototype (car list))) | |
254 (t "foo")))) | |
255 (if documentable | |
256 (speedbar-make-tag-line 'angle ?i | |
257 'semantic-ia-sb-tag-info | |
258 (car list) | |
259 string function (car list) face | |
260 0) | |
261 (speedbar-make-tag-line 'statictag ? nil nil | |
262 string function (car list) face | |
263 0)) | |
264 (setq list (cdr list))))) | |
265 | |
266 (defun semantic-ia-sb-show-tag-info () | |
267 "Display information about the tag on the current line. | |
268 Same as clicking on the <i> button. | |
269 See `semantic-ia-sb-tag-info' for more." | |
270 (interactive) | |
271 (let ((tok nil)) | |
272 (save-excursion | |
273 (end-of-line) | |
274 (forward-char -1) | |
275 (setq tok (get-text-property (point) 'speedbar-token))) | |
276 (semantic-ia-sb-tag-info nil tok 0))) | |
277 | |
278 (defun semantic-ia-sb-tag-info (text tag indent) | |
279 "Display as much information as we can about tag. | |
280 Show the information in a shrunk split-buffer and expand | |
281 out as many details as possible. | |
282 TEXT, TAG, and INDENT are speedbar function arguments." | |
283 (when (semantic-tag-p tag) | |
284 (unwind-protect | |
285 (let ((ob nil)) | |
286 (speedbar-select-attached-frame) | |
287 (setq ob (current-buffer)) | |
288 (with-output-to-temp-buffer "*Tag Information*" | |
289 ;; Output something about this tag: | |
290 (save-excursion | |
291 (set-buffer "*Tag Information*") | |
292 (goto-char (point-max)) | |
293 (insert | |
294 (semantic-format-tag-prototype tag nil t) | |
295 "\n") | |
296 (let ((typetok | |
297 (condition-case nil | |
298 (save-excursion | |
299 (set-buffer ob) | |
300 ;; @todo - We need a context to derive a scope from. | |
301 (semantic-analyze-tag-type tag nil)) | |
302 (error nil)))) | |
303 (if typetok | |
304 (insert (semantic-format-tag-prototype | |
305 typetok nil t)) | |
306 ;; No type found by the analyzer | |
307 ;; The below used to try and select the buffer from the last | |
308 ;; analysis, but since we are already in the correct buffer, I | |
309 ;; don't think that is needed. | |
310 (let ((type (semantic-tag-type tag))) | |
311 (cond ((semantic-tag-p type) | |
312 (setq type (semantic-tag-name type))) | |
313 ((listp type) | |
314 (setq type (car type)))) | |
315 (if (semantic-lex-keyword-p type) | |
316 (setq typetok | |
317 (semantic-lex-keyword-get type 'summary)))) | |
318 (if typetok | |
319 (insert typetok)) | |
320 )) | |
321 )) | |
322 ;; Make it small | |
323 (shrink-window-if-larger-than-buffer | |
324 (get-buffer-window "*Tag Information*"))) | |
325 (select-frame speedbar-frame)))) | |
326 | |
327 (defun semantic-ia-sb-line-path (&optional depth) | |
328 "Return the file name associated with DEPTH." | |
329 (save-match-data | |
330 (let* ((tok (speedbar-line-token)) | |
331 (buff (if (semantic-tag-buffer tok) | |
332 (semantic-tag-buffer tok) | |
333 (current-buffer)))) | |
334 (buffer-file-name buff)))) | |
335 | |
336 (defun semantic-ia-sb-complete (text tag indent) | |
337 "At point in the attached buffer, complete the symbol clicked on. | |
338 TEXT TAG and INDENT are the details." | |
339 ;; Find the specified bounds from the current analysis. | |
340 (speedbar-select-attached-frame) | |
341 (unwind-protect | |
342 (let* ((a (semantic-analyze-current-context (point))) | |
343 (bounds (oref a bounds)) | |
344 (movepoint nil) | |
345 ) | |
346 (save-excursion | |
347 (if (and (<= (point) (cdr bounds)) (>= (point) (car bounds))) | |
348 (setq movepoint t)) | |
349 (goto-char (car bounds)) | |
350 (delete-region (car bounds) (cdr bounds)) | |
351 (insert (semantic-tag-name tag)) | |
352 (if movepoint (setq movepoint (point))) | |
353 ;; I'd like to use this to add fancy () or what not at the end | |
354 ;; but we need the parent file whih requires an upgrade to the | |
355 ;; analysis tool. | |
356 ;;(semantic-insert-foreign-tag tag ??)) | |
357 ) | |
358 (if movepoint | |
359 (let ((cf (selected-frame))) | |
360 (speedbar-select-attached-frame) | |
361 (goto-char movepoint) | |
362 (select-frame cf)))) | |
363 (select-frame speedbar-frame))) | |
364 | |
365 (provide 'semantic/ia-sb) | |
366 | |
367 ;;; semantic/ia-sb.el ends here |