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