Commit | Line | Data |
---|---|---|
acc33231 CY |
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 | ||
70702e9b | 337 | ;;;###autoload |
acc33231 CY |
338 | (defun ede-speedbar-file-setup () |
339 | "Setup some keybindings in the Speedbar File display." | |
340 | (setq speedbar-easymenu-definition-special | |
341 | (append speedbar-easymenu-definition-special | |
342 | ede-speedbar-file-menu-additions | |
343 | )) | |
344 | (define-key speedbar-file-key-map "." ede-speedbar-file-keymap) | |
345 | ;; Finally, if the FILES mode is loaded, force a refresh | |
346 | ;; of the menus and such. | |
347 | (when (and (string= speedbar-initial-expansion-list-name "files") | |
348 | (buffer-live-p speedbar-buffer) | |
349 | ) | |
350 | (speedbar-change-initial-expansion-list "files"))) | |
351 | ||
352 | (provide 'ede/speedbar) | |
353 | ||
70702e9b CY |
354 | ;; Local variables: |
355 | ;; generated-autoload-file: "loaddefs.el" | |
356 | ;; generated-autoload-feature: ede/loaddefs | |
357 | ;; generated-autoload-load-name: "ede/speedbar" | |
358 | ;; End: | |
359 | ||
3999968a | 360 | ;; arch-tag: 56721fc9-8eb5-4115-8511-18cf8397ec87 |
acc33231 | 361 | ;;; ede/speedbar.el ends here |