Mercurial > hg > xemacs-beta

comparison lisp/utils/speedbar.el @ 167:85ec50267440 r20-3b10

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b10
author cvs
date Mon, 13 Aug 2007 09:45:46 +0200
parents 4be1180a9e89
children 6075d714658b
comparison
equal deleted inserted replaced
166:7a77eb660975 167:85ec50267440
1 ;;; speedbar - quick access to files and tags 1 ;;; speedbar --- quick access to files and tags -*-byte-compile-warnings:nil;-*-
2 ;;; 2
3 ;;; Copyright (C) 1996 Eric M. Ludlam 3 ;; Copyright (C) 1996, 1997 Eric M. Ludlam
4 ;;; 4 ;;
5 ;;; Author: Eric M. Ludlam <zappo@gnu.ai.mit.edu> 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 $ 6 ;; Version: 0.5
7 ;;; Version: 0.3.1 7 ;; Keywords: file, tags, tools
8 ;;; Keywords: file, tags, tools 8 ;; X-RCS: $Id: speedbar.el,v 1.2 1997/06/29 23:13:33 steve Exp $
9 ;;; 9 ;;
10 ;;; This program is free software; you can redistribute it and/or modify 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 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) 12 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;;; any later version. 13 ;; any later version.
14 ;;; 14 ;;
15 ;;; This program is distributed in the hope that it will be useful, 15 ;; This program is distributed in the hope that it will be useful,
16 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;;; GNU General Public License for more details. 18 ;; GNU General Public License for more details.
19 ;;; 19 ;;
20 ;;; You should have received a copy of the GNU General Public License 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 21 ;; along with this program; if not, you can either send email to this
22 ;;; program's author (see below) or write to: 22 ;; program's author (see below) or write to:
23 ;;; 23 ;;
24 ;;; The Free Software Foundation, Inc. 24 ;; The Free Software Foundation, Inc.
25 ;;; 675 Mass Ave. 25 ;; 675 Mass Ave.
26 ;;; Cambridge, MA 02139, USA. 26 ;; Cambridge, MA 02139, USA.
27 ;;; 27 ;;
28 ;;; Please send bug reports, etc. to zappo@gnu.ai.mit.edu. 28 ;; Please send bug reports, etc. to zappo@gnu.ai.mit.edu.
29 ;;; 29 ;;
30 30
31 ;;; Commentary: 31 ;;; Commentary:
32 ;;; 32 ;;
33 ;;; The speedbar provides a frame in which files, and locations in 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 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. 35 ;; in order to make the last active frame display that file location.
36 ;;; 36 ;;
37 ;;; If you want to choose it from a menu or something, do this: 37 ;; To use speedbar, add this to your .emacs file:
38 ;;; 38 ;;
39 ;;; (autoload 'speedbar-frame-mode "speedbar" "Popup a speedbar frame" t) 39 ;; (autoload 'speedbar-frame-mode "speedbar" "Popup a speedbar frame" t)
40 ;;; (define-key-after (lookup-key global-map [menu-bar tools]) 40 ;; (autoload 'speedbar-get-focus "speedbar" "Jump to speedbar frame" t)
41 ;;; [speedbar] '("Speedbar" . speedbar-frame-mode) [calendar]) 41 ;;
42 ;;; 42 ;; If you want to choose it from a menu or something, do this:
43 ;;; To activate speedbar without the menu, type: M-x speedbar-frame-mode RET 43 ;;
44 ;;; 44 ;; (define-key-after (lookup-key global-map [menu-bar tools])
45 ;;; Once a speedbar frame is active, it takes advantage of idle time 45 ;; [speedbar] '("Speedbar" . speedbar-frame-mode) [calendar])
46 ;;; to keep it's contents updated. The contents is usually a list of 46 ;;
47 ;;; files in the directory of the currently active buffer. When 47 ;; If you want to access speedbar using only the keyboard, do this:
48 ;;; applicable, tags in the active file can be expanded. 48 ;;
49 ;;; 49 ;; (define-key global-map [f4] 'speedbar-get-focus)
50 ;;; Speedbar uses multiple methods for creating tags to jump to. 50 ;;
51 ;;; When the variable `speedbar-use-imenu-package' is set, then 51 ;; This will let you hit f4 (or whatever key you choose) to jump
52 ;;; speedbar will first try to use imenu to get tags. If the mode of 52 ;; focus to the speedbar frame. Pressing RET or e to jump to a file
53 ;;; the buffer doesn't support imenu, then etags is used. Using Imenu 53 ;; or tag will move you back to the attached frame. The command
54 ;;; has the advantage that tags are cached, so opening and closing 54 ;; `speedbar-get-fucus' will also create a speedbar frame if it does
55 ;;; tags lists is faster. Speedbar-imenu will also load the file into 55 ;; not exist.
56 ;;; a non-selected buffer so clicking the file later will be faster. 56 ;;
57 ;;; 57 ;; Once a speedbar frame is active, it takes advantage of idle time
58 ;;; To add new files types into the speedbar, modify 58 ;; to keep it's contents updated. The contents is usually a list of
59 ;;; `speedbar-file-regexp' to include the extension of the file type 59 ;; files in the directory of the currently active buffer. When
60 ;;; you wish to include. If speedbar complains that the file type is 60 ;; applicable, tags in the active file can be expanded.
61 ;;; not supported, that means there is no built in support from imenu, 61 ;;
62 ;;; and the etags part wasn't set up right. 62 ;; To add new supported files types into speedbar, use the function
63 ;;; 63 ;; `speedbar-add-supported-extension' If speedbar complains that the
64 ;;; To add new file types to imenu, see the documentation in the 64 ;; file type is not supported, that means there is no built in
65 ;;; file imenu.el that comes with emacs. To add new file types which 65 ;; support from imenu, and the etags part wasn't set up correctly. You
66 ;;; etags supports, you need to modify the variable 66 ;; may add elements to `speedbar-supported-extension-expressions' as long
67 ;;; `speedbar-fetch-etags-parse-list'. This variable is an 67 ;; as it is done before speedbar is loaded.
68 ;;; association list with each element of the form: (extension-regex 68 ;;
69 ;;; . parse-one-line) The extension-regex would be something like 69 ;; To prevent speedbar from following you into certain directories
70 ;;; "\\.c$" for a .c file, and the parse-one-line would be either a 70 ;; use the function `speedbar-add-ignored-path-regexp' too add a new
71 ;;; regular expression where match tag 1 is the element you wish 71 ;; regular expression matching a type of path. You may add list
72 ;;; displayed as a tag. If you need to do something more complex, 72 ;; elements to `speedbar-ignored-path-expressions' as long as it is
73 ;;; then you can also write a function which parses one line, and put 73 ;; done before speedbar is loaded.
74 ;;; its symbol there instead. 74 ;;
75 ;;; 75 ;; To add new file types to imenu, see the documentation in the
76 ;;; If the updates are going to slow for you, modify the variable 76 ;; file imenu.el that comes with emacs. To add new file types which
77 ;;; `speedbar-update-speed' to a longer idle time before updates. 77 ;; etags supports, you need to modify the variable
78 ;;; 78 ;; `speedbar-fetch-etags-parse-list'.
79 ;;; If you navigate directories, you will probably notice that you 79 ;;
80 ;;; will navigate to a directory which is eventually replaced after 80 ;; If the updates are going too slow for you, modify the variable
81 ;;; you go back to editing a file (unless you pull up a new file.) 81 ;; `speedbar-update-speed' to a longer idle time before updates.
82 ;;; The delay time before this happens is in 82 ;;
83 ;;; `speedbar-navigating-speed', and defaults to 20 seconds. 83 ;; If you navigate directories, you will probably notice that you
84 ;;; 84 ;; will navigate to a directory which is eventually replaced after
85 ;;; XEmacs users may want to change the default timeouts for 85 ;; you go back to editing a file (unless you pull up a new file.)
86 ;;; `speedbar-update-speed' to something longer as XEmacs doesn't have 86 ;; The delay time before this happens is in
87 ;;; idle timers, the speedbar timer keeps going off arbitrarilly while 87 ;; `speedbar-navigating-speed', and defaults to 10 seconds.
88 ;;; you're typing. It's quite pesky. 88 ;;
89 ;;; 89 ;; XEmacs users may want to change the default timeouts for
90 ;;; To get speedbar-configure-faces to work, you will need to 90 ;; `speedbar-update-speed' to something longer as XEmacs doesn't have
91 ;;; download my eieio package from my ftp site. 91 ;; idle timers, the speedbar timer keeps going off arbitrarilly while
92 ;;; 92 ;; you're typing. It's quite pesky.
93 ;;; EIEIO is NOT required when using speedbar. It is ONLY needed 93 ;;
94 ;;; if you want to use a fancy dialog face editor for speedbar. 94 ;; Users of emacs previous to to v 19.31 (when idle timers
95 ;; where introduced) will not have speedbar updating automatically.
96 ;; Use "r" to refresh the display after changing directories.
97 ;; Remember, do not interrupt the stealthy updates or you display may
98 ;; not be completely refreshed.
99 ;;
100 ;; See optional file `speedbspec.el' for additional configurations
101 ;; which allow speedbar to create specialized lists for special modes
102 ;; that are not file-related.
103 ;;
104 ;; See optional file `speedbcfg.el' for interactive buffers
105 ;; allowing simple configuration of colors and features of speedbar.
106 ;;
107 ;; AUC-TEX users: The imenu tags for AUC-TEX mode don't work very
108 ;; well. Use the imenu keywords from tex-mode.el for better results.
109 ;;
110 ;; This file requires the library package assoc (association lists)
95 111
96 ;;; Speedbar updates can be found at: 112 ;;; Speedbar updates can be found at:
97 ;;; ftp://ftp.ultranet.com/pub/zappo/speedbar.*.el 113 ;; ftp://ftp.ultranet.com/pub/zappo/speedbar*.tar.gz
98 ;;; 114 ;;
99 115
100 ;;; HISTORY: 116 ;;; Change log:
101 ;;; 0.1 Initial Revision 117 ;; 0.1 Initial Revision
102 ;;; 0.2 Fixed problem with x-pointer-shape causing future frames not 118 ;; 0.2 Fixed problem with x-pointer-shape causing future frames not
103 ;;; to be created. 119 ;; to be created.
104 ;;; Fixed annoying habit of `speedbar-update-contents' to make 120 ;; Fixed annoying habit of `speedbar-update-contents' to make
105 ;;; it possible to accidentally kill the speedbar buffer. 121 ;; it possible to accidentally kill the speedbar buffer.
106 ;;; Clicking directory names now only changes the contents of 122 ;; Clicking directory names now only changes the contents of
107 ;;; the speedbar, and does not cause a dired mode to appear. 123 ;; the speedbar, and does not cause a dired mode to appear.
108 ;;; Clicking the <+> next to the directory does cause dired to 124 ;; Clicking the <+> next to the directory does cause dired to
109 ;;; be run. 125 ;; be run.
110 ;;; Added XEmacs support, which means timer support moved to a 126 ;; Added XEmacs support, which means timer support moved to a
111 ;;; platform independant call. 127 ;; platform independant call.
112 ;;; Added imenu support. Now modes are supported by imenu 128 ;; Added imenu support. Now modes are supported by imenu
113 ;;; first, and etags only if the imenu call doesn't work. 129 ;; first, and etags only if the imenu call doesn't work.
114 ;;; Imenu is a little faster than etags, and is more emacs 130 ;; Imenu is a little faster than etags, and is more emacs
115 ;;; friendly. 131 ;; friendly.
116 ;;; Added more user control variables described in the commentary. 132 ;; Added more user control variables described in the commentary.
117 ;;; Added smart recentering when nodes are opened and closed. 133 ;; 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. 134 ;; 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. 135 ;; Added invisible codes to the beginning of each line.
120 ;;; Added list aproach to node expansion for easier addition of new 136 ;; Added list aproach to node expansion for easier addition of new
121 ;;; types of things to expand by 137 ;; types of things to expand by
122 ;;; Added multi-level path name support 138 ;; Added multi-level path name support
123 ;;; Added multi-level tag name support. 139 ;; Added multi-level tag name support.
124 ;;; Only mouse-2 is now used for node expansion 140 ;; Only mouse-2 is now used for node expansion
125 ;;; Added keys e + - to edit expand, and contract node lines 141 ;; Added keys e + - to edit expand, and contract node lines
126 ;;; Added longer legal file regexp for all those modes which support 142 ;; Added longer legal file regexp for all those modes which support
127 ;;; imenu. (pascal, fortran90, ada, pearl) 143 ;; imenu. (pascal, fortran90, ada, pearl)
128 ;;; Fixed centering algorithm 144 ;; Added pascal support to etags from Dave Penkler <dave_penkler@grenoble.hp.com>
129 ;;; Tried to choose background independent colors. Made more robust. 145 ;; Fixed centering algorithm
130 ;;; Rearranged code into a more logical order 146 ;; Tried to choose background independent colors. Made more robust.
131 ;;; 0.3.1 Fixed doc & broken keybindings 147 ;; Rearranged code into a more logical order
132 ;;; Added mode hooks. 148 ;; 0.3.1 Fixed doc & broken keybindings
133 ;;; Improved color selection to be background mode smart 149 ;; Added mode hooks.
134 ;;; `nil' passed to `speedbar-frame-mode' now toggles the frame as 150 ;; Improved color selection to be background mode smart
135 ;;; advertised in the doc string 151 ;; `nil' passed to `speedbar-frame-mode' now toggles the frame as
136 ;;; 152 ;; advertised in the doc string
153 ;; 0.4a Added modified patch from Dan Schmidt <dfan@lglass.com> allowing a
154 ;; directory cache to be maintained speeding up revisiting of files.
155 ;; Default raise-lower behavior is now off by default.
156 ;; Added some menu items for edit expand and contract.
157 ;; Pre 19.31 emacsen can run without idle timers.
158 ;; Added some patch information from Farzin Guilak <farzin@protocol.com>
159 ;; adding xemacs specifics, and some etags upgrades.
160 ;; Added ability to set a faces symbol-value to a string
161 ;; representing the desired foreground color. (idea from
162 ;; Farzin Guilak, but implemented differently)
163 ;; Fixed problem with 1 character buttons.
164 ;; Added support for new Imenu marker technique.
165 ;; Added `speedbar-load-hooks' for things to run only once on
166 ;; load such as updating one of the many lists.
167 ;; Added `speedbar-supported-extension-expressions' which is a
168 ;; list of extensions that speedbar will tag. This variable
169 ;; should only be updated with `speedbar-add-supported-extension'
170 ;; Moved configure dialog support to a separate file so
171 ;; speedbar is not dependant on eieio to run
172 ;; Fixed list-contraction problem when the item was at the end
173 ;; of a sublist.
174 ;; Fixed XEmacs multi-frame timer selecting bug problem.
175 ;; Added `speedbar-ignored-modes' which is a list of major modes
176 ;; speedbar will not follow when it is displayed in the selected frame
177 ;; 0.4 When the file being edited is not in the list, and is a file
178 ;; that should be in the list, the speedbar cache is replaced.
179 ;; Temp buffers are now shown in the attached frame not the
180 ;; speedbar frame
181 ;; New variables `speedbar-vc-*' and `speedbar-stealthy-function-list'
182 ;; added. `speedbar-update-current-file' is now a member of
183 ;; the stealthy list. New function `speedbar-check-vc' will
184 ;; examine each file and mark it if it is checked out. To
185 ;; add new version control types, override the function
186 ;; `speedbar-this-file-in-vc' and `speedbar-vc-check-dir-p'.
187 ;; The stealth list is interruptible so that long operations
188 ;; do not interrupt someones editing flow. Other long
189 ;; speedbar updates will be added to the stealthy list in the
190 ;; future should interesting ones be needed.
191 ;; Added many new functions including:
192 ;; `speedbar-item-byte-compile' `speedbar-item-load'
193 ;; `speedbar-item-copy' `speedbar-item-rename' `speedbar-item-delete'
194 ;; and `speedbar-item-info'
195 ;; If the user kills the speedbar buffer in some way, the frame will
196 ;; be removed.
197 ;; 0.4.1 Bug fixes
198 ;; <mark.jeffries@nomura.co.uk> added `speedbar-update-flag',
199 ;; XEmacs fixes for menus, and tag sorting, and quit key.
200 ;; Modeline now updates itself based on window-width.
201 ;; Frame is cached when closed to make pulling it up again faster.
202 ;; Speedbars window is now marked as dedicated.
203 ;; Added bindings: <grossjoh@charly.informatik.uni-dortmund.de>
204 ;; Long directories are now span multiple lines autmoatically
205 ;; Added `speedbar-directory-button-trim-method' to specify how to
206 ;; sorten the directory button to fit on the screen.
207 ;; 0.4.2 Add one level of full-text cache.
208 ;; Add `speedbar-get-focus' to switchto/raise the speedbar frame.
209 ;; Editing thing-on-line will auto-raise the attached frame.
210 ;; Bound `U' to `speedbar-up-directory' command.
211 ;; Refresh will now maintain all subdirectories that were open
212 ;; when the refresh was requested. (This does not include the
213 ;; tags, only the directories)
214 ;; 0.4.3 Bug fixes
215 ;; 0.4.4 Added `speedbar-ignored-path-expressions' and friends.
216 ;; Configuration menu items not displayed if dialog-mode not present
217 ;; Speedbar buffer now starts with a space, and is not deleted
218 ;; ewhen the speedbar frame is closed. This prevents the invisible
219 ;; frame from preventing buffer switches with other buffers.
220 ;; Fixed very bad bug in the -add-[extension|path] functions.
221 ;; Added `speedbar-find-file-in-frame' which will always pop up a frame
222 ;; that is already display a buffer selected in the speedbar buffer.
223 ;; Added S-mouse2 as "power click" for always poping up a new frame.
224 ;; and always rescanning with imenu (ditching the imenu cache), and
225 ;; always rescanning directories.
226 ;; 0.4.5 XEmacs bugfixes and enhancements.
227 ;; Window Title simplified.
228 ;; 0.4.6 Fixed problems w/ dedicated minibuffer frame.
229 ;; Fixed errors reported by checkdoc.
230 ;; 0.5 Mode-specific contents added. Controlled w/ the variable
231 ;; `speedbar-mode-specific-contents-flag'. See speedbspec
232 ;; for info on enabling this feature.
233 ;; `speedbar-load-hook' name change and pointer check against
234 ;; major-mode. Suggested by Sam Steingold <sds@ptc.com>
235 ;; Quit auto-selects the attached frame.
236 ;; Ranamed `speedbar-do-updates' to `speedbar-update-flag'
237 ;; Passes checkdoc.
238
137 ;;; TODO: 239 ;;; TODO:
138 ;;; 1) Rember contents of directories when leaving them so it's faster 240 ;; 1) More functions to create buttons and options
139 ;;; when returning. 241 ;; 2) filtering algoritms to reduce the number of tags/files displayed.
140 ;;; 2) List of directories to never visit. (User might be browsing 242 ;; 3) Timeout directories we haven't visited in a while.
141 ;;; there temporarilly such as info files, documentation and the 243 ;; 4) Remeber tags when refreshing the display. (Refresh tags too?)
142 ;;; like) 244 ;; 5) More 'special mode support.
143 ;;; 3) Implement SHIFT-mouse2 to rescan buffers with imenu. 245 ;; 6) Smart way to auto-expand instead of directory switch
144 ;;; 4) Better XEmacs support of menus and button-bar 246
145 ;;; 5) More functions to create buttons and options 247 ;;; Code:
146 ;;; 6) filtering algoritms to reduce the number of tags/files 248 (require 'assoc)
147 ;;; displayed. 249 (require 'easymenu)
148 ;;; 7) Build `speedbar-file-regexp' on the fly. 250
149 ;;; 8) More intelligent current file highlighting. 251 (defvar speedbar-xemacsp (string-match "XEmacs" emacs-version)
150 252 "Non-nil if we are running in the XEmacs environment.")
151 (defvar speedbar-xemacsp (string-match "XEmacs" emacs-version))
152 253
153 (defvar speedbar-initial-expansion-list 254 (defvar speedbar-initial-expansion-list
154 '(speedbar-directory-buttons speedbar-default-directory-list) 255 '(speedbar-directory-buttons speedbar-default-directory-list)
155 "*List of functions to call to fill in the speedbar buffer whenever 256 "List of functions to call to fill in the speedbar buffer.
156 a top level update is issued. These functions will allways get the 257 Whenever a top level update is issued all functions in this list are
157 default directory to use passed in as the first parameter, and a 0 as 258 run. These functions will always get the default directory to use
158 the second parameter. They must assume that the cursor is at the 259 passed in as the first parameter, and a 0 as the second parameter.
159 postion where they start inserting buttons.") 260 The 0 indicates the uppermost indentation level. They must assume
261 that the cursor is at the position where they start inserting
262 buttons.")
263
264 (defvar speedbar-stealthy-function-list
265 '(speedbar-update-current-file speedbar-check-vc)
266 "List of functions to periodically call stealthily.
267 Each function must return nil if interrupted, or t if completed.
268 Stealthy functions which have a single operation should always return
269 t. Functions which take a long time should maintain a state (where
270 they are in their speedbar related calculations) and permit
271 interruption. See `speedbar-check-vc' as a good example.")
272
273 (defvar speedbar-mode-specific-contents-flag t
274 "*Non-nil means speedbar will show specail-mode contents.
275 This permits some modes to create customized contents for the speedbar
276 frame.")
277
278 (defvar speedbar-special-mode-expansion-list nil
279 "Mode specific list of functions to call to fill in speedbar.
280 Some modes, such as Info or RMAIL, do not relate quite as easily into
281 a simple list of files. When this variable is non-nil and buffer-local,
282 then these functions are used, creating specialized contents. These
283 functions are called each time the speedbar timer is called. This
284 allows a mode to update it's contents regularly.
285
286 Each function is called with the default and frame belonging to
287 speedbar, and with one parameter; the buffer requesting
288 the speedbar display.")
289
290 (defvar speedbar-load-hook nil
291 "Hooks run when speedbar is loaded.")
292
293 (defvar speedbar-desired-buffer nil
294 "Non-nil when speedbar is showing buttons specific a special mode.
295 In this case it is the originating buffer.")
160 296
161 (defvar speedbar-show-unknown-files nil 297 (defvar speedbar-show-unknown-files nil
162 "*Non-nil shows files with a ? in the expansion tag for files we can't 298 "*Non-nil show files we can't expand with a ? in the expand button.
163 expand. `nil' means don't show the file in the list.") 299 nil means don't show the file in the list.")
164 300
165 ;; Xemacs timers aren't based on idleness. Therefore tune it down a little 301 ;; Xemacs timers aren't based on idleness. Therefore tune it down a little
166 ;; or suffer mightilly! 302 ;; or suffer mightilly!
167 (defvar speedbar-update-speed (if speedbar-xemacsp 5 1) 303 (defvar speedbar-update-speed (if speedbar-xemacsp 5 1)
168 "*Time in seconds of idle time needed before speedbar will update 304 "*Idle time in seconds needed before speedbar will update itself.
169 it's buffer to match what you've been doing in your other frame.") 305 Updates occur to allow speedbar to display directory information
306 relevant to the buffer you are currently editing.")
170 (defvar speedbar-navigating-speed 10 307 (defvar speedbar-navigating-speed 10
171 "*Idle time to wait before re-running the timer proc to pick up any new 308 "*Idle time to wait after navigation commands in speedbar are executed.
172 activity if the user has started navigating directories in the speedbar.") 309 Navigation commands included expanding/contracting nodes, and moving
173 310 between different directories.")
174 (defvar speedbar-width 20 311
175 "*Initial size of the speedbar window") 312 (defvar speedbar-frame-parameters (list
176 313 ;; Xemacs fails to delete speedbar
177 (defvar speedbar-scrollbar-width 10 314 ;; if minibuffer is off.
178 "*Initial sizeo of the speedbar scrollbar. The thinner, the more 315 ;(cons 'minibuffer
179 display room you will have.") 316 ; (if speedbar-xemacsp t nil))
180 317 ;; The above behavior seems to have fixed
181 (defvar speedbar-raise-lower t 318 ;; itself somewhere along the line.
182 "*Non-nil means speedbar will auto raise and lower itself. When this 319 ;; let me know if any problems arise.
183 is set, you can have only a tiny strip visible under your main emacs, 320 '(minibuffer . nil)
184 and it will raise and lower itself when you put the pointer in it.") 321 '(width . 20)
185 322 '(scroll-bar-width . 10)
186 (defvar speedbar-use-imenu-package (not speedbar-xemacsp) 323 '(border-width . 0)
187 "*Optionally use the imenu package instead of etags for parsing. This 324 '(unsplittable . t) )
188 is experimental for performace testing.") 325 "*Parameters to use when creating the speedbar frame.
326 Parameters not listed here which will be added automatically are
327 `height' which will be initialized to the height of the frame speedbar
328 is attached to. To add more frame defaults, `cons' new alist members
329 onto this variable through the `speedbar-load-hook'")
330
331 (defvar speedbar-use-imenu-flag (stringp (locate-library "imenu"))
332 "*Non-nil means use imenu for file parsing. nil to use etags.
333 XEmacs doesn't support imenu, therefore the default is to use etags
334 instead. Etags support is not as robust as imenu support.")
335
336 (defvar speedbar-sort-tags nil
337 "*If Non-nil, sort tags in the speedbar display. (Etags only)
338 See imenu.el source for how imenu does sorting.")
339
340 (defvar speedbar-directory-button-trim-method 'span
341 "*Indicates how the directory button will be displayed.
342 Possible values are:
343 'span - span large directories over multiple lines.
344 'trim - trim large directories to only show the last few.
345 nil - no trimming.")
189 346
190 (defvar speedbar-before-delete-hook nil 347 (defvar speedbar-before-delete-hook nil
191 "*Hooks called before deletiing the speedbar frame.") 348 "*Hooks called before deleting the speedbar frame.")
192 349
193 (defvar speedbar-mode-hook nil 350 (defvar speedbar-mode-hook nil
194 "*Hooks called after creating a speedbar buffer") 351 "*Hooks called after creating a speedbar buffer.")
195 352
196 (defvar speedbar-timer-hook nil 353 (defvar speedbar-timer-hook nil
197 "*Hooks called after running the speedbar timer function") 354 "*Hooks called after running the speedbar timer function.")
355
356 (defvar speedbar-verbosity-level 1
357 "*Verbosity level of the speedbar. 0 means say nothing.
358 1 means medium level verbosity. 2 and higher are higher levels of
359 verbosity.")
360
361 (defvar speedbar-vc-indicator " *"
362 "*Text used to mark files which are currently checked out.
363 Currently only RCS is supported. Other version control systems can be
364 added by examining the function `speedbar-this-file-in-vc' and
365 `speedbar-vc-check-dir-p'")
366
367 (defvar speedbar-vc-do-check t
368 "*Non-nil check all files in speedbar to see if they have been checked out.
369 Any file checked out is marked with `speedbar-vc-indicator'")
370
371 (defvar speedbar-vc-to-do-point nil
372 "Local variable maintaining the current version control check position.")
373
374 (defvar speedbar-ignored-modes nil
375 "*List of major modes which speedbar will not switch directories for.")
376
377 (defvar speedbar-ignored-path-expressions
378 '("/log/$")
379 "*List of regular expressions matching directories speedbar will ignore.
380 They should included paths to directories which are notoriously very
381 large and take a long time to load in. Use the function
382 `speedbar-add-ignored-path-regexp' to add new items to this list after
383 speedbar is loaded. You may place anything you like in this list
384 before speedbar has been loaded.")
198 385
199 (defvar speedbar-file-unshown-regexp 386 (defvar speedbar-file-unshown-regexp
200 (let ((nstr "") (noext completion-ignored-extensions)) 387 (let ((nstr "") (noext completion-ignored-extensions))
201 (while noext 388 (while noext
202 (setq nstr (concat nstr (regexp-quote (car noext)) "$" 389 (setq nstr (concat nstr (regexp-quote (car noext)) "$"
203 (if (cdr noext) "\\|" "")) 390 (if (cdr noext) "\\|" ""))
204 noext (cdr noext))) 391 noext (cdr noext)))
205 (concat nstr "\\|#[^#]+#$\\|\\.\\.?$")) 392 (concat nstr "\\|#[^#]+#$\\|\\.\\.?$"))
206 "*Regular expression matching files we don't want to display in a 393 "*Regexp matching files we don't want displayed in a speedbar buffer.
207 speedbar buffer") 394 It is generated from the variable `completion-ignored-extensions'")
208 395
209 (defvar speedbar-file-regexp 396 (defvar speedbar-supported-extension-expressions
210 (if speedbar-use-imenu-package 397 (append '(".[CcHh]\\(++\\|pp\\|c\\|h\\)?" ".tex\\(i\\(nfo\\)?\\)?"
211 "\\(\\.\\([CchH]\\|c\\(++\\|pp\\)\\|f90\\|ada\\|pl?\\|el\\|t\\(ex\\(i\\(nfo\\)?\\)?\\|cl\\)\\|emacs\\)$\\)\\|[Mm]akefile\\(\\.in\\)?" 398 ".el" ".emacs" ".p" ".java")
212 "\\.\\([CchH]\\|c\\(++\\|pp\\)\\|p\\|el\\|tex\\(i\\(nfo\\)?\\)?\\|emacs\\)$") 399 (if speedbar-use-imenu-flag
213 "*Regular expresson matching files we know how to expand.") 400 '(".f90" ".ada" ".pl" ".tcl" ".m"
401 "Makefile\\(\\.in\\)?")))
402 "*List of regular expressions which will match files supported by tagging.
403 Do not prefix the `.' char with a double \\ to quote it, as the period
404 will be stripped by a simplified optimizer when compiled into a
405 singular expression. This variable will be turned into
406 `speedbar-file-regexp' for use with speedbar. You should use the
407 function `speedbar-add-supported-extension' to add a new extension at
408 runtime, or use the configuration dialog to set it in your .emacs
409 file.")
410
411 (defun speedbar-extension-list-to-regex (extlist)
412 "Takes EXTLIST, a list of extensions and transforms it into regexp.
413 All the preceding . are stripped for an optimized expression starting
414 with . followed by extensions, followed by full-filenames."
415 (let ((regex1 nil) (regex2 nil))
416 (while extlist
417 (if (= (string-to-char (car extlist)) ?.)
418 (setq regex1 (concat regex1 (if regex1 "\\|" "")
419 (substring (car extlist) 1)))
420 (setq regex2 (concat regex2 (if regex2 "\\|" "") (car extlist))))
421 (setq extlist (cdr extlist)))
422 ;; concat all the sub-exressions together, making sure all types
423 ;; of parts exist during concatination.
424 (concat "\\("
425 (if regex1 (concat "\\(\\.\\(" regex1 "\\)\\)") "")
426 (if (and regex1 regex2) "\\|" "")
427 (if regex2 (concat "\\(" regex2 "\\)") "")
428 "\\)$")))
429
430 (defvar speedbar-ignored-path-regexp
431 (speedbar-extension-list-to-regex speedbar-ignored-path-expressions)
432 "Regular expression matching paths speedbar will not switch to.
433 Created from `speedbar-ignored-path-expressions' with the function
434 `speedbar-extension-list-to-regex' (A misnamed function in this case.)
435 Use the function `speedbar-add-ignored-path-regexp' to modify this
436 variable.")
437
438 (defvar speedbar-file-regexp
439 (speedbar-extension-list-to-regex speedbar-supported-extension-expressions)
440 "Regular expression matching files we know how to expand.
441 Created from `speedbar-supported-extension-expression' with the
442 function `speedbar-extension-list-to-regex'")
443
444 (defun speedbar-add-supported-extension (extension)
445 "Add EXTENSION as a new supported extension for speedbar tagging.
446 This should start with a `.' if it is not a complete file name, and
447 the dot should NOT be quoted in with \\. Other regular expression
448 matchers are allowed however. EXTENSION may be a single string or a
449 list of strings."
450 (if (not (listp extension)) (setq extension (list extension)))
451 (while extension
452 (if (member (car extension) speedbar-supported-extension-expressions)
453 nil
454 (setq speedbar-supported-extension-expressions
455 (cons (car extension) speedbar-supported-extension-expressions)))
456 (setq extension (cdr extension)))
457 (setq speedbar-file-regexp (speedbar-extension-list-to-regex
458 speedbar-supported-extension-expressions)))
459
460 (defun speedbar-add-ignored-path-regexp (path-expression)
461 "Add PATH-EXPRESSION as a new ignored path for speedbar tracking.
462 This function will modify `speedbar-ignored-path-regexp' and add
463 PATH-EXPRESSION to `speedbar-ignored-path-expressions'."
464 (if (not (listp path-expression))
465 (setq path-expression (list path-expression)))
466 (while path-expression
467 (if (member (car path-expression) speedbar-ignored-path-expressions)
468 nil
469 (setq speedbar-ignored-path-expressions
470 (cons (car path-expression) speedbar-ignored-path-expressions)))
471 (setq path-expression (cdr path-expression)))
472 (setq speedbar-ignored-path-regexp (speedbar-extension-list-to-regex
473 speedbar-ignored-path-expressions)))
474
475 (defvar speedbar-update-flag (or (not (fboundp 'run-with-idle-timer))
476 (not (fboundp 'start-itimer)))
477 "*Non-nil means to automatically update the display.
478 When this is nil then speedbar will not follow the attached frame's path.
479 When speedbar is active, use:
480
481 \\<speedbar-key-map> `\\[speedbar-toggle-updates]'
482
483 to toggle this value.")
214 484
215 (defvar speedbar-syntax-table nil 485 (defvar speedbar-syntax-table nil
216 "Syntax-table used on the speedbar") 486 "Syntax-table used on the speedbar.")
217 487
218 (if speedbar-syntax-table 488 (if speedbar-syntax-table
219 nil 489 nil
220 (setq speedbar-syntax-table (make-syntax-table)) 490 (setq speedbar-syntax-table (make-syntax-table))
221 ;; turn off paren matching around here. 491 ;; turn off paren matching around here.
223 (modify-syntax-entry ?\" " " speedbar-syntax-table) 493 (modify-syntax-entry ?\" " " speedbar-syntax-table)
224 (modify-syntax-entry ?( " " speedbar-syntax-table) 494 (modify-syntax-entry ?( " " speedbar-syntax-table)
225 (modify-syntax-entry ?) " " speedbar-syntax-table) 495 (modify-syntax-entry ?) " " speedbar-syntax-table)
226 (modify-syntax-entry ?[ " " speedbar-syntax-table) 496 (modify-syntax-entry ?[ " " speedbar-syntax-table)
227 (modify-syntax-entry ?] " " speedbar-syntax-table)) 497 (modify-syntax-entry ?] " " speedbar-syntax-table))
228 498
229 499
230 (defvar speedbar-key-map nil 500 (defvar speedbar-key-map nil
231 "Keymap used in speedbar buffer.") 501 "Keymap used in speedbar buffer.")
232 (defvar speedbar-menu-map nil 502
233 "Keymap used in speedbar menu buffer.") 503 (autoload 'speedbar-configure-options "speedbcfg" "Configure speedbar variables" t)
504 (autoload 'speedbar-configure-faces "speedbcfg" "Configure speedbar faces" t)
234 505
235 (if speedbar-key-map 506 (if speedbar-key-map
236 nil 507 nil
237 (setq speedbar-key-map (make-keymap)) 508 (setq speedbar-key-map (make-keymap))
238 (suppress-keymap speedbar-key-map t) 509 (suppress-keymap speedbar-key-map t)
239 510
511 ;; control
240 (define-key speedbar-key-map "e" 'speedbar-edit-line) 512 (define-key speedbar-key-map "e" 'speedbar-edit-line)
513 (define-key speedbar-key-map "\C-m" 'speedbar-edit-line)
241 (define-key speedbar-key-map "+" 'speedbar-expand-line) 514 (define-key speedbar-key-map "+" 'speedbar-expand-line)
242 (define-key speedbar-key-map "-" 'speedbar-contract-line) 515 (define-key speedbar-key-map "-" 'speedbar-contract-line)
516 (define-key speedbar-key-map "g" 'speedbar-refresh)
517 (define-key speedbar-key-map "t" 'speedbar-toggle-updates)
518 (define-key speedbar-key-map "q" 'speedbar-close-frame)
519 (define-key speedbar-key-map "U" 'speedbar-up-directory)
520
521 ;; navigation
522 (define-key speedbar-key-map "n" 'speedbar-next)
523 (define-key speedbar-key-map "p" 'speedbar-prev)
524 (define-key speedbar-key-map " " 'speedbar-scroll-up)
525 (define-key speedbar-key-map "\C-?" 'speedbar-scroll-down)
526
527 ;; After much use, I suddenly desired in my heart to perform dired
528 ;; style operations since the directory was RIGHT THERE!
529 (define-key speedbar-key-map "I" 'speedbar-item-info)
530 (define-key speedbar-key-map "B" 'speedbar-item-byte-compile)
531 (define-key speedbar-key-map "L" 'speedbar-item-load)
532 (define-key speedbar-key-map "C" 'speedbar-item-copy)
533 (define-key speedbar-key-map "D" 'speedbar-item-delete)
534 (define-key speedbar-key-map "R" 'speedbar-item-rename)
243 535
244 (if (string-match "XEmacs" emacs-version) 536 (if (string-match "XEmacs" emacs-version)
245 (progn 537 (progn
246 ;; bind mouse bindings so we can manipulate the items on each line 538 ;; bind mouse bindings so we can manipulate the items on each line
247 (define-key speedbar-key-map 'button2 'speedbar-click) 539 (define-key speedbar-key-map 'button2 'speedbar-click)
248 540 (define-key speedbar-key-map '(shift button2) 'speedbar-power-click)
249 ;; Xemacs users. You probably want your own toolbar for 541 (define-key speedbar-key-map '(meta button3) 'speedbar-mouse-item-info)
250 ;; the speedbar frame or mode or whatever. Make some buttons 542
251 ;; and mail me how to do it! 543 ;; Setup XEmacs Menubar w/ etags specific items
252 ;; Also, how do you disable all those menu items? Email me that too 544 (defvar speedbar-menu
253 ;; as it would be most helpful. 545 '("Speed Bar"
546 ["Run Speedbar" (speedbar-frame-mode 1) t]
547 ["Refresh" speedbar-refresh t]
548 ["Allow Auto Updates"
549 speedbar-toggle-updates
550 :style toggle
551 :selected speedbar-update-flag]
552 "-----"
553 ["Sort etags in Speedbar"
554 (speedbar-toggle-etags "sort")
555 :style toggle
556 :selected speedbar-sort-tags]
557 ["Show unknown files"
558 (speedbar-toggle-etags "show")
559 :style toggle
560 :selected speedbar-show-unknown-files]
561 "-----"
562 ["Use C++ Tagging"
563 (speedbar-toggle-etags "-C")
564 :style toggle
565 :selected (member "-C" speedbar-fetch-etags-arguments)]
566 ["Tag preprocessor defs"
567 (speedbar-toggle-etags "-D")
568 :style toggle
569 :selected (not (member "-D" speedbar-fetch-etags-arguments))]
570 ["Use indentation"
571 (speedbar-toggle-etags "-S")
572 :style toggle
573 :selected (not (member "-S" speedbar-fetch-etags-arguments))]))
574
575 (add-submenu '("Tools") speedbar-menu nil)
576
254 ) 577 )
255 ;; bind mouse bindings so we can manipulate the items on each line 578 ;; bind mouse bindings so we can manipulate the items on each line
256 (define-key speedbar-key-map [mouse-2] 'speedbar-click) 579 (define-key speedbar-key-map [mouse-2] 'speedbar-click)
257 (define-key speedbar-key-map [down-mouse-2] 'speedbar-quick-mouse) 580 ;; This is the power click for poping up new frames
258 581 (define-key speedbar-key-map [S-mouse-2] 'speedbar-power-click)
259 ;; this was meant to do a rescan or something 582 ;; This adds a small unecessary visual effect
260 ;;(define-key speedbar-key-map [shift-mouse-2] 'speedbar-hard-click) 583 ;;(define-key speedbar-key-map [down-mouse-2] 'speedbar-quick-mouse)
584 (define-key speedbar-key-map [M-mouse-2] 'speedbar-mouse-item-info)
261 585
262 ;; disable all menus - we don't have a lot of space to play with 586 ;; disable all menus - we don't have a lot of space to play with
263 ;; in such a skinny frame. 587 ;; in such a skinny frame. This will cleverly find and nuke some
264 (define-key speedbar-key-map [menu-bar buffer] 'undefined) 588 ;; user-defined menus as well if they are there. Too bad it
265 (define-key speedbar-key-map [menu-bar files] 'undefined) 589 ;; rely's on the structure of a keymap to work.
266 (define-key speedbar-key-map [menu-bar tools] 'undefined) 590 (let ((k (lookup-key global-map [menu-bar])))
267 (define-key speedbar-key-map [menu-bar edit] 'undefined) 591 (while k
268 (define-key speedbar-key-map [menu-bar search] 'undefined) 592 (if (and (listp (car k)) (listp (cdr (car k))))
269 (define-key speedbar-key-map [menu-bar help-menu] 'undefined) 593 (define-key speedbar-key-map (vector 'menu-bar (car (car k)))
594 'undefined))
595 (setq k (cdr k))))
270 596
271 ;; This lets the user scroll as if we had a scrollbar... well maybe not 597 ;; 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) 598 (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 )) 599 ))
287 600
288 (put 'speedbar-configure-faces 'menu-enable '(featurep 'dialog)) 601 (defvar speedbar-easymenu-definition-base
289 (put 'speedbar-configure-options 'menu-enable '(featurep 'dialog)) 602 '("Speedbar"
603 ["Update" speedbar-refresh t]
604 ["Auto Update" speedbar-toggle-updates
605 :style toggle :selected speedbar-update-flag]
606 )
607 "Base part of the speedbar menu.")
608
609 (defvar speedbar-easymenu-definition-special
610 '(["Edit Item On Line" speedbar-edit-line t]
611 ["Show All Files" speedbar-toggle-show-all-files
612 :style toggle :selected speedbar-show-unknown-files]
613 ["Expand Item" speedbar-expand-line
614 (save-excursion (beginning-of-line)
615 (looking-at "[0-9]+: *.\\+. "))]
616 ["Contract Item" speedbar-contract-line
617 (save-excursion (beginning-of-line)
618 (looking-at "[0-9]+: *.-. "))]
619 "----"
620 ["Item Information" speedbar-item-info t]
621 ["Load Lisp File" speedbar-item-load
622 (save-excursion
623 (beginning-of-line)
624 (looking-at "[0-9]+: *\\[[+-]\\] .+\\(\\.el\\)\\( \\*\\)?$"))]
625 ["Byte Compile File" speedbar-item-byte-compile
626 (save-excursion
627 (beginning-of-line)
628 (looking-at "[0-9]+: *\\[[+-]\\] .+\\(\\.el\\)\\( \\*\\)?$"))]
629 ["Copy Item" speedbar-item-copy
630 (save-excursion (beginning-of-line) (looking-at "[0-9]+: *\\["))]
631 ["Rename Item" speedbar-item-rename
632 (save-excursion (beginning-of-line) (looking-at "[0-9]+: *[[<]"))]
633 ["Delete Item" speedbar-item-delete
634 (save-excursion (beginning-of-line) (looking-at "[0-9]+: *[[<]"))])
635 "Additional menu items while in file-mode.")
636
637 (defvar speedbar-easymenu-definition-trailer
638 '("----"
639 ["Close" speedbar-close-frame t])
640 "Menu items appearing at the end of the speedbar menu.")
290 641
291 (defvar speedbar-buffer nil 642 (defvar speedbar-buffer nil
292 "The buffer displaying the speedbar.") 643 "The buffer displaying the speedbar.")
293 (defvar speedbar-frame nil 644 (defvar speedbar-frame nil
294 "The frame displaying speedbar.") 645 "The frame displaying speedbar.")
646 (defvar speedbar-cached-frame nil
647 "The frame that was last created, then removed from the display.")
648 (defvar speedbar-full-text-cache nil
649 "The last open directory is saved in it's entirety for ultra-fast switching.")
295 (defvar speedbar-timer nil 650 (defvar speedbar-timer nil
296 "The speedbar timer used for updating the buffer.") 651 "The speedbar timer used for updating the buffer.")
297 (defvar speedbar-attached-frame nil 652 (defvar speedbar-attached-frame nil
298 "The frame which started speedbar mode. This is the frame from 653 "The frame which started speedbar mode.
299 which all data displayed in the speedbar is gathered, and in which files 654 This is the frame from which all data displayed in the speedbar is
300 and such are displayed.") 655 gathered, and in which files and such are displayed.")
301 656
302 (defvar speedbar-last-selected-file nil 657 (defvar speedbar-last-selected-file nil
303 "The last file which was selected in speedbar buffer") 658 "The last file which was selected in speedbar buffer.")
304 659
305 (defvar speedbar-shown-directories nil 660 (defvar speedbar-shown-directories nil
306 "Used to maintain list of directories simultaneously open in the current 661 "Maintain list of directories simultaneously open in the current speedbar.")
307 speedbar.") 662
663 (defvar speedbar-directory-contents-alist nil
664 "An association list of directories and their contents.
665 Each sublist was returned by `speedbar-file-lists'. This list is
666 maintained to speed up the refresh rate when switching between
667 directories.")
668
669 (defvar speedbar-power-click nil
670 "Never set this by hand. Value is t when S-mouse activity occurs.")
308 671
309 672
310 ;;;
311 ;;; Mode definitions/ user commands 673 ;;; Mode definitions/ user commands
312 ;;; 674 ;;
313 ;;;###autoload 675 ;;###autoload
676 (defalias 'speedbar 'speedbar-frame-mode)
314 (defun speedbar-frame-mode (&optional arg) 677 (defun speedbar-frame-mode (&optional arg)
315 "Enable or disable use of a speedbar. Positive number means turn 678 "Enable or disable speedbar. Positive ARG means turn on, negative turn off.
316 on, negative turns speedbar off, and nil means toggle. Once the 679 nil means toggle. Once the speedbar frame is activated, a buffer in
317 speedbar frame is activated, a buffer in `speedbar-mode' will be 680 `speedbar-mode' will be displayed. Currently, only one speedbar is
318 displayed. Currently, only one speedbar is supported at a time." 681 supported at a time."
319 (interactive "P") 682 (interactive "P")
320 (if (not window-system) 683 (if (not window-system)
321 (error "Speedbar is not useful outside of a windowing environement")) 684 (error "Speedbar is not useful outside of a windowing environment"))
322 ;; toggle frame on and off. 685 ;; toggle frame on and off.
323 (if (not arg) (if speedbar-frame (setq arg -1) (setq arg 1))) 686 (if (not arg) (if speedbar-frame (setq arg -1) (setq arg 1)))
324 ;; turn the frame off on neg number 687 ;; turn the frame off on neg number
325 (if (and (numberp arg) (< arg 0)) 688 (if (and (numberp arg) (< arg 0))
326 (progn 689 (progn
327 (run-hooks 'speedbar-before-delete-hook) 690 (run-hooks 'speedbar-before-delete-hook)
328 (if (and speedbar-frame (frame-live-p speedbar-frame)) 691 (if (and speedbar-frame (frame-live-p speedbar-frame))
329 (delete-frame speedbar-frame)) 692 (if speedbar-xemacsp
693 (delete-frame speedbar-frame)
694 (setq speedbar-cached-frame speedbar-frame)
695 (modify-frame-parameters speedbar-frame '((visibility . nil)))))
696 (setq speedbar-frame nil)
330 (speedbar-set-timer nil) 697 (speedbar-set-timer nil)
331 (setq speedbar-frame nil) 698 ;; Used to delete the buffer. This has the annoying affect of
332 (if (bufferp speedbar-buffer) 699 ;; preventing whatever took it's place from ever appearing
333 (kill-buffer speedbar-buffer))) 700 ;; as the default after a C-x b was typed
701 ;;(if (bufferp speedbar-buffer)
702 ;; (kill-buffer speedbar-buffer))
703 )
334 ;; Set this as our currently attached frame 704 ;; Set this as our currently attached frame
335 (setq speedbar-attached-frame (selected-frame)) 705 (setq speedbar-attached-frame (selected-frame))
336 ;; Get the buffer to play with
337 (speedbar-mode)
338 ;; Get the frame to work in 706 ;; Get the frame to work in
339 (if (and speedbar-frame (frame-live-p speedbar-frame)) 707 (if (frame-live-p speedbar-cached-frame)
340 (raise-frame speedbar-frame) 708 (progn
341 (let ((params (list 709 (setq speedbar-frame speedbar-cached-frame)
342 ;; Xemacs fails to delete speedbar 710 (modify-frame-parameters speedbar-frame '((visibility . t)))
343 ;; if minibuffer is off. 711 ;; Get the buffer to play with
344 ;; JTL <<<< Seems to be OK for 19.15. 712 (speedbar-mode)
345 ;; removed tool- & menubar. 713 (select-frame speedbar-frame)
346 ;; <<<< JTL 714 (if (not (eq (current-buffer) speedbar-buffer))
347 (cons 'minibuffer nil) 715 (switch-to-buffer speedbar-buffer))
348 (cons 'width speedbar-width) 716 (set-window-dedicated-p (selected-window) t)
349 (cons 'height (frame-height)) 717 (raise-frame speedbar-frame)
350 (cons 'scroll-bar-width speedbar-scrollbar-width) 718 (speedbar-set-timer speedbar-update-speed)
351 (cons 'auto-raise speedbar-raise-lower) 719 )
352 (cons 'auto-lower speedbar-raise-lower) 720 (if (frame-live-p speedbar-frame)
353 '(modeline . nil) 721 (raise-frame speedbar-frame)
354 '(border-width . 0) 722 (let ((params (cons (cons 'height (frame-height))
355 '(unsplittable . t) 723 speedbar-frame-parameters)))
356 '(default-toolbar-visible-p . nil) 724 (setq speedbar-frame
357 '(menubar-visible-p . nil)))) 725 (if (< emacs-major-version 20) ;a bug is fixed in v20 & later
358 (setq speedbar-frame 726 (make-frame params)
359 (if (< emacs-minor-version 35) 727 (let ((x-pointer-shape x-pointer-top-left-arrow)
360 (make-frame params) 728 (x-sensitive-text-pointer-shape x-pointer-hand2))
361 (let ((x-pointer-shape x-pointer-top-left-arrow) 729 (make-frame params)))))
362 (x-sensitive-text-pointer-shape x-pointer-hand2)) 730 ;; reset the selection variable
363 (make-frame params))))) 731 (setq speedbar-last-selected-file nil)
364 ;; reset the selection variable 732 ;; Put the buffer into the frame
365 (setq speedbar-last-selected-file nil) 733 (save-window-excursion
366 ;; Put the buffer into the frame 734 ;; Get the buffer to play with
367 (save-window-excursion 735 (speedbar-mode)
368 (select-frame speedbar-frame) 736 (select-frame speedbar-frame)
369 (switch-to-buffer speedbar-buffer) 737 (switch-to-buffer speedbar-buffer)
370 (setq default-minibuffer-frame speedbar-attached-frame)) 738 (set-window-dedicated-p (selected-window) t)
371 (speedbar-set-timer speedbar-update-speed) 739 ;; Turn off toolbar and menubar under XEmacs
372 ))) 740 (if speedbar-xemacsp
741 (progn
742 (set-specifier default-toolbar-visible-p
743 (cons (selected-frame) nil))
744 ;; These lines make the menu-bar go away nicely, but
745 ;; they also cause xemacs much heartache.
746 ;;(set-specifier menubar-visible-p (cons (selected-frame) nil))
747 ;;(make-local-variable 'current-menubar)
748 ;;(setq current-menubar speedbar-menu)
749 ;;(add-submenu nil speedbar-menu nil)
750 )))
751 (speedbar-set-timer speedbar-update-speed)
752 ))))
373 753
374 (defun speedbar-close-frame () 754 (defun speedbar-close-frame ()
375 "Turn off speedbar mode" 755 "Turn off a currently active speedbar."
376 (interactive) 756 (interactive)
377 (speedbar-frame-mode -1)) 757 (speedbar-frame-mode -1)
758 (select-frame speedbar-attached-frame)
759 (other-frame 0))
760
761 (defun speedbar-frame-width ()
762 "Return the width of the speedbar frame in characters.
763 nil if it doesn't exist."
764 (and speedbar-frame (cdr (assoc 'width (frame-parameters speedbar-frame)))))
378 765
379 (defun speedbar-mode () 766 (defun speedbar-mode ()
380 "Create and return a SPEEDBAR buffer. The speedbar buffer allows 767 "Major mode for managing a display of directories and tags.
381 the user to manage a list of directories and paths at different 768 \\<speedbar-key-map>
382 depths. The first line represents the default path of the speedbar 769 The first line represents the default path of the speedbar frame.
383 frame. Each directory segment is a button which jumps speedbar's 770 Each directory segment is a button which jumps speedbar's default
384 default directory to that path. Buttons are activated by clicking 771 directory to that path. Buttons are activated by clicking `\\[speedbar-click]'.
385 mouse-2. 772 In some situations using `\\[speedbar-power-click]' is a `power click' which will
773 rescan cached items, or pop up new frames.
386 774
387 Each line starting with <+> represents a directory. Click on the <+> 775 Each line starting with <+> represents a directory. Click on the <+>
388 to insert the directory listing into the current tree. Click on the 776 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 777 <-> to retract that list. Click on the directory name to go to that
390 directory as the default. 778 directory as the default.
393 `speedbar-show-unknown-files' is t, the lines starting with [?] are 781 `speedbar-show-unknown-files' is t, the lines starting with [?] are
394 files which don't have imenu support, but are not expressly ignored. 782 files which don't have imenu support, but are not expressly ignored.
395 Files are completely ignored if they match `speedbar-file-unshown-regexp' 783 Files are completely ignored if they match `speedbar-file-unshown-regexp'
396 which is generated from `completion-ignored-extensions'. 784 which is generated from `completion-ignored-extensions'.
397 785
786 Files with a `*' character after their name are files checked out of a
787 version control system. (currently only RCS is supported.) New
788 version control systems can be added by examining the documentation
789 for `speedbar-this-file-in-vc' and `speedbar-vc-check-dir-p'
790
398 Click on the [+] to display a list of tags from that file. Click on 791 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 792 the [-] to retract the list. Click on the file name to edit the file
400 in the attached frame. 793 in the attached frame.
401 794
402 If you open tags, you might find a node starting with {+}, which is a 795 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 796 category of tags. Click the {+} to expand the category. Jump-able
404 tags start with >. Click the name of the tag to go to that position 797 tags start with >. Click the name of the tag to go to that position
405 in the selected file. 798 in the selected file.
406 799
407 Keybindings: \\<speedbar-key-map> 800 \\{speedbar-key-map}"
408 \\[speedbar-click] Activate the button under the mouse. 801 ;; NOT interactive
409 \\[speedbar-edit-line] Edit the file/directory on this line. Same as clicking 802 (save-excursion
410 on the name on the selected line.) 803 (setq speedbar-buffer (set-buffer (get-buffer-create " SPEEDBAR")))
411 \\[speedbar-expand-line] Expand the current line. Same as clicking on the + on a line. 804 (kill-all-local-variables)
412 \\[speedbar-contract-line] Contract the current line. Same as clicking on the - on a line." 805 (setq major-mode 'speedbar-mode)
413 (setq speedbar-buffer (set-buffer (get-buffer-create "SPEEDBAR"))) 806 (setq mode-name "Speedbar")
414 (kill-all-local-variables) 807 (use-local-map speedbar-key-map)
415 (setq major-mode 'speedbar-mode) 808 (set-syntax-table speedbar-syntax-table)
416 (setq mode-name "SB") 809 (setq font-lock-keywords nil) ;; no font-locking please
417 (use-local-map speedbar-key-map) 810 (setq truncate-lines t)
418 (set-syntax-table speedbar-syntax-table) 811 (make-local-variable 'frame-title-format)
419 (setq mode-line-format 812 (setq frame-title-format "Speedbar")
420 '("<< SPEEDBAR " (line-number-mode " %3l ") " >>")) 813 ;; Set this up special just for the speedbar buffer
421 (setq font-lock-keywords nil) ;; no font-locking please 814 (if (null default-minibuffer-frame)
422 (setq truncate-lines t) 815 (progn
423 (if (not speedbar-xemacsp) (setq auto-show-mode nil)) ;no auto-show for FSF 816 (make-local-variable 'default-minibuffer-frame)
424 (run-hooks 'speedbar-mode-hook) 817 (setq default-minibuffer-frame speedbar-attached-frame)))
818 (make-local-variable 'temp-buffer-show-function)
819 (setq temp-buffer-show-function 'speedbar-temp-buffer-show-function)
820 (setq kill-buffer-hook '(lambda () (let ((skilling (boundp 'skilling)))
821 (if skilling
822 nil
823 (if (eq (current-buffer)
824 speedbar-buffer)
825 (speedbar-frame-mode -1))))))
826 (speedbar-set-mode-line-format)
827 (if (not speedbar-xemacsp)
828 (setq auto-show-mode nil)) ;no auto-show for Emacs
829 (run-hooks 'speedbar-mode-hook))
425 (speedbar-update-contents) 830 (speedbar-update-contents)
426 ) 831 speedbar-buffer)
427 832
833 (defun speedbar-set-mode-line-format ()
834 "Set the format of the mode line based on the current speedbar environment.
835 This gives visual indications of what is up. It EXPECTS the speedbar
836 frame and window to be the currently active frame and window."
837 (if (frame-live-p speedbar-frame)
838 (save-excursion
839 (set-buffer speedbar-buffer)
840 (let* ((w (or (speedbar-frame-width) 20))
841 (p1 "<<")
842 (p5 ">>")
843 (p3 (if speedbar-update-flag "SPEEDBAR" "SLOWBAR"))
844 (blank (- w (length p1) (length p3) (length p5)
845 (if line-number-mode 4 0)))
846 (p2 (if (> blank 0)
847 (make-string (/ blank 2) ? )
848 ""))
849 (p4 (if (> blank 0)
850 (make-string (+ (/ blank 2) (% blank 2)) ? )
851 ""))
852 (tf
853 (if line-number-mode
854 (list (concat p1 p2 p3) '(line-number-mode " %3l")
855 (concat p4 p5))
856 (list (concat p1 p2 p3 p4 p5)))))
857 (if (not (equal mode-line-format tf))
858 (progn
859 (setq mode-line-format tf)
860 (force-mode-line-update)))))))
861
862 (defun speedbar-temp-buffer-show-function (buffer)
863 "Placed in the variable `temp-buffer-show-function' in `speedbar-mode'.
864 If a user requests help using \\[help-command] <Key> the temp BUFFER will be
865 redirected into a window on the attached frame."
866 (if speedbar-attached-frame (select-frame speedbar-attached-frame))
867 (pop-to-buffer buffer nil)
868 (other-window -1)
869 (run-hooks 'temp-buffer-show-hook))
870
871 (defun speedbar-reconfigure-menubar ()
872 "Reconfigure the menu-bar in a speedbar frame.
873 Different menu items are displayed depending on the current display mode
874 and the existence of packages."
875 (let ((km (make-sparse-keymap))
876 (cf (selected-frame))
877 (md (append speedbar-easymenu-definition-base
878 (if speedbar-shown-directories
879 ;; file display mode version
880 speedbar-easymenu-definition-special
881 (save-excursion
882 (select-frame speedbar-attached-frame)
883 (if (local-variable-p
884 'speedbar-easymenu-definition-special)
885 ;; If bound locally, we can use it
886 speedbar-easymenu-definition-special)))
887 ;; The trailer
888 speedbar-easymenu-definition-trailer)))
889 (easy-menu-define speedbar-menu-map speedbar-key-map "Speedbar menu" md)
890 (if speedbar-xemacsp (set-buffer-menubar (list km)))))
891
892
893 ;;; User Input stuff
894 ;;
428 (defun speedbar-mouse-hscroll (e) 895 (defun speedbar-mouse-hscroll (e)
429 "Read a mouse event from the mode line, and horizontally scroll if the 896 "Read a mouse event E from the mode line, and horizontally scroll.
430 mouse is being clicked on the far left, or far right of the modeline." 897 If the mouse is being clicked on the far left, or far right of the
898 mode-line. This is only useful for non-XEmacs"
431 (interactive "e") 899 (interactive "e")
432 (let* ((xp (car (nth 2 (car (cdr e))))) 900 (let* ((xp (car (nth 2 (car (cdr e)))))
433 (cpw (/ (frame-pixel-width) 901 (cpw (/ (frame-pixel-width)
434 (frame-width))) 902 (frame-width)))
435 (oc (1+ (/ xp cpw))) 903 (oc (1+ (/ xp cpw)))
440 (scroll-right 2)) 908 (scroll-right 2))
441 (t (message "Click on the edge of the modeline to scroll left/right"))) 909 (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) 910 ;;(message "X: Pixel %d Char Pixels %d On char %d" xp cpw oc)
443 )) 911 ))
444 912
913 (defun speedbar-get-focus ()
914 "Change frame focus to or from the speedbar frame.
915 If the selected frame is not speedbar, then speedbar frame is
916 selected. If the speedbar frame is active, then select the attached frame."
917 (interactive)
918 (if (eq (selected-frame) speedbar-frame)
919 (if (frame-live-p speedbar-attached-frame)
920 (select-frame speedbar-attached-frame))
921 ;; make sure we have a frame
922 (if (not (frame-live-p speedbar-frame)) (speedbar-frame-mode 1))
923 ;; go there
924 (select-frame speedbar-frame))
925 (other-frame 0))
926
927 (defun speedbar-next (arg)
928 "Move to the next ARGth line in a speedbar buffer."
929 (interactive "p")
930 (forward-line (or arg 1))
931 (speedbar-item-info)
932 (speedbar-position-cursor-on-line))
933
934 (defun speedbar-prev (arg)
935 "Move to the previous ARGth line in a speedbar buffer."
936 (interactive "p")
937 (speedbar-next (if arg (- arg) -1)))
938
939 (defun speedbar-scroll-up (&optional arg)
940 "Page down one screen-full of the speedbar, or ARG lines."
941 (interactive "P")
942 (scroll-up arg)
943 (speedbar-position-cursor-on-line))
944
945 (defun speedbar-scroll-down (&optional arg)
946 "Page up one screen-full of the speedbar, or ARG lines."
947 (interactive "P")
948 (scroll-down arg)
949 (speedbar-position-cursor-on-line))
950
951 (defun speedbar-up-directory ()
952 "Keyboard accelerator for moving the default directory up one.
953 Assumes that the current buffer is the speedbar buffer"
954 (interactive)
955 (setq default-directory (expand-file-name (concat default-directory "../")))
956 (speedbar-update-contents))
445 957
446 ;;; 958 ;;; Speedbar file activity
959 ;;
960 (defun speedbar-refresh ()
961 "Refresh the current speedbar display, disposing of any cached data."
962 (interactive)
963 (let ((dl speedbar-shown-directories))
964 (while dl
965 (adelete 'speedbar-directory-contents-alist (car dl))
966 (setq dl (cdr dl))))
967 (if (<= 1 speedbar-verbosity-level) (message "Refreshing speedbar..."))
968 (speedbar-update-contents)
969 (speedbar-stealthy-updates)
970 ;; Reset the timer in case it got really hosed for some reason...
971 (speedbar-set-timer speedbar-update-speed)
972 (if (<= 1 speedbar-verbosity-level) (message "Refreshing speedbar...done")))
973
974 (defun speedbar-item-load ()
975 "Byte compile the item under the cursor or mouse if it is a lisp file."
976 (interactive)
977 (let ((f (speedbar-line-file)))
978 (if (and (file-exists-p f) (string-match "\\.el$" f))
979 (if (and (file-exists-p (concat f "c"))
980 (y-or-n-p (format "Load %sc? " f)))
981 ;; If the compiled version exists, load that instead...
982 (load-file (concat f "c"))
983 (load-file f))
984 (error "Not a loadable file..."))))
985
986 (defun speedbar-item-byte-compile ()
987 "Byte compile the item under the cursor or mouse if it is a lisp file."
988 (interactive)
989 (let ((f (speedbar-line-file))
990 (sf (selected-frame)))
991 (if (and (file-exists-p f) (string-match "\\.el$" f))
992 (progn
993 (select-frame speedbar-attached-frame)
994 (byte-compile-file f nil)
995 (select-frame sf)))
996 ))
997
998 (defun speedbar-mouse-item-info (event)
999 "Provide information about what the user clicked on.
1000 This should be bound to a mouse EVENT."
1001 (interactive "e")
1002 (mouse-set-point event)
1003 (speedbar-item-info))
1004
1005 (defun speedbar-item-info ()
1006 "Display info in the mini-buffer about the button the mouse is over."
1007 (interactive)
1008 (if (not speedbar-shown-directories)
1009 nil
1010 (let* ((item (speedbar-line-file))
1011 (attr (if item (file-attributes item) nil)))
1012 (if item (message "%s %d %s" (nth 8 attr) (nth 7 attr) item)
1013 (save-excursion
1014 (beginning-of-line)
1015 (looking-at "\\([0-9]+\\):")
1016 (setq item (speedbar-line-path (string-to-int (match-string 1))))
1017 (if (re-search-forward "> \\([^ ]+\\)$"
1018 (save-excursion(end-of-line)(point)) t)
1019 (progn
1020 (setq attr (get-text-property (match-beginning 1)
1021 'speedbar-token))
1022 (message "Tag %s in %s at position %s"
1023 (match-string 1) item (if attr attr 0)))
1024 (message "No special info for this line.")))
1025 ))))
1026
1027 (defun speedbar-item-copy ()
1028 "Copy the item under the cursor.
1029 Files can be copied to new names or places."
1030 (interactive)
1031 (let ((f (speedbar-line-file)))
1032 (if (not f) (error "Not a file."))
1033 (if (file-directory-p f)
1034 (error "Cannot copy directory.")
1035 (let* ((rt (read-file-name (format "Copy %s to: "
1036 (file-name-nondirectory f))
1037 (file-name-directory f)))
1038 (refresh (member (expand-file-name (file-name-directory rt))
1039 speedbar-shown-directories)))
1040 ;; Create the right file name part
1041 (if (file-directory-p rt)
1042 (setq rt
1043 (concat (expand-file-name rt)
1044 (if (string-match "/$" rt) "" "/")
1045 (file-name-nondirectory f))))
1046 (if (or (not (file-exists-p rt))
1047 (y-or-n-p (format "Overwrite %s with %s? " rt f)))
1048 (progn
1049 (copy-file f rt t t)
1050 ;; refresh display if the new place is currently displayed.
1051 (if refresh
1052 (progn
1053 (speedbar-refresh)
1054 (if (not (speedbar-goto-this-file rt))
1055 (speedbar-goto-this-file f))))
1056 ))))))
1057
1058 (defun speedbar-item-rename ()
1059 "Rename the item under the cursor or mouse.
1060 Files can be renamed to new names or moved to new directories."
1061 (interactive)
1062 (let ((f (speedbar-line-file)))
1063 (if f
1064 (let* ((rt (read-file-name (format "Rename %s to: "
1065 (file-name-nondirectory f))
1066 (file-name-directory f)))
1067 (refresh (member (expand-file-name (file-name-directory rt))
1068 speedbar-shown-directories)))
1069 ;; Create the right file name part
1070 (if (file-directory-p rt)
1071 (setq rt
1072 (concat (expand-file-name rt)
1073 (if (string-match "/$" rt) "" "/")
1074 (file-name-nondirectory f))))
1075 (if (or (not (file-exists-p rt))
1076 (y-or-n-p (format "Overwrite %s with %s? " rt f)))
1077 (progn
1078 (rename-file f rt t)
1079 ;; refresh display if the new place is currently displayed.
1080 (if refresh
1081 (progn
1082 (speedbar-refresh)
1083 (speedbar-goto-this-file rt)
1084 )))))
1085 (error "Not a file."))))
1086
1087 (defun speedbar-item-delete ()
1088 "Delete the item under the cursor. Files are removed from disk."
1089 (interactive)
1090 (let ((f (speedbar-line-file)))
1091 (if (not f) (error "Not a file."))
1092 (if (y-or-n-p (format "Delete %s? " f))
1093 (progn
1094 (if (file-directory-p f)
1095 (delete-directory f)
1096 (delete-file f))
1097 (message "Okie dokie..")
1098 (let ((p (point)))
1099 (speedbar-refresh)
1100 (goto-char p))
1101 ))
1102 ))
1103
1104 (defun speedbar-enable-update ()
1105 "Enable automatic updating in speedbar via timers."
1106 (interactive)
1107 (setq speedbar-update-flag t)
1108 (speedbar-set-mode-line-format)
1109 (speedbar-set-timer speedbar-update-speed))
1110
1111 (defun speedbar-disable-update ()
1112 "Disable automatic updating and stop consuming resources."
1113 (interactive)
1114 (setq speedbar-update-flag nil)
1115 (speedbar-set-mode-line-format)
1116 (speedbar-set-timer nil))
1117
1118 (defun speedbar-toggle-updates ()
1119 "Toggle automatic update for the speedbar frame."
1120 (interactive)
1121 (if speedbar-update-flag
1122 (speedbar-disable-update)
1123 (speedbar-enable-update)))
1124
1125 (defun speedbar-toggle-show-all-files ()
1126 "Toggle display of files speedbar can not tag."
1127 (interactive)
1128 (setq speedbar-show-unknown-files (not speedbar-show-unknown-files))
1129 (speedbar-refresh))
1130
447 ;;; Utility functions 1131 ;;; Utility functions
448 ;;; 1132 ;;
449 (defun speedbar-set-timer (timeout) 1133 (defun speedbar-set-timer (timeout)
450 "Unset an old timer (if there is one) and activate a new timer with the 1134 "Unset an old timer (if there is one) and activate a new timer with TIMEOUT.
451 given timeout value." 1135 TIMEOUT is the number of seconds until the speedbar timer is called
452 (cond 1136 again."
1137 (cond
453 ;; Xemacs 1138 ;; Xemacs
454 (speedbar-xemacsp 1139 (speedbar-xemacsp
455 (if speedbar-timer 1140 (if speedbar-timer
456 (progn (delete-itimer speedbar-timer) 1141 (progn (delete-itimer speedbar-timer)
457 (setq speedbar-timer nil))) 1142 (setq speedbar-timer nil)))
458 (if timeout 1143 (if timeout
459 (setq speedbar-timer (start-itimer "speedbar" 1144 (setq speedbar-timer (start-itimer "speedbar"
460 'speedbar-timer-fn 1145 'speedbar-timer-fn
461 timeout 1146 timeout
462 nil)))) 1147 nil))))
463 ;; GNU emacs 1148 ;; Post 19.31 Emacs
464 (t 1149 ((fboundp 'run-with-idle-timer)
465 (if speedbar-timer 1150 (if speedbar-timer
466 (progn (cancel-timer speedbar-timer) 1151 (progn (cancel-timer speedbar-timer)
467 (setq speedbar-timer nil))) 1152 (setq speedbar-timer nil)))
468 (if timeout 1153 (if timeout
469 (setq speedbar-timer 1154 (setq speedbar-timer
470 (run-with-idle-timer timeout nil 'speedbar-timer-fn)))) 1155 (run-with-idle-timer timeout nil 'speedbar-timer-fn))))
471 )) 1156 ;; Older or other Emacsen with no timers. Set up so that it's
1157 ;; obvious this emacs can't handle the updates
1158 (t
1159 (setq speedbar-update-flag nil)))
1160 ;; change this if it changed for some reason
1161 (speedbar-set-mode-line-format))
472 1162
473 (defmacro speedbar-with-writable (&rest forms) 1163 (defmacro speedbar-with-writable (&rest forms)
474 "Allow the buffer to be writable and evaluate forms. Turn read-only back 1164 "Allow the buffer to be writable and evaluate FORMS.
475 on when done." 1165 Turn read only back on when done."
476 (list 'let '((speedbar-with-writable-buff (current-buffer))) 1166 (list 'let '((speedbar-with-writable-buff (current-buffer)))
477 '(toggle-read-only -1) 1167 '(toggle-read-only -1)
478 (cons 'progn forms) 1168 (cons 'progn forms)
479 '(save-excursion (set-buffer speedbar-with-writable-buff) 1169 '(save-excursion (set-buffer speedbar-with-writable-buff)
480 (toggle-read-only 1)))) 1170 (toggle-read-only 1))))
481 (put 'speedbar-with-writable 'lisp-indent-function 0) 1171 (put 'speedbar-with-writable 'lisp-indent-function 0)
482 1172
1173 (defun speedbar-select-window (buffer)
1174 "Select a window in which BUFFER is show.
1175 If it is not shown, force it to appear in the default window."
1176 (let ((win (get-buffer-window buffer speedbar-attached-frame)))
1177 (if win
1178 (select-window win)
1179 (show-buffer (selected-window) buffer))))
1180
1181 (defmacro speedbar-with-attached-buffer (&rest forms)
1182 "Execute FORMS in the attached frame's special buffer.
1183 Optionally select that frame if necessary."
1184 ;; Reset the timer with a new timeout when cliking a file
1185 ;; in case the user was navigating directories, we can cancel
1186 ;; that other timer.
1187 (list
1188 'progn
1189 '(speedbar-set-timer speedbar-update-speed)
1190 (list
1191 'let '((cf (selected-frame)))
1192 '(select-frame speedbar-attached-frame)
1193 '(speedbar-select-window speedbar-desired-buffer)
1194 (cons 'progn forms)
1195 '(select-frame cf)
1196 '(speedbar-maybee-jump-to-attached-frame)
1197 )))
1198
1199 (defun speedbar-insert-button (text face mouse function
1200 &optional token prevline)
1201 "Insert TEXT as the next logical speedbar button.
1202 FACE is the face to put on the button, MOUSE is the highlight face to use.
1203 When the user clicks on TEXT, FUNCTION is called with the TOKEN parameter.
1204 This function assumes that the current buffer is the speedbar buffer.
1205 If PREVLINE, then put this button on the previous line.
1206
1207 This is a convenience function for special mode that create their own
1208 specialized speedbar displays."
1209 (goto-char (point-max))
1210 (if (/= (current-column) 0) (insert "\n"))
1211 (if prevline (progn (delete-char -1) (insert " "))) ;back up if desired...
1212 (let ((start (point)))
1213 (insert text)
1214 (speedbar-make-button start (point) face mouse function token))
1215 (let ((start (point)))
1216 (insert "\n")
1217 (put-text-property start (point) 'face nil)
1218 (put-text-property start (point) 'mouse-face nil)))
1219
483 (defun speedbar-make-button (start end face mouse function &optional token) 1220 (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 1221 "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 1222 MOUSE is the mouse face. When this button is clicked on FUNCTION
486 will be run with the token parameter of TOKEN (any lisp object)" 1223 will be run with the TOKEN parameter (any lisp object)"
487 (put-text-property start end 'face face) 1224 (put-text-property start end 'face face)
488 (put-text-property start end 'mouse-face mouse) 1225 (put-text-property start end 'mouse-face mouse)
489 (put-text-property start end 'invisible nil) 1226 (put-text-property start end 'invisible nil)
490 (if function (put-text-property start end 'speedbar-function function)) 1227 (if function (put-text-property start end 'speedbar-function function))
491 (if token (put-text-property start end 'speedbar-token token)) 1228 (if token (put-text-property start end 'speedbar-token token))
492 ) 1229 )
493 1230
1231 ;;; File button management
1232 ;;
494 (defun speedbar-file-lists (directory) 1233 (defun speedbar-file-lists (directory)
495 "Create file lists for DIRECTORY. The car is the list of 1234 "Create file lists for DIRECTORY.
496 directories, the cdr is list of files not matching ignored headers." 1235 The car is the list of directories, the cdr is list of files not
497 (let ((default-directory directory) 1236 matching ignored headers. Cache any directory files found in
498 (dir (directory-files directory nil)) 1237 `speedbar-directory-contents-alist' and use that cache before scanning
499 (dirs nil) 1238 the file-system"
500 (files nil)) 1239 (setq directory (expand-file-name directory))
501 (while dir 1240 ;; If in powerclick mode, then the directory we are getting
502 (if (not (string-match speedbar-file-unshown-regexp (car dir))) 1241 ;; should be rescanned.
503 (if (file-directory-p (car dir)) 1242 (if speedbar-power-click
504 (setq dirs (cons (car dir) dirs)) 1243 (adelete 'speedbar-directory-contents-alist directory))
505 (setq files (cons (car dir) files)))) 1244 ;; find the directory, either in the cache, or build it.
506 (setq dir (cdr dir))) 1245 (or (cdr-safe (assoc directory speedbar-directory-contents-alist))
507 (cons (nreverse dirs) (list (nreverse files)))) 1246 (let ((default-directory directory)
508 ) 1247 (dir (directory-files directory nil))
1248 (dirs nil)
1249 (files nil))
1250 (while dir
1251 (if (not (string-match speedbar-file-unshown-regexp (car dir)))
1252 (if (file-directory-p (car dir))
1253 (setq dirs (cons (car dir) dirs))
1254 (setq files (cons (car dir) files))))
1255 (setq dir (cdr dir)))
1256 (let ((nl (cons (nreverse dirs) (list (nreverse files)))))
1257 (aput 'speedbar-directory-contents-alist directory nl)
1258 nl))
1259 ))
509 1260
510 (defun speedbar-directory-buttons (directory index) 1261 (defun speedbar-directory-buttons (directory index)
511 "Inserts a single button group at point for DIRECTORY. Each directory 1262 "Insert a single button group at point for DIRECTORY.
512 path part is a different button. If part of the path matches the user 1263 Each directory path part is a different button. If part of the path
513 directory ~, then it is replaced with a ~" 1264 matches the user directory ~, then it is replaced with a ~.
1265 INDEX is not used, but is required by the caller."
514 (let* ((tilde (expand-file-name "~")) 1266 (let* ((tilde (expand-file-name "~"))
515 (dd (expand-file-name directory)) 1267 (dd (expand-file-name directory))
516 (junk (string-match (regexp-quote tilde) dd)) 1268 (junk (string-match (regexp-quote tilde) dd))
517 (displayme (if junk 1269 (displayme (if junk
518 (concat "~" (substring dd (match-end 0))) 1270 (concat "~" (substring dd (match-end 0)))
528 'speedbar-highlight-face 1280 'speedbar-highlight-face
529 'speedbar-directory-buttons-follow 1281 'speedbar-directory-buttons-follow
530 (if (= (match-beginning 1) p) 1282 (if (= (match-beginning 1) p)
531 (expand-file-name "~/") ;the tilde 1283 (expand-file-name "~/") ;the tilde
532 (buffer-substring-no-properties 1284 (buffer-substring-no-properties
533 p (match-end 0)))))) 1285 p (match-end 0)))))
1286 ;; Nuke the beginning of the directory if it's too long...
1287 (cond ((eq speedbar-directory-button-trim-method 'span)
1288 (beginning-of-line)
1289 (let ((ww (or (speedbar-frame-width) 20)))
1290 (move-to-column ww nil)
1291 (while (>= (current-column) ww)
1292 (re-search-backward "/" nil t)
1293 (if (<= (current-column) 2)
1294 (progn
1295 (re-search-forward "/" nil t)
1296 (if (< (current-column) 4)
1297 (re-search-forward "/" nil t))
1298 (forward-char -1)))
1299 (if (looking-at "/?$")
1300 (beginning-of-line)
1301 (insert "/...\n ")
1302 (move-to-column ww nil)))))
1303 ((eq speedbar-directory-button-trim-method 'trim)
1304 (end-of-line)
1305 (let ((ww (or (speedbar-frame-width) 20))
1306 (tl (current-column)))
1307 (if (< ww tl)
1308 (progn
1309 (move-to-column (- tl ww))
1310 (if (re-search-backward "/" nil t)
1311 (progn
1312 (delete-region (point-min) (point))
1313 (insert "$")
1314 )))))))
1315 )
534 (if (string-match "^/[^/]+/$" displayme) 1316 (if (string-match "^/[^/]+/$" displayme)
535 (progn 1317 (progn
536 (insert " ") 1318 (insert " ")
537 (let ((p (point))) 1319 (let ((p (point)))
538 (insert "<root>") 1320 (insert "<root>")
539 (speedbar-make-button p (point) 1321 (speedbar-make-button p (point)
540 'speedbar-directory-face 1322 'speedbar-directory-face
541 'speedbar-highlight-face 1323 'speedbar-highlight-face
542 'speedbar-directory-buttons-follow 1324 'speedbar-directory-buttons-follow
543 "/")))) 1325 "/"))))
1326 (end-of-line)
544 (insert-char ?\n 1 nil))) 1327 (insert-char ?\n 1 nil)))
545 1328
546 (defun speedbar-make-tag-line (exp-button-type 1329 (defun speedbar-make-tag-line (exp-button-type
547 exp-button-char exp-button-function 1330 exp-button-char exp-button-function
548 exp-button-data 1331 exp-button-data
549 tag-button tag-button-function tag-button-data 1332 tag-button tag-button-function tag-button-data
550 tag-button-face depth) 1333 tag-button-face depth)
551 "Creates a tag line with BUTTON-TYPE for the small button that 1334 "Create a tag line with EXP-BUTTON-TYPE for the small expansion button.
552 expands or contracts a node (if applicable), and BUTTON-CHAR the 1335 This is the button that expands or contracts a node (if applicable),
553 character in it (+, -, ?, etc). BUTTON-FUNCTION is the function to 1336 and EXP-BUTTON-CHAR the character in it (+, -, ?, etc). EXP-BUTTON-FUNCTION
554 call if it's clicked on. Button types are 'bracket, 'angle, 'curly, or nil. 1337 is the function to call if it's clicked on. Button types are
555 1338 'bracket, 'angle, 'curly, or nil. EXP-BUTTON-DATA is extra data
556 Next, TAG-BUTTON is the text of the tag. TAG-FUNCTION is the function 1339 attached to the text forming the expansion button.
557 to call if clicked on, and TAG-DATA is the data to attach to the text 1340
558 field (such a tag positioning, etc). TAG-FACE is a face used for this 1341 Next, TAG-BUTTON is the text of the tag. TAG-BUTTON-FUNCTION is the
559 type of tag. 1342 function to call if clicked on, and TAG-BUTTON-DATA is the data to
1343 attach to the text field (such a tag positioning, etc).
1344 TAG-BUTTON-FACE is a face used for this type of tag.
560 1345
561 Lastly, DEPTH shows the depth of expansion. 1346 Lastly, DEPTH shows the depth of expansion.
562 1347
563 This function assumes that the cursor is in the speecbar window at the 1348 This function assumes that the cursor is in the speedbar window at the
564 position to insert a new item, and that the new item will end with a CR" 1349 position to insert a new item, and that the new item will end with a CR"
565 (let ((start (point)) 1350 (let ((start (point))
566 (end (progn 1351 (end (progn
567 (insert (int-to-string depth) ":") 1352 (insert (int-to-string depth) ":")
568 (point)))) 1353 (point))))
586 (put-text-property (1- (point)) (point) 'invisible nil) 1371 (put-text-property (1- (point)) (point) 'invisible nil)
587 (let ((start (point)) 1372 (let ((start (point))
588 (end (progn (insert tag-button) (point)))) 1373 (end (progn (insert tag-button) (point))))
589 (insert-char ?\n 1 nil) 1374 (insert-char ?\n 1 nil)
590 (put-text-property (1- (point)) (point) 'invisible nil) 1375 (put-text-property (1- (point)) (point) 'invisible nil)
591 (speedbar-make-button start end tag-button-face 1376 (speedbar-make-button start end tag-button-face
592 (if tag-button-function 'speedbar-highlight-face nil) 1377 (if tag-button-function 'speedbar-highlight-face nil)
593 tag-button-function tag-button-data)) 1378 tag-button-function tag-button-data))
594 ) 1379 )
595 1380
596 (defun speedbar-change-expand-button-char (char) 1381 (defun speedbar-change-expand-button-char (char)
597 "Change the expanson button character to CHAR for the current line." 1382 "Change the expansion button character to CHAR for the current line."
598 (save-excursion 1383 (save-excursion
599 (beginning-of-line) 1384 (beginning-of-line)
600 (if (re-search-forward ":\\s-*.\\([-+?]\\)" (save-excursion (end-of-line) 1385 (if (re-search-forward ":\\s-*.\\([-+?]\\)" (save-excursion (end-of-line)
601 (point)) t) 1386 (point)) t)
602 (speedbar-with-writable 1387 (speedbar-with-writable
603 (goto-char (match-beginning 1)) 1388 (goto-char (match-beginning 1))
604 (delete-char 1) 1389 (delete-char 1)
605 (insert-char char 1 t))))) 1390 (insert-char char 1 t)))))
606 1391
607 1392
608 ;;;
609 ;;; Build button lists 1393 ;;; Build button lists
610 ;;; 1394 ;;
611 (defun speedbar-insert-files-at-point (files level) 1395 (defun speedbar-insert-files-at-point (files level)
612 "Insert list of FILES starting at point, and indenting all files to LEVEL 1396 "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 1397 Tag expandable items with a +, otherwise a ?. Don't highlight ? as we
614 we don't know how to manage them. The input parameter FILES is a cons 1398 don't know how to manage them. The input parameter FILES is a cons
615 cell of the form ( 'dir-list . 'file-list )" 1399 cell of the form ( 'DIRLIST . 'FILELIST )"
616 ;; Start inserting all the directories 1400 ;; Start inserting all the directories
617 (let ((dirs (car files))) 1401 (let ((dirs (car files)))
618 (while dirs 1402 (while dirs
619 (speedbar-make-tag-line 'angle ?+ 'speedbar-dired (car dirs) 1403 (speedbar-make-tag-line 'angle ?+ 'speedbar-dired (car dirs)
620 (car dirs) 'speedbar-dir-follow nil 1404 (car dirs) 'speedbar-dir-follow nil
630 (car lst) 'speedbar-find-file nil 1414 (car lst) 'speedbar-find-file nil
631 'speedbar-file-face level))) 1415 'speedbar-file-face level)))
632 (setq lst (cdr lst))))) 1416 (setq lst (cdr lst)))))
633 1417
634 (defun speedbar-default-directory-list (directory index) 1418 (defun speedbar-default-directory-list (directory index)
635 "Inserts files for DIRECTORY with level INDEX at point" 1419 "Insert files for DIRECTORY with level INDEX at point."
636 (speedbar-insert-files-at-point 1420 (speedbar-insert-files-at-point
637 (speedbar-file-lists directory) index) 1421 (speedbar-file-lists directory) index)
638 ) 1422 (speedbar-reset-scanners)
1423 (if (= index 0)
1424 ;; If the shown files variable has extra directories, then
1425 ;; it is our responsibility to redraw them all
1426 ;; Luckilly, the nature of inserting items into this list means
1427 ;; that by reversing it, we can easilly go in the right order
1428 (let ((sf (cdr (reverse speedbar-shown-directories))))
1429 (setq speedbar-shown-directories
1430 (list (expand-file-name default-directory)))
1431 ;; exand them all as we find them
1432 (while sf
1433 (if (speedbar-goto-this-file (car sf))
1434 (progn
1435 (beginning-of-line)
1436 (if (looking-at "[0-9]+:[ ]*<")
1437 (progn
1438 (goto-char (match-end 0))
1439 (speedbar-do-function-pointer)))
1440 (setq sf (cdr sf)))))
1441 )))
639 1442
640 (defun speedbar-insert-generic-list (level lst expand-fun find-fun) 1443 (defun speedbar-insert-generic-list (level lst expand-fun find-fun)
641 "At LEVEL, inserts a generic multi-level alist LIST. Associations with 1444 "At LEVEL, insert a generic multi-level alist LST.
642 lists get {+} tags (to expand into more nodes) and those with positions 1445 Associations with lists get {+} tags (to expand into more nodes) and
643 just get a > as the indicator. {+} buttons will have the function 1446 those with positions just get a > as the indicator. {+} buttons will
644 EXPAND-FUN and the token is the CDR list. The token name will have the 1447 have the function EXPAND-FUN and the token is the CDR list. The token
645 function FIND-FUN and not token." 1448 name will have the function FIND-FUN and not token."
646 ;; Remove imenu rescan button 1449 ;; Remove imenu rescan button
647 (if (string= (car (car lst)) "*Rescan*") 1450 (if (string= (car (car lst)) "*Rescan*")
648 (setq lst (cdr lst))) 1451 (setq lst (cdr lst)))
649 ;; insert the parts 1452 ;; insert the parts
650 (while lst 1453 (while lst
651 (cond ((null (car-safe lst)) nil) ;this would be a separator 1454 (cond ((null (car-safe lst)) nil) ;this would be a separator
652 ((numberp (cdr-safe (car-safe lst))) 1455 ((or (numberp (cdr-safe (car-safe lst)))
1456 (markerp (cdr-safe (car-safe lst))))
653 (speedbar-make-tag-line nil nil nil nil ;no expand button data 1457 (speedbar-make-tag-line nil nil nil nil ;no expand button data
654 (car (car lst)) ;button name 1458 (car (car lst)) ;button name
655 find-fun ;function 1459 find-fun ;function
656 (cdr (car lst)) ;token is position 1460 (cdr (car lst)) ;token is position
657 'speedbar-tag-face 1461 'speedbar-tag-face
658 (1+ level))) 1462 (1+ level)))
659 ((listp (cdr-safe (car-safe lst))) 1463 ((listp (cdr-safe (car-safe lst)))
660 (speedbar-make-tag-line 'curly ?+ expand-fun (cdr (car lst)) 1464 (speedbar-make-tag-line 'curly ?+ expand-fun (cdr (car lst))
661 (car (car lst)) ;button name 1465 (car (car lst)) ;button name
662 nil nil 'speedbar-tag-face 1466 nil nil 'speedbar-tag-face
663 (1+ level))) 1467 (1+ level)))
664 (t (message "Ooops!"))) 1468 (t (message "Ooops!")))
665 (setq lst (cdr lst)))) 1469 (setq lst (cdr lst))))
666 1470
667 ;;;
668 ;;; Timed functions 1471 ;;; Timed functions
669 ;;; 1472 ;;
670 (defun speedbar-update-contents () 1473 (defun speedbar-update-contents ()
671 "Update the contents of the speedbar buffer." 1474 "Generically update the contents of the speedbar buffer."
672 (interactive) 1475 (interactive)
673 (setq speedbar-last-selected-file nil) 1476 ;; Set the current special buffer
674 (setq speedbar-shown-directories (list (expand-file-name default-directory))) 1477 (setq speedbar-desired-buffer nil)
675 (let ((cbd default-directory) 1478 (if (and speedbar-mode-specific-contents-flag
676 (funclst speedbar-initial-expansion-list)) 1479 speedbar-special-mode-expansion-list
1480 (local-variable-p
1481 'speedbar-special-mode-expansion-list))
1482 ;(eq (get major-mode 'mode-class 'special)))
1483 (speedbar-update-special-contents)
1484 (speedbar-update-directory-contents)))
1485
1486 (defun speedbar-update-directory-contents ()
1487 "Update the contents of the speedbar buffer based on the current directory."
1488 (let ((cbd (expand-file-name default-directory))
1489 (funclst speedbar-initial-expansion-list)
1490 (cache speedbar-full-text-cache)
1491 ;; disable stealth during update
1492 (speedbar-stealthy-function-list nil)
1493 (use-cache nil)
1494 ;; Because there is a bug I can't find just yet
1495 (inhibit-quit nil))
677 (save-excursion 1496 (save-excursion
678 (set-buffer speedbar-buffer) 1497 (set-buffer speedbar-buffer)
1498 ;; If we are updating contents to a where we are, then this is
1499 ;; really a request to update existing contents, so we must be
1500 ;; careful with our text cache!
1501 (if (member cbd speedbar-shown-directories)
1502 (setq cache nil)
1503 ;; If this directory is NOT in the current list of available
1504 ;; paths, then use the cache, and set the cache to our new
1505 ;; value. Make sure to unhighlight the current file, or if we
1506 ;; come back to this directory, it might be a different file
1507 ;; and then we get a mess!
1508 (if (> (point-max) 1)
1509 (progn
1510 (speedbar-clear-current-file)
1511 (setq speedbar-full-text-cache
1512 (cons speedbar-shown-directories (buffer-string)))))
1513
1514 ;; Check if our new directory is in the list of directories
1515 ;; show in the text-cahce
1516 (if (member cbd (car cache))
1517 (setq speedbar-shown-directories (car cache)
1518 use-cache t)
1519 ;; default the shown directories to this list...
1520 (setq speedbar-shown-directories (list cbd)))
1521 )
1522 (setq speedbar-last-selected-file nil)
679 (speedbar-with-writable 1523 (speedbar-with-writable
680 (setq default-directory cbd) 1524 (setq default-directory cbd)
681 (delete-region (point-min) (point-max)) 1525 (erase-buffer)
1526 (if use-cache
1527 (insert (cdr cache))
1528 (while funclst
1529 (funcall (car funclst) cbd 0)
1530 (setq funclst (cdr funclst)))))
1531 (goto-char (point-min))))
1532 (speedbar-reconfigure-menubar))
1533
1534 (defun speedbar-update-special-contents ()
1535 "Used the mode-specific variable to fill in the speedbar buffer.
1536 This should only be used by modes classified as special."
1537 (let ((funclst speedbar-special-mode-expansion-list)
1538 (specialbuff (current-buffer)))
1539 (save-excursion
1540 (setq speedbar-desired-buffer specialbuff)
1541 (set-buffer speedbar-buffer)
1542 ;; If we are leaving a directory, cache it.
1543 (if (not speedbar-shown-directories)
1544 ;; Do nothing
1545 nil
1546 ;; Clean up directory maintenance stuff
1547 (speedbar-clear-current-file)
1548 (setq speedbar-full-text-cache
1549 (cons speedbar-shown-directories (buffer-string))
1550 speedbar-shown-directories nil))
1551 ;; Now fill in the buffer with our newly found specialized list.
1552 (speedbar-with-writable
682 (while funclst 1553 (while funclst
683 (funcall (car funclst) cbd 0) 1554 ;; We do not erase the buffer because these functions may
684 (setq funclst (cdr funclst))))))) 1555 ;; decide NOT to update themselves.
1556 (funcall (car funclst) specialbuff)
1557 (setq funclst (cdr funclst))))
1558 (goto-char (point-min))))
1559 (speedbar-reconfigure-menubar))
685 1560
686 (defun speedbar-timer-fn () 1561 (defun speedbar-timer-fn ()
687 "Run whenever emacs is idle to update the speedbar item" 1562 "Run whenever emacs is idle to update the speedbar item."
688 (if (not (and speedbar-frame 1563 (if (not (and (frame-live-p speedbar-frame)
689 (frame-live-p speedbar-frame)
690 speedbar-attached-frame
691 (frame-live-p speedbar-attached-frame))) 1564 (frame-live-p speedbar-attached-frame)))
692 (speedbar-set-timer nil) 1565 (speedbar-set-timer nil)
693 (unwind-protect 1566 (condition-case nil
694 (if (frame-visible-p speedbar-frame) 1567 ;; Save all the match data so that we don't mess up executing fns
695 (let ((af (selected-frame))) 1568 (save-match-data
696 (save-window-excursion 1569 (if (and (frame-visible-p speedbar-frame) speedbar-update-flag)
697 (select-frame speedbar-attached-frame) 1570 (let ((af (selected-frame)))
698 ;; make sure we at least choose a window to 1571 (save-window-excursion
699 ;; get a good directory from 1572 (select-frame speedbar-attached-frame)
700 (if (string-match "\\*Minibuf-[0-9]+\\*" (buffer-name)) 1573 ;; make sure we at least choose a window to
701 (other-window 1)) 1574 ;; get a good directory from
702 ;; Update all the contents if directories change! 1575 (if (string-match "\\*Minibuf-[0-9]+\\*" (buffer-name))
703 (if (or (member (expand-file-name default-directory) 1576 (other-window 1))
704 speedbar-shown-directories) 1577 ;; Update for special mode all the time!
705 (eq af speedbar-frame) 1578 (if (and speedbar-mode-specific-contents-flag
706 (not (buffer-file-name)) 1579 speedbar-special-mode-expansion-list
707 ) 1580 (local-variable-p
708 nil 1581 'speedbar-special-mode-expansion-list))
709 (message "Updating speedbar to: %s..." default-directory) 1582 ;(eq (get major-mode 'mode-class 'special)))
710 (speedbar-update-contents) 1583 (speedbar-update-special-contents)
711 (message "Updating speedbar to: %s...done" default-directory))))) 1584 ;; Update all the contents if directories change!
712 ;; Reset the timer 1585 (if (or (member (expand-file-name default-directory)
713 (speedbar-set-timer speedbar-update-speed) 1586 speedbar-shown-directories)
714 ;; Ok, un-underline old file, underline current file 1587 (string-match speedbar-ignored-path-regexp
715 (speedbar-update-current-file))) 1588 (expand-file-name default-directory))
1589 (member major-mode speedbar-ignored-modes)
1590 (eq af speedbar-frame)
1591 (not (buffer-file-name)))
1592 nil
1593 (if (<= 1 speedbar-verbosity-level)
1594 (message "Updating speedbar to: %s..."
1595 default-directory))
1596 (speedbar-update-directory-contents)
1597 (if (<= 1 speedbar-verbosity-level)
1598 (message "Updating speedbar to: %s...done"
1599 default-directory))))
1600 (select-frame af))
1601 ;; Now run stealthy updates of time-consuming items
1602 (speedbar-stealthy-updates))))
1603 ;; errors that might occur
1604 (error (message "Speedbar error!")))
1605 ;; Reset the timer
1606 (speedbar-set-timer speedbar-update-speed))
716 (run-hooks 'speedbar-timer-hook) 1607 (run-hooks 'speedbar-timer-hook)
717 ) 1608 )
718 1609
1610
1611 ;;; Stealthy activities
1612 ;;
1613 (defun speedbar-stealthy-updates ()
1614 "For a given speedbar, run all items in the stealthy function list.
1615 Each item returns t if it completes successfully, or nil if
1616 interrupted by the user."
1617 (let ((l speedbar-stealthy-function-list))
1618 (unwind-protect
1619 (while (and l (funcall (car l)))
1620 (sit-for 0)
1621 (setq l (cdr l)))
1622 ;(message "Exit with %S" (car l))
1623 )))
1624
1625 (defun speedbar-reset-scanners ()
1626 "Reset any variables used by functions in the stealthy list as state.
1627 If new functions are added, their state needs to be updated here."
1628 (setq speedbar-vc-to-do-point t)
1629 )
1630
1631 (defun speedbar-clear-current-file ()
1632 "Locate the file thought to be current, and unhighlight it."
1633 (save-excursion
1634 (set-buffer speedbar-buffer)
1635 (if speedbar-last-selected-file
1636 (speedbar-with-writable
1637 (goto-char (point-min))
1638 (if (and
1639 speedbar-last-selected-file
1640 (re-search-forward
1641 (concat " \\(" (regexp-quote speedbar-last-selected-file)
1642 "\\)\\(" (regexp-quote speedbar-vc-indicator)
1643 "\\)?\n")
1644 nil t))
1645 (put-text-property (match-beginning 1)
1646 (match-end 1)
1647 'face
1648 'speedbar-file-face))))))
1649
719 (defun speedbar-update-current-file () 1650 (defun speedbar-update-current-file ()
720 "Find out what the current file is, and update our visuals to indicate 1651 "Find the current file is, and update our visuals to indicate its name.
721 what it is. This is specific to file names." 1652 This is specific to file names. If the file name doesn't show up, but
1653 it should be in the list, then the directory cache needs to be
1654 updated."
722 (let* ((lastf (selected-frame)) 1655 (let* ((lastf (selected-frame))
723 (newcf (save-excursion 1656 (newcfd (save-excursion
724 (select-frame speedbar-attached-frame) 1657 (select-frame speedbar-attached-frame)
725 (let ((rf (if (buffer-file-name) 1658 (let ((rf (if (buffer-file-name)
726 (file-name-nondirectory (buffer-file-name)) 1659 (buffer-file-name)
727 nil))) 1660 nil)))
728 (select-frame lastf) 1661 (select-frame lastf)
729 rf))) 1662 rf)))
730 (lastb (current-buffer))) 1663 (newcf (if newcfd (file-name-nondirectory newcfd)))
731 (if (and newcf (not (string= newcf speedbar-last-selected-file))) 1664 (lastb (current-buffer))
1665 (sucf-recursive (boundp 'sucf-recursive)))
1666 (if (and newcf
1667 ;; check here, that way we won't refresh to newcf until
1668 ;; its been written, thus saving ourselves some time
1669 (file-exists-p newcf)
1670 (not (string= newcf speedbar-last-selected-file)))
732 (progn 1671 (progn
1672 ;; It is important to select the frame, otherwise the window
1673 ;; we want the cursor to move in will not be updated by the
1674 ;; search-forward command.
733 (select-frame speedbar-frame) 1675 (select-frame speedbar-frame)
1676 ;; Remove the old file...
1677 (speedbar-clear-current-file)
1678 ;; now highlight the new one.
734 (set-buffer speedbar-buffer) 1679 (set-buffer speedbar-buffer)
735 (speedbar-with-writable 1680 (speedbar-with-writable
736 (goto-char (point-min)) 1681 (goto-char (point-min))
737 (if (and 1682 (if (re-search-forward
738 speedbar-last-selected-file 1683 (concat " \\(" (regexp-quote newcf) "\\)\\("
739 (re-search-forward 1684 (regexp-quote speedbar-vc-indicator)
740 (concat " \\(" (regexp-quote speedbar-last-selected-file) "\\)\n") 1685 "\\)?\n") nil t)
741 nil t)) 1686 ;; put the property on it
742 (put-text-property (match-beginning 1) 1687 (put-text-property (match-beginning 1)
743 (match-end 1) 1688 (match-end 1)
744 'face 1689 'face
745 'speedbar-file-face)) 1690 'speedbar-selected-face)
746 (goto-char (point-min)) 1691 ;; Oops, it's not in the list. Should it be?
747 (if (re-search-forward 1692 (if (and (string-match speedbar-file-regexp newcf)
748 (concat " \\(" (regexp-quote newcf) "\\)\n") nil t) 1693 (string= (file-name-directory newcfd)
749 (put-text-property (match-beginning 1) 1694 (expand-file-name default-directory)))
750 (match-end 1) 1695 ;; yes, it is (we will ignore unknowns for now...)
751 'face 1696 (progn
752 'speedbar-selected-face)) 1697 (speedbar-refresh)
1698 (if (re-search-forward
1699 (concat " \\(" (regexp-quote newcf) "\\)\n") nil t)
1700 ;; put the property on it
1701 (put-text-property (match-beginning 1)
1702 (match-end 1)
1703 'face
1704 'speedbar-selected-face)))
1705 ;; if it's not in there now, whatever...
1706 ))
753 (setq speedbar-last-selected-file newcf)) 1707 (setq speedbar-last-selected-file newcf))
754 (forward-line -1) 1708 (if (not sucf-recursive)
755 (speedbar-position-cursor-on-line) 1709 (progn
1710 (forward-line -1)
1711 (speedbar-position-cursor-on-line)))
756 (set-buffer lastb) 1712 (set-buffer lastb)
757 (select-frame lastf))))) 1713 (select-frame lastf)
1714 )))
1715 ;; return that we are done with this activity.
1716 t)
1717
1718 ;; If it's being used, check for it
1719 (eval-when-compile (or (featurep 'xemacs) (require 'ange-ftp)))
1720
1721 (defun speedbar-check-vc ()
1722 "Scan all files in a directory, and for each see if it's checked out.
1723 See `speedbar-this-file-in-vc' and `speedbar-vc-check-dir-p' for how
1724 to add more types of version control systems."
1725 ;; Check for to-do to be reset. If reset but no RCS is available
1726 ;; then set to nil (do nothing) otherwise, start at the beginning
1727 (save-excursion
1728 (set-buffer speedbar-buffer)
1729 (if (and speedbar-vc-do-check (eq speedbar-vc-to-do-point t)
1730 (speedbar-vc-check-dir-p default-directory)
1731 (not (and (featurep 'ange-ftp)
1732 (string-match (car
1733 (if speedbar-xemacsp
1734 ange-ftp-path-format
1735 ange-ftp-name-format))
1736 (expand-file-name default-directory)))))
1737 (setq speedbar-vc-to-do-point 0))
1738 (if (numberp speedbar-vc-to-do-point)
1739 (progn
1740 (goto-char speedbar-vc-to-do-point)
1741 (while (and (not (input-pending-p))
1742 (re-search-forward "^\\([0-9]+\\):\\s-*\\[[+-]\\] " nil t))
1743 (setq speedbar-vc-to-do-point (point))
1744 (if (speedbar-check-vc-this-line)
1745 (speedbar-with-writable
1746 (insert speedbar-vc-indicator))))
1747 (if (input-pending-p)
1748 ;; return that we are incomplete
1749 nil
1750 ;; we are done, set to-do to nil
1751 (setq speedbar-vc-to-do-point nil)
1752 ;; and return t
1753 t))
1754 t)))
1755
1756 (defun speedbar-check-vc-this-line ()
1757 "Return t if the file on this line is check of of a version control system.
1758 The one caller-requirement is that the last regexp matching operation
1759 has the current depth stored in (MATCHSTRING 1), and that the cursor
1760 is right in front of the file name."
1761 (let* ((d (string-to-int (match-string 1)))
1762 (f (speedbar-line-path d))
1763 (fn (buffer-substring-no-properties
1764 (point) (progn (end-of-line) (point))))
1765 (fulln (concat f fn)))
1766 (if (<= 2 speedbar-verbosity-level)
1767 (message "Speedbar vc check...%s" fulln))
1768 (and (file-writable-p fulln)
1769 (speedbar-this-file-in-vc f fn))))
1770
1771 (defun speedbar-vc-check-dir-p (path)
1772 "Return t if we should bother checking PATH for version control files.
1773 This can be overloaded to add new types of version control systems."
1774 (or
1775 (file-exists-p (concat path "RCS/"))
1776 ;; If SCCS is added in `speedbar-this-file-in-vc'
1777 ;; (file-exists-p (concat path "SCCS/"))
1778 ;; (file-exists-p (getenv "SCCSPATHTHINGIDONTREMEMBER"))
1779 ))
1780
1781 (defun speedbar-this-file-in-vc (path name)
1782 "Check to see if the file in PATH with NAME is in a version control system.
1783 You can add new VC systems by overriding this function. You can
1784 optimize this function by overriding it and only doing those checks
1785 that will occur on your system."
1786 (or
1787 (file-exists-p (concat path "RCS/" name ",v"))
1788 ;; Is this right? I don't recall
1789 ;;(file-exists-p (concat path "SCCS/," fn))
1790 ;;(file-exists-p (concat (getenv "SCCSPATHTHING") "/SCCS/," fn))
1791 ))
758 1792
759 ;;;
760 ;;; Clicking Activity 1793 ;;; Clicking Activity
761 ;;; 1794 ;;
762 (defun speedbar-quick-mouse (e) 1795 (defun speedbar-quick-mouse (e)
763 "Since mouse events are strange, this will keep the mouse nicely 1796 "Since mouse events are strange, this will keep the mouse nicely positioned.
764 positioned." 1797 This should be bound to mouse event E."
765 (interactive "e") 1798 (interactive "e")
766 (mouse-set-point e) 1799 (mouse-set-point e)
767 (beginning-of-line) 1800 (speedbar-position-cursor-on-line)
768 (forward-char 3)
769 ) 1801 )
770 1802
771 (defun speedbar-position-cursor-on-line () 1803 (defun speedbar-position-cursor-on-line ()
772 "Position the cursor on a line." 1804 "Position the cursor on a line."
773 (beginning-of-line) 1805 (let ((oldpos (point)))
774 (re-search-forward "[]>}]" (save-excursion (end-of-line) (point)) t)) 1806 (beginning-of-line)
1807 (if (looking-at "[0-9]+:\\s-*..?.? ")
1808 (goto-char (1- (match-end 0)))
1809 (goto-char oldpos))))
1810
1811 (defun speedbar-power-click (e)
1812 "Activate any speedbar button as a power click.
1813 This should be bound to mouse event E."
1814 (interactive "e")
1815 (let ((speedbar-power-click t))
1816 (speedbar-click e)))
1817
1818 (defun speedbar-click (e)
1819 "Activate any speedbar buttons where the mouse is clicked.
1820 This must be bound to a mouse event. A button is any location of text
1821 with a mouse face that has a text property called `speedbar-function'.
1822 This should be bound to mouse event E."
1823 (interactive "e")
1824 (mouse-set-point e)
1825 (speedbar-do-function-pointer)
1826 (speedbar-quick-mouse e))
1827
1828 (defun speedbar-do-function-pointer ()
1829 "Look under the cursor and examine the text properties.
1830 From this extract the file/tag name, token, indentation level and call
1831 a function if appropriate"
1832 (let* ((fn (get-text-property (point) 'speedbar-function))
1833 (tok (get-text-property (point) 'speedbar-token))
1834 ;; The 1-,+ is safe because scaning starts AFTER the point
1835 ;; specified. This lets the search include the character the
1836 ;; cursor is on.
1837 (tp (previous-single-property-change
1838 (1+ (point)) 'speedbar-function))
1839 (np (next-single-property-change
1840 (point) 'speedbar-function))
1841 (txt (buffer-substring-no-properties (or tp (point-min))
1842 (or np (point-max))))
1843 (dent (save-excursion (beginning-of-line)
1844 (string-to-number
1845 (if (looking-at "[0-9]+")
1846 (buffer-substring-no-properties
1847 (match-beginning 0) (match-end 0))
1848 "0")))))
1849 ;;(message "%S:%S:%S:%s" fn tok txt dent)
1850 (and fn (funcall fn txt tok dent)))
1851 (speedbar-position-cursor-on-line))
1852
1853 ;;; Reading info from the speedbar buffer
1854 ;;
1855 (defun speedbar-line-file (&optional p)
1856 "Retrieve the file or whatever from the line at P point.
1857 The return value is a string representing the file. If it is a
1858 directory, then it is the directory name."
1859 (save-excursion
1860 (save-match-data
1861 (beginning-of-line)
1862 (if (looking-at (concat
1863 "\\([0-9]+\\): *[[<][-+][]>] \\([^ \n]+\\)\\("
1864 (regexp-quote speedbar-vc-indicator)
1865 "\\)?"))
1866 (let* ((depth (string-to-int (match-string 1)))
1867 (path (speedbar-line-path depth))
1868 (f (match-string 2)))
1869 (concat path f))
1870 nil))))
1871
1872 (defun speedbar-goto-this-file (file)
1873 "If FILE is displayed, goto this line and return t.
1874 Otherwise do not move and return nil."
1875 (let ((path (substring (file-name-directory (expand-file-name file))
1876 (length (expand-file-name default-directory))))
1877 (dest (point)))
1878 (save-match-data
1879 (goto-char (point-min))
1880 ;; scan all the directories
1881 (while (and path (not (eq path t)))
1882 (if (string-match "^/?\\([^/]+\\)" path)
1883 (let ((pp (match-string 1 path)))
1884 (if (save-match-data
1885 (re-search-forward (concat "> " (regexp-quote pp) "$")
1886 nil t))
1887 (setq path (substring path (match-end 1)))
1888 (setq path nil)))
1889 (setq path t)))
1890 ;; find the file part
1891 (if (or (not path) (string= (file-name-nondirectory file) ""))
1892 ;; only had a dir part
1893 (if path
1894 (progn
1895 (speedbar-position-cursor-on-line)
1896 t)
1897 (goto-char dest) nil)
1898 ;; find the file part
1899 (let ((nd (file-name-nondirectory file)))
1900 (if (re-search-forward
1901 (concat "] \\(" (regexp-quote nd)
1902 "\\)\\(" (regexp-quote speedbar-vc-indicator) "\\)?$")
1903 nil t)
1904 (progn
1905 (speedbar-position-cursor-on-line)
1906 t)
1907 (goto-char dest)
1908 nil))))))
775 1909
776 (defun speedbar-line-path (depth) 1910 (defun speedbar-line-path (depth)
777 "Retrieve the pathname associated with the current line. This may 1911 "Retrieve the pathname associated with the current line.
778 require traversing backwards and combinding the default directory with 1912 This may require traversing backwards from DEPTH and combining the default
779 these items." 1913 directory with these items."
780 (save-excursion 1914 (save-excursion
781 (let ((path nil)) 1915 (save-match-data
782 (setq depth (1- depth)) 1916 (let ((path nil))
783 (while (/= depth -1) 1917 (setq depth (1- depth))
784 (if (not (re-search-backward (format "^%d:" depth) nil t)) 1918 (while (/= depth -1)
785 (error "Error building path of tag") 1919 (if (not (re-search-backward (format "^%d:" depth) nil t))
786 (cond ((looking-at "[0-9]+:\\s-*<->\\s-+\\([^\n]+\\)$") 1920 (error "Error building path of tag")
787 (setq path (concat (buffer-substring-no-properties 1921 (cond ((looking-at "[0-9]+:\\s-*<->\\s-+\\([^\n]+\\)$")
788 (match-beginning 1) (match-end 1)) 1922 (setq path (concat (buffer-substring-no-properties
789 "/" 1923 (match-beginning 1) (match-end 1))
790 path))) 1924 "/"
791 ((looking-at "[0-9]+:\\s-*[-]\\s-+\\([^\n]+\\)$") 1925 path)))
792 ;; This is the start of our path. 1926 ((looking-at "[0-9]+:\\s-*[-]\\s-+\\([^\n]+\\)$")
793 (setq path (buffer-substring-no-properties 1927 ;; This is the start of our path.
794 (match-beginning 1) (match-end 1)))))) 1928 (setq path (buffer-substring-no-properties
795 (setq depth (1- depth))) 1929 (match-beginning 1) (match-end 1))))))
796 (concat default-directory path)))) 1930 (setq depth (1- depth)))
1931 (if (and path
1932 (string-match (concat (regexp-quote speedbar-vc-indicator) "$")
1933 path))
1934 (setq path (substring path 0 (match-beginning 0))))
1935 (concat default-directory path)))))
797 1936
798 (defun speedbar-edit-line () 1937 (defun speedbar-edit-line ()
799 "Edit whatever tag or file is on the current speedbar line." 1938 "Edit whatever tag or file is on the current speedbar line."
800 (interactive) 1939 (interactive)
801 (beginning-of-line) 1940 (save-excursion
802 (re-search-forward "[]>}] [a-zA-Z0-9]" (save-excursion (end-of-line) (point))) 1941 (beginning-of-line)
803 (speedbar-do-function-pointer)) 1942 ;; If this fails, then it is a non-standard click, and as such,
1943 ;; perfectly allowed.
1944 (re-search-forward "[]>}] [a-zA-Z0-9]"
1945 (save-excursion (end-of-line) (point)) t)
1946 (speedbar-do-function-pointer)))
804 1947
805 (defun speedbar-expand-line () 1948 (defun speedbar-expand-line ()
806 "Expand the line under the cursor." 1949 "Expand the line under the cursor."
807 (interactive) 1950 (interactive)
808 (beginning-of-line) 1951 (beginning-of-line)
809 (re-search-forward ":\\s-*.\\+. " (save-excursion (end-of-line) (point))) 1952 (re-search-forward ":\\s-*.\\+. " (save-excursion (end-of-line) (point)))
810 (forward-char -2) 1953 (forward-char -2)
811 (speedbar-do-function-pointer)) 1954 (speedbar-do-function-pointer))
812 1955
813 (defun speedbar-contract-line () 1956 (defun speedbar-contract-line ()
814 "Expand the line under the cursor." 1957 "Contract the line under the cursor."
815 (interactive) 1958 (interactive)
816 (beginning-of-line) 1959 (beginning-of-line)
817 (re-search-forward ":\\s-*.-. " (save-excursion (end-of-line) (point))) 1960 (re-search-forward ":\\s-*.-. " (save-excursion (end-of-line) (point)))
818 (forward-char -2) 1961 (forward-char -2)
819 (speedbar-do-function-pointer)) 1962 (speedbar-do-function-pointer))
820 1963
821 (defun speedbar-click (e) 1964 (defun speedbar-maybee-jump-to-attached-frame ()
822 "When the user clicks mouse 1 on our speedbar, we must decide what 1965 "Jump to the attached frame ONLY if this was not a mouse event."
823 we want to do! The entire speedbar has functions attached to 1966 (if (numberp last-input-char)
824 buttons. All we have to do is extract from the buffer the information 1967 (progn
825 we need. See `speedbar-mode' for the type of behaviour we want to achieve" 1968 (select-frame speedbar-attached-frame)
826 (interactive "e") 1969 (other-frame 0))))
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 1970
856 (defun speedbar-find-file (text token indent) 1971 (defun speedbar-find-file (text token indent)
857 "Speedbar click handler for filenames. Clicking the filename loads 1972 "Speedbar click handler for filenames.
858 that file into the attached buffer." 1973 TEXT, the file will be displayed in the attached frame.
1974 TOKEN is unused, but required by the click handler. INDENT is the
1975 current indentation level."
859 (let ((cdd (speedbar-line-path indent))) 1976 (let ((cdd (speedbar-line-path indent)))
860 (select-frame speedbar-attached-frame) 1977 (speedbar-find-file-in-frame (concat cdd text))
861 (find-file (concat cdd text)) 1978 (speedbar-stealthy-updates)
862 (speedbar-update-current-file)
863 ;; Reset the timer with a new timeout when cliking a file 1979 ;; Reset the timer with a new timeout when cliking a file
864 ;; in case the user was navigating directories, we can cancel 1980 ;; in case the user was navigating directories, we can cancel
865 ;; that other timer. 1981 ;; that other timer.
866 (speedbar-set-timer speedbar-update-speed))) 1982 (speedbar-set-timer speedbar-update-speed))
1983 (speedbar-maybee-jump-to-attached-frame))
867 1984
868 (defun speedbar-dir-follow (text token indent) 1985 (defun speedbar-dir-follow (text token indent)
869 "Speedbar click handler for directory names. Clicking a directory will 1986 "Speedbar click handler for directory names.
870 cause the speedbar to list files in the selected subdirectory." 1987 Clicking a directory will cause the speedbar to list files in the
871 (setq default-directory 1988 the subdirectory TEXT. TOKEN is an unused requirement. The
1989 subdirectory chosen will be at INDENT level."
1990 (setq default-directory
872 (concat (expand-file-name (concat (speedbar-line-path indent) text)) 1991 (concat (expand-file-name (concat (speedbar-line-path indent) text))
873 "/")) 1992 "/"))
874 ;; Because we leave speedbar as the current buffer, 1993 ;; Because we leave speedbar as the current buffer,
875 ;; update contents will change directory without 1994 ;; update contents will change directory without
876 ;; having to touch the attached frame. 1995 ;; having to touch the attached frame.
877 (speedbar-update-contents) 1996 (speedbar-update-contents)
878 (speedbar-set-timer speedbar-navigating-speed) 1997 (speedbar-set-timer speedbar-navigating-speed)
879 (setq speedbar-last-selected-file nil) 1998 (setq speedbar-last-selected-file nil)
880 (speedbar-update-current-file)) 1999 (speedbar-stealthy-updates))
881 2000
2001 (defun speedbar-delete-subblock (indent)
2002 "Delete text from point to indentation level INDENT or greater.
2003 Handles end-of-sublist smartly."
2004 (speedbar-with-writable
2005 (save-excursion
2006 (end-of-line) (forward-char 1)
2007 (while (and (not (save-excursion
2008 (re-search-forward (format "^%d:" indent)
2009 nil t)))
2010 (>= indent 0))
2011 (setq indent (1- indent)))
2012 (delete-region (point) (if (>= indent 0)
2013 (match-beginning 0)
2014 (point-max))))))
882 2015
883 (defun speedbar-dired (text token indent) 2016 (defun speedbar-dired (text token indent)
884 "Speedbar click handler for filenames. Clicking the filename loads 2017 "Speedbar click handler for directory expand button.
885 that file into the attached buffer." 2018 Clicking this button expands or contracts a directory. TEXT is the
886 (cond ((string-match "+" text) ;we have to expand this file 2019 button clicked which has either a + or -. TOKEN is the directory to be
887 (setq speedbar-shown-directories 2020 expanded. INDENT is the current indentation level."
888 (cons (expand-file-name 2021 (cond ((string-match "+" text) ;we have to expand this dir
2022 (setq speedbar-shown-directories
2023 (cons (expand-file-name
889 (concat (speedbar-line-path indent) token "/")) 2024 (concat (speedbar-line-path indent) token "/"))
890 speedbar-shown-directories)) 2025 speedbar-shown-directories))
891 (speedbar-change-expand-button-char ?-) 2026 (speedbar-change-expand-button-char ?-)
2027 (speedbar-reset-scanners)
892 (save-excursion 2028 (save-excursion
893 (end-of-line) (forward-char 1) 2029 (end-of-line) (forward-char 1)
894 (speedbar-with-writable 2030 (speedbar-with-writable
895 (speedbar-default-directory-list 2031 (speedbar-default-directory-list
896 (concat (speedbar-line-path indent) token "/") 2032 (concat (speedbar-line-path indent) token "/")
897 (1+ indent))))) 2033 (1+ indent)))))
898 ((string-match "-" text) ;we have to contract this node 2034 ((string-match "-" text) ;we have to contract this node
2035 (speedbar-reset-scanners)
899 (let ((oldl speedbar-shown-directories) 2036 (let ((oldl speedbar-shown-directories)
900 (newl nil) 2037 (newl nil)
901 (td (expand-file-name 2038 (td (expand-file-name
902 (concat (speedbar-line-path indent) token)))) 2039 (concat (speedbar-line-path indent) token))))
903 (while oldl 2040 (while oldl
904 (if (not (string-match (concat "^" (regexp-quote td)) (car oldl))) 2041 (if (not (string-match (concat "^" (regexp-quote td)) (car oldl)))
905 (setq newl (cons (car oldl) newl))) 2042 (setq newl (cons (car oldl) newl)))
906 (setq oldl (cdr oldl))) 2043 (setq oldl (cdr oldl)))
907 (setq speedbar-shown-directories newl)) 2044 (setq speedbar-shown-directories newl))
908 (speedbar-change-expand-button-char ?+) 2045 (speedbar-change-expand-button-char ?+)
909 (save-excursion 2046 (speedbar-delete-subblock indent)
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 ) 2047 )
916 (t (error "Ooops... not sure what to do."))) 2048 (t (error "Ooops... not sure what to do.")))
917 (speedbar-center-buffer-smartly) 2049 (speedbar-center-buffer-smartly)
918 (setq speedbar-last-selected-file nil) 2050 (setq speedbar-last-selected-file nil)
919 (save-excursion (speedbar-update-current-file))) 2051 (save-excursion (speedbar-stealthy-updates)))
920 2052
921 (defun speedbar-directory-buttons-follow (text token ident) 2053 (defun speedbar-directory-buttons-follow (text token indent)
922 "Speedbar click handler for default directory buttons." 2054 "Speedbar click handler for default directory buttons.
2055 TEXT is the button clicked on. TOKEN is the directory to follow.
2056 INDENT is the current indentation level and is unused."
923 (setq default-directory token) 2057 (setq default-directory token)
924 ;; Because we leave speedbar as the current buffer, 2058 ;; Because we leave speedbar as the current buffer,
925 ;; update contents will change directory without 2059 ;; update contents will change directory without
926 ;; having to touch the attached frame. 2060 ;; having to touch the attached frame.
927 (speedbar-update-contents) 2061 (speedbar-update-contents)
928 (speedbar-set-timer speedbar-navigating-speed)) 2062 (speedbar-set-timer speedbar-navigating-speed))
929 2063
930 (defun speedbar-tag-file (text token indent) 2064 (defun speedbar-tag-file (text token indent)
931 "The cursor is on a selected line. Expand the tags in the specified 2065 "The cursor is on a selected line. Expand the tags in the specified file.
932 file. The parameter TXT and TOK are required, where TXT is the button 2066 The parameter TEXT and TOKEN are required, where TEXT is the button
933 clicked, and TOK is the file to expand." 2067 clicked, and TOKEN is the file to expand. INDENT is the current
2068 indentation level."
934 (cond ((string-match "+" text) ;we have to expand this file 2069 (cond ((string-match "+" text) ;we have to expand this file
935 (let* ((fn (expand-file-name (concat (speedbar-line-path indent) 2070 (let* ((fn (expand-file-name (concat (speedbar-line-path indent)
936 token))) 2071 token)))
937 (lst (if speedbar-use-imenu-package 2072 (lst (if speedbar-use-imenu-flag
938 (let ((tim (speedbar-fetch-dynamic-imenu fn))) 2073 (let ((tim (speedbar-fetch-dynamic-imenu fn)))
939 (if (eq tim t) 2074 (if (eq tim t)
940 (speedbar-fetch-dynamic-etags fn) 2075 (speedbar-fetch-dynamic-etags fn)
941 tim)) 2076 tim))
942 (speedbar-fetch-dynamic-etags fn)))) 2077 (speedbar-fetch-dynamic-etags fn))))
950 (speedbar-insert-generic-list indent 2085 (speedbar-insert-generic-list indent
951 lst 'speedbar-tag-expand 2086 lst 'speedbar-tag-expand
952 'speedbar-tag-find)))))) 2087 'speedbar-tag-find))))))
953 ((string-match "-" text) ;we have to contract this node 2088 ((string-match "-" text) ;we have to contract this node
954 (speedbar-change-expand-button-char ?+) 2089 (speedbar-change-expand-button-char ?+)
955 (speedbar-with-writable 2090 (speedbar-delete-subblock indent))
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."))) 2091 (t (error "Ooops... not sure what to do.")))
962 (speedbar-center-buffer-smartly)) 2092 (speedbar-center-buffer-smartly))
963 2093
964 (defun speedbar-tag-find (text token indent) 2094 (defun speedbar-tag-find (text token indent)
965 "For the tag in a file, goto that position" 2095 "For the tag TEXT in a file TOKEN, goto that position.
2096 INDENT is the current indentation level."
966 (let ((file (speedbar-line-path indent))) 2097 (let ((file (speedbar-line-path indent)))
967 (select-frame speedbar-attached-frame) 2098 (speedbar-find-file-in-frame file)
968 (find-file file) 2099 (save-excursion (speedbar-stealthy-updates))
969 (save-excursion (speedbar-update-current-file))
970 ;; Reset the timer with a new timeout when cliking a file 2100 ;; Reset the timer with a new timeout when cliking a file
971 ;; in case the user was navigating directories, we can cancel 2101 ;; in case the user was navigating directories, we can cancel
972 ;; that other timer. 2102 ;; that other timer.
973 (speedbar-set-timer speedbar-update-speed) 2103 (speedbar-set-timer speedbar-update-speed)
974 (goto-char token))) 2104 (goto-char token)
2105 ;;(recenter)
2106 (speedbar-maybee-jump-to-attached-frame)
2107 ))
975 2108
976 (defun speedbar-tag-expand (text token indent) 2109 (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, 2110 "Expand a tag sublist. Imenu will return sub-lists of specialized tag types.
978 expand or contract that list." 2111 Etags does not support this feature. TEXT will be the button
2112 string. TOKEN will be the list, and INDENT is the current indentation
2113 level."
979 (cond ((string-match "+" text) ;we have to expand this file 2114 (cond ((string-match "+" text) ;we have to expand this file
980 (speedbar-change-expand-button-char ?-) 2115 (speedbar-change-expand-button-char ?-)
981 (speedbar-with-writable 2116 (speedbar-with-writable
982 (save-excursion 2117 (save-excursion
983 (end-of-line) (forward-char 1) 2118 (end-of-line) (forward-char 1)
984 (speedbar-insert-generic-list indent 2119 (speedbar-insert-generic-list indent
985 token 'speedbar-tag-expand 2120 token 'speedbar-tag-expand
986 'speedbar-tag-find)))) 2121 'speedbar-tag-find))))
987 ((string-match "-" text) ;we have to contract this node 2122 ((string-match "-" text) ;we have to contract this node
988 (speedbar-change-expand-button-char ?+) 2123 (speedbar-change-expand-button-char ?+)
989 (speedbar-with-writable 2124 (speedbar-delete-subblock indent))
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."))) 2125 (t (error "Ooops... not sure what to do.")))
995 (speedbar-center-buffer-smartly)) 2126 (speedbar-center-buffer-smartly))
996 2127
997 ;;; 2128 ;;; Loading files into the attached frame.
2129 ;;
2130 (defun speedbar-find-file-in-frame (file)
2131 "This will load FILE into the speedbar attached frame.
2132 If the file is being displayed in a different frame already, then raise that
2133 frame instead."
2134 (let* ((buff (find-file-noselect file))
2135 (bwin (get-buffer-window buff 0)))
2136 (if bwin
2137 (progn
2138 (select-window bwin)
2139 (raise-frame (window-frame bwin)))
2140 (if speedbar-power-click
2141 (let ((pop-up-frames t)) (select-window (display-buffer buff)))
2142 (select-frame speedbar-attached-frame)
2143 (switch-to-buffer buff))))
2144 )
2145
998 ;;; Centering Utility 2146 ;;; Centering Utility
999 ;;; 2147 ;;
1000 (defun speedbar-center-buffer-smartly () 2148 (defun speedbar-center-buffer-smartly ()
1001 "Look at the buffer, and center it so that which the user is most 2149 "Recenter a speedbar buffer so the current indentation level is all visible.
1002 interested in (as far as we can tell) is all visible. This assumes 2150 This assumes that the cursor is on a file, or tag of a file which the user is
1003 that the cursor is on a file, or tag of a file which the user is
1004 interested in." 2151 interested in."
1005 (if (<= (count-lines (point-min) (point-max)) 2152 (if (<= (count-lines (point-min) (point-max))
1006 (window-height (selected-window))) 2153 (window-height (selected-window)))
1007 ;; whole buffer fits 2154 ;; whole buffer fits
1008 (let ((cp (point))) 2155 (let ((cp (point)))
1009 (goto-char (point-min)) 2156 (goto-char (point-min))
1010 (recenter 0) 2157 (recenter 0)
1056 lte 1))) 2203 lte 1)))
1057 (recenter newcent)))) 2204 (recenter newcent))))
1058 (goto-char cp))))) 2205 (goto-char cp)))))
1059 2206
1060 2207
1061 ;;;
1062 ;;; Tag Management -- Imenu 2208 ;;; Tag Management -- Imenu
1063 ;;; 2209 ;;
2210 (if (string-match "XEmacs" emacs-version)
2211
2212 nil
2213
2214 (eval-when-compile (if (locate-library "imenu") (require 'imenu)))
2215
1064 (defun speedbar-fetch-dynamic-imenu (file) 2216 (defun speedbar-fetch-dynamic-imenu (file)
1065 "Use the imenu package to load in file, and extract all the items 2217 "Load FILE into a buffer, and generate tags using Imenu.
1066 tags we wish to display in the speedbar package." 2218 Returns the tag list, or t for an error."
1067 ;; (eval-when-compile (require 'imenu)) 2219 ;; Load this AND compile it in
2220 (require 'imenu)
1068 (save-excursion 2221 (save-excursion
1069 (set-buffer (find-file-noselect file)) 2222 (set-buffer (find-file-noselect file))
1070 (condition-case nil 2223 (condition-case nil
1071 (imenu--make-index-alist t) 2224 (progn
2225 (if speedbar-power-click (setq imenu--index-alist nil))
2226 (imenu--make-index-alist t))
1072 (error t)))) 2227 (error t))))
1073 2228 )
1074 2229
1075 ;;; 2230 ;;; Tag Management -- etags (XEmacs compatibility part)
1076 ;;; Tag Management -- etags (Not useful for FSF emacs) 2231 ;;
1077 ;;;
1078 (defvar speedbar-fetch-etags-parse-list 2232 (defvar speedbar-fetch-etags-parse-list
1079 '(("\\.\\([cChH]\\|c++\\|cpp\\|cc\\)$" . speedbar-parse-c-or-c++tag) 2233 '(;; Note that java has the same parse-group as c
1080 ("\\.el\\|\\.emacs" . 2234 ("\\.\\([cChH]\\|c++\\|cpp\\|cc\\|hh\\|java\\)$" . speedbar-parse-c-or-c++tag)
1081 "defun\\s-+\\(\\(\\w\\|[-_]\\)+\\)\\s-*\C-?") 2235 ("\\.el\\|\\.emacs" . "defun\\s-+\\(\\(\\w\\|[-_]\\)+\\)\\s-*\C-?")
1082 ("\\.tex$" . speedbar-parse-tex-string) 2236 ("\\.tex$" . speedbar-parse-tex-string)
1083 ("\\.p" . 2237 ("\\.p" .
1084 "\\(\\(FUNCTION\\|function\\|PROCEDURE\\|procedure\\)\\s-+\\([a-zA-Z0-9_.:]+\\)\\)\\s-*(?^?") 2238 "\\(\\(FUNCTION\\|function\\|PROCEDURE\\|procedure\\)\\s-+\\([a-zA-Z0-9_.:]+\\)\\)\\s-*(?^?")
1085 2239
1086 ) 2240 )
1087 "*Alist matching extension vs an expression which will extract the 2241 "Associations of file extensions and expressions for extracting tags.
1088 symbol name we wish to display as match 1. To add a new file type, you 2242 To add a new file type, you would want to add a new association to the
1089 would want to add a new association to the list, where the car 2243 list, where the car is the file match, and the cdr is the way to
1090 is the file match, and the cdr is the way to extract an element from 2244 extract an element from the tags output. If the output is complex,
1091 the tags output. If the output is complex, use a function symbol 2245 use a function symbol instead of regexp. The function should expect
1092 instead of regexp. The function should expect to be at the beginning 2246 to be at the beginning of a line in the etags buffer.
1093 of a line in the etags buffer. 2247
1094 2248 This variable is ignored if `speedbar-use-imenu-flag' is t")
1095 This variable is ignored if `speedbar-use-imenu-package' is `t'")
1096 2249
1097 (defvar speedbar-fetch-etags-command "etags" 2250 (defvar speedbar-fetch-etags-command "etags"
1098 "*Command used to create an etags file. 2251 "*Command used to create an etags file.
1099 2252
1100 This variable is ignored if `speedbar-use-imenu-package' is `t'") 2253 This variable is ignored if `speedbar-use-imenu-flag' is t")
1101 2254
1102 (defvar speedbar-fetch-etags-arguments '("-D" "-I" "-o" "-") 2255 (defvar speedbar-fetch-etags-arguments '("-D" "-I" "-o" "-")
1103 "*List of arguments to use with `speedbar-fetch-etags-command' to create 2256 "*List of arguments to use with `speedbar-fetch-etags-command'.
1104 an etags output buffer. 2257 This creates an etags output buffer. Use `speedbar-toggle-etags' to
1105 2258 modify this list conveniently.
1106 This variable is ignored if `speedbar-use-imenu-package' is `t'") 2259
2260 This variable is ignored if `speedbar-use-imenu-flag' is t")
2261
2262 (defun speedbar-toggle-etags (flag)
2263 "Toggle FLAG in `speedbar-fetch-etags-arguments'.
2264 FLAG then becomes a member of etags command line arguments. If flag
2265 is \"sort\", then toggle the value of `speedbar-sort-tags'. If it's
2266 value is \"show\" then toggle the value of
2267 `speedbar-show-unknown-files'.
2268
2269 This function is a convenience function for XEmacs menu created by
2270 Farzin Guilak <farzin@protocol.com>"
2271 (interactive)
2272 (cond
2273 ((equal flag "sort")
2274 (setq speedbar-sort-tags (not speedbar-sort-tags)))
2275 ((equal flag "show")
2276 (setq speedbar-show-unknown-files (not speedbar-show-unknown-files)))
2277 ((or (equal flag "-C")
2278 (equal flag "-S")
2279 (equal flag "-D"))
2280 (if (member flag speedbar-fetch-etags-arguments)
2281 (setq speedbar-fetch-etags-arguments
2282 (delete flag speedbar-fetch-etags-arguments))
2283 (add-to-list 'speedbar-fetch-etags-arguments flag)))
2284 (t nil)))
1107 2285
1108 (defun speedbar-fetch-dynamic-etags (file) 2286 (defun speedbar-fetch-dynamic-etags (file)
1109 "For the complete file definition FILE, run etags as a subprocess, 2287 "For FILE, run etags and create a list of symbols extracted.
1110 fetch it's output, and create a list of symbols extracted, and their 2288 Each symbol will be associated with it's line position in FILE."
1111 position in FILE."
1112 (let ((newlist nil)) 2289 (let ((newlist nil))
1113 (unwind-protect 2290 (unwind-protect
1114 (save-excursion 2291 (save-excursion
1115 (if (get-buffer "*etags tmp*") 2292 (if (get-buffer "*etags tmp*")
1116 (kill-buffer "*etags tmp*")) ;kill to clean it up 2293 (kill-buffer "*etags tmp*")) ;kill to clean it up
2294 (if (<= 1 speedbar-verbosity-level) (message "Fetching etags..."))
1117 (set-buffer (get-buffer-create "*etags tmp*")) 2295 (set-buffer (get-buffer-create "*etags tmp*"))
1118 (apply 'call-process speedbar-fetch-etags-command nil 2296 (apply 'call-process speedbar-fetch-etags-command nil
1119 (current-buffer) nil 2297 (current-buffer) nil
1120 (append speedbar-fetch-etags-arguments (list file))) 2298 (append speedbar-fetch-etags-arguments (list file)))
1121 (goto-char (point-min)) 2299 (goto-char (point-min))
1122 (let ((expr 2300 (if (<= 1 speedbar-verbosity-level) (message "Fetching etags..."))
2301 (let ((expr
1123 (let ((exprlst speedbar-fetch-etags-parse-list) 2302 (let ((exprlst speedbar-fetch-etags-parse-list)
1124 (ans nil)) 2303 (ans nil))
1125 (while (and (not ans) exprlst) 2304 (while (and (not ans) exprlst)
1126 (if (string-match (car (car exprlst)) file) 2305 (if (string-match (car (car exprlst)) file)
1127 (setq ans (car exprlst))) 2306 (setq ans (car exprlst)))
1134 (setq tnl (speedbar-extract-one-symbol expr))) 2313 (setq tnl (speedbar-extract-one-symbol expr)))
1135 (if tnl (setq newlist (cons tnl newlist))) 2314 (if tnl (setq newlist (cons tnl newlist)))
1136 (forward-line 1))) 2315 (forward-line 1)))
1137 (message "Sorry, no support for a file of that extension")))) 2316 (message "Sorry, no support for a file of that extension"))))
1138 ) 2317 )
1139 (reverse newlist))) 2318 (if speedbar-sort-tags
2319 (sort newlist (lambda (a b) (string< (car a) (car b))))
2320 (reverse newlist))))
2321
2322 ;; This bit donated by Farzin Guilak <farzin@protocol.com> but I'm not
2323 ;; sure it's needed with the different sorting method.
2324 ;;
2325 ;(defun speedbar-clean-etags()
2326 ; "Removes spaces before the ^? character, and removes `#define',
2327 ;return types, etc. preceding tags. This ensures that the sort operation
2328 ;works on the tags, not the return types."
2329 ; (save-excursion
2330 ; (goto-char (point-min))
2331 ; (while
2332 ; (re-search-forward "(?[ \t](?\C-?" nil t)
2333 ; (replace-match "\C-?" nil nil))
2334 ; (goto-char (point-min))
2335 ; (while
2336 ; (re-search-forward "\\(.*[ \t]+\\)\\([^ \t\n]+.*\C-?\\)" nil t)
2337 ; (delete-region (match-beginning 1) (match-end 1)))))
1140 2338
1141 (defun speedbar-extract-one-symbol (expr) 2339 (defun speedbar-extract-one-symbol (expr)
1142 "At point in current buffer, return nil, or one alist of the form 2340 "At point, return nil, or one alist in the form: ( symbol . position )
1143 of a dotted pair: ( symbol . position ) from etags output. Parse the 2341 The line should contain output from etags. Parse the output using the
1144 output using the regular expression EXPR" 2342 regular expression EXPR"
1145 (let* ((sym (if (stringp expr) 2343 (let* ((sym (if (stringp expr)
1146 (if (save-excursion 2344 (if (save-excursion
1147 (re-search-forward expr (save-excursion 2345 (re-search-forward expr (save-excursion
1148 (end-of-line) 2346 (end-of-line)
1149 (point)) t)) 2347 (point)) t))
1150 (buffer-substring-no-properties (match-beginning 1) 2348 (buffer-substring-no-properties (match-beginning 1)
1151 (match-end 1))) 2349 (match-end 1)))
1152 (funcall expr))) 2350 (funcall expr)))
1155 (end-of-line) 2353 (end-of-line)
1156 (point)) 2354 (point))
1157 t))) 2355 t)))
1158 (if (and j sym) 2356 (if (and j sym)
1159 (1+ (string-to-int (buffer-substring-no-properties 2357 (1+ (string-to-int (buffer-substring-no-properties
1160 (match-beginning 2) 2358 (match-beginning 2)
1161 (match-end 2)))) 2359 (match-end 2))))
1162 0)))) 2360 0))))
1163 (if (/= pos 0) 2361 (if (/= pos 0)
1164 (cons sym pos) 2362 (cons sym pos)
1165 nil))) 2363 nil)))
1179 (match-end 1))) 2377 (match-end 1)))
1180 (t nil)) 2378 (t nil))
1181 ))) 2379 )))
1182 2380
1183 (defun speedbar-parse-tex-string () 2381 (defun speedbar-parse-tex-string ()
1184 "Parse a tex string. Only find data which is relevant" 2382 "Parse a Tex string. Only find data which is relevant."
1185 (save-excursion 2383 (save-excursion
1186 (let ((bound (save-excursion (end-of-line) (point)))) 2384 (let ((bound (save-excursion (end-of-line) (point))))
1187 (cond ((re-search-forward "\\(section\\|chapter\\|cite\\)\\s-*{[^\C-?}]*}?" bound t) 2385 (cond ((re-search-forward "\\(section\\|chapter\\|cite\\)\\s-*{[^\C-?}]*}?" bound t)
1188 (buffer-substring-no-properties (match-beginning 0) 2386 (buffer-substring-no-properties (match-beginning 0)
1189 (match-end 0))) 2387 (match-end 0)))
1190 (t nil))))) 2388 (t nil)))))
1191 2389
1192 2390
1193 ;;; 2391 ;;; Color loading section This is messy *Blech!*
1194 ;;; configuration scripts (optional) 2392 ;;
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) 2393 (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 2394 "Create a color for SYM with a L-FG and L-BG color, or D-FG and D-BG.
1288 D-BG. Optionally make BOLD, ITALIC, or UNDERLINED if applicable. If 2395 Optionally make BOLD, ITALIC, or UNDERLINE if applicable. If the background
1289 the background attribute of the current frame is determined to be 2396 attribute of the current frame is determined to be light (white, for example)
1290 light (white, for example) then L-FG and L-BG is used. If not, then 2397 then L-FG and L-BG is used. If not, then D-FG and D-BG is used. This will
1291 D-FG and D-BG is used. This will allocate the colors in the best 2398 allocate the colors in the best possible manor. This will allow me to store
1292 possible mannor. This will allow me to store multiple defaults and 2399 multiple defaults and dynamically determine which colors to use."
1293 dynamically determine which colors to use."
1294 (let* ((params (frame-parameters)) 2400 (let* ((params (frame-parameters))
1295 (disp-res (if (fboundp 'x-get-resource) 2401 (disp-res (if (fboundp 'x-get-resource)
1296 (if speedbar-xemacsp 2402 (if speedbar-xemacsp
1297 (x-get-resource ".displayType" "DisplayType" 'string) 2403 (x-get-resource ".displayType" "DisplayType" 'string)
1298 (x-get-resource ".displayType" "DisplayType")) 2404 (x-get-resource ".displayType" "DisplayType"))
1306 (x-get-resource ".backgroundMode" "BackgroundMode" 'string) 2412 (x-get-resource ".backgroundMode" "BackgroundMode" 'string)
1307 (x-get-resource ".backgroundMode" "BackgroundMode")) 2413 (x-get-resource ".backgroundMode" "BackgroundMode"))
1308 nil)) 2414 nil))
1309 (bgmode 2415 (bgmode
1310 (cond (bg-res (intern (downcase bg-res))) 2416 (cond (bg-res (intern (downcase bg-res)))
1311 ((and params 2417 ((let* ((bgc (or (cdr (assq 'background-color params))
1312 (fboundp 'x-color-values) 2418 (if speedbar-xemacsp
1313 (< (apply '+ (x-color-values 2419 (x-get-resource ".background"
1314 (cdr (assq 'background-color params)))) 2420 "Background" 'string)
1315 (/ (apply '+ (x-color-values "white")) 3))) 2421 (x-get-resource ".background"
2422 "Background"))
2423 ;; if no other options, default is white
2424 "white"))
2425 (bgcr (if speedbar-xemacsp
2426 (color-instance-rgb-components
2427 (make-color-instance bgc))
2428 (x-color-values bgc)))
2429 (wcr (if speedbar-xemacsp
2430 (color-instance-rgb-components
2431 (make-color-instance "white"))
2432 (x-color-values "white"))))
2433 (< (apply '+ bgcr) (/ (apply '+ wcr) 3)))
1316 'dark) 2434 'dark)
1317 (t 'light))) ;our default 2435 (t 'light))) ;our default
1318 (set-p (function (lambda (face-name resource) 2436 (set-p (function (lambda (face-name resource)
1319 (if speedbar-xemacsp 2437 (if speedbar-xemacsp
1320 (x-get-resource 2438 (x-get-resource
1321 (concat face-name ".attribute" resource) 2439 (concat face-name ".attribute" resource)
1322 (concat "Face.Attribute" resource) 2440 (concat "Face.Attribute" resource)
1323 'string) 2441 'string)
1324 (x-get-resource 2442 (x-get-resource
1325 (concat face-name ".attribute" resource) 2443 (concat face-name ".attribute" resource)
1326 (concat "Face.Attribute" resource))) 2444 (concat "Face.Attribute" resource)))
1327 ))) 2445 )))
1328 (nbg (cond ((eq bgmode 'dark) d-bg) 2446 (nbg (cond ((eq bgmode 'dark) d-bg)
1329 (t l-bg))) 2447 (t l-bg)))
1330 (nfg (cond ((eq bgmode 'dark) d-fg) 2448 (nfg (cond ((eq bgmode 'dark) d-fg)
1331 (t l-fg)))) 2449 (t l-fg))))
1332 2450
1333 (if (not (eq display-type 'color)) 2451 (if (not (eq display-type 'color))
1334 ;; we need a face of some sort, so just make due with default 2452 ;; we need a face of some sort, so just make due with default
1335 (progn 2453 (progn
1336 (copy-face 'default sym) 2454 (copy-face 'default sym)
1337 (if bold (condition-case nil 2455 (if bold (condition-case nil
1338 (make-face-bold sym) 2456 (make-face-bold sym)
1339 (error (message "Cannot make face %s bold!" 2457 (error (message "Cannot make face %s bold!"
1340 (symbol-name sym))))) 2458 (symbol-name sym)))))
1341 (if italic (condition-case nil 2459 (if italic (condition-case nil
1342 (make-face-italic sym) 2460 (make-face-italic sym)
1343 (error (message "Cannot make face %s italic!" 2461 (error (message "Cannot make face %s italic!"
1344 (symbol-name sym))))) 2462 (symbol-name sym)))))
1347 ;; make a colorized version of a face. Be sure to check Xdefaults 2465 ;; make a colorized version of a face. Be sure to check Xdefaults
1348 ;; for possible overrides first! 2466 ;; for possible overrides first!
1349 (let ((newface (make-face sym))) 2467 (let ((newface (make-face sym)))
1350 ;; For each attribute, check if it might already be set by Xdefaults 2468 ;; For each attribute, check if it might already be set by Xdefaults
1351 (if (and nfg (not (funcall set-p (symbol-name sym) "Foreground"))) 2469 (if (and nfg (not (funcall set-p (symbol-name sym) "Foreground")))
1352 (set-face-foreground sym nfg)) 2470 (set-face-foreground newface nfg))
1353 (if (and nbg (not (funcall set-p (symbol-name sym) "Background"))) 2471 (if (and nbg (not (funcall set-p (symbol-name sym) "Background")))
1354 (set-face-background sym nbg)) 2472 (set-face-background newface nbg))
1355 2473
1356 (if bold (condition-case nil 2474 (if bold (condition-case nil
1357 (make-face-bold sym) 2475 (make-face-bold newface)
1358 (error (message "Cannot make face %s bold!" 2476 (error (message "Cannot make face %s bold!"
1359 (symbol-name sym))))) 2477 (symbol-name sym)))))
1360 (if italic (condition-case nil 2478 (if italic (condition-case nil
1361 (make-face-italic sym) 2479 (make-face-italic newface)
1362 (error (message "Cannot make face %s italic!" 2480 (error (message "Cannot make face %s italic!"
1363 (symbol-name sym))))) 2481 (symbol-name newface)))))
1364 (set-face-underline-p sym underline) 2482 (set-face-underline-p newface underline)
1365 )))) 2483 ))))
1366 2484
1367 ;; JTL <<<< 2485 (if (x-display-color-p)
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 2486 (progn
1372 (speedbar-load-color 'speedbar-button-face "green4" "default" "green3" "default") 2487 (speedbar-load-color 'speedbar-button-face "green4" nil "green3" nil nil nil nil)
1373 (speedbar-load-color 'speedbar-file-face "cyan4" nil "cyan" nil nil nil nil) 2488 (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) 2489 (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) 2490 (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) 2491 (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) 2492 (speedbar-load-color 'speedbar-highlight-face nil "green" nil "sea green" nil nil nil)
1386 ;;(make-face 'speedbar-highlight-face) 2501 ;;(make-face 'speedbar-highlight-face)
1387 (copy-face 'highlight 'speedbar-highlight-face) 2502 (copy-face 'highlight 'speedbar-highlight-face)
1388 2503
1389 ) ;; monochrome 2504 ) ;; monochrome
1390 2505
1391 ;;; end of lisp 2506 ;; some edebug hooks
2507 (add-hook 'edebug-setup-hook
2508 (lambda ()
2509 (def-edebug-spec speedbar-with-writable def-body)))
2510
2511 ;; run load-time hooks
2512 (run-hooks 'speedbar-load-hook)
2513
1392 (provide 'speedbar) 2514 (provide 'speedbar)
1393 2515 ;;; speedbar ends here
1394 ;;; speedbar.el ends here