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