aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorDan Nicolaescu1998-04-18 19:28:13 +0000
committerDan Nicolaescu1998-04-18 19:28:13 +0000
commit6b3eac8d032042f6eb2d4b2a9359ec2514138a70 (patch)
tree080badc558acd7a8170ee9049610254fc07be8b7
parenta55d9b3b1357840e9e1d3663b598434bc608523e (diff)
downloademacs-6b3eac8d032042f6eb2d4b2a9359ec2514138a70.tar.gz
emacs-6b3eac8d032042f6eb2d4b2a9359ec2514138a70.zip
Initial revision
Diffstat
-rw-r--r--lisp/speedbar.el2893
1 files changed, 2893 insertions, 0 deletions
diff --git a/lisp/speedbar.el b/lisp/speedbar.el
new file mode 100644
index 00000000000..3cf37afc813
--- /dev/null
+++ b/lisp/speedbar.el
@@ -0,0 +1,2893 @@
1;;; speedbar --- quick access to files and tags
2
3;;; Copyright (C) 1996, 97, 98 Free Software Foundation
4;;
5;; Author: Eric M. Ludlam <zappo@gnu.ai.mit.edu>
6;; Version: 0.6.2
7;; Keywords: file, tags, tools
8;;
9;; This file is part of GNU Emacs.
10;;
11;; 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;; the Free Software Foundation; either version 2, or (at your option)
14;; any later version.
15;;
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20;;
21;; 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;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24;; Boston, MA 02111-1307, USA.
25
26;;; Commentary:
27;;
28;; The speedbar provides a frame in which files, and locations in
29;; files are displayed. These items can be clicked on with mouse-2
30;; in order to make the last active frame display that file location.
31;;
32;; Starting Speedbar:
33;;
34;; 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;; submenu will be added under "Tools".
37;;
38;; If speedbar is not a part of your distribution, then add
39;; this to your .emacs file:
40;;
41;; (autoload 'speedbar-frame-mode "speedbar" "Popup a speedbar frame" t)
42;; (autoload 'speedbar-get-focus "speedbar" "Jump to speedbar frame" t)
43;;
44;; If you want to choose it from a menu, you can do this:
45;;
46;; Emacs:
47;; (define-key-after (lookup-key global-map [menu-bar tools])
48;; [speedbar] '("Speedbar" . speedbar-frame-mode) [calendar])
49;;
50;; XEmacs:
51;; (add-menu-button '("Tools")
52;; ["Speedbar" speedbar-frame-mode
53;; :style toggle
54;; :selected (and (boundp 'speedbar-frame)
55;; (frame-live-p speedbar-frame)
56;; (frame-visible-p speedbar-frame))]
57;; "--")
58;;
59;; If you want to access speedbar using only the keyboard, do this:
60;;
61;; (global-set-key [(f4)] 'speedbar-get-focus)
62;;
63;; This will let you hit f4 (or whatever key you choose) to jump
64;; focus to the speedbar frame. Pressing it again will bring you back
65;; to the attached frame. Pressing RET or e to jump to a file
66;; or tag will move you back to the attached frame. The command
67;; `speedbar-get-focus' will also create a speedbar frame if it does
68;; not exist.
69;;
70;; Customizing Speedbar:
71;;
72;; Once a speedbar frame is active, it takes advantage of idle time
73;; to keep its contents updated. The contents is usually a list of
74;; files in the directory of the currently active buffer. When
75;; applicable, tags in the active file can be expanded.
76;;
77;; To add new supported files types into speedbar, use the function
78;; `speedbar-add-supported-extension' If speedbar complains that the
79;; file type is not supported, that means there is no built in
80;; support from imenu, and the etags part wasn't set up correctly. You
81;; may add elements to `speedbar-supported-extension-expressions' as long
82;; as it is done before speedbar is loaded.
83;;
84;; To prevent speedbar from following you into certain directories
85;; use the function `speedbar-add-ignored-path-regexp' too add a new
86;; regular expression matching a type of path. You may add list
87;; elements to `speedbar-ignored-path-expressions' as long as it is
88;; done before speedbar is loaded.
89;;
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
92;; etags supports, you need to modify the variable
93;; `speedbar-fetch-etags-parse-list'.
94;;
95;; If the updates are going too slow for you, modify the variable
96;; `speedbar-update-speed' to a longer idle time before updates.
97;;
98;; If you navigate directories, you will probably notice that you
99;; will navigate to a directory which is eventually replaced after
100;; you go back to editing a file (unless you pull up a new file.)
101;; The delay time before this happens is in
102;; `speedbar-navigating-speed', and defaults to 10 seconds.
103;;
104;; Users XEmacs previous to 20 may want to change the default
105;; timeouts for `speedbar-update-speed' to something longer as XEmacs
106;; doesn't have idle timers, the speedbar timer keeps going off
107;; arbitrarily while you're typing. It's quite pesky.
108;;
109;; Users of really old emacsen without the needed timers will not
110;; have speedbar updating automatically. Use "r" to refresh the
111;; display after changing directories. Remember, do not interrupt the
112;; stealthy updates or your display may not be completely refreshed.
113;;
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
119;; well. Use the imenu keywords from tex-mode.el for better results.
120;;
121;; This file requires the library package assoc (association lists)
122;; and the package custom (for easy configuration of speedbar)
123;; http://www.dina.kvl.dk/~abraham/custom/
124;;
125;; If you do not have custom installed, you can still get face colors
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;;
130;; emacs*speedbar-button-face.attributeForeground: Aquamarine
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;;
141
142;;; Change log:
143;; 0.1 Initial Revision
144;; 0.2 Fixed problem with x-pointer-shape causing future frames not
145;; to be created.
146;; Fixed annoying habit of `speedbar-update-contents' to make
147;; it possible to accidentally kill the speedbar buffer.
148;; Clicking directory names now only changes the contents of
149;; the speedbar, and does not cause a dired mode to appear.
150;; Clicking the <+> next to the directory does cause dired to
151;; be run.
152;; Added XEmacs support, which means timer support moved to a
153;; platform independant call.
154;; Added imenu support. Now modes are supported by imenu
155;; first, and etags only if the imenu call doesn't work.
156;; Imenu is a little faster than etags, and is more emacs
157;; friendly.
158;; Added more user control variables described in the commentary.
159;; Added smart recentering when nodes are opened and closed.
160;; 0.3 x-pointer-shape fixed for emacs 19.35, so I put that check in.
161;; Added invisible codes to the beginning of each line.
162;; Added list aproach to node expansion for easier addition of new
163;; types of things to expand by
164;; Added multi-level path name support
165;; Added multi-level tag name support.
166;; Only mouse-2 is now used for node expansion
167;; Added keys e + - to edit expand, and contract node lines
168;; Added longer legal file regexp for all those modes which support
169;; imenu. (pascal, fortran90, ada, pearl)
170;; Added pascal support to etags from Dave Penkler <dave_penkler@grenoble.hp.com>
171;; Fixed centering algorithm
172;; Tried to choose background independent colors. Made more robust.
173;; Rearranged code into a more logical order
174;; 0.3.1 Fixed doc & broken keybindings
175;; Added mode hooks.
176;; Improved color selection to be background mode smart
177;; `nil' passed to `speedbar-frame-mode' now toggles the frame as
178;; advertised in the doc string
179;; 0.4a Added modified patch from Dan Schmidt <dfan@lglass.com> allowing a
180;; directory cache to be maintained speeding up revisiting of files.
181;; Default raise-lower behavior is now off by default.
182;; Added some menu items for edit expand and contract.
183;; Pre 19.31 emacsen can run without idle timers.
184;; Added some patch information from Farzin Guilak <farzin@protocol.com>
185;; adding xemacs specifics, and some etags upgrades.
186;; Added ability to set a faces symbol-value to a string
187;; representing the desired foreground color. (idea from
188;; Farzin Guilak, but implemented differently)
189;; Fixed problem with 1 character buttons.
190;; Added support for new Imenu marker technique.
191;; Added `speedbar-load-hooks' for things to run only once on
192;; load such as updating one of the many lists.
193;; Added `speedbar-supported-extension-expressions' which is a
194;; list of extensions that speedbar will tag. This variable
195;; should only be updated with `speedbar-add-supported-extension'
196;; Moved configure dialog support to a separate file so
197;; speedbar is not dependant on eieio to run
198;; Fixed list-contraction problem when the item was at the end
199;; of a sublist.
200;; Fixed XEmacs multi-frame timer selecting bug problem.
201;; Added `speedbar-ignored-modes' which is a list of major modes
202;; speedbar will not follow when it is displayed in the selected frame
203;; 0.4 When the file being edited is not in the list, and is a file
204;; that should be in the list, the speedbar cache is replaced.
205;; Temp buffers are now shown in the attached frame not the
206;; speedbar frame
207;; New variables `speedbar-vc-*' and `speedbar-stealthy-function-list'
208;; added. `speedbar-update-current-file' is now a member of
209;; the stealthy list. New function `speedbar-check-vc' will
210;; examine each file and mark it if it is checked out. To
211;; add new version control types, override the function
212;; `speedbar-this-file-in-vc' and `speedbar-vc-check-dir-p'.
213;; The stealth list is interruptible so that long operations
214;; do not interrupt someones editing flow. Other long
215;; speedbar updates will be added to the stealthy list in the
216;; future should interesting ones be needed.
217;; Added many new functions including:
218;; `speedbar-item-byte-compile' `speedbar-item-load'
219;; `speedbar-item-copy' `speedbar-item-rename' `speedbar-item-delete'
220;; and `speedbar-item-info'
221;; If the user kills the speedbar buffer in some way, the frame will
222;; be removed.
223;; 0.4.1 Bug fixes
224;; <mark.jeffries@nomura.co.uk> added `speedbar-update-flag',
225;; XEmacs fixes for menus, and tag sorting, and quit key.
226;; Modeline now updates itself based on window-width.
227;; Frame is cached when closed to make pulling it up again faster.
228;; Speedbars window is now marked as dedicated.
229;; Added bindings: <grossjoh@charly.informatik.uni-dortmund.de>
230;; Long directories are now span multiple lines autmoatically
231;; Added `speedbar-directory-button-trim-method' to specify how to
232;; sorten the directory button to fit on the screen.
233;; 0.4.2 Add one level of full-text cache.
234;; Add `speedbar-get-focus' to switchto/raise the speedbar frame.
235;; Editing thing-on-line will auto-raise the attached frame.
236;; Bound `U' to `speedbar-up-directory' command.
237;; Refresh will now maintain all subdirectories that were open
238;; when the refresh was requested. (This does not include the
239;; tags, only the directories)
240;; 0.4.3 Bug fixes
241;; 0.4.4 Added `speedbar-ignored-path-expressions' and friends.
242;; Configuration menu items not displayed if dialog-mode not present
243;; Speedbar buffer now starts with a space, and is not deleted
244;; ewhen the speedbar frame is closed. This prevents the invisible
245;; frame from preventing buffer switches with other buffers.
246;; Fixed very bad bug in the -add-[extension|path] functions.
247;; Added `speedbar-find-file-in-frame' which will always pop up a frame
248;; that is already display a buffer selected in the speedbar buffer.
249;; Added S-mouse2 as "power click" for always poping up a new frame.
250;; and always rescanning with imenu (ditching the imenu cache), and
251;; always rescanning directories.
252;; 0.4.5 XEmacs bugfixes and enhancements.
253;; Window Title simplified.
254;; 0.4.6 Fixed problems w/ dedicated minibuffer frame.
255;; Fixed errors reported by checkdoc.
256;; 0.5 Mode-specific contents added. Controlled w/ the variable
257;; `speedbar-mode-specific-contents-flag'. See speedbspec
258;; for info on enabling this feature.
259;; `speedbar-load-hook' name change and pointer check against
260;; major-mode. Suggested by Sam Steingold <sds@ptc.com>
261;; Quit auto-selects the attached frame.
262;; Ranamed `speedbar-do-updates' to `speedbar-update-flag'
263;; Passes checkdoc.
264;; 0.5.1 Advice from ptype@dra.hmg.gb:
265;; Use `post-command-idle-hook' in older emacsen
266;; `speedbar-sort-tags' now works with imenu.
267;; Unknown files (marked w/ ?) can now be operated on w/
268;; file commands.
269;; `speedbar-vc-*-hook's for easilly adding new version control systems.
270;; Checkin/out w/ vc will reset the scanners and update the * marker.
271;; Fixed ange-ftp require compile time problem.
272;; Fixed XEmacs menu bar bug.
273;; Added `speedbar-activity-change-focus-flag' to control if the
274;; focus changes w/ mouse events.
275;; Added `speedbar-sort-tags' toggle to the menubar.
276;; Added `speedbar-smart-directory-expand-flag' to toggle how
277;; new directories might be inserted into the speedbar hierarchy.
278;; Added `speedbar-visiting-[tag|file]hook' which is called whenever
279;; speedbar pulls up a file or tag in the attached frame. Setting
280;; this to `reposition-window' will do nice things to function tags.
281;; Fixed text-cache default-directory bug.
282;; Emacs 20 char= support.
283;; 0.5.2 Customization
284;; For older emacsen, you will need to download the new defcustom
285;; package to get nice faces for speedbar
286;; mouse1 Double-click is now the same as middle click.
287;; No mouse pointer shape stuff for XEmacs (is there any?)
288;; 0.5.3 Regressive support for non-custom enabled emacsen.
289;; Fixed serious problem w/ 0.5.2 and ignored paths.
290;; `condition-case' no longer used in timer fcn.
291;; `speedbar-edit-line' is now smarter w/ special modes.
292;; 0.5.4 Fixed more problems for Emacs 20 so speedbar loads correctly.
293;; Updated some documentation strings.
294;; Added customization menu item, and customized some more variables.
295;; 0.5.5 Fixed so that there can be no ignored paths
296;; Added .l & .lsp as lisp, suggested by: sshteingold@cctrading.com
297;; You can now adjust height in `speedbar-frame-parameters'
298;; XEmacs fix for use of `local-variable-p'
299;; 0.5.6 Folded in XEmacs suggestions from Hrvoje Niksic <hniksic@srce.hr>
300;; Several custom changes (group definitions, trim-method & others)
301;; Keymap changes, and ways to add menu items.
302;; Timer use changes for XEmacs 20.4
303;; Regular expression enhancements.
304;; 0.6 Fixed up some frame definition stuff, use more convenience fns.
305;; Rehashed frame creation code for better compatibility.
306;; Fixed setting of kill-buffer hook.
307;; Default speedbar has no menubar, mouse-3 is popup menu,
308;; XEmacs double-click capability (Hrvoje Niksic <hniksic@srce.hr>)
309;; General documentation fixup.
310;; 0.6.1 Fixed button-3 menu for Emacs 20.
311;; 0.6.2 Added autoload tag to `speedbar-get-focus'
312
313;;; TODO:
314;; - 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.
317;; - Remeber tags when refreshing the display. (Refresh tags too?)
318;; - More 'special mode support.
319;; - C- Mouse 3 menu too much indirection
320
321(require 'assoc)
322(require 'easymenu)
323
324;; From custom web page for compatibility between versions of custom:
325(eval-and-compile
326 (condition-case ()
327 (require 'custom)
328 (error nil))
329 (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
330 nil ;; We've got what we needed
331 ;; We have the old custom-library, hack around it!
332 (defmacro defgroup (&rest args)
333 nil)
334 (defmacro defface (var values doc &rest args)
335 (` (progn
336 (defvar (, var) (quote (, var)))
337 ;; To make colors for your faces you need to set your .Xdefaults
338 ;; or set them up ahead of time in your .emacs file.
339 (make-face (, var))
340 )))
341 (defmacro defcustom (var value doc &rest args)
342 (` (defvar (, var) (, value) (, doc))))))
343
344;; customization stuff
345(defgroup speedbar nil
346 "File and tag browser frame."
347 :group 'tags
348 :group 'tools)
349
350(defgroup speedbar-faces nil
351 "Faces used in speedbar."
352 :prefix "speedbar-"
353 :group 'speedbar
354 :group 'faces)
355
356(defgroup speedbar-vc nil
357 "Version control display in speedbar."
358 :prefix "speedbar-"
359 :group 'speedbar)
360
361;;; Code:
362(defvar speedbar-xemacsp (string-match "XEmacs" emacs-version)
363 "Non-nil if we are running in the XEmacs environment.")
364(defvar speedbar-xemacs20p (and speedbar-xemacsp (= emacs-major-version 20)))
365
366(defvar speedbar-initial-expansion-list
367 '(speedbar-directory-buttons speedbar-default-directory-list)
368 "List of functions to call to fill in the speedbar buffer.
369Whenever a top level update is issued all functions in this list are
370run. These functions will always get the default directory to use
371passed in as the first parameter, and a 0 as the second parameter.
372The 0 indicates the uppermost indentation level. They must assume
373that the cursor is at the position where they start inserting
374buttons.")
375
376(defvar speedbar-stealthy-function-list
377 '(speedbar-update-current-file speedbar-check-vc)
378 "List of functions to periodically call stealthily.
379Each function must return nil if interrupted, or t if completed.
380Stealthy functions which have a single operation should always return
381t. Functions which take a long time should maintain a state (where
382they are in their speedbar related calculations) and permit
383interruption. See `speedbar-check-vc' as a good example.")
384
385(defcustom speedbar-mode-specific-contents-flag t
386 "*Non-nil means speedbar will show special mode contents.
387This permits some modes to create customized contents for the speedbar
388frame."
389 :group 'speedbar
390 :type 'boolean)
391
392(defvar speedbar-special-mode-expansion-list nil
393 "Mode specific list of functions to call to fill in speedbar.
394Some modes, such as Info or RMAIL, do not relate quite as easily into
395a simple list of files. When this variable is non-nil and buffer-local,
396then these functions are used, creating specialized contents. These
397functions are called each time the speedbar timer is called. This
398allows a mode to update its contents regularly.
399
400 Each function is called with the default and frame belonging to
401speedbar, and with one parameter; the buffer requesting
402the speedbar display.")
403
404(defcustom speedbar-visiting-file-hook nil
405 "Hooks run when speedbar visits a file in the selected frame."
406 :group 'speedbar
407 :type 'hook)
408
409(defcustom speedbar-visiting-tag-hook nil
410 "Hooks run when speedbar visits a tag in the selected frame."
411 :group 'speedbar
412 :type 'hook)
413
414(defcustom speedbar-load-hook nil
415 "Hooks run when speedbar is loaded."
416 :group 'speedbar
417 :type 'hook)
418
419(defcustom speedbar-show-unknown-files nil
420 "*Non-nil show files we can't expand with a ? in the expand button.
421nil means don't show the file in the list."
422 :group 'speedbar
423 :type 'boolean)
424
425(defcustom speedbar-update-speed
426 (if speedbar-xemacsp
427 (if speedbar-xemacs20p
428 2 ; 1 is too obrusive in XEmacs
429 5) ; when no idleness, need long delay
430 1)
431 "*Idle time in seconds needed before speedbar will update itself.
432Updates occur to allow speedbar to display directory information
433relevant to the buffer you are currently editing."
434 :group 'speedbar
435 :type 'integer)
436
437(defcustom speedbar-navigating-speed 10
438 "*Idle time to wait after navigation commands in speedbar are executed.
439Navigation commands included expanding/contracting nodes, and moving
440between different directories."
441 :group 'speedbar
442 :type 'integer)
443
444(defcustom speedbar-frame-parameters '((minibuffer . nil)
445 (width . 20)
446 (scroll-bar-width . 10)
447 (border-width . 0)
448 (menu-bar-lines . 0)
449 (unsplittable . t))
450 "*Parameters to use when creating the speedbar frame in Emacs.
451Parameters not listed here which will be added automatically are
452`height' which will be initialized to the height of the frame speedbar
453is attached to."
454 :group 'speedbar
455 :type '(repeat (sexp :tag "Parameter:")))
456
457;; These values by Hrvoje Niksic <hniksic@srce.hr>
458(defcustom speedbar-frame-plist
459 '(minibuffer nil width 20 border-width 0
460 internal-border-width 0 unsplittable t
461 default-toolbar-visible-p nil has-modeline-p nil
462 menubar-visible-p nil
463 ;; I don't see the particular value of these three, but...
464 text-pointer-glyph [cursor-font :data "top_left_arrow"]
465 nontext-pointer-glyph [cursor-font :data "top_left_arrow"]
466 selection-pointer-glyph [cursor-font :data "hand2"])
467 "*Parameters to use when creating the speedbar frame in XEmacs.
468Parameters not listed here which will be added automatically are
469`height' which will be initialized to the height of the frame speedbar
470is attached to."
471 :group 'speedbar
472 :type '(repeat (group :inline t
473 (symbol :tag "Property")
474 (sexp :tag "Value"))))
475
476(defcustom speedbar-use-imenu-flag (stringp (locate-library "imenu"))
477 "*Non-nil means use imenu for file parsing. nil to use etags.
478XEmacs prior to 20.4 doesn't support imenu, therefore the default is to
479use etags instead. Etags support is not as robust as imenu support."
480 :tag "User Imenu"
481 :group 'speedbar
482 :type 'boolean)
483
484(defcustom speedbar-sort-tags nil
485 "*If Non-nil, sort tags in the speedbar display."
486 :group 'speedbar
487 :type 'boolean)
488
489(defcustom speedbar-activity-change-focus-flag nil
490 "*Non-nil means the selected frame will change based on activity.
491Thus, if a file is selected for edit, the buffer will appear in the
492selected frame and the focus will change to that frame."
493 :group 'speedbar
494 :type 'boolean)
495
496(defcustom speedbar-directory-button-trim-method 'span
497 "*Indicates how the directory button will be displayed.
498Possible values are:
499 'span - span large directories over multiple lines.
500 'trim - trim large directories to only show the last few.
501 nil - no trimming."
502 :group 'speedbar
503 :type '(radio (const :tag "Span large directories over mutiple lines."
504 span)
505 (const :tag "Trim large directories to only show the last few."
506 trim)
507 (const :tag "No trimming." nil)))
508
509(defcustom speedbar-smart-directory-expand-flag t
510 "*Non-nil means speedbar should use smart expansion.
511Smart expansion only affects when speedbar wants to display a
512directory for a file in the attached frame. When smart expansion is
513enabled, new directories which are children of a displayed directory
514are expanded in the current framework. If nil, then the current
515hierarchy would be replaced with the new directory."
516 :group 'speedbar
517 :type 'boolean)
518
519(defcustom speedbar-before-popup-hook nil
520 "*Hooks called before popping up the speedbar frame."
521 :group 'speedbar
522 :type 'hook)
523
524(defcustom speedbar-before-delete-hook nil
525 "*Hooks called before deleting the speedbar frame."
526 :group 'speedbar
527 :type 'hook)
528
529(defcustom speedbar-mode-hook nil
530 "*Hooks called after creating a speedbar buffer."
531 :group 'speedbar
532 :type 'hook)
533
534(defcustom speedbar-timer-hook nil
535 "*Hooks called after running the speedbar timer function."
536 :group 'speedbar
537 :type 'hook)
538
539(defcustom speedbar-verbosity-level 1
540 "*Verbosity level of the speedbar. 0 means say nothing.
5411 means medium level verbosity. 2 and higher are higher levels of
542verbosity."
543 :group 'speedbar
544 :type 'integer)
545
546(defcustom speedbar-vc-do-check t
547 "*Non-nil check all files in speedbar to see if they have been checked out.
548Any file checked out is marked with `speedbar-vc-indicator'"
549 :group 'speedbar-vc
550 :type 'boolean)
551
552(defvar speedbar-vc-indicator " *"
553 "Text used to mark files which are currently checked out.
554Currently only RCS is supported. Other version control systems can be
555added by examining the function `speedbar-this-file-in-vc' and
556`speedbar-vc-check-dir-p'")
557
558(defcustom speedbar-scanner-reset-hook nil
559 "*Hook called whenever generic scanners are reset.
560Set this to implement your own scanning / rescan safe functions with
561state data."
562 :group 'speedbar
563 :type 'hook)
564
565(defcustom speedbar-vc-path-enable-hook nil
566 "*Return non-nil if the current path should be checked for Version Control.
567Functions in this hook must accept one parameter which is the path
568being checked."
569 :group 'speedbar-vc
570 :type 'hook)
571
572(defcustom speedbar-vc-in-control-hook nil
573 "*Return non-nil if the specified file is under Version Control.
574Functions in this hook must accept two parameters. The PATH of the
575current file, and the FILENAME of the file being checked."
576 :group 'speedbar-vc
577 :type 'hook)
578
579(defvar speedbar-vc-to-do-point nil
580 "Local variable maintaining the current version control check position.")
581
582(defvar speedbar-ignored-modes nil
583 "*List of major modes which speedbar will not switch directories for.")
584
585(defun speedbar-extension-list-to-regex (extlist)
586 "Takes EXTLIST, a list of extensions and transforms it into regexp.
587All the preceding . are stripped for an optimized expression starting
588with . followed by extensions, followed by full-filenames."
589 (let ((regex1 nil) (regex2 nil))
590 (while extlist
591 (if (= (string-to-char (car extlist)) ?.)
592 (setq regex1 (concat regex1 (if regex1 "\\|" "")
593 (substring (car extlist) 1)))
594 (setq regex2 (concat regex2 (if regex2 "\\|" "") (car extlist))))
595 (setq extlist (cdr extlist)))
596 ;; concat all the sub-exressions together, making sure all types
597 ;; of parts exist during concatination.
598 (concat "\\("
599 (if regex1 (concat "\\(\\.\\(" regex1 "\\)\\)") "")
600 (if (and regex1 regex2) "\\|" "")
601 (if regex2 (concat "\\(" regex2 "\\)") "")
602 "\\)$")))
603
604(defvar speedbar-ignored-path-regexp nil
605 "Regular expression matching paths speedbar will not switch to.
606Created from `speedbar-ignored-path-expressions' with the function
607`speedbar-extension-list-to-regex' (A misnamed function in this case.)
608Use the function `speedbar-add-ignored-path-regexp', or customize the
609variable `speedbar-ignored-path-expressions' to modify this variable.")
610
611(defcustom speedbar-ignored-path-expressions
612 '("/logs?/\\'")
613 "*List of regular expressions matching directories speedbar will ignore.
614They should included paths to directories which are notoriously very
615large and take a long time to load in. Use the function
616`speedbar-add-ignored-path-regexp' to add new items to this list after
617speedbar is loaded. You may place anything you like in this list
618before speedbar has been loaded."
619 :group 'speedbar
620 :type '(repeat (regexp :tag "Path Regexp"))
621 :set (lambda (sym val)
622 (setq speedbar-ignored-path-expressions val
623 speedbar-ignored-path-regexp
624 (speedbar-extension-list-to-regex val))))
625
626(defvar speedbar-file-unshown-regexp
627 (let ((nstr "") (noext completion-ignored-extensions))
628 (while noext
629 (setq nstr (concat nstr (regexp-quote (car noext)) "\\'"
630 (if (cdr noext) "\\|" ""))
631 noext (cdr noext)))
632 (concat nstr "\\|#[^#]+#$\\|\\.\\.?\\'"))
633 "*Regexp matching files we don't want displayed in a speedbar buffer.
634It is generated from the variable `completion-ignored-extensions'")
635
636;; this is dangerous to customize, because the defaults will probably
637;; change in the future.
638(defcustom speedbar-supported-extension-expressions
639 (append '(".[CcHh]\\(\\+\\+\\|pp\\|c\\|h\\)?" ".tex\\(i\\(nfo\\)?\\)?"
640 ".el" ".emacs" ".l" ".lsp" ".p" ".java")
641 (if speedbar-use-imenu-flag
642 '(".f90" ".ada" ".pl" ".tcl" ".m"
643 "Makefile\\(\\.in\\)?")))
644 "*List of regular expressions which will match files supported by tagging.
645Do not prefix the `.' char with a double \\ to quote it, as the period
646will be stripped by a simplified optimizer when compiled into a
647singular expression. This variable will be turned into
648`speedbar-file-regexp' for use with speedbar. You should use the
649function `speedbar-add-supported-extension' to add a new extension at
650runtime, or use the configuration dialog to set it in your .emacs
651file."
652 :group 'speedbar
653 :type '(repeat (regexp :tag "Extension Regexp"))
654 :set (lambda (sym val)
655 (setq speedbar-supported-extension-expressions val
656 speedbar-file-regexp (speedbar-extension-list-to-regex val)))
657 )
658
659(defvar speedbar-file-regexp
660 (speedbar-extension-list-to-regex speedbar-supported-extension-expressions)
661 "Regular expression matching files we know how to expand.
662Created from `speedbar-supported-extension-expression' with the
663function `speedbar-extension-list-to-regex'")
664
665(defun speedbar-add-supported-extension (extension)
666 "Add EXTENSION as a new supported extension for speedbar tagging.
667This should start with a `.' if it is not a complete file name, and
668the dot should NOT be quoted in with \\. Other regular expression
669matchers are allowed however. EXTENSION may be a single string or a
670list of strings."
671 (if (not (listp extension)) (setq extension (list extension)))
672 (while extension
673 (if (member (car extension) speedbar-supported-extension-expressions)
674 nil
675 (setq speedbar-supported-extension-expressions
676 (cons (car extension) speedbar-supported-extension-expressions)))
677 (setq extension (cdr extension)))
678 (setq speedbar-file-regexp (speedbar-extension-list-to-regex
679 speedbar-supported-extension-expressions)))
680
681(defun speedbar-add-ignored-path-regexp (path-expression)
682 "Add PATH-EXPRESSION as a new ignored path for speedbar tracking.
683This function will modify `speedbar-ignored-path-regexp' and add
684PATH-EXPRESSION to `speedbar-ignored-path-expressions'."
685 (if (not (listp path-expression))
686 (setq path-expression (list path-expression)))
687 (while path-expression
688 (if (member (car path-expression) speedbar-ignored-path-expressions)
689 nil
690 (setq speedbar-ignored-path-expressions
691 (cons (car path-expression) speedbar-ignored-path-expressions)))
692 (setq path-expression (cdr path-expression)))
693 (setq speedbar-ignored-path-regexp (speedbar-extension-list-to-regex
694 speedbar-ignored-path-expressions)))
695
696;; If we don't have custom, then we set it here by hand.
697(if (not (fboundp 'custom-declare-variable))
698 (setq speedbar-file-regexp (speedbar-extension-list-to-regex
699 speedbar-supported-extension-expressions)
700 speedbar-ignored-path-regexp (speedbar-extension-list-to-regex
701 speedbar-ignored-path-expressions)))
702
703(defvar speedbar-update-flag (or (fboundp 'run-with-idle-timer)
704 (fboundp 'start-itimer)
705 (boundp 'post-command-idle-hook))
706 "*Non-nil means to automatically update the display.
707When this is nil then speedbar will not follow the attached frame's path.
708When speedbar is active, use:
709
710\\<speedbar-key-map> `\\[speedbar-toggle-updates]'
711
712to toggle this value.")
713
714(defvar speedbar-syntax-table nil
715 "Syntax-table used on the speedbar.")
716
717(if speedbar-syntax-table
718 nil
719 (setq speedbar-syntax-table (make-syntax-table))
720 ;; turn off paren matching around here.
721 (modify-syntax-entry ?\' " " speedbar-syntax-table)
722 (modify-syntax-entry ?\" " " speedbar-syntax-table)
723 (modify-syntax-entry ?( " " speedbar-syntax-table)
724 (modify-syntax-entry ?) " " speedbar-syntax-table)
725 (modify-syntax-entry ?[ " " speedbar-syntax-table)
726 (modify-syntax-entry ?] " " speedbar-syntax-table))
727
728
729(defvar speedbar-key-map nil
730 "Keymap used in speedbar buffer.")
731
732(if speedbar-key-map
733 nil
734 (setq speedbar-key-map (make-keymap))
735 (suppress-keymap speedbar-key-map t)
736
737 ;; control
738 (define-key speedbar-key-map "e" 'speedbar-edit-line)
739 (define-key speedbar-key-map "\C-m" 'speedbar-edit-line)
740 (define-key speedbar-key-map "+" 'speedbar-expand-line)
741 (define-key speedbar-key-map "-" 'speedbar-contract-line)
742 (define-key speedbar-key-map "g" 'speedbar-refresh)
743 (define-key speedbar-key-map "t" 'speedbar-toggle-updates)
744 (define-key speedbar-key-map "q" 'speedbar-close-frame)
745 (define-key speedbar-key-map "U" 'speedbar-up-directory)
746
747 ;; navigation
748 (define-key speedbar-key-map "n" 'speedbar-next)
749 (define-key speedbar-key-map "p" 'speedbar-prev)
750 (define-key speedbar-key-map " " 'speedbar-scroll-up)
751 (define-key speedbar-key-map [delete] 'speedbar-scroll-down)
752
753 ;; After much use, I suddenly desired in my heart to perform dired
754 ;; style operations since the directory was RIGHT THERE!
755 (define-key speedbar-key-map "I" 'speedbar-item-info)
756 (define-key speedbar-key-map "B" 'speedbar-item-byte-compile)
757 (define-key speedbar-key-map "L" 'speedbar-item-load)
758 (define-key speedbar-key-map "C" 'speedbar-item-copy)
759 (define-key speedbar-key-map "D" 'speedbar-item-delete)
760 (define-key speedbar-key-map "R" 'speedbar-item-rename)
761
762 (if speedbar-xemacsp
763 (progn
764 ;; mouse bindings so we can manipulate the items on each line
765 (define-key speedbar-key-map 'button2 'speedbar-click)
766 (define-key speedbar-key-map '(shift button2) 'speedbar-power-click)
767 (define-key speedbar-key-map 'button3 'speedbar-xemacs-popup-kludge)
768 (define-key speedbar-key-map '(meta button3) 'speedbar-mouse-item-info))
769 ;; mouse bindings so we can manipulate the items on each line
770 (define-key speedbar-key-map [down-mouse-1] 'speedbar-double-click)
771 (define-key speedbar-key-map [mouse-2] 'speedbar-click)
772 ;; This is the power click for new frames, or refreshing a cache
773 (define-key speedbar-key-map [S-mouse-2] 'speedbar-power-click)
774 ;; This adds a small unecessary visual effect
775 ;;(define-key speedbar-key-map [down-mouse-2] 'speedbar-quick-mouse)
776 (define-key speedbar-key-map [M-mouse-2] 'speedbar-mouse-item-info)
777
778 (define-key speedbar-key-map [down-mouse-3] 'speedbar-emacs-popup-kludge)
779
780 ;;***** Disable disabling: Remove menubar completely.
781 ;; disable all menus - we don't have a lot of space to play with
782 ;; in such a skinny frame. This will cleverly find and nuke some
783 ;; user-defined menus as well if they are there. Too bad it
784 ;; rely's on the structure of a keymap to work.
785; (let ((k (lookup-key global-map [menu-bar])))
786; (while k
787; (if (and (listp (car k)) (listp (cdr (car k))))
788; (define-key speedbar-key-map (vector 'menu-bar (car (car k)))
789; 'undefined))
790; (setq k (cdr k))))
791
792 ;; This lets the user scroll as if we had a scrollbar... well maybe not
793 (define-key speedbar-key-map [mode-line mouse-2] 'speedbar-mouse-hscroll)
794 ))
795
796(defvar speedbar-easymenu-definition-base
797 '("Speedbar"
798 ["Update" speedbar-refresh t]
799 ["Auto Update" speedbar-toggle-updates
800 :style toggle :selected speedbar-update-flag]
801 )
802 "Base part of the speedbar menu.")
803
804(defvar speedbar-easymenu-definition-special
805 '(["Edit Item On Line" speedbar-edit-line t]
806 ["Show All Files" speedbar-toggle-show-all-files
807 :style toggle :selected speedbar-show-unknown-files]
808 ["Expand Item" speedbar-expand-line
809 (save-excursion (beginning-of-line)
810 (looking-at "[0-9]+: *.\\+. "))]
811 ["Contract Item" speedbar-contract-line
812 (save-excursion (beginning-of-line)
813 (looking-at "[0-9]+: *.-. "))]
814 ["Sort Tags" speedbar-toggle-sorting
815 :style toggle :selected speedbar-sort-tags]
816 "----"
817 ["Item Information" speedbar-item-info t]
818 ["Load Lisp File" speedbar-item-load
819 (save-excursion
820 (beginning-of-line)
821 (looking-at "[0-9]+: *\\[[+-]\\] .+\\(\\.el\\)\\( \\*\\)?$"))]
822 ["Byte Compile File" speedbar-item-byte-compile
823 (save-excursion
824 (beginning-of-line)
825 (looking-at "[0-9]+: *\\[[+-]\\] .+\\(\\.el\\)\\( \\*\\)?$"))]
826 ["Copy Item" speedbar-item-copy
827 (save-excursion (beginning-of-line) (looking-at "[0-9]+: *\\["))]
828 ["Rename Item" speedbar-item-rename
829 (save-excursion (beginning-of-line) (looking-at "[0-9]+: *[[<]"))]
830 ["Delete Item" speedbar-item-delete
831 (save-excursion (beginning-of-line) (looking-at "[0-9]+: *[[<]"))])
832 "Additional menu items while in file-mode.")
833
834(defvar speedbar-easymenu-definition-trailer
835 (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
836 '("----"
837 ["Customize..." speedbar-customize t]
838 ["Close" speedbar-close-frame t])
839 '("----"
840 ["Close" speedbar-close-frame t]))
841 "Menu items appearing at the end of the speedbar menu.")
842
843(defvar speedbar-desired-buffer nil
844 "Non-nil when speedbar is showing buttons specific a special mode.
845In this case it is the originating buffer.")
846(defvar speedbar-buffer nil
847 "The buffer displaying the speedbar.")
848(defvar speedbar-frame nil
849 "The frame displaying speedbar.")
850(defvar speedbar-cached-frame nil
851 "The frame that was last created, then removed from the display.")
852(defvar speedbar-full-text-cache nil
853 "The last open directory is saved in its entirety for ultra-fast switching.")
854(defvar speedbar-timer nil
855 "The speedbar timer used for updating the buffer.")
856(defvar speedbar-attached-frame nil
857 "The frame which started speedbar mode.
858This is the frame from which all data displayed in the speedbar is
859gathered, and in which files and such are displayed.")
860
861(defvar speedbar-last-selected-file nil
862 "The last file which was selected in speedbar buffer.")
863
864(defvar speedbar-shown-directories nil
865 "Maintain list of directories simultaneously open in the current speedbar.")
866
867(defvar speedbar-directory-contents-alist nil
868 "An association list of directories and their contents.
869Each sublist was returned by `speedbar-file-lists'. This list is
870maintained to speed up the refresh rate when switching between
871directories.")
872
873(defvar speedbar-power-click nil
874 "Never set this by hand. Value is t when S-mouse activity occurs.")
875
876
877;;; Mode definitions/ user commands
878;;
879
880;;;###autoload
881(defalias 'speedbar 'speedbar-frame-mode)
882;;;###autoload
883(defun speedbar-frame-mode (&optional arg)
884 "Enable or disable speedbar. Positive ARG means turn on, negative turn off.
885nil means toggle. Once the speedbar frame is activated, a buffer in
886`speedbar-mode' will be displayed. Currently, only one speedbar is
887supported at a time.
888`speedbar-before-popup-hook' is called before popping up the speedbar frame.
889`speedbar-before-delete-hook' is called before the frame is deleted."
890 (interactive "P")
891 (if (if (and speedbar-xemacsp (fboundp 'console-on-window-system-p))
892 (not (console-on-window-system-p))
893 (not (symbol-value 'window-system)))
894 (error "Speedbar is not useful outside of a windowing environment"))
895;;; RMS says this should not modify the menu.
896; (if speedbar-xemacsp
897; (add-menu-button '("Tools")
898; ["Speedbar" speedbar-frame-mode
899; :style toggle
900; :selected (and (boundp 'speedbar-frame)
901; (frame-live-p speedbar-frame)
902; (frame-visible-p speedbar-frame))]
903; "--")
904; (define-key-after (lookup-key global-map [menu-bar tools])
905; [speedbar] '("Speedbar" . speedbar-frame-mode) [calendar]))
906 ;; toggle frame on and off.
907 (if (not arg) (if (and (frame-live-p speedbar-frame)
908 (frame-visible-p speedbar-frame))
909 (setq arg -1) (setq arg 1)))
910 ;; turn the frame off on neg number
911 (if (and (numberp arg) (< arg 0))
912 (progn
913 (run-hooks 'speedbar-before-delete-hook)
914 (if (and speedbar-frame (frame-live-p speedbar-frame))
915 (progn
916 (setq speedbar-cached-frame speedbar-frame)
917 (make-frame-invisible speedbar-frame)))
918 (setq speedbar-frame nil)
919 (speedbar-set-timer nil)
920 ;; Used to delete the buffer. This has the annoying affect of
921 ;; preventing whatever took its place from ever appearing
922 ;; as the default after a C-x b was typed
923 ;;(if (bufferp speedbar-buffer)
924 ;; (kill-buffer speedbar-buffer))
925 )
926 ;; Set this as our currently attached frame
927 (setq speedbar-attached-frame (selected-frame))
928 (run-hooks 'speedbar-before-popup-hook)
929 ;; Get the frame to work in
930 (if (frame-live-p speedbar-cached-frame)
931 (progn
932 (setq speedbar-frame speedbar-cached-frame)
933 (make-frame-visible speedbar-frame)
934 ;; Get the buffer to play with
935 (speedbar-mode)
936 (select-frame speedbar-frame)
937 (if (not (eq (current-buffer) speedbar-buffer))
938 (switch-to-buffer speedbar-buffer))
939 (set-window-dedicated-p (selected-window) t)
940 (raise-frame speedbar-frame)
941 (speedbar-set-timer speedbar-update-speed)
942 )
943 (if (frame-live-p speedbar-frame)
944 (raise-frame speedbar-frame)
945 (setq speedbar-frame
946 (if speedbar-xemacsp
947 (make-frame (nconc (list 'height
948 (speedbar-needed-height))
949 speedbar-frame-plist))
950 (let* ((mh (cdr (assoc 'menu-bar-lines (frame-parameters))))
951 (params (append speedbar-frame-parameters
952 (list (cons
953 'height
954 (if speedbar-xemacsp
955 (speedbar-needed-height)
956 (+ mh (frame-height))))))))
957 (if (< emacs-major-version 20);;a bug is fixed in v20 & later
958 (make-frame params)
959 (let ((x-pointer-shape x-pointer-top-left-arrow)
960 (x-sensitive-text-pointer-shape x-pointer-hand2))
961 (make-frame params))))))
962 ;; reset the selection variable
963 (setq speedbar-last-selected-file nil)
964 ;; Put the buffer into the frame
965 (save-window-excursion
966 ;; Get the buffer to play with
967 (speedbar-mode)
968 (select-frame speedbar-frame)
969 (switch-to-buffer speedbar-buffer)
970 (set-window-dedicated-p (selected-window) t))
971 (speedbar-set-timer speedbar-update-speed)))))
972
973;;;###autoload
974(defun speedbar-get-focus ()
975 "Change frame focus to or from the speedbar frame.
976If the selected frame is not speedbar, then speedbar frame is
977selected. If the speedbar frame is active, then select the attached frame."
978 (interactive)
979 (if (eq (selected-frame) speedbar-frame)
980 (if (frame-live-p speedbar-attached-frame)
981 (select-frame speedbar-attached-frame))
982 ;; make sure we have a frame
983 (if (not (frame-live-p speedbar-frame)) (speedbar-frame-mode 1))
984 ;; go there
985 (select-frame speedbar-frame))
986 (other-frame 0))
987
988(defun speedbar-close-frame ()
989 "Turn off a currently active speedbar."
990 (interactive)
991 (speedbar-frame-mode -1)
992 (select-frame speedbar-attached-frame)
993 (other-frame 0))
994
995(defmacro speedbar-frame-width ()
996 "Return the width of the speedbar frame in characters.
997nil if it doesn't exist."
998 '(frame-width speedbar-frame))
999
1000;; XEmacs function only.
1001(defun speedbar-needed-height (&optional frame)
1002 "The needed height for the tool bar FRAME (in characters)."
1003 (or frame (setq frame (selected-frame)))
1004 ;; The 1 is the missing modeline/minibuffer
1005 (+ 1 (/ (frame-pixel-height frame)
1006 (face-height 'default frame))))
1007
1008(defun speedbar-mode ()
1009 "Major mode for managing a display of directories and tags.
1010\\<speedbar-key-map>
1011The first line represents the default path of the speedbar frame.
1012Each directory segment is a button which jumps speedbar's default
1013directory to that path. Buttons are activated by clicking `\\[speedbar-click]'.
1014In some situations using `\\[speedbar-power-click]' is a `power click' which will
1015rescan cached items, or pop up new frames.
1016
1017Each line starting with <+> represents a directory. Click on the <+>
1018to insert the directory listing into the current tree. Click on the
1019<-> to retract that list. Click on the directory name to go to that
1020directory as the default.
1021
1022Each line starting with [+] is a file. If the variable
1023`speedbar-show-unknown-files' is t, the lines starting with [?] are
1024files which don't have imenu support, but are not expressly ignored.
1025Files are completely ignored if they match `speedbar-file-unshown-regexp'
1026which is generated from `completion-ignored-extensions'.
1027
1028Files with a `*' character after their name are files checked out of a
1029version control system. (currently only RCS is supported.) New
1030version control systems can be added by examining the documentation
1031for `speedbar-this-file-in-vc' and `speedbar-vc-check-dir-p'
1032
1033Click on the [+] to display a list of tags from that file. Click on
1034the [-] to retract the list. Click on the file name to edit the file
1035in the attached frame.
1036
1037If you open tags, you might find a node starting with {+}, which is a
1038category of tags. Click the {+} to expand the category. Jump-able
1039tags start with >. Click the name of the tag to go to that position
1040in the selected file.
1041
1042\\{speedbar-key-map}"
1043 ;; NOT interactive
1044 (save-excursion
1045 (setq speedbar-buffer (set-buffer (get-buffer-create " SPEEDBAR")))
1046 (kill-all-local-variables)
1047 (setq major-mode 'speedbar-mode)
1048 (setq mode-name "Speedbar")
1049 (use-local-map speedbar-key-map)
1050 (set-syntax-table speedbar-syntax-table)
1051 (setq font-lock-keywords nil) ;; no font-locking please
1052 (setq truncate-lines t)
1053 (make-local-variable 'frame-title-format)
1054 (setq frame-title-format "Speedbar")
1055 ;; Set this up special just for the speedbar buffer
1056 (if (null default-minibuffer-frame)
1057 (progn
1058 (make-local-variable 'default-minibuffer-frame)
1059 (setq default-minibuffer-frame speedbar-attached-frame)))
1060 (make-local-variable 'temp-buffer-show-function)
1061 (setq temp-buffer-show-function 'speedbar-temp-buffer-show-function)
1062 (if speedbar-xemacsp
1063 (progn
1064 ;; Argh! mouse-track-click-hook doesn't understand the
1065 ;; make-local-hook conventions.
1066 (make-local-variable 'mouse-track-click-hook)
1067 (add-hook 'mouse-track-click-hook
1068 (lambda (event count)
1069 (if (/= (event-button event) 1)
1070 nil ; Do normal operations.
1071 (cond ((eq count 1)
1072 (speedbar-quick-mouse event))
1073 ((or (eq count 2)
1074 (eq count 3))
1075 (mouse-set-point event)
1076 (speedbar-do-function-pointer)
1077 (speedbar-quick-mouse event)))
1078 ;; Don't do normal operations.
1079 t)))))
1080 (make-local-hook 'kill-buffer-hook)
1081 (add-hook 'kill-buffer-hook (lambda () (let ((skilling (boundp 'skilling)))
1082 (if skilling
1083 nil
1084 (if (eq (current-buffer)
1085 speedbar-buffer)
1086 (speedbar-frame-mode -1)))))
1087 t t)
1088 (speedbar-set-mode-line-format)
1089 (if (not speedbar-xemacsp)
1090 (setq auto-show-mode nil)) ;no auto-show for Emacs
1091 (run-hooks 'speedbar-mode-hook))
1092 (speedbar-update-contents)
1093 speedbar-buffer)
1094
1095(defun speedbar-set-mode-line-format ()
1096 "Set the format of the mode line based on the current speedbar environment.
1097This gives visual indications of what is up. It EXPECTS the speedbar
1098frame and window to be the currently active frame and window."
1099 (if (and (frame-live-p speedbar-frame)
1100 (or (not speedbar-xemacsp)
1101 (specifier-instance has-modeline-p)))
1102 (save-excursion
1103 (set-buffer speedbar-buffer)
1104 (let* ((w (or (speedbar-frame-width) 20))
1105 (p1 "<<")
1106 (p5 ">>")
1107 (p3 (if speedbar-update-flag "SPEEDBAR" "SLOWBAR"))
1108 (blank (- w (length p1) (length p3) (length p5)
1109 (if line-number-mode 4 0)))
1110 (p2 (if (> blank 0)
1111 (make-string (/ blank 2) ? )
1112 ""))
1113 (p4 (if (> blank 0)
1114 (make-string (+ (/ blank 2) (% blank 2)) ? )
1115 ""))
1116 (tf
1117 (if line-number-mode
1118 (list (concat p1 p2 p3) '(line-number-mode " %3l")
1119 (concat p4 p5))
1120 (list (concat p1 p2 p3 p4 p5)))))
1121 (if (not (equal mode-line-format tf))
1122 (progn
1123 (setq mode-line-format tf)
1124 (force-mode-line-update)))))))
1125
1126(defun speedbar-temp-buffer-show-function (buffer)
1127 "Placed in the variable `temp-buffer-show-function' in `speedbar-mode'.
1128If a user requests help using \\[help-command] <Key> the temp BUFFER will be
1129redirected into a window on the attached frame."
1130 (if speedbar-attached-frame (select-frame speedbar-attached-frame))
1131 (pop-to-buffer buffer nil)
1132 (other-window -1)
1133 (run-hooks 'temp-buffer-show-hook))
1134
1135(defun speedbar-reconfigure-menubar ()
1136 "Reconfigure the menu-bar in a speedbar frame.
1137Different menu items are displayed depending on the current display mode
1138and the existence of packages."
1139 (let ((md (append speedbar-easymenu-definition-base
1140 (if speedbar-shown-directories
1141 ;; file display mode version
1142 speedbar-easymenu-definition-special
1143 (save-excursion
1144 (select-frame speedbar-attached-frame)
1145 (if (local-variable-p
1146 'speedbar-easymenu-definition-special
1147 (current-buffer))
1148 ;; If bound locally, we can use it
1149 speedbar-easymenu-definition-special)))
1150 ;; The trailer
1151 speedbar-easymenu-definition-trailer)))
1152 (easy-menu-define speedbar-menu-map speedbar-key-map "Speedbar menu" md)
1153 (if speedbar-xemacsp
1154 (save-excursion
1155 (set-buffer speedbar-buffer)
1156 ;; For the benefit of button3
1157 (if (and (not (assoc "Speedbar" mode-popup-menu)))
1158 (easy-menu-add md))
1159 (set-buffer-menubar (list md)))
1160 (easy-menu-add md))))
1161
1162
1163;;; User Input stuff
1164;;
1165
1166;; XEmacs: this can be implemented using modeline keymaps, but there
1167;; is no use, as we have horizontal scrollbar (as the docstring
1168;; hints.)
1169(defun speedbar-mouse-hscroll (e)
1170 "Read a mouse event E from the mode line, and horizontally scroll.
1171If the mouse is being clicked on the far left, or far right of the
1172mode-line. This is only useful for non-XEmacs"
1173 (interactive "e")
1174 (let* ((xp (car (nth 2 (car (cdr e)))))
1175 (cpw (/ (frame-pixel-width)
1176 (frame-width)))
1177 (oc (1+ (/ xp cpw)))
1178 )
1179 (cond ((< oc 3)
1180 (scroll-left 2))
1181 ((> oc (- (window-width) 3))
1182 (scroll-right 2))
1183 (t (message "Click on the edge of the modeline to scroll left/right")))
1184 ;;(message "X: Pixel %d Char Pixels %d On char %d" xp cpw oc)
1185 ))
1186
1187(defun speedbar-customize ()
1188 "Customize speedbar using the Custom package."
1189 (interactive)
1190 (let ((sf (selected-frame)))
1191 (select-frame speedbar-attached-frame)
1192 (customize-group 'speedbar)
1193 (select-frame sf))
1194 (speedbar-maybee-jump-to-attached-frame))
1195
1196;; In XEmacs, we make popup menus work on the item over mouse (as
1197;; opposed to where the point happens to be.) We attain this by
1198;; temporarily moving the point to that place.
1199;; Hrvoje Niksic <hniksic@srce.hr>
1200(defun speedbar-xemacs-popup-kludge (event)
1201 "Pop up a menu related to the clicked on item.
1202Must be bound to EVENT."
1203 (interactive "e")
1204 (save-excursion
1205 (goto-char (event-closest-point event))
1206 (beginning-of-line)
1207 (forward-char (min 5 (- (save-excursion (end-of-line) (point))
1208 (save-excursion (beginning-of-line) (point)))))
1209 (popup-mode-menu)
1210 ;; Wait for menu to bail out. `popup-mode-menu' (and other popup
1211 ;; menu functions) return immediately.
1212 (let (new)
1213 (while (not (misc-user-event-p (setq new (next-event))))
1214 (dispatch-event new))
1215 (dispatch-event new))))
1216
1217(defun speedbar-emacs-popup-kludge (e)
1218 "Pop up a menu related to the clicked on item.
1219Must be bound to event E."
1220 (interactive "e")
1221 (save-excursion
1222 (mouse-set-point e)
1223 ;; This gets the cursor where the user can see it.
1224 (if (not (bolp)) (forward-char -1))
1225 (sit-for 0)
1226 (if (< emacs-major-version 20)
1227 (mouse-major-mode-menu e)
1228 (mouse-major-mode-menu e nil))))
1229
1230(defun speedbar-next (arg)
1231 "Move to the next ARGth line in a speedbar buffer."
1232 (interactive "p")
1233 (forward-line (or arg 1))
1234 (speedbar-item-info)
1235 (speedbar-position-cursor-on-line))
1236
1237(defun speedbar-prev (arg)
1238 "Move to the previous ARGth line in a speedbar buffer."
1239 (interactive "p")
1240 (speedbar-next (if arg (- arg) -1)))
1241
1242(defun speedbar-scroll-up (&optional arg)
1243 "Page down one screen-full of the speedbar, or ARG lines."
1244 (interactive "P")
1245 (scroll-up arg)
1246 (speedbar-position-cursor-on-line))
1247
1248(defun speedbar-scroll-down (&optional arg)
1249 "Page up one screen-full of the speedbar, or ARG lines."
1250 (interactive "P")
1251 (scroll-down arg)
1252 (speedbar-position-cursor-on-line))
1253
1254(defun speedbar-up-directory ()
1255 "Keyboard accelerator for moving the default directory up one.
1256Assumes that the current buffer is the speedbar buffer"
1257 (interactive)
1258 (setq default-directory (expand-file-name (concat default-directory "../")))
1259 (speedbar-update-contents))
1260
1261;;; Speedbar file activity (aka creeping featurism)
1262;;
1263(defun speedbar-refresh ()
1264 "Refresh the current speedbar display, disposing of any cached data."
1265 (interactive)
1266 (let ((dl speedbar-shown-directories))
1267 (while dl
1268 (adelete 'speedbar-directory-contents-alist (car dl))
1269 (setq dl (cdr dl))))
1270 (if (<= 1 speedbar-verbosity-level) (message "Refreshing speedbar..."))
1271 (speedbar-update-contents)
1272 (speedbar-stealthy-updates)
1273 ;; Reset the timer in case it got really hosed for some reason...
1274 (speedbar-set-timer speedbar-update-speed)
1275 (if (<= 1 speedbar-verbosity-level) (message "Refreshing speedbar...done")))
1276
1277(defun speedbar-item-load ()
1278 "Load the item under the cursor or mouse if it is a lisp file."
1279 (interactive)
1280 (let ((f (speedbar-line-file)))
1281 (if (and (file-exists-p f) (string-match "\\.el\\'" f))
1282 (if (and (file-exists-p (concat f "c"))
1283 (y-or-n-p (format "Load %sc? " f)))
1284 ;; If the compiled version exists, load that instead...
1285 (load-file (concat f "c"))
1286 (load-file f))
1287 (error "Not a loadable file..."))))
1288
1289(defun speedbar-item-byte-compile ()
1290 "Byte compile the item under the cursor or mouse if it is a lisp file."
1291 (interactive)
1292 (let ((f (speedbar-line-file))
1293 (sf (selected-frame)))
1294 (if (and (file-exists-p f) (string-match "\\.el\\'" f))
1295 (progn
1296 (select-frame speedbar-attached-frame)
1297 (byte-compile-file f nil)
1298 (select-frame sf)))
1299 ))
1300
1301(defun speedbar-mouse-item-info (event)
1302 "Provide information about what the user clicked on.
1303This should be bound to a mouse EVENT."
1304 (interactive "e")
1305 (mouse-set-point event)
1306 (speedbar-item-info))
1307
1308(defun speedbar-item-info ()
1309 "Display info in the mini-buffer about the button the mouse is over."
1310 (interactive)
1311 (if (not speedbar-shown-directories)
1312 nil
1313 (let* ((item (speedbar-line-file))
1314 (attr (if item (file-attributes item) nil)))
1315 (if item (message "%s %d %s" (nth 8 attr) (nth 7 attr) item)
1316 (save-excursion
1317 (beginning-of-line)
1318 (looking-at "\\([0-9]+\\):")
1319 (setq item (speedbar-line-path (string-to-int (match-string 1))))
1320 (if (re-search-forward "> \\([^ ]+\\)$"
1321 (save-excursion(end-of-line)(point)) t)
1322 (progn
1323 (setq attr (get-text-property (match-beginning 1)
1324 'speedbar-token))
1325 (message "Tag %s in %s at position %s"
1326 (match-string 1) item (if attr attr 0)))
1327 (message "No special info for this line.")))
1328 ))))
1329
1330(defun speedbar-item-copy ()
1331 "Copy the item under the cursor.
1332Files can be copied to new names or places."
1333 (interactive)
1334 (let ((f (speedbar-line-file)))
1335 (if (not f) (error "Not a file."))
1336 (if (file-directory-p f)
1337 (error "Cannot copy directory.")
1338 (let* ((rt (read-file-name (format "Copy %s to: "
1339 (file-name-nondirectory f))
1340 (file-name-directory f)))
1341 (refresh (member (expand-file-name (file-name-directory rt))
1342 speedbar-shown-directories)))
1343 ;; Create the right file name part
1344 (if (file-directory-p rt)
1345 (setq rt
1346 (concat (expand-file-name rt)
1347 (if (string-match "/$" rt) "" "/")
1348 (file-name-nondirectory f))))
1349 (if (or (not (file-exists-p rt))
1350 (y-or-n-p (format "Overwrite %s with %s? " rt f)))
1351 (progn
1352 (copy-file f rt t t)
1353 ;; refresh display if the new place is currently displayed.
1354 (if refresh
1355 (progn
1356 (speedbar-refresh)
1357 (if (not (speedbar-goto-this-file rt))
1358 (speedbar-goto-this-file f))))
1359 ))))))
1360
1361(defun speedbar-item-rename ()
1362 "Rename the item under the cursor or mouse.
1363Files can be renamed to new names or moved to new directories."
1364 (interactive)
1365 (let ((f (speedbar-line-file)))
1366 (if f
1367 (let* ((rt (read-file-name (format "Rename %s to: "
1368 (file-name-nondirectory f))
1369 (file-name-directory f)))
1370 (refresh (member (expand-file-name (file-name-directory rt))
1371 speedbar-shown-directories)))
1372 ;; Create the right file name part
1373 (if (file-directory-p rt)
1374 (setq rt
1375 (concat (expand-file-name rt)
1376 (if (string-match "/\\'" rt) "" "/")
1377 (file-name-nondirectory f))))
1378 (if (or (not (file-exists-p rt))
1379 (y-or-n-p (format "Overwrite %s with %s? " rt f)))
1380 (progn
1381 (rename-file f rt t)
1382 ;; refresh display if the new place is currently displayed.
1383 (if refresh
1384 (progn
1385 (speedbar-refresh)
1386 (speedbar-goto-this-file rt)
1387 )))))
1388 (error "Not a file."))))
1389
1390(defun speedbar-item-delete ()
1391 "Delete the item under the cursor. Files are removed from disk."
1392 (interactive)
1393 (let ((f (speedbar-line-file)))
1394 (if (not f) (error "Not a file."))
1395 (if (y-or-n-p (format "Delete %s? " f))
1396 (progn
1397 (if (file-directory-p f)
1398 (delete-directory f)
1399 (delete-file f))
1400 (message "Okie dokie..")
1401 (let ((p (point)))
1402 (speedbar-refresh)
1403 (goto-char p))
1404 ))
1405 ))
1406
1407(defun speedbar-enable-update ()
1408 "Enable automatic updating in speedbar via timers."
1409 (interactive)
1410 (setq speedbar-update-flag t)
1411 (speedbar-set-mode-line-format)
1412 (speedbar-set-timer speedbar-update-speed))
1413
1414(defun speedbar-disable-update ()
1415 "Disable automatic updating and stop consuming resources."
1416 (interactive)
1417 (setq speedbar-update-flag nil)
1418 (speedbar-set-mode-line-format)
1419 (speedbar-set-timer nil))
1420
1421(defun speedbar-toggle-updates ()
1422 "Toggle automatic update for the speedbar frame."
1423 (interactive)
1424 (if speedbar-update-flag
1425 (speedbar-disable-update)
1426 (speedbar-enable-update)))
1427
1428(defun speedbar-toggle-sorting ()
1429 "Toggle automatic update for the speedbar frame."
1430 (interactive)
1431 (setq speedbar-sort-tags (not speedbar-sort-tags)))
1432
1433(defun speedbar-toggle-show-all-files ()
1434 "Toggle display of files speedbar can not tag."
1435 (interactive)
1436 (setq speedbar-show-unknown-files (not speedbar-show-unknown-files))
1437 (speedbar-refresh))
1438
1439;;; Utility functions
1440;;
1441(defun speedbar-set-timer (timeout)
1442 "Apply a timer with TIMEOUT, or remove a timer if TIMOUT is nil.
1443TIMEOUT is the number of seconds until the speedbar timer is called
1444again. When TIMEOUT is nil, turn off all timeouts.
1445This function will also enable or disable the `vc-checkin-hook' used
1446to track file check ins, and will change the mode line to match
1447`speedbar-update-flag'."
1448 (cond
1449 ;; XEmacs
1450 (speedbar-xemacsp
1451 (if speedbar-timer
1452 (progn (delete-itimer speedbar-timer)
1453 (setq speedbar-timer nil)))
1454 (if timeout
1455 (if (and speedbar-xemacsp
1456 (or (>= emacs-major-version 20)
1457 (>= emacs-minor-version 15)))
1458 (setq speedbar-timer (start-itimer "speedbar"
1459 'speedbar-timer-fn
1460 timeout
1461 timeout
1462 t))
1463 (setq speedbar-timer (start-itimer "speedbar"
1464 'speedbar-timer-fn
1465 timeout
1466 nil)))))
1467 ;; Post 19.31 Emacs
1468 ((fboundp 'run-with-idle-timer)
1469 (if speedbar-timer
1470 (progn (cancel-timer speedbar-timer)
1471 (setq speedbar-timer nil)))
1472 (if timeout
1473 (setq speedbar-timer
1474 (run-with-idle-timer timeout t 'speedbar-timer-fn))))
1475 ;; Emacs 19.30 (Thanks twice: ptype@dra.hmg.gb)
1476 ((fboundp 'post-command-idle-hook)
1477 (if timeout
1478 (add-hook 'post-command-idle-hook 'speedbar-timer-fn)
1479 (remove-hook 'post-command-idle-hook 'speedbar-timer-fn)))
1480 ;; Older or other Emacsen with no timers. Set up so that its
1481 ;; obvious this emacs can't handle the updates
1482 (t
1483 (setq speedbar-update-flag nil)))
1484 ;; Apply a revert hook that will reset the scanners. We attach to revert
1485 ;; because most reverts occur during VC state change, and this lets our
1486 ;; VC scanner fix itself.
1487 (if timeout
1488 (add-hook 'after-revert-hook 'speedbar-reset-scanners)
1489 (remove-hook 'after-revert-hook 'speedbar-reset-scanners)
1490 )
1491 ;; change this if it changed for some reason
1492 (speedbar-set-mode-line-format))
1493
1494(defmacro speedbar-with-writable (&rest forms)
1495 "Allow the buffer to be writable and evaluate FORMS."
1496 (list 'let '((inhibit-read-only t))
1497 '(toggle-read-only -1)
1498 (cons 'progn forms)))
1499(put 'speedbar-with-writable 'lisp-indent-function 0)
1500
1501(defun speedbar-select-window (buffer)
1502 "Select a window in which BUFFER is show.
1503If it is not shown, force it to appear in the default window."
1504 (let ((win (get-buffer-window buffer speedbar-attached-frame)))
1505 (if win
1506 (select-window win)
1507 (show-buffer (selected-window) buffer))))
1508
1509(defmacro speedbar-with-attached-buffer (&rest forms)
1510 "Execute FORMS in the attached frame's special buffer.
1511Optionally select that frame if necessary."
1512 ;; Reset the timer with a new timeout when cliking a file
1513 ;; in case the user was navigating directories, we can cancel
1514 ;; that other timer.
1515 (list
1516 'progn
1517 '(speedbar-set-timer speedbar-update-speed)
1518 (list
1519 'let '((cf (selected-frame)))
1520 '(select-frame speedbar-attached-frame)
1521 '(speedbar-select-window speedbar-desired-buffer)
1522 (cons 'progn forms)
1523 '(select-frame cf)
1524 '(speedbar-maybee-jump-to-attached-frame)
1525 )))
1526
1527(defun speedbar-insert-button (text face mouse function
1528 &optional token prevline)
1529 "Insert TEXT as the next logical speedbar button.
1530FACE is the face to put on the button, MOUSE is the highlight face to use.
1531When the user clicks on TEXT, FUNCTION is called with the TOKEN parameter.
1532This function assumes that the current buffer is the speedbar buffer.
1533If PREVLINE, then put this button on the previous line.
1534
1535This is a convenience function for special mode that create their own
1536specialized speedbar displays."
1537 (goto-char (point-max))
1538 (if (/= (current-column) 0) (insert "\n"))
1539 (if prevline (progn (delete-char -1) (insert " "))) ;back up if desired...
1540 (let ((start (point)))
1541 (insert text)
1542 (speedbar-make-button start (point) face mouse function token))
1543 (let ((start (point)))
1544 (insert "\n")
1545 (put-text-property start (point) 'face nil)
1546 (put-text-property start (point) 'mouse-face nil)))
1547
1548(defun speedbar-make-button (start end face mouse function &optional token)
1549 "Create a button from START to END, with FACE as the display face.
1550MOUSE is the mouse face. When this button is clicked on FUNCTION
1551will be run with the TOKEN parameter (any lisp object)"
1552 (put-text-property start end 'face face)
1553 (put-text-property start end 'mouse-face mouse)
1554 (put-text-property start end 'invisible nil)
1555 (if function (put-text-property start end 'speedbar-function function))
1556 (if token (put-text-property start end 'speedbar-token token))
1557 )
1558
1559;;; File button management
1560;;
1561(defun speedbar-file-lists (directory)
1562 "Create file lists for DIRECTORY.
1563The car is the list of directories, the cdr is list of files not
1564matching ignored headers. Cache any directory files found in
1565`speedbar-directory-contents-alist' and use that cache before scanning
1566the file-system"
1567 (setq directory (expand-file-name directory))
1568 ;; If in powerclick mode, then the directory we are getting
1569 ;; should be rescanned.
1570 (if speedbar-power-click
1571 (adelete 'speedbar-directory-contents-alist directory))
1572 ;; find the directory, either in the cache, or build it.
1573 (or (cdr-safe (assoc directory speedbar-directory-contents-alist))
1574 (let ((default-directory directory)
1575 (dir (directory-files directory nil))
1576 (dirs nil)
1577 (files nil))
1578 (while dir
1579 (if (not (string-match speedbar-file-unshown-regexp (car dir)))
1580 (if (file-directory-p (car dir))
1581 (setq dirs (cons (car dir) dirs))
1582 (setq files (cons (car dir) files))))
1583 (setq dir (cdr dir)))
1584 (let ((nl (cons (nreverse dirs) (list (nreverse files)))))
1585 (aput 'speedbar-directory-contents-alist directory nl)
1586 nl))
1587 ))
1588
1589(defun speedbar-directory-buttons (directory index)
1590 "Insert a single button group at point for DIRECTORY.
1591Each directory path part is a different button. If part of the path
1592matches the user directory ~, then it is replaced with a ~.
1593INDEX is not used, but is required by the caller."
1594 (let* ((tilde (expand-file-name "~"))
1595 (dd (expand-file-name directory))
1596 (junk (string-match (regexp-quote tilde) dd))
1597 (displayme (if junk
1598 (concat "~" (substring dd (match-end 0)))
1599 dd))
1600 (p (point)))
1601 (if (string-match "^~/?\\'" displayme) (setq displayme (concat tilde "/")))
1602 (insert displayme)
1603 (save-excursion
1604 (goto-char p)
1605 (while (re-search-forward "\\([^/]+\\)/" nil t)
1606 (speedbar-make-button (match-beginning 1) (match-end 1)
1607 'speedbar-directory-face
1608 'speedbar-highlight-face
1609 'speedbar-directory-buttons-follow
1610 (if (= (match-beginning 1) p)
1611 (expand-file-name "~/") ;the tilde
1612 (buffer-substring-no-properties
1613 p (match-end 0)))))
1614 ;; Nuke the beginning of the directory if it's too long...
1615 (cond ((eq speedbar-directory-button-trim-method 'span)
1616 (beginning-of-line)
1617 (let ((ww (or (speedbar-frame-width) 20)))
1618 (move-to-column ww nil)
1619 (while (>= (current-column) ww)
1620 (re-search-backward "/" nil t)
1621 (if (<= (current-column) 2)
1622 (progn
1623 (re-search-forward "/" nil t)
1624 (if (< (current-column) 4)
1625 (re-search-forward "/" nil t))
1626 (forward-char -1)))
1627 (if (looking-at "/?$")
1628 (beginning-of-line)
1629 (insert "/...\n ")
1630 (move-to-column ww nil)))))
1631 ((eq speedbar-directory-button-trim-method 'trim)
1632 (end-of-line)
1633 (let ((ww (or (speedbar-frame-width) 20))
1634 (tl (current-column)))
1635 (if (< ww tl)
1636 (progn
1637 (move-to-column (- tl ww))
1638 (if (re-search-backward "/" nil t)
1639 (progn
1640 (delete-region (point-min) (point))
1641 (insert "$")
1642 )))))))
1643 )
1644 (if (string-match "\\`/[^/]+/\\'" displayme)
1645 (progn
1646 (insert " ")
1647 (let ((p (point)))
1648 (insert "<root>")
1649 (speedbar-make-button p (point)
1650 'speedbar-directory-face
1651 'speedbar-highlight-face
1652 'speedbar-directory-buttons-follow
1653 "/"))))
1654 (end-of-line)
1655 (insert-char ?\n 1 nil)))
1656
1657(defun speedbar-make-tag-line (exp-button-type
1658 exp-button-char exp-button-function
1659 exp-button-data
1660 tag-button tag-button-function tag-button-data
1661 tag-button-face depth)
1662 "Create a tag line with EXP-BUTTON-TYPE for the small expansion button.
1663This is the button that expands or contracts a node (if applicable),
1664and EXP-BUTTON-CHAR the character in it (+, -, ?, etc). EXP-BUTTON-FUNCTION
1665is the function to call if it's clicked on. Button types are
1666'bracket, 'angle, 'curly, or nil. EXP-BUTTON-DATA is extra data
1667attached to the text forming the expansion button.
1668
1669Next, TAG-BUTTON is the text of the tag. TAG-BUTTON-FUNCTION is the
1670function to call if clicked on, and TAG-BUTTON-DATA is the data to
1671attach to the text field (such a tag positioning, etc).
1672TAG-BUTTON-FACE is a face used for this type of tag.
1673
1674Lastly, DEPTH shows the depth of expansion.
1675
1676This function assumes that the cursor is in the speedbar window at the
1677position to insert a new item, and that the new item will end with a CR"
1678 (let ((start (point))
1679 (end (progn
1680 (insert (int-to-string depth) ":")
1681 (point))))
1682 (put-text-property start end 'invisible t)
1683 )
1684 (insert-char ? depth nil)
1685 (put-text-property (- (point) depth) (point) 'invisible nil)
1686 (let* ((exp-button (cond ((eq exp-button-type 'bracket) "[%c]")
1687 ((eq exp-button-type 'angle) "<%c>")
1688 ((eq exp-button-type 'curly) "{%c}")
1689 (t ">")))
1690 (buttxt (format exp-button exp-button-char))
1691 (start (point))
1692 (end (progn (insert buttxt) (point)))
1693 (bf (if exp-button-type 'speedbar-button-face nil))
1694 (mf (if exp-button-function 'speedbar-highlight-face nil))
1695 )
1696 (speedbar-make-button start end bf mf exp-button-function exp-button-data)
1697 )
1698 (insert-char ? 1 nil)
1699 (put-text-property (1- (point)) (point) 'invisible nil)
1700 (let ((start (point))
1701 (end (progn (insert tag-button) (point))))
1702 (insert-char ?\n 1 nil)
1703 (put-text-property (1- (point)) (point) 'invisible nil)
1704 (speedbar-make-button start end tag-button-face
1705 (if tag-button-function 'speedbar-highlight-face nil)
1706 tag-button-function tag-button-data))
1707)
1708
1709(defun speedbar-change-expand-button-char (char)
1710 "Change the expansion button character to CHAR for the current line."
1711 (save-excursion
1712 (beginning-of-line)
1713 (if (re-search-forward ":\\s-*.\\([-+?]\\)" (save-excursion (end-of-line)
1714 (point)) t)
1715 (speedbar-with-writable
1716 (goto-char (match-beginning 1))
1717 (delete-char 1)
1718 (insert-char char 1 t)))))
1719
1720
1721;;; Build button lists
1722;;
1723(defun speedbar-insert-files-at-point (files level)
1724 "Insert list of FILES starting at point, and indenting all files to LEVEL.
1725Tag expandable items with a +, otherwise a ?. Don't highlight ? as we
1726don't know how to manage them. The input parameter FILES is a cons
1727cell of the form ( 'DIRLIST . 'FILELIST )"
1728 ;; Start inserting all the directories
1729 (let ((dirs (car files)))
1730 (while dirs
1731 (speedbar-make-tag-line 'angle ?+ 'speedbar-dired (car dirs)
1732 (car dirs) 'speedbar-dir-follow nil
1733 'speedbar-directory-face level)
1734 (setq dirs (cdr dirs))))
1735 (let ((lst (car (cdr files))))
1736 (while lst
1737 (let* ((known (string-match speedbar-file-regexp (car lst)))
1738 (expchar (if known ?+ ??))
1739 (fn (if known 'speedbar-tag-file nil)))
1740 (if (or speedbar-show-unknown-files (/= expchar ??))
1741 (speedbar-make-tag-line 'bracket expchar fn (car lst)
1742 (car lst) 'speedbar-find-file nil
1743 'speedbar-file-face level)))
1744 (setq lst (cdr lst)))))
1745
1746(defun speedbar-default-directory-list (directory index)
1747 "Insert files for DIRECTORY with level INDEX at point."
1748 (speedbar-insert-files-at-point
1749 (speedbar-file-lists directory) index)
1750 (speedbar-reset-scanners)
1751 (if (= index 0)
1752 ;; If the shown files variable has extra directories, then
1753 ;; it is our responsibility to redraw them all
1754 ;; Luckilly, the nature of inserting items into this list means
1755 ;; that by reversing it, we can easilly go in the right order
1756 (let ((sf (cdr (reverse speedbar-shown-directories))))
1757 (setq speedbar-shown-directories
1758 (list (expand-file-name default-directory)))
1759 ;; exand them all as we find them
1760 (while sf
1761 (if (speedbar-goto-this-file (car sf))
1762 (progn
1763 (beginning-of-line)
1764 (if (looking-at "[0-9]+:[ ]*<")
1765 (progn
1766 (goto-char (match-end 0))
1767 (speedbar-do-function-pointer)))
1768 (setq sf (cdr sf)))))
1769 )))
1770
1771(defun speedbar-insert-generic-list (level lst expand-fun find-fun)
1772 "At LEVEL, insert a generic multi-level alist LST.
1773Associations with lists get {+} tags (to expand into more nodes) and
1774those with positions just get a > as the indicator. {+} buttons will
1775have the function EXPAND-FUN and the token is the CDR list. The token
1776name will have the function FIND-FUN and not token."
1777 ;; Remove imenu rescan button
1778 (if (string= (car (car lst)) "*Rescan*")
1779 (setq lst (cdr lst)))
1780 ;; insert the parts
1781 (while lst
1782 (cond ((null (car-safe lst)) nil) ;this would be a separator
1783 ((or (numberp (cdr-safe (car-safe lst)))
1784 (markerp (cdr-safe (car-safe lst))))
1785 (speedbar-make-tag-line nil nil nil nil ;no expand button data
1786 (car (car lst)) ;button name
1787 find-fun ;function
1788 (cdr (car lst)) ;token is position
1789 'speedbar-tag-face
1790 (1+ level)))
1791 ((listp (cdr-safe (car-safe lst)))
1792 (speedbar-make-tag-line 'curly ?+ expand-fun (cdr (car lst))
1793 (car (car lst)) ;button name
1794 nil nil 'speedbar-tag-face
1795 (1+ level)))
1796 (t (message "Ooops!")))
1797 (setq lst (cdr lst))))
1798
1799;;; Timed functions
1800;;
1801(defun speedbar-update-contents ()
1802 "Generically update the contents of the speedbar buffer."
1803 (interactive)
1804 ;; Set the current special buffer
1805 (setq speedbar-desired-buffer nil)
1806 (if (and speedbar-mode-specific-contents-flag
1807 speedbar-special-mode-expansion-list
1808 (local-variable-p
1809 'speedbar-special-mode-expansion-list
1810 (current-buffer)))
1811 ;;(eq (get major-mode 'mode-class 'special)))
1812 (speedbar-update-special-contents)
1813 (speedbar-update-directory-contents)))
1814
1815(defun speedbar-update-directory-contents ()
1816 "Update the contents of the speedbar buffer based on the current directory."
1817 (let ((cbd (expand-file-name default-directory))
1818 cbd-parent
1819 (funclst speedbar-initial-expansion-list)
1820 (cache speedbar-full-text-cache)
1821 ;; disable stealth during update
1822 (speedbar-stealthy-function-list nil)
1823 (use-cache nil)
1824 (expand-local nil)
1825 ;; Because there is a bug I can't find just yet
1826 (inhibit-quit nil))
1827 (save-excursion
1828 (set-buffer speedbar-buffer)
1829 ;; If we are updating contents to where we are, then this is
1830 ;; really a request to update existing contents, so we must be
1831 ;; careful with our text cache!
1832 (if (member cbd speedbar-shown-directories)
1833 (setq cache nil)
1834
1835 ;; Build cbd-parent, and see if THAT is in the current shown
1836 ;; directories. First, go through pains to get the parent directory
1837 (if (and speedbar-smart-directory-expand-flag
1838 (save-match-data
1839 (setq cbd-parent cbd)
1840 (if (string-match "/$" cbd-parent)
1841 (setq cbd-parent (substring cbd-parent 0 (match-beginning 0))))
1842 (setq cbd-parent (file-name-directory cbd-parent)))
1843 (member cbd-parent speedbar-shown-directories))
1844 (setq expand-local t)
1845
1846 ;; If this directory is NOT in the current list of available
1847 ;; paths, then use the cache, and set the cache to our new
1848 ;; value. Make sure to unhighlight the current file, or if we
1849 ;; come back to this directory, it might be a different file
1850 ;; and then we get a mess!
1851 (if (> (point-max) 1)
1852 (progn
1853 (speedbar-clear-current-file)
1854 (setq speedbar-full-text-cache
1855 (cons speedbar-shown-directories (buffer-string)))))
1856
1857 ;; Check if our new directory is in the list of directories
1858 ;; shown in the text-cache
1859 (if (member cbd (car cache))
1860 (setq speedbar-shown-directories (car cache)
1861 use-cache t)
1862 ;; default the shown directories to this list...
1863 (setq speedbar-shown-directories (list cbd)))
1864 ))
1865 (setq speedbar-last-selected-file nil)
1866 (speedbar-with-writable
1867 (if (and expand-local
1868 ;; Find this directory as a speedbar node.
1869 (speedbar-path-line cbd))
1870 ;; Open it.
1871 (speedbar-expand-line)
1872 (erase-buffer)
1873 (cond (use-cache
1874 (setq default-directory
1875 (nth (1- (length speedbar-shown-directories))
1876 speedbar-shown-directories))
1877 (insert (cdr cache)))
1878 (t
1879 (while funclst
1880 (setq default-directory cbd)
1881 (funcall (car funclst) cbd 0)
1882 (setq funclst (cdr funclst))))))
1883 (goto-char (point-min)))))
1884 (speedbar-reconfigure-menubar))
1885
1886(defun speedbar-update-special-contents ()
1887 "Used the mode-specific variable to fill in the speedbar buffer.
1888This should only be used by modes classified as special."
1889 (let ((funclst speedbar-special-mode-expansion-list)
1890 (specialbuff (current-buffer)))
1891 (save-excursion
1892 (setq speedbar-desired-buffer specialbuff)
1893 (set-buffer speedbar-buffer)
1894 ;; If we are leaving a directory, cache it.
1895 (if (not speedbar-shown-directories)
1896 ;; Do nothing
1897 nil
1898 ;; Clean up directory maintenance stuff
1899 (speedbar-clear-current-file)
1900 (setq speedbar-full-text-cache
1901 (cons speedbar-shown-directories (buffer-string))
1902 speedbar-shown-directories nil))
1903 ;; Now fill in the buffer with our newly found specialized list.
1904 (speedbar-with-writable
1905 (while funclst
1906 ;; We do not erase the buffer because these functions may
1907 ;; decide NOT to update themselves.
1908 (funcall (car funclst) specialbuff)
1909 (setq funclst (cdr funclst))))
1910 (goto-char (point-min))))
1911 (speedbar-reconfigure-menubar))
1912
1913(defun speedbar-timer-fn ()
1914 "Run whenever emacs is idle to update the speedbar item."
1915 (if (not (and (frame-live-p speedbar-frame)
1916 (frame-live-p speedbar-attached-frame)))
1917 (speedbar-set-timer nil)
1918 ;; Save all the match data so that we don't mess up executing fns
1919 (save-match-data
1920 (if (and (frame-visible-p speedbar-frame) speedbar-update-flag)
1921 (let ((af (selected-frame)))
1922 (save-window-excursion
1923 (select-frame speedbar-attached-frame)
1924 ;; make sure we at least choose a window to
1925 ;; get a good directory from
1926 (if (string-match "\\*Minibuf-[0-9]+\\*" (buffer-name))
1927 (other-window 1))
1928 ;; Update for special mode all the time!
1929 (if (and speedbar-mode-specific-contents-flag
1930 speedbar-special-mode-expansion-list
1931 (local-variable-p
1932 'speedbar-special-mode-expansion-list
1933 (current-buffer)))
1934 ;;(eq (get major-mode 'mode-class 'special)))
1935 (progn
1936 (if (<= 2 speedbar-verbosity-level)
1937 (message "Updating speedbar to special mode: %s..."
1938 major-mode))
1939 (speedbar-update-special-contents)
1940 (if (<= 2 speedbar-verbosity-level)
1941 (message "Updating speedbar to special mode: %s...done"
1942 major-mode)))
1943 ;; Update all the contents if directories change!
1944 (if (or (member (expand-file-name default-directory)
1945 speedbar-shown-directories)
1946 (and speedbar-ignored-path-regexp
1947 (string-match
1948 speedbar-ignored-path-regexp
1949 (expand-file-name default-directory)))
1950 (member major-mode speedbar-ignored-modes)
1951 (eq af speedbar-frame)
1952 (not (buffer-file-name)))
1953 nil
1954 (if (<= 1 speedbar-verbosity-level)
1955 (message "Updating speedbar to: %s..."
1956 default-directory))
1957 (speedbar-update-directory-contents)
1958 (if (<= 1 speedbar-verbosity-level)
1959 (message "Updating speedbar to: %s...done"
1960 default-directory))))
1961 (select-frame af))
1962 ;; Now run stealthy updates of time-consuming items
1963 (speedbar-stealthy-updates)))))
1964 (run-hooks 'speedbar-timer-hook))
1965
1966
1967;;; Stealthy activities
1968;;
1969(defun speedbar-stealthy-updates ()
1970 "For a given speedbar, run all items in the stealthy function list.
1971Each item returns t if it completes successfully, or nil if
1972interrupted by the user."
1973 (let ((l speedbar-stealthy-function-list))
1974 (unwind-protect
1975 (while (and l (funcall (car l)))
1976 (sit-for 0)
1977 (setq l (cdr l)))
1978 ;(message "Exit with %S" (car l))
1979 )))
1980
1981(defun speedbar-reset-scanners ()
1982 "Reset any variables used by functions in the stealthy list as state.
1983If new functions are added, their state needs to be updated here."
1984 (setq speedbar-vc-to-do-point t)
1985 (run-hooks 'speedbar-scanner-reset-hook)
1986 )
1987
1988(defun speedbar-clear-current-file ()
1989 "Locate the file thought to be current, and remove its highlighting."
1990 (save-excursion
1991 (set-buffer speedbar-buffer)
1992 (if speedbar-last-selected-file
1993 (speedbar-with-writable
1994 (goto-char (point-min))
1995 (if (and
1996 speedbar-last-selected-file
1997 (re-search-forward
1998 (concat " \\(" (regexp-quote speedbar-last-selected-file)
1999 "\\)\\(" (regexp-quote speedbar-vc-indicator)
2000 "\\)?\n")
2001 nil t))
2002 (put-text-property (match-beginning 1)
2003 (match-end 1)
2004 'face
2005 'speedbar-file-face))))))
2006
2007(defun speedbar-update-current-file ()
2008 "Find the current file, and update our visuals to indicate its name.
2009This is specific to file names. If the file name doesn't show up, but
2010it should be in the list, then the directory cache needs to be
2011updated."
2012 (let* ((lastf (selected-frame))
2013 (newcfd (save-excursion
2014 (select-frame speedbar-attached-frame)
2015 (let ((rf (if (buffer-file-name)
2016 (buffer-file-name)
2017 nil)))
2018 (select-frame lastf)
2019 rf)))
2020 (newcf (if newcfd (file-name-nondirectory newcfd)))
2021 (lastb (current-buffer))
2022 (sucf-recursive (boundp 'sucf-recursive)))
2023 (if (and newcf
2024 ;; check here, that way we won't refresh to newcf until
2025 ;; its been written, thus saving ourselves some time
2026 (file-exists-p newcf)
2027 (not (string= newcf speedbar-last-selected-file)))
2028 (progn
2029 ;; It is important to select the frame, otherwise the window
2030 ;; we want the cursor to move in will not be updated by the
2031 ;; search-forward command.
2032 (select-frame speedbar-frame)
2033 ;; Remove the old file...
2034 (speedbar-clear-current-file)
2035 ;; now highlight the new one.
2036 (set-buffer speedbar-buffer)
2037 (speedbar-with-writable
2038 (goto-char (point-min))
2039 (if (re-search-forward
2040 (concat " \\(" (regexp-quote newcf) "\\)\\("
2041 (regexp-quote speedbar-vc-indicator)
2042 "\\)?\n") nil t)
2043 ;; put the property on it
2044 (put-text-property (match-beginning 1)
2045 (match-end 1)
2046 'face
2047 'speedbar-selected-face)
2048 ;; Oops, it's not in the list. Should it be?
2049 (if (and (string-match speedbar-file-regexp newcf)
2050 (string= (file-name-directory newcfd)
2051 (expand-file-name default-directory)))
2052 ;; yes, it is (we will ignore unknowns for now...)
2053 (progn
2054 (speedbar-refresh)
2055 (if (re-search-forward
2056 (concat " \\(" (regexp-quote newcf) "\\)\n") nil t)
2057 ;; put the property on it
2058 (put-text-property (match-beginning 1)
2059 (match-end 1)
2060 'face
2061 'speedbar-selected-face)))
2062 ;; if it's not in there now, whatever...
2063 ))
2064 (setq speedbar-last-selected-file newcf))
2065 (if (not sucf-recursive)
2066 (progn
2067 (forward-line -1)
2068 (speedbar-position-cursor-on-line)))
2069 (set-buffer lastb)
2070 (select-frame lastf)
2071 )))
2072 ;; return that we are done with this activity.
2073 t)
2074
2075;; Load ange-ftp only if compiling to remove errors.
2076;; Steven L Baur <steve@xemacs.org> said this was important:
2077(eval-when-compile (or (featurep 'xemacs) (require 'ange-ftp)))
2078
2079(defun speedbar-check-vc ()
2080 "Scan all files in a directory, and for each see if it's checked out.
2081See `speedbar-this-file-in-vc' and `speedbar-vc-check-dir-p' for how
2082to add more types of version control systems."
2083 ;; Check for to-do to be reset. If reset but no RCS is available
2084 ;; then set to nil (do nothing) otherwise, start at the beginning
2085 (save-excursion
2086 (set-buffer speedbar-buffer)
2087 (if (and speedbar-vc-do-check (eq speedbar-vc-to-do-point t)
2088 (speedbar-vc-check-dir-p default-directory)
2089 (not (and (featurep 'ange-ftp)
2090 (string-match (car
2091 (if speedbar-xemacsp
2092 ange-ftp-path-format
2093 ange-ftp-name-format))
2094 (expand-file-name default-directory)))))
2095 (setq speedbar-vc-to-do-point 0))
2096 (if (numberp speedbar-vc-to-do-point)
2097 (progn
2098 (goto-char speedbar-vc-to-do-point)
2099 (while (and (not (input-pending-p))
2100 (re-search-forward "^\\([0-9]+\\):\\s-*\\[[+-]\\] "
2101 nil t))
2102 (setq speedbar-vc-to-do-point (point))
2103 (if (speedbar-check-vc-this-line (match-string 1))
2104 (if (not (looking-at (regexp-quote speedbar-vc-indicator)))
2105 (speedbar-with-writable (insert speedbar-vc-indicator)))
2106 (if (looking-at (regexp-quote speedbar-vc-indicator))
2107 (speedbar-with-writable
2108 (delete-region (match-beginning 0) (match-end 0))))))
2109 (if (input-pending-p)
2110 ;; return that we are incomplete
2111 nil
2112 ;; we are done, set to-do to nil
2113 (setq speedbar-vc-to-do-point nil)
2114 ;; and return t
2115 t))
2116 t)))
2117
2118(defun speedbar-check-vc-this-line (depth)
2119 "Return t if the file on this line is check of of a version control system.
2120Parameter DEPTH is a string with the current depth of indentation of
2121the file being checked."
2122 (let* ((d (string-to-int depth))
2123 (f (speedbar-line-path d))
2124 (fn (buffer-substring-no-properties
2125 ;; Skip-chars: thanks ptype@dra.hmg.gb
2126 (point) (progn
2127 (skip-chars-forward "^ "
2128 (save-excursion (end-of-line)
2129 (point)))
2130 (point))))
2131 (fulln (concat f fn)))
2132 (if (<= 2 speedbar-verbosity-level)
2133 (message "Speedbar vc check...%s" fulln))
2134 (and (file-writable-p fulln)
2135 (speedbar-this-file-in-vc f fn))))
2136
2137(defun speedbar-vc-check-dir-p (path)
2138 "Return t if we should bother checking PATH for version control files.
2139This can be overloaded to add new types of version control systems."
2140 (or
2141 ;; Local RCS
2142 (file-exists-p (concat path "RCS/"))
2143 ;; Local SCCS
2144 (file-exists-p (concat path "SCCS/"))
2145 ;; Remote SCCS project
2146 (let ((proj-dir (getenv "PROJECTDIR")))
2147 (if proj-dir
2148 (file-exists-p (concat proj-dir "/SCCS"))
2149 nil))
2150 ;; User extension
2151 (run-hook-with-args 'speedbar-vc-path-enable-hook path)
2152 ))
2153
2154(defun speedbar-this-file-in-vc (path name)
2155 "Check to see if the file in PATH with NAME is in a version control system.
2156You can add new VC systems by overriding this function. You can
2157optimize this function by overriding it and only doing those checks
2158that will occur on your system."
2159 (or
2160 ;; RCS file name
2161 (file-exists-p (concat path "RCS/" name ",v"))
2162 ;; Local SCCS file name
2163 (file-exists-p (concat path "SCCS/p." name))
2164 ;; Remote SCCS file name
2165 (let ((proj-dir (getenv "PROJECTDIR")))
2166 (if proj-dir
2167 (file-exists-p (concat proj-dir "/SCCS/p." name))
2168 nil))
2169 ;; User extension
2170 (run-hook-with-args 'speedbar-vc-in-control-hook path name)
2171 ))
2172
2173;;; Clicking Activity
2174;;
2175(defun speedbar-quick-mouse (e)
2176 "Since mouse events are strange, this will keep the mouse nicely positioned.
2177This should be bound to mouse event E."
2178 (interactive "e")
2179 (mouse-set-point e)
2180 (speedbar-position-cursor-on-line)
2181 )
2182
2183(defun speedbar-position-cursor-on-line ()
2184 "Position the cursor on a line."
2185 (let ((oldpos (point)))
2186 (beginning-of-line)
2187 (if (looking-at "[0-9]+:\\s-*..?.? ")
2188 (goto-char (1- (match-end 0)))
2189 (goto-char oldpos))))
2190
2191(defun speedbar-power-click (e)
2192 "Activate any speedbar button as a power click.
2193This should be bound to mouse event E."
2194 (interactive "e")
2195 (let ((speedbar-power-click t))
2196 (speedbar-click e)))
2197
2198(defun speedbar-click (e)
2199 "Activate any speedbar buttons where the mouse is clicked.
2200This must be bound to a mouse event. A button is any location of text
2201with a mouse face that has a text property called `speedbar-function'.
2202This should be bound to mouse event E."
2203 (interactive "e")
2204 (mouse-set-point e)
2205 (speedbar-do-function-pointer)
2206 (speedbar-quick-mouse e))
2207
2208(defun speedbar-double-click (e)
2209 "Activate any speedbar buttons where the mouse is clicked.
2210This must be bound to a mouse event. A button is any location of text
2211with a mouse face that has a text property called `speedbar-function'.
2212This should be bound to mouse event E."
2213 (interactive "e")
2214 ;; Emacs only. XEmacs handles this via `mouse-track-click-hook'.
2215 (cond ((eq (car e) 'down-mouse-1)
2216 (mouse-set-point e))
2217 ((eq (car e) 'mouse-1)
2218 (speedbar-quick-mouse e))
2219 ((or (eq (car e) 'double-down-mouse-1)
2220 (eq (car e) 'tripple-down-mouse-1))
2221 (mouse-set-point e)
2222 (speedbar-do-function-pointer)
2223 (speedbar-quick-mouse e))))
2224
2225(defun speedbar-do-function-pointer ()
2226 "Look under the cursor and examine the text properties.
2227From this extract the file/tag name, token, indentation level and call
2228a function if appropriate"
2229 (let* ((fn (get-text-property (point) 'speedbar-function))
2230 (tok (get-text-property (point) 'speedbar-token))
2231 ;; The 1-,+ is safe because scaning starts AFTER the point
2232 ;; specified. This lets the search include the character the
2233 ;; cursor is on.
2234 (tp (previous-single-property-change
2235 (1+ (point)) 'speedbar-function))
2236 (np (next-single-property-change
2237 (point) 'speedbar-function))
2238 (txt (buffer-substring-no-properties (or tp (point-min))
2239 (or np (point-max))))
2240 (dent (save-excursion (beginning-of-line)
2241 (string-to-number
2242 (if (looking-at "[0-9]+")
2243 (buffer-substring-no-properties
2244 (match-beginning 0) (match-end 0))
2245 "0")))))
2246 ;;(message "%S:%S:%S:%s" fn tok txt dent)
2247 (and fn (funcall fn txt tok dent)))
2248 (speedbar-position-cursor-on-line))
2249
2250;;; Reading info from the speedbar buffer
2251;;
2252(defun speedbar-line-file (&optional p)
2253 "Retrieve the file or whatever from the line at P point.
2254The return value is a string representing the file. If it is a
2255directory, then it is the directory name."
2256 (save-excursion
2257 (save-match-data
2258 (beginning-of-line)
2259 (if (looking-at (concat
2260 "\\([0-9]+\\): *[[<][-+?][]>] \\([^ \n]+\\)\\("
2261 (regexp-quote speedbar-vc-indicator)
2262 "\\)?"))
2263 (let* ((depth (string-to-int (match-string 1)))
2264 (path (speedbar-line-path depth))
2265 (f (match-string 2)))
2266 (concat path f))
2267 nil))))
2268
2269(defun speedbar-goto-this-file (file)
2270 "If FILE is displayed, goto this line and return t.
2271Otherwise do not move and return nil."
2272 (let ((path (substring (file-name-directory (expand-file-name file))
2273 (length (expand-file-name default-directory))))
2274 (dest (point)))
2275 (save-match-data
2276 (goto-char (point-min))
2277 ;; scan all the directories
2278 (while (and path (not (eq path t)))
2279 (if (string-match "^/?\\([^/]+\\)" path)
2280 (let ((pp (match-string 1 path)))
2281 (if (save-match-data
2282 (re-search-forward (concat "> " (regexp-quote pp) "$")
2283 nil t))
2284 (setq path (substring path (match-end 1)))
2285 (setq path nil)))
2286 (setq path t)))
2287 ;; find the file part
2288 (if (or (not path) (string= (file-name-nondirectory file) ""))
2289 ;; only had a dir part
2290 (if path
2291 (progn
2292 (speedbar-position-cursor-on-line)
2293 t)
2294 (goto-char dest) nil)
2295 ;; find the file part
2296 (let ((nd (file-name-nondirectory file)))
2297 (if (re-search-forward
2298 (concat "] \\(" (regexp-quote nd)
2299 "\\)\\(" (regexp-quote speedbar-vc-indicator) "\\)?$")
2300 nil t)
2301 (progn
2302 (speedbar-position-cursor-on-line)
2303 t)
2304 (goto-char dest)
2305 nil))))))
2306
2307(defun speedbar-line-path (depth)
2308 "Retrieve the pathname associated with the current line.
2309This may require traversing backwards from DEPTH and combining the default
2310directory with these items."
2311 (save-excursion
2312 (save-match-data
2313 (let ((path nil))
2314 (setq depth (1- depth))
2315 (while (/= depth -1)
2316 (if (not (re-search-backward (format "^%d:" depth) nil t))
2317 (error "Error building path of tag")
2318 (cond ((looking-at "[0-9]+:\\s-*<->\\s-+\\([^\n]+\\)$")
2319 (setq path (concat (buffer-substring-no-properties
2320 (match-beginning 1) (match-end 1))
2321 "/"
2322 path)))
2323 ((looking-at "[0-9]+:\\s-*[-]\\s-+\\([^\n]+\\)$")
2324 ;; This is the start of our path.
2325 (setq path (buffer-substring-no-properties
2326 (match-beginning 1) (match-end 1))))))
2327 (setq depth (1- depth)))
2328 (if (and path
2329 (string-match (concat (regexp-quote speedbar-vc-indicator) "$")
2330 path))
2331 (setq path (substring path 0 (match-beginning 0))))
2332 (concat default-directory path)))))
2333
2334(defun speedbar-path-line (path)
2335 "Position the cursor on the line specified by PATH."
2336 (save-match-data
2337 (if (string-match "/$" path)
2338 (setq path (substring path 0 (match-beginning 0))))
2339 (let ((nomatch t) (depth 0)
2340 (fname (file-name-nondirectory path))
2341 (pname (file-name-directory path)))
2342 (if (not (member pname speedbar-shown-directories))
2343 (error "Internal Error: File %s not shown in speedbar." path))
2344 (goto-char (point-min))
2345 (while (and nomatch
2346 (re-search-forward
2347 (concat "[]>] \\(" (regexp-quote fname)
2348 "\\)\\(" (regexp-quote speedbar-vc-indicator) "\\)?$")
2349 nil t))
2350 (beginning-of-line)
2351 (looking-at "\\([0-9]+\\):")
2352 (setq depth (string-to-int (match-string 0))
2353 nomatch (not (string= pname (speedbar-line-path depth))))
2354 (end-of-line))
2355 (beginning-of-line)
2356 (not nomatch))))
2357
2358(defun speedbar-edit-line ()
2359 "Edit whatever tag or file is on the current speedbar line."
2360 (interactive)
2361 (or (save-excursion
2362 (beginning-of-line)
2363 ;; If this fails, then it is a non-standard click, and as such,
2364 ;; perfectly allowed.
2365 (if (re-search-forward "[]>}] [a-zA-Z0-9]"
2366 (save-excursion (end-of-line) (point))
2367 t)
2368 (speedbar-do-function-pointer)
2369 nil))
2370 (speedbar-do-function-pointer)))
2371
2372(defun speedbar-expand-line ()
2373 "Expand the line under the cursor."
2374 (interactive)
2375 (beginning-of-line)
2376 (re-search-forward ":\\s-*.\\+. " (save-excursion (end-of-line) (point)))
2377 (forward-char -2)
2378 (speedbar-do-function-pointer))
2379
2380(defun speedbar-contract-line ()
2381 "Contract the line under the cursor."
2382 (interactive)
2383 (beginning-of-line)
2384 (re-search-forward ":\\s-*.-. " (save-excursion (end-of-line) (point)))
2385 (forward-char -2)
2386 (speedbar-do-function-pointer))
2387
2388(if speedbar-xemacsp
2389 (defalias 'speedbar-mouse-event-p 'button-press-event-p)
2390 (defun speedbar-mouse-event-p (event)
2391 "Return t if the event is a mouse related event"
2392 ;; And Emacs does it this way
2393 (if (and (listp event)
2394 (member (event-basic-type event)
2395 '(mouse-1 mouse-2 mouse-3)))
2396 t
2397 nil)))
2398
2399(defun speedbar-maybee-jump-to-attached-frame ()
2400 "Jump to the attached frame ONLY if this was not a mouse event."
2401 (if (or (not (speedbar-mouse-event-p last-input-event))
2402 speedbar-activity-change-focus-flag)
2403 (progn
2404 (select-frame speedbar-attached-frame)
2405 (other-frame 0))))
2406
2407(defun speedbar-find-file (text token indent)
2408 "Speedbar click handler for filenames.
2409TEXT, the file will be displayed in the attached frame.
2410TOKEN is unused, but required by the click handler. INDENT is the
2411current indentation level."
2412 (let ((cdd (speedbar-line-path indent)))
2413 (speedbar-find-file-in-frame (concat cdd text))
2414 (speedbar-stealthy-updates)
2415 (run-hooks 'speedbar-visiting-file-hook)
2416 ;; Reset the timer with a new timeout when cliking a file
2417 ;; in case the user was navigating directories, we can cancel
2418 ;; that other timer.
2419 (speedbar-set-timer speedbar-update-speed))
2420 (speedbar-maybee-jump-to-attached-frame))
2421
2422(defun speedbar-dir-follow (text token indent)
2423 "Speedbar click handler for directory names.
2424Clicking a directory will cause the speedbar to list files in the
2425the subdirectory TEXT. TOKEN is an unused requirement. The
2426subdirectory chosen will be at INDENT level."
2427 (setq default-directory
2428 (concat (expand-file-name (concat (speedbar-line-path indent) text))
2429 "/"))
2430 ;; Because we leave speedbar as the current buffer,
2431 ;; update contents will change directory without
2432 ;; having to touch the attached frame.
2433 (speedbar-update-contents)
2434 (speedbar-set-timer speedbar-navigating-speed)
2435 (setq speedbar-last-selected-file nil)
2436 (speedbar-stealthy-updates))
2437
2438(defun speedbar-delete-subblock (indent)
2439 "Delete text from point to indentation level INDENT or greater.
2440Handles end-of-sublist smartly."
2441 (speedbar-with-writable
2442 (save-excursion
2443 (end-of-line) (forward-char 1)
2444 (while (and (not (save-excursion
2445 (re-search-forward (format "^%d:" indent)
2446 nil t)))
2447 (>= indent 0))
2448 (setq indent (1- indent)))
2449 (delete-region (point) (if (>= indent 0)
2450 (match-beginning 0)
2451 (point-max))))))
2452
2453(defun speedbar-dired (text token indent)
2454 "Speedbar click handler for directory expand button.
2455Clicking this button expands or contracts a directory. TEXT is the
2456button clicked which has either a + or -. TOKEN is the directory to be
2457expanded. INDENT is the current indentation level."
2458 (cond ((string-match "+" text) ;we have to expand this dir
2459 (setq speedbar-shown-directories
2460 (cons (expand-file-name
2461 (concat (speedbar-line-path indent) token "/"))
2462 speedbar-shown-directories))
2463 (speedbar-change-expand-button-char ?-)
2464 (speedbar-reset-scanners)
2465 (save-excursion
2466 (end-of-line) (forward-char 1)
2467 (speedbar-with-writable
2468 (speedbar-default-directory-list
2469 (concat (speedbar-line-path indent) token "/")
2470 (1+ indent)))))
2471 ((string-match "-" text) ;we have to contract this node
2472 (speedbar-reset-scanners)
2473 (let ((oldl speedbar-shown-directories)
2474 (newl nil)
2475 (td (expand-file-name
2476 (concat (speedbar-line-path indent) token))))
2477 (while oldl
2478 (if (not (string-match (concat "^" (regexp-quote td)) (car oldl)))
2479 (setq newl (cons (car oldl) newl)))
2480 (setq oldl (cdr oldl)))
2481 (setq speedbar-shown-directories newl))
2482 (speedbar-change-expand-button-char ?+)
2483 (speedbar-delete-subblock indent)
2484 )
2485 (t (error "Ooops... not sure what to do.")))
2486 (speedbar-center-buffer-smartly)
2487 (setq speedbar-last-selected-file nil)
2488 (save-excursion (speedbar-stealthy-updates)))
2489
2490(defun speedbar-directory-buttons-follow (text token indent)
2491 "Speedbar click handler for default directory buttons.
2492TEXT is the button clicked on. TOKEN is the directory to follow.
2493INDENT is the current indentation level and is unused."
2494 (setq default-directory token)
2495 ;; Because we leave speedbar as the current buffer,
2496 ;; update contents will change directory without
2497 ;; having to touch the attached frame.
2498 (speedbar-update-contents)
2499 (speedbar-set-timer speedbar-navigating-speed))
2500
2501(defun speedbar-tag-file (text token indent)
2502 "The cursor is on a selected line. Expand the tags in the specified file.
2503The parameter TEXT and TOKEN are required, where TEXT is the button
2504clicked, and TOKEN is the file to expand. INDENT is the current
2505indentation level."
2506 (cond ((string-match "+" text) ;we have to expand this file
2507 (let* ((fn (expand-file-name (concat (speedbar-line-path indent)
2508 token)))
2509 (lst (if speedbar-use-imenu-flag
2510 (let ((tim (speedbar-fetch-dynamic-imenu fn)))
2511 (if (eq tim t)
2512 (speedbar-fetch-dynamic-etags fn)
2513 tim))
2514 (speedbar-fetch-dynamic-etags fn))))
2515 ;; if no list, then remove expando button
2516 (if (not lst)
2517 (speedbar-change-expand-button-char ??)
2518 (speedbar-change-expand-button-char ?-)
2519 (speedbar-with-writable
2520 (save-excursion
2521 (end-of-line) (forward-char 1)
2522 (speedbar-insert-generic-list indent
2523 lst 'speedbar-tag-expand
2524 'speedbar-tag-find))))))
2525 ((string-match "-" text) ;we have to contract this node
2526 (speedbar-change-expand-button-char ?+)
2527 (speedbar-delete-subblock indent))
2528 (t (error "Ooops... not sure what to do.")))
2529 (speedbar-center-buffer-smartly))
2530
2531(defun speedbar-tag-find (text token indent)
2532 "For the tag TEXT in a file TOKEN, goto that position.
2533INDENT is the current indentation level."
2534 (let ((file (speedbar-line-path indent)))
2535 (speedbar-find-file-in-frame file)
2536 (save-excursion (speedbar-stealthy-updates))
2537 ;; Reset the timer with a new timeout when cliking a file
2538 ;; in case the user was navigating directories, we can cancel
2539 ;; that other timer.
2540 (speedbar-set-timer speedbar-update-speed)
2541 (goto-char token)
2542 (run-hooks 'speedbar-visiting-tag-hook)
2543 ;;(recenter)
2544 (speedbar-maybee-jump-to-attached-frame)
2545 ))
2546
2547(defun speedbar-tag-expand (text token indent)
2548 "Expand a tag sublist. Imenu will return sub-lists of specialized tag types.
2549Etags does not support this feature. TEXT will be the button
2550string. TOKEN will be the list, and INDENT is the current indentation
2551level."
2552 (cond ((string-match "+" text) ;we have to expand this file
2553 (speedbar-change-expand-button-char ?-)
2554 (speedbar-with-writable
2555 (save-excursion
2556 (end-of-line) (forward-char 1)
2557 (speedbar-insert-generic-list indent
2558 token 'speedbar-tag-expand
2559 'speedbar-tag-find))))
2560 ((string-match "-" text) ;we have to contract this node
2561 (speedbar-change-expand-button-char ?+)
2562 (speedbar-delete-subblock indent))
2563 (t (error "Ooops... not sure what to do.")))
2564 (speedbar-center-buffer-smartly))
2565
2566;;; Loading files into the attached frame.
2567;;
2568(defun speedbar-find-file-in-frame (file)
2569 "This will load FILE into the speedbar attached frame.
2570If the file is being displayed in a different frame already, then raise that
2571frame instead."
2572 (let* ((buff (find-file-noselect file))
2573 (bwin (get-buffer-window buff 0)))
2574 (if bwin
2575 (progn
2576 (select-window bwin)
2577 (raise-frame (window-frame bwin)))
2578 (if speedbar-power-click
2579 (let ((pop-up-frames t)) (select-window (display-buffer buff)))
2580 (select-frame speedbar-attached-frame)
2581 (switch-to-buffer buff))))
2582 )
2583
2584;;; Centering Utility
2585;;
2586(defun speedbar-center-buffer-smartly ()
2587 "Recenter a speedbar buffer so the current indentation level is all visible.
2588This assumes that the cursor is on a file, or tag of a file which the user is
2589interested in."
2590 (if (<= (count-lines (point-min) (point-max))
2591 (window-height (selected-window)))
2592 ;; whole buffer fits
2593 (let ((cp (point)))
2594 (goto-char (point-min))
2595 (recenter 0)
2596 (goto-char cp))
2597 ;; too big
2598 (let (depth start end exp p)
2599 (save-excursion
2600 (beginning-of-line)
2601 (setq depth (if (looking-at "[0-9]+")
2602 (string-to-int (buffer-substring-no-properties
2603 (match-beginning 0) (match-end 0)))
2604 0))
2605 (setq exp (format "^%d:\\s-*[[{<]\\([?+-]\\)[]>}]" depth)))
2606 (save-excursion
2607 (end-of-line)
2608 (if (re-search-backward exp nil t)
2609 (setq start (point))
2610 (error "Center error"))
2611 (save-excursion ;Not sure about this part.
2612 (end-of-line)
2613 (setq p (point))
2614 (while (and (not (re-search-forward exp nil t))
2615 (>= depth 0))
2616 (setq depth (1- depth))
2617 (setq exp (format "^%d:\\s-*[[{<]\\([?+-]\\)[]>}]" depth)))
2618 (if (/= (point) p)
2619 (setq end (point))
2620 (setq end (point-max)))))
2621 ;; Now work out the details of centering
2622 (let ((nl (count-lines start end))
2623 (cp (point)))
2624 (if (> nl (window-height (selected-window)))
2625 ;; We can't fit it all, so just center on cursor
2626 (progn (goto-char start)
2627 (recenter 1))
2628 ;; we can fit everything on the screen, but...
2629 (if (and (pos-visible-in-window-p start (selected-window))
2630 (pos-visible-in-window-p end (selected-window)))
2631 ;; we are all set!
2632 nil
2633 ;; we need to do something...
2634 (goto-char start)
2635 (let ((newcent (/ (- (window-height (selected-window)) nl) 2))
2636 (lte (count-lines start (point-max))))
2637 (if (and (< (+ newcent lte) (window-height (selected-window)))
2638 (> (- (window-height (selected-window)) lte 1)
2639 newcent))
2640 (setq newcent (- (window-height (selected-window))
2641 lte 1)))
2642 (recenter newcent))))
2643 (goto-char cp)))))
2644
2645
2646;;; Tag Management -- Imenu
2647;;
2648(if (not speedbar-use-imenu-flag)
2649
2650 nil
2651
2652(eval-when-compile (if (locate-library "imenu") (require 'imenu)))
2653
2654(defun speedbar-fetch-dynamic-imenu (file)
2655 "Load FILE into a buffer, and generate tags using Imenu.
2656Returns the tag list, or t for an error."
2657 ;; Load this AND compile it in
2658 (require 'imenu)
2659 (save-excursion
2660 (set-buffer (find-file-noselect file))
2661 (if speedbar-power-click (setq imenu--index-alist nil))
2662 (condition-case nil
2663 (let ((index-alist (imenu--make-index-alist t)))
2664 (if speedbar-sort-tags
2665 (sort (copy-alist index-alist)
2666 (lambda (a b) (string< (car a) (car b))))
2667 index-alist))
2668 (error t))))
2669)
2670
2671;;; Tag Management -- etags (old XEmacs compatibility part)
2672;;
2673(defvar speedbar-fetch-etags-parse-list
2674 '(;; Note that java has the same parse-group as c
2675 ("\\.\\([cChH]\\|c\\+\\+\\|cpp\\|cc\\|hh\\|java\\)\\'" .
2676 speedbar-parse-c-or-c++tag)
2677 ("^\\.emacs$\\|.\\(el\\|l\\|lsp\\)\\'" .
2678 "def[^i]+\\s-+\\(\\(\\w\\|[-_]\\)+\\)\\s-*\C-?")
2679 ("\\.tex\\'" . speedbar-parse-tex-string)
2680 ("\\.p\\'" .
2681 "\\(\\(FUNCTION\\|function\\|PROCEDURE\\|procedure\\)\\s-+\\([a-zA-Z0-9_.:]+\\)\\)\\s-*(?^?")
2682 )
2683 "Associations of file extensions and expressions for extracting tags.
2684To add a new file type, you would want to add a new association to the
2685list, where the car is the file match, and the cdr is the way to
2686extract an element from the tags output. If the output is complex,
2687use a function symbol instead of regexp. The function should expect
2688to be at the beginning of a line in the etags buffer.
2689
2690This variable is ignored if `speedbar-use-imenu-flag' is non-nil.")
2691
2692(defvar speedbar-fetch-etags-command "etags"
2693 "*Command used to create an etags file.
2694
2695This variable is ignored if `speedbar-use-imenu-flag' is t")
2696
2697(defvar speedbar-fetch-etags-arguments '("-D" "-I" "-o" "-")
2698 "*List of arguments to use with `speedbar-fetch-etags-command'.
2699This creates an etags output buffer. Use `speedbar-toggle-etags' to
2700modify this list conveniently.
2701
2702This variable is ignored if `speedbar-use-imenu-flag' is t")
2703
2704(defun speedbar-toggle-etags (flag)
2705 "Toggle FLAG in `speedbar-fetch-etags-arguments'.
2706FLAG then becomes a member of etags command line arguments. If flag
2707is \"sort\", then toggle the value of `speedbar-sort-tags'. If its
2708value is \"show\" then toggle the value of
2709`speedbar-show-unknown-files'.
2710
2711 This function is a convenience function for XEmacs menu created by
2712Farzin Guilak <farzin@protocol.com>"
2713 (interactive)
2714 (cond
2715 ((equal flag "sort")
2716 (setq speedbar-sort-tags (not speedbar-sort-tags)))
2717 ((equal flag "show")
2718 (setq speedbar-show-unknown-files (not speedbar-show-unknown-files)))
2719 ((or (equal flag "-C")
2720 (equal flag "-S")
2721 (equal flag "-D"))
2722 (if (member flag speedbar-fetch-etags-arguments)
2723 (setq speedbar-fetch-etags-arguments
2724 (delete flag speedbar-fetch-etags-arguments))
2725 (add-to-list 'speedbar-fetch-etags-arguments flag)))
2726 (t nil)))
2727
2728(defun speedbar-fetch-dynamic-etags (file)
2729 "For FILE, run etags and create a list of symbols extracted.
2730Each symbol will be associated with its line position in FILE."
2731 (let ((newlist nil))
2732 (unwind-protect
2733 (save-excursion
2734 (if (get-buffer "*etags tmp*")
2735 (kill-buffer "*etags tmp*")) ;kill to clean it up
2736 (if (<= 1 speedbar-verbosity-level) (message "Fetching etags..."))
2737 (set-buffer (get-buffer-create "*etags tmp*"))
2738 (apply 'call-process speedbar-fetch-etags-command nil
2739 (current-buffer) nil
2740 (append speedbar-fetch-etags-arguments (list file)))
2741 (goto-char (point-min))
2742 (if (<= 1 speedbar-verbosity-level) (message "Fetching etags..."))
2743 (let ((expr
2744 (let ((exprlst speedbar-fetch-etags-parse-list)
2745 (ans nil))
2746 (while (and (not ans) exprlst)
2747 (if (string-match (car (car exprlst)) file)
2748 (setq ans (car exprlst)))
2749 (setq exprlst (cdr exprlst)))
2750 (cdr ans))))
2751 (if expr
2752 (let (tnl)
2753 (while (not (save-excursion (end-of-line) (eobp)))
2754 (save-excursion
2755 (setq tnl (speedbar-extract-one-symbol expr)))
2756 (if tnl (setq newlist (cons tnl newlist)))
2757 (forward-line 1)))
2758 (message "Sorry, no support for a file of that extension"))))
2759 )
2760 (if speedbar-sort-tags
2761 (sort newlist (lambda (a b) (string< (car a) (car b))))
2762 (reverse newlist))))
2763
2764;; This bit donated by Farzin Guilak <farzin@protocol.com> but I'm not
2765;; sure it's needed with the different sorting method.
2766;;
2767;(defun speedbar-clean-etags()
2768; "Removes spaces before the ^? character, and removes `#define',
2769;return types, etc. preceding tags. This ensures that the sort operation
2770;works on the tags, not the return types."
2771; (save-excursion
2772; (goto-char (point-min))
2773; (while
2774; (re-search-forward "(?[ \t](?\C-?" nil t)
2775; (replace-match "\C-?" nil nil))
2776; (goto-char (point-min))
2777; (while
2778; (re-search-forward "\\(.*[ \t]+\\)\\([^ \t\n]+.*\C-?\\)" nil t)
2779; (delete-region (match-beginning 1) (match-end 1)))))
2780
2781(defun speedbar-extract-one-symbol (expr)
2782 "At point, return nil, or one alist in the form: ( symbol . position )
2783The line should contain output from etags. Parse the output using the
2784regular expression EXPR"
2785 (let* ((sym (if (stringp expr)
2786 (if (save-excursion
2787 (re-search-forward expr (save-excursion
2788 (end-of-line)
2789 (point)) t))
2790 (buffer-substring-no-properties (match-beginning 1)
2791 (match-end 1)))
2792 (funcall expr)))
2793 (pos (let ((j (re-search-forward "[\C-?\C-a]\\([0-9]+\\),\\([0-9]+\\)"
2794 (save-excursion
2795 (end-of-line)
2796 (point))
2797 t)))
2798 (if (and j sym)
2799 (1+ (string-to-int (buffer-substring-no-properties
2800 (match-beginning 2)
2801 (match-end 2))))
2802 0))))
2803 (if (/= pos 0)
2804 (cons sym pos)
2805 nil)))
2806
2807(defun speedbar-parse-c-or-c++tag ()
2808 "Parse a c or c++ tag, which tends to be a little complex."
2809 (save-excursion
2810 (let ((bound (save-excursion (end-of-line) (point))))
2811 (cond ((re-search-forward "\C-?\\([^\C-a]+\\)\C-a" bound t)
2812 (buffer-substring-no-properties (match-beginning 1)
2813 (match-end 1)))
2814 ((re-search-forward "\\<\\([^ \t]+\\)\\s-+new(" bound t)
2815 (buffer-substring-no-properties (match-beginning 1)
2816 (match-end 1)))
2817 ((re-search-forward "\\<\\([^ \t(]+\\)\\s-*(\C-?" bound t)
2818 (buffer-substring-no-properties (match-beginning 1)
2819 (match-end 1)))
2820 (t nil))
2821 )))
2822
2823(defun speedbar-parse-tex-string ()
2824 "Parse a Tex string. Only find data which is relevant."
2825 (save-excursion
2826 (let ((bound (save-excursion (end-of-line) (point))))
2827 (cond ((re-search-forward "\\(\\(sub\\)*section\\|chapter\\|cite\\)\\s-*{[^\C-?}]*}?" bound t)
2828 (buffer-substring-no-properties (match-beginning 0)
2829 (match-end 0)))
2830 (t nil)))))
2831
2832
2833;;; Color loading section This is messy *Blech!*
2834;;
2835(defface speedbar-button-face '((((class color) (background light))
2836 (:foreground "green4"))
2837 (((class color) (background dark))
2838 (:foreground "green3")))
2839 "Face used for +/- buttons."
2840 :group 'speedbar-faces)
2841
2842(defface speedbar-file-face '((((class color) (background light))
2843 (:foreground "cyan4"))
2844 (((class color) (background dark))
2845 (:foreground "cyan"))
2846 (t (:bold t)))
2847 "Face used for file names."
2848 :group 'speedbar-faces)
2849
2850(defface speedbar-directory-face '((((class color) (background light))
2851 (:foreground "blue4"))
2852 (((class color) (background dark))
2853 (:foreground "light blue")))
2854 "Faced used for directory names."
2855 :group 'speedbar-faces)
2856(defface speedbar-tag-face '((((class color) (background light))
2857 (:foreground "brown"))
2858 (((class color) (background dark))
2859 (:foreground "yellow")))
2860 "Face used for displaying tags."
2861 :group 'speedbar-faces)
2862
2863(defface speedbar-selected-face '((((class color) (background light))
2864 (:foreground "red" :underline t))
2865 (((class color) (background dark))
2866 (:foreground "red" :underline t))
2867 (t (:underline t)))
2868 "Face used to underline the file in the active window."
2869 :group 'speedbar-faces)
2870
2871(defface speedbar-highlight-face '((((class color) (background light))
2872 (:background "green"))
2873 (((class color) (background dark))
2874 (:background "sea green"))
2875 (((class grayscale monochrome)
2876 (background light))
2877 (:background "black"))
2878 (((class grayscale monochrome)
2879 (background dark))
2880 (:background "white")))
2881 "Face used for highlighting buttons with the mouse."
2882 :group 'speedbar-faces)
2883
2884;; some edebug hooks
2885(add-hook 'edebug-setup-hook
2886 (lambda ()
2887 (def-edebug-spec speedbar-with-writable def-body)))
2888
2889(provide 'speedbar)
2890;;; speedbar ends here
2891
2892;; run load-time hooks
2893(run-hooks 'speedbar-load-hook)
generated by cgit v1.2.1 (git 2.18.0) at 2026-02-09 22:37:45 +0000