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