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