|
100
|
1 ;;; speedbar - quick access to files and tags
|
|
|
2 ;;;
|
|
|
3 ;;; Copyright (C) 1996 Eric M. Ludlam
|
|
|
4 ;;;
|
|
|
5 ;;; Author: Eric M. Ludlam <zappo@gnu.ai.mit.edu>
|
|
|
6 ;;; RCS: $Id: speedbar.el,v 1.1 1997/02/17 06:40:14 steve Exp $
|
|
|
7 ;;; Version: 0.3.1
|
|
|
8 ;;; Keywords: file, tags, tools
|
|
|
9 ;;;
|
|
|
10 ;;; This program 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 2, or (at your option)
|
|
|
13 ;;; any later version.
|
|
|
14 ;;;
|
|
|
15 ;;; This program 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 this program; if not, you can either send email to this
|
|
|
22 ;;; program's author (see below) or write to:
|
|
|
23 ;;;
|
|
|
24 ;;; The Free Software Foundation, Inc.
|
|
|
25 ;;; 675 Mass Ave.
|
|
|
26 ;;; Cambridge, MA 02139, USA.
|
|
|
27 ;;;
|
|
|
28 ;;; Please send bug reports, etc. to zappo@gnu.ai.mit.edu.
|
|
|
29 ;;;
|
|
|
30
|
|
|
31 ;;; Commentary:
|
|
|
32 ;;;
|
|
|
33 ;;; The speedbar provides a frame in which files, and locations in
|
|
|
34 ;;; files are displayed. These items can be clicked on with mouse-2
|
|
|
35 ;;; in order to make the last active frame display that file location.
|
|
|
36 ;;;
|
|
|
37 ;;; If you want to choose it from a menu or something, do this:
|
|
|
38 ;;;
|
|
|
39 ;;; (autoload 'speedbar-frame-mode "speedbar" "Popup a speedbar frame" t)
|
|
|
40 ;;; (define-key-after (lookup-key global-map [menu-bar tools])
|
|
|
41 ;;; [speedbar] '("Speedbar" . speedbar-frame-mode) [calendar])
|
|
|
42 ;;;
|
|
|
43 ;;; To activate speedbar without the menu, type: M-x speedbar-frame-mode RET
|
|
|
44 ;;;
|
|
|
45 ;;; Once a speedbar frame is active, it takes advantage of idle time
|
|
|
46 ;;; to keep it's contents updated. The contents is usually a list of
|
|
|
47 ;;; files in the directory of the currently active buffer. When
|
|
|
48 ;;; applicable, tags in the active file can be expanded.
|
|
|
49 ;;;
|
|
|
50 ;;; Speedbar uses multiple methods for creating tags to jump to.
|
|
|
51 ;;; When the variable `speedbar-use-imenu-package' is set, then
|
|
|
52 ;;; speedbar will first try to use imenu to get tags. If the mode of
|
|
|
53 ;;; the buffer doesn't support imenu, then etags is used. Using Imenu
|
|
|
54 ;;; has the advantage that tags are cached, so opening and closing
|
|
|
55 ;;; tags lists is faster. Speedbar-imenu will also load the file into
|
|
|
56 ;;; a non-selected buffer so clicking the file later will be faster.
|
|
|
57 ;;;
|
|
|
58 ;;; To add new files types into the speedbar, modify
|
|
|
59 ;;; `speedbar-file-regexp' to include the extension of the file type
|
|
|
60 ;;; you wish to include. If speedbar complains that the file type is
|
|
|
61 ;;; not supported, that means there is no built in support from imenu,
|
|
|
62 ;;; and the etags part wasn't set up right.
|
|
|
63 ;;;
|
|
|
64 ;;; To add new file types to imenu, see the documentation in the
|
|
|
65 ;;; file imenu.el that comes with emacs. To add new file types which
|
|
|
66 ;;; etags supports, you need to modify the variable
|
|
|
67 ;;; `speedbar-fetch-etags-parse-list'. This variable is an
|
|
|
68 ;;; association list with each element of the form: (extension-regex
|
|
|
69 ;;; . parse-one-line) The extension-regex would be something like
|
|
|
70 ;;; "\\.c$" for a .c file, and the parse-one-line would be either a
|
|
|
71 ;;; regular expression where match tag 1 is the element you wish
|
|
|
72 ;;; displayed as a tag. If you need to do something more complex,
|
|
|
73 ;;; then you can also write a function which parses one line, and put
|
|
|
74 ;;; its symbol there instead.
|
|
|
75 ;;;
|
|
|
76 ;;; If the updates are going to slow for you, modify the variable
|
|
|
77 ;;; `speedbar-update-speed' to a longer idle time before updates.
|
|
|
78 ;;;
|
|
|
79 ;;; If you navigate directories, you will probably notice that you
|
|
|
80 ;;; will navigate to a directory which is eventually replaced after
|
|
|
81 ;;; you go back to editing a file (unless you pull up a new file.)
|
|
|
82 ;;; The delay time before this happens is in
|
|
|
83 ;;; `speedbar-navigating-speed', and defaults to 20 seconds.
|
|
|
84 ;;;
|
|
|
85 ;;; XEmacs users may want to change the default timeouts for
|
|
|
86 ;;; `speedbar-update-speed' to something longer as XEmacs doesn't have
|
|
|
87 ;;; idle timers, the speedbar timer keeps going off arbitrarilly while
|
|
|
88 ;;; you're typing. It's quite pesky.
|
|
|
89 ;;;
|
|
|
90 ;;; To get speedbar-configure-faces to work, you will need to
|
|
|
91 ;;; download my eieio package from my ftp site.
|
|
|
92 ;;;
|
|
|
93 ;;; EIEIO is NOT required when using speedbar. It is ONLY needed
|
|
|
94 ;;; if you want to use a fancy dialog face editor for speedbar.
|
|
|
95
|
|
|
96 ;;; Speedbar updates can be found at:
|
|
|
97 ;;; ftp://ftp.ultranet.com/pub/zappo/speedbar.*.el
|
|
|
98 ;;;
|
|
|
99
|
|
|
100 ;;; HISTORY:
|
|
|
101 ;;; 0.1 Initial Revision
|
|
|
102 ;;; 0.2 Fixed problem with x-pointer-shape causing future frames not
|
|
|
103 ;;; to be created.
|
|
|
104 ;;; Fixed annoying habit of `speedbar-update-contents' to make
|
|
|
105 ;;; it possible to accidentally kill the speedbar buffer.
|
|
|
106 ;;; Clicking directory names now only changes the contents of
|
|
|
107 ;;; the speedbar, and does not cause a dired mode to appear.
|
|
|
108 ;;; Clicking the <+> next to the directory does cause dired to
|
|
|
109 ;;; be run.
|
|
|
110 ;;; Added XEmacs support, which means timer support moved to a
|
|
|
111 ;;; platform independant call.
|
|
|
112 ;;; Added imenu support. Now modes are supported by imenu
|
|
|
113 ;;; first, and etags only if the imenu call doesn't work.
|
|
|
114 ;;; Imenu is a little faster than etags, and is more emacs
|
|
|
115 ;;; friendly.
|
|
|
116 ;;; Added more user control variables described in the commentary.
|
|
|
117 ;;; Added smart recentering when nodes are opened and closed.
|
|
|
118 ;;; 0.3 x-pointer-shape fixed for emacs 19.35, so I put that check in.
|
|
|
119 ;;; Added invisible codes to the beginning of each line.
|
|
|
120 ;;; Added list aproach to node expansion for easier addition of new
|
|
|
121 ;;; types of things to expand by
|
|
|
122 ;;; Added multi-level path name support
|
|
|
123 ;;; Added multi-level tag name support.
|
|
|
124 ;;; Only mouse-2 is now used for node expansion
|
|
|
125 ;;; Added keys e + - to edit expand, and contract node lines
|
|
|
126 ;;; Added longer legal file regexp for all those modes which support
|
|
|
127 ;;; imenu. (pascal, fortran90, ada, pearl)
|
|
|
128 ;;; Fixed centering algorithm
|
|
|
129 ;;; Tried to choose background independent colors. Made more robust.
|
|
|
130 ;;; Rearranged code into a more logical order
|
|
|
131 ;;; 0.3.1 Fixed doc & broken keybindings
|
|
|
132 ;;; Added mode hooks.
|
|
|
133 ;;; Improved color selection to be background mode smart
|
|
|
134 ;;; `nil' passed to `speedbar-frame-mode' now toggles the frame as
|
|
|
135 ;;; advertised in the doc string
|
|
|
136 ;;;
|
|
|
137 ;;; TODO:
|
|
|
138 ;;; 1) Rember contents of directories when leaving them so it's faster
|
|
|
139 ;;; when returning.
|
|
|
140 ;;; 2) List of directories to never visit. (User might be browsing
|
|
|
141 ;;; there temporarilly such as info files, documentation and the
|
|
|
142 ;;; like)
|
|
|
143 ;;; 3) Implement SHIFT-mouse2 to rescan buffers with imenu.
|
|
|
144 ;;; 4) Better XEmacs support of menus and button-bar
|
|
|
145 ;;; 5) More functions to create buttons and options
|
|
|
146 ;;; 6) filtering algoritms to reduce the number of tags/files
|
|
|
147 ;;; displayed.
|
|
|
148 ;;; 7) Build `speedbar-file-regexp' on the fly.
|
|
|
149 ;;; 8) More intelligent current file highlighting.
|
|
|
150
|
|
|
151 (defvar speedbar-xemacsp (string-match "XEmacs" emacs-version))
|
|
|
152
|
|
|
153 (defvar speedbar-initial-expansion-list
|
|
|
154 '(speedbar-directory-buttons speedbar-default-directory-list)
|
|
|
155 "*List of functions to call to fill in the speedbar buffer whenever
|
|
|
156 a top level update is issued. These functions will allways get the
|
|
|
157 default directory to use passed in as the first parameter, and a 0 as
|
|
|
158 the second parameter. They must assume that the cursor is at the
|
|
|
159 postion where they start inserting buttons.")
|
|
|
160
|
|
|
161 (defvar speedbar-show-unknown-files nil
|
|
|
162 "*Non-nil shows files with a ? in the expansion tag for files we can't
|
|
|
163 expand. `nil' means don't show the file in the list.")
|
|
|
164
|
|
|
165 ;; Xemacs timers aren't based on idleness. Therefore tune it down a little
|
|
|
166 ;; or suffer mightilly!
|
|
|
167 (defvar speedbar-update-speed (if speedbar-xemacsp 5 1)
|
|
|
168 "*Time in seconds of idle time needed before speedbar will update
|
|
|
169 it's buffer to match what you've been doing in your other frame.")
|
|
|
170 (defvar speedbar-navigating-speed 10
|
|
|
171 "*Idle time to wait before re-running the timer proc to pick up any new
|
|
|
172 activity if the user has started navigating directories in the speedbar.")
|
|
|
173
|
|
|
174 (defvar speedbar-width 20
|
|
|
175 "*Initial size of the speedbar window")
|
|
|
176
|
|
|
177 (defvar speedbar-scrollbar-width 10
|
|
|
178 "*Initial sizeo of the speedbar scrollbar. The thinner, the more
|
|
|
179 display room you will have.")
|
|
|
180
|
|
|
181 (defvar speedbar-raise-lower t
|
|
|
182 "*Non-nil means speedbar will auto raise and lower itself. When this
|
|
|
183 is set, you can have only a tiny strip visible under your main emacs,
|
|
|
184 and it will raise and lower itself when you put the pointer in it.")
|
|
|
185
|
|
|
186 (defvar speedbar-use-imenu-package (not speedbar-xemacsp)
|
|
|
187 "*Optionally use the imenu package instead of etags for parsing. This
|
|
|
188 is experimental for performace testing.")
|
|
|
189
|
|
|
190 (defvar speedbar-before-delete-hook nil
|
|
|
191 "*Hooks called before deletiing the speedbar frame.")
|
|
|
192
|
|
|
193 (defvar speedbar-mode-hook nil
|
|
|
194 "*Hooks called after creating a speedbar buffer")
|
|
|
195
|
|
|
196 (defvar speedbar-timer-hook nil
|
|
|
197 "*Hooks called after running the speedbar timer function")
|
|
|
198
|
|
|
199 (defvar speedbar-file-unshown-regexp
|
|
|
200 (let ((nstr "") (noext completion-ignored-extensions))
|
|
|
201 (while noext
|
|
|
202 (setq nstr (concat nstr (regexp-quote (car noext)) "$"
|
|
|
203 (if (cdr noext) "\\|" ""))
|
|
|
204 noext (cdr noext)))
|
|
|
205 (concat nstr "\\|#[^#]+#$\\|\\.\\.?$"))
|
|
|
206 "*Regular expression matching files we don't want to display in a
|
|
|
207 speedbar buffer")
|
|
|
208
|
|
|
209 (defvar speedbar-file-regexp
|
|
|
210 (if speedbar-use-imenu-package
|
|
|
211 "\\(\\.\\([CchH]\\|c\\(++\\|pp\\)\\|f90\\|ada\\|pl?\\|el\\|t\\(ex\\(i\\(nfo\\)?\\)?\\|cl\\)\\|emacs\\)$\\)\\|[Mm]akefile\\(\\.in\\)?"
|
|
|
212 "\\.\\([CchH]\\|c\\(++\\|pp\\)\\|p\\|el\\|tex\\(i\\(nfo\\)?\\)?\\|emacs\\)$")
|
|
|
213 "*Regular expresson matching files we know how to expand.")
|
|
|
214
|
|
|
215 (defvar speedbar-syntax-table nil
|
|
|
216 "Syntax-table used on the speedbar")
|
|
|
217
|
|
|
218 (if speedbar-syntax-table
|
|
|
219 nil
|
|
|
220 (setq speedbar-syntax-table (make-syntax-table))
|
|
|
221 ;; turn off paren matching around here.
|
|
|
222 (modify-syntax-entry ?\' " " speedbar-syntax-table)
|
|
|
223 (modify-syntax-entry ?\" " " speedbar-syntax-table)
|
|
|
224 (modify-syntax-entry ?( " " speedbar-syntax-table)
|
|
|
225 (modify-syntax-entry ?) " " speedbar-syntax-table)
|
|
|
226 (modify-syntax-entry ?[ " " speedbar-syntax-table)
|
|
|
227 (modify-syntax-entry ?] " " speedbar-syntax-table))
|
|
|
228
|
|
|
229
|
|
|
230 (defvar speedbar-key-map nil
|
|
|
231 "Keymap used in speedbar buffer.")
|
|
|
232 (defvar speedbar-menu-map nil
|
|
|
233 "Keymap used in speedbar menu buffer.")
|
|
|
234
|
|
|
235 (if speedbar-key-map
|
|
|
236 nil
|
|
|
237 (setq speedbar-key-map (make-keymap))
|
|
|
238 (suppress-keymap speedbar-key-map t)
|
|
|
239
|
|
|
240 (define-key speedbar-key-map "e" 'speedbar-edit-line)
|
|
|
241 (define-key speedbar-key-map "+" 'speedbar-expand-line)
|
|
|
242 (define-key speedbar-key-map "-" 'speedbar-contract-line)
|
|
|
243
|
|
|
244 (if (string-match "XEmacs" emacs-version)
|
|
|
245 (progn
|
|
|
246 ;; bind mouse bindings so we can manipulate the items on each line
|
|
|
247 (define-key speedbar-key-map 'button2 'speedbar-click)
|
|
|
248
|
|
|
249 ;; Xemacs users. You probably want your own toolbar for
|
|
|
250 ;; the speedbar frame or mode or whatever. Make some buttons
|
|
|
251 ;; and mail me how to do it!
|
|
|
252 ;; Also, how do you disable all those menu items? Email me that too
|
|
|
253 ;; as it would be most helpful.
|
|
|
254 )
|
|
|
255 ;; bind mouse bindings so we can manipulate the items on each line
|
|
|
256 (define-key speedbar-key-map [mouse-2] 'speedbar-click)
|
|
|
257 (define-key speedbar-key-map [down-mouse-2] 'speedbar-quick-mouse)
|
|
|
258
|
|
|
259 ;; this was meant to do a rescan or something
|
|
|
260 ;;(define-key speedbar-key-map [shift-mouse-2] 'speedbar-hard-click)
|
|
|
261
|
|
|
262 ;; disable all menus - we don't have a lot of space to play with
|
|
|
263 ;; in such a skinny frame.
|
|
|
264 (define-key speedbar-key-map [menu-bar buffer] 'undefined)
|
|
|
265 (define-key speedbar-key-map [menu-bar files] 'undefined)
|
|
|
266 (define-key speedbar-key-map [menu-bar tools] 'undefined)
|
|
|
267 (define-key speedbar-key-map [menu-bar edit] 'undefined)
|
|
|
268 (define-key speedbar-key-map [menu-bar search] 'undefined)
|
|
|
269 (define-key speedbar-key-map [menu-bar help-menu] 'undefined)
|
|
|
270
|
|
|
271 ;; This lets the user scroll as if we had a scrollbar... well maybe not
|
|
|
272 (define-key speedbar-key-map [mode-line mouse-2] 'speedbar-mouse-hscroll)
|
|
|
273
|
|
|
274 ;; Create a menu for speedbar
|
|
|
275 (setq speedbar-menu-map (make-sparse-keymap))
|
|
|
276 (define-key speedbar-key-map [menu-bar speedbar]
|
|
|
277 (cons "Speedbar" speedbar-menu-map))
|
|
|
278 (define-key speedbar-menu-map [close]
|
|
|
279 (cons "Close" 'speedbar-close-frame))
|
|
|
280 (define-key speedbar-menu-map [clonfigure]
|
|
|
281 (cons "Configure Faces" 'speedbar-configure-faces))
|
|
|
282 (define-key speedbar-menu-map [configopt]
|
|
|
283 (cons "Configure Options" 'speedbar-configure-options))
|
|
|
284 (define-key speedbar-menu-map [Update]
|
|
|
285 (cons "Update" 'speedbar-update-contents))
|
|
|
286 ))
|
|
|
287
|
|
|
288 (put 'speedbar-configure-faces 'menu-enable '(featurep 'dialog))
|
|
|
289 (put 'speedbar-configure-options 'menu-enable '(featurep 'dialog))
|
|
|
290
|
|
|
291 (defvar speedbar-buffer nil
|
|
|
292 "The buffer displaying the speedbar.")
|
|
|
293 (defvar speedbar-frame nil
|
|
|
294 "The frame displaying speedbar.")
|
|
|
295 (defvar speedbar-timer nil
|
|
|
296 "The speedbar timer used for updating the buffer.")
|
|
|
297 (defvar speedbar-attached-frame nil
|
|
|
298 "The frame which started speedbar mode. This is the frame from
|
|
|
299 which all data displayed in the speedbar is gathered, and in which files
|
|
|
300 and such are displayed.")
|
|
|
301
|
|
|
302 (defvar speedbar-last-selected-file nil
|
|
|
303 "The last file which was selected in speedbar buffer")
|
|
|
304
|
|
|
305 (defvar speedbar-shown-directories nil
|
|
|
306 "Used to maintain list of directories simultaneously open in the current
|
|
|
307 speedbar.")
|
|
|
308
|
|
|
309
|
|
|
310 ;;;
|
|
|
311 ;;; Mode definitions/ user commands
|
|
|
312 ;;;
|
|
|
313 ;;;###autoload
|
|
|
314 (defun speedbar-frame-mode (&optional arg)
|
|
|
315 "Enable or disable use of a speedbar. Positive number means turn
|
|
|
316 on, negative turns speedbar off, and nil means toggle. Once the
|
|
|
317 speedbar frame is activated, a buffer in `speedbar-mode' will be
|
|
|
318 displayed. Currently, only one speedbar is supported at a time."
|
|
|
319 (interactive "P")
|
|
|
320 (if (not window-system)
|
|
|
321 (error "Speedbar is not useful outside of a windowing environement"))
|
|
|
322 ;; toggle frame on and off.
|
|
|
323 (if (not arg) (if speedbar-frame (setq arg -1) (setq arg 1)))
|
|
|
324 ;; turn the frame off on neg number
|
|
|
325 (if (and (numberp arg) (< arg 0))
|
|
|
326 (progn
|
|
|
327 (run-hooks 'speedbar-before-delete-hook)
|
|
|
328 (if (and speedbar-frame (frame-live-p speedbar-frame))
|
|
|
329 (delete-frame speedbar-frame))
|
|
|
330 (speedbar-set-timer nil)
|
|
|
331 (setq speedbar-frame nil)
|
|
|
332 (if (bufferp speedbar-buffer)
|
|
|
333 (kill-buffer speedbar-buffer)))
|
|
|
334 ;; Set this as our currently attached frame
|
|
|
335 (setq speedbar-attached-frame (selected-frame))
|
|
|
336 ;; Get the buffer to play with
|
|
|
337 (speedbar-mode)
|
|
|
338 ;; Get the frame to work in
|
|
|
339 (if (and speedbar-frame (frame-live-p speedbar-frame))
|
|
|
340 (raise-frame speedbar-frame)
|
|
|
341 (let ((params (list
|
|
|
342 ;; Xemacs fails to delete speedbar
|
|
|
343 ;; if minibuffer is off.
|
|
|
344 ;; JTL <<<< Seems to be OK for 19.15.
|
|
|
345 ;; removed tool- & menubar.
|
|
|
346 ;; <<<< JTL
|
|
|
347 (cons 'minibuffer nil)
|
|
|
348 (cons 'width speedbar-width)
|
|
|
349 (cons 'height (frame-height))
|
|
|
350 (cons 'scroll-bar-width speedbar-scrollbar-width)
|
|
|
351 (cons 'auto-raise speedbar-raise-lower)
|
|
|
352 (cons 'auto-lower speedbar-raise-lower)
|
|
|
353 '(modeline . nil)
|
|
|
354 '(border-width . 0)
|
|
|
355 '(unsplittable . t)
|
|
|
356 '(default-toolbar-visible-p . nil)
|
|
|
357 '(menubar-visible-p . nil))))
|
|
|
358 (setq speedbar-frame
|
|
|
359 (if (< emacs-minor-version 35)
|
|
|
360 (make-frame params)
|
|
|
361 (let ((x-pointer-shape x-pointer-top-left-arrow)
|
|
|
362 (x-sensitive-text-pointer-shape x-pointer-hand2))
|
|
|
363 (make-frame params)))))
|
|
|
364 ;; reset the selection variable
|
|
|
365 (setq speedbar-last-selected-file nil)
|
|
|
366 ;; Put the buffer into the frame
|
|
|
367 (save-window-excursion
|
|
|
368 (select-frame speedbar-frame)
|
|
|
369 (switch-to-buffer speedbar-buffer)
|
|
|
370 (setq default-minibuffer-frame speedbar-attached-frame))
|
|
|
371 (speedbar-set-timer speedbar-update-speed)
|
|
|
372 )))
|
|
|
373
|
|
|
374 (defun speedbar-close-frame ()
|
|
|
375 "Turn off speedbar mode"
|
|
|
376 (interactive)
|
|
|
377 (speedbar-frame-mode -1))
|
|
|
378
|
|
|
379 (defun speedbar-mode ()
|
|
|
380 "Create and return a SPEEDBAR buffer. The speedbar buffer allows
|
|
|
381 the user to manage a list of directories and paths at different
|
|
|
382 depths. The first line represents the default path of the speedbar
|
|
|
383 frame. Each directory segment is a button which jumps speedbar's
|
|
|
384 default directory to that path. Buttons are activated by clicking
|
|
|
385 mouse-2.
|
|
|
386
|
|
|
387 Each line starting with <+> represents a directory. Click on the <+>
|
|
|
388 to insert the directory listing into the current tree. Click on the
|
|
|
389 <-> to retract that list. Click on the directory name to go to that
|
|
|
390 directory as the default.
|
|
|
391
|
|
|
392 Each line starting with [+] is a file. If the variable
|
|
|
393 `speedbar-show-unknown-files' is t, the lines starting with [?] are
|
|
|
394 files which don't have imenu support, but are not expressly ignored.
|
|
|
395 Files are completely ignored if they match `speedbar-file-unshown-regexp'
|
|
|
396 which is generated from `completion-ignored-extensions'.
|
|
|
397
|
|
|
398 Click on the [+] to display a list of tags from that file. Click on
|
|
|
399 the [-] to retract the list. Click on the file name to edit the file
|
|
|
400 in the attached frame.
|
|
|
401
|
|
|
402 If you open tags, you might find a node starting with {+}, which is a
|
|
|
403 category of tags. Click the {+} to expand the category. Jumpable
|
|
|
404 tags start with >. Click the name of the tag to go to that position
|
|
|
405 in the selected file.
|
|
|
406
|
|
|
407 Keybindings: \\<speedbar-key-map>
|
|
|
408 \\[speedbar-click] Activate the button under the mouse.
|
|
|
409 \\[speedbar-edit-line] Edit the file/directory on this line. Same as clicking
|
|
|
410 on the name on the selected line.)
|
|
|
411 \\[speedbar-expand-line] Expand the current line. Same as clicking on the + on a line.
|
|
|
412 \\[speedbar-contract-line] Contract the current line. Same as clicking on the - on a line."
|
|
|
413 (setq speedbar-buffer (set-buffer (get-buffer-create "SPEEDBAR")))
|
|
|
414 (kill-all-local-variables)
|
|
|
415 (setq major-mode 'speedbar-mode)
|
|
|
416 (setq mode-name "SB")
|
|
|
417 (use-local-map speedbar-key-map)
|
|
|
418 (set-syntax-table speedbar-syntax-table)
|
|
|
419 (setq mode-line-format
|
|
|
420 '("<< SPEEDBAR " (line-number-mode " %3l ") " >>"))
|
|
|
421 (setq font-lock-keywords nil) ;; no font-locking please
|
|
|
422 (setq truncate-lines t)
|
|
|
423 (if (not speedbar-xemacsp) (setq auto-show-mode nil)) ;no auto-show for FSF
|
|
|
424 (run-hooks 'speedbar-mode-hook)
|
|
|
425 (speedbar-update-contents)
|
|
|
426 )
|
|
|
427
|
|
|
428 (defun speedbar-mouse-hscroll (e)
|
|
|
429 "Read a mouse event from the mode line, and horizontally scroll if the
|
|
|
430 mouse is being clicked on the far left, or far right of the modeline."
|
|
|
431 (interactive "e")
|
|
|
432 (let* ((xp (car (nth 2 (car (cdr e)))))
|
|
|
433 (cpw (/ (frame-pixel-width)
|
|
|
434 (frame-width)))
|
|
|
435 (oc (1+ (/ xp cpw)))
|
|
|
436 )
|
|
|
437 (cond ((< oc 3)
|
|
|
438 (scroll-left 2))
|
|
|
439 ((> oc (- (window-width) 3))
|
|
|
440 (scroll-right 2))
|
|
|
441 (t (message "Click on the edge of the modeline to scroll left/right")))
|
|
|
442 ;;(message "X: Pixel %d Char Pixels %d On char %d" xp cpw oc)
|
|
|
443 ))
|
|
|
444
|
|
|
445
|
|
|
446 ;;;
|
|
|
447 ;;; Utility functions
|
|
|
448 ;;;
|
|
|
449 (defun speedbar-set-timer (timeout)
|
|
|
450 "Unset an old timer (if there is one) and activate a new timer with the
|
|
|
451 given timeout value."
|
|
|
452 (cond
|
|
|
453 ;; Xemacs
|
|
|
454 (speedbar-xemacsp
|
|
|
455 (if speedbar-timer
|
|
|
456 (progn (delete-itimer speedbar-timer)
|
|
|
457 (setq speedbar-timer nil)))
|
|
|
458 (if timeout
|
|
|
459 (setq speedbar-timer (start-itimer "speedbar"
|
|
|
460 'speedbar-timer-fn
|
|
|
461 timeout
|
|
|
462 nil))))
|
|
|
463 ;; GNU emacs
|
|
|
464 (t
|
|
|
465 (if speedbar-timer
|
|
|
466 (progn (cancel-timer speedbar-timer)
|
|
|
467 (setq speedbar-timer nil)))
|
|
|
468 (if timeout
|
|
|
469 (setq speedbar-timer
|
|
|
470 (run-with-idle-timer timeout nil 'speedbar-timer-fn))))
|
|
|
471 ))
|
|
|
472
|
|
|
473 (defmacro speedbar-with-writable (&rest forms)
|
|
|
474 "Allow the buffer to be writable and evaluate forms. Turn read-only back
|
|
|
475 on when done."
|
|
|
476 (list 'let '((speedbar-with-writable-buff (current-buffer)))
|
|
|
477 '(toggle-read-only -1)
|
|
|
478 (cons 'progn forms)
|
|
|
479 '(save-excursion (set-buffer speedbar-with-writable-buff)
|
|
|
480 (toggle-read-only 1))))
|
|
|
481 (put 'speedbar-with-writable 'lisp-indent-function 0)
|
|
|
482
|
|
|
483 (defun speedbar-make-button (start end face mouse function &optional token)
|
|
|
484 "Create a button from START to END, with FACE as the display face
|
|
|
485 and MOUSE and the mouse face. When this button is clicked on FUNCTION
|
|
|
486 will be run with the token parameter of TOKEN (any lisp object)"
|
|
|
487 (put-text-property start end 'face face)
|
|
|
488 (put-text-property start end 'mouse-face mouse)
|
|
|
489 (put-text-property start end 'invisible nil)
|
|
|
490 (if function (put-text-property start end 'speedbar-function function))
|
|
|
491 (if token (put-text-property start end 'speedbar-token token))
|
|
|
492 )
|
|
|
493
|
|
|
494 (defun speedbar-file-lists (directory)
|
|
|
495 "Create file lists for DIRECTORY. The car is the list of
|
|
|
496 directories, the cdr is list of files not matching ignored headers."
|
|
|
497 (let ((default-directory directory)
|
|
|
498 (dir (directory-files directory nil))
|
|
|
499 (dirs nil)
|
|
|
500 (files nil))
|
|
|
501 (while dir
|
|
|
502 (if (not (string-match speedbar-file-unshown-regexp (car dir)))
|
|
|
503 (if (file-directory-p (car dir))
|
|
|
504 (setq dirs (cons (car dir) dirs))
|
|
|
505 (setq files (cons (car dir) files))))
|
|
|
506 (setq dir (cdr dir)))
|
|
|
507 (cons (nreverse dirs) (list (nreverse files))))
|
|
|
508 )
|
|
|
509
|
|
|
510 (defun speedbar-directory-buttons (directory index)
|
|
|
511 "Inserts a single button group at point for DIRECTORY. Each directory
|
|
|
512 path part is a different button. If part of the path matches the user
|
|
|
513 directory ~, then it is replaced with a ~"
|
|
|
514 (let* ((tilde (expand-file-name "~"))
|
|
|
515 (dd (expand-file-name directory))
|
|
|
516 (junk (string-match (regexp-quote tilde) dd))
|
|
|
517 (displayme (if junk
|
|
|
518 (concat "~" (substring dd (match-end 0)))
|
|
|
519 dd))
|
|
|
520 (p (point)))
|
|
|
521 (if (string-match "^~/?$" displayme) (setq displayme (concat tilde "/")))
|
|
|
522 (insert displayme)
|
|
|
523 (save-excursion
|
|
|
524 (goto-char p)
|
|
|
525 (while (re-search-forward "\\([^/]+\\)/" nil t)
|
|
|
526 (speedbar-make-button (match-beginning 1) (match-end 1)
|
|
|
527 'speedbar-directory-face
|
|
|
528 'speedbar-highlight-face
|
|
|
529 'speedbar-directory-buttons-follow
|
|
|
530 (if (= (match-beginning 1) p)
|
|
|
531 (expand-file-name "~/") ;the tilde
|
|
|
532 (buffer-substring-no-properties
|
|
|
533 p (match-end 0))))))
|
|
|
534 (if (string-match "^/[^/]+/$" displayme)
|
|
|
535 (progn
|
|
|
536 (insert " ")
|
|
|
537 (let ((p (point)))
|
|
|
538 (insert "<root>")
|
|
|
539 (speedbar-make-button p (point)
|
|
|
540 'speedbar-directory-face
|
|
|
541 'speedbar-highlight-face
|
|
|
542 'speedbar-directory-buttons-follow
|
|
|
543 "/"))))
|
|
|
544 (insert-char ?\n 1 nil)))
|
|
|
545
|
|
|
546 (defun speedbar-make-tag-line (exp-button-type
|
|
|
547 exp-button-char exp-button-function
|
|
|
548 exp-button-data
|
|
|
549 tag-button tag-button-function tag-button-data
|
|
|
550 tag-button-face depth)
|
|
|
551 "Creates a tag line with BUTTON-TYPE for the small button that
|
|
|
552 expands or contracts a node (if applicable), and BUTTON-CHAR the
|
|
|
553 character in it (+, -, ?, etc). BUTTON-FUNCTION is the function to
|
|
|
554 call if it's clicked on. Button types are 'bracket, 'angle, 'curly, or nil.
|
|
|
555
|
|
|
556 Next, TAG-BUTTON is the text of the tag. TAG-FUNCTION is the function
|
|
|
557 to call if clicked on, and TAG-DATA is the data to attach to the text
|
|
|
558 field (such a tag positioning, etc). TAG-FACE is a face used for this
|
|
|
559 type of tag.
|
|
|
560
|
|
|
561 Lastly, DEPTH shows the depth of expansion.
|
|
|
562
|
|
|
563 This function assumes that the cursor is in the speecbar window at the
|
|
|
564 position to insert a new item, and that the new item will end with a CR"
|
|
|
565 (let ((start (point))
|
|
|
566 (end (progn
|
|
|
567 (insert (int-to-string depth) ":")
|
|
|
568 (point))))
|
|
|
569 (put-text-property start end 'invisible t)
|
|
|
570 )
|
|
|
571 (insert-char ? depth nil)
|
|
|
572 (put-text-property (- (point) depth) (point) 'invisible nil)
|
|
|
573 (let* ((exp-button (cond ((eq exp-button-type 'bracket) "[%c]")
|
|
|
574 ((eq exp-button-type 'angle) "<%c>")
|
|
|
575 ((eq exp-button-type 'curly) "{%c}")
|
|
|
576 (t ">")))
|
|
|
577 (buttxt (format exp-button exp-button-char))
|
|
|
578 (start (point))
|
|
|
579 (end (progn (insert buttxt) (point)))
|
|
|
580 (bf (if exp-button-type 'speedbar-button-face nil))
|
|
|
581 (mf (if exp-button-function 'speedbar-highlight-face nil))
|
|
|
582 )
|
|
|
583 (speedbar-make-button start end bf mf exp-button-function exp-button-data)
|
|
|
584 )
|
|
|
585 (insert-char ? 1 nil)
|
|
|
586 (put-text-property (1- (point)) (point) 'invisible nil)
|
|
|
587 (let ((start (point))
|
|
|
588 (end (progn (insert tag-button) (point))))
|
|
|
589 (insert-char ?\n 1 nil)
|
|
|
590 (put-text-property (1- (point)) (point) 'invisible nil)
|
|
|
591 (speedbar-make-button start end tag-button-face
|
|
|
592 (if tag-button-function 'speedbar-highlight-face nil)
|
|
|
593 tag-button-function tag-button-data))
|
|
|
594 )
|
|
|
595
|
|
|
596 (defun speedbar-change-expand-button-char (char)
|
|
|
597 "Change the expanson button character to CHAR for the current line."
|
|
|
598 (save-excursion
|
|
|
599 (beginning-of-line)
|
|
|
600 (if (re-search-forward ":\\s-*.\\([-+?]\\)" (save-excursion (end-of-line)
|
|
|
601 (point)) t)
|
|
|
602 (speedbar-with-writable
|
|
|
603 (goto-char (match-beginning 1))
|
|
|
604 (delete-char 1)
|
|
|
605 (insert-char char 1 t)))))
|
|
|
606
|
|
|
607
|
|
|
608 ;;;
|
|
|
609 ;;; Build button lists
|
|
|
610 ;;;
|
|
|
611 (defun speedbar-insert-files-at-point (files level)
|
|
|
612 "Insert list of FILES starting at point, and indenting all files to LEVEL
|
|
|
613 depth. Tag exapndable items with a +, otherwise a ?. Don't highlight ? as
|
|
|
614 we don't know how to manage them. The input parameter FILES is a cons
|
|
|
615 cell of the form ( 'dir-list . 'file-list )"
|
|
|
616 ;; Start inserting all the directories
|
|
|
617 (let ((dirs (car files)))
|
|
|
618 (while dirs
|
|
|
619 (speedbar-make-tag-line 'angle ?+ 'speedbar-dired (car dirs)
|
|
|
620 (car dirs) 'speedbar-dir-follow nil
|
|
|
621 'speedbar-directory-face level)
|
|
|
622 (setq dirs (cdr dirs))))
|
|
|
623 (let ((lst (car (cdr files))))
|
|
|
624 (while lst
|
|
|
625 (let* ((known (string-match speedbar-file-regexp (car lst)))
|
|
|
626 (expchar (if known ?+ ??))
|
|
|
627 (fn (if known 'speedbar-tag-file nil)))
|
|
|
628 (if (or speedbar-show-unknown-files (/= expchar ??))
|
|
|
629 (speedbar-make-tag-line 'bracket expchar fn (car lst)
|
|
|
630 (car lst) 'speedbar-find-file nil
|
|
|
631 'speedbar-file-face level)))
|
|
|
632 (setq lst (cdr lst)))))
|
|
|
633
|
|
|
634 (defun speedbar-default-directory-list (directory index)
|
|
|
635 "Inserts files for DIRECTORY with level INDEX at point"
|
|
|
636 (speedbar-insert-files-at-point
|
|
|
637 (speedbar-file-lists directory) index)
|
|
|
638 )
|
|
|
639
|
|
|
640 (defun speedbar-insert-generic-list (level lst expand-fun find-fun)
|
|
|
641 "At LEVEL, inserts a generic multi-level alist LIST. Associations with
|
|
|
642 lists get {+} tags (to expand into more nodes) and those with positions
|
|
|
643 just get a > as the indicator. {+} buttons will have the function
|
|
|
644 EXPAND-FUN and the token is the CDR list. The token name will have the
|
|
|
645 function FIND-FUN and not token."
|
|
|
646 ;; Remove imenu rescan button
|
|
|
647 (if (string= (car (car lst)) "*Rescan*")
|
|
|
648 (setq lst (cdr lst)))
|
|
|
649 ;; insert the parts
|
|
|
650 (while lst
|
|
|
651 (cond ((null (car-safe lst)) nil) ;this would be a separator
|
|
|
652 ((numberp (cdr-safe (car-safe lst)))
|
|
|
653 (speedbar-make-tag-line nil nil nil nil ;no expand button data
|
|
|
654 (car (car lst)) ;button name
|
|
|
655 find-fun ;function
|
|
|
656 (cdr (car lst)) ;token is position
|
|
|
657 'speedbar-tag-face
|
|
|
658 (1+ level)))
|
|
|
659 ((listp (cdr-safe (car-safe lst)))
|
|
|
660 (speedbar-make-tag-line 'curly ?+ expand-fun (cdr (car lst))
|
|
|
661 (car (car lst)) ;button name
|
|
|
662 nil nil 'speedbar-tag-face
|
|
|
663 (1+ level)))
|
|
|
664 (t (message "Ooops!")))
|
|
|
665 (setq lst (cdr lst))))
|
|
|
666
|
|
|
667 ;;;
|
|
|
668 ;;; Timed functions
|
|
|
669 ;;;
|
|
|
670 (defun speedbar-update-contents ()
|
|
|
671 "Update the contents of the speedbar buffer."
|
|
|
672 (interactive)
|
|
|
673 (setq speedbar-last-selected-file nil)
|
|
|
674 (setq speedbar-shown-directories (list (expand-file-name default-directory)))
|
|
|
675 (let ((cbd default-directory)
|
|
|
676 (funclst speedbar-initial-expansion-list))
|
|
|
677 (save-excursion
|
|
|
678 (set-buffer speedbar-buffer)
|
|
|
679 (speedbar-with-writable
|
|
|
680 (setq default-directory cbd)
|
|
|
681 (delete-region (point-min) (point-max))
|
|
|
682 (while funclst
|
|
|
683 (funcall (car funclst) cbd 0)
|
|
|
684 (setq funclst (cdr funclst)))))))
|
|
|
685
|
|
|
686 (defun speedbar-timer-fn ()
|
|
|
687 "Run whenever emacs is idle to update the speedbar item"
|
|
|
688 (if (not (and speedbar-frame
|
|
|
689 (frame-live-p speedbar-frame)
|
|
|
690 speedbar-attached-frame
|
|
|
691 (frame-live-p speedbar-attached-frame)))
|
|
|
692 (speedbar-set-timer nil)
|
|
|
693 (unwind-protect
|
|
|
694 (if (frame-visible-p speedbar-frame)
|
|
|
695 (let ((af (selected-frame)))
|
|
|
696 (save-window-excursion
|
|
|
697 (select-frame speedbar-attached-frame)
|
|
|
698 ;; make sure we at least choose a window to
|
|
|
699 ;; get a good directory from
|
|
|
700 (if (string-match "\\*Minibuf-[0-9]+\\*" (buffer-name))
|
|
|
701 (other-window 1))
|
|
|
702 ;; Update all the contents if directories change!
|
|
|
703 (if (or (member (expand-file-name default-directory)
|
|
|
704 speedbar-shown-directories)
|
|
|
705 (eq af speedbar-frame)
|
|
|
706 (not (buffer-file-name))
|
|
|
707 )
|
|
|
708 nil
|
|
|
709 (message "Updating speedbar to: %s..." default-directory)
|
|
|
710 (speedbar-update-contents)
|
|
|
711 (message "Updating speedbar to: %s...done" default-directory)))))
|
|
|
712 ;; Reset the timer
|
|
|
713 (speedbar-set-timer speedbar-update-speed)
|
|
|
714 ;; Ok, un-underline old file, underline current file
|
|
|
715 (speedbar-update-current-file)))
|
|
|
716 (run-hooks 'speedbar-timer-hook)
|
|
|
717 )
|
|
|
718
|
|
|
719 (defun speedbar-update-current-file ()
|
|
|
720 "Find out what the current file is, and update our visuals to indicate
|
|
|
721 what it is. This is specific to file names."
|
|
|
722 (let* ((lastf (selected-frame))
|
|
|
723 (newcf (save-excursion
|
|
|
724 (select-frame speedbar-attached-frame)
|
|
|
725 (let ((rf (if (buffer-file-name)
|
|
|
726 (file-name-nondirectory (buffer-file-name))
|
|
|
727 nil)))
|
|
|
728 (select-frame lastf)
|
|
|
729 rf)))
|
|
|
730 (lastb (current-buffer)))
|
|
|
731 (if (and newcf (not (string= newcf speedbar-last-selected-file)))
|
|
|
732 (progn
|
|
|
733 (select-frame speedbar-frame)
|
|
|
734 (set-buffer speedbar-buffer)
|
|
|
735 (speedbar-with-writable
|
|
|
736 (goto-char (point-min))
|
|
|
737 (if (and
|
|
|
738 speedbar-last-selected-file
|
|
|
739 (re-search-forward
|
|
|
740 (concat " \\(" (regexp-quote speedbar-last-selected-file) "\\)\n")
|
|
|
741 nil t))
|
|
|
742 (put-text-property (match-beginning 1)
|
|
|
743 (match-end 1)
|
|
|
744 'face
|
|
|
745 'speedbar-file-face))
|
|
|
746 (goto-char (point-min))
|
|
|
747 (if (re-search-forward
|
|
|
748 (concat " \\(" (regexp-quote newcf) "\\)\n") nil t)
|
|
|
749 (put-text-property (match-beginning 1)
|
|
|
750 (match-end 1)
|
|
|
751 'face
|
|
|
752 'speedbar-selected-face))
|
|
|
753 (setq speedbar-last-selected-file newcf))
|
|
|
754 (forward-line -1)
|
|
|
755 (speedbar-position-cursor-on-line)
|
|
|
756 (set-buffer lastb)
|
|
|
757 (select-frame lastf)))))
|
|
|
758
|
|
|
759 ;;;
|
|
|
760 ;;; Clicking Activity
|
|
|
761 ;;;
|
|
|
762 (defun speedbar-quick-mouse (e)
|
|
|
763 "Since mouse events are strange, this will keep the mouse nicely
|
|
|
764 positioned."
|
|
|
765 (interactive "e")
|
|
|
766 (mouse-set-point e)
|
|
|
767 (beginning-of-line)
|
|
|
768 (forward-char 3)
|
|
|
769 )
|
|
|
770
|
|
|
771 (defun speedbar-position-cursor-on-line ()
|
|
|
772 "Position the cursor on a line."
|
|
|
773 (beginning-of-line)
|
|
|
774 (re-search-forward "[]>}]" (save-excursion (end-of-line) (point)) t))
|
|
|
775
|
|
|
776 (defun speedbar-line-path (depth)
|
|
|
777 "Retrieve the pathname associated with the current line. This may
|
|
|
778 require traversing backwards and combinding the default directory with
|
|
|
779 these items."
|
|
|
780 (save-excursion
|
|
|
781 (let ((path nil))
|
|
|
782 (setq depth (1- depth))
|
|
|
783 (while (/= depth -1)
|
|
|
784 (if (not (re-search-backward (format "^%d:" depth) nil t))
|
|
|
785 (error "Error building path of tag")
|
|
|
786 (cond ((looking-at "[0-9]+:\\s-*<->\\s-+\\([^\n]+\\)$")
|
|
|
787 (setq path (concat (buffer-substring-no-properties
|
|
|
788 (match-beginning 1) (match-end 1))
|
|
|
789 "/"
|
|
|
790 path)))
|
|
|
791 ((looking-at "[0-9]+:\\s-*[-]\\s-+\\([^\n]+\\)$")
|
|
|
792 ;; This is the start of our path.
|
|
|
793 (setq path (buffer-substring-no-properties
|
|
|
794 (match-beginning 1) (match-end 1))))))
|
|
|
795 (setq depth (1- depth)))
|
|
|
796 (concat default-directory path))))
|
|
|
797
|
|
|
798 (defun speedbar-edit-line ()
|
|
|
799 "Edit whatever tag or file is on the current speedbar line."
|
|
|
800 (interactive)
|
|
|
801 (beginning-of-line)
|
|
|
802 (re-search-forward "[]>}] [a-zA-Z0-9]" (save-excursion (end-of-line) (point)))
|
|
|
803 (speedbar-do-function-pointer))
|
|
|
804
|
|
|
805 (defun speedbar-expand-line ()
|
|
|
806 "Expand the line under the cursor."
|
|
|
807 (interactive)
|
|
|
808 (beginning-of-line)
|
|
|
809 (re-search-forward ":\\s-*.\\+. " (save-excursion (end-of-line) (point)))
|
|
|
810 (forward-char -2)
|
|
|
811 (speedbar-do-function-pointer))
|
|
|
812
|
|
|
813 (defun speedbar-contract-line ()
|
|
|
814 "Expand the line under the cursor."
|
|
|
815 (interactive)
|
|
|
816 (beginning-of-line)
|
|
|
817 (re-search-forward ":\\s-*.-. " (save-excursion (end-of-line) (point)))
|
|
|
818 (forward-char -2)
|
|
|
819 (speedbar-do-function-pointer))
|
|
|
820
|
|
|
821 (defun speedbar-click (e)
|
|
|
822 "When the user clicks mouse 1 on our speedbar, we must decide what
|
|
|
823 we want to do! The entire speedbar has functions attached to
|
|
|
824 buttons. All we have to do is extract from the buffer the information
|
|
|
825 we need. See `speedbar-mode' for the type of behaviour we want to achieve"
|
|
|
826 (interactive "e")
|
|
|
827 (mouse-set-point e)
|
|
|
828 (speedbar-do-function-pointer))
|
|
|
829
|
|
|
830 (defun speedbar-do-function-pointer ()
|
|
|
831 "Look under the cursor and examine the text properties. From this extract
|
|
|
832 the file/tag name, token, indentation level and call a function if apropriate"
|
|
|
833 (let* ((fn (get-text-property (point) 'speedbar-function))
|
|
|
834 (tok (get-text-property (point) 'speedbar-token))
|
|
|
835 ;; The 1-,+ is safe because scaning starts AFTER the point
|
|
|
836 ;; specified. This lets the search include the character the
|
|
|
837 ;; cursor is on.
|
|
|
838 (tp (previous-single-property-change
|
|
|
839 (if (get-text-property (1+ (point)) 'speedbar-function)
|
|
|
840 (1+ (point)) (point)) 'speedbar-function))
|
|
|
841 (np (next-single-property-change
|
|
|
842 (if (and (> (point) 1) (get-text-property (1- (point)) 'speedbar-function))
|
|
|
843 (1- (point)) (point)) 'speedbar-function))
|
|
|
844 (txt (buffer-substring-no-properties (or tp (point-min))
|
|
|
845 (or np (point-max))))
|
|
|
846 (dent (save-excursion (beginning-of-line)
|
|
|
847 (string-to-number
|
|
|
848 (if (looking-at "[0-9]+")
|
|
|
849 (buffer-substring-no-properties
|
|
|
850 (match-beginning 0) (match-end 0))
|
|
|
851 "0")))))
|
|
|
852 ;;(message "%S:%S:%S:%s" fn tok txt dent)
|
|
|
853 (and fn (funcall fn txt tok dent)))
|
|
|
854 (speedbar-position-cursor-on-line))
|
|
|
855
|
|
|
856 (defun speedbar-find-file (text token indent)
|
|
|
857 "Speedbar click handler for filenames. Clicking the filename loads
|
|
|
858 that file into the attached buffer."
|
|
|
859 (let ((cdd (speedbar-line-path indent)))
|
|
|
860 (select-frame speedbar-attached-frame)
|
|
|
861 (find-file (concat cdd text))
|
|
|
862 (speedbar-update-current-file)
|
|
|
863 ;; Reset the timer with a new timeout when cliking a file
|
|
|
864 ;; in case the user was navigating directories, we can cancel
|
|
|
865 ;; that other timer.
|
|
|
866 (speedbar-set-timer speedbar-update-speed)))
|
|
|
867
|
|
|
868 (defun speedbar-dir-follow (text token indent)
|
|
|
869 "Speedbar click handler for directory names. Clicking a directory will
|
|
|
870 cause the speedbar to list files in the selected subdirectory."
|
|
|
871 (setq default-directory
|
|
|
872 (concat (expand-file-name (concat (speedbar-line-path indent) text))
|
|
|
873 "/"))
|
|
|
874 ;; Because we leave speedbar as the current buffer,
|
|
|
875 ;; update contents will change directory without
|
|
|
876 ;; having to touch the attached frame.
|
|
|
877 (speedbar-update-contents)
|
|
|
878 (speedbar-set-timer speedbar-navigating-speed)
|
|
|
879 (setq speedbar-last-selected-file nil)
|
|
|
880 (speedbar-update-current-file))
|
|
|
881
|
|
|
882
|
|
|
883 (defun speedbar-dired (text token indent)
|
|
|
884 "Speedbar click handler for filenames. Clicking the filename loads
|
|
|
885 that file into the attached buffer."
|
|
|
886 (cond ((string-match "+" text) ;we have to expand this file
|
|
|
887 (setq speedbar-shown-directories
|
|
|
888 (cons (expand-file-name
|
|
|
889 (concat (speedbar-line-path indent) token "/"))
|
|
|
890 speedbar-shown-directories))
|
|
|
891 (speedbar-change-expand-button-char ?-)
|
|
|
892 (save-excursion
|
|
|
893 (end-of-line) (forward-char 1)
|
|
|
894 (speedbar-with-writable
|
|
|
895 (speedbar-default-directory-list
|
|
|
896 (concat (speedbar-line-path indent) token "/")
|
|
|
897 (1+ indent)))))
|
|
|
898 ((string-match "-" text) ;we have to contract this node
|
|
|
899 (let ((oldl speedbar-shown-directories)
|
|
|
900 (newl nil)
|
|
|
901 (td (expand-file-name
|
|
|
902 (concat (speedbar-line-path indent) token))))
|
|
|
903 (while oldl
|
|
|
904 (if (not (string-match (concat "^" (regexp-quote td)) (car oldl)))
|
|
|
905 (setq newl (cons (car oldl) newl)))
|
|
|
906 (setq oldl (cdr oldl)))
|
|
|
907 (setq speedbar-shown-directories newl))
|
|
|
908 (speedbar-change-expand-button-char ?+)
|
|
|
909 (save-excursion
|
|
|
910 (end-of-line) (forward-char 1)
|
|
|
911 (speedbar-with-writable
|
|
|
912 (if (save-excursion (re-search-forward (format "^%d:" indent) nil t))
|
|
|
913 (delete-region (point) (match-beginning 0))
|
|
|
914 (delete-region (point) (point-max)))))
|
|
|
915 )
|
|
|
916 (t (error "Ooops... not sure what to do.")))
|
|
|
917 (speedbar-center-buffer-smartly)
|
|
|
918 (setq speedbar-last-selected-file nil)
|
|
|
919 (save-excursion (speedbar-update-current-file)))
|
|
|
920
|
|
|
921 (defun speedbar-directory-buttons-follow (text token ident)
|
|
|
922 "Speedbar click handler for default directory buttons."
|
|
|
923 (setq default-directory token)
|
|
|
924 ;; Because we leave speedbar as the current buffer,
|
|
|
925 ;; update contents will change directory without
|
|
|
926 ;; having to touch the attached frame.
|
|
|
927 (speedbar-update-contents)
|
|
|
928 (speedbar-set-timer speedbar-navigating-speed))
|
|
|
929
|
|
|
930 (defun speedbar-tag-file (text token indent)
|
|
|
931 "The cursor is on a selected line. Expand the tags in the specified
|
|
|
932 file. The parameter TXT and TOK are required, where TXT is the button
|
|
|
933 clicked, and TOK is the file to expand."
|
|
|
934 (cond ((string-match "+" text) ;we have to expand this file
|
|
|
935 (let* ((fn (expand-file-name (concat (speedbar-line-path indent)
|
|
|
936 token)))
|
|
|
937 (lst (if speedbar-use-imenu-package
|
|
|
938 (let ((tim (speedbar-fetch-dynamic-imenu fn)))
|
|
|
939 (if (eq tim t)
|
|
|
940 (speedbar-fetch-dynamic-etags fn)
|
|
|
941 tim))
|
|
|
942 (speedbar-fetch-dynamic-etags fn))))
|
|
|
943 ;; if no list, then remove expando button
|
|
|
944 (if (not lst)
|
|
|
945 (speedbar-change-expand-button-char ??)
|
|
|
946 (speedbar-change-expand-button-char ?-)
|
|
|
947 (speedbar-with-writable
|
|
|
948 (save-excursion
|
|
|
949 (end-of-line) (forward-char 1)
|
|
|
950 (speedbar-insert-generic-list indent
|
|
|
951 lst 'speedbar-tag-expand
|
|
|
952 'speedbar-tag-find))))))
|
|
|
953 ((string-match "-" text) ;we have to contract this node
|
|
|
954 (speedbar-change-expand-button-char ?+)
|
|
|
955 (speedbar-with-writable
|
|
|
956 (save-excursion
|
|
|
957 (end-of-line) (forward-char 1)
|
|
|
958 (if (save-excursion (re-search-forward (format "^%d:" indent) nil t))
|
|
|
959 (delete-region (point) (match-beginning 0))
|
|
|
960 (delete-region (point) (point-max))))))
|
|
|
961 (t (error "Ooops... not sure what to do.")))
|
|
|
962 (speedbar-center-buffer-smartly))
|
|
|
963
|
|
|
964 (defun speedbar-tag-find (text token indent)
|
|
|
965 "For the tag in a file, goto that position"
|
|
|
966 (let ((file (speedbar-line-path indent)))
|
|
|
967 (select-frame speedbar-attached-frame)
|
|
|
968 (find-file file)
|
|
|
969 (save-excursion (speedbar-update-current-file))
|
|
|
970 ;; Reset the timer with a new timeout when cliking a file
|
|
|
971 ;; in case the user was navigating directories, we can cancel
|
|
|
972 ;; that other timer.
|
|
|
973 (speedbar-set-timer speedbar-update-speed)
|
|
|
974 (goto-char token)))
|
|
|
975
|
|
|
976 (defun speedbar-tag-expand (text token indent)
|
|
|
977 "For the tag in a file which is really a list of tags of a certain type,
|
|
|
978 expand or contract that list."
|
|
|
979 (cond ((string-match "+" text) ;we have to expand this file
|
|
|
980 (speedbar-change-expand-button-char ?-)
|
|
|
981 (speedbar-with-writable
|
|
|
982 (save-excursion
|
|
|
983 (end-of-line) (forward-char 1)
|
|
|
984 (speedbar-insert-generic-list indent
|
|
|
985 token 'speedbar-tag-expand
|
|
|
986 'speedbar-tag-find))))
|
|
|
987 ((string-match "-" text) ;we have to contract this node
|
|
|
988 (speedbar-change-expand-button-char ?+)
|
|
|
989 (speedbar-with-writable
|
|
|
990 (save-excursion
|
|
|
991 (end-of-line) (forward-char 1)
|
|
|
992 (if (save-excursion (re-search-forward (format "^%d:" indent) nil t))
|
|
|
993 (delete-region (point) (match-beginning 0))))))
|
|
|
994 (t (error "Ooops... not sure what to do.")))
|
|
|
995 (speedbar-center-buffer-smartly))
|
|
|
996
|
|
|
997 ;;;
|
|
|
998 ;;; Centering Utility
|
|
|
999 ;;;
|
|
|
1000 (defun speedbar-center-buffer-smartly ()
|
|
|
1001 "Look at the buffer, and center it so that which the user is most
|
|
|
1002 interested in (as far as we can tell) is all visible. This assumes
|
|
|
1003 that the cursor is on a file, or tag of a file which the user is
|
|
|
1004 interested in."
|
|
|
1005 (if (<= (count-lines (point-min) (point-max))
|
|
|
1006 (window-height (selected-window)))
|
|
|
1007 ;; whole buffer fits
|
|
|
1008 (let ((cp (point)))
|
|
|
1009 (goto-char (point-min))
|
|
|
1010 (recenter 0)
|
|
|
1011 (goto-char cp))
|
|
|
1012 ;; too big
|
|
|
1013 (let (depth start end exp p)
|
|
|
1014 (save-excursion
|
|
|
1015 (beginning-of-line)
|
|
|
1016 (setq depth (if (looking-at "[0-9]+")
|
|
|
1017 (string-to-int (buffer-substring-no-properties
|
|
|
1018 (match-beginning 0) (match-end 0)))
|
|
|
1019 0))
|
|
|
1020 (setq exp (format "^%d:\\s-*[[{<]\\([?+-]\\)[]>}]" depth)))
|
|
|
1021 (save-excursion
|
|
|
1022 (end-of-line)
|
|
|
1023 (if (re-search-backward exp nil t)
|
|
|
1024 (setq start (point))
|
|
|
1025 (error "Center error"))
|
|
|
1026 (save-excursion ;Not sure about this part.
|
|
|
1027 (end-of-line)
|
|
|
1028 (setq p (point))
|
|
|
1029 (while (and (not (re-search-forward exp nil t))
|
|
|
1030 (>= depth 0))
|
|
|
1031 (setq depth (1- depth))
|
|
|
1032 (setq exp (format "^%d:\\s-*[[{<]\\([?+-]\\)[]>}]" depth)))
|
|
|
1033 (if (/= (point) p)
|
|
|
1034 (setq end (point))
|
|
|
1035 (setq end (point-max)))))
|
|
|
1036 ;; Now work out the details of centering
|
|
|
1037 (let ((nl (count-lines start end))
|
|
|
1038 (cp (point)))
|
|
|
1039 (if (> nl (window-height (selected-window)))
|
|
|
1040 ;; We can't fit it all, so just center on cursor
|
|
|
1041 (progn (goto-char start)
|
|
|
1042 (recenter 1))
|
|
|
1043 ;; we can fit everything on the screen, but...
|
|
|
1044 (if (and (pos-visible-in-window-p start (selected-window))
|
|
|
1045 (pos-visible-in-window-p end (selected-window)))
|
|
|
1046 ;; we are all set!
|
|
|
1047 nil
|
|
|
1048 ;; we need to do something...
|
|
|
1049 (goto-char start)
|
|
|
1050 (let ((newcent (/ (- (window-height (selected-window)) nl) 2))
|
|
|
1051 (lte (count-lines start (point-max))))
|
|
|
1052 (if (and (< (+ newcent lte) (window-height (selected-window)))
|
|
|
1053 (> (- (window-height (selected-window)) lte 1)
|
|
|
1054 newcent))
|
|
|
1055 (setq newcent (- (window-height (selected-window))
|
|
|
1056 lte 1)))
|
|
|
1057 (recenter newcent))))
|
|
|
1058 (goto-char cp)))))
|
|
|
1059
|
|
|
1060
|
|
|
1061 ;;;
|
|
|
1062 ;;; Tag Management -- Imenu
|
|
|
1063 ;;;
|
|
|
1064 (defun speedbar-fetch-dynamic-imenu (file)
|
|
|
1065 "Use the imenu package to load in file, and extract all the items
|
|
|
1066 tags we wish to display in the speedbar package."
|
|
|
1067 ;; (eval-when-compile (require 'imenu))
|
|
|
1068 (save-excursion
|
|
|
1069 (set-buffer (find-file-noselect file))
|
|
|
1070 (condition-case nil
|
|
|
1071 (imenu--make-index-alist t)
|
|
|
1072 (error t))))
|
|
|
1073
|
|
|
1074
|
|
|
1075 ;;;
|
|
|
1076 ;;; Tag Management -- etags (Not useful for FSF emacs)
|
|
|
1077 ;;;
|
|
|
1078 (defvar speedbar-fetch-etags-parse-list
|
|
|
1079 '(("\\.\\([cChH]\\|c++\\|cpp\\|cc\\)$" . speedbar-parse-c-or-c++tag)
|
|
|
1080 ("\\.el\\|\\.emacs" .
|
|
|
1081 "defun\\s-+\\(\\(\\w\\|[-_]\\)+\\)\\s-*\C-?")
|
|
|
1082 ("\\.tex$" . speedbar-parse-tex-string)
|
|
|
1083 ("\\.p" .
|
|
|
1084 "\\(\\(FUNCTION\\|function\\|PROCEDURE\\|procedure\\)\\s-+\\([a-zA-Z0-9_.:]+\\)\\)\\s-*(?^?")
|
|
|
1085
|
|
|
1086 )
|
|
|
1087 "*Alist matching extension vs an expression which will extract the
|
|
|
1088 symbol name we wish to display as match 1. To add a new file type, you
|
|
|
1089 would want to add a new association to the list, where the car
|
|
|
1090 is the file match, and the cdr is the way to extract an element from
|
|
|
1091 the tags output. If the output is complex, use a function symbol
|
|
|
1092 instead of regexp. The function should expect to be at the beginning
|
|
|
1093 of a line in the etags buffer.
|
|
|
1094
|
|
|
1095 This variable is ignored if `speedbar-use-imenu-package' is `t'")
|
|
|
1096
|
|
|
1097 (defvar speedbar-fetch-etags-command "etags"
|
|
|
1098 "*Command used to create an etags file.
|
|
|
1099
|
|
|
1100 This variable is ignored if `speedbar-use-imenu-package' is `t'")
|
|
|
1101
|
|
|
1102 (defvar speedbar-fetch-etags-arguments '("-D" "-I" "-o" "-")
|
|
|
1103 "*List of arguments to use with `speedbar-fetch-etags-command' to create
|
|
|
1104 an etags output buffer.
|
|
|
1105
|
|
|
1106 This variable is ignored if `speedbar-use-imenu-package' is `t'")
|
|
|
1107
|
|
|
1108 (defun speedbar-fetch-dynamic-etags (file)
|
|
|
1109 "For the complete file definition FILE, run etags as a subprocess,
|
|
|
1110 fetch it's output, and create a list of symbols extracted, and their
|
|
|
1111 position in FILE."
|
|
|
1112 (let ((newlist nil))
|
|
|
1113 (unwind-protect
|
|
|
1114 (save-excursion
|
|
|
1115 (if (get-buffer "*etags tmp*")
|
|
|
1116 (kill-buffer "*etags tmp*")) ;kill to clean it up
|
|
|
1117 (set-buffer (get-buffer-create "*etags tmp*"))
|
|
|
1118 (apply 'call-process speedbar-fetch-etags-command nil
|
|
|
1119 (current-buffer) nil
|
|
|
1120 (append speedbar-fetch-etags-arguments (list file)))
|
|
|
1121 (goto-char (point-min))
|
|
|
1122 (let ((expr
|
|
|
1123 (let ((exprlst speedbar-fetch-etags-parse-list)
|
|
|
1124 (ans nil))
|
|
|
1125 (while (and (not ans) exprlst)
|
|
|
1126 (if (string-match (car (car exprlst)) file)
|
|
|
1127 (setq ans (car exprlst)))
|
|
|
1128 (setq exprlst (cdr exprlst)))
|
|
|
1129 (cdr ans))))
|
|
|
1130 (if expr
|
|
|
1131 (let (tnl)
|
|
|
1132 (while (not (save-excursion (end-of-line) (eobp)))
|
|
|
1133 (save-excursion
|
|
|
1134 (setq tnl (speedbar-extract-one-symbol expr)))
|
|
|
1135 (if tnl (setq newlist (cons tnl newlist)))
|
|
|
1136 (forward-line 1)))
|
|
|
1137 (message "Sorry, no support for a file of that extension"))))
|
|
|
1138 )
|
|
|
1139 (reverse newlist)))
|
|
|
1140
|
|
|
1141 (defun speedbar-extract-one-symbol (expr)
|
|
|
1142 "At point in current buffer, return nil, or one alist of the form
|
|
|
1143 of a dotted pair: ( symbol . position ) from etags output. Parse the
|
|
|
1144 output using the regular expression EXPR"
|
|
|
1145 (let* ((sym (if (stringp expr)
|
|
|
1146 (if (save-excursion
|
|
|
1147 (re-search-forward expr (save-excursion
|
|
|
1148 (end-of-line)
|
|
|
1149 (point)) t))
|
|
|
1150 (buffer-substring-no-properties (match-beginning 1)
|
|
|
1151 (match-end 1)))
|
|
|
1152 (funcall expr)))
|
|
|
1153 (pos (let ((j (re-search-forward "[\C-?\C-a]\\([0-9]+\\),\\([0-9]+\\)"
|
|
|
1154 (save-excursion
|
|
|
1155 (end-of-line)
|
|
|
1156 (point))
|
|
|
1157 t)))
|
|
|
1158 (if (and j sym)
|
|
|
1159 (1+ (string-to-int (buffer-substring-no-properties
|
|
|
1160 (match-beginning 2)
|
|
|
1161 (match-end 2))))
|
|
|
1162 0))))
|
|
|
1163 (if (/= pos 0)
|
|
|
1164 (cons sym pos)
|
|
|
1165 nil)))
|
|
|
1166
|
|
|
1167 (defun speedbar-parse-c-or-c++tag ()
|
|
|
1168 "Parse a c or c++ tag, which tends to be a little complex."
|
|
|
1169 (save-excursion
|
|
|
1170 (let ((bound (save-excursion (end-of-line) (point))))
|
|
|
1171 (cond ((re-search-forward "\C-?\\([^\C-a]+\\)\C-a" bound t)
|
|
|
1172 (buffer-substring-no-properties (match-beginning 1)
|
|
|
1173 (match-end 1)))
|
|
|
1174 ((re-search-forward "\\<\\([^ \t]+\\)\\s-+new(" bound t)
|
|
|
1175 (buffer-substring-no-properties (match-beginning 1)
|
|
|
1176 (match-end 1)))
|
|
|
1177 ((re-search-forward "\\<\\([^ \t(]+\\)\\s-*(\C-?" bound t)
|
|
|
1178 (buffer-substring-no-properties (match-beginning 1)
|
|
|
1179 (match-end 1)))
|
|
|
1180 (t nil))
|
|
|
1181 )))
|
|
|
1182
|
|
|
1183 (defun speedbar-parse-tex-string ()
|
|
|
1184 "Parse a tex string. Only find data which is relevant"
|
|
|
1185 (save-excursion
|
|
|
1186 (let ((bound (save-excursion (end-of-line) (point))))
|
|
|
1187 (cond ((re-search-forward "\\(section\\|chapter\\|cite\\)\\s-*{[^\C-?}]*}?" bound t)
|
|
|
1188 (buffer-substring-no-properties (match-beginning 0)
|
|
|
1189 (match-end 0)))
|
|
|
1190 (t nil)))))
|
|
|
1191
|
|
|
1192
|
|
|
1193 ;;;
|
|
|
1194 ;;; configuration scripts (optional)
|
|
|
1195 ;;;
|
|
|
1196 (defun speedbar-configure-options ()
|
|
|
1197 "Configure variable options for the speedbar program using dlg-config"
|
|
|
1198 (interactive)
|
|
|
1199 (require 'dlg-config)
|
|
|
1200 (save-excursion
|
|
|
1201 (select-frame speedbar-attached-frame)
|
|
|
1202 (dlg-init)
|
|
|
1203 (let ((oframe (create-widget "Speedbar Options" widget-frame
|
|
|
1204 widget-toplevel-shell
|
|
|
1205 :x 2 :y -3
|
|
|
1206 :frame-label "Speedbar Options"))
|
|
|
1207 )
|
|
|
1208 (create-widget "show-unknown" widget-toggle-button oframe
|
|
|
1209 :x 1 :y 1 :label-value "Show files that are not supported by imenu"
|
|
|
1210 :state (data-object-symbol "speedbar-show-unknown-files"
|
|
|
1211 :value speedbar-show-unknown-files
|
|
|
1212 :symbol 'speedbar-show-unknown-files))
|
|
|
1213
|
|
|
1214 (create-widget "raiselower" widget-toggle-button oframe
|
|
|
1215 :x 1 :y -1 :label-value "Use frame auto raise/lower property"
|
|
|
1216 :state (data-object-symbol "speedbar-raise-lower"
|
|
|
1217 :value speedbar-raise-lower
|
|
|
1218 :symbol 'speedbar-raise-lower))
|
|
|
1219
|
|
|
1220 (create-widget "update-speed" widget-label oframe
|
|
|
1221 :x 1 :y -2 :label-value "Update Delay :")
|
|
|
1222 (create-widget "update-speed-txt" widget-text-field oframe
|
|
|
1223 :width 5 :height 1 :x -2 :y t
|
|
|
1224 :value (data-object-symbol-string-to-int
|
|
|
1225 "update-speed"
|
|
|
1226 :symbol 'speedbar-update-speed
|
|
|
1227 :value (int-to-string speedbar-update-speed)))
|
|
|
1228 (create-widget "update-speed-unit" widget-label oframe
|
|
|
1229 :x -3 :y t :label-value "Seconds")
|
|
|
1230
|
|
|
1231 (create-widget "navigating-speed" widget-label oframe
|
|
|
1232 :x 1 :y -1 :label-value "Navigating Delay:")
|
|
|
1233 (create-widget "navigating-speed-txt" widget-text-field oframe
|
|
|
1234 :width 5 :height 1 :x -2 :y t
|
|
|
1235 :value (data-object-symbol-string-to-int
|
|
|
1236 "navigating-speed"
|
|
|
1237 :symbol 'speedbar-navigating-speed
|
|
|
1238 :value (int-to-string speedbar-navigating-speed)))
|
|
|
1239 (create-widget "navigating-speed-unit" widget-label oframe
|
|
|
1240 :x -3 :y t :label-value "Seconds")
|
|
|
1241
|
|
|
1242 (create-widget "width" widget-label oframe
|
|
|
1243 :x 1 :y -2 :label-value "Display Width :")
|
|
|
1244 (create-widget "width-txt" widget-text-field oframe
|
|
|
1245 :width 5 :height 1 :x -2 :y t
|
|
|
1246 :value (data-object-symbol-string-to-int
|
|
|
1247 "width"
|
|
|
1248 :symbol 'speedbar-width
|
|
|
1249 :value (int-to-string speedbar-width)))
|
|
|
1250 (create-widget "width-unit" widget-label oframe
|
|
|
1251 :x -3 :y t :label-value "Characters")
|
|
|
1252
|
|
|
1253 (create-widget "scrollbar-width" widget-label oframe
|
|
|
1254 :x 1 :y -1 :label-value "Scrollbar Width :")
|
|
|
1255 (create-widget "scrollbar-width-txt" widget-text-field oframe
|
|
|
1256 :width 5 :height 1 :x -2 :y t
|
|
|
1257 :value (data-object-symbol-string-to-int
|
|
|
1258 "width"
|
|
|
1259 :symbol 'speedbar-width
|
|
|
1260 :value (int-to-string speedbar-scrollbar-width)))
|
|
|
1261 (create-widget "scrollbar-width-unit" widget-label oframe
|
|
|
1262 :x -3 :y t :label-value "Pixels")
|
|
|
1263
|
|
|
1264
|
|
|
1265 )
|
|
|
1266 (dlg-end)
|
|
|
1267 (dialog-refresh)
|
|
|
1268 ))
|
|
|
1269
|
|
|
1270 (defun speedbar-configure-faces ()
|
|
|
1271 "Configure faces for the speedbar program using dlg-config."
|
|
|
1272 (interactive)
|
|
|
1273 (require 'dlg-config)
|
|
|
1274 (save-excursion
|
|
|
1275 (select-frame speedbar-attached-frame)
|
|
|
1276 (dlg-faces '(speedbar-button-face
|
|
|
1277 speedbar-file-face
|
|
|
1278 speedbar-directory-face
|
|
|
1279 speedbar-tag-face
|
|
|
1280 speedbar-highlight-face
|
|
|
1281 speedbar-selected-face))))
|
|
|
1282
|
|
|
1283 ;;;
|
|
|
1284 ;;; Color loading section This is message *Blech!*
|
|
|
1285 ;;;
|
|
|
1286 (defun speedbar-load-color (sym l-fg l-bg d-fg d-bg &optional bold italic underline)
|
|
|
1287 "Create a color for SYM with a L-FG and L-BG color, or D-FG and
|
|
|
1288 D-BG. Optionally make BOLD, ITALIC, or UNDERLINED if applicable. If
|
|
|
1289 the background attribute of the current frame is determined to be
|
|
|
1290 light (white, for example) then L-FG and L-BG is used. If not, then
|
|
|
1291 D-FG and D-BG is used. This will allocate the colors in the best
|
|
|
1292 possible mannor. This will allow me to store multiple defaults and
|
|
|
1293 dynamically determine which colors to use."
|
|
|
1294 (let* ((params (frame-parameters))
|
|
|
1295 (disp-res (if (fboundp 'x-get-resource)
|
|
|
1296 (if speedbar-xemacsp
|
|
|
1297 (x-get-resource ".displayType" "DisplayType" 'string)
|
|
|
1298 (x-get-resource ".displayType" "DisplayType"))
|
|
|
1299 nil))
|
|
|
1300 (display-type
|
|
|
1301 (cond (disp-res (intern (downcase disp-res)))
|
|
|
1302 ((and (fboundp 'x-display-color-p) (x-display-color-p)) 'color)
|
|
|
1303 (t 'mono)))
|
|
|
1304 (bg-res (if (fboundp 'x-get-resource)
|
|
|
1305 (if speedbar-xemacsp
|
|
|
1306 (x-get-resource ".backgroundMode" "BackgroundMode" 'string)
|
|
|
1307 (x-get-resource ".backgroundMode" "BackgroundMode"))
|
|
|
1308 nil))
|
|
|
1309 (bgmode
|
|
|
1310 (cond (bg-res (intern (downcase bg-res)))
|
|
|
1311 ((and params
|
|
|
1312 (fboundp 'x-color-values)
|
|
|
1313 (< (apply '+ (x-color-values
|
|
|
1314 (cdr (assq 'background-color params))))
|
|
|
1315 (/ (apply '+ (x-color-values "white")) 3)))
|
|
|
1316 'dark)
|
|
|
1317 (t 'light))) ;our default
|
|
|
1318 (set-p (function (lambda (face-name resource)
|
|
|
1319 (if speedbar-xemacsp
|
|
|
1320 (x-get-resource
|
|
|
1321 (concat face-name ".attribute" resource)
|
|
|
1322 (concat "Face.Attribute" resource)
|
|
|
1323 'string)
|
|
|
1324 (x-get-resource
|
|
|
1325 (concat face-name ".attribute" resource)
|
|
|
1326 (concat "Face.Attribute" resource)))
|
|
|
1327 )))
|
|
|
1328 (nbg (cond ((eq bgmode 'dark) d-bg)
|
|
|
1329 (t l-bg)))
|
|
|
1330 (nfg (cond ((eq bgmode 'dark) d-fg)
|
|
|
1331 (t l-fg))))
|
|
|
1332
|
|
|
1333 (if (not (eq display-type 'color))
|
|
|
1334 ;; we need a face of some sort, so just make due with default
|
|
|
1335 (progn
|
|
|
1336 (copy-face 'default sym)
|
|
|
1337 (if bold (condition-case nil
|
|
|
1338 (make-face-bold sym)
|
|
|
1339 (error (message "Cannot make face %s bold!"
|
|
|
1340 (symbol-name sym)))))
|
|
|
1341 (if italic (condition-case nil
|
|
|
1342 (make-face-italic sym)
|
|
|
1343 (error (message "Cannot make face %s italic!"
|
|
|
1344 (symbol-name sym)))))
|
|
|
1345 (set-face-underline-p sym underline)
|
|
|
1346 )
|
|
|
1347 ;; make a colorized version of a face. Be sure to check Xdefaults
|
|
|
1348 ;; for possible overrides first!
|
|
|
1349 (let ((newface (make-face sym)))
|
|
|
1350 ;; For each attribute, check if it might already be set by Xdefaults
|
|
|
1351 (if (and nfg (not (funcall set-p (symbol-name sym) "Foreground")))
|
|
|
1352 (set-face-foreground sym nfg))
|
|
|
1353 (if (and nbg (not (funcall set-p (symbol-name sym) "Background")))
|
|
|
1354 (set-face-background sym nbg))
|
|
|
1355
|
|
|
1356 (if bold (condition-case nil
|
|
|
1357 (make-face-bold sym)
|
|
|
1358 (error (message "Cannot make face %s bold!"
|
|
|
1359 (symbol-name sym)))))
|
|
|
1360 (if italic (condition-case nil
|
|
|
1361 (make-face-italic sym)
|
|
|
1362 (error (message "Cannot make face %s italic!"
|
|
|
1363 (symbol-name sym)))))
|
|
|
1364 (set-face-underline-p sym underline)
|
|
|
1365 ))))
|
|
|
1366
|
|
|
1367 ;; JTL <<<<
|
|
|
1368 (if nil ;;(x-display-color-p) ;; just a quick hack so it will run.
|
|
|
1369 ;; we can use customize for this.
|
|
|
1370 ;; <<<< JTL
|
|
|
1371 (progn
|
|
|
1372 (speedbar-load-color 'speedbar-button-face "green4" "default" "green3" "default")
|
|
|
1373 (speedbar-load-color 'speedbar-file-face "cyan4" nil "cyan" nil nil nil nil)
|
|
|
1374 (speedbar-load-color 'speedbar-directory-face "blue4" nil "light blue" nil nil nil nil)
|
|
|
1375 (speedbar-load-color 'speedbar-tag-face "brown" nil "yellow" nil nil nil nil)
|
|
|
1376 (speedbar-load-color 'speedbar-selected-face "red" nil "red" nil nil nil t)
|
|
|
1377 (speedbar-load-color 'speedbar-highlight-face nil "green" nil "sea green" nil nil nil)
|
|
|
1378 ) ; color
|
|
|
1379 (make-face 'speedbar-button-face)
|
|
|
1380 ;;(make-face 'speedbar-file-face)
|
|
|
1381 (copy-face 'bold 'speedbar-file-face)
|
|
|
1382 (make-face 'speedbar-directory-face)
|
|
|
1383 (make-face 'speedbar-tag-face)
|
|
|
1384 ;;(make-face 'speedbar-selected-face)
|
|
|
1385 (copy-face 'underline 'speedbar-selected-face)
|
|
|
1386 ;;(make-face 'speedbar-highlight-face)
|
|
|
1387 (copy-face 'highlight 'speedbar-highlight-face)
|
|
|
1388
|
|
|
1389 ) ;; monochrome
|
|
|
1390
|
|
|
1391 ;;; end of lisp
|
|
|
1392 (provide 'speedbar)
|
|
|
1393
|
|
|
1394 ;;; speedbar.el ends here
|
