Commit | Line | Data |
---|---|---|
20bfd709 CY |
1 | ;;; semantic/ia-sb.el --- Speedbar analysis display interactor |
2 | ||
95df8112 | 3 | ;;; Copyright (C) 2002-2004, 2006, 2008-2011 Free Software Foundation, Inc. |
20bfd709 CY |
4 | |
5 | ;; Author: Eric M. Ludlam <zappo@gnu.org> | |
6 | ;; Keywords: syntax | |
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 | ;; Speedbar node for displaying derived context information. | |
26 | ;; | |
27 | ||
28 | (require 'semantic/analyze) | |
29 | (require 'speedbar) | |
30 | ||
31 | ;;; Code: | |
32 | (defvar semantic-ia-sb-key-map nil | |
33 | "Keymap used when in semantic analysis display mode.") | |
34 | ||
35 | (if semantic-ia-sb-key-map | |
36 | nil | |
37 | (setq semantic-ia-sb-key-map (speedbar-make-specialized-keymap)) | |
38 | ||
39 | ;; Basic featuers. | |
40 | (define-key semantic-ia-sb-key-map "\C-m" 'speedbar-edit-line) | |
41 | (define-key semantic-ia-sb-key-map "I" 'semantic-ia-sb-show-tag-info) | |
42 | ) | |
43 | ||
44 | (defvar semantic-ia-sb-easymenu-definition | |
45 | '( "---" | |
46 | ; [ "Expand" speedbar-expand-line nil ] | |
47 | ; [ "Contract" speedbar-contract-line nil ] | |
48 | [ "Tag Information" semantic-ia-sb-show-tag-info t ] | |
49 | [ "Jump to Tag" speedbar-edit-line t ] | |
50 | [ "Complete" speedbar-edit-line t ] | |
51 | ) | |
52 | "Extra menu items Analysis mode.") | |
53 | ||
54 | ;; Make sure our special speedbar major mode is loaded | |
55 | (speedbar-add-expansion-list '("Analyze" | |
56 | semantic-ia-sb-easymenu-definition | |
57 | semantic-ia-sb-key-map | |
58 | semantic-ia-speedbar)) | |
59 | ||
60 | (speedbar-add-mode-functions-list | |
61 | (list "Analyze" | |
62 | ;;'(speedbar-item-info . eieio-speedbar-item-info) | |
63 | '(speedbar-line-directory . semantic-ia-sb-line-path))) | |
64 | ||
e076d49f | 65 | ;;;###autoload |
20bfd709 CY |
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) | |
0816d744 | 106 | (with-current-buffer speedbar-buffer |
20bfd709 CY |
107 | ;; If we have something, do something spiff with it. |
108 | (erase-buffer) | |
109 | (speedbar-insert-separator "Buffer/Function") | |
110 | ;; Note to self: Turn this into an expandable file name. | |
111 | (speedbar-make-tag-line 'bracket ? nil nil | |
112 | (buffer-name buffer) | |
113 | nil nil 'speedbar-file-face 0) | |
114 | ||
115 | (when cnt | |
116 | (semantic-ia-sb-string-list cnt | |
117 | 'speedbar-tag-face | |
118 | 'semantic-sb-token-jump)) | |
119 | (when analysis | |
120 | ;; If this analyzer happens to point at a complete symbol, then | |
121 | ;; see if we can dig up some documentation for it. | |
122 | (semantic-ia-sb-show-doc analysis)) | |
123 | ||
124 | (when analysis | |
125 | ;; Let different classes draw more buttons. | |
126 | (semantic-ia-sb-more-buttons analysis) | |
127 | (when completions | |
128 | (speedbar-insert-separator "Completions") | |
129 | (semantic-ia-sb-completion-list completions | |
130 | 'speedbar-tag-face | |
131 | 'semantic-ia-sb-complete)) | |
132 | ) | |
133 | ||
134 | ;; Show local variables | |
135 | (when scope | |
136 | (semantic-ia-sb-show-scope scope)) | |
137 | ||
138 | ))) | |
139 | ||
140 | (defmethod semantic-ia-sb-show-doc ((context semantic-analyze-context)) | |
141 | "Show documentation about CONTEXT iff CONTEXT points at a complete symbol." | |
142 | (let ((sym (car (reverse (oref context prefix)))) | |
143 | (doc nil)) | |
144 | (when (semantic-tag-p sym) | |
145 | (setq doc (semantic-documentation-for-tag sym)) | |
146 | (when doc | |
147 | (speedbar-insert-separator "Documentation") | |
148 | (insert doc) | |
149 | (insert "\n") | |
150 | )) | |
151 | )) | |
152 | ||
153 | (defun semantic-ia-sb-show-scope (scope) | |
154 | "Show SCOPE information." | |
155 | (let ((localvars (when scope | |
156 | (oref scope localvar))) | |
157 | ) | |
158 | (when localvars | |
159 | (speedbar-insert-separator "Local Variables") | |
160 | (semantic-ia-sb-string-list localvars | |
161 | 'speedbar-tag-face | |
162 | ;; This is from semantic-sb | |
163 | 'semantic-sb-token-jump)))) | |
164 | ||
165 | (defmethod semantic-ia-sb-more-buttons ((context semantic-analyze-context)) | |
166 | "Show a set of speedbar buttons specific to CONTEXT." | |
167 | (let ((prefix (oref context prefix))) | |
168 | (when prefix | |
169 | (speedbar-insert-separator "Prefix") | |
170 | (semantic-ia-sb-string-list prefix | |
171 | 'speedbar-tag-face | |
172 | 'semantic-sb-token-jump)) | |
173 | )) | |
174 | ||
175 | (defmethod semantic-ia-sb-more-buttons ((context semantic-analyze-context-assignment)) | |
176 | "Show a set of speedbar buttons specific to CONTEXT." | |
177 | (call-next-method) | |
178 | (let ((assignee (oref context assignee))) | |
179 | (when assignee | |
180 | (speedbar-insert-separator "Assignee") | |
181 | (semantic-ia-sb-string-list assignee | |
182 | 'speedbar-tag-face | |
183 | 'semantic-sb-token-jump)))) | |
184 | ||
185 | (defmethod semantic-ia-sb-more-buttons ((context semantic-analyze-context-functionarg)) | |
186 | "Show a set of speedbar buttons specific to CONTEXT." | |
187 | (call-next-method) | |
188 | (let ((func (oref context function))) | |
189 | (when func | |
190 | (speedbar-insert-separator "Function") | |
191 | (semantic-ia-sb-string-list func | |
192 | 'speedbar-tag-face | |
193 | 'semantic-sb-token-jump) | |
194 | ;; An index for the argument the prefix is in: | |
195 | (let ((arg (oref context argument)) | |
196 | (args (semantic-tag-function-arguments (car func))) | |
197 | (idx 0) | |
198 | ) | |
199 | (speedbar-insert-separator | |
200 | (format "Argument #%d" (oref context index))) | |
201 | (if args | |
202 | (semantic-ia-sb-string-list args | |
203 | 'speedbar-tag-face | |
204 | 'semantic-sb-token-jump | |
205 | (oref context index) | |
206 | 'speedbar-selected-face) | |
207 | ;; Else, no args list, so use what the context had. | |
208 | (semantic-ia-sb-string-list arg | |
209 | 'speedbar-tag-face | |
210 | 'semantic-sb-token-jump)) | |
211 | )))) | |
212 | ||
213 | (defun semantic-ia-sb-string-list (list face function &optional idx idxface) | |
214 | "Create some speedbar buttons from LIST. | |
215 | Each button will use FACE, and be activated with FUNCTION. | |
216 | Optional IDX is an index into LIST to apply IDXFACE instead." | |
217 | (let ((count 1)) | |
218 | (while list | |
219 | (let* ((usefn nil) | |
220 | (string (cond ((stringp (car list)) | |
221 | (car list)) | |
222 | ((semantic-tag-p (car list)) | |
223 | (setq usefn (semantic-tag-with-position-p (car list))) | |
224 | (semantic-format-tag-uml-concise-prototype (car list))) | |
225 | (t "<No Tag>"))) | |
226 | (localface (if (or (not idx) (/= idx count)) | |
227 | face | |
228 | idxface)) | |
229 | ) | |
230 | (if (semantic-tag-p (car list)) | |
231 | (speedbar-make-tag-line 'angle ?i | |
232 | 'semantic-ia-sb-tag-info (car list) | |
233 | string (if usefn function) (car list) localface | |
234 | 0) | |
235 | (speedbar-make-tag-line 'statictag ?? | |
236 | nil nil | |
237 | string (if usefn function) (car list) localface | |
238 | 0)) | |
239 | (setq list (cdr list) | |
240 | count (1+ count))) | |
241 | ))) | |
242 | ||
243 | (defun semantic-ia-sb-completion-list (list face function) | |
244 | "Create some speedbar buttons from LIST. | |
245 | Each button will use FACE, and be activated with FUNCTION." | |
246 | (while list | |
247 | (let* ((documentable nil) | |
248 | (string (cond ((stringp (car list)) | |
249 | (car list)) | |
250 | ((semantic-tag-p (car list)) | |
251 | (setq documentable t) | |
252 | (semantic-format-tag-uml-concise-prototype (car list))) | |
253 | (t "foo")))) | |
254 | (if documentable | |
255 | (speedbar-make-tag-line 'angle ?i | |
256 | 'semantic-ia-sb-tag-info | |
257 | (car list) | |
258 | string function (car list) face | |
259 | 0) | |
260 | (speedbar-make-tag-line 'statictag ? nil nil | |
261 | string function (car list) face | |
262 | 0)) | |
263 | (setq list (cdr list))))) | |
264 | ||
265 | (defun semantic-ia-sb-show-tag-info () | |
266 | "Display information about the tag on the current line. | |
267 | Same as clicking on the <i> button. | |
268 | See `semantic-ia-sb-tag-info' for more." | |
269 | (interactive) | |
270 | (let ((tok nil)) | |
271 | (save-excursion | |
272 | (end-of-line) | |
273 | (forward-char -1) | |
274 | (setq tok (get-text-property (point) 'speedbar-token))) | |
275 | (semantic-ia-sb-tag-info nil tok 0))) | |
276 | ||
277 | (defun semantic-ia-sb-tag-info (text tag indent) | |
278 | "Display as much information as we can about tag. | |
279 | Show the information in a shrunk split-buffer and expand | |
280 | out as many details as possible. | |
281 | TEXT, TAG, and INDENT are speedbar function arguments." | |
282 | (when (semantic-tag-p tag) | |
283 | (unwind-protect | |
284 | (let ((ob nil)) | |
285 | (speedbar-select-attached-frame) | |
286 | (setq ob (current-buffer)) | |
287 | (with-output-to-temp-buffer "*Tag Information*" | |
288 | ;; Output something about this tag: | |
0816d744 | 289 | (with-current-buffer "*Tag Information*" |
20bfd709 CY |
290 | (goto-char (point-max)) |
291 | (insert | |
292 | (semantic-format-tag-prototype tag nil t) | |
293 | "\n") | |
294 | (let ((typetok | |
295 | (condition-case nil | |
0816d744 | 296 | (with-current-buffer ob |
20bfd709 CY |
297 | ;; @todo - We need a context to derive a scope from. |
298 | (semantic-analyze-tag-type tag nil)) | |
299 | (error nil)))) | |
300 | (if typetok | |
301 | (insert (semantic-format-tag-prototype | |
302 | typetok nil t)) | |
303 | ;; No type found by the analyzer | |
304 | ;; The below used to try and select the buffer from the last | |
305 | ;; analysis, but since we are already in the correct buffer, I | |
306 | ;; don't think that is needed. | |
307 | (let ((type (semantic-tag-type tag))) | |
308 | (cond ((semantic-tag-p type) | |
309 | (setq type (semantic-tag-name type))) | |
310 | ((listp type) | |
311 | (setq type (car type)))) | |
312 | (if (semantic-lex-keyword-p type) | |
313 | (setq typetok | |
314 | (semantic-lex-keyword-get type 'summary)))) | |
315 | (if typetok | |
316 | (insert typetok)) | |
317 | )) | |
318 | )) | |
319 | ;; Make it small | |
320 | (shrink-window-if-larger-than-buffer | |
321 | (get-buffer-window "*Tag Information*"))) | |
322 | (select-frame speedbar-frame)))) | |
323 | ||
324 | (defun semantic-ia-sb-line-path (&optional depth) | |
325 | "Return the file name associated with DEPTH." | |
326 | (save-match-data | |
327 | (let* ((tok (speedbar-line-token)) | |
328 | (buff (if (semantic-tag-buffer tok) | |
329 | (semantic-tag-buffer tok) | |
330 | (current-buffer)))) | |
331 | (buffer-file-name buff)))) | |
332 | ||
333 | (defun semantic-ia-sb-complete (text tag indent) | |
334 | "At point in the attached buffer, complete the symbol clicked on. | |
335 | TEXT TAG and INDENT are the details." | |
336 | ;; Find the specified bounds from the current analysis. | |
337 | (speedbar-select-attached-frame) | |
338 | (unwind-protect | |
339 | (let* ((a (semantic-analyze-current-context (point))) | |
340 | (bounds (oref a bounds)) | |
341 | (movepoint nil) | |
342 | ) | |
343 | (save-excursion | |
344 | (if (and (<= (point) (cdr bounds)) (>= (point) (car bounds))) | |
345 | (setq movepoint t)) | |
346 | (goto-char (car bounds)) | |
347 | (delete-region (car bounds) (cdr bounds)) | |
348 | (insert (semantic-tag-name tag)) | |
349 | (if movepoint (setq movepoint (point))) | |
350 | ;; I'd like to use this to add fancy () or what not at the end | |
351 | ;; but we need the parent file whih requires an upgrade to the | |
352 | ;; analysis tool. | |
353 | ;;(semantic-insert-foreign-tag tag ??)) | |
354 | ) | |
355 | (if movepoint | |
356 | (let ((cf (selected-frame))) | |
357 | (speedbar-select-attached-frame) | |
358 | (goto-char movepoint) | |
359 | (select-frame cf)))) | |
360 | (select-frame speedbar-frame))) | |
361 | ||
362 | (provide 'semantic/ia-sb) | |
363 | ||
e076d49f CY |
364 | ;; Local variables: |
365 | ;; generated-autoload-file: "loaddefs.el" | |
e076d49f CY |
366 | ;; generated-autoload-load-name: "semantic/ia-sb" |
367 | ;; End: | |
368 | ||
20bfd709 | 369 | ;;; semantic/ia-sb.el ends here |