aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKarl Heuer1998-07-10 16:48:06 +0000
committerKarl Heuer1998-07-10 16:48:06 +0000
commit59588cd48bd100ace7bea70b10c7c4b85de30cf1 (patch)
tree3827685e1c23b0e53b381eccd80eee0b4dcfc43e
parentacb50e3cd42d5714272b9a0b449648662a145fe6 (diff)
downloademacs-59588cd48bd100ace7bea70b10c7c4b85de30cf1.tar.gz
emacs-59588cd48bd100ace7bea70b10c7c4b85de30cf1.zip
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.
-rw-r--r--lisp/speedbar.el1707
1 files changed, 1265 insertions, 442 deletions
diff --git a/lisp/speedbar.el b/lisp/speedbar.el
index f3595eaf650..0a98fbacb2c 100644
--- a/lisp/speedbar.el
+++ b/lisp/speedbar.el
@@ -1,23 +1,24 @@
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,
@@ -32,8 +33,7 @@
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:
@@ -41,7 +41,7 @@
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])
@@ -88,7 +88,7 @@
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;;
@@ -101,7 +101,16 @@
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.
@@ -111,10 +120,6 @@
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;;
@@ -122,211 +127,90 @@
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
127;; them in your .Xdefaults file.
128;; Here is an example .Xdefaults for a dark background:
129;; 131;;
130;; emacs*speedbar-button-face.attributeForeground: Aquamarine 132;; Adding a speedbar specialized display mode:
131;; emacs*speedbar-selected-face.attributeForeground: red
132;; emacs*speedbar-selected-face.attributeUnderline: true
133;; emacs*speedbar-directory-face.attributeForeground: magenta
134;; emacs*speedbar-file-face.attributeForeground: green3
135;; emacs*speedbar-highlight-face.attributeBackground: sea green
136;; emacs*speedbar-tag-face.attributeForeground: yellow
137
138;;; Speedbar updates can be found at:
139;; ftp://ftp.ultranet.com/pub/zappo/speedbar*.tar.gz
140;; 133;;
141 134;; Speedbar can be configured to create a special display for certain
142;;; Change log: 135;; modes that do not display tradition file/tag data. Rmail, Info,
143;; 0.1 Initial Revision 136;; and the debugger are examples. These modes can, however, benefit
144;; 0.2 Fixed problem with x-pointer-shape causing future frames not 137;; from a speedbar style display in their own way.
145;; to be created. 138;;
146;; Fixed annoying habit of `speedbar-update-contents' to make 139;; If your `major-mode' is `foo-mode', the only requirement is to
147;; it possible to accidentally kill the speedbar buffer. 140;; create a function called `foo-speedbar-buttons' which takes one
148;; Clicking directory names now only changes the contents of 141;; argument, BUFFER. BUFFER will be the buffer speedbar wants filled.
149;; the speedbar, and does not cause a dired mode to appear. 142;; In `foo-speedbar-buttons' there are several functions that make
150;; Clicking the <+> next to the directory does cause dired to 143;; building a speedbar display easy. See the documentation for
151;; be run. 144;; `speedbar-with-writable' (needed because the buffer is usually
152;; Added XEmacs support, which means timer support moved to a 145;; read-only) `speedbar-make-tag-line', `speedbar-insert-button', and
153;; platform independant call. 146;; `speedbar-insert-generic-list'. If you use
154;; Added imenu support. Now modes are supported by imenu 147;; `speedbar-insert-generic-list', also read the doc for
155;; first, and etags only if the imenu call doesn't work. 148;; `speedbar-tag-hierarchy-method' in case you wish to override it.
156;; Imenu is a little faster than etags, and is more emacs 149;; The function `speedbar-with-attached-buffer' brings you back to the
157;; friendly. 150;; buffer speedbar is displaying for.
158;; Added more user control variables described in the commentary. 151;;
159;; Added smart recentering when nodes are opened and closed. 152;; For those functions that make buttons, the "function" should be a
160;; 0.3 x-pointer-shape fixed for emacs 19.35, so I put that check in. 153;; symbol that is the function to call when clicked on. The "token"
161;; Added invisible codes to the beginning of each line. 154;; is extra data you can pass along. The "function" must take three
162;; Added list aproach to node expansion for easier addition of new 155;; parameters. They are (TEXT TOKEN INDENT). TEXT is the text of the
163;; types of things to expand by 156;; button clicked on. TOKEN is the data passed in when you create the
164;; Added multi-level path name support 157;; button. INDENT is an indentation level, or 0. You can store
165;; Added multi-level tag name support. 158;; indentation levels with `speedbar-make-tag-line' which creates a
166;; Only mouse-2 is now used for node expansion 159;; line with an expander (eg. [+]) and a text button.
167;; Added keys e + - to edit expand, and contract node lines 160;;
168;; Added longer legal file regexp for all those modes which support 161;; Some useful functions when writing expand functions, and click
169;; imenu. (pascal, fortran90, ada, pearl) 162;; functions are `speedbar-change-expand-button-char',
170;; Added pascal support to etags from Dave Penkler <dave_penkler@grenoble.hp.com> 163;; `speedbar-delete-subblock', and `speedbar-center-buffer-smartly'.
171;; Fixed centering algorithm 164;; The variable `speedbar-power-click' is set to t in your functions
172;; Tried to choose background independent colors. Made more robust. 165;; when the user shift-clicks. This indications anything from
173;; Rearranged code into a more logical order 166;; refreshing cached data to making a buffer appear in a new frame.
174;; 0.3.1 Fixed doc & broken keybindings 167;;
175;; Added mode hooks. 168;; If you wish to add to the default speedbar menu for the case of
176;; Improved color selection to be background mode smart 169;; `foo-mode', create a variable `foo-speedbar-menu-items'. This
177;; `nil' passed to `speedbar-frame-mode' now toggles the frame as 170;; should be a list compatible with the `easymenu' package. It will
178;; advertised in the doc string 171;; be spliced into the main menu. (Available with click-mouse-3). If
179;; 0.4a Added modified patch from Dan Schmidt <dfan@lglass.com> allowing a 172;; you wish to have extra key bindings in your special mode, create a
180;; directory cache to be maintained speeding up revisiting of files. 173;; variable `foo-speedbar-key-map'. Instead of using `make-keymap',
181;; Default raise-lower behavior is now off by default. 174;; or `make-sparse-keymap', use the function
182;; Added some menu items for edit expand and contract. 175;; `speedbar-make-specialized-keymap'. This lets you inherit all of
183;; Pre 19.31 emacsen can run without idle timers. 176;; speedbar's default bindings with low overhead.
184;; Added some patch information from Farzin Guilak <farzin@protocol.com> 177;;
185;; adding xemacs specifics, and some etags upgrades. 178;; Adding a speedbar top-level display mode:
186;; Added ability to set a faces symbol-value to a string 179;;
187;; representing the desired foreground color. (idea from 180;; Unlike the specialized modes, there are no name requirements,
188;; Farzin Guilak, but implemented differently) 181;; however the methods for writing a button display, menu, and keymap
189;; Fixed problem with 1 character buttons. 182;; are the same. Once you create these items, you can call the
190;; Added support for new Imenu marker technique. 183;; function `speedbar-add-expansion-list'. It takes one parameter
191;; Added `speedbar-load-hooks' for things to run only once on 184;; which is a list element of the form (NAME MENU KEYMAP &rest
192;; load such as updating one of the many lists. 185;; BUTTON-FUNCTIONS). NAME is a string that will show up in the
193;; Added `speedbar-supported-extension-expressions' which is a 186;; Displays menu item. MENU is a symbol containing the menu items to
194;; list of extensions that speedbar will tag. This variable 187;; splice in. KEYMAP is a symbol holding the keymap to use, and
195;; should only be updated with `speedbar-add-supported-extension' 188;; BUTTON-FUNCTIONS are the function names to call, in order, to create
196;; Moved configure dialog support to a separate file so 189;; the display.
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)
323 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)))
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)
@@ -361,23 +245,51 @@
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
371Whenever a top level update is issued all functions in this list are 255 speedbar-directory-buttons speedbar-default-directory-list)
372run. These functions will always get the default directory to use 256 )
373passed in as the first parameter, and a 0 as the second parameter. 257 "List of named expansion elements for filling the speedbar frame.
374The 0 indicates the uppermost indentation level. They must assume 258These expansion lists are only valid for regular files. Special modes
375that the cursor is at the position where they start inserting 259still get to override this list on a mode-by-mode basis. This list of
376buttons.") 260lists is of the form (NAME MENU KEYMAP FN1 FN2 ...). NAME is a string
261representing the types of things to be displayed. MENU is an easymenu
262structure used when in this mode. KEYMAP is a local keymap to install
263over the regular speedbar keymap. FN1 ... are functions that will be
264called in order. These functions will always get the default
265directory to use passed in as the first parameter, and a 0 as the
266second parameter. The 0 indicates the uppermost indentation level.
267They must assume that the cursor is at the position where they start
268inserting buttons.")
269
270(defcustom speedbar-initial-expansion-list-name "files"
271 "A symbol name representing the expansion list to use.
272The expansion list `speedbar-initial-expansion-mode-alist' contains
273the 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.
280This is used for returning to a previous expansion list method when
281the 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.
288This list is of the form:
289 '( (\"NAME\" FUNCTION ...)
290 ...)
291where NAME is the name of the major display mode these functions are
292for, and the remaining elements FUNCTION are functions to call in order.
381Each function must return nil if interrupted, or t if completed. 293Each function must return nil if interrupted, or t if completed.
382Stealthy functions which have a single operation should always return 294Stealthy functions which have a single operation should always return
383t. Functions which take a long time should maintain a state (where 295t. Functions which take a long time should maintain a state (where
@@ -392,16 +304,16 @@ frame."
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.
396Some modes, such as Info or RMAIL, do not relate quite as easily into 308This list is set by modes that wish to have special speedbar displays.
397a simple list of files. When this variable is non-nil and buffer-local, 309The list is of function names. Each function is called with one
398then these functions are used, creating specialized contents. These 310parameter BUFFER, the originating buffer. The current buffer is the
399functions are called each time the speedbar timer is called. This 311speedbar buffer.")
400allows a mode to update its contents regularly.
401 312
402 Each function is called with the default and frame belonging to 313(defvar speedbar-special-mode-key-map nil
403speedbar, and with one parameter; the buffer requesting 314 "Default keymap used when identifying a specialized display mode.
404the speedbar display.") 315This keymap is local to each buffer that wants to define special keybindings
316effective 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."
@@ -436,7 +348,10 @@ 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.
441Navigation commands included expanding/contracting nodes, and moving 356Navigation commands included expanding/contracting nodes, and moving
442between different directories." 357between different directories."
@@ -483,11 +398,51 @@ use etags instead. Etags support is not as robust as imenu support."
483 :group 'speedbar 398 :group 'speedbar
484 :type 'boolean) 399 :type 'boolean)
485 400
401(defcustom speedbar-track-mouse-flag t
402 "*Non-nil means to display info about the line under the mouse."
403 :group 'speedbar
404 :type 'boolean)
405
486(defcustom speedbar-sort-tags nil 406(defcustom speedbar-sort-tags nil
487 "*If Non-nil, sort tags in the speedbar display." 407 "*If Non-nil, sort tags in the speedbar display. *Obsolete*."
488 :group 'speedbar 408 :group 'speedbar
489 :type 'boolean) 409 :type 'boolean)
490 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.
414Groups are defined as expandable meta-tags. Imenu supports such
415things in some languages, such as separating variables from functions.
416Available 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.
433This is used by all tag-hierarchy methods that break large lists into
434sub-lists."
435 :group 'speedbar
436 :type 'integer)
437
438(defcustom speedbar-tag-regroup-maximum-length 10
439 "*Maximum length of submenus that are regrouped.
440If the regrouping option is used, then if two or more short subgroups
441are next to each other, then they are combined until this number of
442items is reached."
443 :group 'speedbar
444 :type 'integer)
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.
493Thus, if a file is selected for edit, the buffer will appear in the 448Thus, if a file is selected for edit, the buffer will appear in the
@@ -518,6 +473,9 @@ 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
@@ -545,25 +503,21 @@ 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.
550Any file checked out is marked with `speedbar-vc-indicator'" 511Any 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.
556Currently only RCS is supported. Other version control systems can be 517Currently only RCS is supported. Other version control systems can be
557added by examining the function `speedbar-this-file-in-vc' and 518added by examining the function `speedbar-this-file-in-vc' and
558`speedbar-vc-check-dir-p'") 519`speedbar-vc-check-dir-p'")
559 520
560(defcustom speedbar-scanner-reset-hook nil
561 "*Hook called whenever generic scanners are reset.
562Set this to implement your own scanning / rescan safe functions with
563state data."
564 :group 'speedbar
565 :type 'hook)
566
567(defcustom speedbar-vc-path-enable-hook nil 521(defcustom speedbar-vc-path-enable-hook nil
568 "*Return non-nil if the current path should be checked for Version Control. 522 "*Return non-nil if the current path should be checked for Version Control.
569Functions in this hook must accept one parameter which is the path 523Functions in this hook must accept one parameter which is the path
@@ -581,13 +535,56 @@ current file, and the FILENAME of the file being checked."
581(defvar speedbar-vc-to-do-point nil 535(defvar speedbar-vc-to-do-point nil
582 "Local variable maintaining the current version control check position.") 536 "Local variable maintaining the current version control check position.")
583 537
538(defcustom speedbar-obj-do-check t
539 "*Non-nil check all files in speedbar to see if they have an object file.
540Any file checked out is marked with `speedbar-obj-indicator', and the
541marking 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.
550The car is for an up-to-date object. The cdr is for an out of date object.
551The 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.
572Permits stripping of indicator characters from a line.")
573
574(defcustom speedbar-scanner-reset-hook nil
575 "*Hook called whenever generic scanners are reset.
576Set this to implement your own scanning / rescan safe functions with
577state data."
578 :group 'speedbar
579 :type 'hook)
580
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.
589All the preceding . are stripped for an optimized expression starting 586All the preceding `.' are stripped for an optimized expression starting
590with . followed by extensions, followed by full-filenames." 587with `.' 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)) ?.)
@@ -625,6 +622,13 @@ before speedbar has been loaded."
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.
627They should include commonly existing directories which are not
628useful, 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
@@ -638,10 +642,13 @@ It is generated from the variable `completion-ignored-extensions'")
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.
647Do not prefix the `.' char with a double \\ to quote it, as the period 654Do not prefix the `.' char with a double \\ to quote it, as the period
@@ -670,6 +677,7 @@ This should start with a `.' if it is not a complete file name, and
670the dot should NOT be quoted in with \\. Other regular expression 677the dot should NOT be quoted in with \\. Other regular expression
671matchers are allowed however. EXTENSION may be a single string or a 678matchers are allowed however. EXTENSION may be a single string or a
672list of strings." 679list 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)
@@ -684,6 +692,7 @@ list of strings."
684 "Add PATH-EXPRESSION as a new ignored path for speedbar tracking. 692 "Add PATH-EXPRESSION as a new ignored path for speedbar tracking.
685This function will modify `speedbar-ignored-path-regexp' and add 693This function will modify `speedbar-ignored-path-regexp' and add
686PATH-EXPRESSION to `speedbar-ignored-path-expressions'." 694PATH-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
@@ -702,9 +711,11 @@ PATH-EXPRESSION to `speedbar-ignored-path-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.
709When this is nil then speedbar will not follow the attached frame's path. 720When this is nil then speedbar will not follow the attached frame's path.
710When speedbar is active, use: 721When speedbar is active, use:
@@ -727,7 +738,6 @@ to toggle this value.")
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
@@ -737,37 +747,49 @@ to toggle this value.")
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)
@@ -779,21 +801,47 @@ to toggle this value.")
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.
816This 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"
@@ -807,39 +855,41 @@ to toggle this value.")
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
@@ -890,21 +940,6 @@ 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))
@@ -956,7 +991,8 @@ supported at a time.
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))
@@ -981,10 +1017,15 @@ selected. If the speedbar frame is active, then select the attached frame."
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 ()
@@ -994,6 +1035,18 @@ selected. If the speedbar frame is active, then select the attached frame."
994 (select-frame speedbar-attached-frame) 1035 (select-frame speedbar-attached-frame)
995 (other-frame 0)) 1036 (other-frame 0))
996 1037
1038(defun speedbar-switch-buffer-attached-frame (&optional buffer)
1039 "Switch to BUFFER in speedbar's attached frame, and raise that frame.
1040This overrides the default behavior of `switch-to-buffer' which is
1041broken 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)))
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.
999nil if it doesn't exist." 1052nil if it doesn't exist."
@@ -1032,6 +1085,11 @@ version control system. (currently only RCS is supported.) New
1032version control systems can be added by examining the documentation 1085version control systems can be added by examining the documentation
1033for `speedbar-this-file-in-vc' and `speedbar-vc-check-dir-p' 1086for `speedbar-this-file-in-vc' and `speedbar-vc-check-dir-p'
1034 1087
1088Files with a `#' or `!' character after them are source files that
1089have an object file associated with them. The `!' indicates that the
1090files is out of date. You can control what source/object associations
1091exist through the variable `speedbar-obj-alist'.
1092
1035Click on the [+] to display a list of tags from that file. Click on 1093Click on the [+] to display a list of tags from that file. Click on
1036the [-] to retract the list. Click on the file name to edit the file 1094the [-] to retract the list. Click on the file name to edit the file
1037in the attached frame. 1095in the attached frame.
@@ -1048,17 +1106,22 @@ in the selected file.
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
@@ -1088,12 +1151,29 @@ in the selected file.
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)
1096 1166
1167(defun speedbar-show-info-under-mouse (&optional event)
1168 "Call the info function for the line under the mouse.
1169Optional 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))))))
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.
1099This gives visual indications of what is up. It EXPECTS the speedbar 1179This gives visual indications of what is up. It EXPECTS the speedbar
@@ -1132,34 +1212,71 @@ 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.
1139Different menu items are displayed depending on the current display mode 1225Different menu items are displayed depending on the current display mode
1140and the existence of packages." 1226and 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
@@ -1195,6 +1312,34 @@ mode-line. This is only useful for non-XEmacs"
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.
@@ -1203,6 +1348,7 @@ mode-line. This is only useful for non-XEmacs"
1203 "Pop up a menu related to the clicked on item. 1348 "Pop up a menu related to the clicked on item.
1204Must be bound to EVENT." 1349Must 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)
@@ -1241,6 +1387,82 @@ Must be bound to event E."
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.
1392This means that movement is restricted to a subnode, and that siblings
1393of 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.
1422This means that movement is restricted to a subnode, and that siblings
1423of 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.
1431This means that movement is restricted to a subnode, and that siblings
1432of 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.
1439Stop on the first line of the next type of item, or on the last or first item
1440if 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.
1452A LIST in speedbar is a group of similarly typed items, such as directories,
1453files, 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.
1460A LIST in speedbar is a group of similarly typed items, such as directories,
1461files, 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")
@@ -1274,10 +1496,14 @@ Assumes that the current buffer is the speedbar buffer"
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))
@@ -1286,10 +1512,10 @@ Assumes that the current buffer is the speedbar buffer"
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)))
@@ -1297,7 +1523,8 @@ Assumes that the current buffer is the speedbar buffer"
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)
@@ -1307,36 +1534,55 @@ This should be bound to a mouse EVENT."
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.
1539File 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.
1334Files can be copied to new names or places." 1580Files 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)))
@@ -1387,13 +1633,13 @@ Files can be renamed to new names or moved to new directories."
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)
@@ -1406,6 +1652,24 @@ Files can be renamed to new names or moved to new directories."
1406 )) 1652 ))
1407 )) 1653 ))
1408 1654
1655(defun speedbar-item-object-delete ()
1656 "Delete the object associated from the item under the cursor.
1657The file is removed from disk. The object is determined from the
1658variable `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)))))
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)
@@ -1501,12 +1765,12 @@ to track file check ins, and will change the mode line to match
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.
1505If it is not shown, force it to appear in the default window." 1769If 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.
@@ -1550,7 +1814,7 @@ specialized speedbar displays."
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.
1552MOUSE is the mouse face. When this button is clicked on FUNCTION 1816MOUSE is the mouse face. When this button is clicked on FUNCTION
1553will be run with the TOKEN parameter (any lisp object)" 1817will 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)
@@ -1558,6 +1822,114 @@ will be run with the TOKEN parameter (any lisp object)"
1558 (if token (put-text-property start end 'speedbar-token token)) 1822 (if token (put-text-property start end 'speedbar-token token))
1559 ) 1823 )
1560 1824
1825;;; Initial Expansion list management
1826;;
1827(defun speedbar-initial-expansion-list ()
1828 "Return the current default expansion list.
1829This 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.
1837This 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.
1845This 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.
1853This 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.
1882Maintains the value of local variables which control speedbars use
1883of 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)))
1932
1561;;; File button management 1933;;; File button management
1562;; 1934;;
1563(defun speedbar-file-lists (directory) 1935(defun speedbar-file-lists (directory)
@@ -1578,7 +1950,9 @@ the file-system"
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))))
@@ -1696,6 +2070,10 @@ position to insert a new item, and that the new item will end with a CR"
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)
@@ -1717,7 +2095,8 @@ position to insert a new item, and that the new item will end with a CR"
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
@@ -1726,7 +2105,7 @@ position to insert a new item, and that the new item will end with a CR"
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.
1727Tag expandable items with a +, otherwise a ?. Don't highlight ? as we 2106Tag expandable items with a +, otherwise a ?. Don't highlight ? as we
1728don't know how to manage them. The input parameter FILES is a cons 2107don't know how to manage them. The input parameter FILES is a cons
1729cell of the form ( 'DIRLIST . 'FILELIST )" 2108cell 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
@@ -1734,7 +2113,8 @@ cell of the form ( 'DIRLIST . 'FILELIST )"
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 ?+ ??))
@@ -1770,6 +2150,185 @@ cell of the form ( 'DIRLIST . 'FILELIST )"
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.
2324This uses `speedbar-tag-hierarchy-method' to determine how to adjust
2325the 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.
1775Associations with lists get {+} tags (to expand into more nodes) and 2334Associations with lists get {+} tags (to expand into more nodes) and
@@ -1779,6 +2338,8 @@ 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
@@ -1805,7 +2366,11 @@ name will have the function FIND-FUN and not token."
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
@@ -1818,7 +2383,7 @@ name will have the function FIND-FUN and not token."
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)
@@ -1832,7 +2397,12 @@ name will have the function FIND-FUN and not token."
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
@@ -1840,7 +2410,8 @@ name will have the function FIND-FUN and not token."
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)
@@ -1883,7 +2454,7 @@ name will have the function FIND-FUN and not token."
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.
@@ -1910,10 +2481,10 @@ This should only be used by modes classified as special."
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)
@@ -1927,8 +2498,11 @@ This should only be used by modes classified as special."
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
@@ -1962,28 +2536,36 @@ This should only be used by modes classified as special."
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.
1973Each item returns t if it completes successfully, or nil if 2552Each item returns t if it completes successfully, or nil if
1974interrupted by the user." 2553interrupted 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.
1985If new functions are added, their state needs to be updated here." 2566If 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
@@ -1998,8 +2580,7 @@ If new functions are added, their state needs to be updated here."
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)
@@ -2021,7 +2602,8 @@ updated."
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
@@ -2040,8 +2622,7 @@ updated."
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)
@@ -2065,18 +2646,43 @@ updated."
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.
2658If INDICATOR-STRING is space, and REPLACE-THIS is a character, then
2659an the existing indicator is removed. If there is already an
2660indicator, 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.
@@ -2088,12 +2694,17 @@ to add more types of version control systems."
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
@@ -2103,11 +2714,10 @@ to add more types of version control systems."
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
@@ -2171,6 +2781,72 @@ that will occur on your system."
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.
2788See `speedbar-check-obj-this-line' and `speedbar-obj-alist' for how
2789to 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.
2820Parameter DEPTH is a string with the current depth of indentation of
2821the 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;;
@@ -2219,7 +2895,7 @@ This should be bound to mouse event 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))))
@@ -2260,8 +2936,7 @@ directory, then it is the directory name."
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)))
@@ -2298,7 +2973,7 @@ Otherwise do not move and return nil."
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)
@@ -2310,28 +2985,34 @@ Otherwise do not move and return nil."
2310 "Retrieve the pathname associated with the current line. 2985 "Retrieve the pathname associated with the current line.
2311This may require traversing backwards from DEPTH and combining the default 2986This may require traversing backwards from DEPTH and combining the default
2312directory with these items." 2987directory 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."
@@ -2342,12 +3023,12 @@ directory with these items."
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]+\\):")
@@ -2431,8 +3112,10 @@ subdirectory chosen will be at INDENT level."
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))
@@ -2484,7 +3167,7 @@ expanded. INDENT is the current indentation level."
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)))
@@ -2493,7 +3176,9 @@ expanded. INDENT is the current indentation level."
2493 "Speedbar click handler for default directory buttons. 3176 "Speedbar click handler for default directory buttons.
2494TEXT is the button clicked on. TOKEN is the directory to follow. 3177TEXT is the button clicked on. TOKEN is the directory to follow.
2495INDENT is the current indentation level and is unused." 3178INDENT 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.
@@ -2527,7 +3212,7 @@ indentation level."
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)
@@ -2556,13 +3241,12 @@ level."
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.
@@ -2581,7 +3265,7 @@ frame instead."
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;;
@@ -2678,6 +3362,8 @@ Returns the tag list, or t for an error."
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-*(?^?")
@@ -2781,7 +3467,7 @@ Each symbol will be associated with its line position in FILE."
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)
2785The line should contain output from etags. Parse the output using the 3471The line should contain output from etags. Parse the output using the
2786regular expression EXPR" 3472regular expression EXPR"
2787 (let* ((sym (if (stringp expr) 3473 (let* ((sym (if (stringp expr)
@@ -2832,6 +3518,143 @@ regular expression EXPR"
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.
3555DIRECTORY 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.
3560DIRECTORY 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.
3565If 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.
3609TEXT 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))