Mercurial > emacs
comparison lisp/cedet/ede/speedbar.el @ 104496:8c4870c15962
* cedet/ede.el, cedet/ede/*.el: New files.
* cedet/cedet.el: Require ede.
* cedet/semantic/symref/filter.el (semantic-symref-hits-in-region):
Require semantic/idle.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Sun, 20 Sep 2009 15:06:05 +0000 |
parents | |
children | 31e9b85bc047 |
comparison
equal
deleted
inserted
replaced
104495:4659ddbe20bf | 104496:8c4870c15962 |
---|---|
1 ;;; ede/speedbar.el --- Speedbar viewing of EDE projects | |
2 | |
3 ;;; Copyright (C) 1998, 1999, 2000, 2001, 2003, 2005, 2007, 2008, 2009 | |
4 ;;; Free Software Foundation, Inc. | |
5 | |
6 ;; Author: Eric M. Ludlam <zappo@gnu.org> | |
7 ;; Keywords: project, make, tags | |
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 ;; Display a project's hierarchy in speedbar. | |
27 ;; | |
28 | |
29 ;;; Code: | |
30 (require 'speedbar) | |
31 (require 'eieio-speedbar) | |
32 (require 'ede) | |
33 | |
34 ;;; Speedbar support mode | |
35 ;; | |
36 (defvar ede-speedbar-key-map nil | |
37 "A Generic object based speedbar display keymap.") | |
38 | |
39 (defun ede-speedbar-make-map () | |
40 "Make the generic object based speedbar keymap." | |
41 (setq ede-speedbar-key-map (speedbar-make-specialized-keymap)) | |
42 | |
43 ;; General viewing things | |
44 (define-key ede-speedbar-key-map "\C-m" 'speedbar-edit-line) | |
45 (define-key ede-speedbar-key-map "+" 'speedbar-expand-line) | |
46 (define-key ede-speedbar-key-map "=" 'speedbar-expand-line) | |
47 (define-key ede-speedbar-key-map "-" 'speedbar-contract-line) | |
48 (define-key ede-speedbar-key-map " " 'speedbar-toggle-line-expansion) | |
49 | |
50 ;; Some object based things | |
51 (define-key ede-speedbar-key-map "C" 'eieio-speedbar-customize-line) | |
52 | |
53 ;; Some project based things | |
54 (define-key ede-speedbar-key-map "R" 'ede-speedbar-remove-file-from-target) | |
55 (define-key ede-speedbar-key-map "b" 'ede-speedbar-compile-line) | |
56 (define-key ede-speedbar-key-map "B" 'ede-speedbar-compile-project) | |
57 (define-key ede-speedbar-key-map "D" 'ede-speedbar-make-distribution) | |
58 (define-key ede-speedbar-key-map "E" 'ede-speedbar-edit-projectfile) | |
59 ) | |
60 | |
61 (defvar ede-speedbar-menu | |
62 '([ "Compile" ede-speedbar-compile-line t] | |
63 [ "Compile Project" ede-speedbar-compile-project | |
64 (ede-project-child-p (speedbar-line-token)) ] | |
65 "---" | |
66 [ "Edit File/Tag" speedbar-edit-line | |
67 (not (eieio-object-p (speedbar-line-token)))] | |
68 [ "Expand" speedbar-expand-line | |
69 (save-excursion (beginning-of-line) | |
70 (looking-at "[0-9]+: *.\\+. "))] | |
71 [ "Contract" speedbar-contract-line | |
72 (save-excursion (beginning-of-line) | |
73 (looking-at "[0-9]+: *.-. "))] | |
74 "---" | |
75 [ "Remove File from Target" ede-speedbar-remove-file-from-target | |
76 (stringp (speedbar-line-token)) ] | |
77 [ "Customize Project/Target" eieio-speedbar-customize-line | |
78 (eieio-object-p (speedbar-line-token)) ] | |
79 [ "Edit Project File" ede-speedbar-edit-projectfile t] | |
80 [ "Make Distribution" ede-speedbar-make-distribution | |
81 (ede-project-child-p (speedbar-line-token)) ] | |
82 ) | |
83 "Menu part in easymenu format used in speedbar while browsing objects.") | |
84 | |
85 (eieio-speedbar-create 'ede-speedbar-make-map | |
86 'ede-speedbar-key-map | |
87 'ede-speedbar-menu | |
88 "Project" | |
89 'ede-speedbar-toplevel-buttons) | |
90 | |
91 | |
92 (defun ede-speedbar () | |
93 "EDE development environment project browser for speedbar." | |
94 (interactive) | |
95 (speedbar-frame-mode 1) | |
96 (speedbar-change-initial-expansion-list "Project") | |
97 (speedbar-get-focus) | |
98 ) | |
99 | |
100 (defun ede-speedbar-toplevel-buttons (dir) | |
101 "Return a list of objects to display in speedbar. | |
102 Argument DIR is the directory from which to derive the list of objects." | |
103 ede-projects | |
104 ) | |
105 | |
106 ;;; Some special commands useful in EDE | |
107 ;; | |
108 (defun ede-speedbar-remove-file-from-target () | |
109 "Remove the file at point from it's target." | |
110 (interactive) | |
111 (if (stringp (speedbar-line-token)) | |
112 (progn | |
113 (speedbar-edit-line) | |
114 (ede-remove-file)))) | |
115 | |
116 (defun ede-speedbar-compile-line () | |
117 "Compile/Build the project or target on this line." | |
118 (interactive) | |
119 (let ((obj (eieio-speedbar-find-nearest-object))) | |
120 (if (not (eieio-object-p obj)) | |
121 nil | |
122 (cond ((obj-of-class-p obj ede-project) | |
123 (project-compile-project obj)) | |
124 ((obj-of-class-p obj ede-target) | |
125 (project-compile-target obj)) | |
126 (t (error "Error in speedbar structure")))))) | |
127 | |
128 (defun ede-speedbar-get-top-project-for-line () | |
129 "Return a project object for this line." | |
130 (interactive) | |
131 (let ((obj (eieio-speedbar-find-nearest-object))) | |
132 (if (not (eieio-object-p obj)) | |
133 (error "Error in speedbar or ede structure") | |
134 (if (obj-of-class-p obj ede-target) | |
135 (setq obj (ede-target-parent obj))) | |
136 (if (obj-of-class-p obj ede-project) | |
137 obj | |
138 (error "Error in speedbar or ede structure"))))) | |
139 | |
140 (defun ede-speedbar-compile-project () | |
141 "Compile/Build the project which owns this line." | |
142 (interactive) | |
143 (project-compile-project (ede-speedbar-get-top-project-for-line))) | |
144 | |
145 (defun ede-speedbar-compile-file-project () | |
146 "Compile/Build the target which the current file belongs to." | |
147 (interactive) | |
148 (let* ((file (speedbar-line-file)) | |
149 (buf (find-file-noselect file)) | |
150 (bwin (get-buffer-window buf 0))) | |
151 (if bwin | |
152 (progn | |
153 (select-window bwin) | |
154 (raise-frame (window-frame bwin))) | |
155 (dframe-select-attached-frame speedbar-frame) | |
156 (set-buffer buf) | |
157 (ede-compile-target)))) | |
158 | |
159 (defun ede-speedbar-make-distribution () | |
160 "Edit the project file based on this line." | |
161 (interactive) | |
162 (project-make-dist (ede-speedbar-get-top-project-for-line))) | |
163 | |
164 (defun ede-speedbar-edit-projectfile () | |
165 "Edit the project file based on this line." | |
166 (interactive) | |
167 (project-edit-file-target (ede-speedbar-get-top-project-for-line))) | |
168 | |
169 ;;; Speedbar Project Methods | |
170 ;; | |
171 (defun ede-find-nearest-file-line () | |
172 "Go backwards until we find a file." | |
173 (save-excursion | |
174 (beginning-of-line) | |
175 (looking-at "^\\([0-9]+\\):") | |
176 (let ((depth (string-to-number (match-string 1)))) | |
177 (while (not (re-search-forward "[]] [^ ]" | |
178 (save-excursion (end-of-line) | |
179 (point)) | |
180 t)) | |
181 (re-search-backward (format "^%d:" (1- depth))) | |
182 (setq depth (1- depth))) | |
183 (speedbar-line-token)))) | |
184 | |
185 (defmethod eieio-speedbar-derive-line-path ((obj ede-project) &optional depth) | |
186 "Return the path to OBJ. | |
187 Optional DEPTH is the depth we start at." | |
188 (file-name-directory (oref obj file)) | |
189 ) | |
190 | |
191 (defmethod eieio-speedbar-derive-line-path ((obj ede-target) &optional depth) | |
192 "Return the path to OBJ. | |
193 Optional DEPTH is the depth we start at." | |
194 (let ((proj (ede-target-parent obj))) | |
195 ;; Check the type of line we are currently on. | |
196 ;; If we are on a child, we need a file name too. | |
197 (save-excursion | |
198 (let ((lt (speedbar-line-token))) | |
199 (if (or (eieio-object-p lt) (stringp lt)) | |
200 (eieio-speedbar-derive-line-path proj) | |
201 ;; a child element is a token. Do some work to get a filename too. | |
202 (concat (eieio-speedbar-derive-line-path proj) | |
203 (ede-find-nearest-file-line))))))) | |
204 | |
205 (defmethod eieio-speedbar-description ((obj ede-project)) | |
206 "Provide a speedbar description for OBJ." | |
207 (ede-description obj)) | |
208 | |
209 (defmethod eieio-speedbar-description ((obj ede-target)) | |
210 "Provide a speedbar description for OBJ." | |
211 (ede-description obj)) | |
212 | |
213 (defmethod eieio-speedbar-child-description ((obj ede-target)) | |
214 "Provide a speedbar description for a plain-child of OBJ. | |
215 A plain child is a child element which is not an EIEIO object." | |
216 (or (speedbar-item-info-file-helper) | |
217 (speedbar-item-info-tag-helper))) | |
218 | |
219 (defmethod eieio-speedbar-object-buttonname ((object ede-project)) | |
220 "Return a string to use as a speedbar button for OBJECT." | |
221 (if (ede-parent-project object) | |
222 (ede-name object) | |
223 (concat (ede-name object) " " (oref object version)))) | |
224 | |
225 (defmethod eieio-speedbar-object-buttonname ((object ede-target)) | |
226 "Return a string to use as a speedbar button for OBJECT." | |
227 (ede-name object)) | |
228 | |
229 (defmethod eieio-speedbar-object-children ((this ede-project)) | |
230 "Return the list of speedbar display children for THIS." | |
231 (condition-case nil | |
232 (with-slots (subproj targets) this | |
233 (append subproj targets)) | |
234 (error nil))) | |
235 | |
236 (defmethod eieio-speedbar-object-children ((this ede-target)) | |
237 "Return the list of speedbar display children for THIS." | |
238 (oref this source)) | |
239 | |
240 (defmethod eieio-speedbar-child-make-tag-lines ((this ede-target) depth) | |
241 "Create a speedbar tag line for a child of THIS. | |
242 It has depth DEPTH." | |
243 (with-slots (source) this | |
244 (mapcar (lambda (car) | |
245 (speedbar-make-tag-line 'bracket ?+ | |
246 'speedbar-tag-file | |
247 car | |
248 car | |
249 'ede-file-find | |
250 car | |
251 'speedbar-file-face depth)) | |
252 source))) | |
253 | |
254 ;;; Generic file management for TARGETS | |
255 ;; | |
256 (defun ede-file-find (text token indent) | |
257 "Find the file TEXT at path TOKEN. | |
258 INDENT is the current indentation level." | |
259 (speedbar-find-file-in-frame | |
260 (expand-file-name token (speedbar-line-directory indent))) | |
261 (speedbar-maybee-jump-to-attached-frame)) | |
262 | |
263 (defun ede-create-tag-buttons (filename indent) | |
264 "Create the tag buttons associated with FILENAME at INDENT." | |
265 (let* ((lst (speedbar-fetch-dynamic-tags filename))) | |
266 ;; if no list, then remove expando button | |
267 (if (not lst) | |
268 (speedbar-change-expand-button-char ??) | |
269 (speedbar-with-writable | |
270 ;; We must do 1- because indent was already incremented. | |
271 (speedbar-insert-generic-list (1- indent) | |
272 lst | |
273 'ede-tag-expand | |
274 'ede-tag-find))))) | |
275 | |
276 (defun ede-tag-expand (text token indent) | |
277 "Expand a tag sublist. Imenu will return sub-lists of specialized tag types. | |
278 Etags does not support this feature. TEXT will be the button | |
279 string. TOKEN will be the list, and INDENT is the current indentation | |
280 level." | |
281 (cond ((string-match "+" text) ;we have to expand this file | |
282 (speedbar-change-expand-button-char ?-) | |
283 (speedbar-with-writable | |
284 (save-excursion | |
285 (end-of-line) (forward-char 1) | |
286 (speedbar-insert-generic-list indent token | |
287 'ede-tag-expand | |
288 'ede-tag-find)))) | |
289 ((string-match "-" text) ;we have to contract this node | |
290 (speedbar-change-expand-button-char ?+) | |
291 (speedbar-delete-subblock indent)) | |
292 (t (error "Ooops... not sure what to do"))) | |
293 (speedbar-center-buffer-smartly)) | |
294 | |
295 (defun ede-tag-find (text token indent) | |
296 "For the tag TEXT in a file TOKEN, goto that position. | |
297 INDENT is the current indentation level." | |
298 (let ((file (ede-find-nearest-file-line))) | |
299 (speedbar-find-file-in-frame file) | |
300 (save-excursion (speedbar-stealthy-updates)) | |
301 ;; Reset the timer with a new timeout when cliking a file | |
302 ;; in case the user was navigating directories, we can cancel | |
303 ;; that other timer. | |
304 ; (speedbar-set-timer speedbar-update-speed) | |
305 (goto-char token) | |
306 (run-hooks 'speedbar-visiting-tag-hook) | |
307 ;;(recenter) | |
308 (speedbar-maybee-jump-to-attached-frame) | |
309 )) | |
310 | |
311 ;;; EDE and the speedbar FILE display | |
312 ;; | |
313 ;; This will add a couple keybindings and menu items into the | |
314 ;; FILE display for speedbar. | |
315 | |
316 (defvar ede-speedbar-file-menu-additions | |
317 '("----" | |
318 ["Create EDE Target" ede-new-target (ede-current-project) ] | |
319 ["Add to project" ede-speedbar-file-add-to-project (ede-current-project) ] | |
320 ["Compile project" ede-speedbar-compile-project (ede-current-project) ] | |
321 ["Compile file target" ede-speedbar-compile-file-target (ede-current-project) ] | |
322 ["Make distribution" ede-make-dist (ede-current-project) ] | |
323 ) | |
324 "Set of menu items to splice into the speedbar menu.") | |
325 | |
326 (defvar ede-speedbar-file-keymap | |
327 (let ((km (make-sparse-keymap))) | |
328 (define-key km "a" 'ede-speedbar-file-add-to-project) | |
329 (define-key km "t" 'ede-new-target) | |
330 (define-key km "s" 'ede-speedbar) | |
331 (define-key km "C" 'ede-speedbar-compile-project) | |
332 (define-key km "c" 'ede-speedbar-compile-file-target) | |
333 (define-key km "d" 'ede-make-dist) | |
334 km) | |
335 "Keymap spliced into the speedbar keymap.") | |
336 | |
337 (defun ede-speedbar-file-setup () | |
338 "Setup some keybindings in the Speedbar File display." | |
339 (setq speedbar-easymenu-definition-special | |
340 (append speedbar-easymenu-definition-special | |
341 ede-speedbar-file-menu-additions | |
342 )) | |
343 (define-key speedbar-file-key-map "." ede-speedbar-file-keymap) | |
344 ;; Finally, if the FILES mode is loaded, force a refresh | |
345 ;; of the menus and such. | |
346 (when (and (string= speedbar-initial-expansion-list-name "files") | |
347 (buffer-live-p speedbar-buffer) | |
348 ) | |
349 (speedbar-change-initial-expansion-list "files"))) | |
350 | |
351 (provide 'ede/speedbar) | |
352 | |
353 ;;; ede/speedbar.el ends here |