aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorChong Yidong2005-09-30 13:15:10 +0000
committerChong Yidong2005-09-30 13:15:10 +0000
commit58bd8bf966c418bb9f4f1999209490ae377ad0bc (patch)
treeb382c01e8fe11b4273803a99744251a0205cc573
parenta0292bb5600b9cab73d8bd11637c506adfbd7a9b (diff)
downloademacs-58bd8bf966c418bb9f4f1999209490ae377ad0bc.tar.gz
emacs-58bd8bf966c418bb9f4f1999209490ae377ad0bc.zip
* 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.
-rw-r--r--lisp/ChangeLog9
-rw-r--r--lisp/ezimage.el371
-rw-r--r--lisp/sb-image.el111
-rw-r--r--lisp/speedbar.el2751
4 files changed, 1731 insertions, 1511 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index b9cf544b27b..a7f1581525c 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,12 @@
12005-09-30 Eric M. Ludlam <zappo@gnu.org>
2
3 * speedbar.el: New version 1.0pre3.
4
5 * ezimage.el, sb-image.el: New files.
6
7 * sb-*.xpm: Files removed. New image files installed into
8 etc/images/ezimage.
9
12005-09-30 Kenichi Handa <handa@m17n.org> 102005-09-30 Kenichi Handa <handa@m17n.org>
2 11
3 * ps-mule.el (ps-mule-show-warning): If a character is in 12 * ps-mule.el (ps-mule-show-warning): If a character is in
diff --git a/lisp/ezimage.el b/lisp/ezimage.el
new file mode 100644
index 00000000000..9ec3b7a8b8d
--- /dev/null
+++ b/lisp/ezimage.el
@@ -0,0 +1,371 @@
1;;; ezimage --- Generalized Image management
2
3;;; Copyright (C) 1999, 2000, 2001, 2002, 2003 Free Software Foundation
4
5;; Author: Eric M. Ludlam <zappo@gnu.org>
6;; Keywords: file, tags, tools
7;; X-RCS: $Id: ezimage.el,v 1.4 2003/11/20 04:11:33 zappo Exp $
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation; either version 2, or (at your option)
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs; see the file COPYING. If not, write to the
23;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24;; Boston, MA 02111-1307, USA.
25
26;;; Commentary:
27;;
28;; A few routines for placing an image over text that will work for any
29;; Emacs implementation without error. When images are not supported, then
30;; they are justnot displayed.
31;;
32;; The idea is that gui buffers (trees, buttons, etc) will have text
33;; representations of the GUI elements. These routines will replace the text
34;; with an image when images are available.
35;;
36;; This file requires the `image' package if it is available.
37
38(condition-case nil
39 (require 'image)
40 (error nil))
41
42;;; Code:
43(defcustom ezimage-use-images
44 (and (or (fboundp 'defimage) ; emacs 21
45 (fboundp 'make-image-specifier)) ; xemacs
46 (if (fboundp 'display-graphic-p) ; emacs 21
47 (display-graphic-p)
48 window-system) ; old emacs & xemacs
49 (or (not (fboundp 'image-type-available-p)) ; xemacs?
50 (image-type-available-p 'xpm))) ; emacs 21
51 "*Non-nil if ezimage should display icons."
52 :group 'ezimage
53 :version "21.1"
54 :type 'boolean)
55
56;;; Create our own version of defimage
57(eval-and-compile
58
59(if (fboundp 'defimage)
60
61 (progn
62
63(defmacro defezimage (variable imagespec docstring)
64 "Define VARIABLE as an image if `defimage' is not available.
65IMAGESPEC is the image data, and DOCSTRING is documentation for the image."
66 `(progn
67 (defimage ,variable ,imagespec ,docstring)
68 (put (quote ,variable) 'ezimage t)))
69
70; (defalias 'defezimage 'defimage)
71
72;; This hack is for the ezimage install which has an icons direcory for
73;; the default icons to be used.
74;; (add-to-list 'load-path
75;; (concat (file-name-directory
76;; (locate-library "ezimage.el"))
77;; "icons"))
78
79 )
80 (if (not (fboundp 'make-glyph))
81
82(defmacro defezimage (variable imagespec docstring)
83 "Don't bother loading up an image...
84Argument VARIABLE is the variable to define.
85Argument IMAGESPEC is the list defining the image to create.
86Argument DOCSTRING is the documentation for VARIABLE."
87 `(defvar ,variable nil ,docstring))
88
89;; ELSE
90(with-no-warnings
91(defun ezimage-find-image-on-load-path (image)
92 "Find the image file IMAGE on the load path."
93 (let ((l (cons
94 ;; In XEmacs, try the data directory first (for an
95 ;; install in XEmacs proper.) Search the load
96 ;; path next (for user installs)
97 (locate-data-directory "ezimage")
98 load-path))
99 (r nil))
100 (while (and l (not r))
101 (if (file-exists-p (concat (car l) "/" image))
102 (setq r (concat (car l) "/" image))
103 (if (file-exists-p (concat (car l) "/icons/" image))
104 (setq r (concat (car l) "/icons/" image))
105 ))
106 (setq l (cdr l)))
107 r))
108);with-no-warnings
109
110(with-no-warnings
111(defun ezimage-convert-emacs21-imagespec-to-xemacs (spec)
112 "Convert the Emacs21 image SPEC into an XEmacs image spec.
113The Emacs 21 spec is what I first learned, and is easy to convert."
114 (let* ((sl (car spec))
115 (itype (nth 1 sl))
116 (ifile (nth 3 sl)))
117 (vector itype ':file (ezimage-find-image-on-load-path ifile))))
118);with-no-warnings
119
120(defmacro defezimage (variable imagespec docstring)
121 "Define VARIABLE as an image if `defimage' is not available.
122IMAGESPEC is the image data, and DOCSTRING is documentation for the image."
123 `(progn
124 (defvar ,variable
125 ;; The Emacs21 version of defimage looks just like the XEmacs image
126 ;; specifier, except that it needs a :type keyword. If we line
127 ;; stuff up right, we can use this cheat to support XEmacs specifiers.
128 (condition-case nil
129 (make-glyph
130 (make-image-specifier
131 (ezimage-convert-emacs21-imagespec-to-xemacs (quote ,imagespec)))
132 'buffer)
133 (error nil))
134 ,docstring)
135 (put ',variable 'ezimage t)))
136
137)))
138
139(defezimage ezimage-directory
140 ((:type xpm :file "ezimage/dir.xpm" :ascent center))
141 "Image used for empty directories.")
142
143(defezimage ezimage-directory-plus
144 ((:type xpm :file "ezimage/dir-plus.xpm" :ascent center))
145 "Image used for closed directories with stuff in them.")
146
147(defezimage ezimage-directory-minus
148 ((:type xpm :file "ezimage/dir-minus.xpm" :ascent center))
149 "Image used for open directories with stuff in them.")
150
151(defezimage ezimage-page-plus
152 ((:type xpm :file "ezimage/page-plus.xpm" :ascent center))
153 "Image used for closed files with stuff in them.")
154
155(defezimage ezimage-page-minus
156 ((:type xpm :file "ezimage/page-minus.xpm" :ascent center))
157 "Image used for open files with stuff in them.")
158
159(defezimage ezimage-page
160 ((:type xpm :file "ezimage/page.xpm" :ascent center))
161 "Image used for files with nothing interesting in it.")
162
163(defezimage ezimage-tag
164 ((:type xpm :file "ezimage/tag.xpm" :ascent center))
165 "Image used for tags.")
166
167(defezimage ezimage-tag-plus
168 ((:type xpm :file "ezimage/tag-plus.xpm" :ascent center))
169 "Image used for closed tag groups.")
170
171(defezimage ezimage-tag-minus
172 ((:type xpm :file "ezimage/tag-minus.xpm" :ascent center))
173 "Image used for open tags.")
174
175(defezimage ezimage-tag-gt
176 ((:type xpm :file "ezimage/tag-gt.xpm" :ascent center))
177 "Image used for closed tags (with twist arrow).")
178
179(defezimage ezimage-tag-v
180 ((:type xpm :file "ezimage/tag-v.xpm" :ascent center))
181 "Image used for open tags (with twist arrow).")
182
183(defezimage ezimage-tag-type
184 ((:type xpm :file "ezimage/tag-type.xpm" :ascent center))
185 "Image used for tags that represent a data type.")
186
187(defezimage ezimage-box-plus
188 ((:type xpm :file "ezimage/box-plus.xpm" :ascent center))
189 "Image of a closed box.")
190
191(defezimage ezimage-box-minus
192 ((:type xpm :file "ezimage/box-minus.xpm" :ascent center))
193 "Image of an open box.")
194
195(defezimage ezimage-mail
196 ((:type xpm :file "ezimage/mail.xpm" :ascent center))
197 "Image if an envelope.")
198
199(defezimage ezimage-checkout
200 ((:type xpm :file "ezimage/checkmark.xpm" :ascent center))
201 "Image representing a checkmark. For files checked out of a VC.")
202
203(defezimage ezimage-object
204 ((:type xpm :file "ezimage/bits.xpm" :ascent center))
205 "Image representing bits (an object file.)")
206
207(defezimage ezimage-object-out-of-date
208 ((:type xpm :file "ezimage/bitsbang.xpm" :ascent center))
209 "Image representing bits with a ! in it. (an out of data object file.)")
210
211(defezimage ezimage-label
212 ((:type xpm :file "ezimage/label.xpm" :ascent center))
213 "Image used for label prefix.")
214
215(defezimage ezimage-lock
216 ((:type xpm :file "ezimage/lock.xpm" :ascent center))
217 "Image of a lock. Used for Read Only, or private.")
218
219(defezimage ezimage-unlock
220 ((:type xpm :file "ezimage/unlock.xpm" :ascent center))
221 "Image of an unlocked lock.")
222
223(defezimage ezimage-key
224 ((:type xpm :file "ezimage/key.xpm" :ascent center))
225 "Image of a key.")
226
227(defezimage ezimage-document-tag
228 ((:type xpm :file "ezimage/doc.xpm" :ascent center))
229 "Image used to indicate documentation available.")
230
231(defezimage ezimage-document-plus
232 ((:type xpm :file "ezimage/doc-plus.xpm" :ascent center))
233 "Image used to indicate closed documentation.")
234
235(defezimage ezimage-document-minus
236 ((:type xpm :file "ezimage/doc-minus.xpm" :ascent center))
237 "Image used to indicate open documentation.")
238
239(defezimage ezimage-info-tag
240 ((:type xpm :file "ezimage/info.xpm" :ascent center))
241 "Image used to indicate more information available.")
242
243(defvar ezimage-expand-image-button-alist
244 '(
245 ;; here are some standard representations
246 ("<+>" . ezimage-directory-plus)
247 ("<->" . ezimage-directory-minus)
248 ("< >" . ezimage-directory)
249 ("[+]" . ezimage-page-plus)
250 ("[-]" . ezimage-page-minus)
251 ("[?]" . ezimage-page)
252 ("[ ]" . ezimage-page)
253 ("{+}" . ezimage-box-plus)
254 ("{-}" . ezimage-box-minus)
255 ;; Some vaguely representitive entries
256 ("*" . ezimage-checkout)
257 ("#" . ezimage-object)
258 ("!" . ezimage-object-out-of-date)
259 ("%" . ezimage-lock)
260 )
261 "List of text and image associations.")
262
263(defun ezimage-insert-image-button-maybe (start length &optional string)
264 "Insert an image button based on text starting at START for LENGTH chars.
265If buttontext is unknown, just insert that text.
266If we have an image associated with it, use that image.
267Optional argument STRING is a st ring upon which to add text properties."
268 (when ezimage-use-images
269 (let* ((bt (buffer-substring start (+ length start)))
270 (a (assoc bt ezimage-expand-image-button-alist)))
271 ;; Regular images (created with `insert-image' are intangible
272 ;; which (I suppose) make them more compatible with XEmacs 21.
273 ;; Unfortunatly, there is a giant pile o code dependent on the
274 ;; underlying text. This means if we leave it tangible, then I
275 ;; don't have to change said giant piles o code.
276 (if (and a (symbol-value (cdr a)))
277 (ezimage-insert-over-text (symbol-value (cdr a))
278 start
279 (+ start (length bt))))))
280 string)
281
282(defun ezimage-image-over-string (string &optional alist)
283 "Insert over the text in STRING an image found in ALIST.
284Return STRING with properties applied."
285 (if ezimage-use-images
286 (let ((a (assoc string alist)))
287 (if (and a (symbol-value (cdr a)))
288 (ezimage-insert-over-text (symbol-value (cdr a))
289 0 (length string)
290 string)
291 string))
292 string))
293
294(defun ezimage-insert-over-text (image start end &optional string)
295 "Place IMAGE over the text between START and END.
296Assumes the image is part of a gui and can be clicked on.
297Optional argument STRING is a string upon which to add text properties."
298 (when ezimage-use-images
299 (if (featurep 'xemacs)
300 (add-text-properties start end
301 (list 'end-glyph image
302 'rear-nonsticky (list 'display)
303 'invisible t
304 'detachable t)
305 string)
306 (add-text-properties start end
307 (list 'display image
308 'rear-nonsticky (list 'display))
309 string)))
310 string)
311
312(defun ezimage-image-association-dump ()
313 "Dump out the current state of the Ezimage image alist.
314See `ezimage-expand-image-button-alist' for details."
315 (interactive)
316 (with-output-to-temp-buffer "*Ezimage Images*"
317 (save-excursion
318 (set-buffer "*Ezimage Images*")
319 (goto-char (point-max))
320 (insert "Ezimage image cache.\n\n")
321 (let ((start (point)) (end nil))
322 (insert "Image\tText\tImage Name")
323 (setq end (point))
324 (insert "\n")
325 (put-text-property start end 'face 'underline))
326 (let ((ia ezimage-expand-image-button-alist))
327 (while ia
328 (let ((start (point)))
329 (insert (car (car ia)))
330 (insert "\t")
331 (ezimage-insert-image-button-maybe start
332 (length (car (car ia))))
333 (insert (car (car ia)) "\t" (format "%s" (cdr (car ia))) "\n"))
334 (setq ia (cdr ia)))))))
335
336(defun ezimage-image-dump ()
337 "Dump out the current state of the Ezimage image alist.
338See `ezimage-expand-image-button-alist' for details."
339 (interactive)
340 (with-output-to-temp-buffer "*Ezimage Images*"
341 (save-excursion
342 (set-buffer "*Ezimage Images*")
343 (goto-char (point-max))
344 (insert "Ezimage image cache.\n\n")
345 (let ((start (point)) (end nil))
346 (insert "Image\tImage Name")
347 (setq end (point))
348 (insert "\n")
349 (put-text-property start end 'face 'underline))
350 (let ((ia (ezimage-all-images)))
351 (while ia
352 (let ((start (point)))
353 (insert "cm")
354 (ezimage-insert-over-text (symbol-value (car ia)) start (point))
355 (insert "\t" (format "%s" (car ia)) "\n"))
356 (setq ia (cdr ia)))))))
357
358(defun ezimage-all-images ()
359 "Return a list of all variables containing ez images."
360 (let ((ans nil))
361 (mapatoms (lambda (sym)
362 (if (get sym 'ezimage) (setq ans (cons sym ans))))
363 )
364 (setq ans (sort ans (lambda (a b)
365 (string< (symbol-name a) (symbol-name b)))))
366 ans)
367 )
368
369(provide 'ezimage)
370
371;;; sb-image.el ends here
diff --git a/lisp/sb-image.el b/lisp/sb-image.el
new file mode 100644
index 00000000000..036112e4e2a
--- /dev/null
+++ b/lisp/sb-image.el
@@ -0,0 +1,111 @@
1;;; sb-image --- Image management for speedbar
2
3;;; Copyright (C) 1999, 2000, 2001, 2002, 2003 Free Software Foundation
4
5;; Author: Eric M. Ludlam <zappo@gnu.org>
6;; Keywords: file, tags, tools
7;; X-RCS: $Id: sb-image.el,v 1.10 2003/08/25 17:23:39 zappo Exp $
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation; either version 2, or (at your option)
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs; see the file COPYING. If not, write to the
23;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24;; Boston, MA 02111-1307, USA.
25
26;;; Commentary:
27;;
28;; Supporting Image display for Emacs 20 and less, Emacs 21, and XEmacs,
29;; is a challenging task, which doesn't take kindly to being byte compiled.
30;; When sharing speedbar.elc between these three applications, the Image
31;; support can get lost.
32;;
33;; By splitting out that hard part into this file, and avoiding byte
34;; compilation, one copy speedbar can support all these platforms together.
35;;
36;; This file requires the `image' package if it is available.
37
38(require 'ezimage)
39
40;;; Code:
41(defcustom speedbar-use-images ezimage-use-images
42 "*Non-nil if speedbar should display icons."
43 :group 'speedbar
44 :version "21.1"
45 :type 'boolean)
46
47(defalias 'defimage-speedbar 'defezimage)
48
49(defvar speedbar-expand-image-button-alist
50 '(("<+>" . ezimage-directory-plus)
51 ("<->" . ezimage-directory-minus)
52 ("< >" . ezimage-directory)
53 ("[+]" . ezimage-page-plus)
54 ("[-]" . ezimage-page-minus)
55 ("[?]" . ezimage-page)
56 ("[ ]" . ezimage-page)
57 ("{+}" . ezimage-box-plus)
58 ("{-}" . ezimage-box-minus)
59 ("<M>" . ezimage-mail)
60 ("<d>" . ezimage-document-tag)
61 ("<i>" . ezimage-info-tag)
62 (" =>" . ezimage-tag)
63 (" +>" . ezimage-tag-gt)
64 (" ->" . ezimage-tag-v)
65 (">" . ezimage-tag)
66 ("@" . ezimage-tag-type)
67 (" @" . ezimage-tag-type)
68 ("*" . ezimage-checkout)
69 ("#" . ezimage-object)
70 ("!" . ezimage-object-out-of-date)
71 ("//" . ezimage-label)
72 ("%" . ezimage-lock)
73 )
74 "List of text and image associations.")
75
76(defun speedbar-insert-image-button-maybe (start length)
77 "Insert an image button based on text starting at START for LENGTH chars.
78If buttontext is unknown, just insert that text.
79If we have an image associated with it, use that image."
80 (when speedbar-use-images
81 (let ((ezimage-expand-image-button-alist
82 speedbar-expand-image-button-alist))
83 (ezimage-insert-image-button-maybe start length))))
84
85(defun speedbar-image-dump ()
86 "Dump out the current state of the Speedbar image alist.
87See `speedbar-expand-image-button-alist' for details."
88 (interactive)
89 (with-output-to-temp-buffer "*Speedbar Images*"
90 (save-excursion
91 (set-buffer "*Speedbar Images*")
92 (goto-char (point-max))
93 (insert "Speedbar image cache.\n\n")
94 (let ((start (point)) (end nil))
95 (insert "Image\tText\tImage Name")
96 (setq end (point))
97 (insert "\n")
98 (put-text-property start end 'face 'underline))
99 (let ((ia speedbar-expand-image-button-alist))
100 (while ia
101 (let ((start (point)))
102 (insert (car (car ia)))
103 (insert "\t")
104 (speedbar-insert-image-button-maybe start
105 (length (car (car ia))))
106 (insert (car (car ia)) "\t" (format "%s" (cdr (car ia))) "\n"))
107 (setq ia (cdr ia)))))))
108
109(provide 'sb-image)
110
111;;; sb-image.el ends here
diff --git a/lisp/speedbar.el b/lisp/speedbar.el
index 434025ec07c..a25b7aa19c3 100644
--- a/lisp/speedbar.el
+++ b/lisp/speedbar.el
@@ -1,11 +1,17 @@
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.
13Due to massive API changes (removing the use of the word PATH)
14this 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
@@ -21,175 +27,44 @@
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;;
33;; Starting Speedbar:
34;;
35;; Simply type `M-x speedbar', and it will be autoloaded for you.
36
37;; If you want to choose it from a menu, such as "Tools", you can do this:
38;;
39;; (define-key-after (lookup-key global-map [menu-bar tools])
40;; [speedbar] '("Speedbar" . speedbar-frame-mode) [calendar])
41;;
42;; If you want to access speedbar using only the keyboard, do this:
43;;
44;; (global-set-key [f4] 'speedbar-get-focus)
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;; 38;;
67;; To prevent speedbar from following you into certain directories 39;;; Customizing and Developing for speedbar
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;; 40;;
73;; To add new file types to imenu, see the documentation in the 41;; Please see the speedbar manual for informaion.
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;; 42;;
78;; If the updates are going too slow for you, modify the variable 43;;; Notes:
79;; `speedbar-update-speed' to a longer idle time before updates.
80;; 44;;
81;; If you navigate directories, you will probably notice that you 45;; Users of really old emacsen without the need timer functions
82;; will navigate to a directory which is eventually replaced after 46;; will not have speedbar updating automatically. Use "g" to refresh
83;; you go back to editing a file (unless you pull up a new file.) 47;; the display after changing directories. Remember, do not interrupt
84;; The delay time before this happens is in 48;; the stealthy updates or your display may not be completely
85;; `speedbar-navigating-speed', and defaults to 10 seconds. 49;; refreshed.
86;; 50;;
87;; To enable mouse tracking with information in the minibuffer of 51;; AUC-TEX users: The imenu tags for AUC-TEX mode don't work very
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 63
174;;; Code:
175
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
@@ -197,7 +72,8 @@
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."
@@ -210,6 +86,27 @@
210 :prefix "speedbar-" 86 :prefix "speedbar-"
211 :group 'speedbar) 87 :group 'speedbar)
212 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)))))
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)
@@ -244,7 +141,10 @@ 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.
250This list is of the form: 150This list is of the form:
@@ -260,11 +160,11 @@ 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.
270It is not necessary to define any functions for a specialized mode. 170It is not necessary to define any functions for a specialized mode.
@@ -285,6 +185,20 @@ 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.
190The 'always flag means to always query before file operations.
191The 'none-but-delete flag means to not query before any file
192operations, 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.
290This list is set by modes that wish to have special speedbar displays. 204This list is set by modes that wish to have special speedbar displays.
@@ -297,30 +211,40 @@ speedbar buffer.")
297This keymap is local to each buffer that wants to define special keybindings 211This keymap is local to each buffer that wants to define special keybindings
298effective when its display is shown.") 212effective when its display is shown.")
299 213
214(defcustom speedbar-before-visiting-file-hook '(push-mark)
215 "*Hooks run before speedbar visits a file in the selected frame.
216The default buffer is the buffer in the selected window in the attached frame."
217 :group 'speedbar
218 :type 'hook)
219
300(defcustom speedbar-visiting-file-hook nil 220(defcustom speedbar-visiting-file-hook nil
301 "Hooks run when speedbar visits a file in the selected frame." 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.
227The default buffer is the buffer in the selected window in the attached frame."
302 :group 'speedbar 228 :group 'speedbar
303 :type 'hook) 229 :type 'hook)
304 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
@@ -329,49 +253,41 @@ 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.
339Updates occur to allow speedbar to display directory information
340relevant 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'.")
349Navigation commands included expanding/contracting nodes, and moving 263
350between 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.
361Any parameter supported by a frame may be added. The parameter `height' 277Any parameter supported by a frame may be added. The parameter `height'
362will be initialized to the height of the frame speedbar is 278will be initialized to the height of the frame speedbar is
363attached to and added to this list before the new frame is initialized." 279attached 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.
376Parameters not listed here which will be added automatically are 292Parameters 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
@@ -381,7 +297,7 @@ is attached to."
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.
386XEmacs prior to 20.4 doesn't support imenu, therefore the default is to 302XEmacs prior to 20.4 doesn't support imenu, therefore the default is to
387use etags instead. Etags support is not as robust as imenu support." 303use etags instead. Etags support is not as robust as imenu support."
@@ -401,13 +317,22 @@ error occurred, and the next fetch routine is tried.
401INSERT is a function which takes an INDENTation level, and a LIST of 317INSERT is a function which takes an INDENTation level, and a LIST of
402tags to insert. It will then create the speedbar buttons.") 318tags 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.
323When tooltips are not available, mouse-tracking and minibuffer
324display 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*.
335Use `semantic-tag-hierarchy-method' instead."
411 :group 'speedbar 336 :group 'speedbar
412 :type 'boolean) 337 :type 'boolean)
413 338
@@ -427,10 +352,10 @@ 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
@@ -460,13 +385,6 @@ items is reached."
460 :group 'speedbar 385 :group 'speedbar
461 :type 'integer) 386 :type 'integer)
462 387
463(defcustom speedbar-activity-change-focus-flag nil
464 "*Non-nil means the selected frame will change based on activity.
465Thus, if a file is selected for edit, the buffer will appear in the
466selected frame and the focus will change to that frame."
467 :group 'speedbar
468 :type 'boolean)
469
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.
472Possible values are: 390Possible values are:
@@ -493,26 +411,19 @@ hierarchy would be replaced with the new directory."
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)
514 425
515(defcustom speedbar-before-popup-hook nil 426(defcustom speedbar-after-create-hook '(speedbar-frame-reposition-smartly)
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)
@@ -551,18 +462,18 @@ Any file checked out is marked with `speedbar-vc-indicator'."
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.
553Other version control systems can be added by examining the function 464Other 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.
558Functions in this hook must accept one parameter which is the path 469Functions in this hook must accept one parameter which is the directory
559being checked." 470being 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.
565Functions in this hook must accept two parameters. The PATH of the 476Functions in this hook must accept two parameters. The DIRECTORY of the
566current file, and the FILENAME of the file being checked." 477current file, and the FILENAME of the file being checked."
567 :group 'speedbar-vc 478 :group 'speedbar-vc
568 :type 'hook) 479 :type 'hook)
@@ -573,7 +484,7 @@ current file, and the FILENAME of the file being checked."
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.
575Any file checked out is marked with `speedbar-obj-indicator', and the 486Any file checked out is marked with `speedbar-obj-indicator', and the
576marking is based on `speedbar-obj-alist'." 487marking is based on `speedbar-obj-alist'"
577 :group 'speedbar-vc 488 :group 'speedbar-vc
578 :type 'boolean) 489 :type 'boolean)
579 490
@@ -586,7 +497,7 @@ The car is for an up-to-date object. The cdr is for an out of date object.
586The expression `speedbar-obj-alist' defines who gets tagged.") 497The 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")
@@ -594,6 +505,14 @@ The expression `speedbar-obj-alist' defines who gets tagged.")
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 "\\("
@@ -602,6 +521,8 @@ The expression `speedbar-obj-alist' defines who gets tagged.")
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.
607Permits stripping of indicator characters from a line.") 528Permits stripping of indicator characters from a line.")
@@ -613,7 +534,7 @@ 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)
@@ -635,29 +556,29 @@ with `.' followed by extensions, followed by full-filenames."
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.
640Created from `speedbar-ignored-path-expressions' with the function 561Created 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.)
642Use the function `speedbar-add-ignored-path-regexp', or customize the 563Use the function `speedbar-add-ignored-directory-regexp', or customize the
643variable `speedbar-ignored-path-expressions' to modify this variable.") 564variable `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.
648They should included paths to directories which are notoriously very 569They should included directorys to directories which are notoriously very
649large and take a long time to load in. Use the function 570large 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
651speedbar is loaded. You may place anything you like in this list 572speedbar is loaded. You may place anything you like in this list
652before speedbar has been loaded." 573before 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.
662They should include commonly existing directories which are not 583They should include commonly existing directories which are not
663useful, such as version control." 584useful, such as version control."
@@ -675,8 +596,10 @@ useful, such as version control."
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.
676It is generated from the variable `completion-ignored-extensions'") 597It 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.
601Created from `speedbar-supported-extension-expressions' with the
602function `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.
@@ -688,7 +611,7 @@ It is generated from the variable `completion-ignored-extensions'")
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.
693Do not prefix the `.' char with a double \\ to quote it, as the period 616Do not prefix the `.' char with a double \\ to quote it, as the period
694will be stripped by a simplified optimizer when compiled into a 617will be stripped by a simplified optimizer when compiled into a
@@ -696,28 +619,18 @@ 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
697function `speedbar-add-supported-extension' to add a new extension at 620function `speedbar-add-supported-extension' to add a new extension at
698runtime, or use the configuration dialog to set it in your .emacs 621runtime, or use the configuration dialog to set it in your .emacs
699file." 622file.
623If you add an extension to this list, and it does not appear, you may
624need to also modify `completion-ignored-extension' which will also help
625file 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.
710Created from `speedbar-supported-extension-expression' with the
711function `speedbar-extension-list-to-regex'")
712
713(defcustom speedbar-scan-subdirs nil
714 "*Non-nil means speedbar will check if subdirs are empty.
715That way you don't have to click on them to find out. But this
716incurs extra I/O, hence it slows down directory display
717proportionally 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.
@@ -736,42 +649,41 @@ list of strings."
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.
741This function will modify `speedbar-ignored-path-regexp' and add 654This function will modify `speedbar-ignored-directory-regexp' and add
742PATH-EXPRESSION to `speedbar-ignored-path-expressions'." 655DIRECTORY-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.
770When this is nil then speedbar will not follow the attached 677When this is nil then speedbar will not follow the attached frame's directory.
771frame's path. Type \ 678When speedbar is active, use:
772\\<speedbar-key-map>\\[speedbar-toggle-updates] in the speedbar \ 679
680\\<speedbar-key-map> `\\[speedbar-toggle-updates]'
681
773to toggle this value.") 682to toggle this value.")
774 683
684(defvar speedbar-update-flag-disable nil
685 "Permanently disable changing of the update flag.")
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
@@ -797,10 +709,8 @@ to toggle this value.")
797 (suppress-keymap speedbar-key-map t) 709 (suppress-keymap speedbar-key-map t)
798 710
799 ;; control 711 ;; control
800 (define-key speedbar-key-map "g" 'speedbar-refresh)
801 (define-key speedbar-key-map "t" 'speedbar-toggle-updates) 712 (define-key speedbar-key-map "t" 'speedbar-toggle-updates)
802 (define-key speedbar-key-map "q" 'speedbar-close-frame) 713 (define-key speedbar-key-map "g" 'speedbar-refresh)
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)
@@ -809,8 +719,9 @@ to toggle this value.")
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"
@@ -824,46 +735,8 @@ to toggle this value.")
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.
@@ -887,6 +760,11 @@ This basically creates a sparse keymap, and makes it's parent be
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)
889 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)
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)
@@ -896,6 +774,7 @@ This basically creates a sparse keymap, and makes it's parent be
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
@@ -903,6 +782,7 @@ This basically creates a sparse keymap, and makes it's parent be
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))
@@ -925,6 +805,9 @@ This basically creates a sparse keymap, and makes it's parent be
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]+: *.-. "))]
@@ -944,6 +827,8 @@ This basically creates a sparse keymap, and makes it's parent be
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
@@ -951,13 +836,15 @@ This basically creates a sparse keymap, and makes it's parent be
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
@@ -972,12 +859,6 @@ In this case it is the originating buffer.")
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.
979This is the frame from which all data displayed in the speedbar is
980gathered, 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.")
@@ -997,28 +878,17 @@ directories.")
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;;
@@ -1034,132 +904,97 @@ 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))))) 973Doing 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)) 992If the deleted frame is the frame SPEEDBAR is attached to,
1123 (car (cdr cfx)))))) 993we 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 ()
@@ -1167,59 +1002,23 @@ supported at a time.
1167If the selected frame is not speedbar, then speedbar frame is 1002If the selected frame is not speedbar, then speedbar frame is
1168selected. If the speedbar frame is active, then select the attached frame." 1003selected. 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.
1193This overrides the default behavior of `switch-to-buffer' which is
1194broken 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.
1205nil if it doesn't exist." 1012nil 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>
1219The first line represents the default path of the speedbar frame. 1018The first line represents the default directory of the speedbar frame.
1220Each directory segment is a button which jumps speedbar's default 1019Each directory segment is a button which jumps speedbar's default
1221directory to that path. Buttons are activated by clicking `\\[speedbar-click]'. 1020directory to that directory. Buttons are activated by clicking `\\[speedbar-click]'.
1222In some situations using `\\[speedbar-power-click]' is a `power click' which will 1021In some situations using `\\[dframe-power-click]' is a `power click' which will
1223rescan cached items, or pop up new frames. 1022rescan cached items, or pop up new frames.
1224 1023
1225Each line starting with <+> represents a directory. Click on the <+> 1024Each line starting with <+> represents a directory. Click on the <+>
@@ -1255,7 +1054,6 @@ in the selected file.
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")
@@ -1263,110 +1061,59 @@ in the selected file.
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.
1321Optionally 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.
1330Argument FMT is the format string, and ARGS are the arguments for message." 1079Argument 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)
1333 (apply 'message fmt args)))
1334 1081
1335(defun speedbar-y-or-n-p (prompt) 1082(defsubst speedbar-y-or-n-p (prompt &optional deleting)
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.
1337Argument PROMPT is the prompt to use." 1084Argument PROMPT is the prompt to use.
1338 (save-selected-window 1085Optional argument DELETING means this is a query that will delete something.
1339 (if (and default-minibuffer-frame (not (eq default-minibuffer-frame 1086The variable `speedbar-query-confirmation-method' can cause this to
1340 speedbar-attached-frame))) 1087return 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 ()
1346Optional 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.
1356This gives visual indications of what is up. It EXPECTS the speedbar 1102This gives visual indications of what is up. It EXPECTS the speedbar
1357frame and window to be the currently active frame and window." 1103frame 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 ""))
@@ -1375,7 +1122,7 @@ frame and window to be the currently active frame and window."
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))
@@ -1383,23 +1130,6 @@ frame and window to be the currently active frame and window."
1383 (setq mode-line-format tf) 1130 (setq mode-line-format tf)
1384 (speedbar-mode-line-update))))))) 1131 (speedbar-mode-line-update)))))))
1385 1132
1386(defun speedbar-temp-buffer-show-function (buffer)
1387 "Placed in the variable `temp-buffer-show-function' in `speedbar-mode'.
1388If a user requests help using \\[help-command] <Key> the temp BUFFER will be
1389redirected 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
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
@@ -1413,7 +1143,7 @@ and the existence of packages."
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))
@@ -1432,7 +1162,11 @@ and the existence of packages."
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)))
@@ -1441,7 +1175,7 @@ and the existence of packages."
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))
@@ -1458,129 +1192,51 @@ and the existence of packages."
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.
1477If the mouse is being clicked on the far left, or far right of the
1478mode-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)) 1233Optional 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.
1537Must 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.
1555Must 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.
1566This hack overrides it so that the right thing happens in the main
1567Emacs frame, not in the speedbar frame.
1568Argument 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."
@@ -1602,16 +1258,16 @@ of intermediate nodes are skipped."
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)))
@@ -1632,7 +1288,6 @@ of intermediate nodes are skipped."
1632 (speedbar-restricted-move (or arg 1)) 1288 (speedbar-restricted-move (or arg 1))
1633 (speedbar-item-info)) 1289 (speedbar-item-info))
1634 1290
1635
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.
1638This means that movement is restricted to a subnode, and that siblings 1293This means that movement is restricted to a subnode, and that siblings
@@ -1691,11 +1346,14 @@ Assumes that the current buffer is the speedbar buffer."
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) 1351Argument 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)))
@@ -1704,7 +1362,7 @@ Assumes that the current buffer is the speedbar buffer."
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
@@ -1727,7 +1385,7 @@ Assumes that the current buffer is the speedbar buffer."
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)))
@@ -1779,13 +1437,22 @@ nil if not applicable."
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)
@@ -1793,27 +1460,32 @@ nil if not applicable."
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
@@ -1845,7 +1517,8 @@ Files can be copied to new names or places."
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.
@@ -1874,7 +1547,8 @@ Files can be renamed to new names or moved to new directories."
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.
@@ -1885,12 +1559,27 @@ Files can be renamed to new names or moved to new directories."
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)
@@ -1915,7 +1604,7 @@ variable `speedbar-obj-alist'."
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)))))
@@ -1925,7 +1614,7 @@ variable `speedbar-obj-alist'."
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."
@@ -1942,13 +1631,14 @@ variable `speedbar-obj-alist'."
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.
1635Images 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
@@ -1957,61 +1647,6 @@ variable `speedbar-obj-alist'."
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.
1965TIMEOUT is the number of seconds until the speedbar timer is called
1966again. When TIMEOUT is nil, turn off all timeouts.
1967This function will also enable or disable the `vc-checkin-hook' used
1968to 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."
@@ -2019,14 +1654,6 @@ to track file check ins, and will change the mode line to match
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 1656
2022(defun speedbar-select-window (buffer)
2023 "Select a window in which BUFFER is shown.
2024If 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
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.
@@ -2053,13 +1680,30 @@ specialized speedbar displays."
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.
1685Separators 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.
2058MOUSE is the mouse face. When this button is clicked on FUNCTION 1698MOUSE is the mouse face. When this button is clicked on FUNCTION
2059will be run with the TOKEN parameter (any Lisp object)." 1699will 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.
@@ -2116,8 +1760,10 @@ This is based on `speedbar-initial-expansion-list-name' referencing
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.
@@ -2199,26 +1845,30 @@ 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.
2221Each directory path part is a different button. If part of the path 1871Each directory directory part is a different button. If part of the directory
2222matches the user directory ~, then it is replaced with a ~. 1872matches the user directory ~, then it is replaced with a ~.
2223INDEX is not used, but is required by the caller." 1873INDEX is not used, but is required by the caller."
2224 (let* ((tilde (expand-file-name "~/")) 1874 (let* ((tilde (expand-file-name "~/"))
@@ -2294,8 +1944,9 @@ INDEX is not used, but is required by the caller."
2294This is the button that expands or contracts a node (if applicable), 1944This is the button that expands or contracts a node (if applicable),
2295and EXP-BUTTON-CHAR the character in it (+, -, ?, etc). EXP-BUTTON-FUNCTION 1945and EXP-BUTTON-CHAR the character in it (+, -, ?, etc). EXP-BUTTON-FUNCTION
2296is the function to call if it's clicked on. Button types are 1946is 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.
2298attached to the text forming the expansion button. 1948EXP-BUTTON-DATA is extra data attached to the text forming the expansion
1949button.
2299 1950
2300Next, TAG-BUTTON is the text of the tag. TAG-BUTTON-FUNCTION is the 1951Next, TAG-BUTTON is the text of the tag. TAG-BUTTON-FUNCTION is the
2301function to call if clicked on, and TAG-BUTTON-DATA is the data to 1952function to call if clicked on, and TAG-BUTTON-DATA is the data to
@@ -2317,11 +1968,14 @@ position to insert a new item, and that the new item will end with a CR."
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)
@@ -2340,7 +1994,7 @@ position to insert a new item, and that the new item will end with a CR."
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
@@ -2348,50 +2002,45 @@ position to insert a new item, and that the new item will end with a CR."
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.
2363Tag expandable items with a +, otherwise a ?. Don't highlight ? as we 2018Tag expandable items with a +, otherwise a ?. Don't highlight ? as we
2364don't know how to manage them. The input parameter FILES is a cons 2019don't know how to manage them. The input parameter FILES is a cons
2365cell of the form ( 'DIRLIST . 'FILELIST )." 2020cell 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
@@ -2412,12 +2061,63 @@ cell of the form ( 'DIRLIST . 'FILELIST )."
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.
2075Groups 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)))))
2420 2111
2112(defun speedbar-try-completion (string alist)
2113 "A wrapper for `try-completion'.
2114Passes STRING and ALIST to `try-completion' if ALIST
2115passes 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))
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)
@@ -2430,133 +2130,134 @@ cell of the form ( 'DIRLIST . 'FILELIST )."
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.
@@ -2568,17 +2269,18 @@ Argument LST is the list of tags to trim."
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))
@@ -2589,7 +2291,7 @@ Argument LST is the list of tags to trim."
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.
@@ -2597,7 +2299,7 @@ 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)))
@@ -2612,7 +2314,8 @@ This uses `speedbar-tag-hierarchy-method' to determine how to adjust
2612the list." 2314the 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)
@@ -2625,6 +2328,16 @@ the list."
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.
2333Good values for this are `curly' and `expandtag'.
2334Make 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.
2338Good values for this are nil and `statictag'.
2339Make 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.
2630Associations with lists get {+} tags (to expand into more nodes) and 2343Associations with lists get {+} tags (to expand into more nodes) and
@@ -2634,33 +2347,53 @@ 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
@@ -2674,8 +2407,10 @@ name will have the function FIND-FUN and not token."
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)
@@ -2687,19 +2422,61 @@ name will have the function FIND-FUN and not token."
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
@@ -2725,7 +2502,7 @@ name will have the function FIND-FUN and not token."
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!
@@ -2747,7 +2524,7 @@ name will have the function FIND-FUN and not token."
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)
@@ -2788,24 +2565,40 @@ This should only be used by modes classified as special."
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.
2574Uses `dframe-set-timer'.
2575Also 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))
@@ -2833,30 +2626,15 @@ This should only be used by modes classified as special."
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
@@ -2884,12 +2662,16 @@ interrupted by the user."
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.
2885If new functions are added, their state needs to be updated here." 2663If 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
@@ -2898,7 +2680,7 @@ If new functions are added, their state needs to be updated here."
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)
@@ -2914,7 +2696,7 @@ If new functions are added, their state needs to be updated here."
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)
@@ -2930,7 +2712,7 @@ it should be in the list, then the directory cache needs to be
2930updated." 2712updated."
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)))
@@ -2939,7 +2721,7 @@ updated."
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
@@ -2949,11 +2731,11 @@ updated."
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
@@ -2979,7 +2761,13 @@ updated."
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)
@@ -2997,6 +2785,7 @@ indicator, then do not add a space."
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))
@@ -3011,7 +2800,40 @@ indicator, then do not add a space."
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:
@@ -3026,26 +2848,30 @@ 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))
@@ -3066,8 +2892,8 @@ to add more types of version control systems."
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.
3067Parameter DEPTH is a string with the current depth of indentation of 2893Parameter DEPTH is a string with the current depth of indentation of
3068the file being checked." 2894the 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
@@ -3081,41 +2907,54 @@ the file being checked."
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.
3086This can be overloaded to add new types of version control systems." 2912This 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.
3103You can add new VC systems by overriding this function. You can 2933You can add new VC systems by overriding this function. You can
3104optimize this function by overriding it and only doing those checks 2934optimize this function by overriding it and only doing those checks
3105that will occur on your system." 2935that 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
@@ -3126,7 +2965,7 @@ 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)
@@ -3155,8 +2994,8 @@ to add more object types."
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.
3156Parameter DEPTH is a string with the current depth of indentation of 2995Parameter DEPTH is a string with the current depth of indentation of
3157the file being checked." 2996the 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
@@ -3186,28 +3025,6 @@ the file being checked."
3186 3025
3187;;; Clicking Activity 3026;;; Clicking Activity
3188;; 3027;;
3189(defun speedbar-mouse-set-point (e)
3190 "Set POINT based on event E.
3191Handle 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.
3205This 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)))
@@ -3216,47 +3033,22 @@ This should be bound to mouse event E."
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.
3221A power click will dispose of cached data (if available) or bring a buffer
3222up into a different window.
3223This 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.
3230This must be bound to a mouse event. A button is any location of text 3038This must be bound to a mouse event. A button is any location of text
3231with a mouse face that has a text property called `speedbar-function'. 3039with a mouse face that has a text property called `speedbar-function'.
3232This should be bound to mouse event E." 3040Argument 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.
3240This must be bound to a mouse event. A button is any location of text
3241with a mouse face that has a text property called `speedbar-function'.
3242This 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.
3257From this extract the file/tag name, token, indentation level and call 3048From this extract the file/tag name, token, indentation level and call
3258a function if appropriate." 3049a 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
@@ -3286,9 +3078,8 @@ Optional argument P is where to start the search from."
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)
@@ -3298,7 +3089,7 @@ Optional argument P is where to start the search from."
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))
@@ -3310,37 +3101,39 @@ Optional argument P is where to start the search from."
3310The return value is a string representing the file. If it is a 3101The return value is a string representing the file. If it is a
3311directory, then it is the directory name." 3102directory, 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.
3324Otherwise do not move and return nil." 3117Otherwise 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)
@@ -3357,16 +3150,18 @@ Otherwise do not move and return nil."
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.
3362This may require traversing backwards from DEPTH and combining the default 3155This may require traversing backwards from DEPTH and combining the default
3363directory with these items. This function is replaceable in 3156directory 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.
3370This may require traversing backwards from DEPTH and combining the default 3165This may require traversing backwards from DEPTH and combining the default
3371directory with these items." 3166directory with these items."
3372 (save-excursion 3167 (save-excursion
@@ -3375,38 +3170,36 @@ directory with these items."
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
@@ -3415,8 +3208,8 @@ directory with these items."
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))))
@@ -3442,7 +3235,8 @@ directory with these items."
3442With universal argument ARG, flush cached data." 3235With 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-*.\\+. "
@@ -3450,12 +3244,12 @@ With universal argument ARG, flush cached data."
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)
@@ -3468,39 +3262,63 @@ With universal argument ARG, flush cached data."
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.
3279Optional 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.
3492TEXT, the file will be displayed in the attached frame. 3305TEXT, the file will be displayed in the attached frame.
3493TOKEN is unused, but required by the click handler. INDENT is the 3306TOKEN is unused, but required by the click handler. INDENT is the
3494current indentation level." 3307current 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.
@@ -3508,7 +3326,7 @@ Clicking a directory will cause the speedbar to list files in
3508the subdirectory TEXT. TOKEN is an unused requirement. The 3326the subdirectory TEXT. TOKEN is an unused requirement. The
3509subdirectory chosen will be at INDENT level." 3327subdirectory 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
@@ -3528,7 +3346,7 @@ Handles end-of-sublist smartly."
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))
@@ -3542,7 +3360,7 @@ 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)
@@ -3550,14 +3368,14 @@ expanded. INDENT is the current indentation level."
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)))
@@ -3568,7 +3386,6 @@ expanded. INDENT is the current indentation level."
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)
@@ -3590,7 +3407,7 @@ The parameter TEXT and TOKEN are required, where TEXT is the button
3590clicked, and TOKEN is the file to expand. INDENT is the current 3407clicked, and TOKEN is the file to expand. INDENT is the current
3591indentation level." 3408indentation 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)))
@@ -3611,17 +3428,20 @@ indentation level."
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.
3613INDENT is the current indentation level." 3430INDENT 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)
@@ -3644,6 +3464,14 @@ level."
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.
3469A value of 'attached means to use the attached frame (the frame
3470that speedbar was started from.) A number such as 1 or -1 means to
3471pass 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.
3649If the file is being displayed in a different frame already, then raise that 3477If the file is being displayed in a different frame already, then raise that
@@ -3654,9 +3482,11 @@ frame instead."
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
@@ -3666,61 +3496,69 @@ frame instead."
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.
3667This assumes that the cursor is on a file, or tag of a file which the user is 3497This assumes that the cursor is on a file, or tag of a file which the user is
3668interested in." 3498interested in."
3669 (if (<= (count-lines (point-min) (point-max))
3670 (1- (window-height (selected-window))))
3671 ;; whole buffer fits
3672 (let ((cp (point)))
3673 (goto-char (point-min))
3674 (recenter 0)
3675 (goto-char cp))
3676 ;; too big
3677 (let (depth start end exp p)
3678 (save-excursion
3679 (beginning-of-line)
3680 (setq depth (if (looking-at "[0-9]+")
3681 (string-to-int (buffer-substring-no-properties
3682 (match-beginning 0) (match-end 0)))
3683 0))
3684 (setq exp (format "^%d:\\s-*[[{<]\\([?+-]\\)[]>}]" depth)))
3685 (save-excursion
3686 (end-of-line)
3687 (if (re-search-backward exp nil t)
3688 (setq start (point))
3689 (setq start (point-min)))
3690 (save-excursion ;Not sure about this part.
3691 (end-of-line)
3692 (setq p (point))
3693 (while (and (not (re-search-forward exp nil t))
3694 (>= depth 0))
3695 (setq depth (1- depth))
3696 (setq exp (format "^%d:\\s-*[[{<]\\([?+-]\\)[]>}]" depth)))
3697 (if (/= (point) p)
3698 (setq end (point))
3699 (setq end (point-max)))))
3700 ;; Now work out the details of centering
3701 (let ((nl (count-lines start end))
3702 (cp (point)))
3703 (if (> nl (window-height (selected-window)))
3704 ;; We can't fit it all, so just center on cursor
3705 (progn (goto-char start)
3706 (recenter 1))
3707 ;; we can fit everything on the screen, but...
3708 (if (and (pos-visible-in-window-p start (selected-window))
3709 (pos-visible-in-window-p end (selected-window)))
3710 ;; we are all set!
3711 nil
3712 ;; we need to do something...
3713 (goto-char start)
3714 (let ((newcent (/ (- (window-height (selected-window)) nl) 2))
3715 (lte (count-lines start (point-max))))
3716 (if (and (< (+ newcent lte) (window-height (selected-window)))
3717 (> (- (window-height (selected-window)) lte 1)
3718 newcent))
3719 (setq newcent (- (window-height (selected-window))
3720 lte 1)))
3721 (recenter newcent))))
3722 (goto-char cp)))))
3723 3499
3500 (save-selected-window
3501
3502 (select-window (get-buffer-window speedbar-buffer t))
3503
3504 (set-buffer speedbar-buffer)
3505
3506 (if (<= (count-lines (point-min) (point-max))
3507 (1- (window-height (selected-window))))
3508 ;; whole buffer fits
3509 (let ((cp (point)))
3510
3511 (goto-char (point-min))
3512 (recenter 0)
3513 (goto-char cp))
3514 ;; too big
3515 (let (depth start end exp p)
3516 (save-excursion
3517 (beginning-of-line)
3518 (setq depth (if (looking-at "[0-9]+")
3519 (string-to-number (buffer-substring-no-properties
3520 (match-beginning 0) (match-end 0)))
3521 0))
3522 (setq exp (format "^%d:" depth)))
3523 (save-excursion
3524 (end-of-line)
3525 (if (re-search-backward exp nil t)
3526 (setq start (point))
3527 (setq start (point-min)))
3528 (save-excursion ;Not sure about this part.
3529 (end-of-line)
3530 (setq p (point))
3531 (while (and (not (re-search-forward exp nil t))
3532 (>= depth 0))
3533 (setq depth (1- depth))
3534 (setq exp (format "^%d:" depth)))
3535 (if (/= (point) p)
3536 (setq end (point))
3537 (setq end (point-max)))))
3538 ;; Now work out the details of centering
3539 (let ((nl (count-lines start end))
3540 (wl (1- (window-height (selected-window))))
3541 (cp (point)))
3542 (if (> nl wl)
3543 ;; We can't fit it all, so just center on cursor
3544 (progn (goto-char start)
3545 (recenter 1))
3546 ;; we can fit everything on the screen, but...
3547 (if (and (pos-visible-in-window-p start (selected-window))
3548 (pos-visible-in-window-p end (selected-window)))
3549 ;; we are all set!
3550 nil
3551 ;; we need to do something...
3552 (goto-char start)
3553 (let ((newcent (/ (- (window-height (selected-window)) nl) 2))
3554 (lte (count-lines start (point-max))))
3555 (if (and (< (+ newcent lte) (window-height (selected-window)))
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;;
@@ -3730,7 +3568,12 @@ This uses the entries in `speedbar-dynamic-tags-function-list'
3730to find the proper tags. It is up to each of those individual 3568to find the proper tags. It is up to each of those individual
3731functions to do caching and flushing if appropriate." 3569functions 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)
@@ -3738,7 +3581,7 @@ functions to do caching and flushing if appropriate."
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))))
@@ -3755,14 +3598,15 @@ functions to do caching and flushing if appropriate."
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.
3762Returns the tag list, or t for an error." 3605Returns 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
@@ -3776,7 +3620,7 @@ Returns the tag list, or t for an error."
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-?")
@@ -3906,7 +3750,7 @@ regular expression EXPR."
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))))
@@ -3955,6 +3799,7 @@ regular expression EXPR."
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)
@@ -3975,28 +3820,29 @@ regular expression EXPR."
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.
3987DIRECTORY is the path to the currently active buffer, and ZERO is 0." 3832DIRECTORY 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.
3992DIRECTORY is the path to the currently active buffer, and ZERO is 0." 3837DIRECTORY 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.
3997If TEMP is non-nil, then clicking on a buffer restores the previous display." 3842If 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
@@ -4010,10 +3856,11 @@ If TEMP is non-nil, then clicking on a buffer restores the previous display."
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
@@ -4022,20 +3869,33 @@ If TEMP is non-nil, then clicking on a buffer restores the previous display."
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.
3892Argument 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."
@@ -4051,8 +3911,8 @@ If TEMP is non-nil, then clicking on a buffer restores the previous display."
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.
4056Optional argument DEPTH specifies the current depth of the back search." 3916Optional argument DEPTH specifies the current depth of the back search."
4057 (save-excursion 3917 (save-excursion
4058 (end-of-line) 3918 (end-of-line)
@@ -4066,15 +3926,17 @@ Optional argument DEPTH specifies the current depth of the back search."
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.
4074TEXT is the buffer's name, TOKEN and INDENT are unused." 3936TEXT 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))))
@@ -4083,21 +3945,11 @@ TEXT is the buffer's name, TOKEN and INDENT are unused."
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."
@@ -4168,7 +4020,7 @@ TEXT is the buffer's name, TOKEN and INDENT are unused."
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
@@ -4197,173 +4049,50 @@ TEXT is the buffer's name, TOKEN and INDENT are unused."
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)
4223Argument VARIABLE is the variable to define. 4075 (background dark))
4224Argument IMAGESPEC is the list defining the image to create. 4076 (:background "white"
4225Argument 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.
4248IMAGESPEC 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.
4334If buttontext is unknown, just insert that text.
4335If 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