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