comparison lisp/speedbar.el @ 65752:12e5c2513853

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