(bat-generic-mode): "::"-style comments don't
[bpt/emacs.git] / lisp / speedbar.el
CommitLineData
59588cd4 1;;; speedbar --- quick access to files and tags in a frame
6b3eac8d 2
8afc622b 3;;; Copyright (C) 1996, 97, 98, 99 Free Software Foundation
59588cd4
KH
4
5;; Author: Eric M. Ludlam <zappo@gnu.org>
8afc622b 6;; Version: 0.8.1
59588cd4 7;; Keywords: file, tags, tools
cc5034d2 8;; X-RCS: $Id: speedbar.el,v 1.23 1999/06/04 18:22:55 kwzh Exp rms $
59588cd4 9
6b3eac8d 10;; This file is part of GNU Emacs.
59588cd4 11
6b3eac8d
DN
12;; GNU Emacs is free software; you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation; either version 2, or (at your option)
15;; any later version.
59588cd4 16
6b3eac8d
DN
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
59588cd4 21
6b3eac8d
DN
22;; You should have received a copy of the GNU General Public License
23;; along with GNU Emacs; see the file COPYING. If not, write to the
24;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25;; Boston, MA 02111-1307, USA.
26
27;;; Commentary:
28;;
29;; The speedbar provides a frame in which files, and locations in
30;; files are displayed. These items can be clicked on with mouse-2
31;; in order to make the last active frame display that file location.
32;;
33;; Starting Speedbar:
34;;
35;; If speedbar came to you as a part of Emacs, simply type
59588cd4 36;; `M-x speedbar', and it will be autoloaded for you.
6b3eac8d
DN
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;;
59588cd4 44;; If you want to choose it from a menu, such as "Tools", you can do this:
6b3eac8d
DN
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
59588cd4 91;; file imenu.el that comes with Emacs. To add new file types which
6b3eac8d
DN
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;;
59588cd4
KH
104;; To enable mouse tracking with information in the minibuffer of
105;; the attached frame, use the variable `speedbar-track-mouse-flag'.
106;;
107;; Tag layout can be modified through `speedbar-tag-hierarchy-method',
108;; which controls how tags are layed out. It is actually a list of
109;; functions that filter the data. The default groups large tag lists
110;; into sub-lists. A long flat list can be used instead if needed.
111;; Other filters could be easily added.
112;;
113;; Users of XEmacs previous to 20 may want to change the default
6b3eac8d
DN
114;; timeouts for `speedbar-update-speed' to something longer as XEmacs
115;; doesn't have idle timers, the speedbar timer keeps going off
116;; arbitrarily while you're typing. It's quite pesky.
117;;
118;; Users of really old emacsen without the needed timers will not
119;; have speedbar updating automatically. Use "r" to refresh the
120;; display after changing directories. Remember, do not interrupt the
121;; stealthy updates or your display may not be completely refreshed.
122;;
6b3eac8d
DN
123;; AUC-TEX users: The imenu tags for AUC-TEX mode don't work very
124;; well. Use the imenu keywords from tex-mode.el for better results.
125;;
126;; This file requires the library package assoc (association lists)
127;; and the package custom (for easy configuration of speedbar)
128;; http://www.dina.kvl.dk/~abraham/custom/
129;;
59588cd4 130;;; Developing for speedbar
6b3eac8d 131;;
59588cd4 132;; Adding a speedbar specialized display mode:
6b3eac8d 133;;
59588cd4
KH
134;; Speedbar can be configured to create a special display for certain
135;; modes that do not display tradition file/tag data. Rmail, Info,
136;; and the debugger are examples. These modes can, however, benefit
137;; from a speedbar style display in their own way.
138;;
139;; If your `major-mode' is `foo-mode', the only requirement is to
140;; create a function called `foo-speedbar-buttons' which takes one
141;; argument, BUFFER. BUFFER will be the buffer speedbar wants filled.
142;; In `foo-speedbar-buttons' there are several functions that make
143;; building a speedbar display easy. See the documentation for
144;; `speedbar-with-writable' (needed because the buffer is usually
145;; read-only) `speedbar-make-tag-line', `speedbar-insert-button', and
146;; `speedbar-insert-generic-list'. If you use
147;; `speedbar-insert-generic-list', also read the doc for
148;; `speedbar-tag-hierarchy-method' in case you wish to override it.
149;; The function `speedbar-with-attached-buffer' brings you back to the
150;; buffer speedbar is displaying for.
151;;
152;; For those functions that make buttons, the "function" should be a
153;; symbol that is the function to call when clicked on. The "token"
154;; is extra data you can pass along. The "function" must take three
155;; parameters. They are (TEXT TOKEN INDENT). TEXT is the text of the
156;; button clicked on. TOKEN is the data passed in when you create the
157;; button. INDENT is an indentation level, or 0. You can store
158;; indentation levels with `speedbar-make-tag-line' which creates a
159;; line with an expander (eg. [+]) and a text button.
160;;
161;; Some useful functions when writing expand functions, and click
162;; functions are `speedbar-change-expand-button-char',
163;; `speedbar-delete-subblock', and `speedbar-center-buffer-smartly'.
164;; The variable `speedbar-power-click' is set to t in your functions
165;; when the user shift-clicks. This indications anything from
166;; refreshing cached data to making a buffer appear in a new frame.
167;;
168;; If you wish to add to the default speedbar menu for the case of
169;; `foo-mode', create a variable `foo-speedbar-menu-items'. This
170;; should be a list compatible with the `easymenu' package. It will
171;; be spliced into the main menu. (Available with click-mouse-3). If
172;; you wish to have extra key bindings in your special mode, create a
173;; variable `foo-speedbar-key-map'. Instead of using `make-keymap',
174;; or `make-sparse-keymap', use the function
175;; `speedbar-make-specialized-keymap'. This lets you inherit all of
176;; speedbar's default bindings with low overhead.
177;;
178;; Adding a speedbar top-level display mode:
179;;
180;; Unlike the specialized modes, there are no name requirements,
181;; however the methods for writing a button display, menu, and keymap
182;; are the same. Once you create these items, you can call the
183;; function `speedbar-add-expansion-list'. It takes one parameter
184;; which is a list element of the form (NAME MENU KEYMAP &rest
185;; BUTTON-FUNCTIONS). NAME is a string that will show up in the
186;; Displays menu item. MENU is a symbol containing the menu items to
187;; splice in. KEYMAP is a symbol holding the keymap to use, and
188;; BUTTON-FUNCTIONS are the function names to call, in order, to create
189;; the display.
39273816
KH
190;; Another tweekable variable is `speedbar-stealthy-function-list'
191;; which is of the form (NAME &rest FUNCTION ...). NAME is the string
192;; name matching `speedbar-add-expansion-list'. (It does not need to
193;; exist.). This provides additional display info which might be
194;; time-consuming to calculate.
195;; Lastly, `speedbar-mode-functions-list' allows you to set special
196;; function overrides. At the moment very few functions are
197;; over ridable, but more will be added as the need is discovered.
6b3eac8d
DN
198
199;;; TODO:
200;; - More functions to create buttons and options
6b3eac8d
DN
201;; - Timeout directories we haven't visited in a while.
202;; - Remeber tags when refreshing the display. (Refresh tags too?)
203;; - More 'special mode support.
6b3eac8d
DN
204
205(require 'assoc)
206(require 'easymenu)
207
59588cd4
KH
208(defvar speedbar-xemacsp (string-match "XEmacs" emacs-version)
209 "Non-nil if we are running in the XEmacs environment.")
210(defvar speedbar-xemacs20p (and speedbar-xemacsp
211 (= emacs-major-version 20)))
212
6b3eac8d
DN
213;; From custom web page for compatibility between versions of custom:
214(eval-and-compile
215 (condition-case ()
216 (require 'custom)
217 (error nil))
59588cd4
KH
218 (if (and (featurep 'custom) (fboundp 'custom-declare-variable)
219 ;; Some XEmacsen w/ custom don't have :set keyword.
220 ;; This protects them against custom.
221 (fboundp 'custom-initialize-set))
6b3eac8d
DN
222 nil ;; We've got what we needed
223 ;; We have the old custom-library, hack around it!
224 (defmacro defgroup (&rest args)
225 nil)
226 (defmacro defface (var values doc &rest args)
227 (` (progn
228 (defvar (, var) (quote (, var)))
229 ;; To make colors for your faces you need to set your .Xdefaults
230 ;; or set them up ahead of time in your .emacs file.
231 (make-face (, var))
232 )))
233 (defmacro defcustom (var value doc &rest args)
234 (` (defvar (, var) (, value) (, doc))))))
235
236;; customization stuff
237(defgroup speedbar nil
238 "File and tag browser frame."
239 :group 'tags
25709c0d 240 :group 'tools
f5f727f8 241 :group 'convenience
25709c0d 242 :version "20.3")
6b3eac8d
DN
243
244(defgroup speedbar-faces nil
245 "Faces used in speedbar."
246 :prefix "speedbar-"
247 :group 'speedbar
248 :group 'faces)
249
250(defgroup speedbar-vc nil
251 "Version control display in speedbar."
252 :prefix "speedbar-"
253 :group 'speedbar)
254
255;;; Code:
59588cd4
KH
256(defvar speedbar-initial-expansion-mode-alist
257 '(("buffers" speedbar-buffer-easymenu-definition speedbar-buffers-key-map
258 speedbar-buffer-buttons)
259 ("quick buffers" speedbar-buffer-easymenu-definition speedbar-buffers-key-map
260 speedbar-buffer-buttons-temp)
261 ;; Files last, means first in the Displays menu
262 ("files" speedbar-easymenu-definition-special speedbar-file-key-map
263 speedbar-directory-buttons speedbar-default-directory-list)
264 )
265 "List of named expansion elements for filling the speedbar frame.
266These expansion lists are only valid for regular files. Special modes
267still get to override this list on a mode-by-mode basis. This list of
268lists is of the form (NAME MENU KEYMAP FN1 FN2 ...). NAME is a string
269representing the types of things to be displayed. MENU is an easymenu
270structure used when in this mode. KEYMAP is a local keymap to install
271over the regular speedbar keymap. FN1 ... are functions that will be
272called in order. These functions will always get the default
273directory to use passed in as the first parameter, and a 0 as the
274second parameter. The 0 indicates the uppermost indentation level.
275They must assume that the cursor is at the position where they start
276inserting buttons.")
277
f412d5dd 278(defvar speedbar-initial-expansion-list-name "files"
59588cd4
KH
279 "A symbol name representing the expansion list to use.
280The expansion list `speedbar-initial-expansion-mode-alist' contains
f412d5dd 281the names and associated functions to use for buttons in speedbar.")
59588cd4
KH
282
283(defvar speedbar-previously-used-expansion-list-name "files"
284 "Save the last expansion list method.
285This is used for returning to a previous expansion list method when
286the user is done with the current expansion list.")
6b3eac8d
DN
287
288(defvar speedbar-stealthy-function-list
59588cd4
KH
289 '(("files"
290 speedbar-update-current-file speedbar-check-vc speedbar-check-objects)
291 )
6b3eac8d 292 "List of functions to periodically call stealthily.
59588cd4
KH
293This list is of the form:
294 '( (\"NAME\" FUNCTION ...)
295 ...)
296where NAME is the name of the major display mode these functions are
297for, and the remaining elements FUNCTION are functions to call in order.
6b3eac8d
DN
298Each function must return nil if interrupted, or t if completed.
299Stealthy functions which have a single operation should always return
300t. Functions which take a long time should maintain a state (where
301they are in their speedbar related calculations) and permit
302interruption. See `speedbar-check-vc' as a good example.")
303
8afc622b
EL
304(defvar speedbar-mode-functions-list
305 '(("files" (speedbar-item-info . speedbar-files-item-info)
306 (speedbar-line-path . speedbar-files-line-path))
307 ("buffers" (speedbar-item-info . speedbar-buffers-item-info)
308 (speedbar-line-path . speedbar-buffers-line-path))
309 ("quick buffers" (speedbar-item-info . speedbar-buffers-item-info)
310 (speedbar-line-path . speedbar-buffers-line-path))
311 )
312 "List of function tables to use for different major display modes.
313It is not necessary to define any functions for a specialized mode.
314This just provides a simple way of adding lots of customizations.
315Each sublist is of the form:
316 (\"NAME\" (FUNCTIONSYMBOL . REPLACEMENTFUNCTION) ...)
317Where NAME is the name of the specialized mode. The rest of the list
318is a set of dotted pairs of the form FUNCTIONSYMBOL, which is the name
319of a function you would like to replace, and REPLACEMENTFUNCTION,
320which is a function you can call instead. Not all functions can be
321replaced this way. Replaceable functions must provide that
322functionality individually.")
323
6b3eac8d
DN
324(defcustom speedbar-mode-specific-contents-flag t
325 "*Non-nil means speedbar will show special mode contents.
326This permits some modes to create customized contents for the speedbar
327frame."
328 :group 'speedbar
329 :type 'boolean)
330
331(defvar speedbar-special-mode-expansion-list nil
59588cd4
KH
332 "Default function list for creating specialized button lists.
333This list is set by modes that wish to have special speedbar displays.
334The list is of function names. Each function is called with one
335parameter BUFFER, the originating buffer. The current buffer is the
336speedbar buffer.")
6b3eac8d 337
59588cd4
KH
338(defvar speedbar-special-mode-key-map nil
339 "Default keymap used when identifying a specialized display mode.
340This keymap is local to each buffer that wants to define special keybindings
341effective when it's display is shown.")
6b3eac8d
DN
342
343(defcustom speedbar-visiting-file-hook nil
344 "Hooks run when speedbar visits a file in the selected frame."
345 :group 'speedbar
346 :type 'hook)
347
348(defcustom speedbar-visiting-tag-hook nil
349 "Hooks run when speedbar visits a tag in the selected frame."
350 :group 'speedbar
351 :type 'hook)
352
353(defcustom speedbar-load-hook nil
354 "Hooks run when speedbar is loaded."
355 :group 'speedbar
356 :type 'hook)
357
358(defcustom speedbar-show-unknown-files nil
359 "*Non-nil show files we can't expand with a ? in the expand button.
360nil means don't show the file in the list."
361 :group 'speedbar
362 :type 'boolean)
363
364(defcustom speedbar-update-speed
365 (if speedbar-xemacsp
366 (if speedbar-xemacs20p
367 2 ; 1 is too obrusive in XEmacs
368 5) ; when no idleness, need long delay
369 1)
370 "*Idle time in seconds needed before speedbar will update itself.
371Updates occur to allow speedbar to display directory information
372relevant to the buffer you are currently editing."
373 :group 'speedbar
374 :type 'integer)
375
59588cd4
KH
376;; When I moved to a repeating timer, I had the horrible missfortune
377;; of loosing the ability for adaptive speed choice. This update
378;; speed currently causes long delays when it should have been turned off.
379(defcustom speedbar-navigating-speed speedbar-update-speed
6b3eac8d
DN
380 "*Idle time to wait after navigation commands in speedbar are executed.
381Navigation commands included expanding/contracting nodes, and moving
382between different directories."
383 :group 'speedbar
384 :type 'integer)
385
386(defcustom speedbar-frame-parameters '((minibuffer . nil)
387 (width . 20)
6b3eac8d
DN
388 (border-width . 0)
389 (menu-bar-lines . 0)
390 (unsplittable . t))
391 "*Parameters to use when creating the speedbar frame in Emacs.
392Parameters not listed here which will be added automatically are
393`height' which will be initialized to the height of the frame speedbar
394is attached to."
395 :group 'speedbar
396 :type '(repeat (sexp :tag "Parameter:")))
397
398;; These values by Hrvoje Niksic <hniksic@srce.hr>
399(defcustom speedbar-frame-plist
400 '(minibuffer nil width 20 border-width 0
401 internal-border-width 0 unsplittable t
402 default-toolbar-visible-p nil has-modeline-p nil
8583d8b3 403 menubar-visible-p nil)
6b3eac8d
DN
404 "*Parameters to use when creating the speedbar frame in XEmacs.
405Parameters not listed here which will be added automatically are
406`height' which will be initialized to the height of the frame speedbar
407is attached to."
408 :group 'speedbar
409 :type '(repeat (group :inline t
410 (symbol :tag "Property")
411 (sexp :tag "Value"))))
412
413(defcustom speedbar-use-imenu-flag (stringp (locate-library "imenu"))
414 "*Non-nil means use imenu for file parsing. nil to use etags.
415XEmacs prior to 20.4 doesn't support imenu, therefore the default is to
416use etags instead. Etags support is not as robust as imenu support."
417 :tag "User Imenu"
418 :group 'speedbar
419 :type 'boolean)
420
59588cd4
KH
421(defcustom speedbar-track-mouse-flag t
422 "*Non-nil means to display info about the line under the mouse."
423 :group 'speedbar
424 :type 'boolean)
425
6b3eac8d 426(defcustom speedbar-sort-tags nil
59588cd4 427 "*If Non-nil, sort tags in the speedbar display. *Obsolete*."
6b3eac8d
DN
428 :group 'speedbar
429 :type 'boolean)
430
59588cd4
KH
431(defcustom speedbar-tag-hierarchy-method
432 '(prefix-group trim-words)
433 "*List of methods which speedbar will use to organize tags into groups.
434Groups are defined as expandable meta-tags. Imenu supports such
435things in some languages, such as separating variables from functions.
436Available methods are:
437 sort - Sort tags. (sometimes unnecessary)
438 trim-words - Trim all tags by a common prefix, broken @ word sections.
439 prefix-group - Try to guess groups by prefix.
440 simple-group - If imenu already returned some meta groups, stick all
441 tags that are not in a group into a sub-group."
442 :group 'speedbar
443 :type '(repeat
444 (radio
445 (const :tag "Sort the tags." sort)
446 (const :tag "Trim words to common prefix." trim-words)
447 (const :tag "Create groups from common prefixes." prefix-group)
448 (const :tag "Group loose tags into their own group." simple-group))
449 ))
450
8583d8b3
EL
451(defcustom speedbar-tag-group-name-minimum-length 4
452 "*The minimum length of a prefix group name before expanding.
453Thus, if the `speedbar-tag-hierarchy-method' includes `prefix-group'
454and one such groups common characters is less than this number of
455characters, then the group name will be changed to the form of:
456 worda to wordb
457instead of just
458 word
459This way we won't get silly looking listings."
460 :group 'speedbar
461 :type 'integer)
462
59588cd4
KH
463(defcustom speedbar-tag-split-minimum-length 20
464 "*Minimum length before we stop trying to create sub-lists in tags.
465This is used by all tag-hierarchy methods that break large lists into
466sub-lists."
467 :group 'speedbar
468 :type 'integer)
469
470(defcustom speedbar-tag-regroup-maximum-length 10
471 "*Maximum length of submenus that are regrouped.
472If the regrouping option is used, then if two or more short subgroups
473are next to each other, then they are combined until this number of
474items is reached."
475 :group 'speedbar
476 :type 'integer)
477
6b3eac8d
DN
478(defcustom speedbar-activity-change-focus-flag nil
479 "*Non-nil means the selected frame will change based on activity.
480Thus, if a file is selected for edit, the buffer will appear in the
481selected frame and the focus will change to that frame."
482 :group 'speedbar
483 :type 'boolean)
484
485(defcustom speedbar-directory-button-trim-method 'span
486 "*Indicates how the directory button will be displayed.
487Possible values are:
488 'span - span large directories over multiple lines.
489 'trim - trim large directories to only show the last few.
490 nil - no trimming."
491 :group 'speedbar
492 :type '(radio (const :tag "Span large directories over mutiple lines."
493 span)
494 (const :tag "Trim large directories to only show the last few."
495 trim)
496 (const :tag "No trimming." nil)))
497
498(defcustom speedbar-smart-directory-expand-flag t
499 "*Non-nil means speedbar should use smart expansion.
500Smart expansion only affects when speedbar wants to display a
501directory for a file in the attached frame. When smart expansion is
502enabled, new directories which are children of a displayed directory
503are expanded in the current framework. If nil, then the current
504hierarchy would be replaced with the new directory."
505 :group 'speedbar
506 :type 'boolean)
507
59588cd4
KH
508(defvar speedbar-hide-button-brackets-flag nil
509 "*Non-nil means speedbar will hide the brackets around the + or -.")
510
6b3eac8d
DN
511(defcustom speedbar-before-popup-hook nil
512 "*Hooks called before popping up the speedbar frame."
513 :group 'speedbar
514 :type 'hook)
515
516(defcustom speedbar-before-delete-hook nil
517 "*Hooks called before deleting the speedbar frame."
518 :group 'speedbar
519 :type 'hook)
520
521(defcustom speedbar-mode-hook nil
522 "*Hooks called after creating a speedbar buffer."
523 :group 'speedbar
524 :type 'hook)
525
526(defcustom speedbar-timer-hook nil
527 "*Hooks called after running the speedbar timer function."
528 :group 'speedbar
529 :type 'hook)
530
531(defcustom speedbar-verbosity-level 1
532 "*Verbosity level of the speedbar. 0 means say nothing.
5331 means medium level verbosity. 2 and higher are higher levels of
534verbosity."
535 :group 'speedbar
536 :type 'integer)
537
59588cd4
KH
538(defvar speedbar-indicator-separator " "
539 "String separating file text from indicator characters.")
540
6b3eac8d
DN
541(defcustom speedbar-vc-do-check t
542 "*Non-nil check all files in speedbar to see if they have been checked out.
543Any file checked out is marked with `speedbar-vc-indicator'"
544 :group 'speedbar-vc
545 :type 'boolean)
546
59588cd4 547(defvar speedbar-vc-indicator "*"
6b3eac8d
DN
548 "Text used to mark files which are currently checked out.
549Currently only RCS is supported. Other version control systems can be
550added by examining the function `speedbar-this-file-in-vc' and
551`speedbar-vc-check-dir-p'")
552
6b3eac8d
DN
553(defcustom speedbar-vc-path-enable-hook nil
554 "*Return non-nil if the current path should be checked for Version Control.
555Functions in this hook must accept one parameter which is the path
556being checked."
557 :group 'speedbar-vc
558 :type 'hook)
559
560(defcustom speedbar-vc-in-control-hook nil
561 "*Return non-nil if the specified file is under Version Control.
562Functions in this hook must accept two parameters. The PATH of the
563current file, and the FILENAME of the file being checked."
564 :group 'speedbar-vc
565 :type 'hook)
566
567(defvar speedbar-vc-to-do-point nil
568 "Local variable maintaining the current version control check position.")
569
59588cd4
KH
570(defcustom speedbar-obj-do-check t
571 "*Non-nil check all files in speedbar to see if they have an object file.
572Any file checked out is marked with `speedbar-obj-indicator', and the
573marking is based on `speedbar-obj-alist'"
574 :group 'speedbar-vc
575 :type 'boolean)
576
577(defvar speedbar-obj-to-do-point nil
578 "Local variable maintaining the current version control check position.")
579
580(defvar speedbar-obj-indicator '("#" . "!")
581 "Text used to mark files that have a corresponding hidden object file.
582The car is for an up-to-date object. The cdr is for an out of date object.
583The expression `speedbar-obj-alist' defines who gets tagged.")
584
585(defvar speedbar-obj-alist
586 '(("\\.\\([cpC]\\|cpp\\|cc\\)$" . ".o")
587 ("\\.el$" . ".elc")
588 ("\\.java$" . ".class")
589 ("\\.f\\(or\\|90\\|77\\)?$" . ".o")
590 ("\\.tex$" . ".dvi")
591 ("\\.texi$" . ".info"))
592 "Alist of file extensions, and their corresponding object file type.")
593
594(defvar speedbar-indicator-regex
595 (concat (regexp-quote speedbar-indicator-separator)
596 "\\("
597 (regexp-quote speedbar-vc-indicator)
598 "\\|"
599 (regexp-quote (car speedbar-obj-indicator))
600 "\\|"
601 (regexp-quote (cdr speedbar-obj-indicator))
602 "\\)*")
603 "Regular expression used when identifying files.
604Permits stripping of indicator characters from a line.")
605
606(defcustom speedbar-scanner-reset-hook nil
607 "*Hook called whenever generic scanners are reset.
608Set this to implement your own scanning / rescan safe functions with
609state data."
610 :group 'speedbar
611 :type 'hook)
612
6b3eac8d
DN
613(defvar speedbar-ignored-modes nil
614 "*List of major modes which speedbar will not switch directories for.")
615
616(defun speedbar-extension-list-to-regex (extlist)
617 "Takes EXTLIST, a list of extensions and transforms it into regexp.
59588cd4
KH
618All the preceding `.' are stripped for an optimized expression starting
619with `.' followed by extensions, followed by full-filenames."
6b3eac8d
DN
620 (let ((regex1 nil) (regex2 nil))
621 (while extlist
622 (if (= (string-to-char (car extlist)) ?.)
623 (setq regex1 (concat regex1 (if regex1 "\\|" "")
624 (substring (car extlist) 1)))
625 (setq regex2 (concat regex2 (if regex2 "\\|" "") (car extlist))))
626 (setq extlist (cdr extlist)))
627 ;; concat all the sub-exressions together, making sure all types
628 ;; of parts exist during concatination.
629 (concat "\\("
630 (if regex1 (concat "\\(\\.\\(" regex1 "\\)\\)") "")
631 (if (and regex1 regex2) "\\|" "")
632 (if regex2 (concat "\\(" regex2 "\\)") "")
633 "\\)$")))
634
635(defvar speedbar-ignored-path-regexp nil
636 "Regular expression matching paths speedbar will not switch to.
637Created from `speedbar-ignored-path-expressions' with the function
638`speedbar-extension-list-to-regex' (A misnamed function in this case.)
639Use the function `speedbar-add-ignored-path-regexp', or customize the
640variable `speedbar-ignored-path-expressions' to modify this variable.")
641
642(defcustom speedbar-ignored-path-expressions
643 '("/logs?/\\'")
644 "*List of regular expressions matching directories speedbar will ignore.
645They should included paths to directories which are notoriously very
646large and take a long time to load in. Use the function
647`speedbar-add-ignored-path-regexp' to add new items to this list after
648speedbar is loaded. You may place anything you like in this list
649before speedbar has been loaded."
650 :group 'speedbar
651 :type '(repeat (regexp :tag "Path Regexp"))
652 :set (lambda (sym val)
653 (setq speedbar-ignored-path-expressions val
654 speedbar-ignored-path-regexp
655 (speedbar-extension-list-to-regex val))))
656
59588cd4
KH
657(defcustom speedbar-directory-unshown-regexp "^\\(CVS\\|RCS\\|SCCS\\)\\'"
658 "*Regular expression matching directories not to show in speedbar.
659They should include commonly existing directories which are not
660useful, such as version control."
661 :group 'speedbar
662 :type 'string)
663
6b3eac8d
DN
664(defvar speedbar-file-unshown-regexp
665 (let ((nstr "") (noext completion-ignored-extensions))
666 (while noext
667 (setq nstr (concat nstr (regexp-quote (car noext)) "\\'"
668 (if (cdr noext) "\\|" ""))
669 noext (cdr noext)))
a4252bdb
EL
670 ;; backup refdir lockfile
671 (concat nstr "\\|#[^#]+#$\\|\\.\\.?\\'\\|\\.#"))
6b3eac8d
DN
672 "*Regexp matching files we don't want displayed in a speedbar buffer.
673It is generated from the variable `completion-ignored-extensions'")
674
675;; this is dangerous to customize, because the defaults will probably
676;; change in the future.
677(defcustom speedbar-supported-extension-expressions
59588cd4
KH
678 (append '(".[ch]\\(\\+\\+\\|pp\\|c\\|h\\|xx\\)?" ".tex\\(i\\(nfo\\)?\\)?"
679 ".el" ".emacs" ".l" ".lsp" ".p" ".java" ".f\\(90\\|77\\|or\\)?")
6b3eac8d 680 (if speedbar-use-imenu-flag
59588cd4
KH
681 '(".ada" ".pl" ".tcl" ".m" ".scm" ".pm" ".py"
682 ;; html is not supported by default, but an imenu tags package
683 ;; is available. Also, html files are nice to be able to see.
684 ".s?html"
6b3eac8d
DN
685 "Makefile\\(\\.in\\)?")))
686 "*List of regular expressions which will match files supported by tagging.
687Do not prefix the `.' char with a double \\ to quote it, as the period
688will be stripped by a simplified optimizer when compiled into a
689singular expression. This variable will be turned into
690`speedbar-file-regexp' for use with speedbar. You should use the
691function `speedbar-add-supported-extension' to add a new extension at
692runtime, or use the configuration dialog to set it in your .emacs
693file."
694 :group 'speedbar
695 :type '(repeat (regexp :tag "Extension Regexp"))
696 :set (lambda (sym val)
697 (setq speedbar-supported-extension-expressions val
698 speedbar-file-regexp (speedbar-extension-list-to-regex val)))
699 )
700
701(defvar speedbar-file-regexp
702 (speedbar-extension-list-to-regex speedbar-supported-extension-expressions)
703 "Regular expression matching files we know how to expand.
704Created from `speedbar-supported-extension-expression' with the
705function `speedbar-extension-list-to-regex'")
706
707(defun speedbar-add-supported-extension (extension)
708 "Add EXTENSION as a new supported extension for speedbar tagging.
709This should start with a `.' if it is not a complete file name, and
710the dot should NOT be quoted in with \\. Other regular expression
711matchers are allowed however. EXTENSION may be a single string or a
712list of strings."
59588cd4 713 (interactive "sExtionsion: ")
6b3eac8d
DN
714 (if (not (listp extension)) (setq extension (list extension)))
715 (while extension
716 (if (member (car extension) speedbar-supported-extension-expressions)
717 nil
718 (setq speedbar-supported-extension-expressions
719 (cons (car extension) speedbar-supported-extension-expressions)))
720 (setq extension (cdr extension)))
721 (setq speedbar-file-regexp (speedbar-extension-list-to-regex
722 speedbar-supported-extension-expressions)))
723
724(defun speedbar-add-ignored-path-regexp (path-expression)
725 "Add PATH-EXPRESSION as a new ignored path for speedbar tracking.
726This function will modify `speedbar-ignored-path-regexp' and add
727PATH-EXPRESSION to `speedbar-ignored-path-expressions'."
59588cd4 728 (interactive "sPath regex: ")
6b3eac8d
DN
729 (if (not (listp path-expression))
730 (setq path-expression (list path-expression)))
731 (while path-expression
732 (if (member (car path-expression) speedbar-ignored-path-expressions)
733 nil
734 (setq speedbar-ignored-path-expressions
735 (cons (car path-expression) speedbar-ignored-path-expressions)))
736 (setq path-expression (cdr path-expression)))
737 (setq speedbar-ignored-path-regexp (speedbar-extension-list-to-regex
738 speedbar-ignored-path-expressions)))
739
740;; If we don't have custom, then we set it here by hand.
741(if (not (fboundp 'custom-declare-variable))
742 (setq speedbar-file-regexp (speedbar-extension-list-to-regex
743 speedbar-supported-extension-expressions)
744 speedbar-ignored-path-regexp (speedbar-extension-list-to-regex
745 speedbar-ignored-path-expressions)))
746
59588cd4
KH
747(defvar speedbar-update-flag (and
748 (or (fboundp 'run-with-idle-timer)
749 (fboundp 'start-itimer)
750 (boundp 'post-command-idle-hook))
751 window-system)
6b3eac8d
DN
752 "*Non-nil means to automatically update the display.
753When this is nil then speedbar will not follow the attached frame's path.
754When speedbar is active, use:
755
756\\<speedbar-key-map> `\\[speedbar-toggle-updates]'
757
758to toggle this value.")
759
760(defvar speedbar-syntax-table nil
761 "Syntax-table used on the speedbar.")
762
763(if speedbar-syntax-table
764 nil
765 (setq speedbar-syntax-table (make-syntax-table))
766 ;; turn off paren matching around here.
767 (modify-syntax-entry ?\' " " speedbar-syntax-table)
768 (modify-syntax-entry ?\" " " speedbar-syntax-table)
769 (modify-syntax-entry ?( " " speedbar-syntax-table)
770 (modify-syntax-entry ?) " " speedbar-syntax-table)
771 (modify-syntax-entry ?[ " " speedbar-syntax-table)
772 (modify-syntax-entry ?] " " speedbar-syntax-table))
773
6b3eac8d
DN
774(defvar speedbar-key-map nil
775 "Keymap used in speedbar buffer.")
776
777(if speedbar-key-map
778 nil
779 (setq speedbar-key-map (make-keymap))
780 (suppress-keymap speedbar-key-map t)
781
782 ;; control
6b3eac8d
DN
783 (define-key speedbar-key-map "g" 'speedbar-refresh)
784 (define-key speedbar-key-map "t" 'speedbar-toggle-updates)
785 (define-key speedbar-key-map "q" 'speedbar-close-frame)
c95dd4b0 786 (define-key speedbar-key-map "Q" 'delete-frame)
6b3eac8d
DN
787
788 ;; navigation
789 (define-key speedbar-key-map "n" 'speedbar-next)
790 (define-key speedbar-key-map "p" 'speedbar-prev)
59588cd4
KH
791 (define-key speedbar-key-map "\M-n" 'speedbar-restricted-next)
792 (define-key speedbar-key-map "\M-p" 'speedbar-restricted-prev)
793 (define-key speedbar-key-map "\C-\M-n" 'speedbar-forward-list)
794 (define-key speedbar-key-map "\C-\M-p" 'speedbar-backward-list)
6b3eac8d
DN
795 (define-key speedbar-key-map " " 'speedbar-scroll-up)
796 (define-key speedbar-key-map [delete] 'speedbar-scroll-down)
797
59588cd4
KH
798 ;; Short cuts I happen to find useful
799 (define-key speedbar-key-map "r"
800 (lambda () (interactive)
801 (speedbar-change-initial-expansion-list
802 speedbar-previously-used-expansion-list-name)))
803 (define-key speedbar-key-map "b"
804 (lambda () (interactive)
805 (speedbar-change-initial-expansion-list "quick buffers")))
806 (define-key speedbar-key-map "f"
807 (lambda () (interactive)
808 (speedbar-change-initial-expansion-list "files")))
809
810 ;; Overrides
811 (substitute-key-definition 'switch-to-buffer
812 'speedbar-switch-buffer-attached-frame
813 speedbar-key-map global-map)
6b3eac8d
DN
814
815 (if speedbar-xemacsp
816 (progn
817 ;; mouse bindings so we can manipulate the items on each line
818 (define-key speedbar-key-map 'button2 'speedbar-click)
819 (define-key speedbar-key-map '(shift button2) 'speedbar-power-click)
59588cd4
KH
820 ;; Info doc fix from Bob Weiner
821 (if (featurep 'infodoc)
822 nil
823 (define-key speedbar-key-map 'button3 'speedbar-xemacs-popup-kludge))
824 (define-key speedbar-key-map '(meta button3) 'speedbar-mouse-item-info)
825 )
826
6b3eac8d
DN
827 ;; mouse bindings so we can manipulate the items on each line
828 (define-key speedbar-key-map [down-mouse-1] 'speedbar-double-click)
829 (define-key speedbar-key-map [mouse-2] 'speedbar-click)
830 ;; This is the power click for new frames, or refreshing a cache
831 (define-key speedbar-key-map [S-mouse-2] 'speedbar-power-click)
832 ;; This adds a small unecessary visual effect
833 ;;(define-key speedbar-key-map [down-mouse-2] 'speedbar-quick-mouse)
834 (define-key speedbar-key-map [M-mouse-2] 'speedbar-mouse-item-info)
835
836 (define-key speedbar-key-map [down-mouse-3] 'speedbar-emacs-popup-kludge)
837
6b3eac8d
DN
838 ;; This lets the user scroll as if we had a scrollbar... well maybe not
839 (define-key speedbar-key-map [mode-line mouse-2] 'speedbar-mouse-hscroll)
59588cd4
KH
840 ;; another handy place users might click to get our menu.
841 (define-key speedbar-key-map [mode-line down-mouse-1]
842 'speedbar-emacs-popup-kludge)
843
0e596101
EL
844 ;; We can't switch buffers with the buffer mouse menu. Lets hack it.
845 (define-key speedbar-key-map [C-down-mouse-1] 'speedbar-hack-buffer-menu)
846
59588cd4
KH
847 ;; Lastly, we want to track the mouse. Play here
848 (define-key speedbar-key-map [mouse-movement] 'speedbar-track-mouse)
849 ))
850
851(defun speedbar-make-specialized-keymap ()
852 "Create a keymap for use w/ a speedbar major or minor display mode.
853This basically creates a sparse keymap, and makes it's parent be
854`speedbar-key-map'."
855 (let ((k (make-sparse-keymap)))
856 (set-keymap-parent k speedbar-key-map)
857 k))
858
859(defvar speedbar-file-key-map nil
860 "Keymap used in speedbar buffer while files are displayed.")
861
862(if speedbar-file-key-map
863 nil
864 (setq speedbar-file-key-map (speedbar-make-specialized-keymap))
865
866 ;; Basic tree features
867 (define-key speedbar-file-key-map "e" 'speedbar-edit-line)
868 (define-key speedbar-file-key-map "\C-m" 'speedbar-edit-line)
869 (define-key speedbar-file-key-map "+" 'speedbar-expand-line)
870 (define-key speedbar-file-key-map "-" 'speedbar-contract-line)
871
872 ;; file based commands
873 (define-key speedbar-file-key-map "U" 'speedbar-up-directory)
874 (define-key speedbar-file-key-map "I" 'speedbar-item-info)
875 (define-key speedbar-file-key-map "B" 'speedbar-item-byte-compile)
876 (define-key speedbar-file-key-map "L" 'speedbar-item-load)
877 (define-key speedbar-file-key-map "C" 'speedbar-item-copy)
878 (define-key speedbar-file-key-map "D" 'speedbar-item-delete)
879 (define-key speedbar-file-key-map "O" 'speedbar-item-object-delete)
880 (define-key speedbar-file-key-map "R" 'speedbar-item-rename)
881 )
6b3eac8d
DN
882
883(defvar speedbar-easymenu-definition-base
884 '("Speedbar"
885 ["Update" speedbar-refresh t]
886 ["Auto Update" speedbar-toggle-updates
887 :style toggle :selected speedbar-update-flag]
888 )
889 "Base part of the speedbar menu.")
890
891(defvar speedbar-easymenu-definition-special
892 '(["Edit Item On Line" speedbar-edit-line t]
893 ["Show All Files" speedbar-toggle-show-all-files
894 :style toggle :selected speedbar-show-unknown-files]
59588cd4 895 ["Expand File Tags" speedbar-expand-line
6b3eac8d
DN
896 (save-excursion (beginning-of-line)
897 (looking-at "[0-9]+: *.\\+. "))]
59588cd4 898 ["Contract File Tags" speedbar-contract-line
6b3eac8d
DN
899 (save-excursion (beginning-of-line)
900 (looking-at "[0-9]+: *.-. "))]
59588cd4
KH
901; ["Sort Tags" speedbar-toggle-sorting
902; :style toggle :selected speedbar-sort-tags]
6b3eac8d 903 "----"
59588cd4 904 ["File/Tag Information" speedbar-item-info t]
6b3eac8d
DN
905 ["Load Lisp File" speedbar-item-load
906 (save-excursion
907 (beginning-of-line)
59588cd4 908 (looking-at "[0-9]+: *\\[[+-]\\] .+\\(\\.el\\)\\( \\|$\\)"))]
6b3eac8d
DN
909 ["Byte Compile File" speedbar-item-byte-compile
910 (save-excursion
911 (beginning-of-line)
59588cd4
KH
912 (looking-at "[0-9]+: *\\[[+-]\\] .+\\(\\.el\\)\\( \\|$\\)"))]
913 ["Copy File" speedbar-item-copy
6b3eac8d 914 (save-excursion (beginning-of-line) (looking-at "[0-9]+: *\\["))]
59588cd4 915 ["Rename File" speedbar-item-rename
6b3eac8d 916 (save-excursion (beginning-of-line) (looking-at "[0-9]+: *[[<]"))]
59588cd4
KH
917 ["Delete File" speedbar-item-delete
918 (save-excursion (beginning-of-line) (looking-at "[0-9]+: *[[<]"))]
919 ["Delete Object" speedbar-item-object-delete
920 (save-excursion (beginning-of-line)
921 (looking-at "[0-9]+: *\\[[+-]\\] [^ \n]+ \\*?[!#]$"))]
922 )
6b3eac8d
DN
923 "Additional menu items while in file-mode.")
924
925(defvar speedbar-easymenu-definition-trailer
8afc622b 926 (append
59588cd4 927 (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
8afc622b
EL
928 (list ["Customize..." speedbar-customize t]))
929 (list
930 ["Close" speedbar-close-frame t]
931 ["Quit" delete-frame t] ))
6b3eac8d
DN
932 "Menu items appearing at the end of the speedbar menu.")
933
934(defvar speedbar-desired-buffer nil
935 "Non-nil when speedbar is showing buttons specific a special mode.
936In this case it is the originating buffer.")
937(defvar speedbar-buffer nil
938 "The buffer displaying the speedbar.")
939(defvar speedbar-frame nil
940 "The frame displaying speedbar.")
941(defvar speedbar-cached-frame nil
942 "The frame that was last created, then removed from the display.")
943(defvar speedbar-full-text-cache nil
944 "The last open directory is saved in its entirety for ultra-fast switching.")
945(defvar speedbar-timer nil
946 "The speedbar timer used for updating the buffer.")
947(defvar speedbar-attached-frame nil
948 "The frame which started speedbar mode.
949This is the frame from which all data displayed in the speedbar is
950gathered, and in which files and such are displayed.")
951
952(defvar speedbar-last-selected-file nil
953 "The last file which was selected in speedbar buffer.")
954
955(defvar speedbar-shown-directories nil
956 "Maintain list of directories simultaneously open in the current speedbar.")
957
958(defvar speedbar-directory-contents-alist nil
959 "An association list of directories and their contents.
960Each sublist was returned by `speedbar-file-lists'. This list is
961maintained to speed up the refresh rate when switching between
962directories.")
963
964(defvar speedbar-power-click nil
965 "Never set this by hand. Value is t when S-mouse activity occurs.")
966
967\f
8583d8b3
EL
968;;; Compatibility
969;;
970(if (fboundp 'frame-parameter)
971
972 (defalias 'speedbar-frame-parameter 'frame-parameter)
973
974 (defun speedbar-frame-parameter (frame parameter)
975 "Return FRAME's PARAMETER value."
976 (cdr (assoc parameter (frame-parameters frame)))))
977\f
6b3eac8d
DN
978;;; Mode definitions/ user commands
979;;
980
981;;;###autoload
982(defalias 'speedbar 'speedbar-frame-mode)
983;;;###autoload
984(defun speedbar-frame-mode (&optional arg)
985 "Enable or disable speedbar. Positive ARG means turn on, negative turn off.
986nil means toggle. Once the speedbar frame is activated, a buffer in
987`speedbar-mode' will be displayed. Currently, only one speedbar is
988supported at a time.
989`speedbar-before-popup-hook' is called before popping up the speedbar frame.
990`speedbar-before-delete-hook' is called before the frame is deleted."
991 (interactive "P")
6b3eac8d
DN
992 ;; toggle frame on and off.
993 (if (not arg) (if (and (frame-live-p speedbar-frame)
994 (frame-visible-p speedbar-frame))
995 (setq arg -1) (setq arg 1)))
996 ;; turn the frame off on neg number
997 (if (and (numberp arg) (< arg 0))
998 (progn
999 (run-hooks 'speedbar-before-delete-hook)
1000 (if (and speedbar-frame (frame-live-p speedbar-frame))
1001 (progn
1002 (setq speedbar-cached-frame speedbar-frame)
1003 (make-frame-invisible speedbar-frame)))
1004 (setq speedbar-frame nil)
1005 (speedbar-set-timer nil)
1006 ;; Used to delete the buffer. This has the annoying affect of
1007 ;; preventing whatever took its place from ever appearing
1008 ;; as the default after a C-x b was typed
1009 ;;(if (bufferp speedbar-buffer)
1010 ;; (kill-buffer speedbar-buffer))
1011 )
1012 ;; Set this as our currently attached frame
1013 (setq speedbar-attached-frame (selected-frame))
1014 (run-hooks 'speedbar-before-popup-hook)
1015 ;; Get the frame to work in
1016 (if (frame-live-p speedbar-cached-frame)
1017 (progn
1018 (setq speedbar-frame speedbar-cached-frame)
1019 (make-frame-visible speedbar-frame)
1020 ;; Get the buffer to play with
1021 (speedbar-mode)
1022 (select-frame speedbar-frame)
1023 (if (not (eq (current-buffer) speedbar-buffer))
1024 (switch-to-buffer speedbar-buffer))
1025 (set-window-dedicated-p (selected-window) t)
1026 (raise-frame speedbar-frame)
1027 (speedbar-set-timer speedbar-update-speed)
1028 )
1029 (if (frame-live-p speedbar-frame)
1030 (raise-frame speedbar-frame)
1031 (setq speedbar-frame
1032 (if speedbar-xemacsp
8583d8b3
EL
1033 ;; Only guess height if it is not specified.
1034 (if (member 'height speedbar-frame-plist)
1035 (make-frame speedbar-frame-plist)
1036 (make-frame (nconc (list 'height
1037 (speedbar-needed-height))
1038 speedbar-frame-plist)))
1039 (let* ((mh (speedbar-frame-parameter nil 'menu-bar-lines))
1040 (cfx (speedbar-frame-parameter nil 'left))
1041 (cfy (speedbar-frame-parameter nil 'top))
a4252bdb
EL
1042 (cfw (frame-pixel-width))
1043 (params
8583d8b3
EL
1044 ;; Only add a guessed height if one is not specified
1045 ;; in the input parameters.
1046 (if (assoc 'height speedbar-frame-parameters)
1047 speedbar-frame-parameters
1048 (append
1049 speedbar-frame-parameters
1050 (list (cons 'height (+ mh (frame-height)))))))
a4252bdb
EL
1051 (frame
1052 (if (or (< emacs-major-version 20)
1053 (not (eq window-system 'x)))
1054 (make-frame params)
1055 (let ((x-pointer-shape x-pointer-top-left-arrow)
1056 (x-sensitive-text-pointer-shape
1057 x-pointer-hand2))
1058 (make-frame params)))))
8583d8b3
EL
1059 ;; Position speedbar frame.
1060 (if (or (not window-system) (eq window-system 'pc)
1061 (assoc 'left speedbar-frame-parameters)
1062 (assoc 'top speedbar-frame-parameters))
1063 ;; Do no positioning if not on a windowing system,
1064 ;; or if left/top were specified in the parameters.
1065 frame
1066 (let ((cfx
1067 (if (not (consp cfx))
1068 cfx
1069 ;; If cfx is a list, that means we grow
1070 ;; from a specific edge of the display.
1071 ;; Convert that to the distance from the
1072 ;; left side of the display.
1073 (if (eq (car cfx) '-)
1074 ;; A - means distance from the right edge
1075 ;; of the display, or DW - cfx - framewidth
1076 (- (x-display-pixel-width) (car (cdr cfx))
1077 (frame-pixel-width))
1078 (car (cdr cfx))))))
1079 (modify-frame-parameters
1080 frame
1081 (list
1082 (cons
1083 'left
1084 ;; Decide which side to put it
1085 ;; on. 200 is just a buffer
1086 ;; for the left edge of the
1087 ;; screen. The extra 10 is just
1088 ;; dressings for window decorations.
1089 (let ((sfw (frame-pixel-width frame)))
1090 (let ((left-guess (- cfx 10 sfw))
1091 (right-guess (+ cfx cfw 5)))
1092 (let ((left-margin left-guess)
1093 (right-margin
1094 (- (x-display-pixel-width)
1095 right-guess 5 sfw)))
1096 (cond ((>= left-margin 0) left-guess)
1097 ((>= right-margin 0) right-guess)
1098 ;; otherwise choose side we overlap less
1099 ((> left-margin right-margin) 0)
1100 (t (- (x-display-pixel-width) sfw 5)))))))
1101 (cons 'top cfy)))
1102 frame)))))
6b3eac8d
DN
1103 ;; reset the selection variable
1104 (setq speedbar-last-selected-file nil)
1105 ;; Put the buffer into the frame
1106 (save-window-excursion
1107 ;; Get the buffer to play with
1108 (speedbar-mode)
1109 (select-frame speedbar-frame)
1110 (switch-to-buffer speedbar-buffer)
1111 (set-window-dedicated-p (selected-window) t))
f412d5dd
EL
1112 (if (and (or (null window-system) (eq window-system 'pc))
1113 (fboundp 'set-frame-name))
0e596101
EL
1114 (progn
1115 (select-frame speedbar-frame)
1116 (set-frame-name "Speedbar")))
6b3eac8d
DN
1117 (speedbar-set-timer speedbar-update-speed)))))
1118
1119;;;###autoload
1120(defun speedbar-get-focus ()
1121 "Change frame focus to or from the speedbar frame.
1122If the selected frame is not speedbar, then speedbar frame is
1123selected. If the speedbar frame is active, then select the attached frame."
1124 (interactive)
1125 (if (eq (selected-frame) speedbar-frame)
1126 (if (frame-live-p speedbar-attached-frame)
1127 (select-frame speedbar-attached-frame))
59588cd4
KH
1128 ;; If updates are off, then refresh the frame (they want it now...)
1129 (if (not speedbar-update-flag)
1130 (let ((speedbar-update-flag t))
1131 (speedbar-timer-fn)))
6b3eac8d
DN
1132 ;; make sure we have a frame
1133 (if (not (frame-live-p speedbar-frame)) (speedbar-frame-mode 1))
1134 ;; go there
59588cd4
KH
1135 (select-frame speedbar-frame)
1136 )
6b3eac8d
DN
1137 (other-frame 0))
1138
1139(defun speedbar-close-frame ()
1140 "Turn off a currently active speedbar."
1141 (interactive)
1142 (speedbar-frame-mode -1)
1143 (select-frame speedbar-attached-frame)
1144 (other-frame 0))
1145
59588cd4
KH
1146(defun speedbar-switch-buffer-attached-frame (&optional buffer)
1147 "Switch to BUFFER in speedbar's attached frame, and raise that frame.
1148This overrides the default behavior of `switch-to-buffer' which is
1149broken because of the dedicated speedbar frame."
1150 (interactive)
1151 ;; Assume we are in the speedbar frame.
1152 (speedbar-get-focus)
1153 ;; Now switch buffers
1154 (if buffer
1155 (switch-to-buffer buffer)
1156 (call-interactively 'switch-to-buffer nil nil)))
1157
6b3eac8d
DN
1158(defmacro speedbar-frame-width ()
1159 "Return the width of the speedbar frame in characters.
1160nil if it doesn't exist."
1161 '(frame-width speedbar-frame))
1162
1163;; XEmacs function only.
1164(defun speedbar-needed-height (&optional frame)
1165 "The needed height for the tool bar FRAME (in characters)."
1166 (or frame (setq frame (selected-frame)))
1167 ;; The 1 is the missing modeline/minibuffer
1168 (+ 1 (/ (frame-pixel-height frame)
1169 (face-height 'default frame))))
1170
1171(defun speedbar-mode ()
1172 "Major mode for managing a display of directories and tags.
1173\\<speedbar-key-map>
1174The first line represents the default path of the speedbar frame.
1175Each directory segment is a button which jumps speedbar's default
1176directory to that path. Buttons are activated by clicking `\\[speedbar-click]'.
1177In some situations using `\\[speedbar-power-click]' is a `power click' which will
1178rescan cached items, or pop up new frames.
1179
1180Each line starting with <+> represents a directory. Click on the <+>
1181to insert the directory listing into the current tree. Click on the
1182<-> to retract that list. Click on the directory name to go to that
1183directory as the default.
1184
1185Each line starting with [+] is a file. If the variable
1186`speedbar-show-unknown-files' is t, the lines starting with [?] are
1187files which don't have imenu support, but are not expressly ignored.
1188Files are completely ignored if they match `speedbar-file-unshown-regexp'
1189which is generated from `completion-ignored-extensions'.
1190
1191Files with a `*' character after their name are files checked out of a
1192version control system. (currently only RCS is supported.) New
1193version control systems can be added by examining the documentation
1194for `speedbar-this-file-in-vc' and `speedbar-vc-check-dir-p'
1195
59588cd4
KH
1196Files with a `#' or `!' character after them are source files that
1197have an object file associated with them. The `!' indicates that the
1198files is out of date. You can control what source/object associations
1199exist through the variable `speedbar-obj-alist'.
1200
6b3eac8d
DN
1201Click on the [+] to display a list of tags from that file. Click on
1202the [-] to retract the list. Click on the file name to edit the file
1203in the attached frame.
1204
1205If you open tags, you might find a node starting with {+}, which is a
1206category of tags. Click the {+} to expand the category. Jump-able
1207tags start with >. Click the name of the tag to go to that position
1208in the selected file.
1209
1210\\{speedbar-key-map}"
1211 ;; NOT interactive
1212 (save-excursion
1213 (setq speedbar-buffer (set-buffer (get-buffer-create " SPEEDBAR")))
1214 (kill-all-local-variables)
1215 (setq major-mode 'speedbar-mode)
1216 (setq mode-name "Speedbar")
6b3eac8d
DN
1217 (set-syntax-table speedbar-syntax-table)
1218 (setq font-lock-keywords nil) ;; no font-locking please
1219 (setq truncate-lines t)
1220 (make-local-variable 'frame-title-format)
1221 (setq frame-title-format "Speedbar")
1222 ;; Set this up special just for the speedbar buffer
59588cd4 1223 ;; Terminal minibuffer stuff does not require this.
0e596101
EL
1224 (if (and window-system (not (eq window-system 'pc))
1225 (null default-minibuffer-frame))
6b3eac8d
DN
1226 (progn
1227 (make-local-variable 'default-minibuffer-frame)
1228 (setq default-minibuffer-frame speedbar-attached-frame)))
59588cd4
KH
1229 ;; Correct use of `temp-buffer-show-function': Bob Weiner
1230 (if (and (boundp 'temp-buffer-show-hook)
1231 (boundp 'temp-buffer-show-function))
1232 (progn (make-local-variable 'temp-buffer-show-hook)
1233 (setq temp-buffer-show-hook temp-buffer-show-function)))
6b3eac8d
DN
1234 (make-local-variable 'temp-buffer-show-function)
1235 (setq temp-buffer-show-function 'speedbar-temp-buffer-show-function)
1236 (if speedbar-xemacsp
1237 (progn
1238 ;; Argh! mouse-track-click-hook doesn't understand the
1239 ;; make-local-hook conventions.
1240 (make-local-variable 'mouse-track-click-hook)
1241 (add-hook 'mouse-track-click-hook
1242 (lambda (event count)
1243 (if (/= (event-button event) 1)
1244 nil ; Do normal operations.
1245 (cond ((eq count 1)
1246 (speedbar-quick-mouse event))
1247 ((or (eq count 2)
1248 (eq count 3))
1249 (mouse-set-point event)
1250 (speedbar-do-function-pointer)
1251 (speedbar-quick-mouse event)))
1252 ;; Don't do normal operations.
1253 t)))))
1254 (make-local-hook 'kill-buffer-hook)
1255 (add-hook 'kill-buffer-hook (lambda () (let ((skilling (boundp 'skilling)))
1256 (if skilling
1257 nil
1258 (if (eq (current-buffer)
1259 speedbar-buffer)
1260 (speedbar-frame-mode -1)))))
1261 t t)
2d0327e5 1262 (toggle-read-only 1)
6b3eac8d 1263 (speedbar-set-mode-line-format)
59588cd4
KH
1264 (if speedbar-xemacsp
1265 (progn
1266 (make-local-variable 'mouse-motion-handler)
1267 (setq mouse-motion-handler 'speedbar-track-mouse-xemacs))
1268 (if speedbar-track-mouse-flag
1269 (progn
1270 (make-local-variable 'track-mouse)
1271 (setq track-mouse t))) ;this could be messy.
1272 (setq auto-show-mode nil)) ;no auto-show for Emacs
6b3eac8d
DN
1273 (run-hooks 'speedbar-mode-hook))
1274 (speedbar-update-contents)
1275 speedbar-buffer)
1276
39273816
KH
1277(defmacro speedbar-with-attached-buffer (&rest forms)
1278 "Execute FORMS in the attached frame's special buffer.
1279Optionally select that frame if necessary."
1280 `(save-selected-window
1281 (speedbar-set-timer speedbar-update-speed)
1282 (select-frame speedbar-attached-frame)
1283 ,@forms
1284 (speedbar-maybee-jump-to-attached-frame)))
1285
1286(defun speedbar-message (fmt &rest args)
1287 "Like message, but for use in the speedbar frame.
1288Argument FMT is the format string, and ARGS are the arguments for message."
1289 (save-selected-window
1290 (select-frame speedbar-attached-frame)
1291 (apply 'message fmt args)))
1292
1293(defun speedbar-y-or-n-p (prompt)
1294 "Like `y-or-n-p', but for use in the speedbar frame.
1295Argument PROMPT is the prompt to use."
1296 (save-selected-window
1297 (if (and default-minibuffer-frame (not (eq default-minibuffer-frame
1298 speedbar-attached-frame)))
1299 (select-frame speedbar-attached-frame))
1300 (y-or-n-p prompt)))
1301
59588cd4
KH
1302(defun speedbar-show-info-under-mouse (&optional event)
1303 "Call the info function for the line under the mouse.
1304Optional EVENT is currently not used."
1305 (let ((pos (mouse-position))) ; we ignore event until I use it later.
1306 (if (equal (car pos) speedbar-frame)
1307 (save-excursion
1308 (save-window-excursion
1309 (apply 'set-mouse-position pos)
1310 (speedbar-item-info))))))
1311
6b3eac8d
DN
1312(defun speedbar-set-mode-line-format ()
1313 "Set the format of the mode line based on the current speedbar environment.
1314This gives visual indications of what is up. It EXPECTS the speedbar
1315frame and window to be the currently active frame and window."
1316 (if (and (frame-live-p speedbar-frame)
1317 (or (not speedbar-xemacsp)
1318 (specifier-instance has-modeline-p)))
1319 (save-excursion
1320 (set-buffer speedbar-buffer)
1321 (let* ((w (or (speedbar-frame-width) 20))
1322 (p1 "<<")
1323 (p5 ">>")
1324 (p3 (if speedbar-update-flag "SPEEDBAR" "SLOWBAR"))
1325 (blank (- w (length p1) (length p3) (length p5)
1326 (if line-number-mode 4 0)))
1327 (p2 (if (> blank 0)
1328 (make-string (/ blank 2) ? )
1329 ""))
1330 (p4 (if (> blank 0)
1331 (make-string (+ (/ blank 2) (% blank 2)) ? )
1332 ""))
1333 (tf
1334 (if line-number-mode
1335 (list (concat p1 p2 p3) '(line-number-mode " %3l")
1336 (concat p4 p5))
1337 (list (concat p1 p2 p3 p4 p5)))))
1338 (if (not (equal mode-line-format tf))
1339 (progn
1340 (setq mode-line-format tf)
1341 (force-mode-line-update)))))))
1342
1343(defun speedbar-temp-buffer-show-function (buffer)
1344 "Placed in the variable `temp-buffer-show-function' in `speedbar-mode'.
1345If a user requests help using \\[help-command] <Key> the temp BUFFER will be
1346redirected into a window on the attached frame."
1347 (if speedbar-attached-frame (select-frame speedbar-attached-frame))
1348 (pop-to-buffer buffer nil)
1349 (other-window -1)
1095518a
EL
1350 ;; Fix for using this hook on some platforms: Bob Weiner
1351 (cond ((not speedbar-xemacsp)
1352 (run-hooks 'temp-buffer-show-hook))
1353 ((fboundp 'run-hook-with-args)
59588cd4
KH
1354 (run-hook-with-args 'temp-buffer-show-hook buffer))
1355 ((and (boundp 'temp-buffer-show-hook)
1356 (listp temp-buffer-show-hook))
1357 (mapcar (function (lambda (hook) (funcall hook buffer)))
1358 temp-buffer-show-hook))))
1359
0e596101
EL
1360(defvar speedbar-previous-menu nil
1361 "The menu before the last `speedbar-reconfigure-keymaps' was called.")
1362
59588cd4 1363(defun speedbar-reconfigure-keymaps ()
6b3eac8d
DN
1364 "Reconfigure the menu-bar in a speedbar frame.
1365Different menu items are displayed depending on the current display mode
1366and the existence of packages."
59588cd4
KH
1367 (let ((md (append
1368 speedbar-easymenu-definition-base
1369 (if speedbar-shown-directories
1370 ;; file display mode version
1371 (speedbar-initial-menu)
1372 (save-excursion
1373 (select-frame speedbar-attached-frame)
1374 (if (local-variable-p
1375 'speedbar-easymenu-definition-special
1376 (current-buffer))
1377 ;; If bound locally, we can use it
1378 speedbar-easymenu-definition-special)))
1379 ;; Dynamic menu stuff
1380 '("-")
1381 (list (cons "Displays"
1382 (let ((displays nil)
1383 (alist speedbar-initial-expansion-mode-alist))
1384 (while alist
1385 (setq displays
1386 (cons
1387 (vector
1388 (capitalize (car (car alist)))
1389 (list
1390 'speedbar-change-initial-expansion-list
1391 (car (car alist)))
1392 t)
1393 displays))
1394 (setq alist (cdr alist)))
1395 displays)))
1396 ;; The trailer
1397 speedbar-easymenu-definition-trailer))
1398 (localmap (save-excursion
1399 (let ((cf (selected-frame)))
1400 (prog2
1401 (select-frame speedbar-attached-frame)
1402 (if (local-variable-p
1403 'speedbar-special-mode-key-map
1404 (current-buffer))
1405 speedbar-special-mode-key-map)
1406 (select-frame cf))))))
1407 (save-excursion
1408 (set-buffer speedbar-buffer)
1409 (use-local-map (or localmap
1410 (speedbar-initial-keymap)
1411 ;; This creates a small keymap we can glom the
1412 ;; menu adjustments into.
1413 (speedbar-make-specialized-keymap)))
0e596101
EL
1414 ;; Delete the old menu if applicable.
1415 (if speedbar-previous-menu (easy-menu-remove speedbar-previous-menu))
1416 (setq speedbar-previous-menu md)
1417 ;; Now add the new menu
59588cd4
KH
1418 (if (not speedbar-xemacsp)
1419 (easy-menu-define speedbar-menu-map (current-local-map)
1420 "Speedbar menu" md)
0e596101 1421 (easy-menu-add md (current-local-map))
59588cd4 1422 (set-buffer-menubar (list md))))))
6b3eac8d
DN
1423
1424\f
1425;;; User Input stuff
1426;;
1427
1428;; XEmacs: this can be implemented using modeline keymaps, but there
1429;; is no use, as we have horizontal scrollbar (as the docstring
1430;; hints.)
1431(defun speedbar-mouse-hscroll (e)
1432 "Read a mouse event E from the mode line, and horizontally scroll.
1433If the mouse is being clicked on the far left, or far right of the
1434mode-line. This is only useful for non-XEmacs"
1435 (interactive "e")
1436 (let* ((xp (car (nth 2 (car (cdr e)))))
1437 (cpw (/ (frame-pixel-width)
1438 (frame-width)))
1439 (oc (1+ (/ xp cpw)))
1440 )
1441 (cond ((< oc 3)
1442 (scroll-left 2))
1443 ((> oc (- (window-width) 3))
1444 (scroll-right 2))
39273816
KH
1445 (t (speedbar-message
1446 "Click on the edge of the modeline to scroll left/right")))
1447 ;;(speedbar-message "X: Pixel %d Char Pixels %d On char %d" xp cpw oc)
6b3eac8d
DN
1448 ))
1449
1450(defun speedbar-customize ()
1451 "Customize speedbar using the Custom package."
1452 (interactive)
1453 (let ((sf (selected-frame)))
1454 (select-frame speedbar-attached-frame)
1455 (customize-group 'speedbar)
1456 (select-frame sf))
1457 (speedbar-maybee-jump-to-attached-frame))
1458
59588cd4
KH
1459(defun speedbar-track-mouse (event)
1460 "For motion EVENT, display info about the current line."
1461 (interactive "e")
1462 (if (not speedbar-track-mouse-flag)
1463 nil
1464 (save-excursion
1465 (let ((char (nth 1 (car (cdr event)))))
1466 (if (not (numberp char))
39273816 1467 (speedbar-message nil)
59588cd4 1468 (goto-char char)
39273816 1469 ;; (speedbar-message "%S" event)
59588cd4
KH
1470 (speedbar-item-info)
1471 )))))
1472
1473(defun speedbar-track-mouse-xemacs (event)
1474 "For motion EVENT, display info about the current line."
1475 (if (functionp (default-value 'mouse-motion-handler))
1476 (funcall (default-value 'mouse-motion-handler) event))
1477 (if speedbar-track-mouse-flag
1478 (save-excursion
1479 (save-window-excursion
1480 (condition-case ()
1481 (progn (mouse-set-point event)
1482 ;; Prevent focus-related bugs.
1483 (if (eq major-mode 'speedbar-mode)
1484 (speedbar-item-info)))
1485 (error nil))))))
1486
6b3eac8d
DN
1487;; In XEmacs, we make popup menus work on the item over mouse (as
1488;; opposed to where the point happens to be.) We attain this by
1489;; temporarily moving the point to that place.
1490;; Hrvoje Niksic <hniksic@srce.hr>
1491(defun speedbar-xemacs-popup-kludge (event)
1492 "Pop up a menu related to the clicked on item.
1493Must be bound to EVENT."
1494 (interactive "e")
59588cd4 1495 (select-frame speedbar-frame)
6b3eac8d
DN
1496 (save-excursion
1497 (goto-char (event-closest-point event))
1498 (beginning-of-line)
1499 (forward-char (min 5 (- (save-excursion (end-of-line) (point))
1500 (save-excursion (beginning-of-line) (point)))))
1501 (popup-mode-menu)
1502 ;; Wait for menu to bail out. `popup-mode-menu' (and other popup
1503 ;; menu functions) return immediately.
1504 (let (new)
1505 (while (not (misc-user-event-p (setq new (next-event))))
1506 (dispatch-event new))
1507 (dispatch-event new))))
1508
1509(defun speedbar-emacs-popup-kludge (e)
1510 "Pop up a menu related to the clicked on item.
1511Must be bound to event E."
1512 (interactive "e")
1513 (save-excursion
1514 (mouse-set-point e)
1515 ;; This gets the cursor where the user can see it.
1516 (if (not (bolp)) (forward-char -1))
1517 (sit-for 0)
1518 (if (< emacs-major-version 20)
1519 (mouse-major-mode-menu e)
1520 (mouse-major-mode-menu e nil))))
1521
0e596101
EL
1522(defun speedbar-hack-buffer-menu (e)
1523 "Control mouse 1 is buffer menu.
1524This hack overrides it so that the right thing happens in the main
1525Emacs frame, not in the speedbar frame.
1526Argument E is the event causing this activity."
1527 (interactive "e")
1528 (let ((fn (lookup-key global-map (if speedbar-xemacsp
1529 '(control button1)
1530 [C-down-mouse-1])))
1531 (newbuff nil))
1532 (unwind-protect
1533 (save-excursion
1534 (set-window-dedicated-p (selected-window) nil)
1535 (call-interactively fn)
1536 (setq newbuff (current-buffer)))
a8197cfe 1537 (switch-to-buffer speedbar-buffer)
0e596101 1538 (set-window-dedicated-p (selected-window) t))
a8197cfe
KH
1539 (if (not (eq newbuff speedbar-buffer))
1540 (speedbar-with-attached-buffer
1541 (switch-to-buffer newbuff)))))
0e596101 1542
6b3eac8d
DN
1543(defun speedbar-next (arg)
1544 "Move to the next ARGth line in a speedbar buffer."
1545 (interactive "p")
1546 (forward-line (or arg 1))
1547 (speedbar-item-info)
1548 (speedbar-position-cursor-on-line))
1549
1550(defun speedbar-prev (arg)
1551 "Move to the previous ARGth line in a speedbar buffer."
1552 (interactive "p")
1553 (speedbar-next (if arg (- arg) -1)))
1554
59588cd4
KH
1555(defun speedbar-restricted-move (arg)
1556 "Move to the next ARGth line in a speedbar buffer at the same depth.
1557This means that movement is restricted to a subnode, and that siblings
1558of intermediate nodes are skipped."
1559 (if (not (numberp arg)) (signal 'wrong-type-argument (list arg 'numberp)))
1560 ;; First find the extent for which we are allowed to move.
1561 (let ((depth (save-excursion (beginning-of-line)
1562 (if (looking-at "[0-9]+:")
1563 (string-to-int (match-string 0))
1564 0)))
1565 (crement (if (< arg 0) 1 -1)) ; decrement or increment
1566 (lastmatch (point)))
1567 (while (/= arg 0)
1568 (forward-line (- crement))
1569 (let ((subdepth (save-excursion (beginning-of-line)
1570 (if (looking-at "[0-9]+:")
1571 (string-to-int (match-string 0))
1572 0))))
1573 (cond ((or (< subdepth depth)
1574 (progn (end-of-line) (eobp))
1575 (progn (beginning-of-line) (bobp)))
1576 ;; We have reached the end of this block.
1577 (goto-char lastmatch)
1578 (setq arg 0)
1579 (error "End of sub-list"))
1580 ((= subdepth depth)
1581 (setq lastmatch (point)
1582 arg (+ arg crement))))))
1583 (speedbar-position-cursor-on-line)))
1584
1585(defun speedbar-restricted-next (arg)
1586 "Move to the next ARGth line in a speedbar buffer at the same depth.
1587This means that movement is restricted to a subnode, and that siblings
1588of intermediate nodes are skipped."
1589 (interactive "p")
1590 (speedbar-restricted-move (or arg 1))
1591 (speedbar-item-info))
1592
1593
1594(defun speedbar-restricted-prev (arg)
1595 "Move to the previous ARGth line in a speedbar buffer at the same depth.
1596This means that movement is restricted to a subnode, and that siblings
1597of intermediate nodes are skipped."
1598 (interactive "p")
1599 (speedbar-restricted-move (if arg (- arg) -1))
1600 (speedbar-item-info))
1601
1602(defun speedbar-navigate-list (arg)
1603 "Move across ARG groups of similarly typed items in speedbar.
1604Stop on the first line of the next type of item, or on the last or first item
1605if we reach a buffer boundary."
1606 (interactive "p")
1607 (beginning-of-line)
1608 (if (looking-at "[0-9]+: *[[<{][-+?][]>}] ")
1609 (let ((str (regexp-quote (match-string 0))))
1610 (while (looking-at str)
1611 (speedbar-restricted-move arg)
1612 (beginning-of-line))))
1613 (speedbar-position-cursor-on-line))
1614
1615(defun speedbar-forward-list ()
1616 "Move forward over the current list.
1617A LIST in speedbar is a group of similarly typed items, such as directories,
1618files, or the directory button."
1619 (interactive)
1620 (speedbar-navigate-list 1)
1621 (speedbar-item-info))
1622
1623(defun speedbar-backward-list ()
1624 "Move backward over the current list.
1625A LIST in speedbar is a group of similarly typed items, such as directories,
1626files, or the directory button."
1627 (interactive)
1628 (speedbar-navigate-list -1)
1629 (speedbar-item-info))
1630
6b3eac8d
DN
1631(defun speedbar-scroll-up (&optional arg)
1632 "Page down one screen-full of the speedbar, or ARG lines."
1633 (interactive "P")
1634 (scroll-up arg)
1635 (speedbar-position-cursor-on-line))
1636
1637(defun speedbar-scroll-down (&optional arg)
1638 "Page up one screen-full of the speedbar, or ARG lines."
1639 (interactive "P")
1640 (scroll-down arg)
1641 (speedbar-position-cursor-on-line))
1642
1643(defun speedbar-up-directory ()
1644 "Keyboard accelerator for moving the default directory up one.
1645Assumes that the current buffer is the speedbar buffer"
1646 (interactive)
1647 (setq default-directory (expand-file-name (concat default-directory "../")))
1648 (speedbar-update-contents))
1649\f
1650;;; Speedbar file activity (aka creeping featurism)
1651;;
1652(defun speedbar-refresh ()
1653 "Refresh the current speedbar display, disposing of any cached data."
1654 (interactive)
0e596101
EL
1655 (let ((dl speedbar-shown-directories)
1656 (dm (and (boundp 'deactivate-mark) deactivate-mark)))
6b3eac8d
DN
1657 (while dl
1658 (adelete 'speedbar-directory-contents-alist (car dl))
0e596101 1659 (setq dl (cdr dl)))
61d7e1dc 1660 (if (<= 1 speedbar-verbosity-level)
39273816 1661 (speedbar-message "Refreshing speedbar..."))
0e596101
EL
1662 (speedbar-update-contents)
1663 (speedbar-stealthy-updates)
1664 ;; Reset the timer in case it got really hosed for some reason...
1665 (speedbar-set-timer speedbar-update-speed)
1666 (if (<= 1 speedbar-verbosity-level)
39273816 1667 (speedbar-message "Refreshing speedbar...done"))
0e596101 1668 (if (boundp 'deactivate-mark) (setq deactivate-mark dm))))
6b3eac8d
DN
1669
1670(defun speedbar-item-load ()
59588cd4 1671 "Load the item under the cursor or mouse if it is a Lisp file."
6b3eac8d
DN
1672 (interactive)
1673 (let ((f (speedbar-line-file)))
1674 (if (and (file-exists-p f) (string-match "\\.el\\'" f))
1675 (if (and (file-exists-p (concat f "c"))
39273816 1676 (speedbar-y-or-n-p (format "Load %sc? " f)))
6b3eac8d
DN
1677 ;; If the compiled version exists, load that instead...
1678 (load-file (concat f "c"))
1679 (load-file f))
59588cd4 1680 (error "Not a loadable file"))))
6b3eac8d
DN
1681
1682(defun speedbar-item-byte-compile ()
59588cd4 1683 "Byte compile the item under the cursor or mouse if it is a Lisp file."
6b3eac8d
DN
1684 (interactive)
1685 (let ((f (speedbar-line-file))
1686 (sf (selected-frame)))
1687 (if (and (file-exists-p f) (string-match "\\.el\\'" f))
1688 (progn
1689 (select-frame speedbar-attached-frame)
1690 (byte-compile-file f nil)
59588cd4
KH
1691 (select-frame sf)
1692 (speedbar-reset-scanners)))
6b3eac8d
DN
1693 ))
1694
1695(defun speedbar-mouse-item-info (event)
1696 "Provide information about what the user clicked on.
1697This should be bound to a mouse EVENT."
1698 (interactive "e")
1699 (mouse-set-point event)
1700 (speedbar-item-info))
1701
59588cd4
KH
1702(defun speedbar-generic-item-info ()
1703 "Attempt to derive, and then display information about thils line item.
1704File style information is displayed with `speedbar-item-info'."
1705 (save-excursion
1706 (beginning-of-line)
1707 ;; Skip invisible number info.
1708 (if (looking-at "\\([0-9]+\\):") (goto-char (match-end 0)))
1709 ;; Skip items in "folder" type text characters.
1710 (if (looking-at "\\s-*[[<({].[]>)}] ") (goto-char (match-end 0)))
1711 ;; Get the text
39273816
KH
1712 (speedbar-message "Text: %s" (buffer-substring-no-properties
1713 (point) (progn (end-of-line) (point))))))
59588cd4 1714
6b3eac8d 1715(defun speedbar-item-info ()
8afc622b
EL
1716 "Display info in the mini-buffer about the button the mouse is over.
1717This function can be replaced in `speedbar-mode-functions-list' as
1718`speedbar-item-info'"
6b3eac8d 1719 (interactive)
39273816
KH
1720 (let (message-log-max)
1721 (funcall (or (speedbar-fetch-replacement-function 'speedbar-item-info)
1722 'speedbar-generic-item-info))))
8afc622b
EL
1723
1724(defun speedbar-item-info-file-helper (&optional filename)
1725 "Display info about a file that is on the current line.
1726nil if not applicable. If FILENAME, then use that instead of reading
1727it from the speedbar buffer."
1728 (let* ((item (or filename (speedbar-line-file)))
1729 (attr (if item (file-attributes item) nil)))
39273816
KH
1730 (if (and item attr) (speedbar-message "%s %-6d %s" (nth 8 attr)
1731 (nth 7 attr) item)
8afc622b
EL
1732 nil)))
1733
1734(defun speedbar-item-info-tag-helper ()
1735 "Display info about a tag that is on the current line.
1736nil if not applicable."
1737 (save-excursion
2654fa92 1738 (beginning-of-line)
8afc622b
EL
1739 (if (re-search-forward " > \\([^ ]+\\)$"
1740 (save-excursion(end-of-line)(point)) t)
1741 (let ((tag (match-string 1))
1742 (attr (get-text-property (match-beginning 1)
1743 'speedbar-token))
1744 (item nil))
1745 (looking-at "\\([0-9]+\\):")
1746 (setq item (speedbar-line-path (string-to-int (match-string 1))))
39273816
KH
1747 (speedbar-message "Tag: %s in %s @ %s"
1748 tag item (if attr
1749 (if (markerp attr)
1750 (marker-position attr)
1751 attr)
1752 0)))
8afc622b
EL
1753 (if (re-search-forward "{[+-]} \\([^\n]+\\)$"
1754 (save-excursion(end-of-line)(point)) t)
39273816 1755 (speedbar-message "Group of tags \"%s\"" (match-string 1))
8afc622b
EL
1756 nil))))
1757
1758(defun speedbar-files-item-info ()
1759 "Display info in the mini-buffer about the button the mouse is over."
6b3eac8d 1760 (if (not speedbar-shown-directories)
59588cd4 1761 (speedbar-generic-item-info)
8afc622b
EL
1762 (or (speedbar-item-info-file-helper)
1763 (speedbar-item-info-tag-helper)
1764 (speedbar-generic-item-info))))
6b3eac8d
DN
1765
1766(defun speedbar-item-copy ()
1767 "Copy the item under the cursor.
1768Files can be copied to new names or places."
1769 (interactive)
1770 (let ((f (speedbar-line-file)))
59588cd4 1771 (if (not f) (error "Not a file"))
6b3eac8d 1772 (if (file-directory-p f)
59588cd4 1773 (error "Cannot copy directory")
6b3eac8d
DN
1774 (let* ((rt (read-file-name (format "Copy %s to: "
1775 (file-name-nondirectory f))
1776 (file-name-directory f)))
1777 (refresh (member (expand-file-name (file-name-directory rt))
1778 speedbar-shown-directories)))
1779 ;; Create the right file name part
1780 (if (file-directory-p rt)
1781 (setq rt
1782 (concat (expand-file-name rt)
1783 (if (string-match "/$" rt) "" "/")
1784 (file-name-nondirectory f))))
1785 (if (or (not (file-exists-p rt))
39273816 1786 (speedbar-y-or-n-p (format "Overwrite %s with %s? " rt f)))
6b3eac8d
DN
1787 (progn
1788 (copy-file f rt t t)
1789 ;; refresh display if the new place is currently displayed.
1790 (if refresh
1791 (progn
1792 (speedbar-refresh)
1793 (if (not (speedbar-goto-this-file rt))
1794 (speedbar-goto-this-file f))))
1795 ))))))
1796
1797(defun speedbar-item-rename ()
1798 "Rename the item under the cursor or mouse.
1799Files can be renamed to new names or moved to new directories."
1800 (interactive)
1801 (let ((f (speedbar-line-file)))
1802 (if f
1803 (let* ((rt (read-file-name (format "Rename %s to: "
1804 (file-name-nondirectory f))
1805 (file-name-directory f)))
1806 (refresh (member (expand-file-name (file-name-directory rt))
1807 speedbar-shown-directories)))
1808 ;; Create the right file name part
1809 (if (file-directory-p rt)
1810 (setq rt
1811 (concat (expand-file-name rt)
1812 (if (string-match "/\\'" rt) "" "/")
1813 (file-name-nondirectory f))))
1814 (if (or (not (file-exists-p rt))
39273816 1815 (speedbar-y-or-n-p (format "Overwrite %s with %s? " rt f)))
6b3eac8d
DN
1816 (progn
1817 (rename-file f rt t)
1818 ;; refresh display if the new place is currently displayed.
1819 (if refresh
1820 (progn
1821 (speedbar-refresh)
1822 (speedbar-goto-this-file rt)
1823 )))))
59588cd4 1824 (error "Not a file"))))
6b3eac8d
DN
1825
1826(defun speedbar-item-delete ()
1827 "Delete the item under the cursor. Files are removed from disk."
1828 (interactive)
1829 (let ((f (speedbar-line-file)))
59588cd4 1830 (if (not f) (error "Not a file"))
39273816 1831 (if (speedbar-y-or-n-p (format "Delete %s? " f))
6b3eac8d
DN
1832 (progn
1833 (if (file-directory-p f)
1834 (delete-directory f)
1835 (delete-file f))
39273816 1836 (speedbar-message "Okie dokie..")
6b3eac8d
DN
1837 (let ((p (point)))
1838 (speedbar-refresh)
1839 (goto-char p))
1840 ))
1841 ))
1842
59588cd4
KH
1843(defun speedbar-item-object-delete ()
1844 "Delete the object associated from the item under the cursor.
1845The file is removed from disk. The object is determined from the
1846variable `speedbar-obj-alist'."
1847 (interactive)
1848 (let* ((f (speedbar-line-file))
1849 (obj nil)
1850 (oa speedbar-obj-alist))
1851 (if (not f) (error "Not a file"))
1852 (while (and oa (not (string-match (car (car oa)) f)))
1853 (setq oa (cdr oa)))
1854 (setq obj (concat (file-name-sans-extension f) (cdr (car oa))))
1855 (if (and oa (file-exists-p obj)
39273816 1856 (speedbar-y-or-n-p (format "Delete %s? " obj)))
59588cd4
KH
1857 (progn
1858 (delete-file obj)
1859 (speedbar-reset-scanners)))))
1860
6b3eac8d
DN
1861(defun speedbar-enable-update ()
1862 "Enable automatic updating in speedbar via timers."
1863 (interactive)
1864 (setq speedbar-update-flag t)
1865 (speedbar-set-mode-line-format)
1866 (speedbar-set-timer speedbar-update-speed))
1867
1868(defun speedbar-disable-update ()
1869 "Disable automatic updating and stop consuming resources."
1870 (interactive)
1871 (setq speedbar-update-flag nil)
1872 (speedbar-set-mode-line-format)
1873 (speedbar-set-timer nil))
1874
1875(defun speedbar-toggle-updates ()
1876 "Toggle automatic update for the speedbar frame."
1877 (interactive)
1878 (if speedbar-update-flag
1879 (speedbar-disable-update)
1880 (speedbar-enable-update)))
1881
1882(defun speedbar-toggle-sorting ()
1883 "Toggle automatic update for the speedbar frame."
1884 (interactive)
1885 (setq speedbar-sort-tags (not speedbar-sort-tags)))
1886
1887(defun speedbar-toggle-show-all-files ()
1888 "Toggle display of files speedbar can not tag."
1889 (interactive)
1890 (setq speedbar-show-unknown-files (not speedbar-show-unknown-files))
1891 (speedbar-refresh))
1892\f
1893;;; Utility functions
1894;;
1895(defun speedbar-set-timer (timeout)
1896 "Apply a timer with TIMEOUT, or remove a timer if TIMOUT is nil.
1897TIMEOUT is the number of seconds until the speedbar timer is called
1898again. When TIMEOUT is nil, turn off all timeouts.
1899This function will also enable or disable the `vc-checkin-hook' used
1900to track file check ins, and will change the mode line to match
1901`speedbar-update-flag'."
1902 (cond
1903 ;; XEmacs
1904 (speedbar-xemacsp
1905 (if speedbar-timer
1906 (progn (delete-itimer speedbar-timer)
1907 (setq speedbar-timer nil)))
1908 (if timeout
1909 (if (and speedbar-xemacsp
1910 (or (>= emacs-major-version 20)
1911 (>= emacs-minor-version 15)))
1912 (setq speedbar-timer (start-itimer "speedbar"
1913 'speedbar-timer-fn
1914 timeout
1915 timeout
1916 t))
1917 (setq speedbar-timer (start-itimer "speedbar"
1918 'speedbar-timer-fn
1919 timeout
1920 nil)))))
1921 ;; Post 19.31 Emacs
1922 ((fboundp 'run-with-idle-timer)
1923 (if speedbar-timer
1924 (progn (cancel-timer speedbar-timer)
1925 (setq speedbar-timer nil)))
1926 (if timeout
1927 (setq speedbar-timer
1928 (run-with-idle-timer timeout t 'speedbar-timer-fn))))
1929 ;; Emacs 19.30 (Thanks twice: ptype@dra.hmg.gb)
1930 ((fboundp 'post-command-idle-hook)
1931 (if timeout
1932 (add-hook 'post-command-idle-hook 'speedbar-timer-fn)
1933 (remove-hook 'post-command-idle-hook 'speedbar-timer-fn)))
1934 ;; Older or other Emacsen with no timers. Set up so that its
1935 ;; obvious this emacs can't handle the updates
1936 (t
1937 (setq speedbar-update-flag nil)))
1938 ;; Apply a revert hook that will reset the scanners. We attach to revert
1939 ;; because most reverts occur during VC state change, and this lets our
1940 ;; VC scanner fix itself.
1941 (if timeout
1942 (add-hook 'after-revert-hook 'speedbar-reset-scanners)
1943 (remove-hook 'after-revert-hook 'speedbar-reset-scanners)
1944 )
1945 ;; change this if it changed for some reason
1946 (speedbar-set-mode-line-format))
1947
1948(defmacro speedbar-with-writable (&rest forms)
1949 "Allow the buffer to be writable and evaluate FORMS."
1950 (list 'let '((inhibit-read-only t))
6b3eac8d
DN
1951 (cons 'progn forms)))
1952(put 'speedbar-with-writable 'lisp-indent-function 0)
1953
1954(defun speedbar-select-window (buffer)
59588cd4 1955 "Select a window in which BUFFER is shown.
6b3eac8d
DN
1956If it is not shown, force it to appear in the default window."
1957 (let ((win (get-buffer-window buffer speedbar-attached-frame)))
1958 (if win
1959 (select-window win)
59588cd4 1960 (set-window-buffer (selected-window) buffer))))
6b3eac8d 1961
6b3eac8d
DN
1962(defun speedbar-insert-button (text face mouse function
1963 &optional token prevline)
1964 "Insert TEXT as the next logical speedbar button.
1965FACE is the face to put on the button, MOUSE is the highlight face to use.
1966When the user clicks on TEXT, FUNCTION is called with the TOKEN parameter.
1967This function assumes that the current buffer is the speedbar buffer.
1968If PREVLINE, then put this button on the previous line.
1969
1970This is a convenience function for special mode that create their own
1971specialized speedbar displays."
1972 (goto-char (point-max))
1973 (if (/= (current-column) 0) (insert "\n"))
1974 (if prevline (progn (delete-char -1) (insert " "))) ;back up if desired...
1975 (let ((start (point)))
1976 (insert text)
1977 (speedbar-make-button start (point) face mouse function token))
1978 (let ((start (point)))
1979 (insert "\n")
1980 (put-text-property start (point) 'face nil)
1981 (put-text-property start (point) 'mouse-face nil)))
1982
1983(defun speedbar-make-button (start end face mouse function &optional token)
1984 "Create a button from START to END, with FACE as the display face.
1985MOUSE is the mouse face. When this button is clicked on FUNCTION
59588cd4 1986will be run with the TOKEN parameter (any Lisp object)"
6b3eac8d
DN
1987 (put-text-property start end 'face face)
1988 (put-text-property start end 'mouse-face mouse)
1989 (put-text-property start end 'invisible nil)
1990 (if function (put-text-property start end 'speedbar-function function))
1991 (if token (put-text-property start end 'speedbar-token token))
1992 )
1993\f
59588cd4
KH
1994;;; Initial Expansion list management
1995;;
1996(defun speedbar-initial-expansion-list ()
1997 "Return the current default expansion list.
1998This is based on `speedbar-initial-expansion-list-name' referencing
1999`speedbar-initial-expansion-mode-alist'."
2000 ;; cdr1 - name, cdr2 - menu
2001 (cdr (cdr (cdr (assoc speedbar-initial-expansion-list-name
2002 speedbar-initial-expansion-mode-alist)))))
2003
2004(defun speedbar-initial-menu ()
2005 "Return the current default menu data.
2006This is based on `speedbar-initial-expansion-list-name' referencing
2007`speedbar-initial-expansion-mode-alist'."
2008 (symbol-value
2009 (car (cdr (assoc speedbar-initial-expansion-list-name
2010 speedbar-initial-expansion-mode-alist)))))
2011
2012(defun speedbar-initial-keymap ()
2013 "Return the current default menu data.
2014This is based on `speedbar-initial-expansion-list-name' referencing
2015`speedbar-initial-expansion-mode-alist'."
2016 (symbol-value
2017 (car (cdr (cdr (assoc speedbar-initial-expansion-list-name
2018 speedbar-initial-expansion-mode-alist))))))
2019
2020(defun speedbar-initial-stealthy-functions ()
2021 "Return a list of functions to call stealthily.
2022This is based on `speedbar-initial-expansion-list-name' referencing
2023`speedbar-stealthy-function-list'."
2024 (cdr (assoc speedbar-initial-expansion-list-name
2025 speedbar-stealthy-function-list)))
2026
2027(defun speedbar-add-expansion-list (new-list)
2028 "Add NEW-LIST to the list of expansion lists."
2029 (add-to-list 'speedbar-initial-expansion-mode-alist new-list))
2030
2031(defun speedbar-change-initial-expansion-list (new-default)
2032 "Change speedbar's default expansion list to NEW-DEFAULT."
2033 (interactive
2034 (list
2035 (completing-read (format "Speedbar Mode (default %s): "
2036 speedbar-previously-used-expansion-list-name)
2037 speedbar-initial-expansion-mode-alist
2038 nil t "" nil
2039 speedbar-previously-used-expansion-list-name)))
2040 (setq speedbar-previously-used-expansion-list-name
2041 speedbar-initial-expansion-list-name
2042 speedbar-initial-expansion-list-name new-default)
2043 (speedbar-refresh)
2044 (speedbar-reconfigure-keymaps))
2045
8afc622b
EL
2046(defun speedbar-fetch-replacement-function (function)
2047 "Return a current mode specific replacement for function, or nil.
2048Scans `speedbar-mode-functions-list' first for the current mode, then
2049for FUNCTION."
2050 (cdr (assoc function
2051 (cdr (assoc speedbar-initial-expansion-list-name
2052 speedbar-mode-functions-list)))))
2053
2054(defun speedbar-add-mode-functions-list (new-list)
2055 "Add NEW-LIST to the list of mode functions.
2056See `speedbar-mode-functions-list' for details."
2057 (add-to-list 'speedbar-mode-functions-list new-list))
2058
59588cd4
KH
2059\f
2060;;; Special speedbar display management
2061;;
2062(defun speedbar-maybe-add-localized-support (buffer)
2063 "Quick check function called on BUFFERs by the speedbar timer function.
2064Maintains the value of local variables which control speedbars use
2065of the special mode functions."
2066 (or speedbar-special-mode-expansion-list
2067 (speedbar-add-localized-speedbar-support buffer)))
2068
2069(defun speedbar-add-localized-speedbar-support (buffer)
2070 "Add localized speedbar support to BUFFER's mode if it is available."
2071 (interactive "bBuffer: ")
2072 (if (stringp buffer) (setq buffer (get-buffer buffer)))
2073 (if (not (buffer-live-p buffer))
2074 nil
2075 (save-excursion
2076 (set-buffer buffer)
2077 (save-match-data
2078 (let ((ms (symbol-name major-mode)) v)
2079 (if (not (string-match "-mode$" ms))
2080 nil ;; do nothing to broken mode
2081 (setq ms (substring ms 0 (match-beginning 0)))
2082 (setq v (intern-soft (concat ms "-speedbar-buttons")))
2083 (make-local-variable 'speedbar-special-mode-expansion-list)
2084 (if (not v)
2085 (setq speedbar-special-mode-expansion-list t)
2086 ;; If it is autoloaded, we need to load it now so that
2087 ;; we have access to the varialbe -speedbar-menu-items.
2088 ;; Is this XEmacs safe?
2089 (let ((sf (symbol-function v)))
2090 (if (and (listp sf) (eq (car sf) 'autoload))
2091 (load-library (car (cdr sf)))))
2092 (setq speedbar-special-mode-expansion-list (list v))
2093 (setq v (intern-soft (concat ms "-speedbar-key-map")))
2094 (if (not v)
2095 nil ;; don't add special keymap
2096 (make-local-variable 'speedbar-special-mode-key-map)
2097 (setq speedbar-special-mode-key-map
2098 (symbol-value v)))
2099 (setq v (intern-soft (concat ms "-speedbar-menu-items")))
2100 (if (not v)
2101 nil ;; don't add special menus
2102 (make-local-variable 'speedbar-easymenu-definition-special)
2103 (setq speedbar-easymenu-definition-special
2104 (symbol-value v)))
2105 )))))))
2106
2107(defun speedbar-remove-localized-speedbar-support (buffer)
2108 "Remove any traces that BUFFER supports speedbar in a specialized way."
2109 (save-excursion
2110 (set-buffer buffer)
2111 (kill-local-variable 'speedbar-special-mode-expansion-list)
2112 (kill-local-variable 'speedbar-special-mode-key-map)
2113 (kill-local-variable 'speedbar-easymenu-definition-special)))
2114\f
6b3eac8d
DN
2115;;; File button management
2116;;
2117(defun speedbar-file-lists (directory)
2118 "Create file lists for DIRECTORY.
2119The car is the list of directories, the cdr is list of files not
2120matching ignored headers. Cache any directory files found in
2121`speedbar-directory-contents-alist' and use that cache before scanning
2122the file-system"
2123 (setq directory (expand-file-name directory))
2124 ;; If in powerclick mode, then the directory we are getting
2125 ;; should be rescanned.
2126 (if speedbar-power-click
2127 (adelete 'speedbar-directory-contents-alist directory))
2128 ;; find the directory, either in the cache, or build it.
2129 (or (cdr-safe (assoc directory speedbar-directory-contents-alist))
2130 (let ((default-directory directory)
2131 (dir (directory-files directory nil))
2132 (dirs nil)
2133 (files nil))
2134 (while dir
59588cd4
KH
2135 (if (not
2136 (or (string-match speedbar-file-unshown-regexp (car dir))
2137 (string-match speedbar-directory-unshown-regexp (car dir))))
6b3eac8d
DN
2138 (if (file-directory-p (car dir))
2139 (setq dirs (cons (car dir) dirs))
2140 (setq files (cons (car dir) files))))
2141 (setq dir (cdr dir)))
2142 (let ((nl (cons (nreverse dirs) (list (nreverse files)))))
2143 (aput 'speedbar-directory-contents-alist directory nl)
2144 nl))
2145 ))
2146
2147(defun speedbar-directory-buttons (directory index)
2148 "Insert a single button group at point for DIRECTORY.
2149Each directory path part is a different button. If part of the path
2150matches the user directory ~, then it is replaced with a ~.
2151INDEX is not used, but is required by the caller."
2152 (let* ((tilde (expand-file-name "~"))
2153 (dd (expand-file-name directory))
2154 (junk (string-match (regexp-quote tilde) dd))
2155 (displayme (if junk
2156 (concat "~" (substring dd (match-end 0)))
2157 dd))
2158 (p (point)))
2159 (if (string-match "^~/?\\'" displayme) (setq displayme (concat tilde "/")))
2160 (insert displayme)
2161 (save-excursion
2162 (goto-char p)
2163 (while (re-search-forward "\\([^/]+\\)/" nil t)
2164 (speedbar-make-button (match-beginning 1) (match-end 1)
2165 'speedbar-directory-face
2166 'speedbar-highlight-face
2167 'speedbar-directory-buttons-follow
cc5034d2
RS
2168 (if (and (= (match-beginning 1) p)
2169 (not (char-equal (char-after (+ p 1)) ?:)))
6b3eac8d
DN
2170 (expand-file-name "~/") ;the tilde
2171 (buffer-substring-no-properties
2172 p (match-end 0)))))
2173 ;; Nuke the beginning of the directory if it's too long...
2174 (cond ((eq speedbar-directory-button-trim-method 'span)
2175 (beginning-of-line)
2176 (let ((ww (or (speedbar-frame-width) 20)))
2177 (move-to-column ww nil)
2178 (while (>= (current-column) ww)
2179 (re-search-backward "/" nil t)
2180 (if (<= (current-column) 2)
2181 (progn
2182 (re-search-forward "/" nil t)
2183 (if (< (current-column) 4)
2184 (re-search-forward "/" nil t))
2185 (forward-char -1)))
2186 (if (looking-at "/?$")
2187 (beginning-of-line)
2188 (insert "/...\n ")
2189 (move-to-column ww nil)))))
2190 ((eq speedbar-directory-button-trim-method 'trim)
2191 (end-of-line)
2192 (let ((ww (or (speedbar-frame-width) 20))
2193 (tl (current-column)))
2194 (if (< ww tl)
2195 (progn
2196 (move-to-column (- tl ww))
2197 (if (re-search-backward "/" nil t)
2198 (progn
2199 (delete-region (point-min) (point))
2200 (insert "$")
2201 )))))))
2202 )
2203 (if (string-match "\\`/[^/]+/\\'" displayme)
2204 (progn
2205 (insert " ")
2206 (let ((p (point)))
2207 (insert "<root>")
2208 (speedbar-make-button p (point)
2209 'speedbar-directory-face
2210 'speedbar-highlight-face
2211 'speedbar-directory-buttons-follow
2212 "/"))))
2213 (end-of-line)
2214 (insert-char ?\n 1 nil)))
2215
2216(defun speedbar-make-tag-line (exp-button-type
2217 exp-button-char exp-button-function
2218 exp-button-data
2219 tag-button tag-button-function tag-button-data
2220 tag-button-face depth)
2221 "Create a tag line with EXP-BUTTON-TYPE for the small expansion button.
2222This is the button that expands or contracts a node (if applicable),
2223and EXP-BUTTON-CHAR the character in it (+, -, ?, etc). EXP-BUTTON-FUNCTION
2224is the function to call if it's clicked on. Button types are
2225'bracket, 'angle, 'curly, or nil. EXP-BUTTON-DATA is extra data
2226attached to the text forming the expansion button.
2227
2228Next, TAG-BUTTON is the text of the tag. TAG-BUTTON-FUNCTION is the
2229function to call if clicked on, and TAG-BUTTON-DATA is the data to
2230attach to the text field (such a tag positioning, etc).
2231TAG-BUTTON-FACE is a face used for this type of tag.
2232
2233Lastly, DEPTH shows the depth of expansion.
2234
2235This function assumes that the cursor is in the speedbar window at the
2236position to insert a new item, and that the new item will end with a CR"
2237 (let ((start (point))
2238 (end (progn
2239 (insert (int-to-string depth) ":")
2240 (point))))
2241 (put-text-property start end 'invisible t)
2242 )
2243 (insert-char ? depth nil)
2244 (put-text-property (- (point) depth) (point) 'invisible nil)
2245 (let* ((exp-button (cond ((eq exp-button-type 'bracket) "[%c]")
2246 ((eq exp-button-type 'angle) "<%c>")
2247 ((eq exp-button-type 'curly) "{%c}")
2248 (t ">")))
2249 (buttxt (format exp-button exp-button-char))
2250 (start (point))
2251 (end (progn (insert buttxt) (point)))
2252 (bf (if exp-button-type 'speedbar-button-face nil))
2253 (mf (if exp-button-function 'speedbar-highlight-face nil))
2254 )
2255 (speedbar-make-button start end bf mf exp-button-function exp-button-data)
59588cd4
KH
2256 (if speedbar-hide-button-brackets-flag
2257 (progn
2258 (put-text-property start (1+ start) 'invisible t)
2259 (put-text-property end (1- end) 'invisible t)))
6b3eac8d
DN
2260 )
2261 (insert-char ? 1 nil)
2262 (put-text-property (1- (point)) (point) 'invisible nil)
2263 (let ((start (point))
2264 (end (progn (insert tag-button) (point))))
2265 (insert-char ?\n 1 nil)
2266 (put-text-property (1- (point)) (point) 'invisible nil)
2267 (speedbar-make-button start end tag-button-face
2268 (if tag-button-function 'speedbar-highlight-face nil)
2269 tag-button-function tag-button-data))
2270)
2271
2272(defun speedbar-change-expand-button-char (char)
2273 "Change the expansion button character to CHAR for the current line."
2274 (save-excursion
2275 (beginning-of-line)
2276 (if (re-search-forward ":\\s-*.\\([-+?]\\)" (save-excursion (end-of-line)
2277 (point)) t)
2278 (speedbar-with-writable
2279 (goto-char (match-beginning 1))
2280 (delete-char 1)
59588cd4
KH
2281 (insert-char char 1 t)
2282 (put-text-property (point) (1- (point)) 'invisible nil)))))
6b3eac8d
DN
2283
2284\f
2285;;; Build button lists
2286;;
2287(defun speedbar-insert-files-at-point (files level)
2288 "Insert list of FILES starting at point, and indenting all files to LEVEL.
2289Tag expandable items with a +, otherwise a ?. Don't highlight ? as we
2290don't know how to manage them. The input parameter FILES is a cons
59588cd4 2291cell of the form ( 'DIRLIST . 'FILELIST )"
6b3eac8d
DN
2292 ;; Start inserting all the directories
2293 (let ((dirs (car files)))
2294 (while dirs
2295 (speedbar-make-tag-line 'angle ?+ 'speedbar-dired (car dirs)
2296 (car dirs) 'speedbar-dir-follow nil
2297 'speedbar-directory-face level)
2298 (setq dirs (cdr dirs))))
59588cd4
KH
2299 (let ((lst (car (cdr files)))
2300 (case-fold-search t))
6b3eac8d
DN
2301 (while lst
2302 (let* ((known (string-match speedbar-file-regexp (car lst)))
2303 (expchar (if known ?+ ??))
2304 (fn (if known 'speedbar-tag-file nil)))
2305 (if (or speedbar-show-unknown-files (/= expchar ??))
2306 (speedbar-make-tag-line 'bracket expchar fn (car lst)
2307 (car lst) 'speedbar-find-file nil
2308 'speedbar-file-face level)))
2309 (setq lst (cdr lst)))))
2310
2311(defun speedbar-default-directory-list (directory index)
2312 "Insert files for DIRECTORY with level INDEX at point."
2313 (speedbar-insert-files-at-point
2314 (speedbar-file-lists directory) index)
2315 (speedbar-reset-scanners)
2316 (if (= index 0)
2317 ;; If the shown files variable has extra directories, then
2318 ;; it is our responsibility to redraw them all
2319 ;; Luckilly, the nature of inserting items into this list means
2320 ;; that by reversing it, we can easilly go in the right order
2321 (let ((sf (cdr (reverse speedbar-shown-directories))))
2322 (setq speedbar-shown-directories
2323 (list (expand-file-name default-directory)))
2324 ;; exand them all as we find them
2325 (while sf
2326 (if (speedbar-goto-this-file (car sf))
2327 (progn
2328 (beginning-of-line)
2329 (if (looking-at "[0-9]+:[ ]*<")
2330 (progn
2331 (goto-char (match-end 0))
2332 (speedbar-do-function-pointer)))
2333 (setq sf (cdr sf)))))
2334 )))
2335
59588cd4
KH
2336(defun speedbar-apply-one-tag-hierarchy-method (lst method)
2337 "Adjust the tag hierarchy LST by METHOD."
2338 (cond
2339 ((eq method 'sort)
2340 (sort (copy-alist lst)
2341 (lambda (a b) (string< (car a) (car b)))))
2342 ((eq method 'prefix-group)
2343 (let ((newlst nil)
2344 (sublst nil)
2345 (work-list nil)
2346 (junk-list nil)
2347 (short-group-list nil)
2348 (short-start-name nil)
2349 (short-end-name nil)
2350 (num-shorts-grouped 0)
2351 (bins (make-vector 256 nil))
2352 (diff-idx 0))
2353 ;; Break out sub-lists
2354 (while lst
2355 (if (listp (cdr-safe (car-safe lst)))
2356 (setq newlst (cons (car lst) newlst))
2357 (setq sublst (cons (car lst) sublst)))
2358 (setq lst (cdr lst)))
8583d8b3
EL
2359 ;; Reverse newlst because it was made backwards.
2360 ;; Sublist doesn't need reversing because the act
2361 ;; of binning things will reverse it for us.
2362 (setq newlst (nreverse newlst))
59588cd4
KH
2363 ;; Now, first find out how long our list is. Never let a
2364 ;; list get-shorter than our minimum.
2365 (if (<= (length sublst) speedbar-tag-split-minimum-length)
2366 (setq work-list (nreverse sublst))
2367 (setq diff-idx (length (try-completion "" sublst)))
2368 ;; Sort the whole list into bins.
2369 (while sublst
2370 (let ((e (car sublst))
2371 (s (car (car sublst))))
2372 (cond ((<= (length s) diff-idx)
2373 ;; 0 storage bin for shorty.
2374 (aset bins 0 (cons e (aref bins 0))))
2375 (t
2376 ;; stuff into a bin based on ascii value at diff
2377 (aset bins (aref s diff-idx)
2378 (cons e (aref bins (aref s diff-idx)))))))
2379 (setq sublst (cdr sublst)))
2380 ;; Go through all our bins Stick singles into our
2381 ;; junk-list, everything else as sublsts in work-list.
2382 ;; If two neighboring lists are both small, make a grouped
2383 ;; group combinding those two sub-lists.
2384 (setq diff-idx 0)
2385 (while (> 256 diff-idx)
8583d8b3
EL
2386 (let ((l (nreverse ;; Reverse the list since they are stuck in
2387 ;; backwards.
2388 (aref bins diff-idx))))
59588cd4
KH
2389 (if l
2390 (let ((tmp (cons (try-completion "" l) l)))
2391 (if (or (> (length l) speedbar-tag-regroup-maximum-length)
2392 (> (+ (length l) (length short-group-list))
2393 speedbar-tag-split-minimum-length))
2394 (progn
2395 ;; We have reached a longer list, so we
2396 ;; must finish off a grouped group.
2397 (cond
2398 ((and short-group-list
2399 (= (length short-group-list)
2400 num-shorts-grouped))
2401 ;; All singles? Junk list
2402 (setq junk-list (append short-group-list
2403 junk-list)))
2404 ((= num-shorts-grouped 1)
2405 ;; Only one short group? Just stick it in
8583d8b3
EL
2406 ;; there by itself. Make a group, and find
2407 ;; a subexpression
2408 (let ((subexpression (try-completion
2409 "" short-group-list)))
2410 (if (< (length subexpression)
2411 speedbar-tag-group-name-minimum-length)
2412 (setq subexpression
2413 (concat short-start-name
2414 " ("
2415 (substring
2416 (car (car short-group-list))
2417 (length short-start-name))
2418 ")")))
2419 (setq work-list
2420 (cons (cons subexpression
2421 short-group-list)
2422 work-list))))
59588cd4
KH
2423 (short-group-list
2424 ;; Multiple groups to be named in a special
2425 ;; way by displaying the range over which we
2426 ;; have grouped them.
2427 (setq work-list
2428 (cons (cons (concat short-start-name
2429 " to "
2430 short-end-name)
2431 (nreverse short-group-list))
2432 work-list))))
2433 ;; Reset short group list information every time.
2434 (setq short-group-list nil
2435 short-start-name nil
2436 short-end-name nil
8583d8b3 2437 num-shorts-grouped 0)))
59588cd4
KH
2438 ;; Ok, now that we cleaned up the short-group-list,
2439 ;; we can deal with this new list, to decide if it
2440 ;; should go on one of these sub-lists or not.
2441 (if (< (length l) speedbar-tag-regroup-maximum-length)
2442 (setq short-group-list (append short-group-list l)
2443 num-shorts-grouped (1+ num-shorts-grouped)
2444 short-end-name (car tmp)
2445 short-start-name (if short-start-name
2446 short-start-name
2447 (car tmp)))
2448 (setq work-list (cons tmp work-list))))))
2449 (setq diff-idx (1+ diff-idx))))
2450 ;; Did we run out of things? Drop our new list onto the end.
2451 (cond
2452 ((and short-group-list (= (length short-group-list) num-shorts-grouped))
2453 ;; All singles? Junk list
2454 (setq junk-list (append short-group-list junk-list)))
2455 ((= num-shorts-grouped 1)
2456 ;; Only one short group? Just stick it in
2457 ;; there by itself.
2458 (setq work-list
2459 (cons (cons (try-completion "" short-group-list)
8583d8b3 2460 short-group-list)
59588cd4
KH
2461 work-list)))
2462 (short-group-list
2463 ;; Multiple groups to be named in a special
2464 ;; way by displaying the range over which we
2465 ;; have grouped them.
2466 (setq work-list
2467 (cons (cons (concat short-start-name " to " short-end-name)
8583d8b3 2468 short-group-list)
59588cd4 2469 work-list))))
8583d8b3
EL
2470 ;; Reverse the work list nreversed when consing.
2471 (setq work-list (nreverse work-list))
59588cd4
KH
2472 ;; Now, stick our new list onto the end of
2473 (if work-list
2474 (if junk-list
8583d8b3
EL
2475 (append newlst work-list junk-list)
2476 (append newlst work-list))
2477 (append newlst junk-list))))
59588cd4
KH
2478 ((eq method 'trim-words)
2479 (let ((newlst nil)
2480 (sublst nil)
2481 (trim-prefix nil)
2482 (trim-chars 0)
2483 (trimlst nil))
2484 (while lst
2485 (if (listp (cdr-safe (car-safe lst)))
2486 (setq newlst (cons (car lst) newlst))
2487 (setq sublst (cons (car lst) sublst)))
2488 (setq lst (cdr lst)))
2489 ;; Get the prefix to trim by. Make sure that we don't trim
2490 ;; off silly pieces, only complete understandable words.
2491 (setq trim-prefix (try-completion "" sublst))
2492 (if (or (= (length sublst) 1)
2493 (not trim-prefix)
2494 (not (string-match "\\(\\w+\\W+\\)+" trim-prefix)))
2495 (append (nreverse newlst) (nreverse sublst))
2496 (setq trim-prefix (substring trim-prefix (match-beginning 0)
2497 (match-end 0)))
2498 (setq trim-chars (length trim-prefix))
2499 (while sublst
2500 (setq trimlst (cons
2501 (cons (substring (car (car sublst)) trim-chars)
2502 (cdr (car sublst)))
2503 trimlst)
2504 sublst (cdr sublst)))
2505 ;; Put the lists together
2506 (append (nreverse newlst) trimlst))))
2507 ((eq method 'simple-group)
2508 (let ((newlst nil)
2509 (sublst nil))
2510 (while lst
2511 (if (listp (cdr-safe (car-safe lst)))
2512 (setq newlst (cons (car lst) newlst))
2513 (setq sublst (cons (car lst) sublst)))
2514 (setq lst (cdr lst)))
2515 (if (not newlst)
2516 (nreverse sublst)
2517 (setq newlst (cons (cons "Tags" (nreverse sublst)) newlst))
2518 (nreverse newlst))))
2519 (t lst)))
2520
2521(defun speedbar-create-tag-hierarchy (lst)
2522 "Adjust the tag hierarchy in LST, and return it.
2523This uses `speedbar-tag-hierarchy-method' to determine how to adjust
2524the list. See it's value for details."
8583d8b3
EL
2525 (let* ((f (save-excursion
2526 (forward-line -1)
2527 (speedbar-line-path)))
2528 (methods (if (get-file-buffer f)
2529 (save-excursion (set-buffer (get-file-buffer f))
2530 speedbar-tag-hierarchy-method)
2531 speedbar-tag-hierarchy-method)))
59588cd4
KH
2532 (while methods
2533 (setq lst (speedbar-apply-one-tag-hierarchy-method lst (car methods))
2534 methods (cdr methods)))
2535 lst))
2536
6b3eac8d
DN
2537(defun speedbar-insert-generic-list (level lst expand-fun find-fun)
2538 "At LEVEL, insert a generic multi-level alist LST.
2539Associations with lists get {+} tags (to expand into more nodes) and
2540those with positions just get a > as the indicator. {+} buttons will
2541have the function EXPAND-FUN and the token is the CDR list. The token
2542name will have the function FIND-FUN and not token."
2543 ;; Remove imenu rescan button
2544 (if (string= (car (car lst)) "*Rescan*")
2545 (setq lst (cdr lst)))
59588cd4
KH
2546 ;; Adjust the list.
2547 (setq lst (speedbar-create-tag-hierarchy lst))
6b3eac8d
DN
2548 ;; insert the parts
2549 (while lst
2550 (cond ((null (car-safe lst)) nil) ;this would be a separator
2551 ((or (numberp (cdr-safe (car-safe lst)))
2552 (markerp (cdr-safe (car-safe lst))))
2553 (speedbar-make-tag-line nil nil nil nil ;no expand button data
2554 (car (car lst)) ;button name
2555 find-fun ;function
2556 (cdr (car lst)) ;token is position
2557 'speedbar-tag-face
2558 (1+ level)))
2559 ((listp (cdr-safe (car-safe lst)))
2560 (speedbar-make-tag-line 'curly ?+ expand-fun (cdr (car lst))
2561 (car (car lst)) ;button name
2562 nil nil 'speedbar-tag-face
2563 (1+ level)))
39273816 2564 (t (speedbar-message "Ooops!")))
6b3eac8d
DN
2565 (setq lst (cdr lst))))
2566\f
2567;;; Timed functions
2568;;
2569(defun speedbar-update-contents ()
2570 "Generically update the contents of the speedbar buffer."
2571 (interactive)
2572 ;; Set the current special buffer
2573 (setq speedbar-desired-buffer nil)
59588cd4
KH
2574 ;; Check for special modes
2575 (speedbar-maybe-add-localized-support (current-buffer))
2576 ;; Choose the correct method of doodling.
6b3eac8d 2577 (if (and speedbar-mode-specific-contents-flag
59588cd4 2578 (listp speedbar-special-mode-expansion-list)
6b3eac8d
DN
2579 speedbar-special-mode-expansion-list
2580 (local-variable-p
2581 'speedbar-special-mode-expansion-list
2582 (current-buffer)))
2583 ;;(eq (get major-mode 'mode-class 'special)))
2584 (speedbar-update-special-contents)
2585 (speedbar-update-directory-contents)))
2586
2587(defun speedbar-update-directory-contents ()
2588 "Update the contents of the speedbar buffer based on the current directory."
2589 (let ((cbd (expand-file-name default-directory))
2590 cbd-parent
59588cd4 2591 (funclst (speedbar-initial-expansion-list))
6b3eac8d
DN
2592 (cache speedbar-full-text-cache)
2593 ;; disable stealth during update
2594 (speedbar-stealthy-function-list nil)
2595 (use-cache nil)
2596 (expand-local nil)
2597 ;; Because there is a bug I can't find just yet
2598 (inhibit-quit nil))
2599 (save-excursion
2600 (set-buffer speedbar-buffer)
2601 ;; If we are updating contents to where we are, then this is
2602 ;; really a request to update existing contents, so we must be
2603 ;; careful with our text cache!
2604 (if (member cbd speedbar-shown-directories)
59588cd4
KH
2605 (progn
2606 (setq cache nil)
2607 ;; If the current directory is not the last element in the dir
2608 ;; list, then we ALSO need to zap the list of expanded directories
2609 (if (/= (length (member cbd speedbar-shown-directories)) 1)
2610 (setq speedbar-shown-directories (list cbd))))
6b3eac8d
DN
2611
2612 ;; Build cbd-parent, and see if THAT is in the current shown
2613 ;; directories. First, go through pains to get the parent directory
2614 (if (and speedbar-smart-directory-expand-flag
2615 (save-match-data
2616 (setq cbd-parent cbd)
2617 (if (string-match "/$" cbd-parent)
59588cd4
KH
2618 (setq cbd-parent (substring cbd-parent 0
2619 (match-beginning 0))))
6b3eac8d
DN
2620 (setq cbd-parent (file-name-directory cbd-parent)))
2621 (member cbd-parent speedbar-shown-directories))
2622 (setq expand-local t)
2623
2624 ;; If this directory is NOT in the current list of available
2625 ;; paths, then use the cache, and set the cache to our new
2626 ;; value. Make sure to unhighlight the current file, or if we
2627 ;; come back to this directory, it might be a different file
2628 ;; and then we get a mess!
2629 (if (> (point-max) 1)
2630 (progn
2631 (speedbar-clear-current-file)
2632 (setq speedbar-full-text-cache
2633 (cons speedbar-shown-directories (buffer-string)))))
2634
2635 ;; Check if our new directory is in the list of directories
2636 ;; shown in the text-cache
2637 (if (member cbd (car cache))
2638 (setq speedbar-shown-directories (car cache)
2639 use-cache t)
2640 ;; default the shown directories to this list...
2641 (setq speedbar-shown-directories (list cbd)))
2642 ))
a4252bdb 2643 (if (not expand-local) (setq speedbar-last-selected-file nil))
6b3eac8d
DN
2644 (speedbar-with-writable
2645 (if (and expand-local
2646 ;; Find this directory as a speedbar node.
2647 (speedbar-path-line cbd))
2648 ;; Open it.
2649 (speedbar-expand-line)
2650 (erase-buffer)
2651 (cond (use-cache
2652 (setq default-directory
2653 (nth (1- (length speedbar-shown-directories))
2654 speedbar-shown-directories))
2655 (insert (cdr cache)))
2656 (t
2657 (while funclst
2658 (setq default-directory cbd)
2659 (funcall (car funclst) cbd 0)
2660 (setq funclst (cdr funclst))))))
2661 (goto-char (point-min)))))
59588cd4 2662 (speedbar-reconfigure-keymaps))
6b3eac8d
DN
2663
2664(defun speedbar-update-special-contents ()
2665 "Used the mode-specific variable to fill in the speedbar buffer.
2666This should only be used by modes classified as special."
2667 (let ((funclst speedbar-special-mode-expansion-list)
2668 (specialbuff (current-buffer)))
2669 (save-excursion
2670 (setq speedbar-desired-buffer specialbuff)
2671 (set-buffer speedbar-buffer)
2672 ;; If we are leaving a directory, cache it.
2673 (if (not speedbar-shown-directories)
2674 ;; Do nothing
2675 nil
2676 ;; Clean up directory maintenance stuff
2677 (speedbar-clear-current-file)
2678 (setq speedbar-full-text-cache
2679 (cons speedbar-shown-directories (buffer-string))
2680 speedbar-shown-directories nil))
2681 ;; Now fill in the buffer with our newly found specialized list.
2682 (speedbar-with-writable
2683 (while funclst
2684 ;; We do not erase the buffer because these functions may
2685 ;; decide NOT to update themselves.
2686 (funcall (car funclst) specialbuff)
2687 (setq funclst (cdr funclst))))
2688 (goto-char (point-min))))
59588cd4 2689 (speedbar-reconfigure-keymaps))
6b3eac8d
DN
2690
2691(defun speedbar-timer-fn ()
59588cd4 2692 "Run whenever Emacs is idle to update the speedbar item."
6b3eac8d
DN
2693 (if (not (and (frame-live-p speedbar-frame)
2694 (frame-live-p speedbar-attached-frame)))
2695 (speedbar-set-timer nil)
2696 ;; Save all the match data so that we don't mess up executing fns
2697 (save-match-data
a4252bdb
EL
2698 ;; Only do stuff if the frame is visible, not an icon, and if
2699 ;; it is currently flagged to do something.
2700 (if (and speedbar-update-flag
2701 (frame-visible-p speedbar-frame)
2702 (not (eq (frame-visible-p speedbar-frame) 'icon)))
6b3eac8d
DN
2703 (let ((af (selected-frame)))
2704 (save-window-excursion
2705 (select-frame speedbar-attached-frame)
2706 ;; make sure we at least choose a window to
2707 ;; get a good directory from
a4252bdb
EL
2708 (if (window-minibuffer-p (selected-window))
2709 nil
2710 ;; Check for special modes
2711 (speedbar-maybe-add-localized-support (current-buffer))
2712 ;; Update for special mode all the time!
2713 (if (and speedbar-mode-specific-contents-flag
2714 (listp speedbar-special-mode-expansion-list)
2715 speedbar-special-mode-expansion-list
2716 (local-variable-p
2717 'speedbar-special-mode-expansion-list
2718 (current-buffer)))
2719 ;;(eq (get major-mode 'mode-class 'special)))
2720 (progn
2721 (if (<= 2 speedbar-verbosity-level)
39273816
KH
2722 (speedbar-message
2723 "Updating speedbar to special mode: %s..."
2724 major-mode))
a4252bdb
EL
2725 (speedbar-update-special-contents)
2726 (if (<= 2 speedbar-verbosity-level)
2727 (progn
39273816
KH
2728 (speedbar-message
2729 "Updating speedbar to special mode: %s...done"
2730 major-mode)
2731 (speedbar-message nil))))
a4252bdb
EL
2732 ;; Update all the contents if directories change!
2733 (if (or (member (expand-file-name default-directory)
2734 speedbar-shown-directories)
2735 (and speedbar-ignored-path-regexp
2736 (string-match
2737 speedbar-ignored-path-regexp
2738 (expand-file-name default-directory)))
2739 (member major-mode speedbar-ignored-modes)
2740 (eq af speedbar-frame)
2741 (not (buffer-file-name)))
2742 nil
2743 (if (<= 1 speedbar-verbosity-level)
39273816 2744 (speedbar-message "Updating speedbar to: %s..."
a4252bdb
EL
2745 default-directory))
2746 (speedbar-update-directory-contents)
2747 (if (<= 1 speedbar-verbosity-level)
61d7e1dc 2748 (progn
39273816 2749 (speedbar-message "Updating speedbar to: %s...done"
a4252bdb 2750 default-directory)
39273816 2751 (speedbar-message nil)))))
a4252bdb 2752 (select-frame af)))
6b3eac8d 2753 ;; Now run stealthy updates of time-consuming items
59588cd4
KH
2754 (speedbar-stealthy-updates)))
2755 ;; Now run the mouse tracking system
2756 (speedbar-show-info-under-mouse)))
6b3eac8d
DN
2757 (run-hooks 'speedbar-timer-hook))
2758
2759\f
2760;;; Stealthy activities
2761;;
59588cd4
KH
2762(defvar speedbar-stealthy-update-recurse nil
2763 "Recursion avoidance variable for stealthy update.")
2764
6b3eac8d
DN
2765(defun speedbar-stealthy-updates ()
2766 "For a given speedbar, run all items in the stealthy function list.
2767Each item returns t if it completes successfully, or nil if
2768interrupted by the user."
59588cd4
KH
2769 (if (not speedbar-stealthy-update-recurse)
2770 (let ((l (speedbar-initial-stealthy-functions))
2771 (speedbar-stealthy-update-recurse t))
2772 (unwind-protect
469a3717 2773 (speedbar-with-writable
8583d8b3
EL
2774 (while (and l (funcall (car l)))
2775 ;;(sit-for 0)
2776 (setq l (cdr l))))
39273816 2777 ;;(speedbar-message "Exit with %S" (car l))
59588cd4 2778 ))))
6b3eac8d
DN
2779
2780(defun speedbar-reset-scanners ()
2781 "Reset any variables used by functions in the stealthy list as state.
2782If new functions are added, their state needs to be updated here."
59588cd4
KH
2783 (setq speedbar-vc-to-do-point t
2784 speedbar-obj-to-do-point t)
6b3eac8d
DN
2785 (run-hooks 'speedbar-scanner-reset-hook)
2786 )
2787
fd7bd989
EL
2788(defun speedbar-find-selected-file (file)
2789 "Goto the line where FILE is."
2790 (goto-char (point-min))
2791 (let ((m nil))
2792 (while (and (setq m (re-search-forward
2793 (concat " \\(" (file-name-nondirectory file)
2794 "\\)\\(" speedbar-indicator-regex "\\)?\n")
2795 nil t))
2796 (not (string= file
2797 (concat
2798 (speedbar-line-path
2799 (save-excursion
2800 (goto-char (match-beginning 0))
2801 (beginning-of-line)
2802 (save-match-data
2803 (looking-at "[0-9]+:")
2804 (string-to-number (match-string 0)))))
2805 (match-string 1))))))
2806 (if m
2807 (progn
2808 (goto-char (match-beginning 1))
2809 (match-string 1)))))
2810
6b3eac8d
DN
2811(defun speedbar-clear-current-file ()
2812 "Locate the file thought to be current, and remove its highlighting."
2813 (save-excursion
2814 (set-buffer speedbar-buffer)
2815 (if speedbar-last-selected-file
2816 (speedbar-with-writable
fd7bd989 2817 (if (speedbar-find-selected-file speedbar-last-selected-file)
6b3eac8d
DN
2818 (put-text-property (match-beginning 1)
2819 (match-end 1)
2820 'face
2821 'speedbar-file-face))))))
2822
2823(defun speedbar-update-current-file ()
2824 "Find the current file, and update our visuals to indicate its name.
2825This is specific to file names. If the file name doesn't show up, but
2826it should be in the list, then the directory cache needs to be
2827updated."
2828 (let* ((lastf (selected-frame))
2829 (newcfd (save-excursion
2830 (select-frame speedbar-attached-frame)
2831 (let ((rf (if (buffer-file-name)
2832 (buffer-file-name)
2833 nil)))
2834 (select-frame lastf)
2835 rf)))
fd7bd989 2836 (newcf (if newcfd newcfd))
6b3eac8d 2837 (lastb (current-buffer))
59588cd4
KH
2838 (sucf-recursive (boundp 'sucf-recursive))
2839 (case-fold-search t))
6b3eac8d
DN
2840 (if (and newcf
2841 ;; check here, that way we won't refresh to newcf until
2842 ;; its been written, thus saving ourselves some time
2843 (file-exists-p newcf)
2844 (not (string= newcf speedbar-last-selected-file)))
2845 (progn
2846 ;; It is important to select the frame, otherwise the window
2847 ;; we want the cursor to move in will not be updated by the
2848 ;; search-forward command.
2849 (select-frame speedbar-frame)
2850 ;; Remove the old file...
2851 (speedbar-clear-current-file)
2852 ;; now highlight the new one.
2853 (set-buffer speedbar-buffer)
2854 (speedbar-with-writable
fd7bd989
EL
2855 (if (speedbar-find-selected-file newcf)
2856 ;; put the property on it
2857 (put-text-property (match-beginning 1)
2858 (match-end 1)
2859 'face
2860 'speedbar-selected-face)
6b3eac8d
DN
2861 ;; Oops, it's not in the list. Should it be?
2862 (if (and (string-match speedbar-file-regexp newcf)
2863 (string= (file-name-directory newcfd)
2864 (expand-file-name default-directory)))
2865 ;; yes, it is (we will ignore unknowns for now...)
2866 (progn
2867 (speedbar-refresh)
fd7bd989 2868 (if (speedbar-find-selected-file newcf)
6b3eac8d
DN
2869 ;; put the property on it
2870 (put-text-property (match-beginning 1)
2871 (match-end 1)
2872 'face
2873 'speedbar-selected-face)))
2874 ;; if it's not in there now, whatever...
2875 ))
2876 (setq speedbar-last-selected-file newcf))
2877 (if (not sucf-recursive)
0e596101
EL
2878 (progn
2879 (speedbar-center-buffer-smartly)
2880 (speedbar-position-cursor-on-line)
2881 ))
6b3eac8d
DN
2882 (set-buffer lastb)
2883 (select-frame lastf)
2884 )))
2885 ;; return that we are done with this activity.
2886 t)
2887
59588cd4
KH
2888(defun speedbar-add-indicator (indicator-string &optional replace-this)
2889 "Add INDICATOR-STRING to the end of this speedbar line.
2890If INDICATOR-STRING is space, and REPLACE-THIS is a character, then
2891an the existing indicator is removed. If there is already an
2892indicator, then do not add a space."
2893 (beginning-of-line)
2894 ;; The nature of the beast: Assume we are in "the right place"
2895 (end-of-line)
2896 (skip-chars-backward (concat " " speedbar-vc-indicator
2897 (car speedbar-obj-indicator)
2898 (cdr speedbar-obj-indicator)))
2899 (if (and (not (looking-at speedbar-indicator-regex))
2900 (not (string= indicator-string " ")))
2901 (insert speedbar-indicator-separator))
2902 (speedbar-with-writable
2903 (save-excursion
2904 (if (and replace-this
2905 (re-search-forward replace-this (save-excursion (end-of-line)
2906 (point))
2907 t))
2908 (delete-region (match-beginning 0) (match-end 0))))
2909 (end-of-line)
2910 (if (not (string= " " indicator-string))
2911 (insert indicator-string))))
2912
2913;; Load efs/ange-ftp only if compiling to remove byte-compiler warnings.
6b3eac8d 2914;; Steven L Baur <steve@xemacs.org> said this was important:
59588cd4
KH
2915(eval-when-compile (or (featurep 'xemacs)
2916 (condition-case () (require 'efs)
2917 (error (require 'ange-ftp)))))
6b3eac8d
DN
2918
2919(defun speedbar-check-vc ()
2920 "Scan all files in a directory, and for each see if it's checked out.
2921See `speedbar-this-file-in-vc' and `speedbar-vc-check-dir-p' for how
2922to add more types of version control systems."
2923 ;; Check for to-do to be reset. If reset but no RCS is available
2924 ;; then set to nil (do nothing) otherwise, start at the beginning
2925 (save-excursion
2926 (set-buffer speedbar-buffer)
2927 (if (and speedbar-vc-do-check (eq speedbar-vc-to-do-point t)
2928 (speedbar-vc-check-dir-p default-directory)
59588cd4
KH
2929 (not (or (and (featurep 'ange-ftp)
2930 (string-match
2931 (car (if speedbar-xemacsp
2932 ange-ftp-path-format
2933 ange-ftp-name-format))
2934 (expand-file-name default-directory)))
2935 ;; efs support: Bob Weiner
2936 (and (featurep 'efs)
2937 (string-match
2938 (car efs-path-regexp)
2939 (expand-file-name default-directory))))))
6b3eac8d
DN
2940 (setq speedbar-vc-to-do-point 0))
2941 (if (numberp speedbar-vc-to-do-point)
2942 (progn
2943 (goto-char speedbar-vc-to-do-point)
2944 (while (and (not (input-pending-p))
2945 (re-search-forward "^\\([0-9]+\\):\\s-*\\[[+-]\\] "
2946 nil t))
2947 (setq speedbar-vc-to-do-point (point))
2948 (if (speedbar-check-vc-this-line (match-string 1))
59588cd4
KH
2949 (speedbar-add-indicator speedbar-vc-indicator
2950 (regexp-quote speedbar-vc-indicator))
2951 (speedbar-add-indicator " "
2952 (regexp-quote speedbar-vc-indicator))))
6b3eac8d
DN
2953 (if (input-pending-p)
2954 ;; return that we are incomplete
2955 nil
2956 ;; we are done, set to-do to nil
2957 (setq speedbar-vc-to-do-point nil)
2958 ;; and return t
2959 t))
2960 t)))
2961
2962(defun speedbar-check-vc-this-line (depth)
2963 "Return t if the file on this line is check of of a version control system.
2964Parameter DEPTH is a string with the current depth of indentation of
2965the file being checked."
2966 (let* ((d (string-to-int depth))
2967 (f (speedbar-line-path d))
2968 (fn (buffer-substring-no-properties
2969 ;; Skip-chars: thanks ptype@dra.hmg.gb
2970 (point) (progn
2971 (skip-chars-forward "^ "
2972 (save-excursion (end-of-line)
2973 (point)))
2974 (point))))
2975 (fulln (concat f fn)))
2976 (if (<= 2 speedbar-verbosity-level)
39273816 2977 (speedbar-message "Speedbar vc check...%s" fulln))
6b3eac8d
DN
2978 (and (file-writable-p fulln)
2979 (speedbar-this-file-in-vc f fn))))
2980
2981(defun speedbar-vc-check-dir-p (path)
2982 "Return t if we should bother checking PATH for version control files.
2983This can be overloaded to add new types of version control systems."
2984 (or
2985 ;; Local RCS
2986 (file-exists-p (concat path "RCS/"))
2987 ;; Local SCCS
2988 (file-exists-p (concat path "SCCS/"))
2989 ;; Remote SCCS project
2990 (let ((proj-dir (getenv "PROJECTDIR")))
2991 (if proj-dir
2992 (file-exists-p (concat proj-dir "/SCCS"))
2993 nil))
2994 ;; User extension
2995 (run-hook-with-args 'speedbar-vc-path-enable-hook path)
2996 ))
2997
2998(defun speedbar-this-file-in-vc (path name)
2999 "Check to see if the file in PATH with NAME is in a version control system.
3000You can add new VC systems by overriding this function. You can
3001optimize this function by overriding it and only doing those checks
3002that will occur on your system."
3003 (or
3004 ;; RCS file name
3005 (file-exists-p (concat path "RCS/" name ",v"))
0e596101 3006 (file-exists-p (concat path "RCS/" name))
6b3eac8d 3007 ;; Local SCCS file name
8583d8b3 3008 (file-exists-p (concat path "SCCS/s." name))
6b3eac8d
DN
3009 ;; Remote SCCS file name
3010 (let ((proj-dir (getenv "PROJECTDIR")))
3011 (if proj-dir
8583d8b3 3012 (file-exists-p (concat proj-dir "/SCCS/s." name))
6b3eac8d
DN
3013 nil))
3014 ;; User extension
3015 (run-hook-with-args 'speedbar-vc-in-control-hook path name)
3016 ))
59588cd4
KH
3017
3018;; Objet File scanning
3019(defun speedbar-check-objects ()
3020 "Scan all files in a directory, and for each see if there is an object.
3021See `speedbar-check-obj-this-line' and `speedbar-obj-alist' for how
3022to add more object types."
3023 ;; Check for to-do to be reset. If reset but no RCS is available
3024 ;; then set to nil (do nothing) otherwise, start at the beginning
3025 (save-excursion
3026 (set-buffer speedbar-buffer)
3027 (if (and speedbar-obj-do-check (eq speedbar-obj-to-do-point t))
3028 (setq speedbar-obj-to-do-point 0))
3029 (if (numberp speedbar-obj-to-do-point)
3030 (progn
3031 (goto-char speedbar-obj-to-do-point)
3032 (while (and (not (input-pending-p))
3033 (re-search-forward "^\\([0-9]+\\):\\s-*\\[[+-]\\] "
3034 nil t))
3035 (setq speedbar-obj-to-do-point (point))
3036 (let ((ind (speedbar-check-obj-this-line (match-string 1))))
3037 (if (not ind) (setq ind " "))
3038 (speedbar-add-indicator ind (concat
3039 (car speedbar-obj-indicator)
3040 "\\|"
3041 (cdr speedbar-obj-indicator)))))
3042 (if (input-pending-p)
3043 ;; return that we are incomplete
3044 nil
3045 ;; we are done, set to-do to nil
3046 (setq speedbar-obj-to-do-point nil)
3047 ;; and return t
3048 t))
3049 t)))
3050
3051(defun speedbar-check-obj-this-line (depth)
3052 "Return t if the file on this line has an associated object.
3053Parameter DEPTH is a string with the current depth of indentation of
3054the file being checked."
3055 (let* ((d (string-to-int depth))
3056 (f (speedbar-line-path d))
3057 (fn (buffer-substring-no-properties
3058 ;; Skip-chars: thanks ptype@dra.hmg.gb
3059 (point) (progn
3060 (skip-chars-forward "^ "
3061 (save-excursion (end-of-line)
3062 (point)))
3063 (point))))
3064 (fulln (concat f fn)))
3065 (if (<= 2 speedbar-verbosity-level)
39273816 3066 (speedbar-message "Speedbar obj check...%s" fulln))
59588cd4
KH
3067 (let ((oa speedbar-obj-alist))
3068 (while (and oa (not (string-match (car (car oa)) fulln)))
3069 (setq oa (cdr oa)))
3070 (if (not (and oa (file-exists-p (concat (file-name-sans-extension fulln)
3071 (cdr (car oa))))))
3072 nil
3073 ;; Find out if the object is out of date or not.
3074 (let ((date1 (nth 5 (file-attributes fulln)))
3075 (date2 (nth 5 (file-attributes (concat
3076 (file-name-sans-extension fulln)
3077 (cdr (car oa)))))))
3078 (if (or (< (car date1) (car date2))
3079 (and (= (car date1) (car date2))
3080 (< (nth 1 date1) (nth 1 date2))))
3081 (car speedbar-obj-indicator)
3082 (cdr speedbar-obj-indicator)))))))
6b3eac8d
DN
3083\f
3084;;; Clicking Activity
3085;;
3086(defun speedbar-quick-mouse (e)
3087 "Since mouse events are strange, this will keep the mouse nicely positioned.
3088This should be bound to mouse event E."
3089 (interactive "e")
3090 (mouse-set-point e)
3091 (speedbar-position-cursor-on-line)
3092 )
3093
3094(defun speedbar-position-cursor-on-line ()
3095 "Position the cursor on a line."
3096 (let ((oldpos (point)))
3097 (beginning-of-line)
3098 (if (looking-at "[0-9]+:\\s-*..?.? ")
3099 (goto-char (1- (match-end 0)))
3100 (goto-char oldpos))))
3101
3102(defun speedbar-power-click (e)
3103 "Activate any speedbar button as a power click.
3104This should be bound to mouse event E."
3105 (interactive "e")
3106 (let ((speedbar-power-click t))
3107 (speedbar-click e)))
3108
3109(defun speedbar-click (e)
3110 "Activate any speedbar buttons where the mouse is clicked.
3111This must be bound to a mouse event. A button is any location of text
3112with a mouse face that has a text property called `speedbar-function'.
3113This should be bound to mouse event E."
3114 (interactive "e")
3115 (mouse-set-point e)
3116 (speedbar-do-function-pointer)
3117 (speedbar-quick-mouse e))
3118
3119(defun speedbar-double-click (e)
3120 "Activate any speedbar buttons where the mouse is clicked.
3121This must be bound to a mouse event. A button is any location of text
3122with a mouse face that has a text property called `speedbar-function'.
3123This should be bound to mouse event E."
3124 (interactive "e")
3125 ;; Emacs only. XEmacs handles this via `mouse-track-click-hook'.
3126 (cond ((eq (car e) 'down-mouse-1)
3127 (mouse-set-point e))
3128 ((eq (car e) 'mouse-1)
3129 (speedbar-quick-mouse e))
3130 ((or (eq (car e) 'double-down-mouse-1)
59588cd4 3131 (eq (car e) 'triple-down-mouse-1))
6b3eac8d
DN
3132 (mouse-set-point e)
3133 (speedbar-do-function-pointer)
3134 (speedbar-quick-mouse e))))
3135
3136(defun speedbar-do-function-pointer ()
3137 "Look under the cursor and examine the text properties.
3138From this extract the file/tag name, token, indentation level and call
3139a function if appropriate"
3140 (let* ((fn (get-text-property (point) 'speedbar-function))
3141 (tok (get-text-property (point) 'speedbar-token))
3142 ;; The 1-,+ is safe because scaning starts AFTER the point
3143 ;; specified. This lets the search include the character the
3144 ;; cursor is on.
3145 (tp (previous-single-property-change
3146 (1+ (point)) 'speedbar-function))
3147 (np (next-single-property-change
3148 (point) 'speedbar-function))
3149 (txt (buffer-substring-no-properties (or tp (point-min))
3150 (or np (point-max))))
3151 (dent (save-excursion (beginning-of-line)
3152 (string-to-number
3153 (if (looking-at "[0-9]+")
3154 (buffer-substring-no-properties
3155 (match-beginning 0) (match-end 0))
3156 "0")))))
39273816 3157 ;;(speedbar-message "%S:%S:%S:%s" fn tok txt dent)
6b3eac8d
DN
3158 (and fn (funcall fn txt tok dent)))
3159 (speedbar-position-cursor-on-line))
3160\f
3161;;; Reading info from the speedbar buffer
3162;;
8afc622b
EL
3163(defun speedbar-line-text (&optional p)
3164 "Retrieve the text after prefix junk for the current line.
3165Optional argument P is where to start the search from."
3166 (save-excursion
3167 (if p (goto-char p))
3168 (beginning-of-line)
3169 (if (looking-at (concat
8e49673d 3170 "\\([0-9]+\\): *[[<{][-+?][]>}] \\([^ \n]+\\)\\("
8afc622b
EL
3171 speedbar-indicator-regex "\\)?"))
3172 (match-string 2)
3173 nil)))
3174
3175(defun speedbar-line-token (&optional p)
3176 "Retrieve the token information after the prefix junk for the current line.
3177Optional argument P is where to start the search from."
3178 (save-excursion
3179 (if p (goto-char p))
3180 (beginning-of-line)
3181 (if (looking-at (concat
8e49673d 3182 "\\([0-9]+\\): *[[<{][-+?][]>}] \\([^ \n]+\\)\\("
8afc622b
EL
3183 speedbar-indicator-regex "\\)?"))
3184 (progn
3185 (goto-char (match-beginning 2))
3186 (get-text-property (point) 'speedbar-token))
39273816 3187 nil)))
8afc622b 3188
6b3eac8d
DN
3189(defun speedbar-line-file (&optional p)
3190 "Retrieve the file or whatever from the line at P point.
3191The return value is a string representing the file. If it is a
3192directory, then it is the directory name."
8afc622b
EL
3193 (save-match-data
3194 (let ((f (speedbar-line-text p)))
3195 (if f
6b3eac8d 3196 (let* ((depth (string-to-int (match-string 1)))
8afc622b 3197 (path (speedbar-line-path depth)))
6b3eac8d
DN
3198 (concat path f))
3199 nil))))
3200
3201(defun speedbar-goto-this-file (file)
3202 "If FILE is displayed, goto this line and return t.
3203Otherwise do not move and return nil."
3204 (let ((path (substring (file-name-directory (expand-file-name file))
3205 (length (expand-file-name default-directory))))
3206 (dest (point)))
3207 (save-match-data
3208 (goto-char (point-min))
3209 ;; scan all the directories
3210 (while (and path (not (eq path t)))
3211 (if (string-match "^/?\\([^/]+\\)" path)
3212 (let ((pp (match-string 1 path)))
3213 (if (save-match-data
3214 (re-search-forward (concat "> " (regexp-quote pp) "$")
3215 nil t))
3216 (setq path (substring path (match-end 1)))
3217 (setq path nil)))
3218 (setq path t)))
3219 ;; find the file part
3220 (if (or (not path) (string= (file-name-nondirectory file) ""))
3221 ;; only had a dir part
3222 (if path
3223 (progn
3224 (speedbar-position-cursor-on-line)
3225 t)
3226 (goto-char dest) nil)
3227 ;; find the file part
3228 (let ((nd (file-name-nondirectory file)))
3229 (if (re-search-forward
3230 (concat "] \\(" (regexp-quote nd)
59588cd4 3231 "\\)\\(" speedbar-indicator-regex "\\)$")
6b3eac8d
DN
3232 nil t)
3233 (progn
3234 (speedbar-position-cursor-on-line)
3235 t)
3236 (goto-char dest)
3237 nil))))))
3238
8583d8b3 3239(defun speedbar-line-path (&optional depth)
6b3eac8d
DN
3240 "Retrieve the pathname associated with the current line.
3241This may require traversing backwards from DEPTH and combining the default
8afc622b
EL
3242directory with these items. This function is replaceable in
3243`speedbar-mode-functions-list' as `speedbar-line-path'"
3244 (let ((rf (speedbar-fetch-replacement-function 'speedbar-line-path)))
3245 (if rf (funcall rf depth) default-directory)))
3246
3247(defun speedbar-files-line-path (&optional depth)
3248 "Retrieve the pathname associated with the current line.
3249This may require traversing backwards from DEPTH and combining the default
6b3eac8d 3250directory with these items."
8afc622b
EL
3251 (save-excursion
3252 (save-match-data
3253 (if (not depth)
3254 (progn
3255 (beginning-of-line)
3256 (looking-at "^\\([0-9]+\\):")
3257 (setq depth (string-to-int (match-string 1)))))
3258 (let ((path nil))
3259 (setq depth (1- depth))
3260 (while (/= depth -1)
3261 (if (not (re-search-backward (format "^%d:" depth) nil t))
3262 (error "Error building path of tag")
3263 (cond ((looking-at "[0-9]+:\\s-*<->\\s-+\\([^\n]+\\)$")
3264 (setq path (concat (buffer-substring-no-properties
3265 (match-beginning 1) (match-end 1))
3266 "/"
3267 path)))
3268 ((looking-at "[0-9]+:\\s-*[-]\\s-+\\([^\n]+\\)$")
3269 ;; This is the start of our path.
3270 (setq path (buffer-substring-no-properties
3271 (match-beginning 1) (match-end 1))))))
3272 (setq depth (1- depth)))
3273 (if (and path
3274 (string-match (concat speedbar-indicator-regex "$")
3275 path))
3276 (setq path (substring path 0 (match-beginning 0))))
3277 (concat default-directory path)))))
6b3eac8d
DN
3278
3279(defun speedbar-path-line (path)
3280 "Position the cursor on the line specified by PATH."
3281 (save-match-data
3282 (if (string-match "/$" path)
3283 (setq path (substring path 0 (match-beginning 0))))
3284 (let ((nomatch t) (depth 0)
3285 (fname (file-name-nondirectory path))
3286 (pname (file-name-directory path)))
3287 (if (not (member pname speedbar-shown-directories))
59588cd4 3288 (error "Internal Error: File %s not shown in speedbar" path))
6b3eac8d
DN
3289 (goto-char (point-min))
3290 (while (and nomatch
3291 (re-search-forward
3292 (concat "[]>] \\(" (regexp-quote fname)
59588cd4 3293 "\\)\\(" speedbar-indicator-regex "\\)?$")
6b3eac8d
DN
3294 nil t))
3295 (beginning-of-line)
3296 (looking-at "\\([0-9]+\\):")
3297 (setq depth (string-to-int (match-string 0))
3298 nomatch (not (string= pname (speedbar-line-path depth))))
3299 (end-of-line))
3300 (beginning-of-line)
3301 (not nomatch))))
3302
3303(defun speedbar-edit-line ()
3304 "Edit whatever tag or file is on the current speedbar line."
3305 (interactive)
3306 (or (save-excursion
3307 (beginning-of-line)
3308 ;; If this fails, then it is a non-standard click, and as such,
3309 ;; perfectly allowed.
fd7bd989 3310 (if (re-search-forward "[]>?}] [^ ]"
6b3eac8d
DN
3311 (save-excursion (end-of-line) (point))
3312 t)
3313 (speedbar-do-function-pointer)
3314 nil))
3315 (speedbar-do-function-pointer)))
3316
3317(defun speedbar-expand-line ()
3318 "Expand the line under the cursor."
3319 (interactive)
3320 (beginning-of-line)
3321 (re-search-forward ":\\s-*.\\+. " (save-excursion (end-of-line) (point)))
3322 (forward-char -2)
3323 (speedbar-do-function-pointer))
3324
3325(defun speedbar-contract-line ()
3326 "Contract the line under the cursor."
3327 (interactive)
3328 (beginning-of-line)
3329 (re-search-forward ":\\s-*.-. " (save-excursion (end-of-line) (point)))
3330 (forward-char -2)
3331 (speedbar-do-function-pointer))
3332
3333(if speedbar-xemacsp
3334 (defalias 'speedbar-mouse-event-p 'button-press-event-p)
3335 (defun speedbar-mouse-event-p (event)
3336 "Return t if the event is a mouse related event"
3337 ;; And Emacs does it this way
3338 (if (and (listp event)
3339 (member (event-basic-type event)
3340 '(mouse-1 mouse-2 mouse-3)))
3341 t
3342 nil)))
3343
3344(defun speedbar-maybee-jump-to-attached-frame ()
3345 "Jump to the attached frame ONLY if this was not a mouse event."
3346 (if (or (not (speedbar-mouse-event-p last-input-event))
3347 speedbar-activity-change-focus-flag)
3348 (progn
3349 (select-frame speedbar-attached-frame)
3350 (other-frame 0))))
3351
3352(defun speedbar-find-file (text token indent)
3353 "Speedbar click handler for filenames.
3354TEXT, the file will be displayed in the attached frame.
3355TOKEN is unused, but required by the click handler. INDENT is the
3356current indentation level."
3357 (let ((cdd (speedbar-line-path indent)))
3358 (speedbar-find-file-in-frame (concat cdd text))
3359 (speedbar-stealthy-updates)
3360 (run-hooks 'speedbar-visiting-file-hook)
3361 ;; Reset the timer with a new timeout when cliking a file
3362 ;; in case the user was navigating directories, we can cancel
3363 ;; that other timer.
3364 (speedbar-set-timer speedbar-update-speed))
3365 (speedbar-maybee-jump-to-attached-frame))
3366
3367(defun speedbar-dir-follow (text token indent)
3368 "Speedbar click handler for directory names.
3369Clicking a directory will cause the speedbar to list files in the
3370the subdirectory TEXT. TOKEN is an unused requirement. The
3371subdirectory chosen will be at INDENT level."
3372 (setq default-directory
3373 (concat (expand-file-name (concat (speedbar-line-path indent) text))
3374 "/"))
3375 ;; Because we leave speedbar as the current buffer,
3376 ;; update contents will change directory without
59588cd4
KH
3377 ;; having to touch the attached frame. Turn off smart expand just
3378 ;; in case.
3379 (let ((speedbar-smart-directory-expand-flag nil))
3380 (speedbar-update-contents))
6b3eac8d
DN
3381 (speedbar-set-timer speedbar-navigating-speed)
3382 (setq speedbar-last-selected-file nil)
3383 (speedbar-stealthy-updates))
3384
3385(defun speedbar-delete-subblock (indent)
3386 "Delete text from point to indentation level INDENT or greater.
3387Handles end-of-sublist smartly."
3388 (speedbar-with-writable
8583d8b3
EL
3389 (save-excursion
3390 (end-of-line) (forward-char 1)
3391 (let ((start (point)))
3392 (while (and (looking-at "^\\([0-9]+\\):")
3393 (> (string-to-int (match-string 1)) indent)
3394 (not (eobp)))
3395 (forward-line 1)
3396 (beginning-of-line))
3397 (delete-region start (point))))))
6b3eac8d
DN
3398
3399(defun speedbar-dired (text token indent)
3400 "Speedbar click handler for directory expand button.
3401Clicking this button expands or contracts a directory. TEXT is the
3402button clicked which has either a + or -. TOKEN is the directory to be
3403expanded. INDENT is the current indentation level."
3404 (cond ((string-match "+" text) ;we have to expand this dir
3405 (setq speedbar-shown-directories
3406 (cons (expand-file-name
3407 (concat (speedbar-line-path indent) token "/"))
3408 speedbar-shown-directories))
3409 (speedbar-change-expand-button-char ?-)
3410 (speedbar-reset-scanners)
3411 (save-excursion
3412 (end-of-line) (forward-char 1)
3413 (speedbar-with-writable
3414 (speedbar-default-directory-list
3415 (concat (speedbar-line-path indent) token "/")
3416 (1+ indent)))))
3417 ((string-match "-" text) ;we have to contract this node
3418 (speedbar-reset-scanners)
3419 (let ((oldl speedbar-shown-directories)
3420 (newl nil)
3421 (td (expand-file-name
3422 (concat (speedbar-line-path indent) token))))
3423 (while oldl
3424 (if (not (string-match (concat "^" (regexp-quote td)) (car oldl)))
3425 (setq newl (cons (car oldl) newl)))
3426 (setq oldl (cdr oldl)))
8afc622b 3427 (setq speedbar-shown-directories (nreverse newl)))
6b3eac8d
DN
3428 (speedbar-change-expand-button-char ?+)
3429 (speedbar-delete-subblock indent)
3430 )
59588cd4 3431 (t (error "Ooops... not sure what to do")))
6b3eac8d
DN
3432 (speedbar-center-buffer-smartly)
3433 (setq speedbar-last-selected-file nil)
3434 (save-excursion (speedbar-stealthy-updates)))
3435
3436(defun speedbar-directory-buttons-follow (text token indent)
3437 "Speedbar click handler for default directory buttons.
3438TEXT is the button clicked on. TOKEN is the directory to follow.
3439INDENT is the current indentation level and is unused."
0e596101
EL
3440 (if (string-match "^[A-z]:$" token)
3441 (setq default-directory (concat token (char-to-string directory-sep-char)))
59588cd4 3442 (setq default-directory token))
6b3eac8d
DN
3443 ;; Because we leave speedbar as the current buffer,
3444 ;; update contents will change directory without
3445 ;; having to touch the attached frame.
3446 (speedbar-update-contents)
3447 (speedbar-set-timer speedbar-navigating-speed))
3448
3449(defun speedbar-tag-file (text token indent)
3450 "The cursor is on a selected line. Expand the tags in the specified file.
3451The parameter TEXT and TOKEN are required, where TEXT is the button
3452clicked, and TOKEN is the file to expand. INDENT is the current
3453indentation level."
3454 (cond ((string-match "+" text) ;we have to expand this file
3455 (let* ((fn (expand-file-name (concat (speedbar-line-path indent)
3456 token)))
3457 (lst (if speedbar-use-imenu-flag
3458 (let ((tim (speedbar-fetch-dynamic-imenu fn)))
3459 (if (eq tim t)
3460 (speedbar-fetch-dynamic-etags fn)
3461 tim))
3462 (speedbar-fetch-dynamic-etags fn))))
3463 ;; if no list, then remove expando button
3464 (if (not lst)
3465 (speedbar-change-expand-button-char ??)
3466 (speedbar-change-expand-button-char ?-)
3467 (speedbar-with-writable
3468 (save-excursion
3469 (end-of-line) (forward-char 1)
3470 (speedbar-insert-generic-list indent
3471 lst 'speedbar-tag-expand
3472 'speedbar-tag-find))))))
3473 ((string-match "-" text) ;we have to contract this node
3474 (speedbar-change-expand-button-char ?+)
3475 (speedbar-delete-subblock indent))
59588cd4 3476 (t (error "Ooops... not sure what to do")))
6b3eac8d
DN
3477 (speedbar-center-buffer-smartly))
3478
3479(defun speedbar-tag-find (text token indent)
3480 "For the tag TEXT in a file TOKEN, goto that position.
3481INDENT is the current indentation level."
3482 (let ((file (speedbar-line-path indent)))
3483 (speedbar-find-file-in-frame file)
3484 (save-excursion (speedbar-stealthy-updates))
3485 ;; Reset the timer with a new timeout when cliking a file
3486 ;; in case the user was navigating directories, we can cancel
3487 ;; that other timer.
3488 (speedbar-set-timer speedbar-update-speed)
3489 (goto-char token)
3490 (run-hooks 'speedbar-visiting-tag-hook)
3491 ;;(recenter)
3492 (speedbar-maybee-jump-to-attached-frame)
3493 ))
3494
3495(defun speedbar-tag-expand (text token indent)
3496 "Expand a tag sublist. Imenu will return sub-lists of specialized tag types.
3497Etags does not support this feature. TEXT will be the button
3498string. TOKEN will be the list, and INDENT is the current indentation
3499level."
3500 (cond ((string-match "+" text) ;we have to expand this file
3501 (speedbar-change-expand-button-char ?-)
3502 (speedbar-with-writable
3503 (save-excursion
3504 (end-of-line) (forward-char 1)
59588cd4 3505 (speedbar-insert-generic-list indent token 'speedbar-tag-expand
6b3eac8d
DN
3506 'speedbar-tag-find))))
3507 ((string-match "-" text) ;we have to contract this node
3508 (speedbar-change-expand-button-char ?+)
3509 (speedbar-delete-subblock indent))
59588cd4 3510 (t (error "Ooops... not sure what to do")))
6b3eac8d
DN
3511 (speedbar-center-buffer-smartly))
3512\f
3513;;; Loading files into the attached frame.
3514;;
3515(defun speedbar-find-file-in-frame (file)
3516 "This will load FILE into the speedbar attached frame.
3517If the file is being displayed in a different frame already, then raise that
3518frame instead."
3519 (let* ((buff (find-file-noselect file))
3520 (bwin (get-buffer-window buff 0)))
3521 (if bwin
3522 (progn
3523 (select-window bwin)
3524 (raise-frame (window-frame bwin)))
3525 (if speedbar-power-click
3526 (let ((pop-up-frames t)) (select-window (display-buffer buff)))
3527 (select-frame speedbar-attached-frame)
3528 (switch-to-buffer buff))))
59588cd4 3529 )
6b3eac8d
DN
3530
3531;;; Centering Utility
3532;;
3533(defun speedbar-center-buffer-smartly ()
3534 "Recenter a speedbar buffer so the current indentation level is all visible.
3535This assumes that the cursor is on a file, or tag of a file which the user is
3536interested in."
3537 (if (<= (count-lines (point-min) (point-max))
0e596101 3538 (1- (window-height (selected-window))))
6b3eac8d
DN
3539 ;; whole buffer fits
3540 (let ((cp (point)))
3541 (goto-char (point-min))
3542 (recenter 0)
3543 (goto-char cp))
3544 ;; too big
3545 (let (depth start end exp p)
3546 (save-excursion
3547 (beginning-of-line)
3548 (setq depth (if (looking-at "[0-9]+")
3549 (string-to-int (buffer-substring-no-properties
3550 (match-beginning 0) (match-end 0)))
3551 0))
3552 (setq exp (format "^%d:\\s-*[[{<]\\([?+-]\\)[]>}]" depth)))
3553 (save-excursion
3554 (end-of-line)
3555 (if (re-search-backward exp nil t)
3556 (setq start (point))
fd7bd989 3557 (setq start (point-min)))
6b3eac8d
DN
3558 (save-excursion ;Not sure about this part.
3559 (end-of-line)
3560 (setq p (point))
3561 (while (and (not (re-search-forward exp nil t))
3562 (>= depth 0))
3563 (setq depth (1- depth))
3564 (setq exp (format "^%d:\\s-*[[{<]\\([?+-]\\)[]>}]" depth)))
3565 (if (/= (point) p)
3566 (setq end (point))
3567 (setq end (point-max)))))
3568 ;; Now work out the details of centering
3569 (let ((nl (count-lines start end))
3570 (cp (point)))
3571 (if (> nl (window-height (selected-window)))
3572 ;; We can't fit it all, so just center on cursor
3573 (progn (goto-char start)
3574 (recenter 1))
3575 ;; we can fit everything on the screen, but...
3576 (if (and (pos-visible-in-window-p start (selected-window))
3577 (pos-visible-in-window-p end (selected-window)))
3578 ;; we are all set!
3579 nil
3580 ;; we need to do something...
3581 (goto-char start)
3582 (let ((newcent (/ (- (window-height (selected-window)) nl) 2))
3583 (lte (count-lines start (point-max))))
3584 (if (and (< (+ newcent lte) (window-height (selected-window)))
3585 (> (- (window-height (selected-window)) lte 1)
3586 newcent))
3587 (setq newcent (- (window-height (selected-window))
3588 lte 1)))
3589 (recenter newcent))))
3590 (goto-char cp)))))
3591
3592\f
3593;;; Tag Management -- Imenu
3594;;
3595(if (not speedbar-use-imenu-flag)
3596
3597 nil
3598
3599(eval-when-compile (if (locate-library "imenu") (require 'imenu)))
3600
3601(defun speedbar-fetch-dynamic-imenu (file)
3602 "Load FILE into a buffer, and generate tags using Imenu.
3603Returns the tag list, or t for an error."
3604 ;; Load this AND compile it in
3605 (require 'imenu)
3606 (save-excursion
3607 (set-buffer (find-file-noselect file))
3608 (if speedbar-power-click (setq imenu--index-alist nil))
3609 (condition-case nil
3610 (let ((index-alist (imenu--make-index-alist t)))
3611 (if speedbar-sort-tags
3612 (sort (copy-alist index-alist)
3613 (lambda (a b) (string< (car a) (car b))))
3614 index-alist))
3615 (error t))))
3616)
3617\f
3618;;; Tag Management -- etags (old XEmacs compatibility part)
3619;;
3620(defvar speedbar-fetch-etags-parse-list
3621 '(;; Note that java has the same parse-group as c
3622 ("\\.\\([cChH]\\|c\\+\\+\\|cpp\\|cc\\|hh\\|java\\)\\'" .
3623 speedbar-parse-c-or-c++tag)
3624 ("^\\.emacs$\\|.\\(el\\|l\\|lsp\\)\\'" .
3625 "def[^i]+\\s-+\\(\\(\\w\\|[-_]\\)+\\)\\s-*\C-?")
59588cd4
KH
3626; ("\\.\\([fF]\\|for\\|FOR\\|77\\|90\\)\\'" .
3627; speedbar-parse-fortran77-tag)
6b3eac8d
DN
3628 ("\\.tex\\'" . speedbar-parse-tex-string)
3629 ("\\.p\\'" .
3630 "\\(\\(FUNCTION\\|function\\|PROCEDURE\\|procedure\\)\\s-+\\([a-zA-Z0-9_.:]+\\)\\)\\s-*(?^?")
3631 )
3632 "Associations of file extensions and expressions for extracting tags.
3633To add a new file type, you would want to add a new association to the
3634list, where the car is the file match, and the cdr is the way to
3635extract an element from the tags output. If the output is complex,
3636use a function symbol instead of regexp. The function should expect
3637to be at the beginning of a line in the etags buffer.
3638
3639This variable is ignored if `speedbar-use-imenu-flag' is non-nil.")
3640
3641(defvar speedbar-fetch-etags-command "etags"
3642 "*Command used to create an etags file.
3643
3644This variable is ignored if `speedbar-use-imenu-flag' is t")
3645
3646(defvar speedbar-fetch-etags-arguments '("-D" "-I" "-o" "-")
3647 "*List of arguments to use with `speedbar-fetch-etags-command'.
3648This creates an etags output buffer. Use `speedbar-toggle-etags' to
3649modify this list conveniently.
3650
3651This variable is ignored if `speedbar-use-imenu-flag' is t")
3652
3653(defun speedbar-toggle-etags (flag)
3654 "Toggle FLAG in `speedbar-fetch-etags-arguments'.
3655FLAG then becomes a member of etags command line arguments. If flag
3656is \"sort\", then toggle the value of `speedbar-sort-tags'. If its
3657value is \"show\" then toggle the value of
3658`speedbar-show-unknown-files'.
3659
3660 This function is a convenience function for XEmacs menu created by
3661Farzin Guilak <farzin@protocol.com>"
3662 (interactive)
3663 (cond
3664 ((equal flag "sort")
3665 (setq speedbar-sort-tags (not speedbar-sort-tags)))
3666 ((equal flag "show")
3667 (setq speedbar-show-unknown-files (not speedbar-show-unknown-files)))
3668 ((or (equal flag "-C")
3669 (equal flag "-S")
3670 (equal flag "-D"))
3671 (if (member flag speedbar-fetch-etags-arguments)
3672 (setq speedbar-fetch-etags-arguments
3673 (delete flag speedbar-fetch-etags-arguments))
3674 (add-to-list 'speedbar-fetch-etags-arguments flag)))
3675 (t nil)))
3676
3677(defun speedbar-fetch-dynamic-etags (file)
3678 "For FILE, run etags and create a list of symbols extracted.
3679Each symbol will be associated with its line position in FILE."
3680 (let ((newlist nil))
3681 (unwind-protect
3682 (save-excursion
3683 (if (get-buffer "*etags tmp*")
3684 (kill-buffer "*etags tmp*")) ;kill to clean it up
39273816
KH
3685 (if (<= 1 speedbar-verbosity-level)
3686 (speedbar-message "Fetching etags..."))
6b3eac8d
DN
3687 (set-buffer (get-buffer-create "*etags tmp*"))
3688 (apply 'call-process speedbar-fetch-etags-command nil
3689 (current-buffer) nil
3690 (append speedbar-fetch-etags-arguments (list file)))
3691 (goto-char (point-min))
39273816
KH
3692 (if (<= 1 speedbar-verbosity-level)
3693 (speedbar-message "Fetching etags..."))
6b3eac8d
DN
3694 (let ((expr
3695 (let ((exprlst speedbar-fetch-etags-parse-list)
3696 (ans nil))
3697 (while (and (not ans) exprlst)
3698 (if (string-match (car (car exprlst)) file)
3699 (setq ans (car exprlst)))
3700 (setq exprlst (cdr exprlst)))
3701 (cdr ans))))
3702 (if expr
3703 (let (tnl)
3704 (while (not (save-excursion (end-of-line) (eobp)))
3705 (save-excursion
3706 (setq tnl (speedbar-extract-one-symbol expr)))
3707 (if tnl (setq newlist (cons tnl newlist)))
3708 (forward-line 1)))
39273816
KH
3709 (speedbar-message
3710 "Sorry, no support for a file of that extension"))))
6b3eac8d
DN
3711 )
3712 (if speedbar-sort-tags
3713 (sort newlist (lambda (a b) (string< (car a) (car b))))
3714 (reverse newlist))))
3715
3716;; This bit donated by Farzin Guilak <farzin@protocol.com> but I'm not
3717;; sure it's needed with the different sorting method.
3718;;
3719;(defun speedbar-clean-etags()
3720; "Removes spaces before the ^? character, and removes `#define',
3721;return types, etc. preceding tags. This ensures that the sort operation
3722;works on the tags, not the return types."
3723; (save-excursion
3724; (goto-char (point-min))
3725; (while
3726; (re-search-forward "(?[ \t](?\C-?" nil t)
3727; (replace-match "\C-?" nil nil))
3728; (goto-char (point-min))
3729; (while
3730; (re-search-forward "\\(.*[ \t]+\\)\\([^ \t\n]+.*\C-?\\)" nil t)
3731; (delete-region (match-beginning 1) (match-end 1)))))
3732
3733(defun speedbar-extract-one-symbol (expr)
59588cd4 3734 "At point, return nil, or one alist in the form: (SYMBOL . POSITION)
6b3eac8d
DN
3735The line should contain output from etags. Parse the output using the
3736regular expression EXPR"
3737 (let* ((sym (if (stringp expr)
3738 (if (save-excursion
3739 (re-search-forward expr (save-excursion
3740 (end-of-line)
3741 (point)) t))
3742 (buffer-substring-no-properties (match-beginning 1)
3743 (match-end 1)))
3744 (funcall expr)))
3745 (pos (let ((j (re-search-forward "[\C-?\C-a]\\([0-9]+\\),\\([0-9]+\\)"
3746 (save-excursion
3747 (end-of-line)
3748 (point))
3749 t)))
3750 (if (and j sym)
3751 (1+ (string-to-int (buffer-substring-no-properties
3752 (match-beginning 2)
3753 (match-end 2))))
3754 0))))
3755 (if (/= pos 0)
3756 (cons sym pos)
3757 nil)))
3758
3759(defun speedbar-parse-c-or-c++tag ()
3760 "Parse a c or c++ tag, which tends to be a little complex."
3761 (save-excursion
3762 (let ((bound (save-excursion (end-of-line) (point))))
3763 (cond ((re-search-forward "\C-?\\([^\C-a]+\\)\C-a" bound t)
3764 (buffer-substring-no-properties (match-beginning 1)
3765 (match-end 1)))
3766 ((re-search-forward "\\<\\([^ \t]+\\)\\s-+new(" bound t)
3767 (buffer-substring-no-properties (match-beginning 1)
3768 (match-end 1)))
3769 ((re-search-forward "\\<\\([^ \t(]+\\)\\s-*(\C-?" bound t)
3770 (buffer-substring-no-properties (match-beginning 1)
3771 (match-end 1)))
3772 (t nil))
3773 )))
3774
3775(defun speedbar-parse-tex-string ()
3776 "Parse a Tex string. Only find data which is relevant."
3777 (save-excursion
3778 (let ((bound (save-excursion (end-of-line) (point))))
3779 (cond ((re-search-forward "\\(\\(sub\\)*section\\|chapter\\|cite\\)\\s-*{[^\C-?}]*}?" bound t)
3780 (buffer-substring-no-properties (match-beginning 0)
3781 (match-end 0)))
3782 (t nil)))))
3783
3784\f
59588cd4
KH
3785;;; BUFFER DISPLAY mode.
3786;;
3787(defvar speedbar-buffers-key-map nil
3788 "Keymap used when in the buffers display mode.")
3789
3790(if speedbar-buffers-key-map
3791 nil
3792 (setq speedbar-buffers-key-map (speedbar-make-specialized-keymap))
3793
3794 ;; Basic tree features
3795 (define-key speedbar-buffers-key-map "e" 'speedbar-edit-line)
3796 (define-key speedbar-buffers-key-map "\C-m" 'speedbar-edit-line)
3797 (define-key speedbar-buffers-key-map "+" 'speedbar-expand-line)
3798 (define-key speedbar-buffers-key-map "-" 'speedbar-contract-line)
3799
3800 ;; Buffer specific keybindings
3801 (define-key speedbar-buffers-key-map "k" 'speedbar-buffer-kill-buffer)
3802 (define-key speedbar-buffers-key-map "r" 'speedbar-buffer-revert-buffer)
3803
3804 )
3805
3806(defvar speedbar-buffer-easymenu-definition
3807 '(["Jump to buffer" speedbar-edit-line t]
3808 ["Expand File Tags" speedbar-expand-line
3809 (save-excursion (beginning-of-line)
3810 (looking-at "[0-9]+: *.\\+. "))]
3811 ["Contract File Tags" speedbar-contract-line
3812 (save-excursion (beginning-of-line)
3813 (looking-at "[0-9]+: *.-. "))]
3814 )
3815 "Menu item elements shown when displaying a buffer list.")
3816
3817(defun speedbar-buffer-buttons (directory zero)
3818 "Create speedbar buttons based on the buffers currently loaded.
3819DIRECTORY is the path to the currently active buffer, and ZERO is 0."
3820 (speedbar-buffer-buttons-engine nil))
3821
3822(defun speedbar-buffer-buttons-temp (directory zero)
3823 "Create speedbar buttons based on the buffers currently loaded.
3824DIRECTORY is the path to the currently active buffer, and ZERO is 0."
3825 (speedbar-buffer-buttons-engine t))
3826
3827(defun speedbar-buffer-buttons-engine (temp)
3828 "Create speedbar buffer buttons.
3829If TEMP is non-nil, then clicking on a buffer restores the previous display."
3830 (insert "Active Buffers:\n")
3831 (let ((bl (buffer-list)))
3832 (while bl
3833 (if (string-match "^[ *]" (buffer-name (car bl)))
3834 nil
3835 (let* ((known (string-match speedbar-file-regexp
3836 (buffer-name (car bl))))
3837 (expchar (if known ?+ ??))
3838 (fn (if known 'speedbar-tag-file nil))
3839 (fname (save-excursion (set-buffer (car bl))
3840 (buffer-file-name))))
3841 (speedbar-make-tag-line 'bracket expchar fn fname
3842 (buffer-name (car bl))
3843 'speedbar-buffer-click temp
3844 'speedbar-file-face 0)))
3845 (setq bl (cdr bl)))
3846 (setq bl (buffer-list))
3847 (insert "Scratch Buffers:\n")
3848 (while bl
3849 (if (not (string-match "^\\*" (buffer-name (car bl))))
3850 nil
3851 (if (eq (car bl) speedbar-buffer)
3852 nil
3853 (speedbar-make-tag-line 'bracket ?? nil nil
3854 (buffer-name (car bl))
3855 'speedbar-buffer-click temp
3856 'speedbar-file-face 0)))
3857 (setq bl (cdr bl)))
3858 (setq bl (buffer-list))
3859 (insert "Hidden Buffers:\n")
3860 (while bl
3861 (if (not (string-match "^ " (buffer-name (car bl))))
3862 nil
3863 (if (eq (car bl) speedbar-buffer)
3864 nil
3865 (speedbar-make-tag-line 'bracket ?? nil nil
3866 (buffer-name (car bl))
3867 'speedbar-buffer-click temp
3868 'speedbar-file-face 0)))
3869 (setq bl (cdr bl)))))
3870
8afc622b
EL
3871(defun speedbar-buffers-item-info ()
3872 "Display information about the current buffer on the current line."
3873 (or (speedbar-item-info-tag-helper)
3874 (let* ((item (speedbar-line-text))
3875 (buffer (if item (get-buffer item) nil)))
3876 (and buffer
39273816
KH
3877 (speedbar-message "%s%s %S %d %s"
3878 (if (buffer-modified-p buffer) "* " "")
3879 item
3880 (save-excursion (set-buffer buffer) major-mode)
3881 (save-excursion (set-buffer buffer)
3882 (buffer-size))
3883 (or (buffer-file-name buffer) "<No file>"))))))
8afc622b
EL
3884
3885(defun speedbar-buffers-line-path (&optional depth)
3886 "Fetch the full path to the file (buffer) specified on the current line.
3887Optional argument DEPTH specifies the current depth of the back search."
3888 (end-of-line)
3889 ;; Buffers are always at level 0
3890 (if (not (re-search-backward "^0:" nil t))
3891 nil
3892 (let* ((bn (speedbar-line-text))
3893 (buffer (if bn (get-buffer bn))))
3894 (if buffer (file-name-directory (buffer-file-name buffer))))))
3895
59588cd4
KH
3896(defun speedbar-buffer-click (text token indent)
3897 "When the users clicks on a buffer-button in speedbar.
3898TEXT is the buffer's name, TOKEN and INDENT are unused."
3899 (if speedbar-power-click
3900 (let ((pop-up-frames t)) (select-window (display-buffer text)))
3901 (select-frame speedbar-attached-frame)
3902 (switch-to-buffer text)
3903 (if token (speedbar-change-initial-expansion-list
3904 speedbar-previously-used-expansion-list-name))))
3905
3906(defun speedbar-buffer-kill-buffer ()
3907 "Kill the buffer the cursor is on in the speedbar buffer."
3908 (interactive)
3909 (or (save-excursion
3910 (beginning-of-line)
3911 ;; If this fails, then it is a non-standard click, and as such,
3912 ;; perfectly allowed.
fd7bd989 3913 (if (re-search-forward "[]>?}] [^ ]"
59588cd4
KH
3914 (save-excursion (end-of-line) (point))
3915 t)
3916 (let ((text (progn
3917 (forward-char -1)
3918 (buffer-substring (point) (save-excursion
3919 (end-of-line)
3920 (point))))))
3921 (if (and (get-buffer text)
39273816 3922 (speedbar-y-or-n-p (format "Kill buffer %s? " text)))
0e596101
EL
3923 (kill-buffer text))
3924 (speedbar-refresh))))))
59588cd4
KH
3925
3926(defun speedbar-buffer-revert-buffer ()
3927 "Revert the buffer the cursor is on in the speedbar buffer."
3928 (interactive)
3929 (save-excursion
3930 (beginning-of-line)
3931 ;; If this fails, then it is a non-standard click, and as such,
3932 ;; perfectly allowed
fd7bd989 3933 (if (re-search-forward "[]>?}] [^ ]"
59588cd4
KH
3934 (save-excursion (end-of-line) (point))
3935 t)
3936 (let ((text (progn
3937 (forward-char -1)
3938 (buffer-substring (point) (save-excursion
3939 (end-of-line)
3940 (point))))))
3941 (if (get-buffer text)
3942 (progn
3943 (set-buffer text)
3944 (revert-buffer t)))))))
3945
3946
3947\f
6b3eac8d
DN
3948;;; Color loading section This is messy *Blech!*
3949;;
3950(defface speedbar-button-face '((((class color) (background light))
3951 (:foreground "green4"))
3952 (((class color) (background dark))
3953 (:foreground "green3")))
3954 "Face used for +/- buttons."
3955 :group 'speedbar-faces)
3956
3957(defface speedbar-file-face '((((class color) (background light))
3958 (:foreground "cyan4"))
3959 (((class color) (background dark))
3960 (:foreground "cyan"))
3961 (t (:bold t)))
3962 "Face used for file names."
3963 :group 'speedbar-faces)
3964
3965(defface speedbar-directory-face '((((class color) (background light))
3966 (:foreground "blue4"))
3967 (((class color) (background dark))
3968 (:foreground "light blue")))
3969 "Faced used for directory names."
3970 :group 'speedbar-faces)
3971(defface speedbar-tag-face '((((class color) (background light))
3972 (:foreground "brown"))
3973 (((class color) (background dark))
3974 (:foreground "yellow")))
3975 "Face used for displaying tags."
3976 :group 'speedbar-faces)
3977
3978(defface speedbar-selected-face '((((class color) (background light))
3979 (:foreground "red" :underline t))
3980 (((class color) (background dark))
3981 (:foreground "red" :underline t))
3982 (t (:underline t)))
3983 "Face used to underline the file in the active window."
3984 :group 'speedbar-faces)
3985
3986(defface speedbar-highlight-face '((((class color) (background light))
3987 (:background "green"))
3988 (((class color) (background dark))
3989 (:background "sea green"))
3990 (((class grayscale monochrome)
3991 (background light))
3992 (:background "black"))
3993 (((class grayscale monochrome)
3994 (background dark))
3995 (:background "white")))
3996 "Face used for highlighting buttons with the mouse."
3997 :group 'speedbar-faces)
3998
3999;; some edebug hooks
4000(add-hook 'edebug-setup-hook
4001 (lambda ()
4002 (def-edebug-spec speedbar-with-writable def-body)))
4003
4004(provide 'speedbar)
4005;;; speedbar ends here
4006
4007;; run load-time hooks
4008(run-hooks 'speedbar-load-hook)