Mercurial > emacs
comparison lisp/emacs-lisp/eieio-speedbar.el @ 104431:a64f3429f0ac
emacs-lisp/eieio-base.el, emacs-lisp/eieio-comp.el,
emacs-lisp/eieio-custom.el, emacs-lisp/eieio-datadebug.el,
emacs-lisp/eieio-doc.el, emacs-lisp/eieio-opt.el,
emacs-lisp/eieio-speedbar.el, emacs-lisp/eieio.el: Move from eieio/directory.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Sun, 30 Aug 2009 02:02:15 +0000 |
parents | |
children | bdd443ec02cf |
comparison
equal
deleted
inserted
replaced
104430:b93dbe652ecd | 104431:a64f3429f0ac |
---|---|
1 ;;; eieio-speedbar.el -- Classes for managing speedbar displays. | |
2 | |
3 ;;; Copyright (C) 1999, 2000, 2001, 2002, 2005, 2007, 2008 Free | |
4 ;;; Software Foundation, Inc. | |
5 | |
6 ;; Author: Eric M. Ludlam <zappo@gnu.org> | |
7 ;; Version: 0.2 | |
8 ;; Keywords: OO, tools | |
9 | |
10 ;; This file is part of GNU Emacs. | |
11 | |
12 ;; GNU Emacs is free software: you can redistribute it and/or modify | |
13 ;; it under the terms of the GNU General Public License as published by | |
14 ;; the Free Software Foundation, either version 3 of the License, or | |
15 ;; (at your option) any later version. | |
16 | |
17 ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 ;; GNU General Public License for more details. | |
21 | |
22 ;; You should have received a copy of the GNU General Public License | |
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
24 | |
25 ;;; Commentary: | |
26 ;; | |
27 ;; This provides some classes that can be used as a parent which | |
28 ;; will automatically provide SPEEDBAR support for any list of objects | |
29 ;; of that type. | |
30 ;; | |
31 ;; This file requires speedbar version 0.10 or later. | |
32 | |
33 ;;; Creating a new speedbar mode based on a pre-existing object hierarchy | |
34 ;; | |
35 ;; To create a new speedbar mode based on lists of objects is easier | |
36 ;; than creating a whole new speedbar mode from scratch. | |
37 ;; | |
38 ;; 1) Objects that will have lists of items that can be expanded | |
39 ;; should also inherit from the classes: | |
40 ;; * `eieio-speedbar' - specify your own button behavior | |
41 ;; * `eieio-speedbar-directory-button' - objects that behave like directories | |
42 ;; * `eieio-speedbar-file-button' - objects that behave like files | |
43 ;; | |
44 ;; 2) Objects that have lists of children should implement the method | |
45 ;; `eieio-speedbar-object-children' which returns a list of more | |
46 ;; objects, or a list of strings. | |
47 ;; | |
48 ;; 3) Objects that return a list of strings should also implement these | |
49 ;; methods: | |
50 ;; * `eieio-speedbar-child-make-tag-lines' - make tag lines for a child. | |
51 ;; * `eieio-speedbar-child-description' - describe non-object children | |
52 ;; | |
53 ;; 4) Objects which have expanded information should implement the method | |
54 ;; `eieio-speedbar-description' to produce more information. | |
55 ;; | |
56 ;; 5) Objects that are associated with a directory should implement | |
57 ;; the method `eieio-speedbar-derive-line-path' which returns a | |
58 ;; path. | |
59 ;; | |
60 ;; 6) Objects that have a specialized behavior when clicked should | |
61 ;; define the method `eieio-speedbar-handle-click'. | |
62 ;; | |
63 ;; To initialize a new eieio based speedbar display, do the following. | |
64 ;; | |
65 ;; 1) Create a keymap variable `foo-speedbar-key-map'. | |
66 ;; This keymap variable should be initialized in a function. | |
67 ;; If you have no special needs, use `eieio-speedbar-key-map' | |
68 ;; | |
69 ;; 2) Create a variable containing an easymenu definition compatible | |
70 ;; with speedbar. if you have no special needs, use | |
71 ;; `eieio-speedbar-menu'. | |
72 ;; | |
73 ;; 3) Create a function which returns the top-level list of children | |
74 ;; objects to be displayed in speedbar. | |
75 ;; | |
76 ;; 4) Call `eieio-speedbar-create' as specified in it's documentation | |
77 ;; string. This will automatically handle cases when speedbar is | |
78 ;; not already loaded, and specifying all overload functions. | |
79 ;; | |
80 ;; 5) Create an initliazer function which looks like this: | |
81 ;; | |
82 ;; (defun my-speedbar-mode-initilaize () | |
83 ;; "documentation" | |
84 ;; (interactive) | |
85 ;; (speedbar-frame-mode 1) | |
86 ;; (speedbar-change-initial-expansion-list mymodename) | |
87 ;; (speedbar-get-focus)) | |
88 ;; | |
89 ;; where `mymodename' is the same value as passed to `eieio-speedbar-create' | |
90 ;; as the MODENAME parameter. | |
91 | |
92 ;; @todo - Can we make this ECB friendly? | |
93 | |
94 ;;; Code: | |
95 (require 'eieio) | |
96 (require 'eieio-custom) | |
97 (require 'speedbar) | |
98 | |
99 ;;; Support a way of adding generic object based modes into speedbar. | |
100 ;; | |
101 (defun eieio-speedbar-make-map () | |
102 "Make the generic object based speedbar keymap." | |
103 (let ((map (speedbar-make-specialized-keymap))) | |
104 | |
105 ;; General viewing things | |
106 (define-key map "\C-m" 'speedbar-edit-line) | |
107 (define-key map "+" 'speedbar-expand-line) | |
108 (define-key map "=" 'speedbar-expand-line) | |
109 (define-key map "-" 'speedbar-contract-line) | |
110 | |
111 ;; Some object based things | |
112 (define-key map "C" 'eieio-speedbar-customize-line) | |
113 map)) | |
114 | |
115 (defvar eieio-speedbar-key-map (eieio-speedbar-make-map) | |
116 "A Generic object based speedbar display keymap.") | |
117 | |
118 (defvar eieio-speedbar-menu | |
119 '([ "Edit Object/Field" speedbar-edit-line t] | |
120 [ "Expand Object" speedbar-expand-line | |
121 (save-excursion (beginning-of-line) | |
122 (looking-at "[0-9]+: *.\\+. "))] | |
123 [ "Contract Object" speedbar-contract-line | |
124 (save-excursion (beginning-of-line) | |
125 (looking-at "[0-9]+: *.-. "))] | |
126 "---" | |
127 [ "Customize Object" eieio-speedbar-customize-line | |
128 (eieio-object-p (speedbar-line-token)) ] | |
129 ) | |
130 "Menu part in easymenu format used in speedbar while browsing objects.") | |
131 | |
132 ;; Note to self: Fix this silly thing! | |
133 (defalias 'eieio-speedbar-customize-line 'speedbar-edit-line) | |
134 | |
135 (defun eieio-speedbar-create (map-fn map-var menu-var modename fetcher) | |
136 "Create a speedbar mode for displaying an object hierarchy. | |
137 MAP-FN is the keymap generator function used for extra keys. | |
138 MAP-VAR is the keymap variable used. | |
139 MENU-VAR is the symbol containting an easymenu compatible menu part to use. | |
140 MODENAME is a s tring used to identify this browser mode. | |
141 FETCHER is a generic function used to fetch the base object list used when | |
142 creating the speedbar display." | |
143 (if (not (featurep 'speedbar)) | |
144 (add-hook 'speedbar-load-hook | |
145 (list 'lambda nil | |
146 (list 'eieio-speedbar-create-engine | |
147 map-fn map-var menu-var modename fetcher))) | |
148 (eieio-speedbar-create-engine map-fn map-var menu-var modename fetcher))) | |
149 | |
150 (defun eieio-speedbar-create-engine (map-fn map-var menu-var modename fetcher) | |
151 "Create a speedbar mode for displaying an object hierarchy. | |
152 Called from `eieio-speedbar-create', or the speedbar load-hook. | |
153 MAP-FN, MAP-VAR, MENU-VAR, MODENAME, and FETCHER are the same as | |
154 `eieio-speedbar-create'." | |
155 ;; make sure the keymap exists | |
156 (funcall map-fn) | |
157 ;; Add to the expansion list. | |
158 (speedbar-add-expansion-list | |
159 (list modename | |
160 menu-var | |
161 map-var | |
162 (list 'lambda '(dir depth) | |
163 (list 'eieio-speedbar-buttons 'dir 'depth | |
164 (list 'quote fetcher))))) | |
165 ;; Set the special functions. | |
166 (speedbar-add-mode-functions-list | |
167 (list modename | |
168 '(speedbar-item-info . eieio-speedbar-item-info) | |
169 '(speedbar-line-directory . eieio-speedbar-line-path)))) | |
170 | |
171 (defun eieio-speedbar-buttons (dir-or-object depth fetcher) | |
172 "Create buttons for the speedbar display. | |
173 Start in directory DIR-OR-OBJECT. If it is an object, just display that | |
174 objects subelements. | |
175 Argument DEPTH specifies how far down we have already been displayed. | |
176 If it is a directory, use FETCHER to fetch all objects associated with | |
177 that path." | |
178 (let ((objlst (cond ((eieio-object-p dir-or-object) | |
179 (list dir-or-object)) | |
180 ((stringp dir-or-object) | |
181 (funcall fetcher dir-or-object)) | |
182 (t dir-or-object)))) | |
183 (if (not objlst) | |
184 (speedbar-make-tag-line nil nil nil nil "Empty display" nil nil nil | |
185 depth) | |
186 ;; Dump all objects into speedbar | |
187 (while objlst | |
188 (eieio-speedbar-make-tag-line (car objlst) depth) | |
189 (setq objlst (cdr objlst)))))) | |
190 | |
191 | |
192 ;;; DEFAULT SUPERCLASS baseline methods | |
193 ;; | |
194 ;; First, define methods onto the superclass so all classes | |
195 ;; will have some minor support. | |
196 | |
197 (defmethod eieio-speedbar-description ((object eieio-default-superclass)) | |
198 "Return a string describing OBJECT." | |
199 (object-name-string object)) | |
200 | |
201 (defmethod eieio-speedbar-derive-line-path ((object eieio-default-superclass)) | |
202 "Return the path which OBJECT has something to do with." | |
203 nil) | |
204 | |
205 (defmethod eieio-speedbar-object-buttonname ((object eieio-default-superclass)) | |
206 "Return a string to use as a speedbar button for OBJECT." | |
207 (object-name-string object)) | |
208 | |
209 (defmethod eieio-speedbar-make-tag-line ((object eieio-default-superclass) | |
210 depth) | |
211 "Insert a tag line into speedbar at point for OBJECT. | |
212 By default, all objects appear as simple TAGS with no need to inherit from | |
213 the special `eieio-speedbar' classes. Child classes should redefine this | |
214 method to create more accurate tag lines. | |
215 Argument DEPTH is the depth at which the tag line is inserted." | |
216 (speedbar-make-tag-line nil nil nil nil | |
217 (eieio-speedbar-object-buttonname object) | |
218 'eieio-speedbar-object-click | |
219 object | |
220 'speedbar-tag-face | |
221 depth)) | |
222 | |
223 (defmethod eieio-speedbar-handle-click ((object eieio-default-superclass)) | |
224 "Handle a click action on OBJECT in speedbar. | |
225 Any object can be represented as a tag in SPEEDBAR without special | |
226 attributes. These default objects will be pulled up in a custom | |
227 object edit buffer doing an in-place edit. | |
228 | |
229 If your object represents some other item, override this method | |
230 and take the apropriate action." | |
231 (require 'eieio-custom) | |
232 (speedbar-with-attached-buffer | |
233 (eieio-customize-object object)) | |
234 (speedbar-maybee-jump-to-attached-frame)) | |
235 | |
236 | |
237 ;;; Class definitions | |
238 ;; | |
239 ;; Now define a special speedbar class with some | |
240 ;; variables with :allocation class which can be attached into | |
241 ;; object hierarchies. | |
242 ;; | |
243 ;; These more complex types are for objects which wish to display | |
244 ;; lists of children buttons. | |
245 | |
246 (defclass eieio-speedbar nil | |
247 ((buttontype :initform nil | |
248 :type symbol | |
249 :documentation | |
250 "The type of expansion button used for objects of this class. | |
251 Possible values are those symbols supported by the `exp-button-type' argument | |
252 to `speedbar-make-tag-line'." | |
253 :allocation :class) | |
254 (buttonface :initform speedbar-tag-face | |
255 :type (or symbol face) | |
256 :documentation | |
257 "The face used on the textual part of the button for this class. | |
258 See `speedbar-make-tag-line' for details." | |
259 :allocation :class) | |
260 (expanded :initform nil | |
261 :type boolean | |
262 :documentation | |
263 "State of an object being expanded in speedbar.") | |
264 ) | |
265 "Class which provides basic speedbar support for child classes. | |
266 Add one of thie child classes to this class to the parent list of a class." | |
267 :method-invocation-order :depth-first | |
268 :abstract t) | |
269 | |
270 (defclass eieio-speedbar-directory-button (eieio-speedbar) | |
271 ((buttontype :initform angle) | |
272 (buttonface :initform speedbar-directory-face)) | |
273 "Class providing support for objects which behave like a directory." | |
274 :method-invocation-order :depth-first | |
275 :abstract t) | |
276 | |
277 (defclass eieio-speedbar-file-button (eieio-speedbar) | |
278 ((buttontype :initform bracket) | |
279 (buttonface :initform speedbar-file-face)) | |
280 "Class providing support for objects which behave like a directory." | |
281 :method-invocation-order :depth-first | |
282 :abstract t) | |
283 | |
284 | |
285 ;;; Methods to eieio-speedbar-* which do not need to be overriden | |
286 ;; | |
287 (defmethod eieio-speedbar-make-tag-line ((object eieio-speedbar) | |
288 depth) | |
289 "Insert a tag line into speedbar at point for OBJECT. | |
290 All objects a child of symbol `eieio-speedbar' can be created from this | |
291 method. Override this if you need non-traditional tag lines. | |
292 Argument DEPTH is the depth at which the tag line is inserted." | |
293 (let ((children (eieio-speedbar-object-children object)) | |
294 (exp (oref object expanded))) | |
295 (if (not children) | |
296 (if (eq (oref object buttontype) 'expandtag) | |
297 (speedbar-make-tag-line 'statictag | |
298 ? nil nil | |
299 (eieio-speedbar-object-buttonname object) | |
300 'eieio-speedbar-object-click | |
301 object | |
302 (oref object buttonface) | |
303 depth) | |
304 (speedbar-make-tag-line (oref object buttontype) | |
305 ? nil nil | |
306 (eieio-speedbar-object-buttonname object) | |
307 'eieio-speedbar-object-click | |
308 object | |
309 (oref object buttonface) | |
310 depth)) | |
311 (speedbar-make-tag-line (oref object buttontype) | |
312 (if exp ?- ?+) | |
313 'eieio-speedbar-object-expand | |
314 object | |
315 (eieio-speedbar-object-buttonname object) | |
316 'eieio-speedbar-object-click | |
317 object | |
318 (oref object buttonface) | |
319 depth) | |
320 (if exp | |
321 (eieio-speedbar-expand object (1+ depth)))))) | |
322 | |
323 (defmethod eieio-speedbar-child-make-tag-lines ((object eieio-speedbar) depth) | |
324 "Base method for creating tag lines for non-object children." | |
325 (error "You must implement `eieio-speedbar-child-make-tag-lines' for %s" | |
326 (object-name object))) | |
327 | |
328 (defmethod eieio-speedbar-expand ((object eieio-speedbar) depth) | |
329 "Expand OBJECT at indentation DEPTH. | |
330 Inserts a list of new tag lines representing expanded elements withing | |
331 OBJECT." | |
332 (let ((children (eieio-speedbar-object-children object))) | |
333 (cond ((eieio-object-p (car children)) | |
334 (mapcar (lambda (car) | |
335 (eieio-speedbar-make-tag-line car depth)) | |
336 children)) | |
337 (children (eieio-speedbar-child-make-tag-lines object depth))))) | |
338 | |
339 | |
340 ;;; Speedbar specific function callbacks. | |
341 ;; | |
342 (defun eieio-speedbar-object-click (text token indent) | |
343 "Handle a user click on TEXT representing object TOKEN. | |
344 The object is at indentation level INDENT." | |
345 (eieio-speedbar-handle-click token)) | |
346 | |
347 (defun eieio-speedbar-object-expand (text token indent) | |
348 "Expand object represented by TEXT. TOKEN is the object. | |
349 INDENT is the current indentation level." | |
350 (cond ((string-match "+" text) ;we have to expand this file | |
351 (speedbar-change-expand-button-char ?-) | |
352 (oset token expanded t) | |
353 (speedbar-with-writable | |
354 (save-excursion | |
355 (end-of-line) (forward-char 1) | |
356 (eieio-speedbar-expand token (1+ indent))))) | |
357 ((string-match "-" text) ;we have to contract this node | |
358 (speedbar-change-expand-button-char ?+) | |
359 (oset token expanded nil) | |
360 (speedbar-delete-subblock indent)) | |
361 (t (error "Ooops... not sure what to do"))) | |
362 (speedbar-center-buffer-smartly)) | |
363 | |
364 (defmethod eieio-speedbar-child-description ((obj eieio-speedbar)) | |
365 "Return a description for a child of OBJ which is not an object." | |
366 (error "You must implement `eieio-speedbar-child-description' for %s" | |
367 (object-name obj))) | |
368 | |
369 (defun eieio-speedbar-item-info () | |
370 "Display info for the current line when in EDE display mode." | |
371 ;; Switch across the types of the tokens. | |
372 (let ((tok (speedbar-line-token))) | |
373 (cond ((eieio-object-p tok) | |
374 (message (eieio-speedbar-description tok))) | |
375 (t | |
376 (let ((no (eieio-speedbar-find-nearest-object))) | |
377 (if no | |
378 (eieio-speedbar-child-description no))))))) | |
379 | |
380 (defun eieio-speedbar-find-nearest-object (&optional depth) | |
381 "Search backwards to the first line associated with an object. | |
382 Optional argument DEPTH is the current depth of the search." | |
383 (save-excursion | |
384 (if (not depth) | |
385 (progn | |
386 (beginning-of-line) | |
387 (when (looking-at "^\\([0-9]+\\):") | |
388 (setq depth (string-to-number (match-string 1)))))) | |
389 (when depth | |
390 (while (and (not (eieio-object-p (speedbar-line-token))) | |
391 (> depth 0)) | |
392 (setq depth (1- depth)) | |
393 (re-search-backward (format "^%d:" depth) nil t)) | |
394 (speedbar-line-token)))) | |
395 | |
396 (defun eieio-speedbar-line-path (&optional depth) | |
397 "If applicable, return the path to the file the cursor is on. | |
398 Optional DEPTH is the depth we start at." | |
399 (save-match-data | |
400 (if (not depth) | |
401 (progn | |
402 (beginning-of-line) | |
403 (looking-at "^\\([0-9]+\\):") | |
404 (setq depth (string-to-number (match-string 1))))) | |
405 ;; This whole function is presently bogus. Make it better later. | |
406 (let ((tok (eieio-speedbar-find-nearest-object depth))) | |
407 (if (eieio-object-p tok) | |
408 (eieio-speedbar-derive-line-path tok) | |
409 default-directory)))) | |
410 | |
411 | |
412 ;;; Methods to the eieio-speedbar-* classes which need to be overriden. | |
413 ;; | |
414 (defmethod eieio-speedbar-object-children ((object eieio-speedbar)) | |
415 "Return a list of children to be displayed in SPEEDBAR. | |
416 If the return value is a list of OBJECTs, then those objects are | |
417 queried for details. If the return list is made of strings, | |
418 then this object will be queried for the details needed | |
419 to create a speedbar button." | |
420 nil) | |
421 | |
422 (provide 'eieio-speedbar) | |
423 | |
424 ;;; eieio-speedbar.el ends here |