Commit | Line | Data |
---|---|---|
20bfd709 CY |
1 | ;;; semantic/ia-sb.el --- Speedbar analysis display interactor |
2 | ||
ab422c4d PE |
3 | ;;; Copyright (C) 2002-2004, 2006, 2008-2013 Free Software Foundation, |
4 | ;;; Inc. | |
20bfd709 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 | ;; 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 | ||
c5e87d10 | 40 | ;; Basic features. |
20bfd709 CY |
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 | ||
e076d49f | 66 | ;;;###autoload |
20bfd709 CY |
67 | (defun semantic-speedbar-analysis () |
68 | "Start Speedbar in semantic analysis mode. | |
69 | The analyzer displays information about the current context, plus a smart | |
70 | list of possible completions." | |
71 | (interactive) | |
72 | ;; Make sure that speedbar is active | |
73 | (speedbar-frame-mode 1) | |
74 | ;; Now, throw us into Analyze mode on speedbar. | |
75 | (speedbar-change-initial-expansion-list "Analyze") | |
76 | ) | |
77 | ||
78 | (defun semantic-ia-speedbar (directory zero) | |
79 | "Create buttons in speedbar which define the current analysis at POINT. | |
80 | DIRECTORY is the current directory, which is ignored, and ZERO is 0." | |
81 | (let ((analysis nil) | |
82 | (scope nil) | |
83 | (buffer nil) | |
84 | (completions nil) | |
85 | (cf (selected-frame)) | |
86 | (cnt nil) | |
87 | (mode-local-active-mode nil) | |
88 | ) | |
89 | ;; Try and get some sort of analysis | |
90 | (condition-case nil | |
91 | (progn | |
92 | (speedbar-select-attached-frame) | |
93 | (setq buffer (current-buffer)) | |
94 | (setq mode-local-active-mode major-mode) | |
95 | (save-excursion | |
96 | ;; Get the current scope | |
97 | (setq scope (semantic-calculate-scope (point))) | |
98 | ;; Get the analysis | |
99 | (setq analysis (semantic-analyze-current-context (point))) | |
100 | (setq cnt (semantic-find-tag-by-overlay)) | |
101 | (when analysis | |
102 | (setq completions (semantic-analyze-possible-completions analysis)) | |
103 | ) | |
104 | )) | |
105 | (error nil)) | |
106 | (select-frame cf) | |
0816d744 | 107 | (with-current-buffer speedbar-buffer |
20bfd709 CY |
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: | |
0816d744 | 290 | (with-current-buffer "*Tag Information*" |
20bfd709 CY |
291 | (goto-char (point-max)) |
292 | (insert | |
293 | (semantic-format-tag-prototype tag nil t) | |
294 | "\n") | |
295 | (let ((typetok | |
296 | (condition-case nil | |
0816d744 | 297 | (with-current-buffer ob |
20bfd709 CY |
298 | ;; @todo - We need a context to derive a scope from. |
299 | (semantic-analyze-tag-type tag nil)) | |
300 | (error nil)))) | |
301 | (if typetok | |
302 | (insert (semantic-format-tag-prototype | |
303 | typetok nil t)) | |
304 | ;; No type found by the analyzer | |
305 | ;; The below used to try and select the buffer from the last | |
306 | ;; analysis, but since we are already in the correct buffer, I | |
307 | ;; don't think that is needed. | |
308 | (let ((type (semantic-tag-type tag))) | |
309 | (cond ((semantic-tag-p type) | |
310 | (setq type (semantic-tag-name type))) | |
311 | ((listp type) | |
312 | (setq type (car type)))) | |
313 | (if (semantic-lex-keyword-p type) | |
314 | (setq typetok | |
315 | (semantic-lex-keyword-get type 'summary)))) | |
316 | (if typetok | |
317 | (insert typetok)) | |
318 | )) | |
319 | )) | |
320 | ;; Make it small | |
321 | (shrink-window-if-larger-than-buffer | |
322 | (get-buffer-window "*Tag Information*"))) | |
323 | (select-frame speedbar-frame)))) | |
324 | ||
325 | (defun semantic-ia-sb-line-path (&optional depth) | |
326 | "Return the file name associated with DEPTH." | |
327 | (save-match-data | |
328 | (let* ((tok (speedbar-line-token)) | |
329 | (buff (if (semantic-tag-buffer tok) | |
330 | (semantic-tag-buffer tok) | |
331 | (current-buffer)))) | |
332 | (buffer-file-name buff)))) | |
333 | ||
334 | (defun semantic-ia-sb-complete (text tag indent) | |
335 | "At point in the attached buffer, complete the symbol clicked on. | |
336 | TEXT TAG and INDENT are the details." | |
337 | ;; Find the specified bounds from the current analysis. | |
338 | (speedbar-select-attached-frame) | |
339 | (unwind-protect | |
340 | (let* ((a (semantic-analyze-current-context (point))) | |
341 | (bounds (oref a bounds)) | |
342 | (movepoint nil) | |
343 | ) | |
344 | (save-excursion | |
345 | (if (and (<= (point) (cdr bounds)) (>= (point) (car bounds))) | |
346 | (setq movepoint t)) | |
347 | (goto-char (car bounds)) | |
348 | (delete-region (car bounds) (cdr bounds)) | |
349 | (insert (semantic-tag-name tag)) | |
350 | (if movepoint (setq movepoint (point))) | |
351 | ;; I'd like to use this to add fancy () or what not at the end | |
ee7683eb | 352 | ;; but we need the parent file which requires an upgrade to the |
20bfd709 CY |
353 | ;; analysis tool. |
354 | ;;(semantic-insert-foreign-tag tag ??)) | |
355 | ) | |
356 | (if movepoint | |
357 | (let ((cf (selected-frame))) | |
358 | (speedbar-select-attached-frame) | |
359 | (goto-char movepoint) | |
360 | (select-frame cf)))) | |
361 | (select-frame speedbar-frame))) | |
362 | ||
363 | (provide 'semantic/ia-sb) | |
364 | ||
e076d49f CY |
365 | ;; Local variables: |
366 | ;; generated-autoload-file: "loaddefs.el" | |
e076d49f CY |
367 | ;; generated-autoload-load-name: "semantic/ia-sb" |
368 | ;; End: | |
369 | ||
20bfd709 | 370 | ;;; semantic/ia-sb.el ends here |