/[emacs]/emacs/lisp/speedbar.el
ViewVC logotype

Diff of /emacs/lisp/speedbar.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.67 by lektu, Wed Aug 31 13:52:07 2005 UTC revision 1.68 by cyd, Fri Sep 30 13:15:10 2005 UTC
# Line 1  Line 1 
1  ;;; speedbar.el --- quick access to files and tags in a frame  ;;; speedbar --- quick access to files and tags in a frame
2    
3  ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,  ;;; Copyright (C) 1996, 97, 98, 99, 00, 01, 02, 03, 04, 05 Free Software Foundation
 ;;   2004, 2005 Free Software Foundation, Inc.  
4    
5  ;; Author: Eric M. Ludlam <zappo@gnu.org>  ;; Author: Eric M. Ludlam <zappo@gnu.org>
 ;; Version: 0.11a  
6  ;; Keywords: file, tags, tools  ;; Keywords: file, tags, tools
7    ;; X-RCS: $Id$
8    
9    (defvar speedbar-version "1.0pre3"
10      "The current version of speedbar.")
11    (defvar speedbar-incompatible-version "0.14beta4"
12      "This version of speedbar is incompatible with this version.
13    Due to massive API changes (removing the use of the word PATH)
14    this version is not backward compatible to 0.14 or earlier.")
15    
16  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
17    
# Line 21  Line 27 
27    
28  ;; You should have received a copy of the GNU General Public License  ;; You should have received a copy of the GNU General Public License
29  ;; along with GNU Emacs; see the file COPYING.  If not, write to the  ;; along with GNU Emacs; see the file COPYING.  If not, write to the
30  ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,  ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
31  ;; Boston, MA 02110-1301, USA.  ;; Boston, MA 02111-1307, USA.
32    
33  ;;; Commentary:  ;;; Commentary:
34  ;;  ;;
35  ;;   The speedbar provides a frame in which files, and locations in  ;;   The speedbar provides a frame in which files, and locations in
36  ;; files are displayed.  These items can be clicked on with mouse-2  ;; files are displayed.  These items can be clicked on with mouse-2 in
37  ;; in order to make the last active frame display that file location.  ;; to display that file location.
 ;;  
 ;; Starting Speedbar:  
 ;;  
 ;;   Simply type `M-x speedbar', and it will be autoloaded for you.  
   
 ;;   If you want to choose it from a menu, such as "Tools", you can do this:  
 ;;  
 ;;   (define-key-after (lookup-key global-map [menu-bar tools])  
 ;;      [speedbar] '("Speedbar" . speedbar-frame-mode) [calendar])  
 ;;  
 ;;   If you want to access speedbar using only the keyboard, do this:  
 ;;  
 ;;   (global-set-key [f4] 'speedbar-get-focus)  
 ;;  
 ;;   This will let you hit f4 (or whatever key you choose) to jump  
 ;; focus to the speedbar frame.  Pressing it again will bring you back  
 ;; to the attached frame.  Pressing RET or e to jump to a file  
 ;; or tag will move you back to the attached frame.  The command  
 ;; `speedbar-get-focus' will also create a speedbar frame if it does  
 ;; not exist.  
 ;;  
 ;; Customizing Speedbar:  
 ;;  
 ;;   Once a speedbar frame is active, it takes advantage of idle time  
 ;; to keep its contents updated.  The contents is usually a list of  
 ;; files in the directory of the currently active buffer.  When  
 ;; applicable, tags in the active file can be expanded.  
 ;;  
 ;;   To add new supported files types into speedbar, use the function  
 ;; `speedbar-add-supported-extension'.  If speedbar complains that the  
 ;; file type is not supported, that means there is no built in  
 ;; support from imenu, and the etags part wasn't set up correctly.  You  
 ;; may add elements to `speedbar-supported-extension-expressions' as long  
 ;; as it is done before speedbar is loaded.  
38  ;;  ;;
39  ;;   To prevent speedbar from following you into certain directories  ;;; Customizing and Developing for speedbar
 ;; use the function `speedbar-add-ignored-path-regexp' to add a new  
 ;; regular expression matching a type of path.  You may add list  
 ;; elements to `speedbar-ignored-path-expressions' as long as it is  
 ;; done before speedbar is loaded.  
40  ;;  ;;
41  ;;   To add new file types to imenu, see the documentation in the  ;; Please see the speedbar manual for informaion.
 ;; file imenu.el that comes with Emacs.  To add new file types which  
 ;; etags supports, you need to modify the variable  
 ;; `speedbar-fetch-etags-parse-list'.  
42  ;;  ;;
43  ;;    If the updates are going too slow for you, modify the variable  ;;; Notes:
 ;; `speedbar-update-speed' to a longer idle time before updates.  
44  ;;  ;;
45  ;;    If you navigate directories, you will probably notice that you  ;;    Users of really old emacsen without the need timer functions
46  ;; will navigate to a directory which is eventually replaced after  ;; will not have speedbar updating automatically.  Use "g" to refresh
47  ;; you go back to editing a file (unless you pull up a new file.)  ;; the display after changing directories.  Remember, do not interrupt
48  ;; The delay time before this happens is in  ;; the stealthy updates or your display may not be completely
49  ;; `speedbar-navigating-speed', and defaults to 10 seconds.  ;; refreshed.
50  ;;  ;;
51  ;;    To enable mouse tracking with information in the minibuffer of  ;;    AUC-TEX users: The imenu tags for AUC-TEX mode don't work very
 ;; the attached frame, use the variable `speedbar-track-mouse-flag'.  
 ;;  
 ;;    Tag layout can be modified through `speedbar-tag-hierarchy-method',  
 ;; which controls how tags are layed out.  It is actually a list of  
 ;; functions that filter the data.  The default groups large tag lists  
 ;; into sub-lists.  A long flat list can be used instead if needed.  
 ;; Other filters can be easily added.  
 ;;  
 ;;    AUCTEX users: The imenu tags for AUCTEX mode doesn't work very  
52  ;; well.  Use the imenu keywords from tex-mode.el for better results.  ;; well.  Use the imenu keywords from tex-mode.el for better results.
53  ;;  ;;
54  ;; This file requires the library package assoc (association lists)  ;; 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.
59  ;;  ;;
 ;;; Developing for speedbar  
 ;;  
 ;; Adding a speedbar specialized display mode:  
 ;;  
 ;; Speedbar can be configured to create a special display for certain  
 ;; modes that do not display traditional file/tag data.  Rmail, Info,  
 ;; and the debugger are examples.  These modes can, however, benefit  
 ;; from a speedbar style display in their own way.  
 ;;  
 ;; If your `major-mode' is `foo-mode', the only requirement is to  
 ;; create a function called `foo-speedbar-buttons' which takes one  
 ;; argument, BUFFER.  BUFFER will be the buffer speedbar wants filled.  
 ;; In `foo-speedbar-buttons' there are several functions that make  
 ;; building a speedbar display easy.  See the documentation for  
 ;; `speedbar-with-writable' (needed because the buffer is usually  
 ;; read-only) `speedbar-make-tag-line', `speedbar-insert-button', and  
 ;; `speedbar-insert-generic-list'.  If you use  
 ;; `speedbar-insert-generic-list', also read the doc for  
 ;; `speedbar-tag-hierarchy-method' in case you wish to override it.  
 ;; The macro `speedbar-with-attached-buffer' brings you back to the  
 ;; buffer speedbar is displaying for.  
 ;;  
 ;; For those functions that make buttons, the "function" should be a  
 ;; symbol that is the function to call when clicked on.  The "token"  
 ;; is extra data you can pass along.  The "function" must take three  
 ;; parameters.  They are (TEXT TOKEN INDENT).  TEXT is the text of the  
 ;; button clicked on.  TOKEN is the data passed in when you create the  
 ;; button.  INDENT is an indentation level, or 0.  You can store  
 ;; indentation levels with `speedbar-make-tag-line' which creates a  
 ;; line with an expander (eg.  [+]) and a text button.  
 ;;  
 ;; Some useful functions when writing expand functions, and click  
 ;; functions are `speedbar-change-expand-button-char',  
 ;; `speedbar-delete-subblock', and `speedbar-center-buffer-smartly'.  
 ;; The variable `speedbar-power-click' is set to t in your functions  
 ;; when the user shift-clicks.  This is an indication of anything from  
 ;; refreshing cached data to making a buffer appear in a new frame.  
 ;;  
 ;; If you wish to add to the default speedbar menu for the case of  
 ;; `foo-mode', create a variable `foo-speedbar-menu-items'.  This  
 ;; should be a list compatible with the `easymenu' package.  It will  
 ;; be spliced into the main menu.  (Available with click-mouse-3).  If  
 ;; you wish to have extra key bindings in your special mode, create a  
 ;; variable `foo-speedbar-key-map'.  Instead of using `make-keymap',  
 ;; or `make-sparse-keymap', use the function  
 ;; `speedbar-make-specialized-keymap'.  This lets you inherit all of  
 ;; speedbar's default bindings with low overhead.  
 ;;  
 ;; Adding a speedbar top-level display mode:  
 ;;  
 ;; Unlike the specialized modes, there are no name requirements,  
 ;; however the methods for writing a button display, menu, and keymap  
 ;; are the same.  Once you create these items, you can call the  
 ;; function `speedbar-add-expansion-list'.  It takes one parameter  
 ;; which is a list element of the form (NAME MENU KEYMAP &rest  
 ;; BUTTON-FUNCTIONS).  NAME is a string that will show up in the  
 ;; Displays menu item.  MENU is a symbol containing the menu items to  
 ;; splice in.  KEYMAP is a symbol holding the keymap to use, and  
 ;; BUTTON-FUNCTIONS are the function names to call, in order, to create  
 ;; the display.  
 ;;  Another tweakable variable is `speedbar-stealthy-function-list'  
 ;; which is of the form (NAME &rest FUNCTION ...).  NAME is the string  
 ;; name matching `speedbar-add-expansion-list'.  (It does not need to  
 ;; exist.). This provides additional display info which might be  
 ;; time-consuming to calculate.  
 ;;  Lastly, `speedbar-mode-functions-list' allows you to set special  
 ;; function overrides.  At the moment very few functions may be  
 ;; overridden, but more will be added as the need is discovered.  
60    
61  ;;; TODO:  ;;; TODO:
 ;; - More functions to create buttons and options  
62  ;; - Timeout directories we haven't visited in a while.  ;; - Timeout directories we haven't visited in a while.
63    
 ;;; Code:  
   
64  (require 'assoc)  (require 'assoc)
65  (require 'easymenu)  (require 'easymenu)
66    (require 'dframe)
67  (condition-case nil  (require 'sb-image)
     (require 'image)  
   (error nil))  
   
 (defvar ange-ftp-path-format)  
 (defvar efs-path-regexp)  
 (defvar font-lock-keywords)  
 (defvar x-pointer-hand2)  
 (defvar x-pointer-top-left-arrow)  
   
 (defvar speedbar-xemacsp (string-match "XEmacs" emacs-version)  
   "Non-nil if we are running in the XEmacs environment.")  
 (defvar speedbar-xemacs20p (and speedbar-xemacsp  
                                 (>= emacs-major-version 20)))  
68    
69  ;; customization stuff  ;; customization stuff
70  (defgroup speedbar nil  (defgroup speedbar nil
# Line 197  Line 72 
72    :group 'etags    :group 'etags
73    :group 'tools    :group 'tools
74    :group 'convenience    :group 'convenience
75    :version "20.3")  ;  :version "20.3"
76      )
77    
78  (defgroup speedbar-faces nil  (defgroup speedbar-faces nil
79    "Faces used in speedbar."    "Faces used in speedbar."
# Line 210  Line 86 
86    :prefix "speedbar-"    :prefix "speedbar-"
87    :group 'speedbar)    :group 'speedbar)
88    
89    ;;; Code:
90    
91    ;; Note: `inversion-test' requires parts of the CEDET package that are
92    ;; not included with Emacs.
93    ;;
94    ;; (defun speedbar-require-version (major minor &optional beta)
95    ;;   "Non-nil if this version of SPEEDBAR does not satisfy a specific version.
96    ;; Arguments can be:
97    ;;
98    ;;   (MAJOR MINOR &optional BETA)
99    ;;
100    ;;   Values MAJOR and MINOR must be integers.  BETA can be an integer, or
101    ;; excluded if a released version is required.
102    ;;
103    ;; It is assumed that if the current version is newer than that specified,
104    ;; everything passes.  Exceptions occur when known incompatibilities are
105    ;; introduced."
106    ;;   (inversion-test 'speedbar
107    ;;                (concat major "." minor
108    ;;                        (when beta (concat "beta" beta)))))
109    
110  (defvar speedbar-initial-expansion-mode-alist  (defvar speedbar-initial-expansion-mode-alist
111    '(("buffers" speedbar-buffer-easymenu-definition speedbar-buffers-key-map    '(("buffers" speedbar-buffer-easymenu-definition speedbar-buffers-key-map
112       speedbar-buffer-buttons)       speedbar-buffer-buttons)
# Line 244  the user is done with the current expans Line 141  the user is done with the current expans
141    
142  (defvar speedbar-stealthy-function-list  (defvar speedbar-stealthy-function-list
143    '(("files"    '(("files"
144       speedbar-update-current-file speedbar-check-vc speedbar-check-objects)       speedbar-update-current-file
145         speedbar-check-read-only
146         speedbar-check-vc
147         speedbar-check-objects)
148      )      )
149    "List of functions to periodically call stealthily.    "List of functions to periodically call stealthily.
150  This list is of the form:  This list is of the form:
# Line 260  interruption.  See `speedbar-check-vc' a Line 160  interruption.  See `speedbar-check-vc' a
160    
161  (defvar speedbar-mode-functions-list  (defvar speedbar-mode-functions-list
162    '(("files" (speedbar-item-info . speedbar-files-item-info)    '(("files" (speedbar-item-info . speedbar-files-item-info)
163       (speedbar-line-path . speedbar-files-line-path))       (speedbar-line-directory . speedbar-files-line-directory))
164      ("buffers" (speedbar-item-info . speedbar-buffers-item-info)      ("buffers" (speedbar-item-info . speedbar-buffers-item-info)
165       (speedbar-line-path . speedbar-buffers-line-path))       (speedbar-line-directory . speedbar-buffers-line-directory))
166      ("quick buffers" (speedbar-item-info . speedbar-buffers-item-info)      ("quick buffers" (speedbar-item-info . speedbar-buffers-item-info)
167       (speedbar-line-path . speedbar-buffers-line-path))       (speedbar-line-directory . speedbar-buffers-line-directory))
168      )      )
169    "List of function tables to use for different major display modes.    "List of function tables to use for different major display modes.
170  It is not necessary to define any functions for a specialized mode.  It is not necessary to define any functions for a specialized mode.
# Line 285  frame." Line 185  frame."
185    :group 'speedbar    :group 'speedbar
186    :type 'boolean)    :type 'boolean)
187    
188    (defcustom speedbar-query-confirmation-method 'all
189      "*Query control for file operations.
190    The 'always flag means to always query before file operations.
191    The 'none-but-delete flag means to not query before any file
192    operations, except before a file deletion."
193      :group 'speedbar
194      :type '(radio (const :tag "Always Query before some file operations."
195                           all)
196                    (const :tag "Never Query before file operations, except for deletions."
197                           none-but-delete)
198    ;;;;            (const :tag "Never Every Query."
199    ;;;;                   none)
200                    ))
201    
202  (defvar speedbar-special-mode-expansion-list nil  (defvar speedbar-special-mode-expansion-list nil
203    "Default function list for creating specialized button lists.    "Default function list for creating specialized button lists.
204  This list is set by modes that wish to have special speedbar displays.  This list is set by modes that wish to have special speedbar displays.
# Line 297  speedbar buffer.") Line 211  speedbar buffer.")
211  This keymap is local to each buffer that wants to define special keybindings  This keymap is local to each buffer that wants to define special keybindings
212  effective when its display is shown.")  effective when its display is shown.")
213    
214    (defcustom speedbar-before-visiting-file-hook '(push-mark)
215      "*Hooks run before speedbar visits a file in the selected frame.
216    The default buffer is the buffer in the selected window in the attached frame."
217      :group 'speedbar
218      :type 'hook)
219    
220  (defcustom speedbar-visiting-file-hook nil  (defcustom speedbar-visiting-file-hook nil
221    "Hooks run when speedbar visits a file in the selected frame."    "*Hooks run when speedbar visits a file in the selected frame."
222      :group 'speedbar
223      :type 'hook)
224    
225    (defcustom speedbar-before-visiting-tag-hook '(push-mark)
226      "*Hooks run before speedbar visits a tag in the selected frame.
227    The default buffer is the buffer in the selected window in the attached frame."
228    :group 'speedbar    :group 'speedbar
229    :type 'hook)    :type 'hook)
230    
231  (defcustom speedbar-visiting-tag-hook '(speedbar-highlight-one-tag-line)  (defcustom speedbar-visiting-tag-hook '(speedbar-highlight-one-tag-line)
232    "Hooks run when speedbar visits a tag in the selected frame."    "*Hooks run when speedbar visits a tag in the selected frame."
233    :group 'speedbar    :group 'speedbar
234    :type 'hook    :type 'hook
   :version "21.1"  
235    :options '(speedbar-highlight-one-tag-line    :options '(speedbar-highlight-one-tag-line
236               speedbar-recenter-to-top               speedbar-recenter-to-top
237               speedbar-recenter               speedbar-recenter
238               ))               ))
239    
240  (defcustom speedbar-load-hook nil  (defcustom speedbar-load-hook nil
241    "Hooks run when speedbar is loaded."    "*Hooks run when speedbar is loaded."
242    :group 'speedbar    :group 'speedbar
243    :type 'hook)    :type 'hook)
244    
245  (defcustom speedbar-reconfigure-keymaps-hook nil  (defcustom speedbar-reconfigure-keymaps-hook nil
246    "Hooks run when the keymaps are regenerated."    "*Hooks run when the keymaps are regenerated."
247    :group 'speedbar    :group 'speedbar
   :version "21.1"  
248    :type 'hook)    :type 'hook)
249    
250  (defcustom speedbar-show-unknown-files nil  (defcustom speedbar-show-unknown-files nil
# Line 329  nil means don't show the file in the lis Line 253  nil means don't show the file in the lis
253    :group 'speedbar    :group 'speedbar
254    :type 'boolean)    :type 'boolean)
255    
256  (defcustom speedbar-update-speed  ;;; EVENTUALLY REMOVE THESE
   (if speedbar-xemacsp  
       (if speedbar-xemacs20p  
           2                             ; 1 is too obrusive in XEmacs  
         5)                              ; when no idleness, need long delay  
     1)  
   "*Idle time in seconds needed before speedbar will update itself.  
 Updates occur to allow speedbar to display directory information  
 relevant to the buffer you are currently editing."  
   :group 'speedbar  
   :type 'integer)  
257    
258  ;; When I moved to a repeating timer, I had the horrible missfortune  ;; When I moved to a repeating timer, I had the horrible missfortune
259  ;; of loosing the ability for adaptive speed choice.  This update  ;; of loosing the ability for adaptive speed choice.  This update
260  ;; speed currently causes long delays when it should have been turned off.  ;; speed currently causes long delays when it should have been turned off.
261  (defcustom speedbar-navigating-speed speedbar-update-speed  (defvar speedbar-update-speed dframe-update-speed
262    "*Idle time to wait after navigation commands in speedbar are executed.    "*Obsoleted variable.  Use `dframe-update-speed'.")
263  Navigation commands included expanding/contracting nodes, and moving  
264  between different directories."  (defvar speedbar-navigating-speed dframe-update-speed
265    :group 'speedbar    "*Obsoleted variable.  Use `dframe-update-speed'.")
266    :type 'integer)  ;;; END REMOVE THESE
267    
268  (defcustom speedbar-frame-parameters '((minibuffer . nil)  (defcustom speedbar-frame-parameters '((minibuffer . nil)
269                                         (width . 20)                                         (width . 20)
270                                         (border-width . 0)                                         (border-width . 0)
271                                         (menu-bar-lines . 0)                                         (menu-bar-lines . 0)
272                                         (tool-bar-lines . 0)                                         (tool-bar-lines . 0)
273                                         (unsplittable . t))                                         (unsplittable . t)
274                                           (left-fringe . 0)
275                                           )
276    "*Parameters to use when creating the speedbar frame in Emacs.    "*Parameters to use when creating the speedbar frame in Emacs.
277  Any parameter supported by a frame may be added.  The parameter `height'  Any parameter supported by a frame may be added.  The parameter `height'
278  will be initialized to the height of the frame speedbar is  will be initialized to the height of the frame speedbar is
279  attached to and added to this list before the new frame is initialized."  attached to and added to this list before the new frame is initialized."
280    :group 'speedbar    :group 'speedbar
281    :type '(repeat (cons :format "%v"    :type '(repeat (sexp :tag "Parameter:")))
                        (symbol :tag "Parameter")  
                        (sexp :tag "Value"))))  
282    
283  ;; These values by Hrvoje Niksic <hniksic@srce.hr>  ;; These values by Hrvoje Niksic <hniksic@srce.hr>
284  (defcustom speedbar-frame-plist  (defcustom speedbar-frame-plist
285    '(minibuffer nil width 20 border-width 0    '(minibuffer nil width 20 border-width 0
286                 internal-border-width 0 unsplittable t                 internal-border-width 0 unsplittable t
287                 default-toolbar-visible-p nil has-modeline-p nil                 default-toolbar-visible-p nil has-modeline-p nil
288                 menubar-visible-p nil)                 menubar-visible-p nil
289                   default-gutter-visible-p nil
290                   )
291    "*Parameters to use when creating the speedbar frame in XEmacs.    "*Parameters to use when creating the speedbar frame in XEmacs.
292  Parameters not listed here which will be added automatically are  Parameters not listed here which will be added automatically are
293  `height' which will be initialized to the height of the frame speedbar  `height' which will be initialized to the height of the frame speedbar
# Line 381  is attached to." Line 297  is attached to."
297                          (symbol :tag "Property")                          (symbol :tag "Property")
298                          (sexp :tag "Value"))))                          (sexp :tag "Value"))))
299    
300  (defcustom speedbar-use-imenu-flag (fboundp 'imenu)  (defcustom speedbar-use-imenu-flag (stringp (locate-library "imenu"))
301    "*Non-nil means use imenu for file parsing.  nil to use etags.    "*Non-nil means use imenu for file parsing.  nil to use etags.
302  XEmacs prior to 20.4 doesn't support imenu, therefore the default is to  XEmacs prior to 20.4 doesn't support imenu, therefore the default is to
303  use etags instead.  Etags support is not as robust as imenu support."  use etags instead.  Etags support is not as robust as imenu support."
# Line 401  error occurred, and the next fetch routi Line 317  error occurred, and the next fetch routi
317  INSERT is a function which takes an INDENTation level, and a LIST of  INSERT is a function which takes an INDENTation level, and a LIST of
318  tags to insert.  It will then create the speedbar buttons.")  tags to insert.  It will then create the speedbar buttons.")
319    
320  (defcustom speedbar-track-mouse-flag t  (defcustom speedbar-use-tool-tips-flag (and (not (featurep 'xemacs))
321                                           (>= emacs-major-version 21))
322      "*Non-nil means to use tool tips if they are avaialble.
323    When tooltips are not available, mouse-tracking and minibuffer
324    display is used instead."
325      :group 'speedbar
326      :type 'boolean)
327    
328    (defcustom speedbar-track-mouse-flag (not speedbar-use-tool-tips-flag)
329    "*Non-nil means to display info about the line under the mouse."    "*Non-nil means to display info about the line under the mouse."
330    :group 'speedbar    :group 'speedbar
331    :type 'boolean)    :type 'boolean)
332    
333  (defcustom speedbar-sort-tags nil  (defcustom speedbar-sort-tags nil
334    "*If non-nil, sort tags in the speedbar display.  *Obsolete*."    "*If non-nil, sort tags in the speedbar display.  *Obsolete*.
335    Use `semantic-tag-hierarchy-method' instead."
336    :group 'speedbar    :group 'speedbar
337    :type 'boolean)    :type 'boolean)
338    
# Line 427  or Line 352  or
352    (GROUP-NAME-STRING ELT1 ELT2... ELTn)"    (GROUP-NAME-STRING ELT1 ELT2... ELTn)"
353    :group 'speedbar    :group 'speedbar
354    :type 'hook    :type 'hook
355    :options '(speedbar-sort-tag-hierarchy    :options '(speedbar-prefix-group-tag-hierarchy
356               speedbar-trim-words-tag-hierarchy               speedbar-trim-words-tag-hierarchy
357               speedbar-prefix-group-tag-hierarchy               speedbar-simple-group-tag-hierarchy
358               speedbar-simple-group-tag-hierarchy)               speedbar-sort-tag-hierarchy)
359    )    )
360    
361  (defcustom speedbar-tag-group-name-minimum-length 4  (defcustom speedbar-tag-group-name-minimum-length 4
# Line 460  items is reached." Line 385  items is reached."
385    :group 'speedbar    :group 'speedbar
386    :type 'integer)    :type 'integer)
387    
 (defcustom speedbar-activity-change-focus-flag nil  
   "*Non-nil means the selected frame will change based on activity.  
 Thus, if a file is selected for edit, the buffer will appear in the  
 selected frame and the focus will change to that frame."  
   :group 'speedbar  
   :type 'boolean)  
   
388  (defcustom speedbar-directory-button-trim-method 'span  (defcustom speedbar-directory-button-trim-method 'span
389    "*Indicates how the directory button will be displayed.    "*Indicates how the directory button will be displayed.
390  Possible values are:  Possible values are:
# Line 493  hierarchy would be replaced with the new Line 411  hierarchy would be replaced with the new
411  (defcustom speedbar-indentation-width 1  (defcustom speedbar-indentation-width 1
412    "*When sub-nodes are expanded, the number of spaces used for indentation."    "*When sub-nodes are expanded, the number of spaces used for indentation."
413    :group 'speedbar    :group 'speedbar
   :version "21.1"  
414    :type 'integer)    :type 'integer)
415    
416  (defcustom speedbar-hide-button-brackets-flag nil  (defcustom speedbar-hide-button-brackets-flag nil
417    "*Non-nil means speedbar will hide the brackets around the + or -."    "*Non-nil means speedbar will hide the brackets around the + or -."
418    :group 'speedbar    :group 'speedbar
   :version "21.1"  
419    :type 'boolean)    :type 'boolean)
420    
421  (defcustom speedbar-use-images (and (or (fboundp 'defimage)  (defcustom speedbar-before-popup-hook nil
422                                          (fboundp 'make-image-specifier))    "*Hooks called before popping up the speedbar frame."
                                     (if (fboundp 'display-graphic-p)  
                                         (display-graphic-p)  
                                       window-system))  
   "*Non-nil if speedbar should display icons."  
423    :group 'speedbar    :group 'speedbar
424    :version "21.1"    :type 'hook)
   :type 'boolean)  
425    
426  (defcustom speedbar-before-popup-hook nil  (defcustom speedbar-after-create-hook '(speedbar-frame-reposition-smartly)
427    "*Hooks called before popping up the speedbar frame."    "*Hooks called before popping up the speedbar frame."
428    :group 'speedbar    :group 'speedbar
429    :type 'hook)    :type 'hook)
# Line 551  Any file checked out is marked with `spe Line 462  Any file checked out is marked with `spe
462  (defvar speedbar-vc-indicator "*"  (defvar speedbar-vc-indicator "*"
463    "Text used to mark files which are currently checked out.    "Text used to mark files which are currently checked out.
464  Other version control systems can be added by examining the function  Other version control systems can be added by examining the function
465  `speedbar-vc-path-enable-hook' and `speedbar-vc-in-control-hook'.")  `speedbar-vc-directory-enable-hook' and `speedbar-vc-in-control-hook'.")
466    
467  (defcustom speedbar-vc-path-enable-hook nil  (defcustom speedbar-vc-directory-enable-hook nil
468    "*Return non-nil if the current path should be checked for Version Control.    "*Return non-nil if the current directory should be checked for Version Control.
469  Functions in this hook must accept one parameter which is the path  Functions in this hook must accept one parameter which is the directory
470  being checked."  being checked."
471    :group 'speedbar-vc    :group 'speedbar-vc
472    :type 'hook)    :type 'hook)
473    
474  (defcustom speedbar-vc-in-control-hook nil  (defcustom speedbar-vc-in-control-hook nil
475    "*Return non-nil if the specified file is under Version Control.    "*Return non-nil if the specified file is under Version Control.
476  Functions in this hook must accept two parameters.  The PATH of the  Functions in this hook must accept two parameters.  The DIRECTORY of the
477  current file, and the FILENAME of the file being checked."  current file, and the FILENAME of the file being checked."
478    :group 'speedbar-vc    :group 'speedbar-vc
479    :type 'hook)    :type 'hook)
# Line 573  current file, and the FILENAME of the fi Line 484  current file, and the FILENAME of the fi
484  (defcustom speedbar-obj-do-check t  (defcustom speedbar-obj-do-check t
485    "*Non-nil check all files in speedbar to see if they have an object file.    "*Non-nil check all files in speedbar to see if they have an object file.
486  Any file checked out is marked with `speedbar-obj-indicator', and the  Any file checked out is marked with `speedbar-obj-indicator', and the
487  marking is based on `speedbar-obj-alist'."  marking is based on `speedbar-obj-alist'"
488    :group 'speedbar-vc    :group 'speedbar-vc
489    :type 'boolean)    :type 'boolean)
490    
# Line 586  The car is for an up-to-date object.  Th Line 497  The car is for an up-to-date object.  Th
497  The expression `speedbar-obj-alist' defines who gets tagged.")  The expression `speedbar-obj-alist' defines who gets tagged.")
498    
499  (defvar speedbar-obj-alist  (defvar speedbar-obj-alist
500    '(("\\.\\([cpC]\\|cpp\\|cc\\)$" . ".o")    '(("\\.\\([cpC]\\|cpp\\|cc\\|cxx\\)$" . ".o")
501      ("\\.el$" . ".elc")      ("\\.el$" . ".elc")
502      ("\\.java$" . ".class")      ("\\.java$" . ".class")
503      ("\\.f\\(or\\|90\\|77\\)?$" . ".o")      ("\\.f\\(or\\|90\\|77\\)?$" . ".o")
# Line 594  The expression `speedbar-obj-alist' defi Line 505  The expression `speedbar-obj-alist' defi
505      ("\\.texi$" . ".info"))      ("\\.texi$" . ".info"))
506    "Alist of file extensions, and their corresponding object file type.")    "Alist of file extensions, and their corresponding object file type.")
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.
516  (defvar speedbar-indicator-regex  (defvar speedbar-indicator-regex
517    (concat (regexp-quote speedbar-indicator-separator)    (concat (regexp-quote speedbar-indicator-separator)
518            "\\("            "\\("
# Line 602  The expression `speedbar-obj-alist' defi Line 521  The expression `speedbar-obj-alist' defi
521            (regexp-quote (car speedbar-obj-indicator))            (regexp-quote (car speedbar-obj-indicator))
522            "\\|"            "\\|"
523            (regexp-quote (cdr speedbar-obj-indicator))            (regexp-quote (cdr speedbar-obj-indicator))
524              "\\|"
525              (regexp-quote speedbar-object-read-only-indicator)
526            "\\)*")            "\\)*")
527    "Regular expression used when identifying files.    "Regular expression used when identifying files.
528  Permits stripping of indicator characters from a line.")  Permits stripping of indicator characters from a line.")
# Line 613  state data." Line 534  state data."
534    :group 'speedbar    :group 'speedbar
535    :type 'hook)    :type 'hook)
536    
537  (defvar speedbar-ignored-modes nil  (defvar speedbar-ignored-modes '(fundamental-mode)
538    "*List of major modes which speedbar will not switch directories for.")    "*List of major modes which speedbar will not switch directories for.")
539    
540  (defun speedbar-extension-list-to-regex (extlist)  (defun speedbar-extension-list-to-regex (extlist)
# Line 635  with `.' followed by extensions, followe Line 556  with `.' followed by extensions, followe
556              (if regex2 (concat "\\(" regex2 "\\)") "")              (if regex2 (concat "\\(" regex2 "\\)") "")
557              "\\)$")))              "\\)$")))
558    
559  (defvar speedbar-ignored-path-regexp nil  (defvar speedbar-ignored-directory-regexp nil
560    "Regular expression matching paths speedbar will not switch to.    "Regular expression matching directorys speedbar will not switch to.
561  Created from `speedbar-ignored-path-expressions' with the function  Created from `speedbar-ignored-directory-expressions' with the function
562  `speedbar-extension-list-to-regex' (A misnamed function in this case.)  `speedbar-extension-list-to-regex' (A misnamed function in this case.)
563  Use the function `speedbar-add-ignored-path-regexp', or customize the  Use the function `speedbar-add-ignored-directory-regexp', or customize the
564  variable `speedbar-ignored-path-expressions' to modify this variable.")  variable `speedbar-ignored-directory-expressions' to modify this variable.")
565    
566  (defcustom speedbar-ignored-path-expressions  (defcustom speedbar-ignored-directory-expressions
567    '("[/\\]logs?[/\\]\\'")    '("[/\\]logs?[/\\]\\'")
568    "*List of regular expressions matching directories speedbar will ignore.    "*List of regular expressions matching directories speedbar will ignore.
569  They should included paths to directories which are notoriously very  They should included directorys to directories which are notoriously very
570  large and take a long time to load in.  Use the function  large and take a long time to load in.  Use the function
571  `speedbar-add-ignored-path-regexp' to add new items to this list after  `speedbar-add-ignored-directory-regexp' to add new items to this list after
572  speedbar is loaded.  You may place anything you like in this list  speedbar is loaded.  You may place anything you like in this list
573  before speedbar has been loaded."  before speedbar has been loaded."
574    :group 'speedbar    :group 'speedbar
575    :type '(repeat (regexp :tag "Path Regexp"))    :type '(repeat (regexp :tag "Directory Regexp"))
576    :set (lambda (sym val)    :set (lambda (sym val)
577           (setq speedbar-ignored-path-expressions val           (setq speedbar-ignored-directory-expressions val
578                 speedbar-ignored-path-regexp                 speedbar-ignored-directory-regexp
579                 (speedbar-extension-list-to-regex val))))                 (speedbar-extension-list-to-regex val))))
580    
581  (defcustom speedbar-directory-unshown-regexp "^\\(CVS\\|RCS\\|SCCS\\)\\'"  (defcustom speedbar-directory-unshown-regexp "^\\(CVS\\|RCS\\|SCCS\\|\\..*\\)\\'"
582    "*Regular expression matching directories not to show in speedbar.    "*Regular expression matching directories not to show in speedbar.
583  They should include commonly existing directories which are not  They should include commonly existing directories which are not
584  useful, such as version control."  useful, such as version control."
# Line 675  useful, such as version control." Line 596  useful, such as version control."
596    "*Regexp matching files we don't want displayed in a speedbar buffer.    "*Regexp matching files we don't want displayed in a speedbar buffer.
597  It is generated from the variable `completion-ignored-extensions'")  It is generated from the variable `completion-ignored-extensions'")
598    
599  ;; Compiler silencing trick.  The real defvar comes later in this file.  (defvar speedbar-file-regexp nil
600  (defvar speedbar-file-regexp)    "Regular expression matching files we know how to expand.
601    Created from `speedbar-supported-extension-expressions' with the
602    function `speedbar-extension-list-to-regex'")
603    
604  ;; this is dangerous to customize, because the defaults will probably  ;; this is dangerous to customize, because the defaults will probably
605  ;; change in the future.  ;; change in the future.
# Line 688  It is generated from the variable `compl Line 611  It is generated from the variable `compl
611                  ;; html is not supported by default, but an imenu tags package                  ;; html is not supported by default, but an imenu tags package
612                  ;; is available.  Also, html files are nice to be able to see.                  ;; is available.  Also, html files are nice to be able to see.
613                  ".s?html"                  ".s?html"
614                  "[Mm]akefile\\(\\.in\\)?")))                  ".ma?k" "[Mm]akefile\\(\\.in\\)?")))
615    "*List of regular expressions which will match files supported by tagging.    "*List of regular expressions which will match files supported by tagging.
616  Do not prefix the `.' char with a double \\ to quote it, as the period  Do not prefix the `.' char with a double \\ to quote it, as the period
617  will be stripped by a simplified optimizer when compiled into a  will be stripped by a simplified optimizer when compiled into a
# Line 696  singular expression.  This variable will Line 619  singular expression.  This variable will
619  `speedbar-file-regexp' for use with speedbar.  You should use the  `speedbar-file-regexp' for use with speedbar.  You should use the
620  function `speedbar-add-supported-extension' to add a new extension at  function `speedbar-add-supported-extension' to add a new extension at
621  runtime, or use the configuration dialog to set it in your .emacs  runtime, or use the configuration dialog to set it in your .emacs
622  file."  file.
623    If you add an extension to this list, and it does not appear, you may
624    need to also modify `completion-ignored-extension' which will also help
625    file completion."
626    :group 'speedbar    :group 'speedbar
   :version "21.1"  
627    :type '(repeat (regexp :tag "Extension Regexp"))    :type '(repeat (regexp :tag "Extension Regexp"))
628    :set (lambda (sym val)    :set (lambda (sym val)
629           (setq speedbar-supported-extension-expressions val           (set 'speedbar-supported-extension-expressions val)
630                 speedbar-file-regexp (speedbar-extension-list-to-regex val))))           (set 'speedbar-file-regexp (speedbar-extension-list-to-regex val))))
631    
632  (defvar speedbar-file-regexp  (setq speedbar-file-regexp
633    (speedbar-extension-list-to-regex speedbar-supported-extension-expressions)        (speedbar-extension-list-to-regex speedbar-supported-extension-expressions))
   "Regular expression matching files we know how to expand.  
 Created from `speedbar-supported-extension-expression' with the  
 function `speedbar-extension-list-to-regex'")  
   
 (defcustom speedbar-scan-subdirs nil  
   "*Non-nil means speedbar will check if subdirs are empty.  
 That way you don't have to click on them to find out.  But this  
 incurs extra I/O, hence it slows down directory display  
 proportionally to the number of subdirs."  
   :group 'speedbar  
   :type 'boolean  
   :version 22.1)  
634    
635  (defun speedbar-add-supported-extension (extension)  (defun speedbar-add-supported-extension (extension)
636    "Add EXTENSION as a new supported extension for speedbar tagging.    "Add EXTENSION as a new supported extension for speedbar tagging.
# Line 736  list of strings." Line 649  list of strings."
649    (setq speedbar-file-regexp (speedbar-extension-list-to-regex    (setq speedbar-file-regexp (speedbar-extension-list-to-regex
650                                speedbar-supported-extension-expressions)))                                speedbar-supported-extension-expressions)))
651    
652  (defun speedbar-add-ignored-path-regexp (path-expression)  (defun speedbar-add-ignored-directory-regexp (directory-expression)
653    "Add PATH-EXPRESSION as a new ignored path for speedbar tracking.    "Add DIRECTORY-EXPRESSION as a new ignored directory for speedbar tracking.
654  This function will modify `speedbar-ignored-path-regexp' and add  This function will modify `speedbar-ignored-directory-regexp' and add
655  PATH-EXPRESSION to `speedbar-ignored-path-expressions'."  DIRECTORY-EXPRESSION to `speedbar-ignored-directory-expressions'."
656    (interactive "sPath regex: ")    (interactive "sDirectory regex: ")
657    (if (not (listp path-expression))    (if (not (listp directory-expression))
658        (setq path-expression (list path-expression)))        (setq directory-expression (list directory-expression)))
659    (while path-expression    (while directory-expression
660      (if (member (car path-expression) speedbar-ignored-path-expressions)      (if (member (car directory-expression) speedbar-ignored-directory-expressions)
661          nil          nil
662        (setq speedbar-ignored-path-expressions        (setq speedbar-ignored-directory-expressions
663              (cons (car path-expression) speedbar-ignored-path-expressions)))              (cons (car directory-expression) speedbar-ignored-directory-expressions)))
664      (setq path-expression (cdr path-expression)))      (setq directory-expression (cdr directory-expression)))
665    (setq speedbar-ignored-path-regexp (speedbar-extension-list-to-regex    (setq speedbar-ignored-directory-regexp (speedbar-extension-list-to-regex
666                                        speedbar-ignored-path-expressions)))                                        speedbar-ignored-directory-expressions)))
667    
668  ;; If we don't have custom, then we set it here by hand.  ;; If we don't have custom, then we set it here by hand.
669  (if (not (fboundp 'custom-declare-variable))  (if (not (fboundp 'custom-declare-variable))
670      (setq speedbar-file-regexp (speedbar-extension-list-to-regex      (setq speedbar-file-regexp (speedbar-extension-list-to-regex
671                                  speedbar-supported-extension-expressions)                                  speedbar-supported-extension-expressions)
672            speedbar-ignored-path-regexp (speedbar-extension-list-to-regex            speedbar-ignored-directory-regexp (speedbar-extension-list-to-regex
673                                          speedbar-ignored-path-expressions)))                                          speedbar-ignored-directory-expressions)))
674    
675  (defvar speedbar-update-flag (and  (defvar speedbar-update-flag dframe-have-timer-flag
                               (or (fboundp 'run-with-idle-timer)  
                                   (fboundp 'start-itimer)  
                                   (boundp 'post-command-idle-hook))  
                               (if (fboundp 'display-graphic-p)  
                                   (display-graphic-p)  
                                 window-system))  
676    "*Non-nil means to automatically update the display.    "*Non-nil means to automatically update the display.
677  When this is nil then speedbar will not follow the attached  When this is nil then speedbar will not follow the attached frame's directory.
678  frame's path.  Type \  When speedbar is active, use:
679  \\<speedbar-key-map>\\[speedbar-toggle-updates] in the speedbar \  
680    \\<speedbar-key-map> `\\[speedbar-toggle-updates]'
681    
682  to toggle this value.")  to toggle this value.")
683    
684    (defvar speedbar-update-flag-disable nil
685      "Permanently disable changing of the update flag.")
686    
687  (defvar speedbar-syntax-table nil  (defvar speedbar-syntax-table nil
688    "Syntax-table used on the speedbar.")    "Syntax-table used on the speedbar.")
689    
# Line 797  to toggle this value.") Line 709  to toggle this value.")
709    (suppress-keymap speedbar-key-map t)    (suppress-keymap speedbar-key-map t)
710    
711    ;; control    ;; control
   (define-key speedbar-key-map "g" 'speedbar-refresh)  
712    (define-key speedbar-key-map "t" 'speedbar-toggle-updates)    (define-key speedbar-key-map "t" 'speedbar-toggle-updates)
713    (define-key speedbar-key-map "q" 'speedbar-close-frame)    (define-key speedbar-key-map "g" 'speedbar-refresh)
   (define-key speedbar-key-map "Q" 'delete-frame)  
714    
715    ;; navigation    ;; navigation
716    (define-key speedbar-key-map "n" 'speedbar-next)    (define-key speedbar-key-map "n" 'speedbar-next)
# Line 809  to toggle this value.") Line 719  to toggle this value.")
719    (define-key speedbar-key-map "\M-p" 'speedbar-restricted-prev)    (define-key speedbar-key-map "\M-p" 'speedbar-restricted-prev)
720    (define-key speedbar-key-map "\C-\M-n" 'speedbar-forward-list)    (define-key speedbar-key-map "\C-\M-n" 'speedbar-forward-list)
721    (define-key speedbar-key-map "\C-\M-p" 'speedbar-backward-list)    (define-key speedbar-key-map "\C-\M-p" 'speedbar-backward-list)
722    (define-key speedbar-key-map " " 'speedbar-scroll-up)  ;; These commands never seemed useful.
723    (define-key speedbar-key-map [delete] 'speedbar-scroll-down)  ;;  (define-key speedbar-key-map " " 'speedbar-scroll-up)
724    ;;  (define-key speedbar-key-map [delete] 'speedbar-scroll-down)
725    
726    ;; Short cuts I happen to find useful    ;; Short cuts I happen to find useful
727    (define-key speedbar-key-map "r"    (define-key speedbar-key-map "r"
# Line 824  to toggle this value.") Line 735  to toggle this value.")
735      (lambda () (interactive)      (lambda () (interactive)
736        (speedbar-change-initial-expansion-list "files")))        (speedbar-change-initial-expansion-list "files")))
737    
738    ;; Overrides    (dframe-update-keymap speedbar-key-map)
739    (substitute-key-definition 'switch-to-buffer  )
                              'speedbar-switch-buffer-attached-frame  
                              speedbar-key-map global-map)  
   
   (if speedbar-xemacsp  
       (progn  
         ;; mouse bindings so we can manipulate the items on each line  
         (define-key speedbar-key-map 'button2 'speedbar-click)  
         (define-key speedbar-key-map '(shift button2) 'speedbar-power-click)  
         ;; Info doc fix from Bob Weiner  
         (if (featurep 'infodoc)  
             nil  
           (define-key speedbar-key-map 'button3 'speedbar-xemacs-popup-kludge))  
         (define-key speedbar-key-map '(meta button3) 'speedbar-mouse-item-info)  
         )  
   
     ;; mouse bindings so we can manipulate the items on each line  
     (define-key speedbar-key-map [down-mouse-1] 'speedbar-double-click)  
     (define-key speedbar-key-map [mouse-2] 'speedbar-click)  
     ;; This is the power click for new frames, or refreshing a cache  
     (define-key speedbar-key-map [S-mouse-2] 'speedbar-power-click)  
     ;; This adds a small unecessary visual effect  
     ;;(define-key speedbar-key-map [down-mouse-2] 'speedbar-quick-mouse)  
     (define-key speedbar-key-map [M-mouse-2] 'speedbar-mouse-item-info)  
   
     (define-key speedbar-key-map [down-mouse-3] 'speedbar-emacs-popup-kludge)  
   
     ;; This lets the user scroll as if we had a scrollbar... well maybe not  
     (define-key speedbar-key-map [mode-line mouse-2] 'speedbar-mouse-hscroll)  
     ;; another handy place users might click to get our menu.  
     (define-key speedbar-key-map [mode-line down-mouse-1]  
       'speedbar-emacs-popup-kludge)  
   
     ;; We can't switch buffers with the buffer mouse menu.  Lets hack it.  
     (define-key speedbar-key-map [C-down-mouse-1] 'speedbar-hack-buffer-menu)  
   
     ;; Lastly, we want to track the mouse.  Play here  
     (define-key speedbar-key-map [mouse-movement] 'speedbar-track-mouse)  
    ))  
740    
741  (defun speedbar-make-specialized-keymap ()  (defun speedbar-make-specialized-keymap ()
742    "Create a keymap for use with a speedbar major or minor display mode.    "Create a keymap for use with a speedbar major or minor display mode.
# Line 887  This basically creates a sparse keymap, Line 760  This basically creates a sparse keymap,
760    (define-key speedbar-file-key-map "=" 'speedbar-expand-line)    (define-key speedbar-file-key-map "=" 'speedbar-expand-line)
761    (define-key speedbar-file-key-map "-" 'speedbar-contract-line)    (define-key speedbar-file-key-map "-" 'speedbar-contract-line)
762    
763      (define-key speedbar-file-key-map "[" 'speedbar-expand-line-descendants)
764      (define-key speedbar-file-key-map "]" 'speedbar-close-line-descendants)
765    
766      (define-key speedbar-file-key-map " " 'speedbar-toggle-line-expansion)
767    
768    ;; file based commands    ;; file based commands
769    (define-key speedbar-file-key-map "U" 'speedbar-up-directory)    (define-key speedbar-file-key-map "U" 'speedbar-up-directory)
770    (define-key speedbar-file-key-map "I" 'speedbar-item-info)    (define-key speedbar-file-key-map "I" 'speedbar-item-info)
# Line 896  This basically creates a sparse keymap, Line 774  This basically creates a sparse keymap,
774    (define-key speedbar-file-key-map "D" 'speedbar-item-delete)    (define-key speedbar-file-key-map "D" 'speedbar-item-delete)
775    (define-key speedbar-file-key-map "O" 'speedbar-item-object-delete)    (define-key speedbar-file-key-map "O" 'speedbar-item-object-delete)
776    (define-key speedbar-file-key-map "R" 'speedbar-item-rename)    (define-key speedbar-file-key-map "R" 'speedbar-item-rename)
777      (define-key speedbar-file-key-map "M" 'speedbar-create-directory)
778    )    )
779    
780  (defvar speedbar-easymenu-definition-base  (defvar speedbar-easymenu-definition-base
# Line 903  This basically creates a sparse keymap, Line 782  This basically creates a sparse keymap,
782     '("Speedbar"     '("Speedbar"
783       ["Update" speedbar-refresh t]       ["Update" speedbar-refresh t]
784       ["Auto Update" speedbar-toggle-updates       ["Auto Update" speedbar-toggle-updates
785          :active (not speedbar-update-flag-disable)
786        :style toggle :selected speedbar-update-flag])        :style toggle :selected speedbar-update-flag])
787     (if (and (or (fboundp 'defimage)     (if (and (or (fboundp 'defimage)
788                  (fboundp 'make-image-specifier))                  (fboundp 'make-image-specifier))
# Line 925  This basically creates a sparse keymap, Line 805  This basically creates a sparse keymap,
805      ["Flush Cache & Expand" speedbar-flush-expand-line      ["Flush Cache & Expand" speedbar-flush-expand-line
806       (save-excursion (beginning-of-line)       (save-excursion (beginning-of-line)
807                       (looking-at "[0-9]+: *.\\+. "))]                       (looking-at "[0-9]+: *.\\+. "))]
808        ["Expand All Descendants" speedbar-expand-line-descendants
809         (save-excursion (beginning-of-line)
810                         (looking-at "[0-9]+: *.\\+. ")) ]
811      ["Contract File Tags" speedbar-contract-line      ["Contract File Tags" speedbar-contract-line
812       (save-excursion (beginning-of-line)       (save-excursion (beginning-of-line)
813                       (looking-at "[0-9]+: *.-. "))]                       (looking-at "[0-9]+: *.-. "))]
# Line 944  This basically creates a sparse keymap, Line 827  This basically creates a sparse keymap,
827       (save-excursion (beginning-of-line) (looking-at "[0-9]+: *\\["))]       (save-excursion (beginning-of-line) (looking-at "[0-9]+: *\\["))]
828      ["Rename File" speedbar-item-rename      ["Rename File" speedbar-item-rename
829       (save-excursion (beginning-of-line) (looking-at "[0-9]+: *[[<]"))]       (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]+: *[[<]"))]
832      ["Delete File" speedbar-item-delete      ["Delete File" speedbar-item-delete
833       (save-excursion (beginning-of-line) (looking-at "[0-9]+: *[[<]"))]       (save-excursion (beginning-of-line) (looking-at "[0-9]+: *[[<]"))]
834      ["Delete Object" speedbar-item-object-delete      ["Delete Object" speedbar-item-object-delete
# Line 951  This basically creates a sparse keymap, Line 836  This basically creates a sparse keymap,
836                       (looking-at "[0-9]+: *\\[[+-]\\] [^ \n]+ \\*?[!#]$"))]                       (looking-at "[0-9]+: *\\[[+-]\\] [^ \n]+ \\*?[!#]$"))]
837      )      )
838    "Additional menu items while in file-mode.")    "Additional menu items while in file-mode.")
839    
840  (defvar speedbar-easymenu-definition-trailer  (defvar speedbar-easymenu-definition-trailer
841    (append    (append
842     (if (and (featurep 'custom) (fboundp 'custom-declare-variable))     (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
843         (list ["Customize..." speedbar-customize t]))         (list ["Customize..." speedbar-customize t]))
844     (list     (list
845      ["Close" speedbar-close-frame t]      ["Detach" speedbar-detach (and speedbar-frame
846                                        (eq (selected-frame) speedbar-frame)) ]
847        ["Close" dframe-close-frame t]
848      ["Quit" delete-frame t] ))      ["Quit" delete-frame t] ))
849    "Menu items appearing at the end of the speedbar menu.")    "Menu items appearing at the end of the speedbar menu.")
850    
# Line 972  In this case it is the originating buffe Line 859  In this case it is the originating buffe
859    "The frame that was last created, then removed from the display.")    "The frame that was last created, then removed from the display.")
860  (defvar speedbar-full-text-cache nil  (defvar speedbar-full-text-cache nil
861    "The last open directory is saved in its entirety for ultra-fast switching.")    "The last open directory is saved in its entirety for ultra-fast switching.")
 (defvar speedbar-timer nil  
   "The speedbar timer used for updating the buffer.")  
 (defvar speedbar-attached-frame nil  
   "The frame which started speedbar mode.  
 This is the frame from which all data displayed in the speedbar is  
 gathered, and in which files and such are displayed.")  
862    
863  (defvar speedbar-last-selected-file nil  (defvar speedbar-last-selected-file nil
864    "The last file which was selected in speedbar buffer.")    "The last file which was selected in speedbar buffer.")
# Line 997  directories.") Line 878  directories.")
878    
879  ;;; Compatibility  ;;; Compatibility
880  ;;  ;;
881  (if (fboundp 'frame-parameter)  (defalias 'speedbar-make-overlay
882      (if (featurep 'xemacs) 'make-extent 'make-overlay))
883    
884    (defalias 'speedbar-overlay-put
885      (if (featurep 'xemacs) 'set-extent-property 'overlay-put))
886    
887      (defalias 'speedbar-frame-parameter 'frame-parameter)  (defalias 'speedbar-delete-overlay
888      (if (featurep 'xemacs) 'delete-extent 'delete-overlay))
889    
890    (defun speedbar-frame-parameter (frame parameter)  (defalias 'speedbar-mode-line-update
891      "Return FRAME's PARAMETER value."    (if (featurep 'xemacs) 'redraw-modeline 'force-mode-line-update))
     (cdr (assoc parameter (frame-parameters frame)))))  
   
 (if (fboundp 'make-overlay)  
     (progn  
       (defalias 'speedbar-make-overlay 'make-overlay)  
       (defalias 'speedbar-overlay-put 'overlay-put)  
       (defalias 'speedbar-delete-overlay 'delete-overlay)  
       (defalias 'speedbar-overlay-start 'overlay-start)  
       (defalias 'speedbar-overlay-end 'overlay-end)  
       (defalias 'speedbar-mode-line-update 'force-mode-line-update))  
   (defalias 'speedbar-make-overlay 'make-extent)  
   (defalias 'speedbar-overlay-put 'set-extent-property)  
   (defalias 'speedbar-delete-overlay 'delete-extent)  
   (defalias 'speedbar-overlay-start 'extent-start)  
   (defalias 'speedbar-overlay-end 'extent-end)  
   (defalias 'speedbar-mode-line-update 'redraw-modeline))  
892    
893  ;;; Mode definitions/ user commands  ;;; Mode definitions/ user commands
894  ;;  ;;
# Line 1034  supported at a time. Line 904  supported at a time.
904  `speedbar-before-popup-hook' is called before popping up the speedbar frame.  `speedbar-before-popup-hook' is called before popping up the speedbar frame.
905  `speedbar-before-delete-hook' is called before the frame is deleted."  `speedbar-before-delete-hook' is called before the frame is deleted."
906    (interactive "P")    (interactive "P")
907    ;; toggle frame on and off.    ;; Get the buffer to play with
908    (if (not arg) (if (and (frame-live-p speedbar-frame)    (if (not (buffer-live-p speedbar-buffer))
909                           (frame-visible-p speedbar-frame))        (save-excursion
910                      (setq arg -1) (setq arg 1)))          (setq speedbar-buffer (get-buffer-create " SPEEDBAR"))
911    ;; turn the frame off on neg number          (set-buffer speedbar-buffer)
912    (if (and (numberp arg) (< arg 0))          (speedbar-mode)))
913        (progn    ;; Do the frame thing
914          (run-hooks 'speedbar-before-delete-hook)    (dframe-frame-mode arg
915          (if (and speedbar-frame (frame-live-p speedbar-frame))                       'speedbar-frame
916              (progn                       'speedbar-cached-frame
917                (setq speedbar-cached-frame speedbar-frame)                       'speedbar-buffer
918                (make-frame-invisible speedbar-frame)))                       "Speedbar"
919          (setq speedbar-frame nil)                       #'speedbar-frame-mode
920          (speedbar-set-timer nil)                       (if dframe-xemacsp
921          ;; Used to delete the buffer.  This has the annoying affect of                           (append speedbar-frame-plist
922          ;; preventing whatever took its place from ever appearing                                   ;; This is a hack to get speedbar to iconfiy
923          ;; as the default after a C-x b was typed                                   ;; with the selected frame.
924          ;;(if (bufferp speedbar-buffer)                                   (list 'parent (selected-frame)))
925          ;;    (kill-buffer speedbar-buffer))                         speedbar-frame-parameters)
926          )                       speedbar-before-delete-hook
927      ;; Set this as our currently attached frame                       speedbar-before-popup-hook
928      (setq speedbar-attached-frame (selected-frame))                       speedbar-after-create-hook)
929      (run-hooks 'speedbar-before-popup-hook)    ;; Start up the timer
930      ;; Get the frame to work in    (if (not speedbar-frame)
931      (if (frame-live-p speedbar-cached-frame)        (speedbar-set-timer nil)
932          (progn      (speedbar-reconfigure-keymaps)
933            (setq speedbar-frame speedbar-cached-frame)      (speedbar-update-contents)
934            (make-frame-visible speedbar-frame)      (speedbar-set-timer dframe-update-speed)
935            ;; Get the buffer to play with      )
936            (speedbar-mode)    ;; Frame modifications
937            (select-frame speedbar-frame)    (set (make-local-variable 'dframe-delete-frame-function)
938            (if (not (eq (current-buffer) speedbar-buffer))         'speedbar-handle-delete-frame)
939                (switch-to-buffer speedbar-buffer))    ;; hscroll
940            (set-window-dedicated-p (selected-window) t)    (set (make-local-variable 'automatic-hscrolling) nil) ; Emacs 21
941            (raise-frame speedbar-frame)    ;; reset the selection variable
942            (speedbar-set-timer speedbar-update-speed)    (setq speedbar-last-selected-file nil))
943            )  
944        (if (frame-live-p speedbar-frame)  (defun speedbar-frame-reposition-smartly ()
945            (raise-frame speedbar-frame)    "Reposition the speedbar frame to be next to the attached frame."
946          (setq speedbar-frame    (cond ((and dframe-xemacsp
947                (if speedbar-xemacsp                (or (member 'left speedbar-frame-plist)
948                    ;; Only guess height if it is not specified.                    (member 'top speedbar-frame-plist)))
949                    (if (member 'height speedbar-frame-plist)           (dframe-reposition-frame
950                        (make-frame speedbar-frame-plist)            speedbar-frame
951                      (make-frame (nconc (list 'height            (dframe-attached-frame speedbar-frame)
952                                               (speedbar-needed-height))            (cons (car (cdr (member 'left speedbar-frame-plist)))
953                                         speedbar-frame-plist)))                  (car (cdr (member 'top speedbar-frame-plist)))))
954                  (let* ((mh (speedbar-frame-parameter nil 'menu-bar-lines))           )
955                         (cfx (speedbar-frame-parameter nil 'left))          ((and (not dframe-xemacsp)
956                         (cfy (speedbar-frame-parameter nil 'top))                (or (assoc 'left speedbar-frame-parameters)
957                         (cfw (frame-pixel-width))                    (assoc 'top speedbar-frame-parameters)))
958                         (params           ;; if left/top were specified in the parameters, pass them
959                          ;; Only add a guessed height if one is not specified           ;; down to the reposition function
960                          ;; in the input parameters.           (dframe-reposition-frame
961                          (if (assoc 'height speedbar-frame-parameters)            speedbar-frame
962                              speedbar-frame-parameters            (dframe-attached-frame speedbar-frame)
963                            (append            (cons (cdr (assoc 'left speedbar-frame-parameters))
964                             speedbar-frame-parameters                  (cdr (assoc 'top  speedbar-frame-parameters))))
965                             (list (cons 'height (+ mh (frame-height)))))))           )
966                         (frame          (t
967                          (if (or (< emacs-major-version 20)           (dframe-reposition-frame speedbar-frame
968                                  (not (eq window-system 'x)))                                    (dframe-attached-frame speedbar-frame)
969                              (make-frame params)                                    'left-right))))
970                            (let ((x-pointer-shape x-pointer-top-left-arrow)  
971                                  (x-sensitive-text-pointer-shape  (defun speedbar-detach ()
972                                   x-pointer-hand2))    "Detach the current Speedbar from auto-updating.
973                              (make-frame params)))))  Doing this allows the creation of a second speedbar."
974                    ;; Position speedbar frame.    (interactive)
975                    (if (or (not window-system) (eq window-system 'pc)    (let ((buffer speedbar-buffer))
976                            (assoc 'left speedbar-frame-parameters)      (dframe-detach 'speedbar-frame 'speedbar-cached-frame 'speedbar-buffer)
977                            (assoc 'top speedbar-frame-parameters))      (save-excursion
978                        ;; Do no positioning if not on a windowing system,        (set-buffer buffer)
979                        ;; or if left/top were specified in the parameters.        ;; Permanently disable auto-updating in this speedbar buffer.
980                        frame        (set (make-local-variable 'speedbar-update-flag) nil)
981                      (let ((cfx        (set (make-local-variable 'speedbar-update-flag-disable) t)
982                             (if (not (consp cfx))        ;; Make local copies of all the different variables to prevent
983                                 cfx        ;; funny stuff later...
984                               ;; If cfx is a list, that means we grow        )))
985                               ;; from a specific edge of the display.  
986                               ;; Convert that to the distance from the  (defsubst speedbar-current-frame ()
987                               ;; left side of the display.    "Return the frame to use for speedbar based on current context."
988                               (if (eq (car cfx) '-)    (dframe-current-frame 'speedbar-frame 'speedbar-mode))
989                                   ;; A - means distance from the right edge  
990                                   ;; of the display, or DW - cfx - framewidth  (defun speedbar-handle-delete-frame (e)
991                                   (- (x-display-pixel-width) (car (cdr cfx))    "Handle a delete frame event E.
992                                      (frame-pixel-width))  If the deleted frame is the frame SPEEDBAR is attached to,
993                                 (car (cdr cfx))))))  we need to delete speedbar also."
994                        (modify-frame-parameters    (let ((frame-to-be-deleted (car (car (cdr e)))))
995                         frame      (if (eq frame-to-be-deleted dframe-attached-frame)
996                         (list          (delete-frame speedbar-frame)))
997                          (cons    )
                          'left  
                          ;; Decide which side to put it  
                          ;; on.  200 is just a buffer  
                          ;; for the left edge of the  
                          ;; screen.  The extra 10 is just  
                          ;; dressings for window decorations.  
                          (let ((sfw (frame-pixel-width frame)))  
                            (let ((left-guess (- cfx 10 sfw))  
                                  (right-guess (+ cfx cfw 5)))  
                              (let ((left-margin left-guess)  
                                    (right-margin  
                                     (- (x-display-pixel-width)  
                                        right-guess 5 sfw)))  
                                (cond ((>= left-margin 0) left-guess)  
                                      ((>= right-margin 0) right-guess)  
                                      ;; otherwise choose side we overlap less  
                                      ((> left-margin right-margin) 0)  
                                      (t (- (x-display-pixel-width) sfw 5)))))))  
                         (cons 'top cfy)))  
                       frame)))))  
         ;; reset the selection variable  
         (setq speedbar-last-selected-file nil)  
         ;; Put the buffer into the frame  
         (save-window-excursion  
           ;; Get the buffer to play with  
           (speedbar-mode)  
           (select-frame speedbar-frame)  
           (switch-to-buffer speedbar-buffer)  
           (set-window-dedicated-p (selected-window) t))  
         (if (and (or (null window-system) (eq window-system 'pc))  
                  (fboundp 'set-frame-name))  
             (progn  
               (select-frame speedbar-frame)  
               (set-frame-name "Speedbar")))  
         (speedbar-set-timer speedbar-update-speed)))))  
998    
999  ;;;###autoload  ;;;###autoload
1000  (defun speedbar-get-focus ()  (defun speedbar-get-focus ()
# Line 1167  supported at a time. Line 1002  supported at a time.
1002  If the selected frame is not speedbar, then speedbar frame is  If the selected frame is not speedbar, then speedbar frame is
1003  selected.  If the speedbar frame is active, then select the attached frame."  selected.  If the speedbar frame is active, then select the attached frame."
1004    (interactive)    (interactive)
1005    (if (eq (selected-frame) speedbar-frame)    (speedbar-reset-scanners)
1006        (if (frame-live-p speedbar-attached-frame)    (dframe-get-focus 'speedbar-frame 'speedbar-frame-mode
1007            (select-frame speedbar-attached-frame))                      (lambda () (let ((speedbar-update-flag t))
1008      ;; If updates are off, then refresh the frame (they want it now...)                                   (speedbar-timer-fn)))))
     (if (not speedbar-update-flag)  
         (let ((speedbar-update-flag t))  
           (speedbar-timer-fn)))  
     ;; make sure we have a frame  
     (if (not (frame-live-p speedbar-frame)) (speedbar-frame-mode 1))  
     ;; go there  
     (select-frame speedbar-frame)  
     )  
   (other-frame 0))  
   
 (defun speedbar-close-frame ()  
   "Turn off a currently active speedbar."  
   (interactive)  
   (speedbar-frame-mode -1)  
   (select-frame speedbar-attached-frame)  
   (other-frame 0))  
   
 (defun speedbar-switch-buffer-attached-frame (&optional buffer)  
   "Switch to BUFFER in speedbar's attached frame, and raise that frame.  
 This overrides the default behavior of `switch-to-buffer' which is  
 broken because of the dedicated speedbar frame."  
   (interactive)  
   ;; Assume we are in the speedbar frame.  
   (speedbar-get-focus)  
   ;; Now switch buffers  
   (if buffer  
       (switch-to-buffer buffer)  
     (call-interactively 'switch-to-buffer nil nil)))  
1009    
1010  (defmacro speedbar-frame-width ()  (defmacro speedbar-frame-width ()
1011    "Return the width of the speedbar frame in characters.    "Return the width of the speedbar frame in characters.
1012  nil if it doesn't exist."  nil if it doesn't exist."
1013    '(frame-width speedbar-frame))    '(window-width (get-buffer-window speedbar-buffer)))
   
 ;; XEmacs function only.  
 (defun speedbar-needed-height (&optional frame)  
   "The needed height for the tool bar FRAME (in characters)."  
   (or frame (setq frame (selected-frame)))  
   ;; The 1 is the missing modeline/minibuffer  
   (+ 1 (/ (frame-pixel-height frame)  
           (face-height 'default frame))))  
1014    
1015  (defun speedbar-mode ()  (defun speedbar-mode ()
1016    "Major mode for managing a display of directories and tags.    "Major mode for managing a display of directories and tags.
1017  \\<speedbar-key-map>  \\<speedbar-key-map>
1018  The first line represents the default path of the speedbar frame.  The first line represents the default directory of the speedbar frame.
1019  Each directory segment is a button which jumps speedbar's default  Each directory segment is a button which jumps speedbar's default
1020  directory to that path.  Buttons are activated by clicking `\\[speedbar-click]'.  directory to that directory.  Buttons are activated by clicking `\\[speedbar-click]'.
1021  In some situations using `\\[speedbar-power-click]' is a `power click' which will  In some situations using `\\[dframe-power-click]' is a `power click' which will
1022  rescan cached items, or pop up new frames.  rescan cached items, or pop up new frames.
1023    
1024  Each line starting with <+> represents a directory.  Click on the <+>  Each line starting with <+> represents a directory.  Click on the <+>
# Line 1255  in the selected file. Line 1054  in the selected file.
1054  \\{speedbar-key-map}"  \\{speedbar-key-map}"
1055    ;; NOT interactive    ;; NOT interactive
1056    (save-excursion    (save-excursion
     (setq speedbar-buffer (set-buffer (get-buffer-create " SPEEDBAR")))  
1057      (kill-all-local-variables)      (kill-all-local-variables)
1058      (setq major-mode 'speedbar-mode)      (setq major-mode 'speedbar-mode)
1059      (setq mode-name "Speedbar")      (setq mode-name "Speedbar")
# Line 1263  in the selected file. Line 1061  in the selected file.
1061      (setq font-lock-keywords nil) ;; no font-locking please      (setq font-lock-keywords nil) ;; no font-locking please
1062      (setq truncate-lines t)      (setq truncate-lines t)
1063      (make-local-variable 'frame-title-format)      (make-local-variable 'frame-title-format)
1064      (setq frame-title-format "Speedbar")      (setq frame-title-format (concat "Speedbar " speedbar-version))
1065      ;; Set this up special just for the speedbar buffer      (setq case-fold-search nil)
     ;; Terminal minibuffer stuff does not require this.  
     (if (and window-system (not (eq window-system 'pc))  
              (null default-minibuffer-frame))  
         (progn  
           (make-local-variable 'default-minibuffer-frame)  
           (setq default-minibuffer-frame speedbar-attached-frame)))  
     ;; Correct use of `temp-buffer-show-function': Bob Weiner  
     (if (and (boundp 'temp-buffer-show-hook)  
              (boundp 'temp-buffer-show-function))  
         (progn (make-local-variable 'temp-buffer-show-hook)  
                (setq temp-buffer-show-hook temp-buffer-show-function)))  
     (make-local-variable 'temp-buffer-show-function)  
     (setq temp-buffer-show-function 'speedbar-temp-buffer-show-function)  
     (if speedbar-xemacsp  
         (progn  
           ;; Argh!  mouse-track-click-hook doesn't understand the  
           ;; make-local-hook conventions.  
           (make-local-variable 'mouse-track-click-hook)  
           (add-hook 'mouse-track-click-hook  
                     (lambda (event count)  
                       (if (/= (event-button event) 1)  
                           nil           ; Do normal operations.  
                         (cond ((eq count 1)  
                                (speedbar-quick-mouse event))  
                               ((or (eq count 2)  
                                    (eq count 3))  
                                (speedbar-mouse-set-point event)  
                                (speedbar-do-function-pointer)  
                                (speedbar-quick-mouse event)))  
                         ;; Don't do normal operations.  
                         t)))))  
     (add-hook 'kill-buffer-hook (lambda () (let ((skilling (boundp 'skilling)))  
                                              (if skilling  
                                                  nil  
                                                (if (eq (current-buffer)  
                                                        speedbar-buffer)  
                                                    (speedbar-frame-mode -1)))))  
               t t)  
1066      (toggle-read-only 1)      (toggle-read-only 1)
1067      (speedbar-set-mode-line-format)      (speedbar-set-mode-line-format)
1068      (if speedbar-xemacsp      ;; Add in our dframe hooks.
1069          (with-no-warnings      (if speedbar-track-mouse-flag
1070           (set (make-local-variable 'mouse-motion-handler)          (setq dframe-track-mouse-function #'speedbar-track-mouse))
1071                'speedbar-track-mouse-xemacs))      (setq dframe-help-echo-function #'speedbar-item-info
1072        (if speedbar-track-mouse-flag            dframe-mouse-click-function #'speedbar-click
1073            (set (make-local-variable 'track-mouse) t))   ;this could be messy.            dframe-mouse-position-function #'speedbar-position-cursor-on-line)
1074        (setq auto-show-mode nil))        ;no auto-show for Emacs      (run-hooks 'speedbar-mode-hook))
     (run-mode-hooks 'speedbar-mode-hook))  
   (speedbar-update-contents)  
1075    speedbar-buffer)    speedbar-buffer)
1076    
1077  (defmacro speedbar-with-attached-buffer (&rest forms)  (defmacro speedbar-message (fmt &rest args)
   "Execute FORMS in the attached frame's special buffer.  
 Optionally select that frame if necessary."  
   `(save-selected-window  
      (speedbar-set-timer speedbar-update-speed)  
      (select-frame speedbar-attached-frame)  
      ,@forms  
      (speedbar-maybee-jump-to-attached-frame)))  
   
 (defun speedbar-message (fmt &rest args)  
1078    "Like message, but for use in the speedbar frame.    "Like message, but for use in the speedbar frame.
1079  Argument FMT is the format string, and ARGS are the arguments for message."  Argument FMT is the format string, and ARGS are the arguments for message."
1080    (save-selected-window    `(dframe-message ,fmt ,@args))
     (select-frame speedbar-attached-frame)  
     (apply 'message fmt args)))  
1081    
1082  (defun speedbar-y-or-n-p (prompt)  (defsubst speedbar-y-or-n-p (prompt &optional deleting)
1083    "Like `y-or-n-p', but for use in the speedbar frame.    "Like `y-or-n-p', but for use in the speedbar frame.
1084  Argument PROMPT is the prompt to use."  Argument PROMPT is the prompt to use.
1085    (save-selected-window  Optional argument DELETING means this is a query that will delete something.
1086      (if (and default-minibuffer-frame (not (eq default-minibuffer-frame  The variable `speedbar-query-confirmation-method' can cause this to
1087                                                 speedbar-attached-frame)))  return true without a query."
1088          (select-frame speedbar-attached-frame))    (or (and (not deleting)
1089      (y-or-n-p prompt)))             (eq speedbar-query-confirmation-method 'none-but-delete))
1090          (dframe-y-or-n-p prompt)))
1091  (defun speedbar-show-info-under-mouse (&optional event)  
1092    "Call the info function for the line under the mouse.  (defsubst speedbar-select-attached-frame ()
1093  Optional EVENT is currently not used."    "Select the frame attached to this speedbar."
1094    (let ((pos (mouse-position)))  ; we ignore event until I use it later.    (dframe-select-attached-frame (speedbar-current-frame)))
1095      (if (equal (car pos) speedbar-frame)  
1096          (save-excursion  ;; Backwards compatibility
1097            (save-window-excursion  (defalias 'speedbar-with-attached-buffer 'dframe-with-attached-buffer)
1098              (apply 'set-mouse-position (list (car pos) (cadr pos) (cddr pos)))  (defalias 'speedbar-maybee-jump-to-attached-frame 'dframe-maybee-jump-to-attached-frame)
1099              (speedbar-item-info))))))  
   
1100  (defun speedbar-set-mode-line-format ()  (defun speedbar-set-mode-line-format ()
1101    "Set the format of the mode line based on the current speedbar environment.    "Set the format of the mode line based on the current speedbar environment.
1102  This gives visual indications of what is up.  It EXPECTS the speedbar  This gives visual indications of what is up.  It EXPECTS the speedbar
1103  frame and window to be the currently active frame and window."  frame and window to be the currently active frame and window."
1104    (if (and (frame-live-p speedbar-frame)    (if (and (frame-live-p (speedbar-current-frame))
1105             (or (not speedbar-xemacsp)             (or (not dframe-xemacsp)
1106                 (with-no-warnings                 (with-no-warnings
1107                  (specifier-instance has-modeline-p))))                   (specifier-instance has-modeline-p)))
1108        (save-excursion             speedbar-buffer)      (save-excursion
1109          (set-buffer speedbar-buffer)          (set-buffer speedbar-buffer)
1110          (let* ((w (or (speedbar-frame-width) 20))          (let* ((w (or (speedbar-frame-width) 20))
1111                 (p1 "<<")                 (p1 "<<")
1112                 (p5 ">>")                 (p5 ">>")
1113                 (p3 (if speedbar-update-flag "SPEEDBAR" "SLOWBAR"))                 (p3 (if speedbar-update-flag "#" "!"))
1114                 (blank (- w (length p1) (length p3) (length p5)                 (p35 (capitalize speedbar-initial-expansion-list-name))
1115                           (if line-number-mode 4 0)))                 (blank (- w (length p1) (length p3) (length p5) (length p35)
1116                             (if line-number-mode 5 1)))
1117                 (p2 (if (> blank 0)                 (p2 (if (> blank 0)
1118                         (make-string (/ blank 2) ? )                         (make-string (/ blank 2) ? )
1119                       ""))                       ""))
# Line 1375  frame and window to be the currently act Line 1122  frame and window to be the currently act
1122                       ""))                       ""))
1123                 (tf                 (tf
1124                  (if line-number-mode                  (if line-number-mode
1125                      (list (concat p1 p2 p3) '(line-number-mode " %3l")                      (list (concat p1 p2 p3 " " p35) '(line-number-mode " %3l")
1126                            (concat p4 p5))                            (concat p4 p5))
1127                    (list (concat p1 p2 p3 p4 p5)))))                    (list (concat p1 p2 p3 p4 p5)))))
1128            (if (not (equal mode-line-format tf))            (if (not (equal mode-line-format tf))
# Line 1383  frame and window to be the currently act Line 1130  frame and window to be the currently act
1130                  (setq mode-line-format tf)                  (setq mode-line-format tf)
1131                  (speedbar-mode-line-update)))))))                  (speedbar-mode-line-update)))))))
1132    
 (defun speedbar-temp-buffer-show-function (buffer)  
   "Placed in the variable `temp-buffer-show-function' in `speedbar-mode'.  
 If a user requests help using \\[help-command] <Key> the temp BUFFER will be  
 redirected into a window on the attached frame."  
   (if speedbar-attached-frame (select-frame speedbar-attached-frame))  
   (pop-to-buffer buffer nil)  
   (other-window -1)  
   ;; Fix for using this hook on some platforms: Bob Weiner  
   (cond ((not speedbar-xemacsp)  
          (run-hooks 'temp-buffer-show-hook))  
         ((fboundp 'run-hook-with-args)  
          (run-hook-with-args 'temp-buffer-show-hook buffer))  
         ((and (boundp 'temp-buffer-show-hook)  
               (listp temp-buffer-show-hook))  
          (mapcar (function (lambda (hook) (funcall hook buffer)))  
                  temp-buffer-show-hook))))  
   
1133  (defvar speedbar-previous-menu nil  (defvar speedbar-previous-menu nil
1134    "The menu before the last `speedbar-reconfigure-keymaps' was called.")    "The menu before the last `speedbar-reconfigure-keymaps' was called.")
1135    
# Line 1413  and the existence of packages." Line 1143  and the existence of packages."
1143                   ;; file display mode version                   ;; file display mode version
1144                   (speedbar-initial-menu)                   (speedbar-initial-menu)
1145                 (save-excursion                 (save-excursion
1146                   (select-frame speedbar-attached-frame)                   (dframe-select-attached-frame speedbar-frame)
1147                   (if (local-variable-p                   (if (local-variable-p
1148                        'speedbar-easymenu-definition-special                        'speedbar-easymenu-definition-special
1149                        (current-buffer))                        (current-buffer))
# Line 1432  and the existence of packages." Line 1162  and the existence of packages."
1162                                      (list                                      (list
1163                                       'speedbar-change-initial-expansion-list                                       'speedbar-change-initial-expansion-list
1164                                       (car (car alist)))                                       (car (car alist)))
1165                                      t)                                      :style 'radio
1166                                        :selected
1167                                        `(string= ,(car (car alist))
1168                                             speedbar-initial-expansion-list-name)
1169                                        )
1170                                     displays))                                     displays))
1171                              (setq alist (cdr alist)))                              (setq alist (cdr alist)))
1172                            displays)))                            displays)))
# Line 1441  and the existence of packages." Line 1175  and the existence of packages."
1175          (localmap (save-excursion          (localmap (save-excursion
1176                      (let ((cf (selected-frame)))                      (let ((cf (selected-frame)))
1177                        (prog2                        (prog2
1178                            (select-frame speedbar-attached-frame)                            (dframe-select-attached-frame speedbar-frame)
1179                            (if (local-variable-p                            (if (local-variable-p
1180                                 'speedbar-special-mode-key-map                                 'speedbar-special-mode-key-map
1181                                 (current-buffer))                                 (current-buffer))
# Line 1458  and the existence of packages." Line 1192  and the existence of packages."
1192        (if speedbar-previous-menu (easy-menu-remove speedbar-previous-menu))        (if speedbar-previous-menu (easy-menu-remove speedbar-previous-menu))
1193        (setq speedbar-previous-menu md)        (setq speedbar-previous-menu md)
1194        ;; Now add the new menu        ;; Now add the new menu
1195        (if (not speedbar-xemacsp)        (if (not dframe-xemacsp)
1196            (easy-menu-define speedbar-menu-map (current-local-map)            (easy-menu-define speedbar-menu-map (current-local-map)
1197                              "Speedbar menu" md)                              "Speedbar menu" md)
1198          (easy-menu-add md (current-local-map))          (easy-menu-add md (current-local-map))
1199          (set-buffer-menubar (list md))))          ;; XEmacs-specific:
1200            (if (fboundp 'set-buffer-menubar)
1201                (set-buffer-menubar (list md)))))
1202    
1203      (run-hooks 'speedbar-reconfigure-keymaps-hook)))      (run-hooks 'speedbar-reconfigure-keymaps-hook)))
1204    
1205    
1206  ;;; User Input stuff  ;;; User Input stuff
1207  ;;  ;;
   
 ;; XEmacs: this can be implemented using modeline keymaps, but there  
 ;; is no use, as we have horizontal scrollbar (as the docstring  
 ;; hints.)  
 (defun speedbar-mouse-hscroll (e)  
   "Read a mouse event E from the mode line, and horizontally scroll.  
 If the mouse is being clicked on the far left, or far right of the  
 mode-line.  This is only useful for non-XEmacs."  
   (interactive "e")  
   (let* ((xp (car (nth 2 (car (cdr e)))))  
          (cpw (/ (frame-pixel-width)  
                  (frame-width)))  
          (oc (1+ (/ xp cpw)))  
          )  
     (cond ((< oc 3)  
            (scroll-left 2))  
           ((> oc (- (window-width) 3))  
            (scroll-right 2))  
           (t (speedbar-message  
               "Click on the edge of the modeline to scroll left/right")))  
     ;;(speedbar-message "X: Pixel %d Char Pixels %d On char %d" xp cpw oc)  
     ))  
   
1208  (defun speedbar-customize ()  (defun speedbar-customize ()
1209    "Customize speedbar using the Custom package."    "Customize speedbar using the Custom package."
1210    (interactive)    (interactive)
1211    (let ((sf (selected-frame)))    (let ((sf (selected-frame)))
1212      (select-frame speedbar-attached-frame)      (dframe-select-attached-frame speedbar-frame)
1213      (customize-group 'speedbar)      (customize-group 'speedbar)
1214      (select-frame sf))      (select-frame sf))
1215    (speedbar-maybee-jump-to-attached-frame))    (dframe-maybee-jump-to-attached-frame))
1216    
1217  (defun speedbar-track-mouse (event)  (defun speedbar-track-mouse (event)
1218    "For motion EVENT, display info about the current line."    "For motion EVENT, display info about the current line."
   (interactive "e")  
1219    (if (not speedbar-track-mouse-flag)    (if (not speedbar-track-mouse-flag)
1220        nil        nil
1221      (save-excursion      (save-excursion
1222        (let ((char (nth 1 (car (cdr event)))))        (save-window-excursion
1223          (if (not (numberp char))          (condition-case nil
1224              (speedbar-message nil)              (progn
1225            (goto-char char)                (mouse-set-point event)
1226            ;; (speedbar-message "%S" event)                (if (eq major-mode 'speedbar-mode)
1227            (speedbar-item-info)                    ;; XEmacs may let us get in here in other mode buffers.
1228            )))))                    (speedbar-item-info)))
1229              (t (speedbar-message nil)))))))
1230    
1231  (defun speedbar-track-mouse-xemacs (event)  (defun speedbar-show-info-under-mouse ()
1232    "For motion EVENT, display info about the current line."    "Call the info function for the line under the mouse.
1233    (if (functionp (default-value 'mouse-motion-handler))  Optional EVENT is currently not used."
1234        (funcall (default-value 'mouse-motion-handler) event))    (let ((pos (mouse-position))) ; we ignore event until I use it later.
1235    (if speedbar-track-mouse-flag      (if (equal (car pos) speedbar-frame)
       (save-excursion  
         (save-window-excursion  
           (condition-case ()  
               (progn (mouse-set-point event)  
                      ;; Prevent focus-related bugs.  
                      (if (eq major-mode 'speedbar-mode)  
                          (speedbar-item-info)))  
             (error nil))))))  
   
 ;; In XEmacs, we make popup menus work on the item over mouse (as  
 ;; opposed to where the point happens to be.)  We attain this by  
 ;; temporarily moving the point to that place.  
 ;;    Hrvoje Niksic <hniksic@srce.hr>  
 (defun speedbar-xemacs-popup-kludge (event)  
   "Pop up a menu related to the clicked on item.  
 Must be bound to EVENT."  
   (interactive "e")  
   (select-frame speedbar-frame)  
   (save-excursion  
     (goto-char (event-closest-point event))  
     (beginning-of-line)  
     (forward-char (min 5 (- (save-excursion (end-of-line) (point))  
                             (save-excursion (beginning-of-line) (point)))))  
     (popup-mode-menu)  
     ;; Wait for menu to bail out.  `popup-mode-menu' (and other popup  
     ;; menu functions) return immediately.  
     (let (new)  
       (while (not (misc-user-event-p (setq new (next-event))))  
         (dispatch-event new))  
       (dispatch-event new))))  
   
 (defun speedbar-emacs-popup-kludge (e)  
   "Pop up a menu related to the clicked on item.  
 Must be bound to event E."  
   (interactive "e")  
   (save-excursion  
     (mouse-set-point e)  
     ;; This gets the cursor where the user can see it.  
     (if (not (bolp)) (forward-char -1))  
     (sit-for 0)  
     (mouse-major-mode-menu e nil)))  
   
 (defun speedbar-hack-buffer-menu (e)  
   "Control mouse 1 is buffer menu.  
 This hack overrides it so that the right thing happens in the main  
 Emacs frame, not in the speedbar frame.  
 Argument E is the event causing this activity."  
   (interactive "e")  
   (let ((fn (lookup-key global-map (if speedbar-xemacsp  
                                               '(control button1)  
                                      [C-down-mouse-1])))  
         (newbuff nil))  
     (unwind-protect  
1236          (save-excursion          (save-excursion
1237            (set-window-dedicated-p (selected-window) nil)            (save-window-excursion
1238            (call-interactively fn)              (apply 'set-mouse-position pos)
1239            (setq newbuff (current-buffer)))              (speedbar-item-info))))))
       (switch-to-buffer speedbar-buffer)  
       (set-window-dedicated-p (selected-window) t))  
     (if (not (eq newbuff speedbar-buffer))  
         (speedbar-with-attached-buffer  
          (switch-to-buffer newbuff)))))  
1240    
1241  (defun speedbar-next (arg)  (defun speedbar-next (arg)
1242    "Move to the next ARGth line in a speedbar buffer."    "Move to the next ARGth line in a speedbar buffer."
# Line 1602  of intermediate nodes are skipped." Line 1258  of intermediate nodes are skipped."
1258    ;; First find the extent for which we are allowed to move.    ;; First find the extent for which we are allowed to move.
1259    (let ((depth (save-excursion (beginning-of-line)    (let ((depth (save-excursion (beginning-of-line)
1260                                 (if (looking-at "[0-9]+:")                                 (if (looking-at "[0-9]+:")
1261                                     (string-to-int (match-string 0))                                     (string-to-number (match-string 0))
1262                                   0)))                                   0)))
1263          (crement (if (< arg 0) 1 -1)) ; decrement or increment          (crement (if (< arg 0) 1 -1))   ; decrement or increment
1264          (lastmatch (point)))          (lastmatch (point)))
1265      (while (/= arg 0)      (while (/= arg 0)
1266        (forward-line (- crement))        (forward-line (- crement))
1267        (let ((subdepth (save-excursion (beginning-of-line)        (let ((subdepth (save-excursion (beginning-of-line)
1268                                 (if (looking-at "[0-9]+:")                                        (if (looking-at "[0-9]+:")
1269                                     (string-to-int (match-string 0))                                            (string-to-number (match-string 0))
1270                                   0))))                                          0))))
1271          (cond ((or (< subdepth depth)          (cond ((or (< subdepth depth)
1272                     (progn (end-of-line) (eobp))                     (progn (end-of-line) (eobp))
1273                     (progn (beginning-of-line) (bobp)))                     (progn (beginning-of-line) (bobp)))
# Line 1632  of intermediate nodes are skipped." Line 1288  of intermediate nodes are skipped."
1288    (speedbar-restricted-move (or arg 1))    (speedbar-restricted-move (or arg 1))
1289    (speedbar-item-info))    (speedbar-item-info))
1290    
   
1291  (defun speedbar-restricted-prev (arg)  (defun speedbar-restricted-prev (arg)
1292    "Move to the previous ARGth line in a speedbar buffer at the same depth.    "Move to the previous ARGth line in a speedbar buffer at the same depth.
1293  This means that movement is restricted to a subnode, and that siblings  This means that movement is restricted to a subnode, and that siblings
# Line 1691  Assumes that the current buffer is the s Line 1346  Assumes that the current buffer is the s
1346    
1347  ;;; Speedbar file activity (aka creeping featurism)  ;;; Speedbar file activity (aka creeping featurism)
1348  ;;  ;;
1349  (defun speedbar-refresh ()  (defun speedbar-refresh (&optional arg)
1350    "Refresh the current speedbar display, disposing of any cached data."    "Refresh the current speedbar display, disposing of any cached data.
1351    (interactive)  Argument ARG represents to force a refresh past any caches that may exist."
1352      (interactive "P")
1353    (let ((dl speedbar-shown-directories)    (let ((dl speedbar-shown-directories)
1354            (dframe-power-click arg)
1355          deactivate-mark)          deactivate-mark)
1356        ;; We need to hack something so this works in detached frames.
1357      (while dl      (while dl
1358        (adelete 'speedbar-directory-contents-alist (car dl))        (adelete 'speedbar-directory-contents-alist (car dl))
1359        (setq dl (cdr dl)))        (setq dl (cdr dl)))
# Line 1704  Assumes that the current buffer is the s Line 1362  Assumes that the current buffer is the s
1362      (speedbar-update-contents)      (speedbar-update-contents)
1363      (speedbar-stealthy-updates)      (speedbar-stealthy-updates)
1364      ;; Reset the timer in case it got really hosed for some reason...      ;; Reset the timer in case it got really hosed for some reason...
1365      (speedbar-set-timer speedbar-update-speed)      (speedbar-set-timer dframe-update-speed)
1366      (if (<= 1 speedbar-verbosity-level)      (if (<= 1 speedbar-verbosity-level)
1367          (speedbar-message "Refreshing speedbar...done"))))          (speedbar-message "Refreshing speedbar...done"))))
1368    
# Line 1727  Assumes that the current buffer is the s Line 1385  Assumes that the current buffer is the s
1385          (sf (selected-frame)))          (sf (selected-frame)))
1386      (if (and (file-exists-p f) (string-match "\\.el\\'" f))      (if (and (file-exists-p f) (string-match "\\.el\\'" f))
1387          (progn          (progn
1388            (select-frame speedbar-attached-frame)            (dframe-select-attached-frame speedbar-frame)
1389            (byte-compile-file f nil)            (byte-compile-file f nil)
1390            (select-frame sf)            (select-frame sf)
1391            (speedbar-reset-scanners)))            (speedbar-reset-scanners)))
# Line 1779  nil if not applicable." Line 1437  nil if not applicable."
1437      (beginning-of-line)      (beginning-of-line)
1438      (if (re-search-forward " [-+=]?> \\([^\n]+\\)"      (if (re-search-forward " [-+=]?> \\([^\n]+\\)"
1439                             (save-excursion(end-of-line)(point)) t)                             (save-excursion(end-of-line)(point)) t)
1440          (let ((tag (match-string 1))         (let* ((tag (match-string 1))
1441                (attr (speedbar-line-token))                (attr (speedbar-line-token))
1442                (item nil))                (item nil)
1443            (if (and (featurep 'semantic) (semantic-token-p attr))                (semantic-tagged (if (fboundp 'semantic-tag-p)
1444                (speedbar-message (semantic-summerize-nonterminal attr))                                     (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                     )))
1454              (looking-at "\\([0-9]+\\):")              (looking-at "\\([0-9]+\\):")
1455              (setq item (file-name-nondirectory (speedbar-line-path)))              (setq item (file-name-nondirectory (speedbar-line-directory)))
1456              (speedbar-message "Tag: %s  in %s" tag item)))              (speedbar-message "Tag: %s  in %s" tag item)))
1457        (if (re-search-forward "{[+-]} \\([^\n]+\\)$"        (if (re-search-forward "{[+-]} \\([^\n]+\\)$"
1458                               (save-excursion(end-of-line)(point)) t)                               (save-excursion(end-of-line)(point)) t)
# Line 1793  nil if not applicable." Line 1460  nil if not applicable."
1460          (if (re-search-forward " [+-]?[()|@] \\([^\n]+\\)$" nil t)          (if (re-search-forward " [+-]?[()|@] \\([^\n]+\\)$" nil t)
1461              (let* ((detailtext (match-string 1))              (let* ((detailtext (match-string 1))
1462                     (detail (or (speedbar-line-token) detailtext))                     (detail (or (speedbar-line-token) detailtext))
1463                    (parent (save-excursion                     (parent (save-excursion
1464                              (beginning-of-line)                               (beginning-of-line)
1465                              (let ((dep (if (looking-at "[0-9]+:")                               (let ((dep (if (looking-at "[0-9]+:")
1466                                             (1- (string-to-int (match-string 0)))                                              (1- (string-to-number (match-string 0)))
1467                                           0)))                                            0)))
1468                                (re-search-backward (concat "^"                                 (re-search-backward (concat "^"
1469                                                             (int-to-string dep)                                 (int-to-string dep)
1470                                                             ":")                                 ":")
1471                                                    nil t))                                                     nil t))
1472                              (if (looking-at "[0-9]+: +[-+=>]> \\([^\n]+\\)$")                               (if (looking-at "[0-9]+: +[-+=>]> \\([^\n]+\\)$")
1473                                  (speedbar-line-token)                                   (speedbar-line-token)
1474                                nil))))                                 nil))))
1475                (if (and (featurep 'semantic) (semantic-token-p detail))                (if (featurep 'semantic)
1476                    (speedbar-message                    (with-no-warnings
1477                     (semantic-summerize-nonterminal detail parent))                      (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':
1487                  (if parent                  (if parent
1488                      (speedbar-message "Detail: %s of tag %s" detail                      (speedbar-message "Detail: %s of tag %s" detail parent)
                                       (if (and (featurep 'semantic)  
                                                (semantic-token-p parent))  
                                           (semantic-token-name parent)  
                                         parent))  
1489                    (speedbar-message "Detail: %s" detail))))                    (speedbar-message "Detail: %s" detail))))
1490            nil)))))            nil)))))
1491    
# Line 1845  Files can be copied to new names or plac Line 1517  Files can be copied to new names or plac
1517                            (if (string-match "[/\\]$" rt) "" "/")                            (if (string-match "[/\\]$" rt) "" "/")
1518                            (file-name-nondirectory f))))                            (file-name-nondirectory f))))
1519          (if (or (not (file-exists-p rt))          (if (or (not (file-exists-p rt))
1520                  (speedbar-y-or-n-p (format "Overwrite %s with %s? " rt f)))                  (speedbar-y-or-n-p (format "Overwrite %s with %s? " rt f)
1521                                       t))
1522              (progn              (progn
1523                (copy-file f rt t t)                (copy-file f rt t t)
1524                ;; refresh display if the new place is currently displayed.                ;; refresh display if the new place is currently displayed.
# Line 1874  Files can be renamed to new names or mov Line 1547  Files can be renamed to new names or mov
1547                              (if (string-match "[/\\]\\'" rt) "" "/")                              (if (string-match "[/\\]\\'" rt) "" "/")
1548                              (file-name-nondirectory f))))                              (file-name-nondirectory f))))
1549            (if (or (not (file-exists-p rt))            (if (or (not (file-exists-p rt))
1550                    (speedbar-y-or-n-p (format "Overwrite %s with %s? " rt f)))                    (speedbar-y-or-n-p (format "Overwrite %s with %s? " rt f)
1551                                         t))
1552                (progn                (progn
1553                  (rename-file f rt t)                  (rename-file f rt t)
1554                  ;; refresh display if the new place is currently displayed.                  ;; refresh display if the new place is currently displayed.
# Line 1885  Files can be renamed to new names or mov Line 1559  Files can be renamed to new names or mov
1559                        )))))                        )))))
1560        (error "Not a file"))))        (error "Not a file"))))
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    
1577  (defun speedbar-item-delete ()  (defun speedbar-item-delete ()
1578    "Delete the item under the cursor.  Files are removed from disk."    "Delete the item under the cursor.  Files are removed from disk."
1579    (interactive)    (interactive)
1580    (let ((f (speedbar-line-file)))    (let ((f (speedbar-line-file)))
1581      (if (not f) (error "Not a file"))      (if (not f) (error "Not a file"))
1582      (if (speedbar-y-or-n-p (format "Delete %s? " f))      (if (speedbar-y-or-n-p (format "Delete %s? " f) t)
1583          (progn          (progn
1584            (if (file-directory-p f)            (if (file-directory-p f)
1585                (delete-directory f)                (delete-directory f)
# Line 1915  variable `speedbar-obj-alist'." Line 1604  variable `speedbar-obj-alist'."
1604        (setq oa (cdr oa)))        (setq oa (cdr oa)))
1605      (setq obj (concat (file-name-sans-extension f) (cdr (car oa))))      (setq obj (concat (file-name-sans-extension f) (cdr (car oa))))
1606      (if (and oa (file-exists-p obj)      (if (and oa (file-exists-p obj)
1607               (speedbar-y-or-n-p (format "Delete %s? " obj)))               (speedbar-y-or-n-p (format "Delete %s? " obj) t))
1608          (progn          (progn
1609            (delete-file obj)            (delete-file obj)
1610            (speedbar-reset-scanners)))))            (speedbar-reset-scanners)))))
# Line 1925  variable `speedbar-obj-alist'." Line 1614  variable `speedbar-obj-alist'."
1614    (interactive)    (interactive)
1615    (setq speedbar-update-flag t)    (setq speedbar-update-flag t)
1616    (speedbar-set-mode-line-format)    (speedbar-set-mode-line-format)
1617    (speedbar-set-timer speedbar-update-speed))    (speedbar-set-timer dframe-update-speed))
1618    
1619  (defun speedbar-disable-update ()  (defun speedbar-disable-update ()
1620    "Disable automatic updating and stop consuming resources."    "Disable automatic updating and stop consuming resources."
# Line 1942  variable `speedbar-obj-alist'." Line 1631  variable `speedbar-obj-alist'."
1631      (speedbar-enable-update)))      (speedbar-enable-update)))
1632    
1633  (defun speedbar-toggle-images ()  (defun speedbar-toggle-images ()
1634    "Toggle images for the speedbar frame."    "Toggle use of images in the speedbar frame.
1635    Images are not available in Emacs 20 or earlier."
1636    (interactive)    (interactive)
1637    (setq speedbar-use-images (not speedbar-use-images))    (setq speedbar-use-images (not speedbar-use-images))
1638    (speedbar-refresh))    (speedbar-refresh))
1639    
1640  (defun speedbar-toggle-sorting ()  (defun speedbar-toggle-sorting ()
1641    "Toggle sorting for the speedbar frame."    "Toggle tag sorting."
1642    (interactive)    (interactive)
1643    (setq speedbar-sort-tags (not speedbar-sort-tags)))    (setq speedbar-sort-tags (not speedbar-sort-tags)))
1644    
# Line 1957  variable `speedbar-obj-alist'." Line 1647  variable `speedbar-obj-alist'."
1647    (interactive)    (interactive)
1648    (setq speedbar-show-unknown-files (not speedbar-show-unknown-files))    (setq speedbar-show-unknown-files (not speedbar-show-unknown-files))
1649    (speedbar-refresh))    (speedbar-refresh))
   
 ;;; Utility functions  
 ;;  
 (defun speedbar-set-timer (timeout)  
   "Apply a timer with TIMEOUT, or remove a timer if TIMEOUT is nil.  
 TIMEOUT is the number of seconds until the speedbar timer is called  
 again.  When TIMEOUT is nil, turn off all timeouts.  
 This function will also enable or disable the `vc-checkin-hook' used  
 to track file check ins, and will change the mode line to match  
 `speedbar-update-flag'."  
   (cond  
    ;; XEmacs  
    (speedbar-xemacsp  
     (if speedbar-timer  
         (progn (delete-itimer speedbar-timer)  
                (setq speedbar-timer nil)))  
     (if timeout  
         (if (and speedbar-xemacsp  
                  (or (>= emacs-major-version 20)  
                      (>= emacs-minor-version 15)))  
             (setq speedbar-timer (start-itimer "speedbar"  
                                                'speedbar-timer-fn  
                                                timeout  
                                                timeout  
                                                t))  
           (setq speedbar-timer (start-itimer "speedbar"  
                                              'speedbar-timer-fn  
                                              timeout  
                                              nil)))))  
    ;; Post 19.31 Emacs  
    ((fboundp 'run-with-idle-timer)  
     (if speedbar-timer  
         (progn (cancel-timer speedbar-timer)  
                (setq speedbar-timer nil)))  
     (if timeout  
         (setq speedbar-timer  
               (run-with-idle-timer timeout t 'speedbar-timer-fn))))  
    ;; Emacs 19.30 (Thanks twice: ptype@dra.hmg.gb)  
    ((fboundp 'post-command-idle-hook)  
     (if timeout  
         (add-hook 'post-command-idle-hook 'speedbar-timer-fn)  
       (remove-hook 'post-command-idle-hook 'speedbar-timer-fn)))  
    ;; Older or other Emacsen with no timers.  Set up so that its  
    ;; obvious this emacs can't handle the updates  
    (t  
     (setq speedbar-update-flag nil)))  
   ;; Apply a revert hook that will reset the scanners.  We attach to revert  
   ;; because most reverts occur during VC state change, and this lets our  
   ;; VC scanner fix itself.  
   (if timeout  
       (add-hook 'after-revert-hook 'speedbar-reset-scanners)  
     (remove-hook 'after-revert-hook 'speedbar-reset-scanners)  
     )  
   ;; change this if it changed for some reason  
   (speedbar-set-mode-line-format))  
1650    
1651  (defmacro speedbar-with-writable (&rest forms)  (defmacro speedbar-with-writable (&rest forms)
1652    "Allow the buffer to be writable and evaluate FORMS."    "Allow the buffer to be writable and evaluate FORMS."
# Line 2019  to track file check ins, and will change Line 1654  to track file check ins, and will change
1654          (cons 'progn forms)))          (cons 'progn forms)))
1655  (put 'speedbar-with-writable 'lisp-indent-function 0)  (put 'speedbar-with-writable 'lisp-indent-function 0)
1656    
 (defun speedbar-select-window (buffer)  
   "Select a window in which BUFFER is shown.  
 If it is not shown, force it to appear in the default window."  
   (let ((win (get-buffer-window buffer speedbar-attached-frame)))  
     (if win  
         (select-window win)  
       (set-window-buffer (selected-window) buffer))))  
   
1657  (defun speedbar-insert-button (text face mouse function  (defun speedbar-insert-button (text face mouse function
1658                                      &optional token prevline)                                      &optional token prevline)
1659    "Insert TEXT as the next logical speedbar button.    "Insert TEXT as the next logical speedbar button.
# Line 2053  specialized speedbar displays." Line 1680  specialized speedbar displays."
1680      (put-text-property start (point) 'invisible nil)      (put-text-property start (point) 'invisible nil)
1681      (put-text-property start (point) 'mouse-face nil)))      (put-text-property start (point) 'mouse-face nil)))
1682    
1683    (defun speedbar-insert-separator (text)
1684      "Insert a separation label of TEXT.
1685    Separators are not active, have no labels, depth, or actions."
1686      (if speedbar-use-images
1687          (let ((start (point)))
1688            (insert "//")
1689            (speedbar-insert-image-button-maybe start 2)))
1690      (let ((start (point)))
1691        (insert text "\n")
1692        (speedbar-make-button start (point)
1693                              'speedbar-separator-face
1694                              nil nil nil)))
1695    
1696  (defun speedbar-make-button (start end face mouse function &optional token)  (defun speedbar-make-button (start end face mouse function &optional token)
1697    "Create a button from START to END, with FACE as the display face.    "Create a button from START to END, with FACE as the display face.
1698  MOUSE is the mouse face.  When this button is clicked on FUNCTION  MOUSE is the mouse face.  When this button is clicked on FUNCTION
1699  will be run with the TOKEN parameter (any Lisp object)."  will be run with the TOKEN parameter (any Lisp object)"
1700    (put-text-property start end 'face face)    (put-text-property start end 'face face)
1701    (put-text-property start end 'mouse-face mouse)    (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))
1704    (put-text-property start end 'invisible nil)    (put-text-property start end 'invisible nil)
1705      (put-text-property start end 'speedbar-text
1706                         (buffer-substring-no-properties start end))
1707    (if function (put-text-property start end 'speedbar-function function))    (if function (put-text-property start end 'speedbar-function function))
1708    (if token (put-text-property start end 'speedbar-token token))    (if token (put-text-property start end 'speedbar-token token))
1709    ;; So far the only text we have is less that 3 chars.    ;; So far the only text we have is less that 3 chars.
# Line 2116  This is based on `speedbar-initial-expan Line 1760  This is based on `speedbar-initial-expan
1760    (setq speedbar-previously-used-expansion-list-name    (setq speedbar-previously-used-expansion-list-name
1761          speedbar-initial-expansion-list-name          speedbar-initial-expansion-list-name
1762          speedbar-initial-expansion-list-name new-default)          speedbar-initial-expansion-list-name new-default)
1763    (speedbar-refresh)    (if (and (speedbar-current-frame) (frame-live-p (speedbar-current-frame)))
1764    (speedbar-reconfigure-keymaps))        (progn
1765            (speedbar-refresh)
1766            (speedbar-reconfigure-keymaps))))
1767    
1768  (defun speedbar-fetch-replacement-function (function)  (defun speedbar-fetch-replacement-function (function)
1769    "Return a current mode specific replacement for function, or nil.    "Return a current mode specific replacement for function, or nil.
# Line 2199  the file-system." Line 1845  the file-system."
1845    (setq directory (expand-file-name directory))    (setq directory (expand-file-name directory))
1846    ;; If in powerclick mode, then the directory we are getting    ;; If in powerclick mode, then the directory we are getting
1847    ;; should be rescanned.    ;; should be rescanned.
1848    (if speedbar-power-click    (if dframe-power-click
1849        (adelete 'speedbar-directory-contents-alist directory))        (adelete 'speedbar-directory-contents-alist directory))
1850    ;; find the directory, either in the cache, or build it.    ;; find the directory, either in the cache, or build it.
1851    (or (cdr-safe (assoc directory speedbar-directory-contents-alist))    (or (cdr-safe (assoc directory speedbar-directory-contents-alist))
1852        (let ((default-directory directory)        (let ((default-directory directory)
1853              (case-fold-search read-file-name-completion-ignore-case)              (dir (directory-files directory nil))
1854              dirs files)              (dirs nil)
1855          (dolist (file (directory-files directory nil))              (files nil))
1856            (or (string-match speedbar-file-unshown-regexp file)          (while dir
1857                (string-match speedbar-directory-unshown-regexp file)            (if (not
1858                (if (file-directory-p file)                 (or (string-match speedbar-file-unshown-regexp (car dir))
1859                    (setq dirs (cons file dirs))                     (string-match speedbar-directory-unshown-regexp (car dir))))
1860                  (setq files (cons file files)))))                (if (file-directory-p (car dir))
1861          (let ((nl `(,(nreverse dirs) ,(nreverse files))))                    (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)))))
1865            (aput 'speedbar-directory-contents-alist directory nl)            (aput 'speedbar-directory-contents-alist directory nl)
1866            nl))))            nl))
1867          ))
1868    
1869  (defun speedbar-directory-buttons (directory index)  (defun speedbar-directory-buttons (directory index)
1870    "Insert a single button group at point for DIRECTORY.    "Insert a single button group at point for DIRECTORY.
1871  Each directory path part is a different button.  If part of the path  Each directory directory part is a different button.  If part of the directory
1872  matches the user directory ~, then it is replaced with a ~.  matches the user directory ~, then it is replaced with a ~.
1873  INDEX is not used, but is required by the caller."  INDEX is not used, but is required by the caller."
1874    (let* ((tilde (expand-file-name "~/"))    (let* ((tilde (expand-file-name "~/"))
# Line 2294  INDEX is not used, but is required by th Line 1944  INDEX is not used, but is required by th
1944  This is the button that expands or contracts a node (if applicable),  This is the button that expands or contracts a node (if applicable),
1945  and EXP-BUTTON-CHAR the character in it (+, -, ?, etc).  EXP-BUTTON-FUNCTION  and EXP-BUTTON-CHAR the character in it (+, -, ?, etc).  EXP-BUTTON-FUNCTION
1946  is the function to call if it's clicked on.  Button types are  is the function to call if it's clicked on.  Button types are
1947  'bracket, 'angle, 'curly, or nil.  EXP-BUTTON-DATA is extra data  'bracket, 'angle, 'curly, 'expandtag, 'statictag, t, or nil.
1948  attached to the text forming the expansion button.  EXP-BUTTON-DATA is extra data attached to the text forming the expansion
1949    button.
1950    
1951  Next, TAG-BUTTON is the text of the tag.  TAG-BUTTON-FUNCTION is the  Next, TAG-BUTTON is the text of the tag.  TAG-BUTTON-FUNCTION is the
1952  function to call if clicked on, and TAG-BUTTON-DATA is the data to  function to call if clicked on, and TAG-BUTTON-DATA is the data to
# Line 2317  position to insert a new item, and that Line 1968  position to insert a new item, and that
1968      (let* ((exp-button (cond ((eq exp-button-type 'bracket) "[%c]")      (let* ((exp-button (cond ((eq exp-button-type 'bracket) "[%c]")
1969                               ((eq exp-button-type 'angle) "<%c>")                               ((eq exp-button-type 'angle) "<%c>")
1970                               ((eq exp-button-type 'curly) "{%c}")                               ((eq exp-button-type 'curly) "{%c}")
1971                                 ((eq exp-button-type 'expandtag) " %c>")
1972                                 ((eq exp-button-type 'statictag) " =>")
1973                               (t ">")))                               (t ">")))
1974             (buttxt (format exp-button exp-button-char))             (buttxt (format exp-button exp-button-char))
1975             (start (point))             (start (point))
1976             (end (progn (insert buttxt) (point)))             (end (progn (insert buttxt) (point)))
1977             (bf (if exp-button-type 'speedbar-button-face nil))             (bf (if (and exp-button-type (not (eq exp-button-type 'statictag)))
1978                       'speedbar-button-face nil))
1979             (mf (if exp-button-function 'speedbar-highlight-face nil))             (mf (if exp-button-function 'speedbar-highlight-face nil))
1980             )             )
1981        (speedbar-make-button start end bf mf exp-button-function exp-button-data)        (speedbar-make-button start end bf mf exp-button-function exp-button-data)
# Line 2340  position to insert a new item, and that Line 1994  position to insert a new item, and that
1994                              (if tag-button-function 'speedbar-highlight-face nil)                              (if tag-button-function 'speedbar-highlight-face nil)
1995                              tag-button-function tag-button-data))                              tag-button-function tag-button-data))
1996      ))      ))
1997      
1998  (defun speedbar-change-expand-button-char (char)  (defun speedbar-change-expand-button-char (char)
1999    "Change the expansion button character to CHAR for the current line."    "Change the expansion button character to CHAR for the current line."
2000    (save-excursion    (save-excursion
# Line 2348  position to insert a new item, and that Line 2002  position to insert a new item, and that
2002      (if (re-search-forward ":\\s-*.\\([-+?]\\)" (save-excursion (end-of-line)      (if (re-search-forward ":\\s-*.\\([-+?]\\)" (save-excursion (end-of-line)
2003                                                                  (point)) t)                                                                  (point)) t)
2004          (speedbar-with-writable          (speedbar-with-writable
2005            (goto-char (match-beginning 1))            (goto-char (match-end 1))
           (delete-char 1)  
2006            (insert-char char 1 t)            (insert-char char 1 t)
2007            (put-text-property (point) (1- (point)) 'invisible nil)            (forward-char -1)
2008              (delete-char -1)
2009              ;;(put-text-property (point) (1- (point)) 'invisible nil)
2010            ;; make sure we fix the image on the text here.            ;; make sure we fix the image on the text here.
2011            (speedbar-insert-image-button-maybe (- (point) 2) 3)))))            (speedbar-insert-image-button-maybe (- (point) 1) 3)))))
2012    
2013    
2014  ;;; Build button lists  ;;; Build button lists
2015  ;;  ;;
2016  (defun speedbar-insert-files-at-point (files level directory)  (defun speedbar-insert-files-at-point (files level)
2017    "Insert list of FILES starting at point, and indenting all files to LEVEL.    "Insert list of FILES starting at point, and indenting all files to LEVEL.
2018  Tag expandable items with a +, otherwise a ?.  Don't highlight ? as we  Tag expandable items with a +, otherwise a ?.  Don't highlight ? as we
2019  don't know how to manage them.  The input parameter FILES is a cons  don't know how to manage them.  The input parameter FILES is a cons
2020  cell of the form ( 'DIRLIST .  'FILELIST )."  cell of the form ( 'DIRLIST .  'FILELIST )."
2021    ;; Start inserting all the directories    ;; Start inserting all the directories
2022    (dolist (dir (car files))    (let ((dirs (car files)))
2023      (if (if speedbar-scan-subdirs      (while dirs
2024              (condition-case nil        (speedbar-make-tag-line 'angle ?+ 'speedbar-dired (car dirs)
2025                  (let ((l (speedbar-file-lists (concat directory dir))))                                (car dirs) 'speedbar-dir-follow nil
2026                    (or (car l) (cadr l)))                                'speedbar-directory-face level)
2027                (file-error))        (setq dirs (cdr dirs))))
2028            (file-readable-p (concat directory dir)))    (let ((lst (car (cdr files)))
2029          (speedbar-make-tag-line 'angle ?+ 'speedbar-dired dir          (case-fold-search t))
2030                                  dir 'speedbar-dir-follow nil      (while lst
2031                                  'speedbar-directory-face level)        (let* ((known (string-match speedbar-file-regexp (car lst)))
       (speedbar-make-tag-line 'angle ?  nil dir  
                               dir 'speedbar-dir-follow nil  
                               'speedbar-directory-face level)))  
   (let ((case-fold-search read-file-name-completion-ignore-case))  
     (dolist (file (cadr files))  
       (let* ((known (and (file-readable-p (concat directory file))  
                          (string-match speedbar-file-regexp file)))  
2032               (expchar (if known ?+ ??))               (expchar (if known ?+ ??))
2033               (fn (if known 'speedbar-tag-file nil)))               (fn (if known 'speedbar-tag-file nil)))
2034          (if (or speedbar-show-unknown-files (/= expchar ??))          (if (or speedbar-show-unknown-files (/= expchar ??))
2035              (speedbar-make-tag-line 'bracket expchar fn file              (speedbar-make-tag-line 'bracket expchar fn (car lst)
2036                                      file 'speedbar-find-file nil                                      (car lst) 'speedbar-find-file nil
2037                                      'speedbar-file-face level))))))                                      'speedbar-file-face level)))
2038          (setq lst (cdr lst)))))
2039    
2040  (defun speedbar-default-directory-list (directory index)  (defun speedbar-default-directory-list (directory index)
2041    "Insert files for DIRECTORY with level INDEX at point."    "Insert files for DIRECTORY with level INDEX at point."
2042    (speedbar-insert-files-at-point    (speedbar-insert-files-at-point
2043     (speedbar-file-lists directory) index directory)     (speedbar-file-lists directory) index)
2044    (speedbar-reset-scanners)    (speedbar-reset-scanners)
2045    (if (= index 0)    (if (= index 0)
2046        ;; If the shown files variable has extra directories, then        ;; If the shown files variable has extra directories, then
# Line 2412  cell of the form ( 'DIRLIST .  'FILELIST Line 2061  cell of the form ( 'DIRLIST .  'FILELIST
2061                        (speedbar-do-function-pointer)))))                        (speedbar-do-function-pointer)))))
2062            (setq sf (cdr sf)))            (setq sf (cdr sf)))
2063          )))          )))
2064    ;;; Generic List support
2065    ;;
2066    ;;  Generic lists are hierarchies of tags which we may need to permute
2067    ;;  in order to make it look nice.
2068    ;;
2069    ;;  A generic list is of the form:
2070    ;;  ( ("name" . marker-or-number)              <-- one tag at this level
2071    ;;    ("name" ("name" . mon) ("name" . mon) )  <-- one group of tags
2072    ;;    ("name" mon ("name" . mon) )             <-- group w/ a position and tags
2073    (defun speedbar-generic-list-group-p (sublst)
2074      "Non-nil if SUBLST is a group.
2075    Groups may optionally contain a position."
2076      (and (stringp (car-safe sublst))
2077           (or (and (listp (cdr-safe sublst))
2078                    (or (speedbar-generic-list-tag-p (car-safe (cdr-safe sublst)))
2079                        (speedbar-generic-list-group-p (car-safe (cdr-safe sublst))
2080                                                       )))
2081               (and (number-or-marker-p (car-safe (cdr-safe sublst)))
2082                    (listp (cdr-safe (cdr-safe sublst)))
2083                    (speedbar-generic-list-tag-p
2084                     (car-safe (cdr-safe (cdr-safe sublst)))))
2085               )))
2086    
2087    (defun speedbar-generic-list-positioned-group-p (sublst)
2088      "Non-nil of SUBLST is a group with a position."
2089      (and (stringp (car-safe sublst))
2090           (number-or-marker-p (car-safe (cdr-safe sublst)))
2091           (listp (cdr-safe (cdr-safe sublst)))
2092           (let ((rest (car-safe (cdr-safe (cdr-safe sublst)))))
2093             (or (speedbar-generic-list-tag-p rest)
2094                 (speedbar-generic-list-group-p rest)
2095                 (speedbar-generic-list-positioned-group-p rest)
2096                 ))))
2097    
2098    (defun speedbar-generic-list-tag-p (sublst)
2099      "Non nil if SUBLST is a tag."
2100      (and (stringp (car-safe sublst))
2101           (or (and (number-or-marker-p (cdr-safe sublst))
2102                    (not (cdr-safe (cdr-safe sublst))))
2103               ;; For semantic/bovine items, this is needed
2104               (symbolp (car-safe (cdr-safe sublst))))
2105           ))
2106    
2107  (defun speedbar-sort-tag-hierarchy (lst)  (defun speedbar-sort-tag-hierarchy (lst)
2108    "Sort all elements of tag hierarchy LST."    "Sort all elements of tag hierarchy LST."
2109    (sort (copy-alist lst)    (sort (copy-alist lst)
2110          (lambda (a b) (string< (car a) (car b)))))          (lambda (a b) (string< (car a) (car b)))))
2111    
2112    (defun speedbar-try-completion (string alist)
2113      "A wrapper for `try-completion'.
2114    Passes STRING and ALIST to `try-completion' if ALIST
2115    passes some tests."
2116      (if (and (listp alist) (not (null alist))
2117               (listp (car alist)) (stringp (car (car alist))))
2118          (try-completion string alist)
2119        nil))
2120    
2121  (defun speedbar-prefix-group-tag-hierarchy (lst)  (defun speedbar-prefix-group-tag-hierarchy (lst)
2122    "Prefix group names for tag hierarchy LST."    "Prefix group names for tag hierarchy LST."
2123    (let ((newlst nil)    (let ((newlst nil)
# Line 2430  cell of the form ( 'DIRLIST .  'FILELIST Line 2130  cell of the form ( 'DIRLIST .  'FILELIST
2130          (num-shorts-grouped 0)          (num-shorts-grouped 0)
2131          (bins (make-vector 256 nil))          (bins (make-vector 256 nil))
2132          (diff-idx 0))          (diff-idx 0))
2133      ;; Break out sub-lists      (if (<= (length lst) speedbar-tag-regroup-maximum-length)
2134      (while lst          ;; Do nothing.  Too short to bother with.
2135        (if (and (listp (cdr-safe (car-safe lst)))          lst
2136                 ;; This one is for bovine tokens        ;; Break out sub-lists
2137                 (not (symbolp (car-safe (cdr-safe (car-safe lst))))))        (while lst
2138            (setq newlst (cons (car lst) newlst))          (if (speedbar-generic-list-group-p (car-safe lst))
2139          (setq sublst (cons (car lst) sublst)))              (setq newlst (cons (car lst) newlst))
2140        (setq lst (cdr lst)))            (setq sublst (cons (car lst) sublst)))
2141      ;; Reverse newlst because it was made backwards.          (setq lst (cdr lst)))
2142      ;; Sublist doesn't need reversing because the act        ;; Reverse newlst because it was made backwards.
2143      ;; of binning things will reverse it for us.        ;; Sublist doesn't need reversing because the act
2144      (setq newlst (nreverse newlst))        ;; of binning things will reverse it for us.
2145      ;; Now, first find out how long our list is.  Never let a        (setq newlst (nreverse newlst)
2146      ;; list get-shorter than our minimum.              sublst sublst)
2147      (if (<= (length sublst) speedbar-tag-split-minimum-length)        ;; Now, first find out how long our list is.  Never let a
2148          (setq work-list (nreverse sublst))        ;; list get-shorter than our minimum.
2149        (setq diff-idx (length (try-completion "" sublst)))        (if (<= (length sublst) speedbar-tag-split-minimum-length)
2150        ;; Sort the whole list into bins.            (setq work-list sublst)
2151        (while sublst          (setq diff-idx (length (speedbar-try-completion "" sublst)))
2152          (let ((e (car sublst))          ;; Sort the whole list into bins.
2153                (s (car (car sublst))))          (while sublst
2154            (cond ((<= (length s) diff-idx)            (let ((e (car sublst))
2155                   ;; 0 storage bin for shorty.                  (s (car (car sublst))))
2156                   (aset bins 0 (cons e (aref bins 0))))              (cond ((<= (length s) diff-idx)
2157                  (t                     ;; 0 storage bin for shorty.
2158                   ;; stuff into a bin based on ascii value at diff                     (aset bins 0 (cons e (aref bins 0))))
2159                   (aset bins (aref s diff-idx)                    (t
2160                         (cons e (aref bins (aref s diff-idx)))))))                     ;; stuff into a bin based on ascii value at diff
2161          (setq sublst (cdr sublst)))                     (aset bins (aref s diff-idx)
2162        ;; Go through all our bins  Stick singles into our                           (cons e (aref bins (aref s diff-idx)))))))
2163        ;; junk-list, everything else as sublsts in work-list.            (setq sublst (cdr sublst)))
2164        ;; If two neighboring lists are both small, make a grouped          ;; Go through all our bins  Stick singles into our
2165        ;; group combinding those two sub-lists.          ;; junk-list, everything else as sublsts in work-list.
2166        (setq diff-idx 0)          ;; If two neighboring lists are both small, make a grouped
2167        (while (> 256 diff-idx)          ;; group combinding those two sub-lists.
2168          (let ((l (nreverse;; Reverse the list since they are stuck in          (setq diff-idx 0)
2169                    ;; backwards.          (while (> 256 diff-idx)
2170                    (aref bins diff-idx))))            ;; The bins contents are currently in forward order.
2171            (if l            (let ((l (aref bins diff-idx)))
2172                (let ((tmp (cons (try-completion "" l) l)))              (if l
2173                  (if (or (> (length l) speedbar-tag-regroup-maximum-length)                  (let ((tmp (cons (speedbar-try-completion "" l) l)))
2174                          (> (+ (length l) (length short-group-list))                    (if (or (> (length l) speedbar-tag-regroup-maximum-length)
2175                             speedbar-tag-split-minimum-length))                            (> (+ (length l) (length short-group-list))
2176                      (progn                               speedbar-tag-split-minimum-length))
2177                        ;; We have reached a longer list, so we                        (progn
2178                        ;; must finish off a grouped group.                          ;; We have reached a longer list, so we
2179                        (cond                          ;; must finish off a grouped group.
2180                         ((and short-group-list                          (cond
2181                               (= (length short-group-list)                           ((and short-group-list
2182                                  num-shorts-grouped))                                 (= (length short-group-list)
2183                          ;; All singles?  Junk list                                    num-shorts-grouped))
2184                          (setq junk-list (append short-group-list                            ;; All singles?  Junk list
2185                                                  junk-list)))                            (setq junk-list (append (nreverse short-group-list)
2186                         ((= num-shorts-grouped 1)                                                    junk-list)))
2187                          ;; Only one short group?  Just stick it in                           ((= num-shorts-grouped 1)
2188                          ;; there by itself.  Make a group, and find                            ;; Only one short group?  Just stick it in
2189                          ;; a subexpression                            ;; there by itself.  Make a group, and find
2190                          (let ((subexpression (try-completion                            ;; a subexpression
2191                                                "" short-group-list)))                            (let ((subexpression (speedbar-try-completion
2192                            (if (< (length subexpression)                                                  "" short-group-list)))
2193                                   speedbar-tag-group-name-minimum-length)                              (if (< (length subexpression)
2194                                (setq subexpression                                     speedbar-tag-group-name-minimum-length)
2195                                      (concat short-start-name                                  (setq subexpression
2196                                              " ("                                        (concat short-start-name
2197                                              (substring                                                " ("
2198                                               (car (car short-group-list))                                                (substring
2199                                               (length short-start-name))                                                 (car (car short-group-list))
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.
2210                            (setq work-list                            (setq work-list
2211                                  (cons (cons subexpression                                  (cons (cons (concat short-start-name
2212                                                        " to "
2213                                                        short-end-name)
2214                                              short-group-list)                                              short-group-list)
2215                                        work-list))))                                        work-list))))
2216                         (short-group-list                       ;; Reset short group list information every time.
2217                          ;; Multiple groups to be named in a special                          (setq short-group-list nil
2218                          ;; way by displaying the range over which we                                short-start-name nil
2219                          ;; have grouped them.                                short-end-name nil
2220                          (setq work-list                                num-shorts-grouped 0)))
2221                                (cons (cons (concat short-start-name                    ;; Ok, now that we cleaned up the short-group-list,
2222                                                    " to "                    ;; we can deal with this new list, to decide if it
2223                                                    short-end-name)                    ;; should go on one of these sub-lists or not.
2224                                            (nreverse short-group-list))                    (if (< (length l) speedbar-tag-regroup-maximum-length)
2225                                      work-list))))                        (setq short-group-list (append l short-group-list)
2226                        ;; Reset short group list information every time.                              num-shorts-grouped (1+ num-shorts-grouped)
2227                        (setq short-group-list nil                              short-end-name (car tmp)
2228                              short-start-name nil                              short-start-name (if short-start-name
2229                              short-end-name nil                                                   short-start-name
2230                              num-shorts-grouped 0)))                                                 (car tmp)))
2231                  ;; Ok, now that we cleaned up the short-group-list,                      (setq work-list (cons tmp work-list))))))
2232                  ;; we can deal with this new list, to decide if it            (setq diff-idx (1+ diff-idx))))
2233                  ;; should go on one of these sub-lists or not.        ;; Did we run out of things?  Drop our new list onto the end.
2234                  (if (< (length l) speedbar-tag-regroup-maximum-length)        (cond
2235                      (setq short-group-list (append short-group-list l)         ((and short-group-list (= (length short-group-list) num-shorts-grouped))
2236                            num-shorts-grouped (1+ num-shorts-grouped)          ;; All singles?  Junk list
2237                            short-end-name (car tmp)          (setq junk-list (append short-group-list junk-list)))
2238                            short-start-name (if short-start-name         ((= num-shorts-grouped 1)
2239                                                 short-start-name          ;; Only one short group?  Just stick it in
2240                                               (car tmp)))          ;; there by itself.
2241                    (setq work-list (cons tmp work-list))))))          (setq work-list
2242          (setq diff-idx (1+ diff-idx))))                (cons (cons (speedbar-try-completion "" short-group-list)
2243      ;; Did we run out of things?  Drop our new list onto the end.                            short-group-list)
2244      (cond                      work-list)))
2245       ((and short-group-list (= (length short-group-list) num-shorts-grouped))         (short-group-list
2246        ;; All singles?  Junk list          ;; Multiple groups to be named in a special
2247        (setq junk-list (append short-group-list junk-list)))          ;; way by displaying the range over which we
2248       ((= num-shorts-grouped 1)          ;; have grouped them.
2249        ;; Only one short group?  Just stick it in          (setq work-list
2250        ;; there by itself.                (cons (cons (concat short-start-name " to " short-end-name)
2251        (setq work-list                            short-group-list)
2252              (cons (cons (try-completion "" short-group-list)                      work-list))))
2253                          short-group-list)        ;; Reverse the work list nreversed when consing.
2254                    work-list)))        (setq work-list (nreverse work-list))
2255       (short-group-list        ;; Now, stick our new list onto the end of
2256        ;; Multiple groups to be named in a special        (if work-list
2257        ;; way by displaying the range over which we            (if junk-list
2258        ;; have grouped them.                (append newlst work-list junk-list)
2259        (setq work-list              (append newlst work-list))
2260              (cons (cons (concat short-start-name " to " short-end-name)          (append  newlst junk-list)))))
                         short-group-list)  
                   work-list))))  
     ;; Reverse the work list nreversed when consing.  
     (setq work-list (nreverse work-list))  
     ;; Now, stick our new list onto the end of  
     (if work-list  
         (if junk-list  
             (append newlst work-list junk-list)  
           (append newlst work-list))  
       (append  newlst junk-list))))  
2261    
2262  (defun speedbar-trim-words-tag-hierarchy (lst)  (defun speedbar-trim-words-tag-hierarchy (lst)
2263    "Trim all words in a tag hierarchy.    "Trim all words in a tag hierarchy.
# Line 2568  Argument LST is the list of tags to trim Line 2269  Argument LST is the list of tags to trim
2269          (trim-chars 0)          (trim-chars 0)
2270          (trimlst nil))          (trimlst nil))
2271      (while lst      (while lst
2272        (if (listp (cdr-safe (car-safe lst)))        (if (speedbar-generic-list-group-p (car-safe lst))
2273            (setq newlst (cons (car lst) newlst))            (setq newlst (cons (car lst) newlst))
2274          (setq sublst (cons (car lst) sublst)))          (setq sublst (cons (car lst) sublst)))
2275        (setq lst (cdr lst)))        (setq lst (cdr lst)))
2276      ;; Get the prefix to trim by.  Make sure that we don't trim      ;; Get the prefix to trim by.  Make sure that we don't trim
2277      ;; off silly pieces, only complete understandable words.      ;; off silly pieces, only complete understandable words.
2278      (setq trim-prefix (try-completion "" sublst))      (setq trim-prefix (speedbar-try-completion "" sublst)
2279              newlst (nreverse newlst))
2280      (if (or (= (length sublst) 1)      (if (or (= (length sublst) 1)
2281              (not trim-prefix)              (not trim-prefix)
2282              (not (string-match "\\(\\w+\\W+\\)+" trim-prefix)))              (not (string-match "\\(\\w+\\W+\\)+" trim-prefix)))
2283          (append (nreverse newlst) (nreverse sublst))          (append newlst (nreverse sublst))
2284        (setq trim-prefix (substring trim-prefix (match-beginning 0)        (setq trim-prefix (substring trim-prefix (match-beginning 0)
2285                                     (match-end 0)))                                     (match-end 0)))
2286        (setq trim-chars (length trim-prefix))        (setq trim-chars (length trim-prefix))
# Line 2589  Argument LST is the list of tags to trim Line 2291  Argument LST is the list of tags to trim
2291                         trimlst)                         trimlst)
2292                sublst (cdr sublst)))                sublst (cdr sublst)))
2293        ;; Put the lists together        ;; Put the lists together
2294        (append (nreverse newlst) trimlst))))        (append newlst trimlst))))
2295    
2296  (defun speedbar-simple-group-tag-hierarchy (lst)  (defun speedbar-simple-group-tag-hierarchy (lst)
2297    "Create a simple 'Tags' group with orphaned tags.    "Create a simple 'Tags' group with orphaned tags.
# Line 2597  Argument LST is the list of tags to sort Line 2299  Argument LST is the list of tags to sort
2299    (let ((newlst nil)    (let ((newlst nil)
2300          (sublst nil))          (sublst nil))
2301      (while lst      (while lst
2302        (if (listp (cdr-safe (car-safe lst)))        (if (speedbar-generic-list-group-p (car-safe lst))
2303            (setq newlst (cons (car lst) newlst))            (setq newlst (cons (car lst) newlst))
2304          (setq sublst (cons (car lst) sublst)))          (setq sublst (cons (car lst) sublst)))
2305        (setq lst (cdr lst)))        (setq lst (cdr lst)))
# Line 2612  This uses `speedbar-tag-hierarchy-method Line 2314  This uses `speedbar-tag-hierarchy-method
2314  the list."  the list."
2315    (let* ((f (save-excursion    (let* ((f (save-excursion
2316                (forward-line -1)                (forward-line -1)
2317                (speedbar-line-path)))                (or (speedbar-line-file)
2318                      (speedbar-line-directory))))
2319           (methods (if (get-file-buffer f)           (methods (if (get-file-buffer f)
2320                        (save-excursion (set-buffer (get-file-buffer f))                        (save-excursion (set-buffer (get-file-buffer f))
2321                                        speedbar-tag-hierarchy-method)                                        speedbar-tag-hierarchy-method)
# Line 2625  the list." Line 2328  the list."
2328              methods (cdr methods)))              methods (cdr methods)))
2329      lst))      lst))
2330    
2331    (defvar speedbar-generic-list-group-expand-button-type 'curly
2332      "The type of button created for groups of tags.
2333    Good values for this are `curly' and `expandtag'.
2334    Make buffer local for your mode.")
2335    
2336    (defvar speedbar-generic-list-tag-button-type nil
2337      "The type of button created for tags in generic lists.
2338    Good values for this are nil and `statictag'.
2339    Make buffer local for your mode.")
2340    
2341  (defun speedbar-insert-generic-list (level lst expand-fun find-fun)  (defun speedbar-insert-generic-list (level lst expand-fun find-fun)
2342    "At LEVEL, insert a generic multi-level alist LST.    "At LEVEL, insert a generic multi-level alist LST.
2343  Associations with lists get {+} tags (to expand into more nodes) and  Associations with lists get {+} tags (to expand into more nodes) and
# Line 2634  name will have the function FIND-FUN and Line 2347  name will have the function FIND-FUN and
2347    ;; Remove imenu rescan button    ;; Remove imenu rescan button
2348    (if (string= (car (car lst)) "*Rescan*")    (if (string= (car (car lst)) "*Rescan*")
2349        (setq lst (cdr lst)))        (setq lst (cdr lst)))
2350    ;; Adjust the list.    ;; Get, and set up variables that define how we treat these tags.
2351    (setq lst (speedbar-create-tag-hierarchy lst))     (let ((f (save-excursion (forward-line -1)
2352    ;; insert the parts                              (or (speedbar-line-file)
2353    (while lst                                  (speedbar-line-directory))))
2354      (cond ((null (car-safe lst)) nil)   ;this would be a separator           expand-button tag-button)
2355            ((or (numberp (cdr-safe (car-safe lst)))       (save-excursion
2356                 (markerp (cdr-safe (car-safe lst))))         (if (get-file-buffer f)
2357             (speedbar-make-tag-line nil nil nil nil ;no expand button data             (set-buffer (get-file-buffer f)))
2358                                     (car (car lst)) ;button name         (setq expand-button speedbar-generic-list-group-expand-button-type
2359                                     find-fun        ;function               tag-button speedbar-generic-list-tag-button-type))
2360                                     (cdr (car lst)) ;token is position       ;; Adjust the list.
2361                                     'speedbar-tag-face       (setq lst (speedbar-create-tag-hierarchy lst))
2362                                     (1+ level)))       ;; insert the parts
2363            ((listp (cdr-safe (car-safe lst)))       (while lst
2364             (speedbar-make-tag-line 'curly ?+ expand-fun (cdr (car lst))         (cond ((null (car-safe lst)) nil)        ;this would be a separator
2365                                     (car (car lst)) ;button name              ((speedbar-generic-list-tag-p (car lst))
2366                                     nil nil 'speedbar-tag-face               (speedbar-make-tag-line tag-button
2367                                     (1+ level)))                                       nil nil nil ;no expand button data
2368            (t (speedbar-message "Ooops!")))                                       (car (car lst)) ;button name
2369      (setq lst (cdr lst))))                                       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)))))
2390    
2391  (defun speedbar-insert-imenu-list (indent lst)  (defun speedbar-insert-imenu-list (indent lst)
2392    "At level INDENT, insert the imenu generated LST."    "At level INDENT, insert the imenu generated LST."
2393    (speedbar-insert-generic-list indent lst    (speedbar-insert-generic-list indent lst
2394                                  'speedbar-tag-expand                                  'speedbar-tag-expand
2395                                  'speedbar-tag-find))                                  'speedbar-tag-find))
2396                                    
2397  (defun speedbar-insert-etags-list (indent lst)  (defun speedbar-insert-etags-list (indent lst)
2398    "At level INDENT, insert the etags generated LST."    "At level INDENT, insert the etags generated LST."
2399    (speedbar-insert-generic-list indent lst    (speedbar-insert-generic-list indent lst
# Line 2674  name will have the function FIND-FUN and Line 2407  name will have the function FIND-FUN and
2407    (interactive)    (interactive)
2408    ;; Set the current special buffer    ;; Set the current special buffer
2409    (setq speedbar-desired-buffer nil)    (setq speedbar-desired-buffer nil)
2410    
2411    ;; Check for special modes    ;; Check for special modes
2412    (speedbar-maybe-add-localized-support (current-buffer))    (speedbar-maybe-add-localized-support (current-buffer))
2413    
2414    ;; Choose the correct method of doodling.    ;; Choose the correct method of doodling.
2415    (if (and speedbar-mode-specific-contents-flag    (if (and speedbar-mode-specific-contents-flag
2416             (listp speedbar-special-mode-expansion-list)             (listp speedbar-special-mode-expansion-list)
# Line 2687  name will have the function FIND-FUN and Line 2422  name will have the function FIND-FUN and
2422        (speedbar-update-special-contents)        (speedbar-update-special-contents)
2423      (speedbar-update-directory-contents)))      (speedbar-update-directory-contents)))
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    
2465  (defun speedbar-update-directory-contents ()  (defun speedbar-update-directory-contents ()
2466    "Update the contents of the speedbar buffer based on the current directory."    "Update the contents of the speedbar buffer based on the current directory."
2467    (let ((cbd (expand-file-name default-directory))  
2468          cbd-parent    (save-excursion
2469          (funclst (speedbar-initial-expansion-list))  
2470          (cache speedbar-full-text-cache)      (let ((cbd (expand-file-name default-directory))
2471          ;; disable stealth during update            cbd-parent
2472          (speedbar-stealthy-function-list nil)            (funclst (speedbar-initial-expansion-list))
2473          (use-cache nil)            (cache speedbar-full-text-cache)
2474          (expand-local nil)            ;; disable stealth during update
2475          ;; Because there is a bug I can't find just yet            (speedbar-stealthy-function-list nil)
2476          (inhibit-quit nil))            (use-cache nil)
2477      (save-excursion            (expand-local nil)
2478              ;; Because there is a bug I can't find just yet
2479              (inhibit-quit nil))
2480        (set-buffer speedbar-buffer)        (set-buffer speedbar-buffer)
2481        ;; If we are updating contents to where we are, then this is        ;; If we are updating contents to where we are, then this is
2482        ;; really a request to update existing contents, so we must be        ;; really a request to update existing contents, so we must be
# Line 2725  name will have the function FIND-FUN and Line 2502  name will have the function FIND-FUN and
2502              (setq expand-local t)              (setq expand-local t)
2503    
2504            ;; If this directory is NOT in the current list of available            ;; If this directory is NOT in the current list of available
2505            ;; paths, then use the cache, and set the cache to our new            ;; directorys, then use the cache, and set the cache to our new
2506            ;; value.  Make sure to unhighlight the current file, or if we            ;; value.  Make sure to unhighlight the current file, or if we
2507            ;; come back to this directory, it might be a different file            ;; come back to this directory, it might be a different file
2508            ;; and then we get a mess!            ;; and then we get a mess!
# Line 2747  name will have the function FIND-FUN and Line 2524  name will have the function FIND-FUN and
2524        (speedbar-with-writable        (speedbar-with-writable
2525          (if (and expand-local          (if (and expand-local
2526                   ;; Find this directory as a speedbar node.                   ;; Find this directory as a speedbar node.
2527                   (speedbar-path-line cbd))                   (speedbar-directory-line cbd))
2528              ;; Open it.              ;; Open it.
2529              (speedbar-expand-line)              (speedbar-expand-line)
2530            (erase-buffer)            (erase-buffer)
# Line 2788  This should only be used by modes classi Line 2565  This should only be used by modes classi
2565            ;; decide NOT to update themselves.            ;; decide NOT to update themselves.
2566            (funcall (car funclst) specialbuff)            (funcall (car funclst) specialbuff)
2567            (setq funclst (cdr funclst))))            (setq funclst (cdr funclst))))
2568    
2569        (goto-char (point-min))))        (goto-char (point-min))))
2570    (speedbar-reconfigure-keymaps))    (speedbar-reconfigure-keymaps))
2571    
2572    (defun speedbar-set-timer (timeout)
2573      "Set up the speedbar timer with TIMEOUT.
2574    Uses `dframe-set-timer'.
2575    Also resets scanner functions."
2576      (dframe-set-timer timeout 'speedbar-timer-fn 'speedbar-update-flag)
2577      ;; Apply a revert hook that will reset the scanners.  We attach to revert
2578      ;; because most reverts occur during VC state change, and this lets our
2579      ;; VC scanner fix itself.
2580      (if timeout
2581          (add-hook 'after-revert-hook 'speedbar-reset-scanners)
2582        (remove-hook 'after-revert-hook 'speedbar-reset-scanners))
2583      ;; change this if it changed for some reason
2584      (speedbar-set-mode-line-format))
2585    
2586  (defun speedbar-timer-fn ()  (defun speedbar-timer-fn ()
2587    "Run whenever Emacs is idle to update the speedbar item."    "Run whenever Emacs is idle to update the speedbar item."
2588    (if (not (and (frame-live-p speedbar-frame)    (if (or (not (speedbar-current-frame))
2589                  (frame-live-p speedbar-attached-frame)))            (not (frame-live-p (speedbar-current-frame))))
2590        (speedbar-set-timer nil)        (speedbar-set-timer nil)
2591      ;; Save all the match data so that we don't mess up executing fns      ;; Save all the match data so that we don't mess up executing fns
2592      (save-match-data      (save-match-data
2593        ;; Only do stuff if the frame is visible, not an icon, and if        ;; Only do stuff if the frame is visible, not an icon, and if
2594        ;; it is currently flagged to do something.        ;; it is currently flagged to do something.
2595        (if (and speedbar-update-flag        (if (and speedbar-update-flag
2596                 (frame-visible-p speedbar-frame)                 (speedbar-current-frame)
2597                 (not (eq (frame-visible-p speedbar-frame) 'icon)))                 (frame-visible-p (speedbar-current-frame))
2598                   (not (eq (frame-visible-p (speedbar-current-frame)) 'icon)))
2599            (let ((af (selected-frame)))            (let ((af (selected-frame)))
2600              (save-window-excursion              (save-window-excursion
2601                (select-frame speedbar-attached-frame)                (dframe-select-attached-frame speedbar-frame)
2602                ;; make sure we at least choose a window to                ;; make sure we at least choose a window to
2603                ;; get a good directory from                ;; get a good directory from
2604                (if (window-minibuffer-p (selected-window))                (if (window-minibuffer-p (selected-window))
# Line 2833  This should only be used by modes classi Line 2626  This should only be used by modes classi
2626                               major-mode)                               major-mode)
2627                              (speedbar-message nil))))                              (speedbar-message nil))))
2628                    ;; Update all the contents if directories change!                    ;; Update all the contents if directories change!
2629                    (if (or (member (expand-file-name default-directory)                    (if (or (member major-mode speedbar-ignored-modes)
2630                                    speedbar-shown-directories)                            (eq af (speedbar-current-frame))
                           (and speedbar-ignored-path-regexp  
                                (string-match  
                                 speedbar-ignored-path-regexp  
                                 (expand-file-name default-directory)))  
                           (member major-mode speedbar-ignored-modes)  
                           (eq af speedbar-frame)  
2631                            (not (buffer-file-name)))                            (not (buffer-file-name)))
2632                        nil                        nil
2633                      (if (<= 1 speedbar-verbosity-level)                      (speedbar-update-localized-contents)
2634                          (speedbar-message "Updating speedbar to: %s..."                      ))
                                  default-directory))  
                     (speedbar-update-directory-contents)  
                     (if (<= 1 speedbar-verbosity-level)  
                         (progn  
                           (speedbar-message "Updating speedbar to: %s...done"  
                                    default-directory)  
                           (speedbar-message nil)))))  
2635                  (select-frame af)))                  (select-frame af)))
2636              ;; Now run stealthy updates of time-consuming items              ;; Now run stealthy updates of time-consuming items
2637              (speedbar-stealthy-updates)))              (speedbar-stealthy-updates)))))
       ;; Now run the mouse tracking system  
       (speedbar-show-info-under-mouse)))  
2638    (run-hooks 'speedbar-timer-hook))    (run-hooks 'speedbar-timer-hook))
2639    
2640    
# Line 2884  interrupted by the user." Line 2662  interrupted by the user."
2662    "Reset any variables used by functions in the stealthy list as state.    "Reset any variables used by functions in the stealthy list as state.
2663  If new functions are added, their state needs to be updated here."  If new functions are added, their state needs to be updated here."
2664    (setq speedbar-vc-to-do-point t    (setq speedbar-vc-to-do-point t
2665          speedbar-obj-to-do-point t)          speedbar-obj-to-do-point t
2666            speedbar-ro-to-do-point t)
2667    (run-hooks 'speedbar-scanner-reset-hook)    (run-hooks 'speedbar-scanner-reset-hook)
2668    )    )
2669    
2670  (defun speedbar-find-selected-file (file)  (defun speedbar-find-selected-file (file)
2671    "Go to the line where FILE is."    "Go to the line where FILE is."
2672    
2673      (set-buffer speedbar-buffer)
2674      
2675    (goto-char (point-min))    (goto-char (point-min))
2676    (let ((m nil))    (let ((m nil))
2677      (while (and (setq m (re-search-forward      (while (and (setq m (re-search-forward
# Line 2898  If new functions are added, their state Line 2680  If new functions are added, their state
2680                           nil t))                           nil t))
2681                  (not (string= file                  (not (string= file
2682                                (concat                                (concat
2683                                 (speedbar-line-path                                 (speedbar-line-directory
2684                                  (save-excursion                                  (save-excursion
2685                                    (goto-char (match-beginning 0))                                    (goto-char (match-beginning 0))
2686                                    (beginning-of-line)                                    (beginning-of-line)
# Line 2914  If new functions are added, their state Line 2696  If new functions are added, their state
2696  (defun speedbar-clear-current-file ()  (defun speedbar-clear-current-file ()
2697    "Locate the file thought to be current, and remove its highlighting."    "Locate the file thought to be current, and remove its highlighting."
2698    (save-excursion    (save-excursion
2699      (set-buffer speedbar-buffer)      ;;(set-buffer speedbar-buffer)
2700      (if speedbar-last-selected-file      (if speedbar-last-selected-file
2701          (speedbar-with-writable          (speedbar-with-writable
2702            (if (speedbar-find-selected-file speedbar-last-selected-file)            (if (speedbar-find-selected-file speedbar-last-selected-file)
# Line 2930  it should be in the list, then the direc Line 2712  it should be in the list, then the direc
2712  updated."  updated."
2713    (let* ((lastf (selected-frame))    (let* ((lastf (selected-frame))
2714           (newcfd (save-excursion           (newcfd (save-excursion
2715                     (select-frame speedbar-attached-frame)                     (dframe-select-attached-frame speedbar-frame)
2716                     (let ((rf (if (buffer-file-name)                     (let ((rf (if (buffer-file-name)
2717                                   (buffer-file-name)                                   (buffer-file-name)
2718                                 nil)))                                 nil)))
# Line 2939  updated." Line 2721  updated."
2721           (newcf (if newcfd newcfd))           (newcf (if newcfd newcfd))
2722           (lastb (current-buffer))           (lastb (current-buffer))
2723           (sucf-recursive (boundp 'sucf-recursive))           (sucf-recursive (boundp 'sucf-recursive))
2724           (case-fold-search read-file-name-completion-ignore-case))           (case-fold-search t))
2725      (if (and newcf      (if (and newcf
2726               ;; check here, that way we won't refresh to newcf until               ;; check here, that way we won't refresh to newcf until
2727               ;; its been written, thus saving ourselves some time               ;; its been written, thus saving ourselves some time
# Line 2949  updated." Line 2731  updated."
2731            ;; It is important to select the frame, otherwise the window            ;; It is important to select the frame, otherwise the window
2732            ;; we want the cursor to move in will not be updated by the            ;; we want the cursor to move in will not be updated by the
2733            ;; search-forward command.            ;; search-forward command.
2734            (select-frame speedbar-frame)            (select-frame (speedbar-current-frame))
2735            ;; Remove the old file...            ;; Remove the old file...
2736            (speedbar-clear-current-file)            (speedbar-clear-current-file)
2737            ;; now highlight the new one.            ;; now highlight the new one.
2738            (set-buffer speedbar-buffer)            ;; (set-buffer speedbar-buffer)
2739            (speedbar-with-writable            (speedbar-with-writable
2740              (if (speedbar-find-selected-file newcf)              (if (speedbar-find-selected-file newcf)
2741                  ;; put the property on it                  ;; put the property on it
# Line 2979  updated." Line 2761  updated."
2761              (setq speedbar-last-selected-file newcf))              (setq speedbar-last-selected-file newcf))
2762            (if (not sucf-recursive)            (if (not sucf-recursive)
2763                (progn                (progn
2764                  (speedbar-center-buffer-smartly)  
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    
2771                  (speedbar-position-cursor-on-line)                  (speedbar-position-cursor-on-line)
2772                  ))                  ))
2773            (set-buffer lastb)            (set-buffer lastb)
# Line 2997  indicator, then do not add a space." Line 2785  indicator, then do not add a space."
2785    ;; The nature of the beast: Assume we are in "the right place"    ;; The nature of the beast: Assume we are in "the right place"
2786    (end-of-line)    (end-of-line)
2787    (skip-chars-backward (concat " " speedbar-vc-indicator    (skip-chars-backward (concat " " speedbar-vc-indicator
2788                                   speedbar-object-read-only-indicator
2789                                 (car speedbar-obj-indicator)                                 (car speedbar-obj-indicator)
2790                                 (cdr speedbar-obj-indicator)))                                 (cdr speedbar-obj-indicator)))
2791    (if (and (not (looking-at speedbar-indicator-regex))    (if (and (not (looking-at speedbar-indicator-regex))
# Line 3011  indicator, then do not add a space." Line 2800  indicator, then do not add a space."
2800            (delete-region (match-beginning 0) (match-end 0))))            (delete-region (match-beginning 0) (match-end 0))))
2801      (end-of-line)      (end-of-line)
2802      (if (not (string= " " indicator-string))      (if (not (string= " " indicator-string))
2803          (insert indicator-string))))          (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)))
2837    
2838  ;; Load efs/ange-ftp only if compiling to remove byte-compiler warnings.  ;; Load efs/ange-ftp only if compiling to remove byte-compiler warnings.
2839  ;; Steven L Baur <steve@xemacs.org> said this was important:  ;; Steven L Baur <steve@xemacs.org> said this was important:
# Line 3026  to add more types of version control sys Line 2848  to add more types of version control sys
2848    ;; Check for to-do to be reset.  If reset but no RCS is available    ;; Check for to-do to be reset.  If reset but no RCS is available
2849    ;; then set to nil (do nothing) otherwise, start at the beginning    ;; then set to nil (do nothing) otherwise, start at the beginning
2850    (save-excursion    (save-excursion
2851      (set-buffer speedbar-buffer)      (if speedbar-buffer (set-buffer speedbar-buffer))
2852      (if (and speedbar-vc-do-check (eq speedbar-vc-to-do-point t)      (if (and speedbar-vc-do-check (eq speedbar-vc-to-do-point t)
2853               (speedbar-vc-check-dir-p default-directory)               (speedbar-vc-check-dir-p default-directory)
2854               (not (or (and (featurep 'ange-ftp)               (not (or (and (featurep 'ange-ftp)
2855                             (string-match                             (string-match
2856                              (car (if speedbar-xemacsp                              (car (symbol-value
2857                                       ange-ftp-path-format                                    (if dframe-xemacsp
2858                                     ange-ftp-name-format))                                        'ange-ftp-directory-format
2859                                        'ange-ftp-name-format)))
2860                              (expand-file-name default-directory)))                              (expand-file-name default-directory)))
2861                        ;; efs support: Bob Weiner                        ;; efs support: Bob Weiner
2862                        (and (featurep 'efs)                        (and (featurep 'efs)
2863                             (string-match                             (string-match
2864                              (car efs-path-regexp)                              (let ((reg (symbol-value 'efs-directory-regexp)))
2865                                  (if (stringp reg)
2866                                      reg
2867                                    (car reg)))
2868                              (expand-file-name default-directory))))))                              (expand-file-name default-directory))))))
2869          (setq speedbar-vc-to-do-point 0))          (setq speedbar-vc-to-do-point 0))
2870      (if (numberp speedbar-vc-to-do-point)      (if (numberp speedbar-vc-to-do-point)
2871          (progn          (progn
2872            (goto-char speedbar-vc-to-do-point)            (goto-char speedbar-vc-to-do-point)
2873            (while (and (not (input-pending-p))            (while (and (not (input-pending-p))
2874                        (re-search-forward "^\\([0-9]+\\):\\s-*\\[[+-]\\] "                        (re-search-forward "^\\([0-9]+\\):\\s-*\\[[+-?]\\] "
2875                                           nil t))                                           nil t))
2876              (setq speedbar-vc-to-do-point (point))              (setq speedbar-vc-to-do-point (point))
2877              (if (speedbar-check-vc-this-line (match-string 1))              (if (speedbar-check-vc-this-line (match-string 1))
# Line 3066  to add more types of version control sys Line 2892  to add more types of version control sys
2892    "Return t if the file on this line is check of of a version control system.    "Return t if the file on this line is check of of a version control system.
2893  Parameter DEPTH is a string with the current depth of indentation of  Parameter DEPTH is a string with the current depth of indentation of
2894  the file being checked."  the file being checked."
2895    (let* ((d (string-to-int depth))    (let* ((d (string-to-number depth))
2896           (f (speedbar-line-path d))           (f (speedbar-line-directory d))
2897           (fn (buffer-substring-no-properties           (fn (buffer-substring-no-properties
2898                ;; Skip-chars: thanks ptype@dra.hmg.gb                ;; Skip-chars: thanks ptype@dra.hmg.gb
2899                (point) (progn                (point) (progn
# Line 3081  the file being checked." Line 2907  the file being checked."
2907      (and (file-writable-p fulln)      (and (file-writable-p fulln)
2908           (speedbar-this-file-in-vc f fn))))           (speedbar-this-file-in-vc f fn))))
2909    
2910  (defun speedbar-vc-check-dir-p (path)  (defun speedbar-vc-check-dir-p (directory)
2911    "Return t if we should bother checking PATH for version control files.    "Return t if we should bother checking DIRECTORY for version control files.
2912  This can be overloaded to add new types of version control systems."  This can be overloaded to add new types of version control systems."
2913    (or    (or
2914       ;; Local CVS available in Emacs 21
2915       (and (fboundp 'vc-state)
2916            (file-exists-p (concat directory "CVS/")))
2917     ;; Local RCS     ;; Local RCS
2918     (file-exists-p (concat path "RCS/"))     (file-exists-p (concat directory "RCS/"))
2919     ;; Local SCCS     ;; Local SCCS
2920     (file-exists-p (concat path "SCCS/"))     (file-exists-p (concat directory "SCCS/"))
2921     ;; Remote SCCS project     ;; Remote SCCS project
2922     (let ((proj-dir (getenv "PROJECTDIR")))     (let ((proj-dir (getenv "PROJECTDIR")))
2923       (if proj-dir       (if proj-dir
2924           (file-exists-p (concat proj-dir "/SCCS"))           (file-exists-p (concat proj-dir "/SCCS"))
2925         nil))         nil))
2926     ;; User extension     ;; User extension
2927     (run-hook-with-args 'speedbar-vc-path-enable-hook path)     (run-hook-with-args-until-success 'speedbar-vc-directory-enable-hook
2928                                         directory)
2929     ))     ))
2930    
2931  (defun speedbar-this-file-in-vc (path name)  (defun speedbar-this-file-in-vc (directory name)
2932    "Check to see if the file in PATH with NAME is in a version control system.    "Check to see if the file in DIRECTORY with NAME is in a version control system.
2933  You can add new VC systems by overriding this function.  You can  You can add new VC systems by overriding this function.  You can
2934  optimize this function by overriding it and only doing those checks  optimize this function by overriding it and only doing those checks
2935  that will occur on your system."  that will occur on your system."
2936    (or    (or
2937     ;; RCS file name     (if (fboundp 'vc-state)
2938     (file-exists-p (concat path "RCS/" name ",v"))         ;; Emacs 21 handles VC state in a nice way.
2939     (file-exists-p (concat path "RCS/" name))         (condition-case nil
2940     ;; Local SCCS file name             (let ((state  (vc-state (concat directory name))))
2941     (file-exists-p (concat path "SCCS/s." name))               (not (or (eq 'up-to-date state)
2942     ;; Remote SCCS file name                        (null state))))
2943     (let ((proj-dir (getenv "PROJECTDIR")))           ;; An error means not in a VC system
2944       (if proj-dir           (error nil))
2945           (file-exists-p (concat proj-dir "/SCCS/s." name))       (or
2946         nil))        ;; 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))))
2956     ;; User extension     ;; User extension
2957     (run-hook-with-args 'speedbar-vc-in-control-hook path name)     (run-hook-with-args 'speedbar-vc-in-control-hook directory name)
2958     ))     ))
2959    
2960  ;; Objet File scanning  ;; Objet File scanning
# Line 3126  to add more object types." Line 2965  to add more object types."
2965    ;; Check for to-do to be reset.  If reset but no RCS is available    ;; Check for to-do to be reset.  If reset but no RCS is available
2966    ;; then set to nil (do nothing) otherwise, start at the beginning    ;; then set to nil (do nothing) otherwise, start at the beginning
2967    (save-excursion    (save-excursion
2968      (set-buffer speedbar-buffer)      (if speedbar-buffer (set-buffer speedbar-buffer))
2969      (if (and speedbar-obj-do-check (eq speedbar-obj-to-do-point t))      (if (and speedbar-obj-do-check (eq speedbar-obj-to-do-point t))
2970          (setq speedbar-obj-to-do-point 0))          (setq speedbar-obj-to-do-point 0))
2971      (if (numberp speedbar-obj-to-do-point)      (if (numberp speedbar-obj-to-do-point)
# Line 3155  to add more object types." Line 2994  to add more object types."
2994    "Return t if the file on this line has an associated object.    "Return t if the file on this line has an associated object.
2995  Parameter DEPTH is a string with the current depth of indentation of  Parameter DEPTH is a string with the current depth of indentation of
2996  the file being checked."  the file being checked."
2997    (let* ((d (string-to-int depth))    (let* ((d (string-to-number depth))
2998           (f (speedbar-line-path d))           (f (speedbar-line-directory d))
2999           (fn (buffer-substring-no-properties           (fn (buffer-substring-no-properties
3000                ;; Skip-chars: thanks ptype@dra.hmg.gb                ;; Skip-chars: thanks ptype@dra.hmg.gb
3001                (point) (progn                (point) (progn
# Line 3186  the file being checked." Line 3025  the file being checked."
3025    
3026  ;;; Clicking Activity  ;;; Clicking Activity
3027  ;;  ;;
 (defun speedbar-mouse-set-point (e)  
   "Set POINT based on event E.  
 Handle clicking on images in XEmacs."  
   (if (and (fboundp 'event-over-glyph-p) (event-over-glyph-p e))  
       ;; We are in XEmacs, and clicked on a picture  
       (let ((ext (event-glyph-extent e)))  
         ;; This position is back inside the extent where the  
         ;; junk we pushed into the property list lives.  
         (if (extent-end-position ext)  
             (goto-char (1- (extent-end-position ext)))  
           (mouse-set-point e)))  
     ;; We are not in XEmacs, OR we didn't click on a picture.  
     (mouse-set-point e)))  
   
 (defun speedbar-quick-mouse (e)  
   "Since mouse events are strange, this will keep the mouse nicely positioned.  
 This should be bound to mouse event E."  
   (interactive "e")  
   (speedbar-mouse-set-point e)  
   (speedbar-position-cursor-on-line)  
   )  
   
3028  (defun speedbar-position-cursor-on-line ()  (defun speedbar-position-cursor-on-line ()
3029    "Position the cursor on a line."    "Position the cursor on a line."
3030    (let ((oldpos (point)))    (let ((oldpos (point)))
# Line 3216  This should be bound to mouse event E." Line 3033  This should be bound to mouse event E."
3033          (goto-char (1- (match-end 0)))          (goto-char (1- (match-end 0)))
3034        (goto-char oldpos))))        (goto-char oldpos))))
3035    
 (defun speedbar-power-click (e)  
   "Activate any speedbar button as a power click.  
 A power click will dispose of cached data (if available) or bring a buffer  
 up into a different window.  
 This should be bound to mouse event E."  
   (interactive "e")  
   (let ((speedbar-power-click t))  
     (speedbar-click e)))  
   
3036  (defun speedbar-click (e)  (defun speedbar-click (e)
3037    "Activate any speedbar buttons where the mouse is clicked.    "Activate any speedbar buttons where the mouse is clicked.
3038  This must be bound to a mouse event.  A button is any location of text  This must be bound to a mouse event.  A button is any location of text
3039  with a mouse face that has a text property called `speedbar-function'.  with a mouse face that has a text property called `speedbar-function'.
3040  This should be bound to mouse event E."  Argument E is the click event."
3041    (interactive "e")    ;; Backward compatibility let statement.
3042    (speedbar-mouse-set-point e)    (let ((speedbar-power-click dframe-power-click))
3043    (speedbar-do-function-pointer)      (speedbar-do-function-pointer))
3044    (speedbar-quick-mouse e))    (dframe-quick-mouse e))
   
 (defun speedbar-double-click (e)  
   "Activate any speedbar buttons where the mouse is clicked.  
 This must be bound to a mouse event.  A button is any location of text  
 with a mouse face that has a text property called `speedbar-function'.  
 This should be bound to mouse event E."  
   (interactive "e")  
   ;; Emacs only.  XEmacs handles this via `mouse-track-click-hook'.  
   (cond ((eq (car e) 'down-mouse-1)  
          (speedbar-mouse-set-point e))  
         ((eq (car e) 'mouse-1)  
          (speedbar-quick-mouse e))  
         ((or (eq (car e) 'double-down-mouse-1)  
              (eq (car e) 'triple-down-mouse-1))  
          (speedbar-mouse-set-point e)  
          (speedbar-do-function-pointer)  
          (speedbar-quick-mouse e))))  
3045    
3046  (defun speedbar-do-function-pointer ()  (defun speedbar-do-function-pointer ()
3047    "Look under the cursor and examine the text properties.    "Look under the cursor and examine the text properties.
3048  From this extract the file/tag name, token, indentation level and call  From this extract the file/tag name, token, indentation level and call
3049  a function if appropriate."  a function if appropriate."
3050    (let* ((fn (get-text-property (point) 'speedbar-function))    (let* ((speedbar-frame (speedbar-current-frame))
3051             (fn (get-text-property (point) 'speedbar-function))
3052           (tok (get-text-property (point) 'speedbar-token))           (tok (get-text-property (point) 'speedbar-token))
3053           ;; The 1-,+ is safe because scaning starts AFTER the point           ;; The 1-,+ is safe because scaning starts AFTER the point
3054           ;; specified.  This lets the search include the character the           ;; specified.  This lets the search include the character the
# Line 3286  Optional argument P is where to start th Line 3078  Optional argument P is where to start th
3078      (if p (goto-char p))      (if p (goto-char p))
3079      (beginning-of-line)      (beginning-of-line)
3080      (if (looking-at (concat      (if (looking-at (concat
3081                       "\\([0-9]+\\): *[[<{][-+?][]>}] \\([^ \n]+\\)\\("                       "\\([0-9]+\\): *[[<{]?[-+?= ][]>}@()|] \\([^ \n]+\\)"))
3082                       speedbar-indicator-regex "\\)?"))          (get-text-property (match-beginning 2) 'speedbar-text)
         (match-string 2)  
3083        nil)))        nil)))
3084    
3085  (defun speedbar-line-token (&optional p)  (defun speedbar-line-token (&optional p)
# Line 3298  Optional argument P is where to start th Line 3089  Optional argument P is where to start th
3089      (if p (goto-char p))      (if p (goto-char p))
3090      (beginning-of-line)      (beginning-of-line)
3091      (if (looking-at (concat      (if (looking-at (concat
3092                       "\\([0-9]+\\): *[[<{]?[-+?=][]>}@()|] \\([^ \n]+\\)\\("                       "\\([0-9]+\\): *[[<{]?[-+?= ][]>}@()|] \\([^ \n]+\\)\\("
3093                       speedbar-indicator-regex "\\)?"))                       speedbar-indicator-regex "\\)?"))
3094          (progn          (progn
3095            (goto-char (match-beginning 2))            (goto-char (match-beginning 2))
# Line 3310  Optional argument P is where to start th Line 3101  Optional argument P is where to start th
3101  The return value is a string representing the file.  If it is a  The return value is a string representing the file.  If it is a
3102  directory, then it is the directory name."  directory, then it is the directory name."
3103    (save-match-data    (save-match-data
3104      (let ((f (speedbar-line-text p)))      (save-restriction
3105        (if f        (widen)
3106            (let* ((depth (string-to-int (match-string 1)))        (let ((f (speedbar-line-text p)))
3107                   (path (speedbar-line-path depth)))          (if f
3108              (if (file-exists-p (concat path f))              (let* ((depth (string-to-number (match-string 1)))
3109                  (concat path f)                     (directory (speedbar-line-directory depth)))
3110                nil))                (if (file-exists-p (concat directory f))
3111          nil))))                    (concat directory f)
3112                    nil))
3113              nil)))))
3114    
3115  (defun speedbar-goto-this-file (file)  (defun speedbar-goto-this-file (file)
3116    "If FILE is displayed, go to this line and return t.    "If FILE is displayed, go to this line and return t.
3117  Otherwise do not move and return nil."  Otherwise do not move and return nil."
3118    (let ((path (substring (file-name-directory (expand-file-name file))    (let ((directory (substring (file-name-directory (expand-file-name file))
3119                           (length (expand-file-name default-directory))))                           (length (expand-file-name default-directory))))
3120          (dest (point)))          (dest (point)))
3121      (save-match-data      (save-match-data
3122        (goto-char (point-min))        (goto-char (point-min))
3123        ;; scan all the directories        ;; scan all the directories
3124        (while (and path (not (eq path t)))        (while (and directory (not (eq directory t)))
3125          (if (string-match "^[/\\]?\\([^/\\]+\\)" path)          (if (string-match "^[/\\]?\\([^/\\]+\\)" directory)
3126              (let ((pp (match-string 1 path)))              (let ((pp (match-string 1 directory)))
3127                (if (save-match-data                (if (save-match-data
3128                      (re-search-forward (concat "> " (regexp-quote pp) "$")                      (re-search-forward (concat "> " (regexp-quote pp) "$")
3129                                         nil t))                                         nil t))
3130                    (setq path (substring path (match-end 1)))                    (setq directory (substring directory (match-end 1)))
3131                  (setq path nil)))                  (setq directory nil)))
3132            (setq path t)))            (setq directory t)))
3133        ;; find the file part        ;; find the file part
3134        (if (or (not path) (string= (file-name-nondirectory file) ""))        (if (or (not directory) (string= (file-name-nondirectory file) ""))
3135            ;; only had a dir part            ;; only had a dir part
3136            (if path            (if directory
3137                (progn                (progn
3138                  (speedbar-position-cursor-on-line)                  (speedbar-position-cursor-on-line)
3139                  t)                  t)
# Line 3357  Otherwise do not move and return nil." Line 3150  Otherwise do not move and return nil."
3150              (goto-char dest)              (goto-char dest)
3151              nil))))))              nil))))))
3152    
3153  (defun speedbar-line-path (&optional depth)  (defun speedbar-line-directory (&optional depth)
3154    "Retrieve the pathname associated with the current line.    "Retrieve the directoryname associated with the current line.
3155  This may require traversing backwards from DEPTH and combining the default  This may require traversing backwards from DEPTH and combining the default
3156  directory with these items.  This function is replaceable in  directory with these items.  This function is replaceable in
3157  `speedbar-mode-functions-list' as `speedbar-line-path'."  `speedbar-mode-functions-list' as `speedbar-line-directory'."
3158    (let ((rf (speedbar-fetch-replacement-function 'speedbar-line-path)))    (save-restriction
3159      (if rf (funcall rf depth) default-directory)))      (widen)
3160        (let ((rf (speedbar-fetch-replacement-function 'speedbar-line-directory)))
3161  (defun speedbar-files-line-path (&optional depth)        (if rf (funcall rf depth) default-directory))))
3162    "Retrieve the pathname associated with the current line.        
3163    (defun speedbar-files-line-directory (&optional depth)
3164      "Retrieve the directoryname associated with the current line.
3165  This may require traversing backwards from DEPTH and combining the default  This may require traversing backwards from DEPTH and combining the default
3166  directory with these items."  directory with these items."
3167    (save-excursion    (save-excursion
# Line 3375  directory with these items." Line 3170  directory with these items."
3170            (progn            (progn
3171              (beginning-of-line)              (beginning-of-line)
3172              (looking-at "^\\([0-9]+\\):")              (looking-at "^\\([0-9]+\\):")
3173              (setq depth (string-to-int (match-string 1)))))              (setq depth (string-to-number (match-string 1)))))
3174        (let ((path nil))        (let ((directory nil))
3175          (setq depth (1- depth))          (setq depth (1- depth))
3176          (while (/= depth -1)          (while (/= depth -1)
3177            (if (not (re-search-backward (format "^%d:" depth) nil t))            (if (not (re-search-backward (format "^%d:" depth) nil t))
3178                (error "Error building path of tag")                (error "Error building filename of tag")
3179              (cond ((looking-at "[0-9]+:\\s-*<->\\s-+\\([^\n]+\\)$")              (cond ((looking-at "[0-9]+:\\s-*<->\\s-+\\([^\n]+\\)")
3180                     (setq path (concat (buffer-substring-no-properties                     (setq directory (concat (speedbar-line-text)
                                        (match-beginning 1) (match-end 1))  
3181                                        "/"                                        "/"
3182                                        path)))                                        directory)))
3183                    ((looking-at "[0-9]+:\\s-*[-]\\s-+\\([^\n]+\\)$")                    ((looking-at "[0-9]+:\\s-*[-]\\s-+\\([^\n]+\\)")
3184                     ;; This is the start of our path.                     ;; This is the start of our directory.
3185                     (setq path (buffer-substring-no-properties                     (setq directory (speedbar-line-text)))))
                                (match-beginning 1) (match-end 1))))))  
3186            (setq depth (1- depth)))            (setq depth (1- depth)))
3187          (if (and path          (if (and directory
3188                   (string-match (concat speedbar-indicator-regex "$")                   (string-match (concat speedbar-indicator-regex "$")
3189                                 path))                                 directory))
3190              (setq path (substring path 0 (match-beginning 0))))              (setq directory (substring directory 0 (match-beginning 0))))
3191          (concat default-directory path)))))          (concat default-directory directory)))))
3192    
3193  (defun speedbar-path-line (path)  (defun speedbar-directory-line (directory)
3194    "Position the cursor on the line specified by PATH."    "Position the cursor on the line specified by DIRECTORY."
3195    (save-match-data    (save-match-data
3196      (if (string-match "[/\\]$" path)      (if (string-match "[/\\]$" directory)
3197          (setq path (substring path 0 (match-beginning 0))))          (setq directory (substring directory 0 (match-beginning 0))))
3198      (let ((nomatch t) (depth 0)      (let ((nomatch t) (depth 0)
3199            (fname (file-name-nondirectory path))            (fname (file-name-nondirectory directory))
3200            (pname (file-name-directory path)))            (pname (file-name-directory directory)))
3201        (if (not (member pname speedbar-shown-directories))        (if (not (member pname speedbar-shown-directories))
3202            (error "Internal Error: File %s not shown in speedbar" path))            (error "Internal Error: File %s not shown in speedbar" directory))
3203        (goto-char (point-min))        (goto-char (point-min))
3204        (while (and nomatch        (while (and nomatch
3205                    (re-search-forward                    (re-search-forward
# Line 3415  directory with these items." Line 3208  directory with these items."
3208                     nil t))                     nil t))
3209          (beginning-of-line)          (beginning-of-line)
3210          (looking-at "\\([0-9]+\\):")          (looking-at "\\([0-9]+\\):")
3211          (setq depth (string-to-int (match-string 0))          (setq depth (string-to-number (match-string 0))
3212                nomatch (not (string= pname (speedbar-line-path depth))))                nomatch (not (string= pname (speedbar-line-directory depth))))
3213          (end-of-line))          (end-of-line))
3214        (beginning-of-line)        (beginning-of-line)
3215        (not nomatch))))        (not nomatch))))
# Line 3442  directory with these items." Line 3235  directory with these items."
3235  With universal argument ARG, flush cached data."  With universal argument ARG, flush cached data."
3236    (interactive "P")    (interactive "P")
3237    (beginning-of-line)    (beginning-of-line)
3238    (let ((speedbar-power-click arg))    (let* ((dframe-power-click arg)
3239             (speedbar-power-click arg))
3240      (condition-case nil      (condition-case nil
3241          (progn          (progn
3242            (re-search-forward ":\\s-*.\\+. "            (re-search-forward ":\\s-*.\\+. "
# Line 3450  With universal argument ARG, flush cache Line 3244  With universal argument ARG, flush cache
3244            (forward-char -2)            (forward-char -2)
3245            (speedbar-do-function-pointer))            (speedbar-do-function-pointer))
3246        (error (speedbar-position-cursor-on-line)))))        (error (speedbar-position-cursor-on-line)))))
3247      
3248  (defun speedbar-flush-expand-line ()  (defun speedbar-flush-expand-line ()
3249    "Expand the line under the cursor and flush any cached information."    "Expand the line under the cursor and flush any cached information."
3250    (interactive)    (interactive)
3251    (speedbar-expand-line 1))    (speedbar-expand-line 1))
3252      
3253  (defun speedbar-contract-line ()  (defun speedbar-contract-line ()
3254    "Contract the line under the cursor."    "Contract the line under the cursor."
3255    (interactive)    (interactive)
# Line 3468  With universal argument ARG, flush cache Line 3262  With universal argument ARG, flush cache
3262          (speedbar-do-function-pointer))          (speedbar-do-function-pointer))
3263      (error (speedbar-position-cursor-on-line))))      (error (speedbar-position-cursor-on-line))))
3264    
3265  (if speedbar-xemacsp  (defun speedbar-toggle-line-expansion ()
3266      (defalias 'speedbar-mouse-event-p 'button-press-event-p)    "Contract or expand the line under the cursor."
3267    (defun speedbar-mouse-event-p (event)    (interactive)
3268      "Return t if the event is a mouse related event."    (beginning-of-line)
3269      ;; And Emacs does it this way    (condition-case nil
     (if (and (listp event)  
              (member (event-basic-type event)  
                      '(mouse-1 mouse-2 mouse-3)))  
         t  
       nil)))  
   
 (defun speedbar-maybee-jump-to-attached-frame ()  
   "Jump to the attached frame ONLY if this was not a mouse event."  
   (if (or (not (speedbar-mouse-event-p last-input-event))  
           speedbar-activity-change-focus-flag)  
3270        (progn        (progn
3271          (select-frame speedbar-attached-frame)          (re-search-forward ":\\s-*.[-+]. "
3272          (other-frame 0))))                             (save-excursion (end-of-line) (point)))
3273            (forward-char -2)
3274            (speedbar-do-function-pointer))
3275        (error (speedbar-position-cursor-on-line))))
3276    
3277    (defun speedbar-expand-line-descendants (&optional arg)
3278      "Expand the line under the cursor and all descendants.
3279    Optional argument ARG indicates that any cache should be flushed."
3280      (interactive "P")
3281      (speedbar-expand-line arg)
3282      ;; Now, inside the area expaded here, expand all subnodes of
3283      ;; the same descendant type.
3284      (save-excursion
3285        (speedbar-next 1) ;; Move into the list.
3286        (let ((err nil))
3287          (while (not err)
3288            (condition-case nil
3289                (progn
3290                  (speedbar-expand-line-descendants arg)
3291                  (speedbar-restricted-next 1))
3292              (error (setq err t))))))
3293      )
3294    
3295    (defun speedbar-contract-line-descendants ()
3296      "Expand the line under the cursor and all descendants."
3297      (interactive)
3298      (speedbar-contract-line)
3299      ;; Don't need to do anything else since all descendants are
3300      ;; hidden by default anyway.  Yay!  It's easy.
3301      )
3302    
3303  (defun speedbar-find-file (text token indent)  (defun speedbar-find-file (text token indent)
3304    "Speedbar click handler for filenames.    "Speedbar click handler for filenames.
3305  TEXT, the file will be displayed in the attached frame.  TEXT, the file will be displayed in the attached frame.
3306  TOKEN is unused, but required by the click handler.  INDENT is the  TOKEN is unused, but required by the click handler.  INDENT is the
3307  current indentation level."  current indentation level."
3308    (let ((cdd (speedbar-line-path indent)))    (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))
3314      (speedbar-find-file-in-frame (concat cdd text))      (speedbar-find-file-in-frame (concat cdd text))
3315      (speedbar-stealthy-updates)      (speedbar-stealthy-updates)
3316      (run-hooks 'speedbar-visiting-file-hook)      (run-hooks 'speedbar-visiting-file-hook)
3317      ;; Reset the timer with a new timeout when cliking a file      ;; Reset the timer with a new timeout when cliking a file
3318      ;; in case the user was navigating directories, we can cancel      ;; in case the user was navigating directories, we can cancel
3319      ;; that other timer.      ;; that other timer.
3320      (speedbar-set-timer speedbar-update-speed))      (speedbar-set-timer dframe-update-speed))
3321    (speedbar-maybee-jump-to-attached-frame))    (dframe-maybee-jump-to-attached-frame))
3322    
3323  (defun speedbar-dir-follow (text token indent)  (defun speedbar-dir-follow (text token indent)
3324    "Speedbar click handler for directory names.    "Speedbar click handler for directory names.
# Line 3508  Clicking a directory will cause the spee Line 3326  Clicking a directory will cause the spee
3326  the subdirectory TEXT.  TOKEN is an unused requirement.  The  the subdirectory TEXT.  TOKEN is an unused requirement.  The
3327  subdirectory chosen will be at INDENT level."  subdirectory chosen will be at INDENT level."
3328    (setq default-directory    (setq default-directory
3329          (concat (expand-file-name (concat (speedbar-line-path indent) text))          (concat (expand-file-name (concat (speedbar-line-directory indent) text))
3330                  "/"))                  "/"))
3331    ;; Because we leave speedbar as the current buffer,    ;; Because we leave speedbar as the current buffer,
3332    ;; update contents will change directory without    ;; update contents will change directory without
# Line 3528  Handles end-of-sublist smartly." Line 3346  Handles end-of-sublist smartly."
3346        (end-of-line) (forward-char 1)        (end-of-line) (forward-char 1)
3347        (let ((start (point)))        (let ((start (point)))
3348          (while (and (looking-at "^\\([0-9]+\\):")          (while (and (looking-at "^\\([0-9]+\\):")
3349                      (> (string-to-int (match-string 1)) indent)                      (> (string-to-number (match-string 1)) indent)
3350                      (not (eobp)))                      (not (eobp)))
3351            (forward-line 1)            (forward-line 1)
3352            (beginning-of-line))            (beginning-of-line))
# Line 3542  expanded.  INDENT is the current indenta Line 3360  expanded.  INDENT is the current indenta
3360    (cond ((string-match "+" text)        ;we have to expand this dir    (cond ((string-match "+" text)        ;we have to expand this dir
3361           (setq speedbar-shown-directories           (setq speedbar-shown-directories
3362                 (cons (expand-file-name                 (cons (expand-file-name
3363                        (concat (speedbar-line-path indent) token "/"))                        (concat (speedbar-line-directory indent) token "/"))
3364                       speedbar-shown-directories))                       speedbar-shown-directories))
3365           (speedbar-change-expand-button-char ?-)           (speedbar-change-expand-button-char ?-)
3366           (speedbar-reset-scanners)           (speedbar-reset-scanners)
# Line 3550  expanded.  INDENT is the current indenta Line 3368  expanded.  INDENT is the current indenta
3368             (end-of-line) (forward-char 1)             (end-of-line) (forward-char 1)
3369             (speedbar-with-writable             (speedbar-with-writable
3370               (speedbar-default-directory-list               (speedbar-default-directory-list
3371                (concat (speedbar-line-path indent) token "/")                (concat (speedbar-line-directory indent) token "/")
3372                (1+ indent)))))                (1+ indent)))))
3373          ((string-match "-" text)        ;we have to contract this node          ((string-match "-" text)        ;we have to contract this node
3374           (speedbar-reset-scanners)           (speedbar-reset-scanners)
3375           (let ((oldl speedbar-shown-directories)           (let ((oldl speedbar-shown-directories)
3376                 (newl nil)                 (newl nil)
3377                 (td (expand-file-name                 (td (expand-file-name
3378                      (concat (speedbar-line-path indent) token))))                      (concat (speedbar-line-directory indent) token))))
3379             (while oldl             (while oldl
3380               (if (not (string-match (concat "^" (regexp-quote td)) (car oldl)))               (if (not (string-match (concat "^" (regexp-quote td)) (car oldl)))
3381                   (setq newl (cons (car oldl) newl)))                   (setq newl (cons (car oldl) newl)))
# Line 3568  expanded.  INDENT is the current indenta Line 3386  expanded.  INDENT is the current indenta
3386           )           )
3387          (t (error "Ooops...  not sure what to do")))          (t (error "Ooops...  not sure what to do")))
3388    (speedbar-center-buffer-smartly)    (speedbar-center-buffer-smartly)
   (setq speedbar-last-selected-file nil)  
3389    (save-excursion (speedbar-stealthy-updates)))    (save-excursion (speedbar-stealthy-updates)))
3390    
3391  (defun speedbar-directory-buttons-follow (text token indent)  (defun speedbar-directory-buttons-follow (text token indent)
# Line 3590  The parameter TEXT and TOKEN are require Line 3407  The parameter TEXT and TOKEN are require
3407  clicked, and TOKEN is the file to expand.  INDENT is the current  clicked, and TOKEN is the file to expand.  INDENT is the current
3408  indentation level."  indentation level."
3409    (cond ((string-match "+" text)        ;we have to expand this file    (cond ((string-match "+" text)        ;we have to expand this file
3410           (let* ((fn (expand-file-name (concat (speedbar-line-path indent)           (let* ((fn (expand-file-name (concat (speedbar-line-directory indent)
3411                                                token)))                                                token)))
3412                  (mode nil)                  (mode nil)
3413                  (lst (speedbar-fetch-dynamic-tags fn)))                  (lst (speedbar-fetch-dynamic-tags fn)))
# Line 3611  indentation level." Line 3428  indentation level."
3428  (defun speedbar-tag-find (text token indent)  (defun speedbar-tag-find (text token indent)
3429    "For the tag TEXT in a file TOKEN, go to that position.    "For the tag TEXT in a file TOKEN, go to that position.
3430  INDENT is the current indentation level."  INDENT is the current indentation level."
3431    (let ((file (speedbar-line-path indent)))    (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))
3436      (speedbar-find-file-in-frame file)      (speedbar-find-file-in-frame file)
3437      (save-excursion (speedbar-stealthy-updates))      (save-excursion (speedbar-stealthy-updates))
3438      ;; Reset the timer with a new timeout when cliking a file      ;; Reset the timer with a new timeout when cliking a file
3439      ;; in case the user was navigating directories, we can cancel      ;; in case the user was navigating directories, we can cancel
3440      ;; that other timer.      ;; that other timer.
3441      (speedbar-set-timer speedbar-update-speed)      (speedbar-set-timer dframe-update-speed)
3442      (goto-char token)      (goto-char token)
3443      (run-hooks 'speedbar-visiting-tag-hook)      (run-hooks 'speedbar-visiting-tag-hook)
3444      ;;(recenter)      (dframe-maybee-jump-to-attached-frame)
     (speedbar-maybee-jump-to-attached-frame)  
3445      ))      ))
3446    
3447  (defun speedbar-tag-expand (text token indent)  (defun speedbar-tag-expand (text token indent)
# Line 3644  level." Line 3464  level."
3464    
3465  ;;; Loading files into the attached frame.  ;;; Loading files into the attached frame.
3466  ;;  ;;
3467    (defcustom speedbar-select-frame-method 'attached
3468      "*Specify how to select a frame for displaying a file.
3469    A value of 'attached means to use the attached frame (the frame
3470    that speedbar was started from.)  A number such as 1 or -1 means to
3471    pass that number to `other-frame' while selecting a frame from speedbar."
3472      :group 'speedbar
3473      :type 'sexp)
3474    
3475  (defun speedbar-find-file-in-frame (file)  (defun speedbar-find-file-in-frame (file)
3476    "This will load FILE into the speedbar attached frame.    "This will load FILE into the speedbar attached frame.
3477  If the file is being displayed in a different frame already, then raise that  If the file is being displayed in a different frame already, then raise that
# Line 3654  frame instead." Line 3482  frame instead."
3482          (progn          (progn
3483            (select-window bwin)            (select-window bwin)
3484            (raise-frame (window-frame bwin)))            (raise-frame (window-frame bwin)))
3485        (if speedbar-power-click        (if dframe-power-click
3486            (let ((pop-up-frames t)) (select-window (display-buffer buff)))            (let ((pop-up-frames t)) (select-window (display-buffer buff)))
3487          (select-frame speedbar-attached-frame)          (if (numberp speedbar-select-frame-method)
3488                (other-frame speedbar-select-frame-method)
3489              (dframe-select-attached-frame speedbar-frame))
3490          (switch-to-buffer buff))))          (switch-to-buffer buff))))
3491   )   )
3492    
# Line 3666  frame instead." Line 3496  frame instead."
3496    "Recenter a speedbar buffer so the current indentation level is all visible.    "Recenter a speedbar buffer so the current indentation level is all visible.
3497  This assumes that the cursor is on a file, or tag of a file which the user is  This assumes that the cursor is on a file, or tag of a file which the user is
3498  interested in."  interested in."
   (if (<= (count-lines (point-min) (point-max))  
           (1- (window-height (selected-window))))  
       ;; whole buffer fits  
       (let ((cp (point)))  
         (goto-char (point-min))  
         (recenter 0)  
         (goto-char cp))  
     ;; too big  
     (let (depth start end exp p)  
       (save-excursion  
         (beginning-of-line)  
         (setq depth (if (looking-at "[0-9]+")  
                         (string-to-int (buffer-substring-no-properties  
                                         (match-beginning 0) (match-end 0)))  
                       0))  
         (setq exp (format "^%d:\\s-*[[{<]\\([?+-]\\)[]>}]" depth)))  
       (save-excursion  
         (end-of-line)  
         (if (re-search-backward exp nil t)  
             (setq start (point))  
           (setq start (point-min)))  
         (save-excursion                 ;Not sure about this part.  
           (end-of-line)  
           (setq p (point))  
           (while (and (not (re-search-forward exp nil t))  
                       (>= depth 0))  
             (setq depth (1- depth))  
             (setq exp (format "^%d:\\s-*[[{<]\\([?+-]\\)[]>}]" depth)))  
           (if (/= (point) p)  
               (setq end (point))  
             (setq end (point-max)))))  
       ;; Now work out the details of centering  
       (let ((nl (count-lines start end))  
             (cp (point)))  
         (if (> nl (window-height (selected-window)))  
             ;; We can't fit it all, so just center on cursor  
             (progn (goto-char start)  
                    (recenter 1))  
           ;; we can fit everything on the screen, but...  
           (if (and (pos-visible-in-window-p start (selected-window))  
                    (pos-visible-in-window-p end (selected-window)))  
               ;; we are all set!  
               nil  
             ;; we need to do something...  
             (goto-char start)  
             (let ((newcent (/ (- (window-height (selected-window)) nl) 2))  
                   (lte (count-lines start (point-max))))  
               (if (and (< (+ newcent lte) (window-height (selected-window)))  
                        (> (- (window-height (selected-window)) lte 1)  
                           newcent))  
                   (setq newcent (- (window-height (selected-window))  
                                    lte 1)))  
               (recenter newcent))))  
         (goto-char cp)))))  
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))))))
3562    
3563  ;;; Tag Management -- List of expanders:  ;;; Tag Management -- List of expanders:
3564  ;;  ;;
# Line 3730  This uses the entries in `speedbar-dynam Line 3568  This uses the entries in `speedbar-dynam
3568  to find the proper tags.  It is up to each of those individual  to find the proper tags.  It is up to each of those individual
3569  functions to do caching and flushing if appropriate."  functions to do caching and flushing if appropriate."
3570    (save-excursion    (save-excursion
3571      (set-buffer (find-file-noselect file))      ;; 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)))
3577      ;; If there is a buffer-local value of      ;; If there is a buffer-local value of
3578      ;; speedbar-dynamic-tags-function-list, it will now be available.      ;; speedbar-dynamic-tags-function-list, it will now be available.
3579      (let ((dtf speedbar-dynamic-tags-function-list)      (let ((dtf speedbar-dynamic-tags-function-list)
# Line 3738  functions to do caching and flushing if Line 3581  functions to do caching and flushing if
3581        (while (and (eq ret t) dtf)        (while (and (eq ret t) dtf)
3582          (setq ret          (setq ret
3583                (if (fboundp (car (car dtf)))                (if (fboundp (car (car dtf)))
3584                    (funcall (car (car dtf)) (buffer-file-name))                    (funcall (car (car dtf)) file)
3585                  t))                  t))
3586          (if (eq ret t)          (if (eq ret t)
3587              (setq dtf (cdr dtf))))              (setq dtf (cdr dtf))))
# Line 3755  functions to do caching and flushing if Line 3598  functions to do caching and flushing if
3598    
3599      nil      nil
3600    
3601  (eval-when-compile (condition-case nil (require 'imenu) (error nil)))  (eval-when-compile (if (locate-library "imenu") (require 'imenu)))
3602    
3603  (defun speedbar-fetch-dynamic-imenu (file)  (defun speedbar-fetch-dynamic-imenu (file)
3604    "Load FILE into a buffer, and generate tags using Imenu.    "Load FILE into a buffer, and generate tags using Imenu.
3605  Returns the tag list, or t for an error."  Returns the tag list, or t for an error."
3606    ;; Load this AND compile it in    ;; Load this AND compile it in
3607    (require 'imenu)    (require 'imenu)
3608    (if speedbar-power-click (setq imenu--index-alist nil))    (set-buffer (find-file-noselect file))
3609      (if dframe-power-click (setq imenu--index-alist nil))
3610    (condition-case nil    (condition-case nil
3611        (let ((index-alist (imenu--make-index-alist t)))        (let ((index-alist (imenu--make-index-alist t)))
3612          (if speedbar-sort-tags          (if speedbar-sort-tags
# Line 3776  Returns the tag list, or t for an error. Line 3620  Returns the tag list, or t for an error.
3620  ;;  ;;
3621  (defvar speedbar-fetch-etags-parse-list  (defvar speedbar-fetch-etags-parse-list
3622    '(;; Note that java has the same parse-group as c    '(;; Note that java has the same parse-group as c
3623      ("\\.\\([cChH]\\|c\\+\\+\\|cpp\\|cc\\|hh\\|java\\)\\'" .      ("\\.\\([cChH]\\|c\\+\\+\\|cpp\\|cc\\|hh\\|java\\|cxx\\|hxx\\)\\'" .
3624       speedbar-parse-c-or-c++tag)       speedbar-parse-c-or-c++tag)
3625      ("^\\.emacs$\\|.\\(el\\|l\\|lsp\\)\\'" .      ("^\\.emacs$\\|.\\(el\\|l\\|lsp\\)\\'" .
3626       "def[^i]+\\s-+\\(\\(\\w\\|[-_]\\)+\\)\\s-*\C-?")       "def[^i]+\\s-+\\(\\(\\w\\|[-_]\\)+\\)\\s-*\C-?")
# Line 3906  regular expression EXPR." Line 3750  regular expression EXPR."
3750                                              (point))                                              (point))
3751                                            t)))                                            t)))
3752                  (if (and j sym)                  (if (and j sym)
3753                      (1+ (string-to-int (buffer-substring-no-properties                      (1+ (string-to-number (buffer-substring-no-properties
3754                                          (match-beginning 2)                                          (match-beginning 2)
3755                                          (match-end 2))))                                          (match-end 2))))
3756                    0))))                    0))))
# Line 3955  regular expression EXPR." Line 3799  regular expression EXPR."
3799    (define-key speedbar-buffers-key-map "+" 'speedbar-expand-line)    (define-key speedbar-buffers-key-map "+" 'speedbar-expand-line)
3800    (define-key speedbar-buffers-key-map "=" 'speedbar-expand-line)    (define-key speedbar-buffers-key-map "=" 'speedbar-expand-line)
3801    (define-key speedbar-buffers-key-map "-" 'speedbar-contract-line)    (define-key speedbar-buffers-key-map "-" 'speedbar-contract-line)
3802      (define-key speedbar-buffers-key-map " " 'speedbar-toggle-line-expansion)
3803    
3804    ;; Buffer specific keybindings    ;; Buffer specific keybindings
3805    (define-key speedbar-buffers-key-map "k" 'speedbar-buffer-kill-buffer)    (define-key speedbar-buffers-key-map "k" 'speedbar-buffer-kill-buffer)
# Line 3975  regular expression EXPR." Line 3820  regular expression EXPR."
3820                       (looking-at "[0-9]+: *.-. "))]                       (looking-at "[0-9]+: *.-. "))]
3821      ["Kill Buffer" speedbar-buffer-kill-buffer      ["Kill Buffer" speedbar-buffer-kill-buffer
3822       (save-excursion (beginning-of-line)       (save-excursion (beginning-of-line)
3823                       (looking-at "[0-9]+: *.-. "))]                       (looking-at "[0-9]+: *.[-+?]. "))]
3824      ["Revert Buffer" speedbar-buffer-revert-buffer      ["Revert Buffer" speedbar-buffer-revert-buffer
3825       (save-excursion (beginning-of-line)       (save-excursion (beginning-of-line)
3826                       (looking-at "[0-9]+: *.-. "))]                       (looking-at "[0-9]+: *.[-+?]. "))]
3827      )      )
3828    "Menu item elements shown when displaying a buffer list.")    "Menu item elements shown when displaying a buffer list.")
3829    
3830  (defun speedbar-buffer-buttons (directory zero)  (defun speedbar-buffer-buttons (directory zero)
3831    "Create speedbar buttons based on the buffers currently loaded.    "Create speedbar buttons based on the buffers currently loaded.
3832  DIRECTORY is the path to the currently active buffer, and ZERO is 0."  DIRECTORY is the directory to the currently active buffer, and ZERO is 0."
3833    (speedbar-buffer-buttons-engine nil))    (speedbar-buffer-buttons-engine nil))
3834    
3835  (defun speedbar-buffer-buttons-temp (directory zero)  (defun speedbar-buffer-buttons-temp (directory zero)
3836    "Create speedbar buttons based on the buffers currently loaded.    "Create speedbar buttons based on the buffers currently loaded.
3837  DIRECTORY is the path to the currently active buffer, and ZERO is 0."  DIRECTORY is the directory to the currently active buffer, and ZERO is 0."
3838    (speedbar-buffer-buttons-engine t))    (speedbar-buffer-buttons-engine t))
3839    
3840  (defun speedbar-buffer-buttons-engine (temp)  (defun speedbar-buffer-buttons-engine (temp)
3841    "Create speedbar buffer buttons.    "Create speedbar buffer buttons.
3842  If TEMP is non-nil, then clicking on a buffer restores the previous display."  If TEMP is non-nil, then clicking on a buffer restores the previous display."
3843    (insert "Active Buffers:\n")    (speedbar-insert-separator "Active Buffers:")
3844    (let ((bl (buffer-list)))    (let ((bl (buffer-list))
3845            (case-fold-search t))
3846      (while bl      (while bl
3847        (if (string-match "^[ *]" (buffer-name (car bl)))        (if (string-match "^[ *]" (buffer-name (car bl)))
3848            nil            nil
# Line 4010  If TEMP is non-nil, then clicking on a b Line 3856  If TEMP is non-nil, then clicking on a b
3856                                    (if fname (file-name-nondirectory fname))                                    (if fname (file-name-nondirectory fname))
3857                                    (buffer-name (car bl))                                    (buffer-name (car bl))
3858                                    'speedbar-buffer-click temp                                    'speedbar-buffer-click temp
3859                                    'speedbar-file-face 0)))                                    'speedbar-file-face 0)
3860              (speedbar-buffers-tail-notes (car bl))))
3861        (setq bl (cdr bl)))        (setq bl (cdr bl)))
3862      (setq bl (buffer-list))      (setq bl (buffer-list))
3863      (insert "Scratch Buffers:\n")      (speedbar-insert-separator "Scratch Buffers:")
3864      (while bl      (while bl
3865        (if (not (string-match "^\\*" (buffer-name (car bl))))        (if (not (string-match "^\\*" (buffer-name (car bl))))
3866            nil            nil
# Line 4022  If TEMP is non-nil, then clicking on a b Line 3869  If TEMP is non-nil, then clicking on a b
3869            (speedbar-make-tag-line 'bracket ?? nil nil            (speedbar-make-tag-line 'bracket ?? nil nil
3870                                    (buffer-name (car bl))                                    (buffer-name (car bl))
3871                                    'speedbar-buffer-click temp                                    'speedbar-buffer-click temp
3872                                    'speedbar-file-face 0)))                                    'speedbar-file-face 0)
3873              (speedbar-buffers-tail-notes (car bl))))
3874        (setq bl (cdr bl)))        (setq bl (cdr bl)))
3875      (setq bl (buffer-list))      (setq bl (buffer-list))
3876      (insert "Hidden Buffers:\n")      ;;(speedbar-insert-separator "Hidden Buffers:")
3877      (while bl      ;;(while bl
3878        (if (not (string-match "^ " (buffer-name (car bl))))      ;;  (if (not (string-match "^ " (buffer-name (car bl))))
3879            nil      ;;    nil
3880          (if (eq (car bl) speedbar-buffer)      ;;  (if (eq (car bl) speedbar-buffer)
3881              nil      ;;      nil
3882            (speedbar-make-tag-line 'bracket ?? nil nil      ;;    (speedbar-make-tag-line 'bracket ?? nil nil
3883                                    (buffer-name (car bl))      ;;                            (buffer-name (car bl))
3884                                    'speedbar-buffer-click temp      ;;                            'speedbar-buffer-click temp
3885                                    'speedbar-file-face 0)))      ;;                            'speedbar-file-face 0)
3886        (setq bl (cdr bl)))))      ;;    (speedbar-buffers-tail-notes (car bl))))
3887        ;;  (setq bl (cdr bl)))
3888        ))
3889    
3890    (defun speedbar-buffers-tail-notes (buffer)
3891      "Add a note to the end of the last tag line.
3892    Argument BUFFER is the buffer being tested."
3893      (let (mod ro)
3894        (save-excursion
3895          (set-buffer buffer)
3896          (setq mod (buffer-modified-p)
3897                ro buffer-read-only))
3898        (if ro (speedbar-insert-button "%" nil nil nil nil t))))
3899    
3900  (defun speedbar-buffers-item-info ()  (defun speedbar-buffers-item-info ()
3901    "Display information about the current buffer on the current line."    "Display information about the current buffer on the current line."
# Line 4051  If TEMP is non-nil, then clicking on a b Line 3911  If TEMP is non-nil, then clicking on a b
3911                                                 (buffer-size))                                                 (buffer-size))
3912                                 (or (buffer-file-name buffer) "<No file>"))))))                                 (or (buffer-file-name buffer) "<No file>"))))))
3913    
3914  (defun speedbar-buffers-line-path (&optional depth)  (defun speedbar-buffers-line-directory (&optional depth)
3915    "Fetch the full path to the file (buffer) specified on the current line.    "Fetch the full directory to the file (buffer) specified on the current line.
3916  Optional argument DEPTH specifies the current depth of the back search."  Optional argument DEPTH specifies the current depth of the back search."
3917    (save-excursion    (save-excursion
3918      (end-of-line)      (end-of-line)
# Line 4066  Optional argument DEPTH specifies the cu Line 3926  Optional argument DEPTH specifies the cu
3926                (if (save-excursion                (if (save-excursion
3927                      (end-of-line)                      (end-of-line)
3928                      (eq start (point)))                      (eq start (point)))
3929                    (file-name-directory (buffer-file-name buffer))                    (or (save-excursion (set-buffer buffer)
3930                                          default-directory)
3931                          "")
3932                  (buffer-file-name buffer))))))))                  (buffer-file-name buffer))))))))
3933    
3934  (defun speedbar-buffer-click (text token indent)  (defun speedbar-buffer-click (text token indent)
3935    "When the users clicks on a buffer-button in speedbar.    "When the users clicks on a buffer-button in speedbar.
3936  TEXT is the buffer's name, TOKEN and INDENT are unused."  TEXT is the buffer's name, TOKEN and INDENT are unused."
3937    (if speedbar-power-click    (if dframe-power-click
3938        (let ((pop-up-frames t)) (select-window (display-buffer text)))        (let ((pop-up-frames t)) (select-window (display-buffer text)))
3939      (select-frame speedbar-attached-frame)      (dframe-select-attached-frame speedbar-frame)
3940      (switch-to-buffer text)      (switch-to-buffer text)
3941      (if token (speedbar-change-initial-expansion-list      (if token (speedbar-change-initial-expansion-list
3942                 speedbar-previously-used-expansion-list-name))))                 speedbar-previously-used-expansion-list-name))))
# Line 4083  TEXT is the buffer's name, TOKEN and IND Line 3945  TEXT is the buffer's name, TOKEN and IND
3945    "Kill the buffer the cursor is on in the speedbar buffer."    "Kill the buffer the cursor is on in the speedbar buffer."
3946    (interactive)    (interactive)
3947    (or (save-excursion    (or (save-excursion
3948          (beginning-of-line)          (let ((text (speedbar-line-text)))
3949          ;; If this fails, then it is a non-standard click, and as such,            (if (and (get-buffer text)
3950          ;; perfectly allowed.                     (speedbar-y-or-n-p (format "Kill buffer %s? " text)))
3951          (if (re-search-forward "[]>?}] [^ ]"                (kill-buffer text))
3952                                 (save-excursion (end-of-line) (point))            (speedbar-refresh)))))
                                t)  
             (let ((text (progn  
                           (forward-char -1)  
                           (buffer-substring (point) (save-excursion  
                                                       (end-of-line)  
                                                       (point))))))  
               (if (and (get-buffer text)  
                        (speedbar-y-or-n-p (format "Kill buffer %s? " text)))  
                   (kill-buffer text))  
               (speedbar-refresh))))))  
3953    
3954  (defun speedbar-buffer-revert-buffer ()  (defun speedbar-buffer-revert-buffer ()
3955    "Revert the buffer the cursor is on in the speedbar buffer."    "Revert the buffer the cursor is on in the speedbar buffer."
# Line 4168  TEXT is the buffer's name, TOKEN and IND Line 4020  TEXT is the buffer's name, TOKEN and IND
4020                                 (:foreground "cyan4"))                                 (:foreground "cyan4"))
4021                                (((class color) (background dark))                                (((class color) (background dark))
4022                                 (:foreground "cyan"))                                 (:foreground "cyan"))
4023                                (t (:weight bold)))                                (t (:bold t)))
4024    "Face used for file names."    "Face used for file names."
4025    :group 'speedbar-faces)    :group 'speedbar-faces)
4026    
# Line 4197  TEXT is the buffer's name, TOKEN and IND Line 4049  TEXT is the buffer's name, TOKEN and IND
4049                                      (:background "green"))                                      (:background "green"))
4050                                     (((class color) (background dark))                                     (((class color) (background dark))
4051                                      (:background "sea green"))                                      (:background "sea green"))
4052                                     (((class grayscale mono)                                     (((class grayscale monochrome)
4053                                       (background light))                                       (background light))
4054                                      (:background "black"))                                      (:background "black"))
4055                                     (((class grayscale mono)                                     (((class grayscale monochrome)
4056                                       (background dark))                                       (background dark))
4057                                      (:background "white")))                                      (:background "white")))
4058    "Face used for highlighting buttons with the mouse."    "Face used for highlighting buttons with the mouse."
4059    :group 'speedbar-faces)    :group 'speedbar-faces)
4060    
4061    (defface speedbar-separator-face '((((class color) (background light))
4062  ;;; Image loading and inlining                                      (:background "blue"
4063  ;;                                       :foreground "white"
4064                                         :overline "gray"))
4065  ;;; Some images if defimage is available:                                     (((class color) (background dark))
4066  (eval-when-compile                                      (:background "blue"
4067                                         :foreground "white"
4068  (if (fboundp 'defimage)                                       :overline "gray"))
4069      (defalias 'defimage-speedbar 'defimage)                                     (((class grayscale monochrome)
4070                                         (background light))
4071    (if (not (fboundp 'make-glyph))                                      (:background "black"
4072                                         :foreground "white"
4073  (defmacro defimage-speedbar (variable imagespec docstring)                                       :overline "white"))
4074    "Don't bother loading up an image...                                     (((class grayscale monochrome)
4075  Argument VARIABLE is the variable to define.                                       (background dark))
4076  Argument IMAGESPEC is the list defining the image to create.                                      (:background "white"
4077  Argument DOCSTRING is the documentation for VARIABLE."                                       :foreground "black"
4078    `(defvar ,variable nil ,docstring))                                       :overline "black")))
4079      "Face used for separator labes in a display."
4080  ;; ELSE    :group 'speedbar-faces)
 (defun speedbar-find-image-on-load-path (image)  
   "Find the image file IMAGE on the load path."  
   (let ((l load-path)  
         (r nil))  
     (while (and l (not r))  
       (if (file-exists-p (concat (car l) "/" image))  
           (setq r (concat (car l) "/" image)))  
       (setq l (cdr l)))  
     r))  
   
 (defun speedbar-convert-emacs21-imagespec-to-xemacs (spec)  
   "Convert the Emacs21 image SPEC into an XEmacs image spec."  
   (let* ((sl (car spec))  
          (itype (nth 1 sl))  
          (ifile (nth 3 sl)))  
     (vector itype ':file (speedbar-find-image-on-load-path ifile))))  
   
 (defmacro defimage-speedbar (variable imagespec docstring)  
   "Define VARIABLE as an image if `defimage' is not available.  
 IMAGESPEC is the image data, and DOCSTRING is documentation for the image."  
   `(defvar ,variable  
      ;; The Emacs21 version of defimage looks just like the XEmacs image  
      ;; specifier, except that it needs a :type keyword.  If we line  
      ;; stuff up right, we can use this cheat to support XEmacs specifiers.  
      (condition-case nil  
          (make-glyph  
           (make-image-specifier  
            (speedbar-convert-emacs21-imagespec-to-xemacs (quote ,imagespec)))  
           'buffer)  
        (error nil))  
      ,docstring)))))  
   
 (defimage-speedbar speedbar-directory-plus  
   ((:type xpm :file "sb-dir-plus.xpm" :ascent center))  
   "Image used for closed directories with stuff in them.")  
   
 (defimage-speedbar speedbar-directory-minus  
   ((:type xpm :file "sb-dir-minus.xpm" :ascent center))  
   "Image used for open directories with stuff in them.")  
   
 (defimage-speedbar speedbar-directory  
   ((:type xpm :file "sb-dir.xpm" :ascent center))  
   "Image used for empty or unreadable directories.")  
   
 (defimage-speedbar speedbar-page-plus  
   ((:type xpm :file "sb-pg-plus.xpm" :ascent center))  
   "Image used for closed files with stuff in them.")  
   
 (defimage-speedbar speedbar-page-minus  
   ((:type xpm :file "sb-pg-minus.xpm" :ascent center))  
   "Image used for open files with stuff in them.")  
   
 (defimage-speedbar speedbar-page  
   ((:type xpm :file "sb-pg.xpm" :ascent center))  
   "Image used for files that can't be opened.")  
   
 (defimage-speedbar speedbar-tag  
   ((:type xpm :file "sb-tag.xpm" :ascent center))  
   "Image used for tags.")  
   
 (defimage-speedbar speedbar-tag-plus  
   ((:type xpm :file "sb-tag-plus.xpm" :ascent center))  
   "Image used for closed tag groups.")  
   
 (defimage-speedbar speedbar-tag-minus  
   ((:type xpm :file "sb-tag-minus.xpm" :ascent center))  
   "Image used for open tag groups.")  
   
 (defimage-speedbar speedbar-tag-gt  
   ((:type xpm :file "sb-tag-gt.xpm" :ascent center))  
   "Image used for open tag groups.")  
   
 (defimage-speedbar speedbar-tag-v  
   ((:type xpm :file "sb-tag-v.xpm" :ascent center))  
   "Image used for open tag groups.")  
   
 (defimage-speedbar speedbar-tag-type  
   ((:type xpm :file "sb-tag-type.xpm" :ascent center))  
   "Image used for open tag groups.")  
   
 (defimage-speedbar speedbar-mail  
   ((:type xpm :file "sb-mail.xpm" :ascent center))  
   "Image used for open tag groups.")  
   
 (defvar speedbar-expand-image-button-alist  
   '(("<+>" . speedbar-directory-plus)  
     ("<->" . speedbar-directory-minus)  
     ("< >" . speedbar-directory)  
     ("[+]" . speedbar-page-plus)  
     ("[-]" . speedbar-page-minus)  
     ("[?]" . speedbar-page)  
     ("{+}" . speedbar-tag-plus)  
     ("{-}" . speedbar-tag-minus)  
     ("<M>" . speedbar-mail)  
     (" =>" . speedbar-tag)  
     (" +>" . speedbar-tag-gt)  
     (" ->" . speedbar-tag-v)  
     (">" . speedbar-tag)  
     ("@" . speedbar-tag-type)  
     ("  @" . speedbar-tag-type)  
     )  
   "List of text and image associations.")  
   
 (defun speedbar-insert-image-button-maybe (start length)  
   "Insert an image button based on text starting at START for LENGTH chars.  
 If buttontext is unknown, just insert that text.  
 If we have an image associated with it, use that image."  
   (if speedbar-use-images  
       (let* ((bt (buffer-substring start (+ length start)))  
              (a (assoc bt speedbar-expand-image-button-alist)))  
         ;; Regular images (created with `insert-image' are intangible  
         ;; which (I suppose) make them more compatible with XEmacs 21.  
         ;; Unfortunatly, there is a giant pile o code dependent on the  
         ;; underlying text.  This means if we leave it tangible, then I  
         ;; don't have to change said giant piles o code.  
         (if (and a (symbol-value (cdr a)))  
             (if (featurep 'xemacs)  
                 (add-text-properties (+ start (length bt)) start  
                                      (list 'end-glyph (symbol-value (cdr a))  
                                            'rear-nonsticky (list 'display)  
                                            'invisible t  
                                            'detachable t))  
               (add-text-properties start (+ start (length bt))  
                                    (list 'display (symbol-value (cdr a))  
                                          'rear-nonsticky (list 'display))))  
           ;(message "Bad text [%s]" (buffer-substring start (+ start length)))  
           ))))  
   
4081    
4082  ;; some edebug hooks  ;; some edebug hooks
4083  (add-hook 'edebug-setup-hook  (add-hook 'edebug-setup-hook
4084            (lambda ()            (lambda ()
4085              (def-edebug-spec speedbar-with-writable def-body)))              (def-edebug-spec speedbar-with-writable def-body)))
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    
4094  (provide 'speedbar)  (provide 'speedbar)
4095    ;;; speedbar ends here
4096    
4097  ;; run load-time hooks  ;; run load-time hooks
4098  (run-hooks 'speedbar-load-hook)  (run-hooks 'speedbar-load-hook)
   
 ;; arch-tag: 4477e6d1-f78c-48b9-a503-387d3c9767d5  
 ;;; speedbar.el ends here  

Legend:
Removed from v.1.67  
changed lines
  Added in v.1.68

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26