comparison lisp/speedbar.el @ 22735:ca02f300fc41

More commentary. (speedbar-xemacsp) Moved definition. (speedbar-initial-expansion-mode-list) was `speedbar-initial-expansion-list' and now has multiple modes. (speedbar-stealthy-function-list) now has mode labels. (speedbar-initial-expansion-list-name, speedbar-previously-used-expansion-list-name, speedbar-special-mode-key-map, speedbar-track-mouse-flag, speedbar-tag-hierarchy-method, speedbar-tag-split-minimum-length, speedbar-tag-regroup-maximum-length, speedbar-hide-button-brackets-flag) New variables (speedbar-special-mode-expansion-list) updated documentation. (speedbar-navigating-speed, speedbar-update-speed) phasing out. (speedbar-vc-indicator) removed space from this var. (speedbar-indicator-separator, speedbar-obj-do-check, speedbar-obj-to-do-point, speedbar-obj-indicator, speedbar-obj-alist, speedbar-indicator-regex) new variables. (speedbar-directory-unshown-regexp) New variable. (speedbar-supported-extension-expressions) Added more extensions. (speedbar-add-supported-extension, speedbar-add-ignored-path-regexp) Made interactive. (speedbar-update-flag) nil w/ no window system. (speedbar-file-key-map) Moved some key bindings from `speedbar-key-map' to this map. (speedbar-make-specialized-keymap) New function. (speedbar-file-key-map) New key map. (speedbar-easymenu-definition-special) Updated to new functions. (speedbar-easymenu-definition-trailer) Changed conditional part. (speedbar-frame-mode) Removed commented code, fixed W32 cursor bug, Updated to better handle terminal frames. (speedbar-switch-buffer-attached-frame) New function. (speedbar-mode) Updated documentation, no local keymap, correct `temp-buffer-show-function' use, enable mouse-tracking. (speedbar-show-info-under-mouse) New function. (speedbar-reconfigure-keymaps) Was `speedbar-reconfigure-menubar'. Enable major display mode specific menus & key maps. (speedbar-temp-buffer-show-function) Fix use of `temp-buffer-show-hook' (speedbar-track-mouse, speedbar-track-mouse-xemacs) New functions. (speedbar-restricted-move, speedbar-restricted-next, speedbar-restricted-prev, speedbar-navigate-list, speedbar-forward-list, speedbar-backward-list) New commands. (speedbar-refresh) Updated message printing & verbosity. (speedbar-item-load) Updated message. (speedbar-item-byte-compile) Updated doc & reset scanners. (speedbar-item-info) Overhauled with more details. (speedbar-item-copy) Update messages. (speedbar-generic-item-info) New function (speedbar-item-delete) Update messages. (speedbar-item-object-delete) New function. (speedbar-select-window) Update doc. Use `show-buffer'. (speedbar-make-button) Update doc. (speedbar-initial-expansion-list, speedbar-initial-menu, speedbar-initial-keymap, speedbar-initial-stealthy-functions, speedbar-add-expansion-list, speedbar-change-initial-expansion-list) New functions. (speedbar-maybe-add-localized-support, speedbar-add-localized-speedbar-support, speedbar-remove-localized-speedbar-support) Imported from speedbspec (speedbar-file-lists) Filter out some directories. (speedbar-make-tag-line) Can hide brackets. (speedbar-change-expand-button-char) Protect invisible text prop. (speedbar-insert-files-at-point) Ignore case during comares. (speedbar-apply-one-tag-hierarchy-method, speedbar-create-tag-hierarchy) New functions. (speedbar-insert-generic-list) Now calls hierarchy functions on tags. (speedbar-update-contents) Handles localized support. (speedbar-update-directory-contents) Uses fn for expansion list, Fixed directory cacheing bug. (speedbar-timer-fn) Calls localized support function. (speedbar-stealthy-update-recurse) New variable (speedbar-stealthy-updates) Handle new stealth function format. (speedbar-clear-current-file) Handle indicator regex. (speedbar-update-current-file) Ignores case, update handle indicator regex, Fix line positioning. (speedbar-add-indicator) Handles obj indicators now. (speedbar-check-objects, speedbar-check-obj-this-line) New functions. (speedbar-double-click) Fix tripple click error. (speedbar-line-file, speedbar-goto-this-file) Handle indicator regex. (speedbar-line-path) Only try to get a file when in "files" display. (speedbar-line-depth) Handle indicator regex. (speedbar-dir-follow) Turn of smart-adjust to disable cache use. (speedbar-directory-buttons-follow) Hack for W32 emacs directories. (speedbar-buffers-key-map) New key map. (speedbar-buffer-easymenu-definition) New meny items. (speedbar-buffer-buttons, speedbar-buffer-buttons-temp, speedbar-buffer-buttons-engine, speedbar-buffer-click, speedbar-buffer-kill-buffer, speedbar-buffer-revert-buffer) New functions.
author Karl Heuer <kwzh@gnu.org>
date Fri, 10 Jul 1998 16:48:06 +0000
parents a77d473867b8
children 322179a8fd20
comparison
equal deleted inserted replaced
22734:09db8bddedc5 22735:ca02f300fc41
1 ;;; speedbar --- quick access to files and tags 1 ;;; speedbar --- quick access to files and tags in a frame
2 2
3 ;;; Copyright (C) 1996, 97, 98 Free Software Foundation 3 ;;; Copyright (C) 1996, 97, 98 Free Software Foundation
4 ;; 4
5 ;; Author: Eric M. Ludlam <zappo@gnu.ai.mit.edu> 5 ;; Author: Eric M. Ludlam <zappo@gnu.org>
6 ;; Version: 0.6.2 6 ;; Version: 0.7
7 ;; Keywords: file, tags, tools, convenience 7 ;; Keywords: file, tags, tools
8 ;; 8 ;; X-RCS: $Id: speedbar.el,v 1.112 1998/06/16 12:53:18 kwzh Exp kwzh $
9
9 ;; This file is part of GNU Emacs. 10 ;; This file is part of GNU Emacs.
10 ;; 11
11 ;; GNU Emacs is free software; you can redistribute it and/or modify 12 ;; GNU Emacs is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by 13 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option) 14 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; any later version. 15 ;; any later version.
15 ;; 16
16 ;; GNU Emacs is distributed in the hope that it will be useful, 17 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details. 20 ;; GNU General Public License for more details.
20 ;; 21
21 ;; You should have received a copy of the GNU General Public License 22 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the 23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA. 25 ;; Boston, MA 02111-1307, USA.
25 26
30 ;; in order to make the last active frame display that file location. 31 ;; in order to make the last active frame display that file location.
31 ;; 32 ;;
32 ;; Starting Speedbar: 33 ;; Starting Speedbar:
33 ;; 34 ;;
34 ;; If speedbar came to you as a part of Emacs, simply type 35 ;; If speedbar came to you as a part of Emacs, simply type
35 ;; `M-x speedbar', and it will be autoloaded for you. A "Speedbar" 36 ;; `M-x speedbar', and it will be autoloaded for you.
36 ;; submenu will be added under "Tools".
37 ;; 37 ;;
38 ;; If speedbar is not a part of your distribution, then add 38 ;; If speedbar is not a part of your distribution, then add
39 ;; this to your .emacs file: 39 ;; this to your .emacs file:
40 ;; 40 ;;
41 ;; (autoload 'speedbar-frame-mode "speedbar" "Popup a speedbar frame" t) 41 ;; (autoload 'speedbar-frame-mode "speedbar" "Popup a speedbar frame" t)
42 ;; (autoload 'speedbar-get-focus "speedbar" "Jump to speedbar frame" t) 42 ;; (autoload 'speedbar-get-focus "speedbar" "Jump to speedbar frame" t)
43 ;; 43 ;;
44 ;; If you want to choose it from a menu, you can do this: 44 ;; If you want to choose it from a menu, such as "Tools", you can do this:
45 ;; 45 ;;
46 ;; Emacs: 46 ;; Emacs:
47 ;; (define-key-after (lookup-key global-map [menu-bar tools]) 47 ;; (define-key-after (lookup-key global-map [menu-bar tools])
48 ;; [speedbar] '("Speedbar" . speedbar-frame-mode) [calendar]) 48 ;; [speedbar] '("Speedbar" . speedbar-frame-mode) [calendar])
49 ;; 49 ;;
86 ;; regular expression matching a type of path. You may add list 86 ;; regular expression matching a type of path. You may add list
87 ;; elements to `speedbar-ignored-path-expressions' as long as it is 87 ;; elements to `speedbar-ignored-path-expressions' as long as it is
88 ;; done before speedbar is loaded. 88 ;; done before speedbar is loaded.
89 ;; 89 ;;
90 ;; To add new file types to imenu, see the documentation in the 90 ;; To add new file types to imenu, see the documentation in the
91 ;; file imenu.el that comes with emacs. To add new file types which 91 ;; file imenu.el that comes with Emacs. To add new file types which
92 ;; etags supports, you need to modify the variable 92 ;; etags supports, you need to modify the variable
93 ;; `speedbar-fetch-etags-parse-list'. 93 ;; `speedbar-fetch-etags-parse-list'.
94 ;; 94 ;;
95 ;; If the updates are going too slow for you, modify the variable 95 ;; If the updates are going too slow for you, modify the variable
96 ;; `speedbar-update-speed' to a longer idle time before updates. 96 ;; `speedbar-update-speed' to a longer idle time before updates.
99 ;; will navigate to a directory which is eventually replaced after 99 ;; will navigate to a directory which is eventually replaced after
100 ;; you go back to editing a file (unless you pull up a new file.) 100 ;; you go back to editing a file (unless you pull up a new file.)
101 ;; The delay time before this happens is in 101 ;; The delay time before this happens is in
102 ;; `speedbar-navigating-speed', and defaults to 10 seconds. 102 ;; `speedbar-navigating-speed', and defaults to 10 seconds.
103 ;; 103 ;;
104 ;; Users XEmacs previous to 20 may want to change the default 104 ;; To enable mouse tracking with information in the minibuffer of
105 ;; the attached frame, use the variable `speedbar-track-mouse-flag'.
106 ;;
107 ;; Tag layout can be modified through `speedbar-tag-hierarchy-method',
108 ;; which controls how tags are layed out. It is actually a list of
109 ;; functions that filter the data. The default groups large tag lists
110 ;; into sub-lists. A long flat list can be used instead if needed.
111 ;; Other filters could be easily added.
112 ;;
113 ;; Users of XEmacs previous to 20 may want to change the default
105 ;; timeouts for `speedbar-update-speed' to something longer as XEmacs 114 ;; timeouts for `speedbar-update-speed' to something longer as XEmacs
106 ;; doesn't have idle timers, the speedbar timer keeps going off 115 ;; doesn't have idle timers, the speedbar timer keeps going off
107 ;; arbitrarily while you're typing. It's quite pesky. 116 ;; arbitrarily while you're typing. It's quite pesky.
108 ;; 117 ;;
109 ;; Users of really old emacsen without the needed timers will not 118 ;; Users of really old emacsen without the needed timers will not
110 ;; have speedbar updating automatically. Use "r" to refresh the 119 ;; have speedbar updating automatically. Use "r" to refresh the
111 ;; display after changing directories. Remember, do not interrupt the 120 ;; display after changing directories. Remember, do not interrupt the
112 ;; stealthy updates or your display may not be completely refreshed. 121 ;; stealthy updates or your display may not be completely refreshed.
113 ;; 122 ;;
114 ;; See optional file `speedbspec.el' for additional configurations
115 ;; which allow speedbar to create specialized lists for special modes
116 ;; that are not file-related.
117 ;;
118 ;; AUC-TEX users: The imenu tags for AUC-TEX mode don't work very 123 ;; AUC-TEX users: The imenu tags for AUC-TEX mode don't work very
119 ;; well. Use the imenu keywords from tex-mode.el for better results. 124 ;; well. Use the imenu keywords from tex-mode.el for better results.
120 ;; 125 ;;
121 ;; This file requires the library package assoc (association lists) 126 ;; This file requires the library package assoc (association lists)
122 ;; and the package custom (for easy configuration of speedbar) 127 ;; and the package custom (for easy configuration of speedbar)
123 ;; http://www.dina.kvl.dk/~abraham/custom/ 128 ;; http://www.dina.kvl.dk/~abraham/custom/
124 ;; 129 ;;
125 ;; If you do not have custom installed, you can still get face colors 130 ;;; Developing for speedbar
126 ;; by modifying the faces directly in your .emacs file, or setting 131 ;;
127 ;; them in your .Xdefaults file. 132 ;; Adding a speedbar specialized display mode:
128 ;; Here is an example .Xdefaults for a dark background: 133 ;;
129 ;; 134 ;; Speedbar can be configured to create a special display for certain
130 ;; emacs*speedbar-button-face.attributeForeground: Aquamarine 135 ;; modes that do not display tradition file/tag data. Rmail, Info,
131 ;; emacs*speedbar-selected-face.attributeForeground: red 136 ;; and the debugger are examples. These modes can, however, benefit
132 ;; emacs*speedbar-selected-face.attributeUnderline: true 137 ;; from a speedbar style display in their own way.
133 ;; emacs*speedbar-directory-face.attributeForeground: magenta 138 ;;
134 ;; emacs*speedbar-file-face.attributeForeground: green3 139 ;; If your `major-mode' is `foo-mode', the only requirement is to
135 ;; emacs*speedbar-highlight-face.attributeBackground: sea green 140 ;; create a function called `foo-speedbar-buttons' which takes one
136 ;; emacs*speedbar-tag-face.attributeForeground: yellow 141 ;; argument, BUFFER. BUFFER will be the buffer speedbar wants filled.
137 142 ;; In `foo-speedbar-buttons' there are several functions that make
138 ;;; Speedbar updates can be found at: 143 ;; building a speedbar display easy. See the documentation for
139 ;; ftp://ftp.ultranet.com/pub/zappo/speedbar*.tar.gz 144 ;; `speedbar-with-writable' (needed because the buffer is usually
140 ;; 145 ;; read-only) `speedbar-make-tag-line', `speedbar-insert-button', and
141 146 ;; `speedbar-insert-generic-list'. If you use
142 ;;; Change log: 147 ;; `speedbar-insert-generic-list', also read the doc for
143 ;; 0.1 Initial Revision 148 ;; `speedbar-tag-hierarchy-method' in case you wish to override it.
144 ;; 0.2 Fixed problem with x-pointer-shape causing future frames not 149 ;; The function `speedbar-with-attached-buffer' brings you back to the
145 ;; to be created. 150 ;; buffer speedbar is displaying for.
146 ;; Fixed annoying habit of `speedbar-update-contents' to make 151 ;;
147 ;; it possible to accidentally kill the speedbar buffer. 152 ;; For those functions that make buttons, the "function" should be a
148 ;; Clicking directory names now only changes the contents of 153 ;; symbol that is the function to call when clicked on. The "token"
149 ;; the speedbar, and does not cause a dired mode to appear. 154 ;; is extra data you can pass along. The "function" must take three
150 ;; Clicking the <+> next to the directory does cause dired to 155 ;; parameters. They are (TEXT TOKEN INDENT). TEXT is the text of the
151 ;; be run. 156 ;; button clicked on. TOKEN is the data passed in when you create the
152 ;; Added XEmacs support, which means timer support moved to a 157 ;; button. INDENT is an indentation level, or 0. You can store
153 ;; platform independant call. 158 ;; indentation levels with `speedbar-make-tag-line' which creates a
154 ;; Added imenu support. Now modes are supported by imenu 159 ;; line with an expander (eg. [+]) and a text button.
155 ;; first, and etags only if the imenu call doesn't work. 160 ;;
156 ;; Imenu is a little faster than etags, and is more emacs 161 ;; Some useful functions when writing expand functions, and click
157 ;; friendly. 162 ;; functions are `speedbar-change-expand-button-char',
158 ;; Added more user control variables described in the commentary. 163 ;; `speedbar-delete-subblock', and `speedbar-center-buffer-smartly'.
159 ;; Added smart recentering when nodes are opened and closed. 164 ;; The variable `speedbar-power-click' is set to t in your functions
160 ;; 0.3 x-pointer-shape fixed for emacs 19.35, so I put that check in. 165 ;; when the user shift-clicks. This indications anything from
161 ;; Added invisible codes to the beginning of each line. 166 ;; refreshing cached data to making a buffer appear in a new frame.
162 ;; Added list aproach to node expansion for easier addition of new 167 ;;
163 ;; types of things to expand by 168 ;; If you wish to add to the default speedbar menu for the case of
164 ;; Added multi-level path name support 169 ;; `foo-mode', create a variable `foo-speedbar-menu-items'. This
165 ;; Added multi-level tag name support. 170 ;; should be a list compatible with the `easymenu' package. It will
166 ;; Only mouse-2 is now used for node expansion 171 ;; be spliced into the main menu. (Available with click-mouse-3). If
167 ;; Added keys e + - to edit expand, and contract node lines 172 ;; you wish to have extra key bindings in your special mode, create a
168 ;; Added longer legal file regexp for all those modes which support 173 ;; variable `foo-speedbar-key-map'. Instead of using `make-keymap',
169 ;; imenu. (pascal, fortran90, ada, pearl) 174 ;; or `make-sparse-keymap', use the function
170 ;; Added pascal support to etags from Dave Penkler <dave_penkler@grenoble.hp.com> 175 ;; `speedbar-make-specialized-keymap'. This lets you inherit all of
171 ;; Fixed centering algorithm 176 ;; speedbar's default bindings with low overhead.
172 ;; Tried to choose background independent colors. Made more robust. 177 ;;
173 ;; Rearranged code into a more logical order 178 ;; Adding a speedbar top-level display mode:
174 ;; 0.3.1 Fixed doc & broken keybindings 179 ;;
175 ;; Added mode hooks. 180 ;; Unlike the specialized modes, there are no name requirements,
176 ;; Improved color selection to be background mode smart 181 ;; however the methods for writing a button display, menu, and keymap
177 ;; `nil' passed to `speedbar-frame-mode' now toggles the frame as 182 ;; are the same. Once you create these items, you can call the
178 ;; advertised in the doc string 183 ;; function `speedbar-add-expansion-list'. It takes one parameter
179 ;; 0.4a Added modified patch from Dan Schmidt <dfan@lglass.com> allowing a 184 ;; which is a list element of the form (NAME MENU KEYMAP &rest
180 ;; directory cache to be maintained speeding up revisiting of files. 185 ;; BUTTON-FUNCTIONS). NAME is a string that will show up in the
181 ;; Default raise-lower behavior is now off by default. 186 ;; Displays menu item. MENU is a symbol containing the menu items to
182 ;; Added some menu items for edit expand and contract. 187 ;; splice in. KEYMAP is a symbol holding the keymap to use, and
183 ;; Pre 19.31 emacsen can run without idle timers. 188 ;; BUTTON-FUNCTIONS are the function names to call, in order, to create
184 ;; Added some patch information from Farzin Guilak <farzin@protocol.com> 189 ;; the display.
185 ;; adding xemacs specifics, and some etags upgrades.
186 ;; Added ability to set a faces symbol-value to a string
187 ;; representing the desired foreground color. (idea from
188 ;; Farzin Guilak, but implemented differently)
189 ;; Fixed problem with 1 character buttons.
190 ;; Added support for new Imenu marker technique.
191 ;; Added `speedbar-load-hooks' for things to run only once on
192 ;; load such as updating one of the many lists.
193 ;; Added `speedbar-supported-extension-expressions' which is a
194 ;; list of extensions that speedbar will tag. This variable
195 ;; should only be updated with `speedbar-add-supported-extension'
196 ;; Moved configure dialog support to a separate file so
197 ;; speedbar is not dependant on eieio to run
198 ;; Fixed list-contraction problem when the item was at the end
199 ;; of a sublist.
200 ;; Fixed XEmacs multi-frame timer selecting bug problem.
201 ;; Added `speedbar-ignored-modes' which is a list of major modes
202 ;; speedbar will not follow when it is displayed in the selected frame
203 ;; 0.4 When the file being edited is not in the list, and is a file
204 ;; that should be in the list, the speedbar cache is replaced.
205 ;; Temp buffers are now shown in the attached frame not the
206 ;; speedbar frame
207 ;; New variables `speedbar-vc-*' and `speedbar-stealthy-function-list'
208 ;; added. `speedbar-update-current-file' is now a member of
209 ;; the stealthy list. New function `speedbar-check-vc' will
210 ;; examine each file and mark it if it is checked out. To
211 ;; add new version control types, override the function
212 ;; `speedbar-this-file-in-vc' and `speedbar-vc-check-dir-p'.
213 ;; The stealth list is interruptible so that long operations
214 ;; do not interrupt someones editing flow. Other long
215 ;; speedbar updates will be added to the stealthy list in the
216 ;; future should interesting ones be needed.
217 ;; Added many new functions including:
218 ;; `speedbar-item-byte-compile' `speedbar-item-load'
219 ;; `speedbar-item-copy' `speedbar-item-rename' `speedbar-item-delete'
220 ;; and `speedbar-item-info'
221 ;; If the user kills the speedbar buffer in some way, the frame will
222 ;; be removed.
223 ;; 0.4.1 Bug fixes
224 ;; <mark.jeffries@nomura.co.uk> added `speedbar-update-flag',
225 ;; XEmacs fixes for menus, and tag sorting, and quit key.
226 ;; Modeline now updates itself based on window-width.
227 ;; Frame is cached when closed to make pulling it up again faster.
228 ;; Speedbars window is now marked as dedicated.
229 ;; Added bindings: <grossjoh@charly.informatik.uni-dortmund.de>
230 ;; Long directories are now span multiple lines autmoatically
231 ;; Added `speedbar-directory-button-trim-method' to specify how to
232 ;; sorten the directory button to fit on the screen.
233 ;; 0.4.2 Add one level of full-text cache.
234 ;; Add `speedbar-get-focus' to switchto/raise the speedbar frame.
235 ;; Editing thing-on-line will auto-raise the attached frame.
236 ;; Bound `U' to `speedbar-up-directory' command.
237 ;; Refresh will now maintain all subdirectories that were open
238 ;; when the refresh was requested. (This does not include the
239 ;; tags, only the directories)
240 ;; 0.4.3 Bug fixes
241 ;; 0.4.4 Added `speedbar-ignored-path-expressions' and friends.
242 ;; Configuration menu items not displayed if dialog-mode not present
243 ;; Speedbar buffer now starts with a space, and is not deleted
244 ;; ewhen the speedbar frame is closed. This prevents the invisible
245 ;; frame from preventing buffer switches with other buffers.
246 ;; Fixed very bad bug in the -add-[extension|path] functions.
247 ;; Added `speedbar-find-file-in-frame' which will always pop up a frame
248 ;; that is already display a buffer selected in the speedbar buffer.
249 ;; Added S-mouse2 as "power click" for always poping up a new frame.
250 ;; and always rescanning with imenu (ditching the imenu cache), and
251 ;; always rescanning directories.
252 ;; 0.4.5 XEmacs bugfixes and enhancements.
253 ;; Window Title simplified.
254 ;; 0.4.6 Fixed problems w/ dedicated minibuffer frame.
255 ;; Fixed errors reported by checkdoc.
256 ;; 0.5 Mode-specific contents added. Controlled w/ the variable
257 ;; `speedbar-mode-specific-contents-flag'. See speedbspec
258 ;; for info on enabling this feature.
259 ;; `speedbar-load-hook' name change and pointer check against
260 ;; major-mode. Suggested by Sam Steingold <sds@ptc.com>
261 ;; Quit auto-selects the attached frame.
262 ;; Ranamed `speedbar-do-updates' to `speedbar-update-flag'
263 ;; Passes checkdoc.
264 ;; 0.5.1 Advice from ptype@dra.hmg.gb:
265 ;; Use `post-command-idle-hook' in older emacsen
266 ;; `speedbar-sort-tags' now works with imenu.
267 ;; Unknown files (marked w/ ?) can now be operated on w/
268 ;; file commands.
269 ;; `speedbar-vc-*-hook's for easilly adding new version control systems.
270 ;; Checkin/out w/ vc will reset the scanners and update the * marker.
271 ;; Fixed ange-ftp require compile time problem.
272 ;; Fixed XEmacs menu bar bug.
273 ;; Added `speedbar-activity-change-focus-flag' to control if the
274 ;; focus changes w/ mouse events.
275 ;; Added `speedbar-sort-tags' toggle to the menubar.
276 ;; Added `speedbar-smart-directory-expand-flag' to toggle how
277 ;; new directories might be inserted into the speedbar hierarchy.
278 ;; Added `speedbar-visiting-[tag|file]hook' which is called whenever
279 ;; speedbar pulls up a file or tag in the attached frame. Setting
280 ;; this to `reposition-window' will do nice things to function tags.
281 ;; Fixed text-cache default-directory bug.
282 ;; Emacs 20 char= support.
283 ;; 0.5.2 Customization
284 ;; For older emacsen, you will need to download the new defcustom
285 ;; package to get nice faces for speedbar
286 ;; mouse1 Double-click is now the same as middle click.
287 ;; No mouse pointer shape stuff for XEmacs (is there any?)
288 ;; 0.5.3 Regressive support for non-custom enabled emacsen.
289 ;; Fixed serious problem w/ 0.5.2 and ignored paths.
290 ;; `condition-case' no longer used in timer fcn.
291 ;; `speedbar-edit-line' is now smarter w/ special modes.
292 ;; 0.5.4 Fixed more problems for Emacs 20 so speedbar loads correctly.
293 ;; Updated some documentation strings.
294 ;; Added customization menu item, and customized some more variables.
295 ;; 0.5.5 Fixed so that there can be no ignored paths
296 ;; Added .l & .lsp as lisp, suggested by: sshteingold@cctrading.com
297 ;; You can now adjust height in `speedbar-frame-parameters'
298 ;; XEmacs fix for use of `local-variable-p'
299 ;; 0.5.6 Folded in XEmacs suggestions from Hrvoje Niksic <hniksic@srce.hr>
300 ;; Several custom changes (group definitions, trim-method & others)
301 ;; Keymap changes, and ways to add menu items.
302 ;; Timer use changes for XEmacs 20.4
303 ;; Regular expression enhancements.
304 ;; 0.6 Fixed up some frame definition stuff, use more convenience fns.
305 ;; Rehashed frame creation code for better compatibility.
306 ;; Fixed setting of kill-buffer hook.
307 ;; Default speedbar has no menubar, mouse-3 is popup menu,
308 ;; XEmacs double-click capability (Hrvoje Niksic <hniksic@srce.hr>)
309 ;; General documentation fixup.
310 ;; 0.6.1 Fixed button-3 menu for Emacs 20.
311 ;; 0.6.2 Added autoload tag to `speedbar-get-focus'
312 190
313 ;;; TODO: 191 ;;; TODO:
314 ;; - More functions to create buttons and options 192 ;; - More functions to create buttons and options
315 ;; - filtering algorithms to reduce the number of tags/files displayed.
316 ;; - Timeout directories we haven't visited in a while. 193 ;; - Timeout directories we haven't visited in a while.
317 ;; - Remeber tags when refreshing the display. (Refresh tags too?) 194 ;; - Remeber tags when refreshing the display. (Refresh tags too?)
318 ;; - More 'special mode support. 195 ;; - More 'special mode support.
319 ;; - C- Mouse 3 menu too much indirection
320 196
321 (require 'assoc) 197 (require 'assoc)
322 (require 'easymenu) 198 (require 'easymenu)
199
200 (defvar speedbar-xemacsp (string-match "XEmacs" emacs-version)
201 "Non-nil if we are running in the XEmacs environment.")
202 (defvar speedbar-xemacs20p (and speedbar-xemacsp
203 (= emacs-major-version 20)))
323 204
324 ;; From custom web page for compatibility between versions of custom: 205 ;; From custom web page for compatibility between versions of custom:
325 (eval-and-compile 206 (eval-and-compile
326 (condition-case () 207 (condition-case ()
327 (require 'custom) 208 (require 'custom)
328 (error nil)) 209 (error nil))
329 (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) 210 (if (and (featurep 'custom) (fboundp 'custom-declare-variable)
211 ;; Some XEmacsen w/ custom don't have :set keyword.
212 ;; This protects them against custom.
213 (fboundp 'custom-initialize-set))
330 nil ;; We've got what we needed 214 nil ;; We've got what we needed
331 ;; We have the old custom-library, hack around it! 215 ;; We have the old custom-library, hack around it!
332 (defmacro defgroup (&rest args) 216 (defmacro defgroup (&rest args)
333 nil) 217 nil)
334 (defmacro defface (var values doc &rest args) 218 (defmacro defface (var values doc &rest args)
359 "Version control display in speedbar." 243 "Version control display in speedbar."
360 :prefix "speedbar-" 244 :prefix "speedbar-"
361 :group 'speedbar) 245 :group 'speedbar)
362 246
363 ;;; Code: 247 ;;; Code:
364 (defvar speedbar-xemacsp (string-match "XEmacs" emacs-version) 248 (defvar speedbar-initial-expansion-mode-alist
365 "Non-nil if we are running in the XEmacs environment.") 249 '(("buffers" speedbar-buffer-easymenu-definition speedbar-buffers-key-map
366 (defvar speedbar-xemacs20p (and speedbar-xemacsp (= emacs-major-version 20))) 250 speedbar-buffer-buttons)
367 251 ("quick buffers" speedbar-buffer-easymenu-definition speedbar-buffers-key-map
368 (defvar speedbar-initial-expansion-list 252 speedbar-buffer-buttons-temp)
369 '(speedbar-directory-buttons speedbar-default-directory-list) 253 ;; Files last, means first in the Displays menu
370 "List of functions to call to fill in the speedbar buffer. 254 ("files" speedbar-easymenu-definition-special speedbar-file-key-map
371 Whenever a top level update is issued all functions in this list are 255 speedbar-directory-buttons speedbar-default-directory-list)
372 run. These functions will always get the default directory to use 256 )
373 passed in as the first parameter, and a 0 as the second parameter. 257 "List of named expansion elements for filling the speedbar frame.
374 The 0 indicates the uppermost indentation level. They must assume 258 These expansion lists are only valid for regular files. Special modes
375 that the cursor is at the position where they start inserting 259 still get to override this list on a mode-by-mode basis. This list of
376 buttons.") 260 lists is of the form (NAME MENU KEYMAP FN1 FN2 ...). NAME is a string
261 representing the types of things to be displayed. MENU is an easymenu
262 structure used when in this mode. KEYMAP is a local keymap to install
263 over the regular speedbar keymap. FN1 ... are functions that will be
264 called in order. These functions will always get the default
265 directory to use passed in as the first parameter, and a 0 as the
266 second parameter. The 0 indicates the uppermost indentation level.
267 They must assume that the cursor is at the position where they start
268 inserting buttons.")
269
270 (defcustom speedbar-initial-expansion-list-name "files"
271 "A symbol name representing the expansion list to use.
272 The expansion list `speedbar-initial-expansion-mode-alist' contains
273 the names and associated functions to use for buttons in speedbar."
274 :group 'speedbar
275 :type '(radio (const :tag "File Directorys" file)
276 ))
277
278 (defvar speedbar-previously-used-expansion-list-name "files"
279 "Save the last expansion list method.
280 This is used for returning to a previous expansion list method when
281 the user is done with the current expansion list.")
377 282
378 (defvar speedbar-stealthy-function-list 283 (defvar speedbar-stealthy-function-list
379 '(speedbar-update-current-file speedbar-check-vc) 284 '(("files"
285 speedbar-update-current-file speedbar-check-vc speedbar-check-objects)
286 )
380 "List of functions to periodically call stealthily. 287 "List of functions to periodically call stealthily.
288 This list is of the form:
289 '( (\"NAME\" FUNCTION ...)
290 ...)
291 where NAME is the name of the major display mode these functions are
292 for, and the remaining elements FUNCTION are functions to call in order.
381 Each function must return nil if interrupted, or t if completed. 293 Each function must return nil if interrupted, or t if completed.
382 Stealthy functions which have a single operation should always return 294 Stealthy functions which have a single operation should always return
383 t. Functions which take a long time should maintain a state (where 295 t. Functions which take a long time should maintain a state (where
384 they are in their speedbar related calculations) and permit 296 they are in their speedbar related calculations) and permit
385 interruption. See `speedbar-check-vc' as a good example.") 297 interruption. See `speedbar-check-vc' as a good example.")
390 frame." 302 frame."
391 :group 'speedbar 303 :group 'speedbar
392 :type 'boolean) 304 :type 'boolean)
393 305
394 (defvar speedbar-special-mode-expansion-list nil 306 (defvar speedbar-special-mode-expansion-list nil
395 "Mode specific list of functions to call to fill in speedbar. 307 "Default function list for creating specialized button lists.
396 Some modes, such as Info or RMAIL, do not relate quite as easily into 308 This list is set by modes that wish to have special speedbar displays.
397 a simple list of files. When this variable is non-nil and buffer-local, 309 The list is of function names. Each function is called with one
398 then these functions are used, creating specialized contents. These 310 parameter BUFFER, the originating buffer. The current buffer is the
399 functions are called each time the speedbar timer is called. This 311 speedbar buffer.")
400 allows a mode to update its contents regularly. 312
401 313 (defvar speedbar-special-mode-key-map nil
402 Each function is called with the default and frame belonging to 314 "Default keymap used when identifying a specialized display mode.
403 speedbar, and with one parameter; the buffer requesting 315 This keymap is local to each buffer that wants to define special keybindings
404 the speedbar display.") 316 effective when it's display is shown.")
405 317
406 (defcustom speedbar-visiting-file-hook nil 318 (defcustom speedbar-visiting-file-hook nil
407 "Hooks run when speedbar visits a file in the selected frame." 319 "Hooks run when speedbar visits a file in the selected frame."
408 :group 'speedbar 320 :group 'speedbar
409 :type 'hook) 321 :type 'hook)
434 Updates occur to allow speedbar to display directory information 346 Updates occur to allow speedbar to display directory information
435 relevant to the buffer you are currently editing." 347 relevant to the buffer you are currently editing."
436 :group 'speedbar 348 :group 'speedbar
437 :type 'integer) 349 :type 'integer)
438 350
439 (defcustom speedbar-navigating-speed 10 351 ;; When I moved to a repeating timer, I had the horrible missfortune
352 ;; of loosing the ability for adaptive speed choice. This update
353 ;; speed currently causes long delays when it should have been turned off.
354 (defcustom speedbar-navigating-speed speedbar-update-speed
440 "*Idle time to wait after navigation commands in speedbar are executed. 355 "*Idle time to wait after navigation commands in speedbar are executed.
441 Navigation commands included expanding/contracting nodes, and moving 356 Navigation commands included expanding/contracting nodes, and moving
442 between different directories." 357 between different directories."
443 :group 'speedbar 358 :group 'speedbar
444 :type 'integer) 359 :type 'integer)
481 use etags instead. Etags support is not as robust as imenu support." 396 use etags instead. Etags support is not as robust as imenu support."
482 :tag "User Imenu" 397 :tag "User Imenu"
483 :group 'speedbar 398 :group 'speedbar
484 :type 'boolean) 399 :type 'boolean)
485 400
486 (defcustom speedbar-sort-tags nil 401 (defcustom speedbar-track-mouse-flag t
487 "*If Non-nil, sort tags in the speedbar display." 402 "*Non-nil means to display info about the line under the mouse."
488 :group 'speedbar 403 :group 'speedbar
489 :type 'boolean) 404 :type 'boolean)
405
406 (defcustom speedbar-sort-tags nil
407 "*If Non-nil, sort tags in the speedbar display. *Obsolete*."
408 :group 'speedbar
409 :type 'boolean)
410
411 (defcustom speedbar-tag-hierarchy-method
412 '(prefix-group trim-words)
413 "*List of methods which speedbar will use to organize tags into groups.
414 Groups are defined as expandable meta-tags. Imenu supports such
415 things in some languages, such as separating variables from functions.
416 Available methods are:
417 sort - Sort tags. (sometimes unnecessary)
418 trim-words - Trim all tags by a common prefix, broken @ word sections.
419 prefix-group - Try to guess groups by prefix.
420 simple-group - If imenu already returned some meta groups, stick all
421 tags that are not in a group into a sub-group."
422 :group 'speedbar
423 :type '(repeat
424 (radio
425 (const :tag "Sort the tags." sort)
426 (const :tag "Trim words to common prefix." trim-words)
427 (const :tag "Create groups from common prefixes." prefix-group)
428 (const :tag "Group loose tags into their own group." simple-group))
429 ))
430
431 (defcustom speedbar-tag-split-minimum-length 20
432 "*Minimum length before we stop trying to create sub-lists in tags.
433 This is used by all tag-hierarchy methods that break large lists into
434 sub-lists."
435 :group 'speedbar
436 :type 'integer)
437
438 (defcustom speedbar-tag-regroup-maximum-length 10
439 "*Maximum length of submenus that are regrouped.
440 If the regrouping option is used, then if two or more short subgroups
441 are next to each other, then they are combined until this number of
442 items is reached."
443 :group 'speedbar
444 :type 'integer)
490 445
491 (defcustom speedbar-activity-change-focus-flag nil 446 (defcustom speedbar-activity-change-focus-flag nil
492 "*Non-nil means the selected frame will change based on activity. 447 "*Non-nil means the selected frame will change based on activity.
493 Thus, if a file is selected for edit, the buffer will appear in the 448 Thus, if a file is selected for edit, the buffer will appear in the
494 selected frame and the focus will change to that frame." 449 selected frame and the focus will change to that frame."
516 are expanded in the current framework. If nil, then the current 471 are expanded in the current framework. If nil, then the current
517 hierarchy would be replaced with the new directory." 472 hierarchy would be replaced with the new directory."
518 :group 'speedbar 473 :group 'speedbar
519 :type 'boolean) 474 :type 'boolean)
520 475
476 (defvar speedbar-hide-button-brackets-flag nil
477 "*Non-nil means speedbar will hide the brackets around the + or -.")
478
521 (defcustom speedbar-before-popup-hook nil 479 (defcustom speedbar-before-popup-hook nil
522 "*Hooks called before popping up the speedbar frame." 480 "*Hooks called before popping up the speedbar frame."
523 :group 'speedbar 481 :group 'speedbar
524 :type 'hook) 482 :type 'hook)
525 483
543 1 means medium level verbosity. 2 and higher are higher levels of 501 1 means medium level verbosity. 2 and higher are higher levels of
544 verbosity." 502 verbosity."
545 :group 'speedbar 503 :group 'speedbar
546 :type 'integer) 504 :type 'integer)
547 505
506 (defvar speedbar-indicator-separator " "
507 "String separating file text from indicator characters.")
508
548 (defcustom speedbar-vc-do-check t 509 (defcustom speedbar-vc-do-check t
549 "*Non-nil check all files in speedbar to see if they have been checked out. 510 "*Non-nil check all files in speedbar to see if they have been checked out.
550 Any file checked out is marked with `speedbar-vc-indicator'" 511 Any file checked out is marked with `speedbar-vc-indicator'"
551 :group 'speedbar-vc 512 :group 'speedbar-vc
552 :type 'boolean) 513 :type 'boolean)
553 514
554 (defvar speedbar-vc-indicator " *" 515 (defvar speedbar-vc-indicator "*"
555 "Text used to mark files which are currently checked out. 516 "Text used to mark files which are currently checked out.
556 Currently only RCS is supported. Other version control systems can be 517 Currently only RCS is supported. Other version control systems can be
557 added by examining the function `speedbar-this-file-in-vc' and 518 added by examining the function `speedbar-this-file-in-vc' and
558 `speedbar-vc-check-dir-p'") 519 `speedbar-vc-check-dir-p'")
520
521 (defcustom speedbar-vc-path-enable-hook nil
522 "*Return non-nil if the current path should be checked for Version Control.
523 Functions in this hook must accept one parameter which is the path
524 being checked."
525 :group 'speedbar-vc
526 :type 'hook)
527
528 (defcustom speedbar-vc-in-control-hook nil
529 "*Return non-nil if the specified file is under Version Control.
530 Functions in this hook must accept two parameters. The PATH of the
531 current file, and the FILENAME of the file being checked."
532 :group 'speedbar-vc
533 :type 'hook)
534
535 (defvar speedbar-vc-to-do-point nil
536 "Local variable maintaining the current version control check position.")
537
538 (defcustom speedbar-obj-do-check t
539 "*Non-nil check all files in speedbar to see if they have an object file.
540 Any file checked out is marked with `speedbar-obj-indicator', and the
541 marking is based on `speedbar-obj-alist'"
542 :group 'speedbar-vc
543 :type 'boolean)
544
545 (defvar speedbar-obj-to-do-point nil
546 "Local variable maintaining the current version control check position.")
547
548 (defvar speedbar-obj-indicator '("#" . "!")
549 "Text used to mark files that have a corresponding hidden object file.
550 The car is for an up-to-date object. The cdr is for an out of date object.
551 The expression `speedbar-obj-alist' defines who gets tagged.")
552
553 (defvar speedbar-obj-alist
554 '(("\\.\\([cpC]\\|cpp\\|cc\\)$" . ".o")
555 ("\\.el$" . ".elc")
556 ("\\.java$" . ".class")
557 ("\\.f\\(or\\|90\\|77\\)?$" . ".o")
558 ("\\.tex$" . ".dvi")
559 ("\\.texi$" . ".info"))
560 "Alist of file extensions, and their corresponding object file type.")
561
562 (defvar speedbar-indicator-regex
563 (concat (regexp-quote speedbar-indicator-separator)
564 "\\("
565 (regexp-quote speedbar-vc-indicator)
566 "\\|"
567 (regexp-quote (car speedbar-obj-indicator))
568 "\\|"
569 (regexp-quote (cdr speedbar-obj-indicator))
570 "\\)*")
571 "Regular expression used when identifying files.
572 Permits stripping of indicator characters from a line.")
559 573
560 (defcustom speedbar-scanner-reset-hook nil 574 (defcustom speedbar-scanner-reset-hook nil
561 "*Hook called whenever generic scanners are reset. 575 "*Hook called whenever generic scanners are reset.
562 Set this to implement your own scanning / rescan safe functions with 576 Set this to implement your own scanning / rescan safe functions with
563 state data." 577 state data."
564 :group 'speedbar 578 :group 'speedbar
565 :type 'hook) 579 :type 'hook)
566 580
567 (defcustom speedbar-vc-path-enable-hook nil
568 "*Return non-nil if the current path should be checked for Version Control.
569 Functions in this hook must accept one parameter which is the path
570 being checked."
571 :group 'speedbar-vc
572 :type 'hook)
573
574 (defcustom speedbar-vc-in-control-hook nil
575 "*Return non-nil if the specified file is under Version Control.
576 Functions in this hook must accept two parameters. The PATH of the
577 current file, and the FILENAME of the file being checked."
578 :group 'speedbar-vc
579 :type 'hook)
580
581 (defvar speedbar-vc-to-do-point nil
582 "Local variable maintaining the current version control check position.")
583
584 (defvar speedbar-ignored-modes nil 581 (defvar speedbar-ignored-modes nil
585 "*List of major modes which speedbar will not switch directories for.") 582 "*List of major modes which speedbar will not switch directories for.")
586 583
587 (defun speedbar-extension-list-to-regex (extlist) 584 (defun speedbar-extension-list-to-regex (extlist)
588 "Takes EXTLIST, a list of extensions and transforms it into regexp. 585 "Takes EXTLIST, a list of extensions and transforms it into regexp.
589 All the preceding . are stripped for an optimized expression starting 586 All the preceding `.' are stripped for an optimized expression starting
590 with . followed by extensions, followed by full-filenames." 587 with `.' followed by extensions, followed by full-filenames."
591 (let ((regex1 nil) (regex2 nil)) 588 (let ((regex1 nil) (regex2 nil))
592 (while extlist 589 (while extlist
593 (if (= (string-to-char (car extlist)) ?.) 590 (if (= (string-to-char (car extlist)) ?.)
594 (setq regex1 (concat regex1 (if regex1 "\\|" "") 591 (setq regex1 (concat regex1 (if regex1 "\\|" "")
595 (substring (car extlist) 1))) 592 (substring (car extlist) 1)))
623 :set (lambda (sym val) 620 :set (lambda (sym val)
624 (setq speedbar-ignored-path-expressions val 621 (setq speedbar-ignored-path-expressions val
625 speedbar-ignored-path-regexp 622 speedbar-ignored-path-regexp
626 (speedbar-extension-list-to-regex val)))) 623 (speedbar-extension-list-to-regex val))))
627 624
625 (defcustom speedbar-directory-unshown-regexp "^\\(CVS\\|RCS\\|SCCS\\)\\'"
626 "*Regular expression matching directories not to show in speedbar.
627 They should include commonly existing directories which are not
628 useful, such as version control."
629 :group 'speedbar
630 :type 'string)
631
628 (defvar speedbar-file-unshown-regexp 632 (defvar speedbar-file-unshown-regexp
629 (let ((nstr "") (noext completion-ignored-extensions)) 633 (let ((nstr "") (noext completion-ignored-extensions))
630 (while noext 634 (while noext
631 (setq nstr (concat nstr (regexp-quote (car noext)) "\\'" 635 (setq nstr (concat nstr (regexp-quote (car noext)) "\\'"
632 (if (cdr noext) "\\|" "")) 636 (if (cdr noext) "\\|" ""))
636 It is generated from the variable `completion-ignored-extensions'") 640 It is generated from the variable `completion-ignored-extensions'")
637 641
638 ;; this is dangerous to customize, because the defaults will probably 642 ;; this is dangerous to customize, because the defaults will probably
639 ;; change in the future. 643 ;; change in the future.
640 (defcustom speedbar-supported-extension-expressions 644 (defcustom speedbar-supported-extension-expressions
641 (append '(".[CcHh]\\(\\+\\+\\|pp\\|c\\|h\\)?" ".tex\\(i\\(nfo\\)?\\)?" 645 (append '(".[ch]\\(\\+\\+\\|pp\\|c\\|h\\|xx\\)?" ".tex\\(i\\(nfo\\)?\\)?"
642 ".el" ".emacs" ".l" ".lsp" ".p" ".java") 646 ".el" ".emacs" ".l" ".lsp" ".p" ".java" ".f\\(90\\|77\\|or\\)?")
643 (if speedbar-use-imenu-flag 647 (if speedbar-use-imenu-flag
644 '(".f90" ".ada" ".pl" ".tcl" ".m" 648 '(".ada" ".pl" ".tcl" ".m" ".scm" ".pm" ".py"
649 ;; html is not supported by default, but an imenu tags package
650 ;; is available. Also, html files are nice to be able to see.
651 ".s?html"
645 "Makefile\\(\\.in\\)?"))) 652 "Makefile\\(\\.in\\)?")))
646 "*List of regular expressions which will match files supported by tagging. 653 "*List of regular expressions which will match files supported by tagging.
647 Do not prefix the `.' char with a double \\ to quote it, as the period 654 Do not prefix the `.' char with a double \\ to quote it, as the period
648 will be stripped by a simplified optimizer when compiled into a 655 will be stripped by a simplified optimizer when compiled into a
649 singular expression. This variable will be turned into 656 singular expression. This variable will be turned into
668 "Add EXTENSION as a new supported extension for speedbar tagging. 675 "Add EXTENSION as a new supported extension for speedbar tagging.
669 This should start with a `.' if it is not a complete file name, and 676 This should start with a `.' if it is not a complete file name, and
670 the dot should NOT be quoted in with \\. Other regular expression 677 the dot should NOT be quoted in with \\. Other regular expression
671 matchers are allowed however. EXTENSION may be a single string or a 678 matchers are allowed however. EXTENSION may be a single string or a
672 list of strings." 679 list of strings."
680 (interactive "sExtionsion: ")
673 (if (not (listp extension)) (setq extension (list extension))) 681 (if (not (listp extension)) (setq extension (list extension)))
674 (while extension 682 (while extension
675 (if (member (car extension) speedbar-supported-extension-expressions) 683 (if (member (car extension) speedbar-supported-extension-expressions)
676 nil 684 nil
677 (setq speedbar-supported-extension-expressions 685 (setq speedbar-supported-extension-expressions
682 690
683 (defun speedbar-add-ignored-path-regexp (path-expression) 691 (defun speedbar-add-ignored-path-regexp (path-expression)
684 "Add PATH-EXPRESSION as a new ignored path for speedbar tracking. 692 "Add PATH-EXPRESSION as a new ignored path for speedbar tracking.
685 This function will modify `speedbar-ignored-path-regexp' and add 693 This function will modify `speedbar-ignored-path-regexp' and add
686 PATH-EXPRESSION to `speedbar-ignored-path-expressions'." 694 PATH-EXPRESSION to `speedbar-ignored-path-expressions'."
695 (interactive "sPath regex: ")
687 (if (not (listp path-expression)) 696 (if (not (listp path-expression))
688 (setq path-expression (list path-expression))) 697 (setq path-expression (list path-expression)))
689 (while path-expression 698 (while path-expression
690 (if (member (car path-expression) speedbar-ignored-path-expressions) 699 (if (member (car path-expression) speedbar-ignored-path-expressions)
691 nil 700 nil
700 (setq speedbar-file-regexp (speedbar-extension-list-to-regex 709 (setq speedbar-file-regexp (speedbar-extension-list-to-regex
701 speedbar-supported-extension-expressions) 710 speedbar-supported-extension-expressions)
702 speedbar-ignored-path-regexp (speedbar-extension-list-to-regex 711 speedbar-ignored-path-regexp (speedbar-extension-list-to-regex
703 speedbar-ignored-path-expressions))) 712 speedbar-ignored-path-expressions)))
704 713
705 (defvar speedbar-update-flag (or (fboundp 'run-with-idle-timer) 714 (defvar speedbar-update-flag (and
706 (fboundp 'start-itimer) 715 (or (fboundp 'run-with-idle-timer)
707 (boundp 'post-command-idle-hook)) 716 (fboundp 'start-itimer)
717 (boundp 'post-command-idle-hook))
718 window-system)
708 "*Non-nil means to automatically update the display. 719 "*Non-nil means to automatically update the display.
709 When this is nil then speedbar will not follow the attached frame's path. 720 When this is nil then speedbar will not follow the attached frame's path.
710 When speedbar is active, use: 721 When speedbar is active, use:
711 722
712 \\<speedbar-key-map> `\\[speedbar-toggle-updates]' 723 \\<speedbar-key-map> `\\[speedbar-toggle-updates]'
725 (modify-syntax-entry ?( " " speedbar-syntax-table) 736 (modify-syntax-entry ?( " " speedbar-syntax-table)
726 (modify-syntax-entry ?) " " speedbar-syntax-table) 737 (modify-syntax-entry ?) " " speedbar-syntax-table)
727 (modify-syntax-entry ?[ " " speedbar-syntax-table) 738 (modify-syntax-entry ?[ " " speedbar-syntax-table)
728 (modify-syntax-entry ?] " " speedbar-syntax-table)) 739 (modify-syntax-entry ?] " " speedbar-syntax-table))
729 740
730
731 (defvar speedbar-key-map nil 741 (defvar speedbar-key-map nil
732 "Keymap used in speedbar buffer.") 742 "Keymap used in speedbar buffer.")
733 743
734 (if speedbar-key-map 744 (if speedbar-key-map
735 nil 745 nil
736 (setq speedbar-key-map (make-keymap)) 746 (setq speedbar-key-map (make-keymap))
737 (suppress-keymap speedbar-key-map t) 747 (suppress-keymap speedbar-key-map t)
738 748
739 ;; control 749 ;; control
740 (define-key speedbar-key-map "e" 'speedbar-edit-line)
741 (define-key speedbar-key-map "\C-m" 'speedbar-edit-line)
742 (define-key speedbar-key-map "+" 'speedbar-expand-line)
743 (define-key speedbar-key-map "-" 'speedbar-contract-line)
744 (define-key speedbar-key-map "g" 'speedbar-refresh) 750 (define-key speedbar-key-map "g" 'speedbar-refresh)
745 (define-key speedbar-key-map "t" 'speedbar-toggle-updates) 751 (define-key speedbar-key-map "t" 'speedbar-toggle-updates)
746 (define-key speedbar-key-map "q" 'speedbar-close-frame) 752 (define-key speedbar-key-map "q" 'speedbar-close-frame)
747 (define-key speedbar-key-map "U" 'speedbar-up-directory)
748 753
749 ;; navigation 754 ;; navigation
750 (define-key speedbar-key-map "n" 'speedbar-next) 755 (define-key speedbar-key-map "n" 'speedbar-next)
751 (define-key speedbar-key-map "p" 'speedbar-prev) 756 (define-key speedbar-key-map "p" 'speedbar-prev)
757 (define-key speedbar-key-map "\M-n" 'speedbar-restricted-next)
758 (define-key speedbar-key-map "\M-p" 'speedbar-restricted-prev)
759 (define-key speedbar-key-map "\C-\M-n" 'speedbar-forward-list)
760 (define-key speedbar-key-map "\C-\M-p" 'speedbar-backward-list)
752 (define-key speedbar-key-map " " 'speedbar-scroll-up) 761 (define-key speedbar-key-map " " 'speedbar-scroll-up)
753 (define-key speedbar-key-map [delete] 'speedbar-scroll-down) 762 (define-key speedbar-key-map [delete] 'speedbar-scroll-down)
754 763
755 ;; After much use, I suddenly desired in my heart to perform dired 764 ;; Short cuts I happen to find useful
756 ;; style operations since the directory was RIGHT THERE! 765 (define-key speedbar-key-map "r"
757 (define-key speedbar-key-map "I" 'speedbar-item-info) 766 (lambda () (interactive)
758 (define-key speedbar-key-map "B" 'speedbar-item-byte-compile) 767 (speedbar-change-initial-expansion-list
759 (define-key speedbar-key-map "L" 'speedbar-item-load) 768 speedbar-previously-used-expansion-list-name)))
760 (define-key speedbar-key-map "C" 'speedbar-item-copy) 769 (define-key speedbar-key-map "b"
761 (define-key speedbar-key-map "D" 'speedbar-item-delete) 770 (lambda () (interactive)
762 (define-key speedbar-key-map "R" 'speedbar-item-rename) 771 (speedbar-change-initial-expansion-list "quick buffers")))
772 (define-key speedbar-key-map "f"
773 (lambda () (interactive)
774 (speedbar-change-initial-expansion-list "files")))
775
776 ;; Overrides
777 (substitute-key-definition 'switch-to-buffer
778 'speedbar-switch-buffer-attached-frame
779 speedbar-key-map global-map)
763 780
764 (if speedbar-xemacsp 781 (if speedbar-xemacsp
765 (progn 782 (progn
766 ;; mouse bindings so we can manipulate the items on each line 783 ;; mouse bindings so we can manipulate the items on each line
767 (define-key speedbar-key-map 'button2 'speedbar-click) 784 (define-key speedbar-key-map 'button2 'speedbar-click)
768 (define-key speedbar-key-map '(shift button2) 'speedbar-power-click) 785 (define-key speedbar-key-map '(shift button2) 'speedbar-power-click)
769 (define-key speedbar-key-map 'button3 'speedbar-xemacs-popup-kludge) 786 ;; Info doc fix from Bob Weiner
770 (define-key speedbar-key-map '(meta button3) 'speedbar-mouse-item-info)) 787 (if (featurep 'infodoc)
788 nil
789 (define-key speedbar-key-map 'button3 'speedbar-xemacs-popup-kludge))
790 (define-key speedbar-key-map '(meta button3) 'speedbar-mouse-item-info)
791 )
792
771 ;; mouse bindings so we can manipulate the items on each line 793 ;; mouse bindings so we can manipulate the items on each line
772 (define-key speedbar-key-map [down-mouse-1] 'speedbar-double-click) 794 (define-key speedbar-key-map [down-mouse-1] 'speedbar-double-click)
773 (define-key speedbar-key-map [mouse-2] 'speedbar-click) 795 (define-key speedbar-key-map [mouse-2] 'speedbar-click)
774 ;; This is the power click for new frames, or refreshing a cache 796 ;; This is the power click for new frames, or refreshing a cache
775 (define-key speedbar-key-map [S-mouse-2] 'speedbar-power-click) 797 (define-key speedbar-key-map [S-mouse-2] 'speedbar-power-click)
777 ;;(define-key speedbar-key-map [down-mouse-2] 'speedbar-quick-mouse) 799 ;;(define-key speedbar-key-map [down-mouse-2] 'speedbar-quick-mouse)
778 (define-key speedbar-key-map [M-mouse-2] 'speedbar-mouse-item-info) 800 (define-key speedbar-key-map [M-mouse-2] 'speedbar-mouse-item-info)
779 801
780 (define-key speedbar-key-map [down-mouse-3] 'speedbar-emacs-popup-kludge) 802 (define-key speedbar-key-map [down-mouse-3] 'speedbar-emacs-popup-kludge)
781 803
782 ;;***** Disable disabling: Remove menubar completely.
783 ;; disable all menus - we don't have a lot of space to play with
784 ;; in such a skinny frame. This will cleverly find and nuke some
785 ;; user-defined menus as well if they are there. Too bad it
786 ;; rely's on the structure of a keymap to work.
787 ; (let ((k (lookup-key global-map [menu-bar])))
788 ; (while k
789 ; (if (and (listp (car k)) (listp (cdr (car k))))
790 ; (define-key speedbar-key-map (vector 'menu-bar (car (car k)))
791 ; 'undefined))
792 ; (setq k (cdr k))))
793
794 ;; This lets the user scroll as if we had a scrollbar... well maybe not 804 ;; This lets the user scroll as if we had a scrollbar... well maybe not
795 (define-key speedbar-key-map [mode-line mouse-2] 'speedbar-mouse-hscroll) 805 (define-key speedbar-key-map [mode-line mouse-2] 'speedbar-mouse-hscroll)
796 )) 806 ;; another handy place users might click to get our menu.
807 (define-key speedbar-key-map [mode-line down-mouse-1]
808 'speedbar-emacs-popup-kludge)
809
810 ;; Lastly, we want to track the mouse. Play here
811 (define-key speedbar-key-map [mouse-movement] 'speedbar-track-mouse)
812 ))
813
814 (defun speedbar-make-specialized-keymap ()
815 "Create a keymap for use w/ a speedbar major or minor display mode.
816 This basically creates a sparse keymap, and makes it's parent be
817 `speedbar-key-map'."
818 (let ((k (make-sparse-keymap)))
819 (set-keymap-parent k speedbar-key-map)
820 k))
821
822 (defvar speedbar-file-key-map nil
823 "Keymap used in speedbar buffer while files are displayed.")
824
825 (if speedbar-file-key-map
826 nil
827 (setq speedbar-file-key-map (speedbar-make-specialized-keymap))
828
829 ;; Basic tree features
830 (define-key speedbar-file-key-map "e" 'speedbar-edit-line)
831 (define-key speedbar-file-key-map "\C-m" 'speedbar-edit-line)
832 (define-key speedbar-file-key-map "+" 'speedbar-expand-line)
833 (define-key speedbar-file-key-map "-" 'speedbar-contract-line)
834
835 ;; file based commands
836 (define-key speedbar-file-key-map "U" 'speedbar-up-directory)
837 (define-key speedbar-file-key-map "I" 'speedbar-item-info)
838 (define-key speedbar-file-key-map "B" 'speedbar-item-byte-compile)
839 (define-key speedbar-file-key-map "L" 'speedbar-item-load)
840 (define-key speedbar-file-key-map "C" 'speedbar-item-copy)
841 (define-key speedbar-file-key-map "D" 'speedbar-item-delete)
842 (define-key speedbar-file-key-map "O" 'speedbar-item-object-delete)
843 (define-key speedbar-file-key-map "R" 'speedbar-item-rename)
844 )
797 845
798 (defvar speedbar-easymenu-definition-base 846 (defvar speedbar-easymenu-definition-base
799 '("Speedbar" 847 '("Speedbar"
800 ["Update" speedbar-refresh t] 848 ["Update" speedbar-refresh t]
801 ["Auto Update" speedbar-toggle-updates 849 ["Auto Update" speedbar-toggle-updates
805 853
806 (defvar speedbar-easymenu-definition-special 854 (defvar speedbar-easymenu-definition-special
807 '(["Edit Item On Line" speedbar-edit-line t] 855 '(["Edit Item On Line" speedbar-edit-line t]
808 ["Show All Files" speedbar-toggle-show-all-files 856 ["Show All Files" speedbar-toggle-show-all-files
809 :style toggle :selected speedbar-show-unknown-files] 857 :style toggle :selected speedbar-show-unknown-files]
810 ["Expand Item" speedbar-expand-line 858 ["Expand File Tags" speedbar-expand-line
811 (save-excursion (beginning-of-line) 859 (save-excursion (beginning-of-line)
812 (looking-at "[0-9]+: *.\\+. "))] 860 (looking-at "[0-9]+: *.\\+. "))]
813 ["Contract Item" speedbar-contract-line 861 ["Contract File Tags" speedbar-contract-line
814 (save-excursion (beginning-of-line) 862 (save-excursion (beginning-of-line)
815 (looking-at "[0-9]+: *.-. "))] 863 (looking-at "[0-9]+: *.-. "))]
816 ["Sort Tags" speedbar-toggle-sorting 864 ; ["Sort Tags" speedbar-toggle-sorting
817 :style toggle :selected speedbar-sort-tags] 865 ; :style toggle :selected speedbar-sort-tags]
818 "----" 866 "----"
819 ["Item Information" speedbar-item-info t] 867 ["File/Tag Information" speedbar-item-info t]
820 ["Load Lisp File" speedbar-item-load 868 ["Load Lisp File" speedbar-item-load
821 (save-excursion 869 (save-excursion
822 (beginning-of-line) 870 (beginning-of-line)
823 (looking-at "[0-9]+: *\\[[+-]\\] .+\\(\\.el\\)\\( \\*\\)?$"))] 871 (looking-at "[0-9]+: *\\[[+-]\\] .+\\(\\.el\\)\\( \\|$\\)"))]
824 ["Byte Compile File" speedbar-item-byte-compile 872 ["Byte Compile File" speedbar-item-byte-compile
825 (save-excursion 873 (save-excursion
826 (beginning-of-line) 874 (beginning-of-line)
827 (looking-at "[0-9]+: *\\[[+-]\\] .+\\(\\.el\\)\\( \\*\\)?$"))] 875 (looking-at "[0-9]+: *\\[[+-]\\] .+\\(\\.el\\)\\( \\|$\\)"))]
828 ["Copy Item" speedbar-item-copy 876 ["Copy File" speedbar-item-copy
829 (save-excursion (beginning-of-line) (looking-at "[0-9]+: *\\["))] 877 (save-excursion (beginning-of-line) (looking-at "[0-9]+: *\\["))]
830 ["Rename Item" speedbar-item-rename 878 ["Rename File" speedbar-item-rename
831 (save-excursion (beginning-of-line) (looking-at "[0-9]+: *[[<]"))] 879 (save-excursion (beginning-of-line) (looking-at "[0-9]+: *[[<]"))]
832 ["Delete Item" speedbar-item-delete 880 ["Delete File" speedbar-item-delete
833 (save-excursion (beginning-of-line) (looking-at "[0-9]+: *[[<]"))]) 881 (save-excursion (beginning-of-line) (looking-at "[0-9]+: *[[<]"))]
882 ["Delete Object" speedbar-item-object-delete
883 (save-excursion (beginning-of-line)
884 (looking-at "[0-9]+: *\\[[+-]\\] [^ \n]+ \\*?[!#]$"))]
885 )
834 "Additional menu items while in file-mode.") 886 "Additional menu items while in file-mode.")
835 887
836 (defvar speedbar-easymenu-definition-trailer 888 (defvar speedbar-easymenu-definition-trailer
837 (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) 889 (list
838 '("----" 890 (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
839 ["Customize..." speedbar-customize t] 891 ["Customize..." speedbar-customize t])
840 ["Close" speedbar-close-frame t]) 892 ["Close" speedbar-close-frame t])
841 '("----"
842 ["Close" speedbar-close-frame t]))
843 "Menu items appearing at the end of the speedbar menu.") 893 "Menu items appearing at the end of the speedbar menu.")
844 894
845 (defvar speedbar-desired-buffer nil 895 (defvar speedbar-desired-buffer nil
846 "Non-nil when speedbar is showing buttons specific a special mode. 896 "Non-nil when speedbar is showing buttons specific a special mode.
847 In this case it is the originating buffer.") 897 In this case it is the originating buffer.")
888 `speedbar-mode' will be displayed. Currently, only one speedbar is 938 `speedbar-mode' will be displayed. Currently, only one speedbar is
889 supported at a time. 939 supported at a time.
890 `speedbar-before-popup-hook' is called before popping up the speedbar frame. 940 `speedbar-before-popup-hook' is called before popping up the speedbar frame.
891 `speedbar-before-delete-hook' is called before the frame is deleted." 941 `speedbar-before-delete-hook' is called before the frame is deleted."
892 (interactive "P") 942 (interactive "P")
893 (if (if (and speedbar-xemacsp (fboundp 'console-on-window-system-p))
894 (not (console-on-window-system-p))
895 (not (symbol-value 'window-system)))
896 (error "Speedbar is not useful outside of a windowing environment"))
897 ;;; RMS says this should not modify the menu.
898 ; (if speedbar-xemacsp
899 ; (add-menu-button '("Tools")
900 ; ["Speedbar" speedbar-frame-mode
901 ; :style toggle
902 ; :selected (and (boundp 'speedbar-frame)
903 ; (frame-live-p speedbar-frame)
904 ; (frame-visible-p speedbar-frame))]
905 ; "--")
906 ; (define-key-after (lookup-key global-map [menu-bar tools])
907 ; [speedbar] '("Speedbar" . speedbar-frame-mode) [calendar]))
908 ;; toggle frame on and off. 943 ;; toggle frame on and off.
909 (if (not arg) (if (and (frame-live-p speedbar-frame) 944 (if (not arg) (if (and (frame-live-p speedbar-frame)
910 (frame-visible-p speedbar-frame)) 945 (frame-visible-p speedbar-frame))
911 (setq arg -1) (setq arg 1))) 946 (setq arg -1) (setq arg 1)))
912 ;; turn the frame off on neg number 947 ;; turn the frame off on neg number
954 (list (cons 989 (list (cons
955 'height 990 'height
956 (if speedbar-xemacsp 991 (if speedbar-xemacsp
957 (speedbar-needed-height) 992 (speedbar-needed-height)
958 (+ mh (frame-height)))))))) 993 (+ mh (frame-height))))))))
959 (if (< emacs-major-version 20);;a bug is fixed in v20 & later 994 (if (or (< emacs-major-version 20);;a bug is fixed in v20
995 (not (eq window-system 'x)))
960 (make-frame params) 996 (make-frame params)
961 (let ((x-pointer-shape x-pointer-top-left-arrow) 997 (let ((x-pointer-shape x-pointer-top-left-arrow)
962 (x-sensitive-text-pointer-shape x-pointer-hand2)) 998 (x-sensitive-text-pointer-shape x-pointer-hand2))
963 (make-frame params)))))) 999 (make-frame params))))))
964 ;; reset the selection variable 1000 ;; reset the selection variable
979 selected. If the speedbar frame is active, then select the attached frame." 1015 selected. If the speedbar frame is active, then select the attached frame."
980 (interactive) 1016 (interactive)
981 (if (eq (selected-frame) speedbar-frame) 1017 (if (eq (selected-frame) speedbar-frame)
982 (if (frame-live-p speedbar-attached-frame) 1018 (if (frame-live-p speedbar-attached-frame)
983 (select-frame speedbar-attached-frame)) 1019 (select-frame speedbar-attached-frame))
1020 ;; If updates are off, then refresh the frame (they want it now...)
1021 (if (not speedbar-update-flag)
1022 (let ((speedbar-update-flag t))
1023 (speedbar-timer-fn)))
984 ;; make sure we have a frame 1024 ;; make sure we have a frame
985 (if (not (frame-live-p speedbar-frame)) (speedbar-frame-mode 1)) 1025 (if (not (frame-live-p speedbar-frame)) (speedbar-frame-mode 1))
986 ;; go there 1026 ;; go there
987 (select-frame speedbar-frame)) 1027 (select-frame speedbar-frame)
1028 )
988 (other-frame 0)) 1029 (other-frame 0))
989 1030
990 (defun speedbar-close-frame () 1031 (defun speedbar-close-frame ()
991 "Turn off a currently active speedbar." 1032 "Turn off a currently active speedbar."
992 (interactive) 1033 (interactive)
993 (speedbar-frame-mode -1) 1034 (speedbar-frame-mode -1)
994 (select-frame speedbar-attached-frame) 1035 (select-frame speedbar-attached-frame)
995 (other-frame 0)) 1036 (other-frame 0))
1037
1038 (defun speedbar-switch-buffer-attached-frame (&optional buffer)
1039 "Switch to BUFFER in speedbar's attached frame, and raise that frame.
1040 This overrides the default behavior of `switch-to-buffer' which is
1041 broken because of the dedicated speedbar frame."
1042 (interactive)
1043 ;; Assume we are in the speedbar frame.
1044 (speedbar-get-focus)
1045 ;; Now switch buffers
1046 (if buffer
1047 (switch-to-buffer buffer)
1048 (call-interactively 'switch-to-buffer nil nil)))
996 1049
997 (defmacro speedbar-frame-width () 1050 (defmacro speedbar-frame-width ()
998 "Return the width of the speedbar frame in characters. 1051 "Return the width of the speedbar frame in characters.
999 nil if it doesn't exist." 1052 nil if it doesn't exist."
1000 '(frame-width speedbar-frame)) 1053 '(frame-width speedbar-frame))
1030 Files with a `*' character after their name are files checked out of a 1083 Files with a `*' character after their name are files checked out of a
1031 version control system. (currently only RCS is supported.) New 1084 version control system. (currently only RCS is supported.) New
1032 version control systems can be added by examining the documentation 1085 version control systems can be added by examining the documentation
1033 for `speedbar-this-file-in-vc' and `speedbar-vc-check-dir-p' 1086 for `speedbar-this-file-in-vc' and `speedbar-vc-check-dir-p'
1034 1087
1088 Files with a `#' or `!' character after them are source files that
1089 have an object file associated with them. The `!' indicates that the
1090 files is out of date. You can control what source/object associations
1091 exist through the variable `speedbar-obj-alist'.
1092
1035 Click on the [+] to display a list of tags from that file. Click on 1093 Click on the [+] to display a list of tags from that file. Click on
1036 the [-] to retract the list. Click on the file name to edit the file 1094 the [-] to retract the list. Click on the file name to edit the file
1037 in the attached frame. 1095 in the attached frame.
1038 1096
1039 If you open tags, you might find a node starting with {+}, which is a 1097 If you open tags, you might find a node starting with {+}, which is a
1046 (save-excursion 1104 (save-excursion
1047 (setq speedbar-buffer (set-buffer (get-buffer-create " SPEEDBAR"))) 1105 (setq speedbar-buffer (set-buffer (get-buffer-create " SPEEDBAR")))
1048 (kill-all-local-variables) 1106 (kill-all-local-variables)
1049 (setq major-mode 'speedbar-mode) 1107 (setq major-mode 'speedbar-mode)
1050 (setq mode-name "Speedbar") 1108 (setq mode-name "Speedbar")
1051 (use-local-map speedbar-key-map)
1052 (set-syntax-table speedbar-syntax-table) 1109 (set-syntax-table speedbar-syntax-table)
1053 (setq font-lock-keywords nil) ;; no font-locking please 1110 (setq font-lock-keywords nil) ;; no font-locking please
1054 (setq truncate-lines t) 1111 (setq truncate-lines t)
1055 (make-local-variable 'frame-title-format) 1112 (make-local-variable 'frame-title-format)
1056 (setq frame-title-format "Speedbar") 1113 (setq frame-title-format "Speedbar")
1057 ;; Set this up special just for the speedbar buffer 1114 ;; Set this up special just for the speedbar buffer
1058 (if (null default-minibuffer-frame) 1115 ;; Terminal minibuffer stuff does not require this.
1116 (if (and window-system (null default-minibuffer-frame))
1059 (progn 1117 (progn
1060 (make-local-variable 'default-minibuffer-frame) 1118 (make-local-variable 'default-minibuffer-frame)
1061 (setq default-minibuffer-frame speedbar-attached-frame))) 1119 (setq default-minibuffer-frame speedbar-attached-frame)))
1120 ;; Correct use of `temp-buffer-show-function': Bob Weiner
1121 (if (and (boundp 'temp-buffer-show-hook)
1122 (boundp 'temp-buffer-show-function))
1123 (progn (make-local-variable 'temp-buffer-show-hook)
1124 (setq temp-buffer-show-hook temp-buffer-show-function)))
1062 (make-local-variable 'temp-buffer-show-function) 1125 (make-local-variable 'temp-buffer-show-function)
1063 (setq temp-buffer-show-function 'speedbar-temp-buffer-show-function) 1126 (setq temp-buffer-show-function 'speedbar-temp-buffer-show-function)
1064 (if speedbar-xemacsp 1127 (if speedbar-xemacsp
1065 (progn 1128 (progn
1066 ;; Argh! mouse-track-click-hook doesn't understand the 1129 ;; Argh! mouse-track-click-hook doesn't understand the
1086 (if (eq (current-buffer) 1149 (if (eq (current-buffer)
1087 speedbar-buffer) 1150 speedbar-buffer)
1088 (speedbar-frame-mode -1))))) 1151 (speedbar-frame-mode -1)))))
1089 t t) 1152 t t)
1090 (speedbar-set-mode-line-format) 1153 (speedbar-set-mode-line-format)
1091 (if (not speedbar-xemacsp) 1154 (if speedbar-xemacsp
1092 (setq auto-show-mode nil)) ;no auto-show for Emacs 1155 (progn
1156 (make-local-variable 'mouse-motion-handler)
1157 (setq mouse-motion-handler 'speedbar-track-mouse-xemacs))
1158 (if speedbar-track-mouse-flag
1159 (progn
1160 (make-local-variable 'track-mouse)
1161 (setq track-mouse t))) ;this could be messy.
1162 (setq auto-show-mode nil)) ;no auto-show for Emacs
1093 (run-hooks 'speedbar-mode-hook)) 1163 (run-hooks 'speedbar-mode-hook))
1094 (speedbar-update-contents) 1164 (speedbar-update-contents)
1095 speedbar-buffer) 1165 speedbar-buffer)
1166
1167 (defun speedbar-show-info-under-mouse (&optional event)
1168 "Call the info function for the line under the mouse.
1169 Optional EVENT is currently not used."
1170 (let ((pos (mouse-position))) ; we ignore event until I use it later.
1171 (if (equal (car pos) speedbar-frame)
1172 (save-excursion
1173 (save-window-excursion
1174 (apply 'set-mouse-position pos)
1175 (speedbar-item-info))))))
1096 1176
1097 (defun speedbar-set-mode-line-format () 1177 (defun speedbar-set-mode-line-format ()
1098 "Set the format of the mode line based on the current speedbar environment. 1178 "Set the format of the mode line based on the current speedbar environment.
1099 This gives visual indications of what is up. It EXPECTS the speedbar 1179 This gives visual indications of what is up. It EXPECTS the speedbar
1100 frame and window to be the currently active frame and window." 1180 frame and window to be the currently active frame and window."
1130 If a user requests help using \\[help-command] <Key> the temp BUFFER will be 1210 If a user requests help using \\[help-command] <Key> the temp BUFFER will be
1131 redirected into a window on the attached frame." 1211 redirected into a window on the attached frame."
1132 (if speedbar-attached-frame (select-frame speedbar-attached-frame)) 1212 (if speedbar-attached-frame (select-frame speedbar-attached-frame))
1133 (pop-to-buffer buffer nil) 1213 (pop-to-buffer buffer nil)
1134 (other-window -1) 1214 (other-window -1)
1135 (run-hooks 'temp-buffer-show-hook)) 1215 ;; Fix for using this hook: Bob Weiner
1136 1216 (cond ((fboundp 'run-hook-with-args)
1137 (defun speedbar-reconfigure-menubar () 1217 (run-hook-with-args 'temp-buffer-show-hook buffer))
1218 ((and (boundp 'temp-buffer-show-hook)
1219 (listp temp-buffer-show-hook))
1220 (mapcar (function (lambda (hook) (funcall hook buffer)))
1221 temp-buffer-show-hook))))
1222
1223 (defun speedbar-reconfigure-keymaps ()
1138 "Reconfigure the menu-bar in a speedbar frame. 1224 "Reconfigure the menu-bar in a speedbar frame.
1139 Different menu items are displayed depending on the current display mode 1225 Different menu items are displayed depending on the current display mode
1140 and the existence of packages." 1226 and the existence of packages."
1141 (let ((md (append speedbar-easymenu-definition-base 1227 (let ((md (append
1142 (if speedbar-shown-directories 1228 speedbar-easymenu-definition-base
1143 ;; file display mode version 1229 (if speedbar-shown-directories
1144 speedbar-easymenu-definition-special 1230 ;; file display mode version
1145 (save-excursion 1231 (speedbar-initial-menu)
1146 (select-frame speedbar-attached-frame) 1232 (save-excursion
1147 (if (local-variable-p 1233 (select-frame speedbar-attached-frame)
1148 'speedbar-easymenu-definition-special 1234 (if (local-variable-p
1149 (current-buffer)) 1235 'speedbar-easymenu-definition-special
1150 ;; If bound locally, we can use it 1236 (current-buffer))
1151 speedbar-easymenu-definition-special))) 1237 ;; If bound locally, we can use it
1152 ;; The trailer 1238 speedbar-easymenu-definition-special)))
1153 speedbar-easymenu-definition-trailer))) 1239 ;; Dynamic menu stuff
1154 (easy-menu-define speedbar-menu-map speedbar-key-map "Speedbar menu" md) 1240 '("-")
1155 (if speedbar-xemacsp 1241 (list (cons "Displays"
1156 (save-excursion 1242 (let ((displays nil)
1157 (set-buffer speedbar-buffer) 1243 (alist speedbar-initial-expansion-mode-alist))
1158 ;; For the benefit of button3 1244 (while alist
1159 (if (and (not (assoc "Speedbar" mode-popup-menu))) 1245 (setq displays
1160 (easy-menu-add md)) 1246 (cons
1161 (set-buffer-menubar (list md))) 1247 (vector
1162 (easy-menu-add md)))) 1248 (capitalize (car (car alist)))
1249 (list
1250 'speedbar-change-initial-expansion-list
1251 (car (car alist)))
1252 t)
1253 displays))
1254 (setq alist (cdr alist)))
1255 displays)))
1256 ;; The trailer
1257 speedbar-easymenu-definition-trailer))
1258 (localmap (save-excursion
1259 (let ((cf (selected-frame)))
1260 (prog2
1261 (select-frame speedbar-attached-frame)
1262 (if (local-variable-p
1263 'speedbar-special-mode-key-map
1264 (current-buffer))
1265 speedbar-special-mode-key-map)
1266 (select-frame cf))))))
1267 (save-excursion
1268 (set-buffer speedbar-buffer)
1269 (use-local-map (or localmap
1270 (speedbar-initial-keymap)
1271 ;; This creates a small keymap we can glom the
1272 ;; menu adjustments into.
1273 (speedbar-make-specialized-keymap)))
1274 (if (not speedbar-xemacsp)
1275 (easy-menu-define speedbar-menu-map (current-local-map)
1276 "Speedbar menu" md)
1277 (if (and (not (assoc "Speedbar" mode-popup-menu)))
1278 (easy-menu-add md (current-local-map)))
1279 (set-buffer-menubar (list md))))))
1163 1280
1164 1281
1165 ;;; User Input stuff 1282 ;;; User Input stuff
1166 ;; 1283 ;;
1167 1284
1193 (select-frame speedbar-attached-frame) 1310 (select-frame speedbar-attached-frame)
1194 (customize-group 'speedbar) 1311 (customize-group 'speedbar)
1195 (select-frame sf)) 1312 (select-frame sf))
1196 (speedbar-maybee-jump-to-attached-frame)) 1313 (speedbar-maybee-jump-to-attached-frame))
1197 1314
1315 (defun speedbar-track-mouse (event)
1316 "For motion EVENT, display info about the current line."
1317 (interactive "e")
1318 (if (not speedbar-track-mouse-flag)
1319 nil
1320 (save-excursion
1321 (let ((char (nth 1 (car (cdr event)))))
1322 (if (not (numberp char))
1323 (message nil)
1324 (goto-char char)
1325 ;; (message "%S" event)
1326 (speedbar-item-info)
1327 )))))
1328
1329 (defun speedbar-track-mouse-xemacs (event)
1330 "For motion EVENT, display info about the current line."
1331 (if (functionp (default-value 'mouse-motion-handler))
1332 (funcall (default-value 'mouse-motion-handler) event))
1333 (if speedbar-track-mouse-flag
1334 (save-excursion
1335 (save-window-excursion
1336 (condition-case ()
1337 (progn (mouse-set-point event)
1338 ;; Prevent focus-related bugs.
1339 (if (eq major-mode 'speedbar-mode)
1340 (speedbar-item-info)))
1341 (error nil))))))
1342
1198 ;; In XEmacs, we make popup menus work on the item over mouse (as 1343 ;; In XEmacs, we make popup menus work on the item over mouse (as
1199 ;; opposed to where the point happens to be.) We attain this by 1344 ;; opposed to where the point happens to be.) We attain this by
1200 ;; temporarily moving the point to that place. 1345 ;; temporarily moving the point to that place.
1201 ;; Hrvoje Niksic <hniksic@srce.hr> 1346 ;; Hrvoje Niksic <hniksic@srce.hr>
1202 (defun speedbar-xemacs-popup-kludge (event) 1347 (defun speedbar-xemacs-popup-kludge (event)
1203 "Pop up a menu related to the clicked on item. 1348 "Pop up a menu related to the clicked on item.
1204 Must be bound to EVENT." 1349 Must be bound to EVENT."
1205 (interactive "e") 1350 (interactive "e")
1351 (select-frame speedbar-frame)
1206 (save-excursion 1352 (save-excursion
1207 (goto-char (event-closest-point event)) 1353 (goto-char (event-closest-point event))
1208 (beginning-of-line) 1354 (beginning-of-line)
1209 (forward-char (min 5 (- (save-excursion (end-of-line) (point)) 1355 (forward-char (min 5 (- (save-excursion (end-of-line) (point))
1210 (save-excursion (beginning-of-line) (point))))) 1356 (save-excursion (beginning-of-line) (point)))))
1239 (defun speedbar-prev (arg) 1385 (defun speedbar-prev (arg)
1240 "Move to the previous ARGth line in a speedbar buffer." 1386 "Move to the previous ARGth line in a speedbar buffer."
1241 (interactive "p") 1387 (interactive "p")
1242 (speedbar-next (if arg (- arg) -1))) 1388 (speedbar-next (if arg (- arg) -1)))
1243 1389
1390 (defun speedbar-restricted-move (arg)
1391 "Move to the next ARGth line in a speedbar buffer at the same depth.
1392 This means that movement is restricted to a subnode, and that siblings
1393 of intermediate nodes are skipped."
1394 (if (not (numberp arg)) (signal 'wrong-type-argument (list arg 'numberp)))
1395 ;; First find the extent for which we are allowed to move.
1396 (let ((depth (save-excursion (beginning-of-line)
1397 (if (looking-at "[0-9]+:")
1398 (string-to-int (match-string 0))
1399 0)))
1400 (crement (if (< arg 0) 1 -1)) ; decrement or increment
1401 (lastmatch (point)))
1402 (while (/= arg 0)
1403 (forward-line (- crement))
1404 (let ((subdepth (save-excursion (beginning-of-line)
1405 (if (looking-at "[0-9]+:")
1406 (string-to-int (match-string 0))
1407 0))))
1408 (cond ((or (< subdepth depth)
1409 (progn (end-of-line) (eobp))
1410 (progn (beginning-of-line) (bobp)))
1411 ;; We have reached the end of this block.
1412 (goto-char lastmatch)
1413 (setq arg 0)
1414 (error "End of sub-list"))
1415 ((= subdepth depth)
1416 (setq lastmatch (point)
1417 arg (+ arg crement))))))
1418 (speedbar-position-cursor-on-line)))
1419
1420 (defun speedbar-restricted-next (arg)
1421 "Move to the next ARGth line in a speedbar buffer at the same depth.
1422 This means that movement is restricted to a subnode, and that siblings
1423 of intermediate nodes are skipped."
1424 (interactive "p")
1425 (speedbar-restricted-move (or arg 1))
1426 (speedbar-item-info))
1427
1428
1429 (defun speedbar-restricted-prev (arg)
1430 "Move to the previous ARGth line in a speedbar buffer at the same depth.
1431 This means that movement is restricted to a subnode, and that siblings
1432 of intermediate nodes are skipped."
1433 (interactive "p")
1434 (speedbar-restricted-move (if arg (- arg) -1))
1435 (speedbar-item-info))
1436
1437 (defun speedbar-navigate-list (arg)
1438 "Move across ARG groups of similarly typed items in speedbar.
1439 Stop on the first line of the next type of item, or on the last or first item
1440 if we reach a buffer boundary."
1441 (interactive "p")
1442 (beginning-of-line)
1443 (if (looking-at "[0-9]+: *[[<{][-+?][]>}] ")
1444 (let ((str (regexp-quote (match-string 0))))
1445 (while (looking-at str)
1446 (speedbar-restricted-move arg)
1447 (beginning-of-line))))
1448 (speedbar-position-cursor-on-line))
1449
1450 (defun speedbar-forward-list ()
1451 "Move forward over the current list.
1452 A LIST in speedbar is a group of similarly typed items, such as directories,
1453 files, or the directory button."
1454 (interactive)
1455 (speedbar-navigate-list 1)
1456 (speedbar-item-info))
1457
1458 (defun speedbar-backward-list ()
1459 "Move backward over the current list.
1460 A LIST in speedbar is a group of similarly typed items, such as directories,
1461 files, or the directory button."
1462 (interactive)
1463 (speedbar-navigate-list -1)
1464 (speedbar-item-info))
1465
1244 (defun speedbar-scroll-up (&optional arg) 1466 (defun speedbar-scroll-up (&optional arg)
1245 "Page down one screen-full of the speedbar, or ARG lines." 1467 "Page down one screen-full of the speedbar, or ARG lines."
1246 (interactive "P") 1468 (interactive "P")
1247 (scroll-up arg) 1469 (scroll-up arg)
1248 (speedbar-position-cursor-on-line)) 1470 (speedbar-position-cursor-on-line))
1272 (if (<= 1 speedbar-verbosity-level) (message "Refreshing speedbar...")) 1494 (if (<= 1 speedbar-verbosity-level) (message "Refreshing speedbar..."))
1273 (speedbar-update-contents) 1495 (speedbar-update-contents)
1274 (speedbar-stealthy-updates) 1496 (speedbar-stealthy-updates)
1275 ;; Reset the timer in case it got really hosed for some reason... 1497 ;; Reset the timer in case it got really hosed for some reason...
1276 (speedbar-set-timer speedbar-update-speed) 1498 (speedbar-set-timer speedbar-update-speed)
1277 (if (<= 1 speedbar-verbosity-level) (message "Refreshing speedbar...done"))) 1499 (if (<= 1 speedbar-verbosity-level)
1500 (progn
1501 (message "Refreshing speedbar...done")
1502 (sit-for 0)
1503 (message nil))))
1278 1504
1279 (defun speedbar-item-load () 1505 (defun speedbar-item-load ()
1280 "Load the item under the cursor or mouse if it is a lisp file." 1506 "Load the item under the cursor or mouse if it is a Lisp file."
1281 (interactive) 1507 (interactive)
1282 (let ((f (speedbar-line-file))) 1508 (let ((f (speedbar-line-file)))
1283 (if (and (file-exists-p f) (string-match "\\.el\\'" f)) 1509 (if (and (file-exists-p f) (string-match "\\.el\\'" f))
1284 (if (and (file-exists-p (concat f "c")) 1510 (if (and (file-exists-p (concat f "c"))
1285 (y-or-n-p (format "Load %sc? " f))) 1511 (y-or-n-p (format "Load %sc? " f)))
1286 ;; If the compiled version exists, load that instead... 1512 ;; If the compiled version exists, load that instead...
1287 (load-file (concat f "c")) 1513 (load-file (concat f "c"))
1288 (load-file f)) 1514 (load-file f))
1289 (error "Not a loadable file...")))) 1515 (error "Not a loadable file"))))
1290 1516
1291 (defun speedbar-item-byte-compile () 1517 (defun speedbar-item-byte-compile ()
1292 "Byte compile the item under the cursor or mouse if it is a lisp file." 1518 "Byte compile the item under the cursor or mouse if it is a Lisp file."
1293 (interactive) 1519 (interactive)
1294 (let ((f (speedbar-line-file)) 1520 (let ((f (speedbar-line-file))
1295 (sf (selected-frame))) 1521 (sf (selected-frame)))
1296 (if (and (file-exists-p f) (string-match "\\.el\\'" f)) 1522 (if (and (file-exists-p f) (string-match "\\.el\\'" f))
1297 (progn 1523 (progn
1298 (select-frame speedbar-attached-frame) 1524 (select-frame speedbar-attached-frame)
1299 (byte-compile-file f nil) 1525 (byte-compile-file f nil)
1300 (select-frame sf))) 1526 (select-frame sf)
1527 (speedbar-reset-scanners)))
1301 )) 1528 ))
1302 1529
1303 (defun speedbar-mouse-item-info (event) 1530 (defun speedbar-mouse-item-info (event)
1304 "Provide information about what the user clicked on. 1531 "Provide information about what the user clicked on.
1305 This should be bound to a mouse EVENT." 1532 This should be bound to a mouse EVENT."
1306 (interactive "e") 1533 (interactive "e")
1307 (mouse-set-point event) 1534 (mouse-set-point event)
1308 (speedbar-item-info)) 1535 (speedbar-item-info))
1309 1536
1537 (defun speedbar-generic-item-info ()
1538 "Attempt to derive, and then display information about thils line item.
1539 File style information is displayed with `speedbar-item-info'."
1540 (save-excursion
1541 (beginning-of-line)
1542 ;; Skip invisible number info.
1543 (if (looking-at "\\([0-9]+\\):") (goto-char (match-end 0)))
1544 ;; Skip items in "folder" type text characters.
1545 (if (looking-at "\\s-*[[<({].[]>)}] ") (goto-char (match-end 0)))
1546 ;; Get the text
1547 (message "Text: %s" (buffer-substring-no-properties
1548 (point) (progn (end-of-line) (point))))))
1549
1310 (defun speedbar-item-info () 1550 (defun speedbar-item-info ()
1311 "Display info in the mini-buffer about the button the mouse is over." 1551 "Display info in the mini-buffer about the button the mouse is over."
1312 (interactive) 1552 (interactive)
1313 (if (not speedbar-shown-directories) 1553 (if (not speedbar-shown-directories)
1314 nil 1554 (speedbar-generic-item-info)
1315 (let* ((item (speedbar-line-file)) 1555 (let* ((item (speedbar-line-file))
1316 (attr (if item (file-attributes item) nil))) 1556 (attr (if item (file-attributes item) nil)))
1317 (if item (message "%s %d %s" (nth 8 attr) (nth 7 attr) item) 1557 (if (and item attr) (message "%s %-6d %s" (nth 8 attr) (nth 7 attr) item)
1318 (save-excursion 1558 (save-excursion
1319 (beginning-of-line) 1559 (beginning-of-line)
1320 (looking-at "\\([0-9]+\\):") 1560 (if (not (looking-at "\\([0-9]+\\):"))
1321 (setq item (speedbar-line-path (string-to-int (match-string 1)))) 1561 (speedbar-generic-item-info)
1322 (if (re-search-forward "> \\([^ ]+\\)$" 1562 (setq item (speedbar-line-path (string-to-int (match-string 1))))
1323 (save-excursion(end-of-line)(point)) t) 1563 (if (re-search-forward "> \\([^ ]+\\)$"
1324 (progn 1564 (save-excursion(end-of-line)(point)) t)
1325 (setq attr (get-text-property (match-beginning 1) 1565 (progn
1326 'speedbar-token)) 1566 (setq attr (get-text-property (match-beginning 1)
1327 (message "Tag %s in %s at position %s" 1567 'speedbar-token))
1328 (match-string 1) item (if attr attr 0))) 1568 (message "Tag: %s in %s @ %s"
1329 (message "No special info for this line."))) 1569 (match-string 1) item
1330 )))) 1570 (if attr
1571 (if (markerp attr) (marker-position attr) attr)
1572 0)))
1573 (if (re-search-forward "{[+-]} \\([^\n]+\\)$"
1574 (save-excursion(end-of-line)(point)) t)
1575 (message "Group of tags \"%s\"" (match-string 1))
1576 (speedbar-generic-item-info)))))))))
1331 1577
1332 (defun speedbar-item-copy () 1578 (defun speedbar-item-copy ()
1333 "Copy the item under the cursor. 1579 "Copy the item under the cursor.
1334 Files can be copied to new names or places." 1580 Files can be copied to new names or places."
1335 (interactive) 1581 (interactive)
1336 (let ((f (speedbar-line-file))) 1582 (let ((f (speedbar-line-file)))
1337 (if (not f) (error "Not a file.")) 1583 (if (not f) (error "Not a file"))
1338 (if (file-directory-p f) 1584 (if (file-directory-p f)
1339 (error "Cannot copy directory.") 1585 (error "Cannot copy directory")
1340 (let* ((rt (read-file-name (format "Copy %s to: " 1586 (let* ((rt (read-file-name (format "Copy %s to: "
1341 (file-name-nondirectory f)) 1587 (file-name-nondirectory f))
1342 (file-name-directory f))) 1588 (file-name-directory f)))
1343 (refresh (member (expand-file-name (file-name-directory rt)) 1589 (refresh (member (expand-file-name (file-name-directory rt))
1344 speedbar-shown-directories))) 1590 speedbar-shown-directories)))
1385 (if refresh 1631 (if refresh
1386 (progn 1632 (progn
1387 (speedbar-refresh) 1633 (speedbar-refresh)
1388 (speedbar-goto-this-file rt) 1634 (speedbar-goto-this-file rt)
1389 ))))) 1635 )))))
1390 (error "Not a file.")))) 1636 (error "Not a file"))))
1391 1637
1392 (defun speedbar-item-delete () 1638 (defun speedbar-item-delete ()
1393 "Delete the item under the cursor. Files are removed from disk." 1639 "Delete the item under the cursor. Files are removed from disk."
1394 (interactive) 1640 (interactive)
1395 (let ((f (speedbar-line-file))) 1641 (let ((f (speedbar-line-file)))
1396 (if (not f) (error "Not a file.")) 1642 (if (not f) (error "Not a file"))
1397 (if (y-or-n-p (format "Delete %s? " f)) 1643 (if (y-or-n-p (format "Delete %s? " f))
1398 (progn 1644 (progn
1399 (if (file-directory-p f) 1645 (if (file-directory-p f)
1400 (delete-directory f) 1646 (delete-directory f)
1401 (delete-file f)) 1647 (delete-file f))
1403 (let ((p (point))) 1649 (let ((p (point)))
1404 (speedbar-refresh) 1650 (speedbar-refresh)
1405 (goto-char p)) 1651 (goto-char p))
1406 )) 1652 ))
1407 )) 1653 ))
1654
1655 (defun speedbar-item-object-delete ()
1656 "Delete the object associated from the item under the cursor.
1657 The file is removed from disk. The object is determined from the
1658 variable `speedbar-obj-alist'."
1659 (interactive)
1660 (let* ((f (speedbar-line-file))
1661 (obj nil)
1662 (oa speedbar-obj-alist))
1663 (if (not f) (error "Not a file"))
1664 (while (and oa (not (string-match (car (car oa)) f)))
1665 (setq oa (cdr oa)))
1666 (setq obj (concat (file-name-sans-extension f) (cdr (car oa))))
1667 (if (and oa (file-exists-p obj)
1668 (y-or-n-p (format "Delete %s? " obj)))
1669 (progn
1670 (delete-file obj)
1671 (speedbar-reset-scanners)))))
1408 1672
1409 (defun speedbar-enable-update () 1673 (defun speedbar-enable-update ()
1410 "Enable automatic updating in speedbar via timers." 1674 "Enable automatic updating in speedbar via timers."
1411 (interactive) 1675 (interactive)
1412 (setq speedbar-update-flag t) 1676 (setq speedbar-update-flag t)
1499 '(toggle-read-only -1) 1763 '(toggle-read-only -1)
1500 (cons 'progn forms))) 1764 (cons 'progn forms)))
1501 (put 'speedbar-with-writable 'lisp-indent-function 0) 1765 (put 'speedbar-with-writable 'lisp-indent-function 0)
1502 1766
1503 (defun speedbar-select-window (buffer) 1767 (defun speedbar-select-window (buffer)
1504 "Select a window in which BUFFER is show. 1768 "Select a window in which BUFFER is shown.
1505 If it is not shown, force it to appear in the default window." 1769 If it is not shown, force it to appear in the default window."
1506 (let ((win (get-buffer-window buffer speedbar-attached-frame))) 1770 (let ((win (get-buffer-window buffer speedbar-attached-frame)))
1507 (if win 1771 (if win
1508 (select-window win) 1772 (select-window win)
1509 (show-buffer (selected-window) buffer)))) 1773 (set-window-buffer (selected-window) buffer))))
1510 1774
1511 (defmacro speedbar-with-attached-buffer (&rest forms) 1775 (defmacro speedbar-with-attached-buffer (&rest forms)
1512 "Execute FORMS in the attached frame's special buffer. 1776 "Execute FORMS in the attached frame's special buffer.
1513 Optionally select that frame if necessary." 1777 Optionally select that frame if necessary."
1514 ;; Reset the timer with a new timeout when cliking a file 1778 ;; Reset the timer with a new timeout when cliking a file
1548 (put-text-property start (point) 'mouse-face nil))) 1812 (put-text-property start (point) 'mouse-face nil)))
1549 1813
1550 (defun speedbar-make-button (start end face mouse function &optional token) 1814 (defun speedbar-make-button (start end face mouse function &optional token)
1551 "Create a button from START to END, with FACE as the display face. 1815 "Create a button from START to END, with FACE as the display face.
1552 MOUSE is the mouse face. When this button is clicked on FUNCTION 1816 MOUSE is the mouse face. When this button is clicked on FUNCTION
1553 will be run with the TOKEN parameter (any lisp object)" 1817 will be run with the TOKEN parameter (any Lisp object)"
1554 (put-text-property start end 'face face) 1818 (put-text-property start end 'face face)
1555 (put-text-property start end 'mouse-face mouse) 1819 (put-text-property start end 'mouse-face mouse)
1556 (put-text-property start end 'invisible nil) 1820 (put-text-property start end 'invisible nil)
1557 (if function (put-text-property start end 'speedbar-function function)) 1821 (if function (put-text-property start end 'speedbar-function function))
1558 (if token (put-text-property start end 'speedbar-token token)) 1822 (if token (put-text-property start end 'speedbar-token token))
1559 ) 1823 )
1824
1825 ;;; Initial Expansion list management
1826 ;;
1827 (defun speedbar-initial-expansion-list ()
1828 "Return the current default expansion list.
1829 This is based on `speedbar-initial-expansion-list-name' referencing
1830 `speedbar-initial-expansion-mode-alist'."
1831 ;; cdr1 - name, cdr2 - menu
1832 (cdr (cdr (cdr (assoc speedbar-initial-expansion-list-name
1833 speedbar-initial-expansion-mode-alist)))))
1834
1835 (defun speedbar-initial-menu ()
1836 "Return the current default menu data.
1837 This is based on `speedbar-initial-expansion-list-name' referencing
1838 `speedbar-initial-expansion-mode-alist'."
1839 (symbol-value
1840 (car (cdr (assoc speedbar-initial-expansion-list-name
1841 speedbar-initial-expansion-mode-alist)))))
1842
1843 (defun speedbar-initial-keymap ()
1844 "Return the current default menu data.
1845 This is based on `speedbar-initial-expansion-list-name' referencing
1846 `speedbar-initial-expansion-mode-alist'."
1847 (symbol-value
1848 (car (cdr (cdr (assoc speedbar-initial-expansion-list-name
1849 speedbar-initial-expansion-mode-alist))))))
1850
1851 (defun speedbar-initial-stealthy-functions ()
1852 "Return a list of functions to call stealthily.
1853 This is based on `speedbar-initial-expansion-list-name' referencing
1854 `speedbar-stealthy-function-list'."
1855 (cdr (assoc speedbar-initial-expansion-list-name
1856 speedbar-stealthy-function-list)))
1857
1858 (defun speedbar-add-expansion-list (new-list)
1859 "Add NEW-LIST to the list of expansion lists."
1860 (add-to-list 'speedbar-initial-expansion-mode-alist new-list))
1861
1862 (defun speedbar-change-initial-expansion-list (new-default)
1863 "Change speedbar's default expansion list to NEW-DEFAULT."
1864 (interactive
1865 (list
1866 (completing-read (format "Speedbar Mode (default %s): "
1867 speedbar-previously-used-expansion-list-name)
1868 speedbar-initial-expansion-mode-alist
1869 nil t "" nil
1870 speedbar-previously-used-expansion-list-name)))
1871 (setq speedbar-previously-used-expansion-list-name
1872 speedbar-initial-expansion-list-name
1873 speedbar-initial-expansion-list-name new-default)
1874 (speedbar-refresh)
1875 (speedbar-reconfigure-keymaps))
1876
1877
1878 ;;; Special speedbar display management
1879 ;;
1880 (defun speedbar-maybe-add-localized-support (buffer)
1881 "Quick check function called on BUFFERs by the speedbar timer function.
1882 Maintains the value of local variables which control speedbars use
1883 of the special mode functions."
1884 (or speedbar-special-mode-expansion-list
1885 (speedbar-add-localized-speedbar-support buffer)))
1886
1887 (defun speedbar-add-localized-speedbar-support (buffer)
1888 "Add localized speedbar support to BUFFER's mode if it is available."
1889 (interactive "bBuffer: ")
1890 (if (stringp buffer) (setq buffer (get-buffer buffer)))
1891 (if (not (buffer-live-p buffer))
1892 nil
1893 (save-excursion
1894 (set-buffer buffer)
1895 (save-match-data
1896 (let ((ms (symbol-name major-mode)) v)
1897 (if (not (string-match "-mode$" ms))
1898 nil ;; do nothing to broken mode
1899 (setq ms (substring ms 0 (match-beginning 0)))
1900 (setq v (intern-soft (concat ms "-speedbar-buttons")))
1901 (make-local-variable 'speedbar-special-mode-expansion-list)
1902 (if (not v)
1903 (setq speedbar-special-mode-expansion-list t)
1904 ;; If it is autoloaded, we need to load it now so that
1905 ;; we have access to the varialbe -speedbar-menu-items.
1906 ;; Is this XEmacs safe?
1907 (let ((sf (symbol-function v)))
1908 (if (and (listp sf) (eq (car sf) 'autoload))
1909 (load-library (car (cdr sf)))))
1910 (setq speedbar-special-mode-expansion-list (list v))
1911 (setq v (intern-soft (concat ms "-speedbar-key-map")))
1912 (if (not v)
1913 nil ;; don't add special keymap
1914 (make-local-variable 'speedbar-special-mode-key-map)
1915 (setq speedbar-special-mode-key-map
1916 (symbol-value v)))
1917 (setq v (intern-soft (concat ms "-speedbar-menu-items")))
1918 (if (not v)
1919 nil ;; don't add special menus
1920 (make-local-variable 'speedbar-easymenu-definition-special)
1921 (setq speedbar-easymenu-definition-special
1922 (symbol-value v)))
1923 )))))))
1924
1925 (defun speedbar-remove-localized-speedbar-support (buffer)
1926 "Remove any traces that BUFFER supports speedbar in a specialized way."
1927 (save-excursion
1928 (set-buffer buffer)
1929 (kill-local-variable 'speedbar-special-mode-expansion-list)
1930 (kill-local-variable 'speedbar-special-mode-key-map)
1931 (kill-local-variable 'speedbar-easymenu-definition-special)))
1560 1932
1561 ;;; File button management 1933 ;;; File button management
1562 ;; 1934 ;;
1563 (defun speedbar-file-lists (directory) 1935 (defun speedbar-file-lists (directory)
1564 "Create file lists for DIRECTORY. 1936 "Create file lists for DIRECTORY.
1576 (let ((default-directory directory) 1948 (let ((default-directory directory)
1577 (dir (directory-files directory nil)) 1949 (dir (directory-files directory nil))
1578 (dirs nil) 1950 (dirs nil)
1579 (files nil)) 1951 (files nil))
1580 (while dir 1952 (while dir
1581 (if (not (string-match speedbar-file-unshown-regexp (car dir))) 1953 (if (not
1954 (or (string-match speedbar-file-unshown-regexp (car dir))
1955 (string-match speedbar-directory-unshown-regexp (car dir))))
1582 (if (file-directory-p (car dir)) 1956 (if (file-directory-p (car dir))
1583 (setq dirs (cons (car dir) dirs)) 1957 (setq dirs (cons (car dir) dirs))
1584 (setq files (cons (car dir) files)))) 1958 (setq files (cons (car dir) files))))
1585 (setq dir (cdr dir))) 1959 (setq dir (cdr dir)))
1586 (let ((nl (cons (nreverse dirs) (list (nreverse files))))) 1960 (let ((nl (cons (nreverse dirs) (list (nreverse files)))))
1694 (end (progn (insert buttxt) (point))) 2068 (end (progn (insert buttxt) (point)))
1695 (bf (if exp-button-type 'speedbar-button-face nil)) 2069 (bf (if exp-button-type 'speedbar-button-face nil))
1696 (mf (if exp-button-function 'speedbar-highlight-face nil)) 2070 (mf (if exp-button-function 'speedbar-highlight-face nil))
1697 ) 2071 )
1698 (speedbar-make-button start end bf mf exp-button-function exp-button-data) 2072 (speedbar-make-button start end bf mf exp-button-function exp-button-data)
2073 (if speedbar-hide-button-brackets-flag
2074 (progn
2075 (put-text-property start (1+ start) 'invisible t)
2076 (put-text-property end (1- end) 'invisible t)))
1699 ) 2077 )
1700 (insert-char ? 1 nil) 2078 (insert-char ? 1 nil)
1701 (put-text-property (1- (point)) (point) 'invisible nil) 2079 (put-text-property (1- (point)) (point) 'invisible nil)
1702 (let ((start (point)) 2080 (let ((start (point))
1703 (end (progn (insert tag-button) (point)))) 2081 (end (progn (insert tag-button) (point))))
1715 (if (re-search-forward ":\\s-*.\\([-+?]\\)" (save-excursion (end-of-line) 2093 (if (re-search-forward ":\\s-*.\\([-+?]\\)" (save-excursion (end-of-line)
1716 (point)) t) 2094 (point)) t)
1717 (speedbar-with-writable 2095 (speedbar-with-writable
1718 (goto-char (match-beginning 1)) 2096 (goto-char (match-beginning 1))
1719 (delete-char 1) 2097 (delete-char 1)
1720 (insert-char char 1 t))))) 2098 (insert-char char 1 t)
2099 (put-text-property (point) (1- (point)) 'invisible nil)))))
1721 2100
1722 2101
1723 ;;; Build button lists 2102 ;;; Build button lists
1724 ;; 2103 ;;
1725 (defun speedbar-insert-files-at-point (files level) 2104 (defun speedbar-insert-files-at-point (files level)
1726 "Insert list of FILES starting at point, and indenting all files to LEVEL. 2105 "Insert list of FILES starting at point, and indenting all files to LEVEL.
1727 Tag expandable items with a +, otherwise a ?. Don't highlight ? as we 2106 Tag expandable items with a +, otherwise a ?. Don't highlight ? as we
1728 don't know how to manage them. The input parameter FILES is a cons 2107 don't know how to manage them. The input parameter FILES is a cons
1729 cell of the form ( 'DIRLIST . 'FILELIST )" 2108 cell of the form ( 'DIRLIST . 'FILELIST )"
1730 ;; Start inserting all the directories 2109 ;; Start inserting all the directories
1731 (let ((dirs (car files))) 2110 (let ((dirs (car files)))
1732 (while dirs 2111 (while dirs
1733 (speedbar-make-tag-line 'angle ?+ 'speedbar-dired (car dirs) 2112 (speedbar-make-tag-line 'angle ?+ 'speedbar-dired (car dirs)
1734 (car dirs) 'speedbar-dir-follow nil 2113 (car dirs) 'speedbar-dir-follow nil
1735 'speedbar-directory-face level) 2114 'speedbar-directory-face level)
1736 (setq dirs (cdr dirs)))) 2115 (setq dirs (cdr dirs))))
1737 (let ((lst (car (cdr files)))) 2116 (let ((lst (car (cdr files)))
2117 (case-fold-search t))
1738 (while lst 2118 (while lst
1739 (let* ((known (string-match speedbar-file-regexp (car lst))) 2119 (let* ((known (string-match speedbar-file-regexp (car lst)))
1740 (expchar (if known ?+ ??)) 2120 (expchar (if known ?+ ??))
1741 (fn (if known 'speedbar-tag-file nil))) 2121 (fn (if known 'speedbar-tag-file nil)))
1742 (if (or speedbar-show-unknown-files (/= expchar ??)) 2122 (if (or speedbar-show-unknown-files (/= expchar ??))
1768 (goto-char (match-end 0)) 2148 (goto-char (match-end 0))
1769 (speedbar-do-function-pointer))) 2149 (speedbar-do-function-pointer)))
1770 (setq sf (cdr sf))))) 2150 (setq sf (cdr sf)))))
1771 ))) 2151 )))
1772 2152
2153 (defun speedbar-apply-one-tag-hierarchy-method (lst method)
2154 "Adjust the tag hierarchy LST by METHOD."
2155 (cond
2156 ((eq method 'sort)
2157 (sort (copy-alist lst)
2158 (lambda (a b) (string< (car a) (car b)))))
2159 ((eq method 'prefix-group)
2160 (let ((newlst nil)
2161 (sublst nil)
2162 (work-list nil)
2163 (junk-list nil)
2164 (short-group-list nil)
2165 (short-start-name nil)
2166 (short-end-name nil)
2167 (num-shorts-grouped 0)
2168 (bins (make-vector 256 nil))
2169 (diff-idx 0))
2170 ;; Break out sub-lists
2171 (while lst
2172 (if (listp (cdr-safe (car-safe lst)))
2173 (setq newlst (cons (car lst) newlst))
2174 (setq sublst (cons (car lst) sublst)))
2175 (setq lst (cdr lst)))
2176 ;; Now, first find out how long our list is. Never let a
2177 ;; list get-shorter than our minimum.
2178 (if (<= (length sublst) speedbar-tag-split-minimum-length)
2179 (setq work-list (nreverse sublst))
2180 (setq diff-idx (length (try-completion "" sublst)))
2181 ;; Sort the whole list into bins.
2182 (while sublst
2183 (let ((e (car sublst))
2184 (s (car (car sublst))))
2185 (cond ((<= (length s) diff-idx)
2186 ;; 0 storage bin for shorty.
2187 (aset bins 0 (cons e (aref bins 0))))
2188 (t
2189 ;; stuff into a bin based on ascii value at diff
2190 (aset bins (aref s diff-idx)
2191 (cons e (aref bins (aref s diff-idx)))))))
2192 (setq sublst (cdr sublst)))
2193 ;; Go through all our bins Stick singles into our
2194 ;; junk-list, everything else as sublsts in work-list.
2195 ;; If two neighboring lists are both small, make a grouped
2196 ;; group combinding those two sub-lists.
2197 (setq diff-idx 0)
2198 (while (> 256 diff-idx)
2199 (let ((l (aref bins diff-idx)))
2200 (if l
2201 (let ((tmp (cons (try-completion "" l) l)))
2202 (if (or (> (length l) speedbar-tag-regroup-maximum-length)
2203 (> (+ (length l) (length short-group-list))
2204 speedbar-tag-split-minimum-length))
2205 (progn
2206 ;; We have reached a longer list, so we
2207 ;; must finish off a grouped group.
2208 (cond
2209 ((and short-group-list
2210 (= (length short-group-list)
2211 num-shorts-grouped))
2212 ;; All singles? Junk list
2213 (setq junk-list (append short-group-list
2214 junk-list)))
2215 ((= num-shorts-grouped 1)
2216 ;; Only one short group? Just stick it in
2217 ;; there by itself.
2218 (setq work-list
2219 (cons (cons (try-completion
2220 "" short-group-list)
2221 (nreverse short-group-list))
2222 work-list)))
2223 (short-group-list
2224 ;; Multiple groups to be named in a special
2225 ;; way by displaying the range over which we
2226 ;; have grouped them.
2227 (setq work-list
2228 (cons (cons (concat short-start-name
2229 " to "
2230 short-end-name)
2231 (nreverse short-group-list))
2232 work-list))))
2233 ;; Reset short group list information every time.
2234 (setq short-group-list nil
2235 short-start-name nil
2236 short-end-name nil
2237 num-shorts-grouped 0)))
2238 ;; Ok, now that we cleaned up the short-group-list,
2239 ;; we can deal with this new list, to decide if it
2240 ;; should go on one of these sub-lists or not.
2241 (if (< (length l) speedbar-tag-regroup-maximum-length)
2242 (setq short-group-list (append short-group-list l)
2243 num-shorts-grouped (1+ num-shorts-grouped)
2244 short-end-name (car tmp)
2245 short-start-name (if short-start-name
2246 short-start-name
2247 (car tmp)))
2248 (setq work-list (cons tmp work-list))))))
2249 (setq diff-idx (1+ diff-idx))))
2250 ;; Did we run out of things? Drop our new list onto the end.
2251 (cond
2252 ((and short-group-list (= (length short-group-list) num-shorts-grouped))
2253 ;; All singles? Junk list
2254 (setq junk-list (append short-group-list junk-list)))
2255 ((= num-shorts-grouped 1)
2256 ;; Only one short group? Just stick it in
2257 ;; there by itself.
2258 (setq work-list
2259 (cons (cons (try-completion "" short-group-list)
2260 (nreverse short-group-list))
2261 work-list)))
2262 (short-group-list
2263 ;; Multiple groups to be named in a special
2264 ;; way by displaying the range over which we
2265 ;; have grouped them.
2266 (setq work-list
2267 (cons (cons (concat short-start-name " to " short-end-name)
2268 (nreverse short-group-list))
2269 work-list))))
2270 ;; Now, stick our new list onto the end of
2271 (if work-list
2272 (if junk-list
2273 (append (nreverse newlst)
2274 (nreverse work-list)
2275 junk-list)
2276 (append (nreverse newlst)
2277 (nreverse work-list)))
2278 (append (nreverse newlst) junk-list))))
2279 ((eq method 'trim-words)
2280 (let ((newlst nil)
2281 (sublst nil)
2282 (trim-prefix nil)
2283 (trim-chars 0)
2284 (trimlst nil))
2285 (while lst
2286 (if (listp (cdr-safe (car-safe lst)))
2287 (setq newlst (cons (car lst) newlst))
2288 (setq sublst (cons (car lst) sublst)))
2289 (setq lst (cdr lst)))
2290 ;; Get the prefix to trim by. Make sure that we don't trim
2291 ;; off silly pieces, only complete understandable words.
2292 (setq trim-prefix (try-completion "" sublst))
2293 (if (or (= (length sublst) 1)
2294 (not trim-prefix)
2295 (not (string-match "\\(\\w+\\W+\\)+" trim-prefix)))
2296 (append (nreverse newlst) (nreverse sublst))
2297 (setq trim-prefix (substring trim-prefix (match-beginning 0)
2298 (match-end 0)))
2299 (setq trim-chars (length trim-prefix))
2300 (while sublst
2301 (setq trimlst (cons
2302 (cons (substring (car (car sublst)) trim-chars)
2303 (cdr (car sublst)))
2304 trimlst)
2305 sublst (cdr sublst)))
2306 ;; Put the lists together
2307 (append (nreverse newlst) trimlst))))
2308 ((eq method 'simple-group)
2309 (let ((newlst nil)
2310 (sublst nil))
2311 (while lst
2312 (if (listp (cdr-safe (car-safe lst)))
2313 (setq newlst (cons (car lst) newlst))
2314 (setq sublst (cons (car lst) sublst)))
2315 (setq lst (cdr lst)))
2316 (if (not newlst)
2317 (nreverse sublst)
2318 (setq newlst (cons (cons "Tags" (nreverse sublst)) newlst))
2319 (nreverse newlst))))
2320 (t lst)))
2321
2322 (defun speedbar-create-tag-hierarchy (lst)
2323 "Adjust the tag hierarchy in LST, and return it.
2324 This uses `speedbar-tag-hierarchy-method' to determine how to adjust
2325 the list. See it's value for details."
2326 (let ((methods speedbar-tag-hierarchy-method))
2327 (while methods
2328 (setq lst (speedbar-apply-one-tag-hierarchy-method lst (car methods))
2329 methods (cdr methods)))
2330 lst))
2331
1773 (defun speedbar-insert-generic-list (level lst expand-fun find-fun) 2332 (defun speedbar-insert-generic-list (level lst expand-fun find-fun)
1774 "At LEVEL, insert a generic multi-level alist LST. 2333 "At LEVEL, insert a generic multi-level alist LST.
1775 Associations with lists get {+} tags (to expand into more nodes) and 2334 Associations with lists get {+} tags (to expand into more nodes) and
1776 those with positions just get a > as the indicator. {+} buttons will 2335 those with positions just get a > as the indicator. {+} buttons will
1777 have the function EXPAND-FUN and the token is the CDR list. The token 2336 have the function EXPAND-FUN and the token is the CDR list. The token
1778 name will have the function FIND-FUN and not token." 2337 name will have the function FIND-FUN and not token."
1779 ;; Remove imenu rescan button 2338 ;; Remove imenu rescan button
1780 (if (string= (car (car lst)) "*Rescan*") 2339 (if (string= (car (car lst)) "*Rescan*")
1781 (setq lst (cdr lst))) 2340 (setq lst (cdr lst)))
2341 ;; Adjust the list.
2342 (setq lst (speedbar-create-tag-hierarchy lst))
1782 ;; insert the parts 2343 ;; insert the parts
1783 (while lst 2344 (while lst
1784 (cond ((null (car-safe lst)) nil) ;this would be a separator 2345 (cond ((null (car-safe lst)) nil) ;this would be a separator
1785 ((or (numberp (cdr-safe (car-safe lst))) 2346 ((or (numberp (cdr-safe (car-safe lst)))
1786 (markerp (cdr-safe (car-safe lst)))) 2347 (markerp (cdr-safe (car-safe lst))))
1803 (defun speedbar-update-contents () 2364 (defun speedbar-update-contents ()
1804 "Generically update the contents of the speedbar buffer." 2365 "Generically update the contents of the speedbar buffer."
1805 (interactive) 2366 (interactive)
1806 ;; Set the current special buffer 2367 ;; Set the current special buffer
1807 (setq speedbar-desired-buffer nil) 2368 (setq speedbar-desired-buffer nil)
2369 ;; Check for special modes
2370 (speedbar-maybe-add-localized-support (current-buffer))
2371 ;; Choose the correct method of doodling.
1808 (if (and speedbar-mode-specific-contents-flag 2372 (if (and speedbar-mode-specific-contents-flag
2373 (listp speedbar-special-mode-expansion-list)
1809 speedbar-special-mode-expansion-list 2374 speedbar-special-mode-expansion-list
1810 (local-variable-p 2375 (local-variable-p
1811 'speedbar-special-mode-expansion-list 2376 'speedbar-special-mode-expansion-list
1812 (current-buffer))) 2377 (current-buffer)))
1813 ;;(eq (get major-mode 'mode-class 'special))) 2378 ;;(eq (get major-mode 'mode-class 'special)))
1816 2381
1817 (defun speedbar-update-directory-contents () 2382 (defun speedbar-update-directory-contents ()
1818 "Update the contents of the speedbar buffer based on the current directory." 2383 "Update the contents of the speedbar buffer based on the current directory."
1819 (let ((cbd (expand-file-name default-directory)) 2384 (let ((cbd (expand-file-name default-directory))
1820 cbd-parent 2385 cbd-parent
1821 (funclst speedbar-initial-expansion-list) 2386 (funclst (speedbar-initial-expansion-list))
1822 (cache speedbar-full-text-cache) 2387 (cache speedbar-full-text-cache)
1823 ;; disable stealth during update 2388 ;; disable stealth during update
1824 (speedbar-stealthy-function-list nil) 2389 (speedbar-stealthy-function-list nil)
1825 (use-cache nil) 2390 (use-cache nil)
1826 (expand-local nil) 2391 (expand-local nil)
1830 (set-buffer speedbar-buffer) 2395 (set-buffer speedbar-buffer)
1831 ;; If we are updating contents to where we are, then this is 2396 ;; If we are updating contents to where we are, then this is
1832 ;; really a request to update existing contents, so we must be 2397 ;; really a request to update existing contents, so we must be
1833 ;; careful with our text cache! 2398 ;; careful with our text cache!
1834 (if (member cbd speedbar-shown-directories) 2399 (if (member cbd speedbar-shown-directories)
1835 (setq cache nil) 2400 (progn
2401 (setq cache nil)
2402 ;; If the current directory is not the last element in the dir
2403 ;; list, then we ALSO need to zap the list of expanded directories
2404 (if (/= (length (member cbd speedbar-shown-directories)) 1)
2405 (setq speedbar-shown-directories (list cbd))))
1836 2406
1837 ;; Build cbd-parent, and see if THAT is in the current shown 2407 ;; Build cbd-parent, and see if THAT is in the current shown
1838 ;; directories. First, go through pains to get the parent directory 2408 ;; directories. First, go through pains to get the parent directory
1839 (if (and speedbar-smart-directory-expand-flag 2409 (if (and speedbar-smart-directory-expand-flag
1840 (save-match-data 2410 (save-match-data
1841 (setq cbd-parent cbd) 2411 (setq cbd-parent cbd)
1842 (if (string-match "/$" cbd-parent) 2412 (if (string-match "/$" cbd-parent)
1843 (setq cbd-parent (substring cbd-parent 0 (match-beginning 0)))) 2413 (setq cbd-parent (substring cbd-parent 0
2414 (match-beginning 0))))
1844 (setq cbd-parent (file-name-directory cbd-parent))) 2415 (setq cbd-parent (file-name-directory cbd-parent)))
1845 (member cbd-parent speedbar-shown-directories)) 2416 (member cbd-parent speedbar-shown-directories))
1846 (setq expand-local t) 2417 (setq expand-local t)
1847 2418
1848 ;; If this directory is NOT in the current list of available 2419 ;; If this directory is NOT in the current list of available
1881 (while funclst 2452 (while funclst
1882 (setq default-directory cbd) 2453 (setq default-directory cbd)
1883 (funcall (car funclst) cbd 0) 2454 (funcall (car funclst) cbd 0)
1884 (setq funclst (cdr funclst)))))) 2455 (setq funclst (cdr funclst))))))
1885 (goto-char (point-min))))) 2456 (goto-char (point-min)))))
1886 (speedbar-reconfigure-menubar)) 2457 (speedbar-reconfigure-keymaps))
1887 2458
1888 (defun speedbar-update-special-contents () 2459 (defun speedbar-update-special-contents ()
1889 "Used the mode-specific variable to fill in the speedbar buffer. 2460 "Used the mode-specific variable to fill in the speedbar buffer.
1890 This should only be used by modes classified as special." 2461 This should only be used by modes classified as special."
1891 (let ((funclst speedbar-special-mode-expansion-list) 2462 (let ((funclst speedbar-special-mode-expansion-list)
1908 ;; We do not erase the buffer because these functions may 2479 ;; We do not erase the buffer because these functions may
1909 ;; decide NOT to update themselves. 2480 ;; decide NOT to update themselves.
1910 (funcall (car funclst) specialbuff) 2481 (funcall (car funclst) specialbuff)
1911 (setq funclst (cdr funclst)))) 2482 (setq funclst (cdr funclst))))
1912 (goto-char (point-min)))) 2483 (goto-char (point-min))))
1913 (speedbar-reconfigure-menubar)) 2484 (speedbar-reconfigure-keymaps))
1914 2485
1915 (defun speedbar-timer-fn () 2486 (defun speedbar-timer-fn ()
1916 "Run whenever emacs is idle to update the speedbar item." 2487 "Run whenever Emacs is idle to update the speedbar item."
1917 (if (not (and (frame-live-p speedbar-frame) 2488 (if (not (and (frame-live-p speedbar-frame)
1918 (frame-live-p speedbar-attached-frame))) 2489 (frame-live-p speedbar-attached-frame)))
1919 (speedbar-set-timer nil) 2490 (speedbar-set-timer nil)
1920 ;; Save all the match data so that we don't mess up executing fns 2491 ;; Save all the match data so that we don't mess up executing fns
1921 (save-match-data 2492 (save-match-data
1925 (select-frame speedbar-attached-frame) 2496 (select-frame speedbar-attached-frame)
1926 ;; make sure we at least choose a window to 2497 ;; make sure we at least choose a window to
1927 ;; get a good directory from 2498 ;; get a good directory from
1928 (if (string-match "\\*Minibuf-[0-9]+\\*" (buffer-name)) 2499 (if (string-match "\\*Minibuf-[0-9]+\\*" (buffer-name))
1929 (other-window 1)) 2500 (other-window 1))
2501 ;; Check for special modes
2502 (speedbar-maybe-add-localized-support (current-buffer))
1930 ;; Update for special mode all the time! 2503 ;; Update for special mode all the time!
1931 (if (and speedbar-mode-specific-contents-flag 2504 (if (and speedbar-mode-specific-contents-flag
2505 (listp speedbar-special-mode-expansion-list)
1932 speedbar-special-mode-expansion-list 2506 speedbar-special-mode-expansion-list
1933 (local-variable-p 2507 (local-variable-p
1934 'speedbar-special-mode-expansion-list 2508 'speedbar-special-mode-expansion-list
1935 (current-buffer))) 2509 (current-buffer)))
1936 ;;(eq (get major-mode 'mode-class 'special))) 2510 ;;(eq (get major-mode 'mode-class 'special)))
1960 (if (<= 1 speedbar-verbosity-level) 2534 (if (<= 1 speedbar-verbosity-level)
1961 (message "Updating speedbar to: %s...done" 2535 (message "Updating speedbar to: %s...done"
1962 default-directory)))) 2536 default-directory))))
1963 (select-frame af)) 2537 (select-frame af))
1964 ;; Now run stealthy updates of time-consuming items 2538 ;; Now run stealthy updates of time-consuming items
1965 (speedbar-stealthy-updates))))) 2539 (speedbar-stealthy-updates)))
2540 ;; Now run the mouse tracking system
2541 (speedbar-show-info-under-mouse)))
1966 (run-hooks 'speedbar-timer-hook)) 2542 (run-hooks 'speedbar-timer-hook))
1967 2543
1968 2544
1969 ;;; Stealthy activities 2545 ;;; Stealthy activities
1970 ;; 2546 ;;
2547 (defvar speedbar-stealthy-update-recurse nil
2548 "Recursion avoidance variable for stealthy update.")
2549
1971 (defun speedbar-stealthy-updates () 2550 (defun speedbar-stealthy-updates ()
1972 "For a given speedbar, run all items in the stealthy function list. 2551 "For a given speedbar, run all items in the stealthy function list.
1973 Each item returns t if it completes successfully, or nil if 2552 Each item returns t if it completes successfully, or nil if
1974 interrupted by the user." 2553 interrupted by the user."
1975 (let ((l speedbar-stealthy-function-list)) 2554 (if (not speedbar-stealthy-update-recurse)
1976 (unwind-protect 2555 (let ((l (speedbar-initial-stealthy-functions))
1977 (while (and l (funcall (car l))) 2556 (speedbar-stealthy-update-recurse t))
1978 (sit-for 0) 2557 (unwind-protect
1979 (setq l (cdr l))) 2558 (while (and l (funcall (car l)))
1980 ;(message "Exit with %S" (car l)) 2559 ;(sit-for 0)
1981 ))) 2560 (setq l (cdr l)))
2561 ;;(message "Exit with %S" (car l))
2562 ))))
1982 2563
1983 (defun speedbar-reset-scanners () 2564 (defun speedbar-reset-scanners ()
1984 "Reset any variables used by functions in the stealthy list as state. 2565 "Reset any variables used by functions in the stealthy list as state.
1985 If new functions are added, their state needs to be updated here." 2566 If new functions are added, their state needs to be updated here."
1986 (setq speedbar-vc-to-do-point t) 2567 (setq speedbar-vc-to-do-point t
2568 speedbar-obj-to-do-point t)
1987 (run-hooks 'speedbar-scanner-reset-hook) 2569 (run-hooks 'speedbar-scanner-reset-hook)
1988 ) 2570 )
1989 2571
1990 (defun speedbar-clear-current-file () 2572 (defun speedbar-clear-current-file ()
1991 "Locate the file thought to be current, and remove its highlighting." 2573 "Locate the file thought to be current, and remove its highlighting."
1996 (goto-char (point-min)) 2578 (goto-char (point-min))
1997 (if (and 2579 (if (and
1998 speedbar-last-selected-file 2580 speedbar-last-selected-file
1999 (re-search-forward 2581 (re-search-forward
2000 (concat " \\(" (regexp-quote speedbar-last-selected-file) 2582 (concat " \\(" (regexp-quote speedbar-last-selected-file)
2001 "\\)\\(" (regexp-quote speedbar-vc-indicator) 2583 "\\)\\(" speedbar-indicator-regex "\\)?\n")
2002 "\\)?\n")
2003 nil t)) 2584 nil t))
2004 (put-text-property (match-beginning 1) 2585 (put-text-property (match-beginning 1)
2005 (match-end 1) 2586 (match-end 1)
2006 'face 2587 'face
2007 'speedbar-file-face)))))) 2588 'speedbar-file-face))))))
2019 nil))) 2600 nil)))
2020 (select-frame lastf) 2601 (select-frame lastf)
2021 rf))) 2602 rf)))
2022 (newcf (if newcfd (file-name-nondirectory newcfd))) 2603 (newcf (if newcfd (file-name-nondirectory newcfd)))
2023 (lastb (current-buffer)) 2604 (lastb (current-buffer))
2024 (sucf-recursive (boundp 'sucf-recursive))) 2605 (sucf-recursive (boundp 'sucf-recursive))
2606 (case-fold-search t))
2025 (if (and newcf 2607 (if (and newcf
2026 ;; check here, that way we won't refresh to newcf until 2608 ;; check here, that way we won't refresh to newcf until
2027 ;; its been written, thus saving ourselves some time 2609 ;; its been written, thus saving ourselves some time
2028 (file-exists-p newcf) 2610 (file-exists-p newcf)
2029 (not (string= newcf speedbar-last-selected-file))) 2611 (not (string= newcf speedbar-last-selected-file)))
2038 (set-buffer speedbar-buffer) 2620 (set-buffer speedbar-buffer)
2039 (speedbar-with-writable 2621 (speedbar-with-writable
2040 (goto-char (point-min)) 2622 (goto-char (point-min))
2041 (if (re-search-forward 2623 (if (re-search-forward
2042 (concat " \\(" (regexp-quote newcf) "\\)\\(" 2624 (concat " \\(" (regexp-quote newcf) "\\)\\("
2043 (regexp-quote speedbar-vc-indicator) 2625 speedbar-indicator-regex "\\)?$") nil t)
2044 "\\)?\n") nil t)
2045 ;; put the property on it 2626 ;; put the property on it
2046 (put-text-property (match-beginning 1) 2627 (put-text-property (match-beginning 1)
2047 (match-end 1) 2628 (match-end 1)
2048 'face 2629 'face
2049 'speedbar-selected-face) 2630 'speedbar-selected-face)
2063 'speedbar-selected-face))) 2644 'speedbar-selected-face)))
2064 ;; if it's not in there now, whatever... 2645 ;; if it's not in there now, whatever...
2065 )) 2646 ))
2066 (setq speedbar-last-selected-file newcf)) 2647 (setq speedbar-last-selected-file newcf))
2067 (if (not sucf-recursive) 2648 (if (not sucf-recursive)
2068 (progn 2649 (speedbar-position-cursor-on-line))
2069 (forward-line -1)
2070 (speedbar-position-cursor-on-line)))
2071 (set-buffer lastb) 2650 (set-buffer lastb)
2072 (select-frame lastf) 2651 (select-frame lastf)
2073 ))) 2652 )))
2074 ;; return that we are done with this activity. 2653 ;; return that we are done with this activity.
2075 t) 2654 t)
2076 2655
2077 ;; Load ange-ftp only if compiling to remove errors. 2656 (defun speedbar-add-indicator (indicator-string &optional replace-this)
2657 "Add INDICATOR-STRING to the end of this speedbar line.
2658 If INDICATOR-STRING is space, and REPLACE-THIS is a character, then
2659 an the existing indicator is removed. If there is already an
2660 indicator, then do not add a space."
2661 (beginning-of-line)
2662 ;; The nature of the beast: Assume we are in "the right place"
2663 (end-of-line)
2664 (skip-chars-backward (concat " " speedbar-vc-indicator
2665 (car speedbar-obj-indicator)
2666 (cdr speedbar-obj-indicator)))
2667 (if (and (not (looking-at speedbar-indicator-regex))
2668 (not (string= indicator-string " ")))
2669 (insert speedbar-indicator-separator))
2670 (speedbar-with-writable
2671 (save-excursion
2672 (if (and replace-this
2673 (re-search-forward replace-this (save-excursion (end-of-line)
2674 (point))
2675 t))
2676 (delete-region (match-beginning 0) (match-end 0))))
2677 (end-of-line)
2678 (if (not (string= " " indicator-string))
2679 (insert indicator-string))))
2680
2681 ;; Load efs/ange-ftp only if compiling to remove byte-compiler warnings.
2078 ;; Steven L Baur <steve@xemacs.org> said this was important: 2682 ;; Steven L Baur <steve@xemacs.org> said this was important:
2079 (eval-when-compile (or (featurep 'xemacs) (require 'ange-ftp))) 2683 (eval-when-compile (or (featurep 'xemacs)
2684 (condition-case () (require 'efs)
2685 (error (require 'ange-ftp)))))
2080 2686
2081 (defun speedbar-check-vc () 2687 (defun speedbar-check-vc ()
2082 "Scan all files in a directory, and for each see if it's checked out. 2688 "Scan all files in a directory, and for each see if it's checked out.
2083 See `speedbar-this-file-in-vc' and `speedbar-vc-check-dir-p' for how 2689 See `speedbar-this-file-in-vc' and `speedbar-vc-check-dir-p' for how
2084 to add more types of version control systems." 2690 to add more types of version control systems."
2086 ;; then set to nil (do nothing) otherwise, start at the beginning 2692 ;; then set to nil (do nothing) otherwise, start at the beginning
2087 (save-excursion 2693 (save-excursion
2088 (set-buffer speedbar-buffer) 2694 (set-buffer speedbar-buffer)
2089 (if (and speedbar-vc-do-check (eq speedbar-vc-to-do-point t) 2695 (if (and speedbar-vc-do-check (eq speedbar-vc-to-do-point t)
2090 (speedbar-vc-check-dir-p default-directory) 2696 (speedbar-vc-check-dir-p default-directory)
2091 (not (and (featurep 'ange-ftp) 2697 (not (or (and (featurep 'ange-ftp)
2092 (string-match (car 2698 (string-match
2093 (if speedbar-xemacsp 2699 (car (if speedbar-xemacsp
2094 ange-ftp-path-format 2700 ange-ftp-path-format
2095 ange-ftp-name-format)) 2701 ange-ftp-name-format))
2096 (expand-file-name default-directory))))) 2702 (expand-file-name default-directory)))
2703 ;; efs support: Bob Weiner
2704 (and (featurep 'efs)
2705 (string-match
2706 (car efs-path-regexp)
2707 (expand-file-name default-directory))))))
2097 (setq speedbar-vc-to-do-point 0)) 2708 (setq speedbar-vc-to-do-point 0))
2098 (if (numberp speedbar-vc-to-do-point) 2709 (if (numberp speedbar-vc-to-do-point)
2099 (progn 2710 (progn
2100 (goto-char speedbar-vc-to-do-point) 2711 (goto-char speedbar-vc-to-do-point)
2101 (while (and (not (input-pending-p)) 2712 (while (and (not (input-pending-p))
2102 (re-search-forward "^\\([0-9]+\\):\\s-*\\[[+-]\\] " 2713 (re-search-forward "^\\([0-9]+\\):\\s-*\\[[+-]\\] "
2103 nil t)) 2714 nil t))
2104 (setq speedbar-vc-to-do-point (point)) 2715 (setq speedbar-vc-to-do-point (point))
2105 (if (speedbar-check-vc-this-line (match-string 1)) 2716 (if (speedbar-check-vc-this-line (match-string 1))
2106 (if (not (looking-at (regexp-quote speedbar-vc-indicator))) 2717 (speedbar-add-indicator speedbar-vc-indicator
2107 (speedbar-with-writable (insert speedbar-vc-indicator))) 2718 (regexp-quote speedbar-vc-indicator))
2108 (if (looking-at (regexp-quote speedbar-vc-indicator)) 2719 (speedbar-add-indicator " "
2109 (speedbar-with-writable 2720 (regexp-quote speedbar-vc-indicator))))
2110 (delete-region (match-beginning 0) (match-end 0))))))
2111 (if (input-pending-p) 2721 (if (input-pending-p)
2112 ;; return that we are incomplete 2722 ;; return that we are incomplete
2113 nil 2723 nil
2114 ;; we are done, set to-do to nil 2724 ;; we are done, set to-do to nil
2115 (setq speedbar-vc-to-do-point nil) 2725 (setq speedbar-vc-to-do-point nil)
2169 (file-exists-p (concat proj-dir "/SCCS/p." name)) 2779 (file-exists-p (concat proj-dir "/SCCS/p." name))
2170 nil)) 2780 nil))
2171 ;; User extension 2781 ;; User extension
2172 (run-hook-with-args 'speedbar-vc-in-control-hook path name) 2782 (run-hook-with-args 'speedbar-vc-in-control-hook path name)
2173 )) 2783 ))
2784
2785 ;; Objet File scanning
2786 (defun speedbar-check-objects ()
2787 "Scan all files in a directory, and for each see if there is an object.
2788 See `speedbar-check-obj-this-line' and `speedbar-obj-alist' for how
2789 to add more object types."
2790 ;; Check for to-do to be reset. If reset but no RCS is available
2791 ;; then set to nil (do nothing) otherwise, start at the beginning
2792 (save-excursion
2793 (set-buffer speedbar-buffer)
2794 (if (and speedbar-obj-do-check (eq speedbar-obj-to-do-point t))
2795 (setq speedbar-obj-to-do-point 0))
2796 (if (numberp speedbar-obj-to-do-point)
2797 (progn
2798 (goto-char speedbar-obj-to-do-point)
2799 (while (and (not (input-pending-p))
2800 (re-search-forward "^\\([0-9]+\\):\\s-*\\[[+-]\\] "
2801 nil t))
2802 (setq speedbar-obj-to-do-point (point))
2803 (let ((ind (speedbar-check-obj-this-line (match-string 1))))
2804 (if (not ind) (setq ind " "))
2805 (speedbar-add-indicator ind (concat
2806 (car speedbar-obj-indicator)
2807 "\\|"
2808 (cdr speedbar-obj-indicator)))))
2809 (if (input-pending-p)
2810 ;; return that we are incomplete
2811 nil
2812 ;; we are done, set to-do to nil
2813 (setq speedbar-obj-to-do-point nil)
2814 ;; and return t
2815 t))
2816 t)))
2817
2818 (defun speedbar-check-obj-this-line (depth)
2819 "Return t if the file on this line has an associated object.
2820 Parameter DEPTH is a string with the current depth of indentation of
2821 the file being checked."
2822 (let* ((d (string-to-int depth))
2823 (f (speedbar-line-path d))
2824 (fn (buffer-substring-no-properties
2825 ;; Skip-chars: thanks ptype@dra.hmg.gb
2826 (point) (progn
2827 (skip-chars-forward "^ "
2828 (save-excursion (end-of-line)
2829 (point)))
2830 (point))))
2831 (fulln (concat f fn)))
2832 (if (<= 2 speedbar-verbosity-level)
2833 (message "Speedbar obj check...%s" fulln))
2834 (let ((oa speedbar-obj-alist))
2835 (while (and oa (not (string-match (car (car oa)) fulln)))
2836 (setq oa (cdr oa)))
2837 (if (not (and oa (file-exists-p (concat (file-name-sans-extension fulln)
2838 (cdr (car oa))))))
2839 nil
2840 ;; Find out if the object is out of date or not.
2841 (let ((date1 (nth 5 (file-attributes fulln)))
2842 (date2 (nth 5 (file-attributes (concat
2843 (file-name-sans-extension fulln)
2844 (cdr (car oa)))))))
2845 (if (or (< (car date1) (car date2))
2846 (and (= (car date1) (car date2))
2847 (< (nth 1 date1) (nth 1 date2))))
2848 (car speedbar-obj-indicator)
2849 (cdr speedbar-obj-indicator)))))))
2174 2850
2175 ;;; Clicking Activity 2851 ;;; Clicking Activity
2176 ;; 2852 ;;
2177 (defun speedbar-quick-mouse (e) 2853 (defun speedbar-quick-mouse (e)
2178 "Since mouse events are strange, this will keep the mouse nicely positioned. 2854 "Since mouse events are strange, this will keep the mouse nicely positioned.
2217 (cond ((eq (car e) 'down-mouse-1) 2893 (cond ((eq (car e) 'down-mouse-1)
2218 (mouse-set-point e)) 2894 (mouse-set-point e))
2219 ((eq (car e) 'mouse-1) 2895 ((eq (car e) 'mouse-1)
2220 (speedbar-quick-mouse e)) 2896 (speedbar-quick-mouse e))
2221 ((or (eq (car e) 'double-down-mouse-1) 2897 ((or (eq (car e) 'double-down-mouse-1)
2222 (eq (car e) 'tripple-down-mouse-1)) 2898 (eq (car e) 'triple-down-mouse-1))
2223 (mouse-set-point e) 2899 (mouse-set-point e)
2224 (speedbar-do-function-pointer) 2900 (speedbar-do-function-pointer)
2225 (speedbar-quick-mouse e)))) 2901 (speedbar-quick-mouse e))))
2226 2902
2227 (defun speedbar-do-function-pointer () 2903 (defun speedbar-do-function-pointer ()
2258 (save-excursion 2934 (save-excursion
2259 (save-match-data 2935 (save-match-data
2260 (beginning-of-line) 2936 (beginning-of-line)
2261 (if (looking-at (concat 2937 (if (looking-at (concat
2262 "\\([0-9]+\\): *[[<][-+?][]>] \\([^ \n]+\\)\\(" 2938 "\\([0-9]+\\): *[[<][-+?][]>] \\([^ \n]+\\)\\("
2263 (regexp-quote speedbar-vc-indicator) 2939 speedbar-indicator-regex "\\)?"))
2264 "\\)?"))
2265 (let* ((depth (string-to-int (match-string 1))) 2940 (let* ((depth (string-to-int (match-string 1)))
2266 (path (speedbar-line-path depth)) 2941 (path (speedbar-line-path depth))
2267 (f (match-string 2))) 2942 (f (match-string 2)))
2268 (concat path f)) 2943 (concat path f))
2269 nil)))) 2944 nil))))
2296 (goto-char dest) nil) 2971 (goto-char dest) nil)
2297 ;; find the file part 2972 ;; find the file part
2298 (let ((nd (file-name-nondirectory file))) 2973 (let ((nd (file-name-nondirectory file)))
2299 (if (re-search-forward 2974 (if (re-search-forward
2300 (concat "] \\(" (regexp-quote nd) 2975 (concat "] \\(" (regexp-quote nd)
2301 "\\)\\(" (regexp-quote speedbar-vc-indicator) "\\)?$") 2976 "\\)\\(" speedbar-indicator-regex "\\)$")
2302 nil t) 2977 nil t)
2303 (progn 2978 (progn
2304 (speedbar-position-cursor-on-line) 2979 (speedbar-position-cursor-on-line)
2305 t) 2980 t)
2306 (goto-char dest) 2981 (goto-char dest)
2308 2983
2309 (defun speedbar-line-path (depth) 2984 (defun speedbar-line-path (depth)
2310 "Retrieve the pathname associated with the current line. 2985 "Retrieve the pathname associated with the current line.
2311 This may require traversing backwards from DEPTH and combining the default 2986 This may require traversing backwards from DEPTH and combining the default
2312 directory with these items." 2987 directory with these items."
2313 (save-excursion 2988 (cond
2314 (save-match-data 2989 ((string= speedbar-initial-expansion-list-name "files")
2315 (let ((path nil)) 2990 (save-excursion
2316 (setq depth (1- depth)) 2991 (save-match-data
2317 (while (/= depth -1) 2992 (let ((path nil))
2318 (if (not (re-search-backward (format "^%d:" depth) nil t)) 2993 (setq depth (1- depth))
2319 (error "Error building path of tag") 2994 (while (/= depth -1)
2320 (cond ((looking-at "[0-9]+:\\s-*<->\\s-+\\([^\n]+\\)$") 2995 (if (not (re-search-backward (format "^%d:" depth) nil t))
2321 (setq path (concat (buffer-substring-no-properties 2996 (error "Error building path of tag")
2322 (match-beginning 1) (match-end 1)) 2997 (cond ((looking-at "[0-9]+:\\s-*<->\\s-+\\([^\n]+\\)$")
2323 "/" 2998 (setq path (concat (buffer-substring-no-properties
2324 path))) 2999 (match-beginning 1) (match-end 1))
2325 ((looking-at "[0-9]+:\\s-*[-]\\s-+\\([^\n]+\\)$") 3000 "/"
2326 ;; This is the start of our path. 3001 path)))
2327 (setq path (buffer-substring-no-properties 3002 ((looking-at "[0-9]+:\\s-*[-]\\s-+\\([^\n]+\\)$")
2328 (match-beginning 1) (match-end 1)))))) 3003 ;; This is the start of our path.
2329 (setq depth (1- depth))) 3004 (setq path (buffer-substring-no-properties
2330 (if (and path 3005 (match-beginning 1) (match-end 1))))))
2331 (string-match (concat (regexp-quote speedbar-vc-indicator) "$") 3006 (setq depth (1- depth)))
2332 path)) 3007 (if (and path
2333 (setq path (substring path 0 (match-beginning 0)))) 3008 (string-match (concat speedbar-indicator-regex "$")
2334 (concat default-directory path))))) 3009 path))
3010 (setq path (substring path 0 (match-beginning 0))))
3011 (concat default-directory path)))))
3012 (t
3013 ;; If we aren't in file mode, then return an empty string to make
3014 ;; sure that we can still get some stuff done.
3015 "")))
2335 3016
2336 (defun speedbar-path-line (path) 3017 (defun speedbar-path-line (path)
2337 "Position the cursor on the line specified by PATH." 3018 "Position the cursor on the line specified by PATH."
2338 (save-match-data 3019 (save-match-data
2339 (if (string-match "/$" path) 3020 (if (string-match "/$" path)
2340 (setq path (substring path 0 (match-beginning 0)))) 3021 (setq path (substring path 0 (match-beginning 0))))
2341 (let ((nomatch t) (depth 0) 3022 (let ((nomatch t) (depth 0)
2342 (fname (file-name-nondirectory path)) 3023 (fname (file-name-nondirectory path))
2343 (pname (file-name-directory path))) 3024 (pname (file-name-directory path)))
2344 (if (not (member pname speedbar-shown-directories)) 3025 (if (not (member pname speedbar-shown-directories))
2345 (error "Internal Error: File %s not shown in speedbar." path)) 3026 (error "Internal Error: File %s not shown in speedbar" path))
2346 (goto-char (point-min)) 3027 (goto-char (point-min))
2347 (while (and nomatch 3028 (while (and nomatch
2348 (re-search-forward 3029 (re-search-forward
2349 (concat "[]>] \\(" (regexp-quote fname) 3030 (concat "[]>] \\(" (regexp-quote fname)
2350 "\\)\\(" (regexp-quote speedbar-vc-indicator) "\\)?$") 3031 "\\)\\(" speedbar-indicator-regex "\\)?$")
2351 nil t)) 3032 nil t))
2352 (beginning-of-line) 3033 (beginning-of-line)
2353 (looking-at "\\([0-9]+\\):") 3034 (looking-at "\\([0-9]+\\):")
2354 (setq depth (string-to-int (match-string 0)) 3035 (setq depth (string-to-int (match-string 0))
2355 nomatch (not (string= pname (speedbar-line-path depth)))) 3036 nomatch (not (string= pname (speedbar-line-path depth))))
2429 (setq default-directory 3110 (setq default-directory
2430 (concat (expand-file-name (concat (speedbar-line-path indent) text)) 3111 (concat (expand-file-name (concat (speedbar-line-path indent) text))
2431 "/")) 3112 "/"))
2432 ;; Because we leave speedbar as the current buffer, 3113 ;; Because we leave speedbar as the current buffer,
2433 ;; update contents will change directory without 3114 ;; update contents will change directory without
2434 ;; having to touch the attached frame. 3115 ;; having to touch the attached frame. Turn off smart expand just
2435 (speedbar-update-contents) 3116 ;; in case.
3117 (let ((speedbar-smart-directory-expand-flag nil))
3118 (speedbar-update-contents))
2436 (speedbar-set-timer speedbar-navigating-speed) 3119 (speedbar-set-timer speedbar-navigating-speed)
2437 (setq speedbar-last-selected-file nil) 3120 (setq speedbar-last-selected-file nil)
2438 (speedbar-stealthy-updates)) 3121 (speedbar-stealthy-updates))
2439 3122
2440 (defun speedbar-delete-subblock (indent) 3123 (defun speedbar-delete-subblock (indent)
2482 (setq oldl (cdr oldl))) 3165 (setq oldl (cdr oldl)))
2483 (setq speedbar-shown-directories newl)) 3166 (setq speedbar-shown-directories newl))
2484 (speedbar-change-expand-button-char ?+) 3167 (speedbar-change-expand-button-char ?+)
2485 (speedbar-delete-subblock indent) 3168 (speedbar-delete-subblock indent)
2486 ) 3169 )
2487 (t (error "Ooops... not sure what to do."))) 3170 (t (error "Ooops... not sure what to do")))
2488 (speedbar-center-buffer-smartly) 3171 (speedbar-center-buffer-smartly)
2489 (setq speedbar-last-selected-file nil) 3172 (setq speedbar-last-selected-file nil)
2490 (save-excursion (speedbar-stealthy-updates))) 3173 (save-excursion (speedbar-stealthy-updates)))
2491 3174
2492 (defun speedbar-directory-buttons-follow (text token indent) 3175 (defun speedbar-directory-buttons-follow (text token indent)
2493 "Speedbar click handler for default directory buttons. 3176 "Speedbar click handler for default directory buttons.
2494 TEXT is the button clicked on. TOKEN is the directory to follow. 3177 TEXT is the button clicked on. TOKEN is the directory to follow.
2495 INDENT is the current indentation level and is unused." 3178 INDENT is the current indentation level and is unused."
2496 (setq default-directory token) 3179 (if (string-match "^[A-Z]:$" token)
3180 (setq default-directory (concat token "\\"))
3181 (setq default-directory token))
2497 ;; Because we leave speedbar as the current buffer, 3182 ;; Because we leave speedbar as the current buffer,
2498 ;; update contents will change directory without 3183 ;; update contents will change directory without
2499 ;; having to touch the attached frame. 3184 ;; having to touch the attached frame.
2500 (speedbar-update-contents) 3185 (speedbar-update-contents)
2501 (speedbar-set-timer speedbar-navigating-speed)) 3186 (speedbar-set-timer speedbar-navigating-speed))
2525 lst 'speedbar-tag-expand 3210 lst 'speedbar-tag-expand
2526 'speedbar-tag-find)))))) 3211 'speedbar-tag-find))))))
2527 ((string-match "-" text) ;we have to contract this node 3212 ((string-match "-" text) ;we have to contract this node
2528 (speedbar-change-expand-button-char ?+) 3213 (speedbar-change-expand-button-char ?+)
2529 (speedbar-delete-subblock indent)) 3214 (speedbar-delete-subblock indent))
2530 (t (error "Ooops... not sure what to do."))) 3215 (t (error "Ooops... not sure what to do")))
2531 (speedbar-center-buffer-smartly)) 3216 (speedbar-center-buffer-smartly))
2532 3217
2533 (defun speedbar-tag-find (text token indent) 3218 (defun speedbar-tag-find (text token indent)
2534 "For the tag TEXT in a file TOKEN, goto that position. 3219 "For the tag TEXT in a file TOKEN, goto that position.
2535 INDENT is the current indentation level." 3220 INDENT is the current indentation level."
2554 (cond ((string-match "+" text) ;we have to expand this file 3239 (cond ((string-match "+" text) ;we have to expand this file
2555 (speedbar-change-expand-button-char ?-) 3240 (speedbar-change-expand-button-char ?-)
2556 (speedbar-with-writable 3241 (speedbar-with-writable
2557 (save-excursion 3242 (save-excursion
2558 (end-of-line) (forward-char 1) 3243 (end-of-line) (forward-char 1)
2559 (speedbar-insert-generic-list indent 3244 (speedbar-insert-generic-list indent token 'speedbar-tag-expand
2560 token 'speedbar-tag-expand
2561 'speedbar-tag-find)))) 3245 'speedbar-tag-find))))
2562 ((string-match "-" text) ;we have to contract this node 3246 ((string-match "-" text) ;we have to contract this node
2563 (speedbar-change-expand-button-char ?+) 3247 (speedbar-change-expand-button-char ?+)
2564 (speedbar-delete-subblock indent)) 3248 (speedbar-delete-subblock indent))
2565 (t (error "Ooops... not sure what to do."))) 3249 (t (error "Ooops... not sure what to do")))
2566 (speedbar-center-buffer-smartly)) 3250 (speedbar-center-buffer-smartly))
2567 3251
2568 ;;; Loading files into the attached frame. 3252 ;;; Loading files into the attached frame.
2569 ;; 3253 ;;
2570 (defun speedbar-find-file-in-frame (file) 3254 (defun speedbar-find-file-in-frame (file)
2579 (raise-frame (window-frame bwin))) 3263 (raise-frame (window-frame bwin)))
2580 (if speedbar-power-click 3264 (if speedbar-power-click
2581 (let ((pop-up-frames t)) (select-window (display-buffer buff))) 3265 (let ((pop-up-frames t)) (select-window (display-buffer buff)))
2582 (select-frame speedbar-attached-frame) 3266 (select-frame speedbar-attached-frame)
2583 (switch-to-buffer buff)))) 3267 (switch-to-buffer buff))))
2584 ) 3268 )
2585 3269
2586 ;;; Centering Utility 3270 ;;; Centering Utility
2587 ;; 3271 ;;
2588 (defun speedbar-center-buffer-smartly () 3272 (defun speedbar-center-buffer-smartly ()
2589 "Recenter a speedbar buffer so the current indentation level is all visible. 3273 "Recenter a speedbar buffer so the current indentation level is all visible.
2676 '(;; Note that java has the same parse-group as c 3360 '(;; Note that java has the same parse-group as c
2677 ("\\.\\([cChH]\\|c\\+\\+\\|cpp\\|cc\\|hh\\|java\\)\\'" . 3361 ("\\.\\([cChH]\\|c\\+\\+\\|cpp\\|cc\\|hh\\|java\\)\\'" .
2678 speedbar-parse-c-or-c++tag) 3362 speedbar-parse-c-or-c++tag)
2679 ("^\\.emacs$\\|.\\(el\\|l\\|lsp\\)\\'" . 3363 ("^\\.emacs$\\|.\\(el\\|l\\|lsp\\)\\'" .
2680 "def[^i]+\\s-+\\(\\(\\w\\|[-_]\\)+\\)\\s-*\C-?") 3364 "def[^i]+\\s-+\\(\\(\\w\\|[-_]\\)+\\)\\s-*\C-?")
3365 ; ("\\.\\([fF]\\|for\\|FOR\\|77\\|90\\)\\'" .
3366 ; speedbar-parse-fortran77-tag)
2681 ("\\.tex\\'" . speedbar-parse-tex-string) 3367 ("\\.tex\\'" . speedbar-parse-tex-string)
2682 ("\\.p\\'" . 3368 ("\\.p\\'" .
2683 "\\(\\(FUNCTION\\|function\\|PROCEDURE\\|procedure\\)\\s-+\\([a-zA-Z0-9_.:]+\\)\\)\\s-*(?^?") 3369 "\\(\\(FUNCTION\\|function\\|PROCEDURE\\|procedure\\)\\s-+\\([a-zA-Z0-9_.:]+\\)\\)\\s-*(?^?")
2684 ) 3370 )
2685 "Associations of file extensions and expressions for extracting tags. 3371 "Associations of file extensions and expressions for extracting tags.
2779 ; (while 3465 ; (while
2780 ; (re-search-forward "\\(.*[ \t]+\\)\\([^ \t\n]+.*\C-?\\)" nil t) 3466 ; (re-search-forward "\\(.*[ \t]+\\)\\([^ \t\n]+.*\C-?\\)" nil t)
2781 ; (delete-region (match-beginning 1) (match-end 1))))) 3467 ; (delete-region (match-beginning 1) (match-end 1)))))
2782 3468
2783 (defun speedbar-extract-one-symbol (expr) 3469 (defun speedbar-extract-one-symbol (expr)
2784 "At point, return nil, or one alist in the form: ( symbol . position ) 3470 "At point, return nil, or one alist in the form: (SYMBOL . POSITION)
2785 The line should contain output from etags. Parse the output using the 3471 The line should contain output from etags. Parse the output using the
2786 regular expression EXPR" 3472 regular expression EXPR"
2787 (let* ((sym (if (stringp expr) 3473 (let* ((sym (if (stringp expr)
2788 (if (save-excursion 3474 (if (save-excursion
2789 (re-search-forward expr (save-excursion 3475 (re-search-forward expr (save-excursion
2830 (buffer-substring-no-properties (match-beginning 0) 3516 (buffer-substring-no-properties (match-beginning 0)
2831 (match-end 0))) 3517 (match-end 0)))
2832 (t nil))))) 3518 (t nil)))))
2833 3519
2834 3520
3521 ;;; BUFFER DISPLAY mode.
3522 ;;
3523 (defvar speedbar-buffers-key-map nil
3524 "Keymap used when in the buffers display mode.")
3525
3526 (if speedbar-buffers-key-map
3527 nil
3528 (setq speedbar-buffers-key-map (speedbar-make-specialized-keymap))
3529
3530 ;; Basic tree features
3531 (define-key speedbar-buffers-key-map "e" 'speedbar-edit-line)
3532 (define-key speedbar-buffers-key-map "\C-m" 'speedbar-edit-line)
3533 (define-key speedbar-buffers-key-map "+" 'speedbar-expand-line)
3534 (define-key speedbar-buffers-key-map "-" 'speedbar-contract-line)
3535
3536 ;; Buffer specific keybindings
3537 (define-key speedbar-buffers-key-map "k" 'speedbar-buffer-kill-buffer)
3538 (define-key speedbar-buffers-key-map "r" 'speedbar-buffer-revert-buffer)
3539
3540 )
3541
3542 (defvar speedbar-buffer-easymenu-definition
3543 '(["Jump to buffer" speedbar-edit-line t]
3544 ["Expand File Tags" speedbar-expand-line
3545 (save-excursion (beginning-of-line)
3546 (looking-at "[0-9]+: *.\\+. "))]
3547 ["Contract File Tags" speedbar-contract-line
3548 (save-excursion (beginning-of-line)
3549 (looking-at "[0-9]+: *.-. "))]
3550 )
3551 "Menu item elements shown when displaying a buffer list.")
3552
3553 (defun speedbar-buffer-buttons (directory zero)
3554 "Create speedbar buttons based on the buffers currently loaded.
3555 DIRECTORY is the path to the currently active buffer, and ZERO is 0."
3556 (speedbar-buffer-buttons-engine nil))
3557
3558 (defun speedbar-buffer-buttons-temp (directory zero)
3559 "Create speedbar buttons based on the buffers currently loaded.
3560 DIRECTORY is the path to the currently active buffer, and ZERO is 0."
3561 (speedbar-buffer-buttons-engine t))
3562
3563 (defun speedbar-buffer-buttons-engine (temp)
3564 "Create speedbar buffer buttons.
3565 If TEMP is non-nil, then clicking on a buffer restores the previous display."
3566 (insert "Active Buffers:\n")
3567 (let ((bl (buffer-list)))
3568 (while bl
3569 (if (string-match "^[ *]" (buffer-name (car bl)))
3570 nil
3571 (let* ((known (string-match speedbar-file-regexp
3572 (buffer-name (car bl))))
3573 (expchar (if known ?+ ??))
3574 (fn (if known 'speedbar-tag-file nil))
3575 (fname (save-excursion (set-buffer (car bl))
3576 (buffer-file-name))))
3577 (speedbar-make-tag-line 'bracket expchar fn fname
3578 (buffer-name (car bl))
3579 'speedbar-buffer-click temp
3580 'speedbar-file-face 0)))
3581 (setq bl (cdr bl)))
3582 (setq bl (buffer-list))
3583 (insert "Scratch Buffers:\n")
3584 (while bl
3585 (if (not (string-match "^\\*" (buffer-name (car bl))))
3586 nil
3587 (if (eq (car bl) speedbar-buffer)
3588 nil
3589 (speedbar-make-tag-line 'bracket ?? nil nil
3590 (buffer-name (car bl))
3591 'speedbar-buffer-click temp
3592 'speedbar-file-face 0)))
3593 (setq bl (cdr bl)))
3594 (setq bl (buffer-list))
3595 (insert "Hidden Buffers:\n")
3596 (while bl
3597 (if (not (string-match "^ " (buffer-name (car bl))))
3598 nil
3599 (if (eq (car bl) speedbar-buffer)
3600 nil
3601 (speedbar-make-tag-line 'bracket ?? nil nil
3602 (buffer-name (car bl))
3603 'speedbar-buffer-click temp
3604 'speedbar-file-face 0)))
3605 (setq bl (cdr bl)))))
3606
3607 (defun speedbar-buffer-click (text token indent)
3608 "When the users clicks on a buffer-button in speedbar.
3609 TEXT is the buffer's name, TOKEN and INDENT are unused."
3610 (if speedbar-power-click
3611 (let ((pop-up-frames t)) (select-window (display-buffer text)))
3612 (select-frame speedbar-attached-frame)
3613 (switch-to-buffer text)
3614 (if token (speedbar-change-initial-expansion-list
3615 speedbar-previously-used-expansion-list-name))))
3616
3617 (defun speedbar-buffer-kill-buffer ()
3618 "Kill the buffer the cursor is on in the speedbar buffer."
3619 (interactive)
3620 (or (save-excursion
3621 (beginning-of-line)
3622 ;; If this fails, then it is a non-standard click, and as such,
3623 ;; perfectly allowed.
3624 (if (re-search-forward "[]>}] [a-zA-Z0-9]"
3625 (save-excursion (end-of-line) (point))
3626 t)
3627 (let ((text (progn
3628 (forward-char -1)
3629 (buffer-substring (point) (save-excursion
3630 (end-of-line)
3631 (point))))))
3632 (if (and (get-buffer text)
3633 (y-or-n-p (format "Kill buffer %s? " text)))
3634 (kill-buffer text)))))))
3635
3636 (defun speedbar-buffer-revert-buffer ()
3637 "Revert the buffer the cursor is on in the speedbar buffer."
3638 (interactive)
3639 (save-excursion
3640 (beginning-of-line)
3641 ;; If this fails, then it is a non-standard click, and as such,
3642 ;; perfectly allowed
3643 (if (re-search-forward "[]>}] [a-zA-Z0-9]"
3644 (save-excursion (end-of-line) (point))
3645 t)
3646 (let ((text (progn
3647 (forward-char -1)
3648 (buffer-substring (point) (save-excursion
3649 (end-of-line)
3650 (point))))))
3651 (if (get-buffer text)
3652 (progn
3653 (set-buffer text)
3654 (revert-buffer t)))))))
3655
3656
3657
2835 ;;; Color loading section This is messy *Blech!* 3658 ;;; Color loading section This is messy *Blech!*
2836 ;; 3659 ;;
2837 (defface speedbar-button-face '((((class color) (background light)) 3660 (defface speedbar-button-face '((((class color) (background light))
2838 (:foreground "green4")) 3661 (:foreground "green4"))
2839 (((class color) (background dark)) 3662 (((class color) (background dark))