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