--- /dev/null
+;;; speedbar --- quick access to files and tags
+
+;;; Copyright (C) 1996, 97, 98 Free Software Foundation
+;;
+;; Author: Eric M. Ludlam <zappo@gnu.ai.mit.edu>
+;; Version: 0.6.2
+;; Keywords: file, tags, tools
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+;;
+;; The speedbar provides a frame in which files, and locations in
+;; files are displayed. These items can be clicked on with mouse-2
+;; in order to make the last active frame display that file location.
+;;
+;; Starting Speedbar:
+;;
+;; If speedbar came to you as a part of Emacs, simply type
+;; `M-x speedbar', and it will be autoloaded for you. A "Speedbar"
+;; submenu will be added under "Tools".
+;;
+;; If speedbar is not a part of your distribution, then add
+;; this to your .emacs file:
+;;
+;; (autoload 'speedbar-frame-mode "speedbar" "Popup a speedbar frame" t)
+;; (autoload 'speedbar-get-focus "speedbar" "Jump to speedbar frame" t)
+;;
+;; If you want to choose it from a menu, you can do this:
+;;
+;; Emacs:
+;; (define-key-after (lookup-key global-map [menu-bar tools])
+;; [speedbar] '("Speedbar" . speedbar-frame-mode) [calendar])
+;;
+;; XEmacs:
+;; (add-menu-button '("Tools")
+;; ["Speedbar" speedbar-frame-mode
+;; :style toggle
+;; :selected (and (boundp 'speedbar-frame)
+;; (frame-live-p speedbar-frame)
+;; (frame-visible-p speedbar-frame))]
+;; "--")
+;;
+;; 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.
+;;
+;; To prevent speedbar from following you into certain directories
+;; use the function `speedbar-add-ignored-path-regexp' too 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.
+;;
+;; To add new file types to imenu, see the documentation in the
+;; 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'.
+;;
+;; If the updates are going too slow for you, modify the variable
+;; `speedbar-update-speed' to a longer idle time before updates.
+;;
+;; If you navigate directories, you will probably notice that you
+;; will navigate to a directory which is eventually replaced after
+;; you go back to editing a file (unless you pull up a new file.)
+;; The delay time before this happens is in
+;; `speedbar-navigating-speed', and defaults to 10 seconds.
+;;
+;; Users XEmacs previous to 20 may want to change the default
+;; timeouts for `speedbar-update-speed' to something longer as XEmacs
+;; doesn't have idle timers, the speedbar timer keeps going off
+;; arbitrarily while you're typing. It's quite pesky.
+;;
+;; Users of really old emacsen without the needed timers will not
+;; have speedbar updating automatically. Use "r" to refresh the
+;; display after changing directories. Remember, do not interrupt the
+;; stealthy updates or your display may not be completely refreshed.
+;;
+;; See optional file `speedbspec.el' for additional configurations
+;; which allow speedbar to create specialized lists for special modes
+;; that are not file-related.
+;;
+;; AUC-TEX users: The imenu tags for AUC-TEX mode don't work very
+;; well. Use the imenu keywords from tex-mode.el for better results.
+;;
+;; This file requires the library package assoc (association lists)
+;; and the package custom (for easy configuration of speedbar)
+;; http://www.dina.kvl.dk/~abraham/custom/
+;;
+;; If you do not have custom installed, you can still get face colors
+;; by modifying the faces directly in your .emacs file, or setting
+;; them in your .Xdefaults file.
+;; Here is an example .Xdefaults for a dark background:
+;;
+;; emacs*speedbar-button-face.attributeForeground: Aquamarine
+;; emacs*speedbar-selected-face.attributeForeground: red
+;; emacs*speedbar-selected-face.attributeUnderline: true
+;; emacs*speedbar-directory-face.attributeForeground: magenta
+;; emacs*speedbar-file-face.attributeForeground: green3
+;; emacs*speedbar-highlight-face.attributeBackground: sea green
+;; emacs*speedbar-tag-face.attributeForeground: yellow
+
+;;; Speedbar updates can be found at:
+;; ftp://ftp.ultranet.com/pub/zappo/speedbar*.tar.gz
+;;
+
+;;; Change log:
+;; 0.1 Initial Revision
+;; 0.2 Fixed problem with x-pointer-shape causing future frames not
+;; to be created.
+;; Fixed annoying habit of `speedbar-update-contents' to make
+;; it possible to accidentally kill the speedbar buffer.
+;; Clicking directory names now only changes the contents of
+;; the speedbar, and does not cause a dired mode to appear.
+;; Clicking the <+> next to the directory does cause dired to
+;; be run.
+;; Added XEmacs support, which means timer support moved to a
+;; platform independant call.
+;; Added imenu support. Now modes are supported by imenu
+;; first, and etags only if the imenu call doesn't work.
+;; Imenu is a little faster than etags, and is more emacs
+;; friendly.
+;; Added more user control variables described in the commentary.
+;; Added smart recentering when nodes are opened and closed.
+;; 0.3 x-pointer-shape fixed for emacs 19.35, so I put that check in.
+;; Added invisible codes to the beginning of each line.
+;; Added list aproach to node expansion for easier addition of new
+;; types of things to expand by
+;; Added multi-level path name support
+;; Added multi-level tag name support.
+;; Only mouse-2 is now used for node expansion
+;; Added keys e + - to edit expand, and contract node lines
+;; Added longer legal file regexp for all those modes which support
+;; imenu. (pascal, fortran90, ada, pearl)
+;; Added pascal support to etags from Dave Penkler <dave_penkler@grenoble.hp.com>
+;; Fixed centering algorithm
+;; Tried to choose background independent colors. Made more robust.
+;; Rearranged code into a more logical order
+;; 0.3.1 Fixed doc & broken keybindings
+;; Added mode hooks.
+;; Improved color selection to be background mode smart
+;; `nil' passed to `speedbar-frame-mode' now toggles the frame as
+;; advertised in the doc string
+;; 0.4a Added modified patch from Dan Schmidt <dfan@lglass.com> allowing a
+;; directory cache to be maintained speeding up revisiting of files.
+;; Default raise-lower behavior is now off by default.
+;; Added some menu items for edit expand and contract.
+;; Pre 19.31 emacsen can run without idle timers.
+;; Added some patch information from Farzin Guilak <farzin@protocol.com>
+;; adding xemacs specifics, and some etags upgrades.
+;; Added ability to set a faces symbol-value to a string
+;; representing the desired foreground color. (idea from
+;; Farzin Guilak, but implemented differently)
+;; Fixed problem with 1 character buttons.
+;; Added support for new Imenu marker technique.
+;; Added `speedbar-load-hooks' for things to run only once on
+;; load such as updating one of the many lists.
+;; Added `speedbar-supported-extension-expressions' which is a
+;; list of extensions that speedbar will tag. This variable
+;; should only be updated with `speedbar-add-supported-extension'
+;; Moved configure dialog support to a separate file so
+;; speedbar is not dependant on eieio to run
+;; Fixed list-contraction problem when the item was at the end
+;; of a sublist.
+;; Fixed XEmacs multi-frame timer selecting bug problem.
+;; Added `speedbar-ignored-modes' which is a list of major modes
+;; speedbar will not follow when it is displayed in the selected frame
+;; 0.4 When the file being edited is not in the list, and is a file
+;; that should be in the list, the speedbar cache is replaced.
+;; Temp buffers are now shown in the attached frame not the
+;; speedbar frame
+;; New variables `speedbar-vc-*' and `speedbar-stealthy-function-list'
+;; added. `speedbar-update-current-file' is now a member of
+;; the stealthy list. New function `speedbar-check-vc' will
+;; examine each file and mark it if it is checked out. To
+;; add new version control types, override the function
+;; `speedbar-this-file-in-vc' and `speedbar-vc-check-dir-p'.
+;; The stealth list is interruptible so that long operations
+;; do not interrupt someones editing flow. Other long
+;; speedbar updates will be added to the stealthy list in the
+;; future should interesting ones be needed.
+;; Added many new functions including:
+;; `speedbar-item-byte-compile' `speedbar-item-load'
+;; `speedbar-item-copy' `speedbar-item-rename' `speedbar-item-delete'
+;; and `speedbar-item-info'
+;; If the user kills the speedbar buffer in some way, the frame will
+;; be removed.
+;; 0.4.1 Bug fixes
+;; <mark.jeffries@nomura.co.uk> added `speedbar-update-flag',
+;; XEmacs fixes for menus, and tag sorting, and quit key.
+;; Modeline now updates itself based on window-width.
+;; Frame is cached when closed to make pulling it up again faster.
+;; Speedbars window is now marked as dedicated.
+;; Added bindings: <grossjoh@charly.informatik.uni-dortmund.de>
+;; Long directories are now span multiple lines autmoatically
+;; Added `speedbar-directory-button-trim-method' to specify how to
+;; sorten the directory button to fit on the screen.
+;; 0.4.2 Add one level of full-text cache.
+;; Add `speedbar-get-focus' to switchto/raise the speedbar frame.
+;; Editing thing-on-line will auto-raise the attached frame.
+;; Bound `U' to `speedbar-up-directory' command.
+;; Refresh will now maintain all subdirectories that were open
+;; when the refresh was requested. (This does not include the
+;; tags, only the directories)
+;; 0.4.3 Bug fixes
+;; 0.4.4 Added `speedbar-ignored-path-expressions' and friends.
+;; Configuration menu items not displayed if dialog-mode not present
+;; Speedbar buffer now starts with a space, and is not deleted
+;; ewhen the speedbar frame is closed. This prevents the invisible
+;; frame from preventing buffer switches with other buffers.
+;; Fixed very bad bug in the -add-[extension|path] functions.
+;; Added `speedbar-find-file-in-frame' which will always pop up a frame
+;; that is already display a buffer selected in the speedbar buffer.
+;; Added S-mouse2 as "power click" for always poping up a new frame.
+;; and always rescanning with imenu (ditching the imenu cache), and
+;; always rescanning directories.
+;; 0.4.5 XEmacs bugfixes and enhancements.
+;; Window Title simplified.
+;; 0.4.6 Fixed problems w/ dedicated minibuffer frame.
+;; Fixed errors reported by checkdoc.
+;; 0.5 Mode-specific contents added. Controlled w/ the variable
+;; `speedbar-mode-specific-contents-flag'. See speedbspec
+;; for info on enabling this feature.
+;; `speedbar-load-hook' name change and pointer check against
+;; major-mode. Suggested by Sam Steingold <sds@ptc.com>
+;; Quit auto-selects the attached frame.
+;; Ranamed `speedbar-do-updates' to `speedbar-update-flag'
+;; Passes checkdoc.
+;; 0.5.1 Advice from ptype@dra.hmg.gb:
+;; Use `post-command-idle-hook' in older emacsen
+;; `speedbar-sort-tags' now works with imenu.
+;; Unknown files (marked w/ ?) can now be operated on w/
+;; file commands.
+;; `speedbar-vc-*-hook's for easilly adding new version control systems.
+;; Checkin/out w/ vc will reset the scanners and update the * marker.
+;; Fixed ange-ftp require compile time problem.
+;; Fixed XEmacs menu bar bug.
+;; Added `speedbar-activity-change-focus-flag' to control if the
+;; focus changes w/ mouse events.
+;; Added `speedbar-sort-tags' toggle to the menubar.
+;; Added `speedbar-smart-directory-expand-flag' to toggle how
+;; new directories might be inserted into the speedbar hierarchy.
+;; Added `speedbar-visiting-[tag|file]hook' which is called whenever
+;; speedbar pulls up a file or tag in the attached frame. Setting
+;; this to `reposition-window' will do nice things to function tags.
+;; Fixed text-cache default-directory bug.
+;; Emacs 20 char= support.
+;; 0.5.2 Customization
+;; For older emacsen, you will need to download the new defcustom
+;; package to get nice faces for speedbar
+;; mouse1 Double-click is now the same as middle click.
+;; No mouse pointer shape stuff for XEmacs (is there any?)
+;; 0.5.3 Regressive support for non-custom enabled emacsen.
+;; Fixed serious problem w/ 0.5.2 and ignored paths.
+;; `condition-case' no longer used in timer fcn.
+;; `speedbar-edit-line' is now smarter w/ special modes.
+;; 0.5.4 Fixed more problems for Emacs 20 so speedbar loads correctly.
+;; Updated some documentation strings.
+;; Added customization menu item, and customized some more variables.
+;; 0.5.5 Fixed so that there can be no ignored paths
+;; Added .l & .lsp as lisp, suggested by: sshteingold@cctrading.com
+;; You can now adjust height in `speedbar-frame-parameters'
+;; XEmacs fix for use of `local-variable-p'
+;; 0.5.6 Folded in XEmacs suggestions from Hrvoje Niksic <hniksic@srce.hr>
+;; Several custom changes (group definitions, trim-method & others)
+;; Keymap changes, and ways to add menu items.
+;; Timer use changes for XEmacs 20.4
+;; Regular expression enhancements.
+;; 0.6 Fixed up some frame definition stuff, use more convenience fns.
+;; Rehashed frame creation code for better compatibility.
+;; Fixed setting of kill-buffer hook.
+;; Default speedbar has no menubar, mouse-3 is popup menu,
+;; XEmacs double-click capability (Hrvoje Niksic <hniksic@srce.hr>)
+;; General documentation fixup.
+;; 0.6.1 Fixed button-3 menu for Emacs 20.
+;; 0.6.2 Added autoload tag to `speedbar-get-focus'
+
+;;; TODO:
+;; - More functions to create buttons and options
+;; - filtering algorithms to reduce the number of tags/files displayed.
+;; - Timeout directories we haven't visited in a while.
+;; - Remeber tags when refreshing the display. (Refresh tags too?)
+;; - More 'special mode support.
+;; - C- Mouse 3 menu too much indirection
+
+(require 'assoc)
+(require 'easymenu)
+
+;; From custom web page for compatibility between versions of custom:
+(eval-and-compile
+ (condition-case ()
+ (require 'custom)
+ (error nil))
+ (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
+ nil ;; We've got what we needed
+ ;; We have the old custom-library, hack around it!
+ (defmacro defgroup (&rest args)
+ nil)
+ (defmacro defface (var values doc &rest args)
+ (` (progn
+ (defvar (, var) (quote (, var)))
+ ;; To make colors for your faces you need to set your .Xdefaults
+ ;; or set them up ahead of time in your .emacs file.
+ (make-face (, var))
+ )))
+ (defmacro defcustom (var value doc &rest args)
+ (` (defvar (, var) (, value) (, doc))))))
+
+;; customization stuff
+(defgroup speedbar nil
+ "File and tag browser frame."
+ :group 'tags
+ :group 'tools)
+
+(defgroup speedbar-faces nil
+ "Faces used in speedbar."
+ :prefix "speedbar-"
+ :group 'speedbar
+ :group 'faces)
+
+(defgroup speedbar-vc nil
+ "Version control display in speedbar."
+ :prefix "speedbar-"
+ :group 'speedbar)
+
+;;; Code:
+(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)))
+
+(defvar speedbar-initial-expansion-list
+ '(speedbar-directory-buttons speedbar-default-directory-list)
+ "List of functions to call to fill in the speedbar buffer.
+Whenever a top level update is issued all functions in this list are
+run. These functions will always get the default directory to use
+passed in as the first parameter, and a 0 as the second parameter.
+The 0 indicates the uppermost indentation level. They must assume
+that the cursor is at the position where they start inserting
+buttons.")
+
+(defvar speedbar-stealthy-function-list
+ '(speedbar-update-current-file speedbar-check-vc)
+ "List of functions to periodically call stealthily.
+Each function must return nil if interrupted, or t if completed.
+Stealthy functions which have a single operation should always return
+t. Functions which take a long time should maintain a state (where
+they are in their speedbar related calculations) and permit
+interruption. See `speedbar-check-vc' as a good example.")
+
+(defcustom speedbar-mode-specific-contents-flag t
+ "*Non-nil means speedbar will show special mode contents.
+This permits some modes to create customized contents for the speedbar
+frame."
+ :group 'speedbar
+ :type 'boolean)
+
+(defvar speedbar-special-mode-expansion-list nil
+ "Mode specific list of functions to call to fill in speedbar.
+Some modes, such as Info or RMAIL, do not relate quite as easily into
+a simple list of files. When this variable is non-nil and buffer-local,
+then these functions are used, creating specialized contents. These
+functions are called each time the speedbar timer is called. This
+allows a mode to update its contents regularly.
+
+ Each function is called with the default and frame belonging to
+speedbar, and with one parameter; the buffer requesting
+the speedbar display.")
+
+(defcustom speedbar-visiting-file-hook nil
+ "Hooks run when speedbar visits a file in the selected frame."
+ :group 'speedbar
+ :type 'hook)
+
+(defcustom speedbar-visiting-tag-hook nil
+ "Hooks run when speedbar visits a tag in the selected frame."
+ :group 'speedbar
+ :type 'hook)
+
+(defcustom speedbar-load-hook nil
+ "Hooks run when speedbar is loaded."
+ :group 'speedbar
+ :type 'hook)
+
+(defcustom speedbar-show-unknown-files nil
+ "*Non-nil show files we can't expand with a ? in the expand button.
+nil means don't show the file in the list."
+ :group 'speedbar
+ :type 'boolean)
+
+(defcustom speedbar-update-speed
+ (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)
+
+(defcustom speedbar-navigating-speed 10
+ "*Idle time to wait after navigation commands in speedbar are executed.
+Navigation commands included expanding/contracting nodes, and moving
+between different directories."
+ :group 'speedbar
+ :type 'integer)
+
+(defcustom speedbar-frame-parameters '((minibuffer . nil)
+ (width . 20)
+ (scroll-bar-width . 10)
+ (border-width . 0)
+ (menu-bar-lines . 0)
+ (unsplittable . t))
+ "*Parameters to use when creating the speedbar frame in Emacs.
+Parameters not listed here which will be added automatically are
+`height' which will be initialized to the height of the frame speedbar
+is attached to."
+ :group 'speedbar
+ :type '(repeat (sexp :tag "Parameter:")))
+
+;; These values by Hrvoje Niksic <hniksic@srce.hr>
+(defcustom speedbar-frame-plist
+ '(minibuffer nil width 20 border-width 0
+ internal-border-width 0 unsplittable t
+ default-toolbar-visible-p nil has-modeline-p nil
+ menubar-visible-p nil
+ ;; I don't see the particular value of these three, but...
+ text-pointer-glyph [cursor-font :data "top_left_arrow"]
+ nontext-pointer-glyph [cursor-font :data "top_left_arrow"]
+ selection-pointer-glyph [cursor-font :data "hand2"])
+ "*Parameters to use when creating the speedbar frame in XEmacs.
+Parameters not listed here which will be added automatically are
+`height' which will be initialized to the height of the frame speedbar
+is attached to."
+ :group 'speedbar
+ :type '(repeat (group :inline t
+ (symbol :tag "Property")
+ (sexp :tag "Value"))))
+
+(defcustom speedbar-use-imenu-flag (stringp (locate-library "imenu"))
+ "*Non-nil means use imenu for file parsing. nil to use etags.
+XEmacs prior to 20.4 doesn't support imenu, therefore the default is to
+use etags instead. Etags support is not as robust as imenu support."
+ :tag "User Imenu"
+ :group 'speedbar
+ :type 'boolean)
+
+(defcustom speedbar-sort-tags nil
+ "*If Non-nil, sort tags in the speedbar display."
+ :group 'speedbar
+ :type 'boolean)
+
+(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)
+
+(defcustom speedbar-directory-button-trim-method 'span
+ "*Indicates how the directory button will be displayed.
+Possible values are:
+ 'span - span large directories over multiple lines.
+ 'trim - trim large directories to only show the last few.
+ nil - no trimming."
+ :group 'speedbar
+ :type '(radio (const :tag "Span large directories over mutiple lines."
+ span)
+ (const :tag "Trim large directories to only show the last few."
+ trim)
+ (const :tag "No trimming." nil)))
+
+(defcustom speedbar-smart-directory-expand-flag t
+ "*Non-nil means speedbar should use smart expansion.
+Smart expansion only affects when speedbar wants to display a
+directory for a file in the attached frame. When smart expansion is
+enabled, new directories which are children of a displayed directory
+are expanded in the current framework. If nil, then the current
+hierarchy would be replaced with the new directory."
+ :group 'speedbar
+ :type 'boolean)
+
+(defcustom speedbar-before-popup-hook nil
+ "*Hooks called before popping up the speedbar frame."
+ :group 'speedbar
+ :type 'hook)
+
+(defcustom speedbar-before-delete-hook nil
+ "*Hooks called before deleting the speedbar frame."
+ :group 'speedbar
+ :type 'hook)
+
+(defcustom speedbar-mode-hook nil
+ "*Hooks called after creating a speedbar buffer."
+ :group 'speedbar
+ :type 'hook)
+
+(defcustom speedbar-timer-hook nil
+ "*Hooks called after running the speedbar timer function."
+ :group 'speedbar
+ :type 'hook)
+
+(defcustom speedbar-verbosity-level 1
+ "*Verbosity level of the speedbar. 0 means say nothing.
+1 means medium level verbosity. 2 and higher are higher levels of
+verbosity."
+ :group 'speedbar
+ :type 'integer)
+
+(defcustom speedbar-vc-do-check t
+ "*Non-nil check all files in speedbar to see if they have been checked out.
+Any file checked out is marked with `speedbar-vc-indicator'"
+ :group 'speedbar-vc
+ :type 'boolean)
+
+(defvar speedbar-vc-indicator " *"
+ "Text used to mark files which are currently checked out.
+Currently only RCS is supported. Other version control systems can be
+added by examining the function `speedbar-this-file-in-vc' and
+`speedbar-vc-check-dir-p'")
+
+(defcustom speedbar-scanner-reset-hook nil
+ "*Hook called whenever generic scanners are reset.
+Set this to implement your own scanning / rescan safe functions with
+state data."
+ :group 'speedbar
+ :type 'hook)
+
+(defcustom speedbar-vc-path-enable-hook nil
+ "*Return non-nil if the current path should be checked for Version Control.
+Functions in this hook must accept one parameter which is the path
+being checked."
+ :group 'speedbar-vc
+ :type 'hook)
+
+(defcustom speedbar-vc-in-control-hook nil
+ "*Return non-nil if the specified file is under Version Control.
+Functions in this hook must accept two parameters. The PATH of the
+current file, and the FILENAME of the file being checked."
+ :group 'speedbar-vc
+ :type 'hook)
+
+(defvar speedbar-vc-to-do-point nil
+ "Local variable maintaining the current version control check position.")
+
+(defvar speedbar-ignored-modes nil
+ "*List of major modes which speedbar will not switch directories for.")
+
+(defun speedbar-extension-list-to-regex (extlist)
+ "Takes EXTLIST, a list of extensions and transforms it into regexp.
+All the preceding . are stripped for an optimized expression starting
+with . followed by extensions, followed by full-filenames."
+ (let ((regex1 nil) (regex2 nil))
+ (while extlist
+ (if (= (string-to-char (car extlist)) ?.)
+ (setq regex1 (concat regex1 (if regex1 "\\|" "")
+ (substring (car extlist) 1)))
+ (setq regex2 (concat regex2 (if regex2 "\\|" "") (car extlist))))
+ (setq extlist (cdr extlist)))
+ ;; concat all the sub-exressions together, making sure all types
+ ;; of parts exist during concatination.
+ (concat "\\("
+ (if regex1 (concat "\\(\\.\\(" regex1 "\\)\\)") "")
+ (if (and regex1 regex2) "\\|" "")
+ (if regex2 (concat "\\(" regex2 "\\)") "")
+ "\\)$")))
+
+(defvar speedbar-ignored-path-regexp nil
+ "Regular expression matching paths speedbar will not switch to.
+Created from `speedbar-ignored-path-expressions' with the function
+`speedbar-extension-list-to-regex' (A misnamed function in this case.)
+Use the function `speedbar-add-ignored-path-regexp', or customize the
+variable `speedbar-ignored-path-expressions' to modify this variable.")
+
+(defcustom speedbar-ignored-path-expressions
+ '("/logs?/\\'")
+ "*List of regular expressions matching directories speedbar will ignore.
+They should included paths to directories which are notoriously very
+large and take a long time to load in. Use the function
+`speedbar-add-ignored-path-regexp' to add new items to this list after
+speedbar is loaded. You may place anything you like in this list
+before speedbar has been loaded."
+ :group 'speedbar
+ :type '(repeat (regexp :tag "Path Regexp"))
+ :set (lambda (sym val)
+ (setq speedbar-ignored-path-expressions val
+ speedbar-ignored-path-regexp
+ (speedbar-extension-list-to-regex val))))
+
+(defvar speedbar-file-unshown-regexp
+ (let ((nstr "") (noext completion-ignored-extensions))
+ (while noext
+ (setq nstr (concat nstr (regexp-quote (car noext)) "\\'"
+ (if (cdr noext) "\\|" ""))
+ noext (cdr noext)))
+ (concat nstr "\\|#[^#]+#$\\|\\.\\.?\\'"))
+ "*Regexp matching files we don't want displayed in a speedbar buffer.
+It is generated from the variable `completion-ignored-extensions'")
+
+;; this is dangerous to customize, because the defaults will probably
+;; change in the future.
+(defcustom speedbar-supported-extension-expressions
+ (append '(".[CcHh]\\(\\+\\+\\|pp\\|c\\|h\\)?" ".tex\\(i\\(nfo\\)?\\)?"
+ ".el" ".emacs" ".l" ".lsp" ".p" ".java")
+ (if speedbar-use-imenu-flag
+ '(".f90" ".ada" ".pl" ".tcl" ".m"
+ "Makefile\\(\\.in\\)?")))
+ "*List of regular expressions which will match files supported by tagging.
+Do not prefix the `.' char with a double \\ to quote it, as the period
+will be stripped by a simplified optimizer when compiled into a
+singular expression. This variable will be turned into
+`speedbar-file-regexp' for use with speedbar. You should use the
+function `speedbar-add-supported-extension' to add a new extension at
+runtime, or use the configuration dialog to set it in your .emacs
+file."
+ :group 'speedbar
+ :type '(repeat (regexp :tag "Extension Regexp"))
+ :set (lambda (sym val)
+ (setq speedbar-supported-extension-expressions val
+ speedbar-file-regexp (speedbar-extension-list-to-regex val)))
+ )
+
+(defvar speedbar-file-regexp
+ (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'")
+
+(defun speedbar-add-supported-extension (extension)
+ "Add EXTENSION as a new supported extension for speedbar tagging.
+This should start with a `.' if it is not a complete file name, and
+the dot should NOT be quoted in with \\. Other regular expression
+matchers are allowed however. EXTENSION may be a single string or a
+list of strings."
+ (if (not (listp extension)) (setq extension (list extension)))
+ (while extension
+ (if (member (car extension) speedbar-supported-extension-expressions)
+ nil
+ (setq speedbar-supported-extension-expressions
+ (cons (car extension) speedbar-supported-extension-expressions)))
+ (setq extension (cdr extension)))
+ (setq speedbar-file-regexp (speedbar-extension-list-to-regex
+ speedbar-supported-extension-expressions)))
+
+(defun speedbar-add-ignored-path-regexp (path-expression)
+ "Add PATH-EXPRESSION as a new ignored path for speedbar tracking.
+This function will modify `speedbar-ignored-path-regexp' and add
+PATH-EXPRESSION to `speedbar-ignored-path-expressions'."
+ (if (not (listp path-expression))
+ (setq path-expression (list path-expression)))
+ (while path-expression
+ (if (member (car path-expression) speedbar-ignored-path-expressions)
+ nil
+ (setq speedbar-ignored-path-expressions
+ (cons (car path-expression) speedbar-ignored-path-expressions)))
+ (setq path-expression (cdr path-expression)))
+ (setq speedbar-ignored-path-regexp (speedbar-extension-list-to-regex
+ speedbar-ignored-path-expressions)))
+
+;; If we don't have custom, then we set it here by hand.
+(if (not (fboundp 'custom-declare-variable))
+ (setq speedbar-file-regexp (speedbar-extension-list-to-regex
+ speedbar-supported-extension-expressions)
+ speedbar-ignored-path-regexp (speedbar-extension-list-to-regex
+ speedbar-ignored-path-expressions)))
+
+(defvar speedbar-update-flag (or (fboundp 'run-with-idle-timer)
+ (fboundp 'start-itimer)
+ (boundp 'post-command-idle-hook))
+ "*Non-nil means to automatically update the display.
+When this is nil then speedbar will not follow the attached frame's path.
+When speedbar is active, use:
+
+\\<speedbar-key-map> `\\[speedbar-toggle-updates]'
+
+to toggle this value.")
+
+(defvar speedbar-syntax-table nil
+ "Syntax-table used on the speedbar.")
+
+(if speedbar-syntax-table
+ nil
+ (setq speedbar-syntax-table (make-syntax-table))
+ ;; turn off paren matching around here.
+ (modify-syntax-entry ?\' " " speedbar-syntax-table)
+ (modify-syntax-entry ?\" " " speedbar-syntax-table)
+ (modify-syntax-entry ?( " " speedbar-syntax-table)
+ (modify-syntax-entry ?) " " speedbar-syntax-table)
+ (modify-syntax-entry ?[ " " speedbar-syntax-table)
+ (modify-syntax-entry ?] " " speedbar-syntax-table))
+
+
+(defvar speedbar-key-map nil
+ "Keymap used in speedbar buffer.")
+
+(if speedbar-key-map
+ nil
+ (setq speedbar-key-map (make-keymap))
+ (suppress-keymap speedbar-key-map t)
+
+ ;; control
+ (define-key speedbar-key-map "e" 'speedbar-edit-line)
+ (define-key speedbar-key-map "\C-m" 'speedbar-edit-line)
+ (define-key speedbar-key-map "+" 'speedbar-expand-line)
+ (define-key speedbar-key-map "-" 'speedbar-contract-line)
+ (define-key speedbar-key-map "g" 'speedbar-refresh)
+ (define-key speedbar-key-map "t" 'speedbar-toggle-updates)
+ (define-key speedbar-key-map "q" 'speedbar-close-frame)
+ (define-key speedbar-key-map "U" 'speedbar-up-directory)
+
+ ;; navigation
+ (define-key speedbar-key-map "n" 'speedbar-next)
+ (define-key speedbar-key-map "p" 'speedbar-prev)
+ (define-key speedbar-key-map " " 'speedbar-scroll-up)
+ (define-key speedbar-key-map [delete] 'speedbar-scroll-down)
+
+ ;; After much use, I suddenly desired in my heart to perform dired
+ ;; style operations since the directory was RIGHT THERE!
+ (define-key speedbar-key-map "I" 'speedbar-item-info)
+ (define-key speedbar-key-map "B" 'speedbar-item-byte-compile)
+ (define-key speedbar-key-map "L" 'speedbar-item-load)
+ (define-key speedbar-key-map "C" 'speedbar-item-copy)
+ (define-key speedbar-key-map "D" 'speedbar-item-delete)
+ (define-key speedbar-key-map "R" 'speedbar-item-rename)
+
+ (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)
+ (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)
+
+ ;;***** Disable disabling: Remove menubar completely.
+ ;; disable all menus - we don't have a lot of space to play with
+ ;; in such a skinny frame. This will cleverly find and nuke some
+ ;; user-defined menus as well if they are there. Too bad it
+ ;; rely's on the structure of a keymap to work.
+; (let ((k (lookup-key global-map [menu-bar])))
+; (while k
+; (if (and (listp (car k)) (listp (cdr (car k))))
+; (define-key speedbar-key-map (vector 'menu-bar (car (car k)))
+; 'undefined))
+; (setq k (cdr k))))
+
+ ;; 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)
+ ))
+
+(defvar speedbar-easymenu-definition-base
+ '("Speedbar"
+ ["Update" speedbar-refresh t]
+ ["Auto Update" speedbar-toggle-updates
+ :style toggle :selected speedbar-update-flag]
+ )
+ "Base part of the speedbar menu.")
+
+(defvar speedbar-easymenu-definition-special
+ '(["Edit Item On Line" speedbar-edit-line t]
+ ["Show All Files" speedbar-toggle-show-all-files
+ :style toggle :selected speedbar-show-unknown-files]
+ ["Expand Item" speedbar-expand-line
+ (save-excursion (beginning-of-line)
+ (looking-at "[0-9]+: *.\\+. "))]
+ ["Contract Item" speedbar-contract-line
+ (save-excursion (beginning-of-line)
+ (looking-at "[0-9]+: *.-. "))]
+ ["Sort Tags" speedbar-toggle-sorting
+ :style toggle :selected speedbar-sort-tags]
+ "----"
+ ["Item Information" speedbar-item-info t]
+ ["Load Lisp File" speedbar-item-load
+ (save-excursion
+ (beginning-of-line)
+ (looking-at "[0-9]+: *\\[[+-]\\] .+\\(\\.el\\)\\( \\*\\)?$"))]
+ ["Byte Compile File" speedbar-item-byte-compile
+ (save-excursion
+ (beginning-of-line)
+ (looking-at "[0-9]+: *\\[[+-]\\] .+\\(\\.el\\)\\( \\*\\)?$"))]
+ ["Copy Item" speedbar-item-copy
+ (save-excursion (beginning-of-line) (looking-at "[0-9]+: *\\["))]
+ ["Rename Item" speedbar-item-rename
+ (save-excursion (beginning-of-line) (looking-at "[0-9]+: *[[<]"))]
+ ["Delete Item" speedbar-item-delete
+ (save-excursion (beginning-of-line) (looking-at "[0-9]+: *[[<]"))])
+ "Additional menu items while in file-mode.")
+
+(defvar speedbar-easymenu-definition-trailer
+ (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
+ '("----"
+ ["Customize..." speedbar-customize t]
+ ["Close" speedbar-close-frame t])
+ '("----"
+ ["Close" speedbar-close-frame t]))
+ "Menu items appearing at the end of the speedbar menu.")
+
+(defvar speedbar-desired-buffer nil
+ "Non-nil when speedbar is showing buttons specific a special mode.
+In this case it is the originating buffer.")
+(defvar speedbar-buffer nil
+ "The buffer displaying the speedbar.")
+(defvar speedbar-frame nil
+ "The frame displaying speedbar.")
+(defvar speedbar-cached-frame nil
+ "The frame that was last created, then removed from the display.")
+(defvar speedbar-full-text-cache nil
+ "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.")
+
+(defvar speedbar-last-selected-file nil
+ "The last file which was selected in speedbar buffer.")
+
+(defvar speedbar-shown-directories nil
+ "Maintain list of directories simultaneously open in the current speedbar.")
+
+(defvar speedbar-directory-contents-alist nil
+ "An association list of directories and their contents.
+Each sublist was returned by `speedbar-file-lists'. This list is
+maintained to speed up the refresh rate when switching between
+directories.")
+
+(defvar speedbar-power-click nil
+ "Never set this by hand. Value is t when S-mouse activity occurs.")
+
+\f
+;;; Mode definitions/ user commands
+;;
+
+;;;###autoload
+(defalias 'speedbar 'speedbar-frame-mode)
+;;;###autoload
+(defun speedbar-frame-mode (&optional arg)
+ "Enable or disable speedbar. Positive ARG means turn on, negative turn off.
+nil means toggle. Once the speedbar frame is activated, a buffer in
+`speedbar-mode' will be displayed. Currently, only one speedbar is
+supported at a time.
+`speedbar-before-popup-hook' is called before popping up the speedbar frame.
+`speedbar-before-delete-hook' is called before the frame is deleted."
+ (interactive "P")
+ (if (if (and speedbar-xemacsp (fboundp 'console-on-window-system-p))
+ (not (console-on-window-system-p))
+ (not (symbol-value 'window-system)))
+ (error "Speedbar is not useful outside of a windowing environment"))
+;;; RMS says this should not modify the menu.
+; (if speedbar-xemacsp
+; (add-menu-button '("Tools")
+; ["Speedbar" speedbar-frame-mode
+; :style toggle
+; :selected (and (boundp 'speedbar-frame)
+; (frame-live-p speedbar-frame)
+; (frame-visible-p speedbar-frame))]
+; "--")
+; (define-key-after (lookup-key global-map [menu-bar tools])
+; [speedbar] '("Speedbar" . speedbar-frame-mode) [calendar]))
+ ;; toggle frame on and off.
+ (if (not arg) (if (and (frame-live-p speedbar-frame)
+ (frame-visible-p speedbar-frame))
+ (setq arg -1) (setq arg 1)))
+ ;; turn the frame off on neg number
+ (if (and (numberp arg) (< arg 0))
+ (progn
+ (run-hooks 'speedbar-before-delete-hook)
+ (if (and speedbar-frame (frame-live-p speedbar-frame))
+ (progn
+ (setq speedbar-cached-frame speedbar-frame)
+ (make-frame-invisible speedbar-frame)))
+ (setq speedbar-frame nil)
+ (speedbar-set-timer nil)
+ ;; Used to delete the buffer. This has the annoying affect of
+ ;; preventing whatever took its place from ever appearing
+ ;; as the default after a C-x b was typed
+ ;;(if (bufferp speedbar-buffer)
+ ;; (kill-buffer speedbar-buffer))
+ )
+ ;; Set this as our currently attached frame
+ (setq speedbar-attached-frame (selected-frame))
+ (run-hooks 'speedbar-before-popup-hook)
+ ;; Get the frame to work in
+ (if (frame-live-p speedbar-cached-frame)
+ (progn
+ (setq speedbar-frame speedbar-cached-frame)
+ (make-frame-visible speedbar-frame)
+ ;; Get the buffer to play with
+ (speedbar-mode)
+ (select-frame speedbar-frame)
+ (if (not (eq (current-buffer) speedbar-buffer))
+ (switch-to-buffer speedbar-buffer))
+ (set-window-dedicated-p (selected-window) t)
+ (raise-frame speedbar-frame)
+ (speedbar-set-timer speedbar-update-speed)
+ )
+ (if (frame-live-p speedbar-frame)
+ (raise-frame speedbar-frame)
+ (setq speedbar-frame
+ (if speedbar-xemacsp
+ (make-frame (nconc (list 'height
+ (speedbar-needed-height))
+ speedbar-frame-plist))
+ (let* ((mh (cdr (assoc 'menu-bar-lines (frame-parameters))))
+ (params (append speedbar-frame-parameters
+ (list (cons
+ 'height
+ (if speedbar-xemacsp
+ (speedbar-needed-height)
+ (+ mh (frame-height))))))))
+ (if (< emacs-major-version 20);;a bug is fixed in v20 & later
+ (make-frame params)
+ (let ((x-pointer-shape x-pointer-top-left-arrow)
+ (x-sensitive-text-pointer-shape x-pointer-hand2))
+ (make-frame params))))))
+ ;; 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))
+ (speedbar-set-timer speedbar-update-speed)))))
+
+;;;###autoload
+(defun speedbar-get-focus ()
+ "Change frame focus to or from the speedbar frame.
+If the selected frame is not speedbar, then speedbar frame is
+selected. If the speedbar frame is active, then select the attached frame."
+ (interactive)
+ (if (eq (selected-frame) speedbar-frame)
+ (if (frame-live-p speedbar-attached-frame)
+ (select-frame speedbar-attached-frame))
+ ;; 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))
+
+(defmacro speedbar-frame-width ()
+ "Return the width of the speedbar frame in characters.
+nil if it doesn't exist."
+ '(frame-width speedbar-frame))
+
+;; 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))))
+
+(defun speedbar-mode ()
+ "Major mode for managing a display of directories and tags.
+\\<speedbar-key-map>
+The first line represents the default path of the speedbar frame.
+Each directory segment is a button which jumps speedbar's default
+directory to that path. Buttons are activated by clicking `\\[speedbar-click]'.
+In some situations using `\\[speedbar-power-click]' is a `power click' which will
+rescan cached items, or pop up new frames.
+
+Each line starting with <+> represents a directory. Click on the <+>
+to insert the directory listing into the current tree. Click on the
+<-> to retract that list. Click on the directory name to go to that
+directory as the default.
+
+Each line starting with [+] is a file. If the variable
+`speedbar-show-unknown-files' is t, the lines starting with [?] are
+files which don't have imenu support, but are not expressly ignored.
+Files are completely ignored if they match `speedbar-file-unshown-regexp'
+which is generated from `completion-ignored-extensions'.
+
+Files with a `*' character after their name are files checked out of a
+version control system. (currently only RCS is supported.) New
+version control systems can be added by examining the documentation
+for `speedbar-this-file-in-vc' and `speedbar-vc-check-dir-p'
+
+Click on the [+] to display a list of tags from that file. Click on
+the [-] to retract the list. Click on the file name to edit the file
+in the attached frame.
+
+If you open tags, you might find a node starting with {+}, which is a
+category of tags. Click the {+} to expand the category. Jump-able
+tags start with >. Click the name of the tag to go to that position
+in the selected file.
+
+\\{speedbar-key-map}"
+ ;; NOT interactive
+ (save-excursion
+ (setq speedbar-buffer (set-buffer (get-buffer-create " SPEEDBAR")))
+ (kill-all-local-variables)
+ (setq major-mode 'speedbar-mode)
+ (setq mode-name "Speedbar")
+ (use-local-map speedbar-key-map)
+ (set-syntax-table speedbar-syntax-table)
+ (setq font-lock-keywords nil) ;; no font-locking please
+ (setq truncate-lines t)
+ (make-local-variable 'frame-title-format)
+ (setq frame-title-format "Speedbar")
+ ;; Set this up special just for the speedbar buffer
+ (if (null default-minibuffer-frame)
+ (progn
+ (make-local-variable 'default-minibuffer-frame)
+ (setq default-minibuffer-frame speedbar-attached-frame)))
+ (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))
+ (mouse-set-point event)
+ (speedbar-do-function-pointer)
+ (speedbar-quick-mouse event)))
+ ;; Don't do normal operations.
+ t)))))
+ (make-local-hook 'kill-buffer-hook)
+ (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)
+ (speedbar-set-mode-line-format)
+ (if (not speedbar-xemacsp)
+ (setq auto-show-mode nil)) ;no auto-show for Emacs
+ (run-hooks 'speedbar-mode-hook))
+ (speedbar-update-contents)
+ speedbar-buffer)
+
+(defun speedbar-set-mode-line-format ()
+ "Set the format of the mode line based on the current speedbar environment.
+This gives visual indications of what is up. It EXPECTS the speedbar
+frame and window to be the currently active frame and window."
+ (if (and (frame-live-p speedbar-frame)
+ (or (not speedbar-xemacsp)
+ (specifier-instance has-modeline-p)))
+ (save-excursion
+ (set-buffer speedbar-buffer)
+ (let* ((w (or (speedbar-frame-width) 20))
+ (p1 "<<")
+ (p5 ">>")
+ (p3 (if speedbar-update-flag "SPEEDBAR" "SLOWBAR"))
+ (blank (- w (length p1) (length p3) (length p5)
+ (if line-number-mode 4 0)))
+ (p2 (if (> blank 0)
+ (make-string (/ blank 2) ? )
+ ""))
+ (p4 (if (> blank 0)
+ (make-string (+ (/ blank 2) (% blank 2)) ? )
+ ""))
+ (tf
+ (if line-number-mode
+ (list (concat p1 p2 p3) '(line-number-mode " %3l")
+ (concat p4 p5))
+ (list (concat p1 p2 p3 p4 p5)))))
+ (if (not (equal mode-line-format tf))
+ (progn
+ (setq mode-line-format tf)
+ (force-mode-line-update)))))))
+
+(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)
+ (run-hooks 'temp-buffer-show-hook))
+
+(defun speedbar-reconfigure-menubar ()
+ "Reconfigure the menu-bar in a speedbar frame.
+Different menu items are displayed depending on the current display mode
+and the existence of packages."
+ (let ((md (append speedbar-easymenu-definition-base
+ (if speedbar-shown-directories
+ ;; file display mode version
+ speedbar-easymenu-definition-special
+ (save-excursion
+ (select-frame speedbar-attached-frame)
+ (if (local-variable-p
+ 'speedbar-easymenu-definition-special
+ (current-buffer))
+ ;; If bound locally, we can use it
+ speedbar-easymenu-definition-special)))
+ ;; The trailer
+ speedbar-easymenu-definition-trailer)))
+ (easy-menu-define speedbar-menu-map speedbar-key-map "Speedbar menu" md)
+ (if speedbar-xemacsp
+ (save-excursion
+ (set-buffer speedbar-buffer)
+ ;; For the benefit of button3
+ (if (and (not (assoc "Speedbar" mode-popup-menu)))
+ (easy-menu-add md))
+ (set-buffer-menubar (list md)))
+ (easy-menu-add md))))
+
+\f
+;;; User Input stuff
+;;
+
+;; 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 (message "Click on the edge of the modeline to scroll left/right")))
+ ;;(message "X: Pixel %d Char Pixels %d On char %d" xp cpw oc)
+ ))
+
+(defun speedbar-customize ()
+ "Customize speedbar using the Custom package."
+ (interactive)
+ (let ((sf (selected-frame)))
+ (select-frame speedbar-attached-frame)
+ (customize-group 'speedbar)
+ (select-frame sf))
+ (speedbar-maybee-jump-to-attached-frame))
+
+;; 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")
+ (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)
+ (if (< emacs-major-version 20)
+ (mouse-major-mode-menu e)
+ (mouse-major-mode-menu e nil))))
+
+(defun speedbar-next (arg)
+ "Move to the next ARGth line in a speedbar buffer."
+ (interactive "p")
+ (forward-line (or arg 1))
+ (speedbar-item-info)
+ (speedbar-position-cursor-on-line))
+
+(defun speedbar-prev (arg)
+ "Move to the previous ARGth line in a speedbar buffer."
+ (interactive "p")
+ (speedbar-next (if arg (- arg) -1)))
+
+(defun speedbar-scroll-up (&optional arg)
+ "Page down one screen-full of the speedbar, or ARG lines."
+ (interactive "P")
+ (scroll-up arg)
+ (speedbar-position-cursor-on-line))
+
+(defun speedbar-scroll-down (&optional arg)
+ "Page up one screen-full of the speedbar, or ARG lines."
+ (interactive "P")
+ (scroll-down arg)
+ (speedbar-position-cursor-on-line))
+
+(defun speedbar-up-directory ()
+ "Keyboard accelerator for moving the default directory up one.
+Assumes that the current buffer is the speedbar buffer"
+ (interactive)
+ (setq default-directory (expand-file-name (concat default-directory "../")))
+ (speedbar-update-contents))
+\f
+;;; Speedbar file activity (aka creeping featurism)
+;;
+(defun speedbar-refresh ()
+ "Refresh the current speedbar display, disposing of any cached data."
+ (interactive)
+ (let ((dl speedbar-shown-directories))
+ (while dl
+ (adelete 'speedbar-directory-contents-alist (car dl))
+ (setq dl (cdr dl))))
+ (if (<= 1 speedbar-verbosity-level) (message "Refreshing speedbar..."))
+ (speedbar-update-contents)
+ (speedbar-stealthy-updates)
+ ;; Reset the timer in case it got really hosed for some reason...
+ (speedbar-set-timer speedbar-update-speed)
+ (if (<= 1 speedbar-verbosity-level) (message "Refreshing speedbar...done")))
+
+(defun speedbar-item-load ()
+ "Load the item under the cursor or mouse if it is a lisp file."
+ (interactive)
+ (let ((f (speedbar-line-file)))
+ (if (and (file-exists-p f) (string-match "\\.el\\'" f))
+ (if (and (file-exists-p (concat f "c"))
+ (y-or-n-p (format "Load %sc? " f)))
+ ;; If the compiled version exists, load that instead...
+ (load-file (concat f "c"))
+ (load-file f))
+ (error "Not a loadable file..."))))
+
+(defun speedbar-item-byte-compile ()
+ "Byte compile the item under the cursor or mouse if it is a lisp file."
+ (interactive)
+ (let ((f (speedbar-line-file))
+ (sf (selected-frame)))
+ (if (and (file-exists-p f) (string-match "\\.el\\'" f))
+ (progn
+ (select-frame speedbar-attached-frame)
+ (byte-compile-file f nil)
+ (select-frame sf)))
+ ))
+
+(defun speedbar-mouse-item-info (event)
+ "Provide information about what the user clicked on.
+This should be bound to a mouse EVENT."
+ (interactive "e")
+ (mouse-set-point event)
+ (speedbar-item-info))
+
+(defun speedbar-item-info ()
+ "Display info in the mini-buffer about the button the mouse is over."
+ (interactive)
+ (if (not speedbar-shown-directories)
+ nil
+ (let* ((item (speedbar-line-file))
+ (attr (if item (file-attributes item) nil)))
+ (if item (message "%s %d %s" (nth 8 attr) (nth 7 attr) item)
+ (save-excursion
+ (beginning-of-line)
+ (looking-at "\\([0-9]+\\):")
+ (setq item (speedbar-line-path (string-to-int (match-string 1))))
+ (if (re-search-forward "> \\([^ ]+\\)$"
+ (save-excursion(end-of-line)(point)) t)
+ (progn
+ (setq attr (get-text-property (match-beginning 1)
+ 'speedbar-token))
+ (message "Tag %s in %s at position %s"
+ (match-string 1) item (if attr attr 0)))
+ (message "No special info for this line.")))
+ ))))
+
+(defun speedbar-item-copy ()
+ "Copy the item under the cursor.
+Files can be copied to new names or places."
+ (interactive)
+ (let ((f (speedbar-line-file)))
+ (if (not f) (error "Not a file."))
+ (if (file-directory-p f)
+ (error "Cannot copy directory.")
+ (let* ((rt (read-file-name (format "Copy %s to: "
+ (file-name-nondirectory f))
+ (file-name-directory f)))
+ (refresh (member (expand-file-name (file-name-directory rt))
+ speedbar-shown-directories)))
+ ;; Create the right file name part
+ (if (file-directory-p rt)
+ (setq rt
+ (concat (expand-file-name rt)
+ (if (string-match "/$" rt) "" "/")
+ (file-name-nondirectory f))))
+ (if (or (not (file-exists-p rt))
+ (y-or-n-p (format "Overwrite %s with %s? " rt f)))
+ (progn
+ (copy-file f rt t t)
+ ;; refresh display if the new place is currently displayed.
+ (if refresh
+ (progn
+ (speedbar-refresh)
+ (if (not (speedbar-goto-this-file rt))
+ (speedbar-goto-this-file f))))
+ ))))))
+
+(defun speedbar-item-rename ()
+ "Rename the item under the cursor or mouse.
+Files can be renamed to new names or moved to new directories."
+ (interactive)
+ (let ((f (speedbar-line-file)))
+ (if f
+ (let* ((rt (read-file-name (format "Rename %s to: "
+ (file-name-nondirectory f))
+ (file-name-directory f)))
+ (refresh (member (expand-file-name (file-name-directory rt))
+ speedbar-shown-directories)))
+ ;; Create the right file name part
+ (if (file-directory-p rt)
+ (setq rt
+ (concat (expand-file-name rt)
+ (if (string-match "/\\'" rt) "" "/")
+ (file-name-nondirectory f))))
+ (if (or (not (file-exists-p rt))
+ (y-or-n-p (format "Overwrite %s with %s? " rt f)))
+ (progn
+ (rename-file f rt t)
+ ;; refresh display if the new place is currently displayed.
+ (if refresh
+ (progn
+ (speedbar-refresh)
+ (speedbar-goto-this-file rt)
+ )))))
+ (error "Not a file."))))
+
+(defun speedbar-item-delete ()
+ "Delete the item under the cursor. Files are removed from disk."
+ (interactive)
+ (let ((f (speedbar-line-file)))
+ (if (not f) (error "Not a file."))
+ (if (y-or-n-p (format "Delete %s? " f))
+ (progn
+ (if (file-directory-p f)
+ (delete-directory f)
+ (delete-file f))
+ (message "Okie dokie..")
+ (let ((p (point)))
+ (speedbar-refresh)
+ (goto-char p))
+ ))
+ ))
+
+(defun speedbar-enable-update ()
+ "Enable automatic updating in speedbar via timers."
+ (interactive)
+ (setq speedbar-update-flag t)
+ (speedbar-set-mode-line-format)
+ (speedbar-set-timer speedbar-update-speed))
+
+(defun speedbar-disable-update ()
+ "Disable automatic updating and stop consuming resources."
+ (interactive)
+ (setq speedbar-update-flag nil)
+ (speedbar-set-mode-line-format)
+ (speedbar-set-timer nil))
+
+(defun speedbar-toggle-updates ()
+ "Toggle automatic update for the speedbar frame."
+ (interactive)
+ (if speedbar-update-flag
+ (speedbar-disable-update)
+ (speedbar-enable-update)))
+
+(defun speedbar-toggle-sorting ()
+ "Toggle automatic update for the speedbar frame."
+ (interactive)
+ (setq speedbar-sort-tags (not speedbar-sort-tags)))
+
+(defun speedbar-toggle-show-all-files ()
+ "Toggle display of files speedbar can not tag."
+ (interactive)
+ (setq speedbar-show-unknown-files (not speedbar-show-unknown-files))
+ (speedbar-refresh))
+\f
+;;; Utility functions
+;;
+(defun speedbar-set-timer (timeout)
+ "Apply a timer with TIMEOUT, or remove a timer if TIMOUT 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))
+
+(defmacro speedbar-with-writable (&rest forms)
+ "Allow the buffer to be writable and evaluate FORMS."
+ (list 'let '((inhibit-read-only t))
+ '(toggle-read-only -1)
+ (cons 'progn forms)))
+(put 'speedbar-with-writable 'lisp-indent-function 0)
+
+(defun speedbar-select-window (buffer)
+ "Select a window in which BUFFER is show.
+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)
+ (show-buffer (selected-window) buffer))))
+
+(defmacro speedbar-with-attached-buffer (&rest forms)
+ "Execute FORMS in the attached frame's special buffer.
+Optionally select that frame if necessary."
+ ;; Reset the timer with a new timeout when cliking a file
+ ;; in case the user was navigating directories, we can cancel
+ ;; that other timer.
+ (list
+ 'progn
+ '(speedbar-set-timer speedbar-update-speed)
+ (list
+ 'let '((cf (selected-frame)))
+ '(select-frame speedbar-attached-frame)
+ '(speedbar-select-window speedbar-desired-buffer)
+ (cons 'progn forms)
+ '(select-frame cf)
+ '(speedbar-maybee-jump-to-attached-frame)
+ )))
+
+(defun speedbar-insert-button (text face mouse function
+ &optional token prevline)
+ "Insert TEXT as the next logical speedbar button.
+FACE is the face to put on the button, MOUSE is the highlight face to use.
+When the user clicks on TEXT, FUNCTION is called with the TOKEN parameter.
+This function assumes that the current buffer is the speedbar buffer.
+If PREVLINE, then put this button on the previous line.
+
+This is a convenience function for special mode that create their own
+specialized speedbar displays."
+ (goto-char (point-max))
+ (if (/= (current-column) 0) (insert "\n"))
+ (if prevline (progn (delete-char -1) (insert " "))) ;back up if desired...
+ (let ((start (point)))
+ (insert text)
+ (speedbar-make-button start (point) face mouse function token))
+ (let ((start (point)))
+ (insert "\n")
+ (put-text-property start (point) 'face nil)
+ (put-text-property start (point) 'mouse-face nil)))
+
+(defun speedbar-make-button (start end face mouse function &optional token)
+ "Create a button from START to END, with FACE as the display face.
+MOUSE is the mouse face. When this button is clicked on FUNCTION
+will be run with the TOKEN parameter (any lisp object)"
+ (put-text-property start end 'face face)
+ (put-text-property start end 'mouse-face mouse)
+ (put-text-property start end 'invisible nil)
+ (if function (put-text-property start end 'speedbar-function function))
+ (if token (put-text-property start end 'speedbar-token token))
+ )
+\f
+;;; File button management
+;;
+(defun speedbar-file-lists (directory)
+ "Create file lists for DIRECTORY.
+The car is the list of directories, the cdr is list of files not
+matching ignored headers. Cache any directory files found in
+`speedbar-directory-contents-alist' and use that cache before scanning
+the file-system"
+ (setq directory (expand-file-name directory))
+ ;; If in powerclick mode, then the directory we are getting
+ ;; should be rescanned.
+ (if speedbar-power-click
+ (adelete 'speedbar-directory-contents-alist directory))
+ ;; find the directory, either in the cache, or build it.
+ (or (cdr-safe (assoc directory speedbar-directory-contents-alist))
+ (let ((default-directory directory)
+ (dir (directory-files directory nil))
+ (dirs nil)
+ (files nil))
+ (while dir
+ (if (not (string-match speedbar-file-unshown-regexp (car dir)))
+ (if (file-directory-p (car dir))
+ (setq dirs (cons (car dir) dirs))
+ (setq files (cons (car dir) files))))
+ (setq dir (cdr dir)))
+ (let ((nl (cons (nreverse dirs) (list (nreverse files)))))
+ (aput 'speedbar-directory-contents-alist directory nl)
+ nl))
+ ))
+
+(defun speedbar-directory-buttons (directory index)
+ "Insert a single button group at point for DIRECTORY.
+Each directory path part is a different button. If part of the path
+matches the user directory ~, then it is replaced with a ~.
+INDEX is not used, but is required by the caller."
+ (let* ((tilde (expand-file-name "~"))
+ (dd (expand-file-name directory))
+ (junk (string-match (regexp-quote tilde) dd))
+ (displayme (if junk
+ (concat "~" (substring dd (match-end 0)))
+ dd))
+ (p (point)))
+ (if (string-match "^~/?\\'" displayme) (setq displayme (concat tilde "/")))
+ (insert displayme)
+ (save-excursion
+ (goto-char p)
+ (while (re-search-forward "\\([^/]+\\)/" nil t)
+ (speedbar-make-button (match-beginning 1) (match-end 1)
+ 'speedbar-directory-face
+ 'speedbar-highlight-face
+ 'speedbar-directory-buttons-follow
+ (if (= (match-beginning 1) p)
+ (expand-file-name "~/") ;the tilde
+ (buffer-substring-no-properties
+ p (match-end 0)))))
+ ;; Nuke the beginning of the directory if it's too long...
+ (cond ((eq speedbar-directory-button-trim-method 'span)
+ (beginning-of-line)
+ (let ((ww (or (speedbar-frame-width) 20)))
+ (move-to-column ww nil)
+ (while (>= (current-column) ww)
+ (re-search-backward "/" nil t)
+ (if (<= (current-column) 2)
+ (progn
+ (re-search-forward "/" nil t)
+ (if (< (current-column) 4)
+ (re-search-forward "/" nil t))
+ (forward-char -1)))
+ (if (looking-at "/?$")
+ (beginning-of-line)
+ (insert "/...\n ")
+ (move-to-column ww nil)))))
+ ((eq speedbar-directory-button-trim-method 'trim)
+ (end-of-line)
+ (let ((ww (or (speedbar-frame-width) 20))
+ (tl (current-column)))
+ (if (< ww tl)
+ (progn
+ (move-to-column (- tl ww))
+ (if (re-search-backward "/" nil t)
+ (progn
+ (delete-region (point-min) (point))
+ (insert "$")
+ )))))))
+ )
+ (if (string-match "\\`/[^/]+/\\'" displayme)
+ (progn
+ (insert " ")
+ (let ((p (point)))
+ (insert "<root>")
+ (speedbar-make-button p (point)
+ 'speedbar-directory-face
+ 'speedbar-highlight-face
+ 'speedbar-directory-buttons-follow
+ "/"))))
+ (end-of-line)
+ (insert-char ?\n 1 nil)))
+
+(defun speedbar-make-tag-line (exp-button-type
+ exp-button-char exp-button-function
+ exp-button-data
+ tag-button tag-button-function tag-button-data
+ tag-button-face depth)
+ "Create a tag line with EXP-BUTTON-TYPE for the small expansion button.
+This is the button that expands or contracts a node (if applicable),
+and EXP-BUTTON-CHAR the character in it (+, -, ?, etc). EXP-BUTTON-FUNCTION
+is the function to call if it's clicked on. Button types are
+'bracket, 'angle, 'curly, or nil. EXP-BUTTON-DATA is extra data
+attached to the text forming the expansion button.
+
+Next, TAG-BUTTON is the text of the tag. TAG-BUTTON-FUNCTION is the
+function to call if clicked on, and TAG-BUTTON-DATA is the data to
+attach to the text field (such a tag positioning, etc).
+TAG-BUTTON-FACE is a face used for this type of tag.
+
+Lastly, DEPTH shows the depth of expansion.
+
+This function assumes that the cursor is in the speedbar window at the
+position to insert a new item, and that the new item will end with a CR"
+ (let ((start (point))
+ (end (progn
+ (insert (int-to-string depth) ":")
+ (point))))
+ (put-text-property start end 'invisible t)
+ )
+ (insert-char ? depth nil)
+ (put-text-property (- (point) depth) (point) 'invisible nil)
+ (let* ((exp-button (cond ((eq exp-button-type 'bracket) "[%c]")
+ ((eq exp-button-type 'angle) "<%c>")
+ ((eq exp-button-type 'curly) "{%c}")
+ (t ">")))
+ (buttxt (format exp-button exp-button-char))
+ (start (point))
+ (end (progn (insert buttxt) (point)))
+ (bf (if exp-button-type 'speedbar-button-face nil))
+ (mf (if exp-button-function 'speedbar-highlight-face nil))
+ )
+ (speedbar-make-button start end bf mf exp-button-function exp-button-data)
+ )
+ (insert-char ? 1 nil)
+ (put-text-property (1- (point)) (point) 'invisible nil)
+ (let ((start (point))
+ (end (progn (insert tag-button) (point))))
+ (insert-char ?\n 1 nil)
+ (put-text-property (1- (point)) (point) 'invisible nil)
+ (speedbar-make-button start end tag-button-face
+ (if tag-button-function 'speedbar-highlight-face nil)
+ tag-button-function tag-button-data))
+)
+
+(defun speedbar-change-expand-button-char (char)
+ "Change the expansion button character to CHAR for the current line."
+ (save-excursion
+ (beginning-of-line)
+ (if (re-search-forward ":\\s-*.\\([-+?]\\)" (save-excursion (end-of-line)
+ (point)) t)
+ (speedbar-with-writable
+ (goto-char (match-beginning 1))
+ (delete-char 1)
+ (insert-char char 1 t)))))
+
+\f
+;;; Build button lists
+;;
+(defun speedbar-insert-files-at-point (files level)
+ "Insert list of FILES starting at point, and indenting all files to LEVEL.
+Tag expandable items with a +, otherwise a ?. Don't highlight ? as we
+don't know how to manage them. The input parameter FILES is a cons
+cell of the form ( 'DIRLIST . 'FILELIST )"
+ ;; Start inserting all the directories
+ (let ((dirs (car files)))
+ (while dirs
+ (speedbar-make-tag-line 'angle ?+ 'speedbar-dired (car dirs)
+ (car dirs) 'speedbar-dir-follow nil
+ 'speedbar-directory-face level)
+ (setq dirs (cdr dirs))))
+ (let ((lst (car (cdr files))))
+ (while lst
+ (let* ((known (string-match speedbar-file-regexp (car lst)))
+ (expchar (if known ?+ ??))
+ (fn (if known 'speedbar-tag-file nil)))
+ (if (or speedbar-show-unknown-files (/= expchar ??))
+ (speedbar-make-tag-line 'bracket expchar fn (car lst)
+ (car lst) 'speedbar-find-file nil
+ 'speedbar-file-face level)))
+ (setq lst (cdr lst)))))
+
+(defun speedbar-default-directory-list (directory index)
+ "Insert files for DIRECTORY with level INDEX at point."
+ (speedbar-insert-files-at-point
+ (speedbar-file-lists directory) index)
+ (speedbar-reset-scanners)
+ (if (= index 0)
+ ;; If the shown files variable has extra directories, then
+ ;; it is our responsibility to redraw them all
+ ;; Luckilly, the nature of inserting items into this list means
+ ;; that by reversing it, we can easilly go in the right order
+ (let ((sf (cdr (reverse speedbar-shown-directories))))
+ (setq speedbar-shown-directories
+ (list (expand-file-name default-directory)))
+ ;; exand them all as we find them
+ (while sf
+ (if (speedbar-goto-this-file (car sf))
+ (progn
+ (beginning-of-line)
+ (if (looking-at "[0-9]+:[ ]*<")
+ (progn
+ (goto-char (match-end 0))
+ (speedbar-do-function-pointer)))
+ (setq sf (cdr sf)))))
+ )))
+
+(defun speedbar-insert-generic-list (level lst expand-fun find-fun)
+ "At LEVEL, insert a generic multi-level alist LST.
+Associations with lists get {+} tags (to expand into more nodes) and
+those with positions just get a > as the indicator. {+} buttons will
+have the function EXPAND-FUN and the token is the CDR list. The token
+name will have the function FIND-FUN and not token."
+ ;; Remove imenu rescan button
+ (if (string= (car (car lst)) "*Rescan*")
+ (setq lst (cdr lst)))
+ ;; insert the parts
+ (while lst
+ (cond ((null (car-safe lst)) nil) ;this would be a separator
+ ((or (numberp (cdr-safe (car-safe lst)))
+ (markerp (cdr-safe (car-safe lst))))
+ (speedbar-make-tag-line nil nil nil nil ;no expand button data
+ (car (car lst)) ;button name
+ find-fun ;function
+ (cdr (car lst)) ;token is position
+ 'speedbar-tag-face
+ (1+ level)))
+ ((listp (cdr-safe (car-safe lst)))
+ (speedbar-make-tag-line 'curly ?+ expand-fun (cdr (car lst))
+ (car (car lst)) ;button name
+ nil nil 'speedbar-tag-face
+ (1+ level)))
+ (t (message "Ooops!")))
+ (setq lst (cdr lst))))
+\f
+;;; Timed functions
+;;
+(defun speedbar-update-contents ()
+ "Generically update the contents of the speedbar buffer."
+ (interactive)
+ ;; Set the current special buffer
+ (setq speedbar-desired-buffer nil)
+ (if (and speedbar-mode-specific-contents-flag
+ speedbar-special-mode-expansion-list
+ (local-variable-p
+ 'speedbar-special-mode-expansion-list
+ (current-buffer)))
+ ;;(eq (get major-mode 'mode-class 'special)))
+ (speedbar-update-special-contents)
+ (speedbar-update-directory-contents)))
+
+(defun speedbar-update-directory-contents ()
+ "Update the contents of the speedbar buffer based on the current directory."
+ (let ((cbd (expand-file-name default-directory))
+ cbd-parent
+ (funclst speedbar-initial-expansion-list)
+ (cache speedbar-full-text-cache)
+ ;; disable stealth during update
+ (speedbar-stealthy-function-list nil)
+ (use-cache nil)
+ (expand-local nil)
+ ;; Because there is a bug I can't find just yet
+ (inhibit-quit nil))
+ (save-excursion
+ (set-buffer speedbar-buffer)
+ ;; If we are updating contents to where we are, then this is
+ ;; really a request to update existing contents, so we must be
+ ;; careful with our text cache!
+ (if (member cbd speedbar-shown-directories)
+ (setq cache nil)
+
+ ;; Build cbd-parent, and see if THAT is in the current shown
+ ;; directories. First, go through pains to get the parent directory
+ (if (and speedbar-smart-directory-expand-flag
+ (save-match-data
+ (setq cbd-parent cbd)
+ (if (string-match "/$" cbd-parent)
+ (setq cbd-parent (substring cbd-parent 0 (match-beginning 0))))
+ (setq cbd-parent (file-name-directory cbd-parent)))
+ (member cbd-parent speedbar-shown-directories))
+ (setq expand-local t)
+
+ ;; If this directory is NOT in the current list of available
+ ;; paths, then use the cache, and set the cache to our new
+ ;; value. Make sure to unhighlight the current file, or if we
+ ;; come back to this directory, it might be a different file
+ ;; and then we get a mess!
+ (if (> (point-max) 1)
+ (progn
+ (speedbar-clear-current-file)
+ (setq speedbar-full-text-cache
+ (cons speedbar-shown-directories (buffer-string)))))
+
+ ;; Check if our new directory is in the list of directories
+ ;; shown in the text-cache
+ (if (member cbd (car cache))
+ (setq speedbar-shown-directories (car cache)
+ use-cache t)
+ ;; default the shown directories to this list...
+ (setq speedbar-shown-directories (list cbd)))
+ ))
+ (setq speedbar-last-selected-file nil)
+ (speedbar-with-writable
+ (if (and expand-local
+ ;; Find this directory as a speedbar node.
+ (speedbar-path-line cbd))
+ ;; Open it.
+ (speedbar-expand-line)
+ (erase-buffer)
+ (cond (use-cache
+ (setq default-directory
+ (nth (1- (length speedbar-shown-directories))
+ speedbar-shown-directories))
+ (insert (cdr cache)))
+ (t
+ (while funclst
+ (setq default-directory cbd)
+ (funcall (car funclst) cbd 0)
+ (setq funclst (cdr funclst))))))
+ (goto-char (point-min)))))
+ (speedbar-reconfigure-menubar))
+
+(defun speedbar-update-special-contents ()
+ "Used the mode-specific variable to fill in the speedbar buffer.
+This should only be used by modes classified as special."
+ (let ((funclst speedbar-special-mode-expansion-list)
+ (specialbuff (current-buffer)))
+ (save-excursion
+ (setq speedbar-desired-buffer specialbuff)
+ (set-buffer speedbar-buffer)
+ ;; If we are leaving a directory, cache it.
+ (if (not speedbar-shown-directories)
+ ;; Do nothing
+ nil
+ ;; Clean up directory maintenance stuff
+ (speedbar-clear-current-file)
+ (setq speedbar-full-text-cache
+ (cons speedbar-shown-directories (buffer-string))
+ speedbar-shown-directories nil))
+ ;; Now fill in the buffer with our newly found specialized list.
+ (speedbar-with-writable
+ (while funclst
+ ;; We do not erase the buffer because these functions may
+ ;; decide NOT to update themselves.
+ (funcall (car funclst) specialbuff)
+ (setq funclst (cdr funclst))))
+ (goto-char (point-min))))
+ (speedbar-reconfigure-menubar))
+
+(defun speedbar-timer-fn ()
+ "Run whenever emacs is idle to update the speedbar item."
+ (if (not (and (frame-live-p speedbar-frame)
+ (frame-live-p speedbar-attached-frame)))
+ (speedbar-set-timer nil)
+ ;; Save all the match data so that we don't mess up executing fns
+ (save-match-data
+ (if (and (frame-visible-p speedbar-frame) speedbar-update-flag)
+ (let ((af (selected-frame)))
+ (save-window-excursion
+ (select-frame speedbar-attached-frame)
+ ;; make sure we at least choose a window to
+ ;; get a good directory from
+ (if (string-match "\\*Minibuf-[0-9]+\\*" (buffer-name))
+ (other-window 1))
+ ;; Update for special mode all the time!
+ (if (and speedbar-mode-specific-contents-flag
+ speedbar-special-mode-expansion-list
+ (local-variable-p
+ 'speedbar-special-mode-expansion-list
+ (current-buffer)))
+ ;;(eq (get major-mode 'mode-class 'special)))
+ (progn
+ (if (<= 2 speedbar-verbosity-level)
+ (message "Updating speedbar to special mode: %s..."
+ major-mode))
+ (speedbar-update-special-contents)
+ (if (<= 2 speedbar-verbosity-level)
+ (message "Updating speedbar to special mode: %s...done"
+ major-mode)))
+ ;; Update all the contents if directories change!
+ (if (or (member (expand-file-name default-directory)
+ speedbar-shown-directories)
+ (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)
+ (not (buffer-file-name)))
+ nil
+ (if (<= 1 speedbar-verbosity-level)
+ (message "Updating speedbar to: %s..."
+ default-directory))
+ (speedbar-update-directory-contents)
+ (if (<= 1 speedbar-verbosity-level)
+ (message "Updating speedbar to: %s...done"
+ default-directory))))
+ (select-frame af))
+ ;; Now run stealthy updates of time-consuming items
+ (speedbar-stealthy-updates)))))
+ (run-hooks 'speedbar-timer-hook))
+
+\f
+;;; Stealthy activities
+;;
+(defun speedbar-stealthy-updates ()
+ "For a given speedbar, run all items in the stealthy function list.
+Each item returns t if it completes successfully, or nil if
+interrupted by the user."
+ (let ((l speedbar-stealthy-function-list))
+ (unwind-protect
+ (while (and l (funcall (car l)))
+ (sit-for 0)
+ (setq l (cdr l)))
+ ;(message "Exit with %S" (car l))
+ )))
+
+(defun speedbar-reset-scanners ()
+ "Reset any variables used by functions in the stealthy list as state.
+If new functions are added, their state needs to be updated here."
+ (setq speedbar-vc-to-do-point t)
+ (run-hooks 'speedbar-scanner-reset-hook)
+ )
+
+(defun speedbar-clear-current-file ()
+ "Locate the file thought to be current, and remove its highlighting."
+ (save-excursion
+ (set-buffer speedbar-buffer)
+ (if speedbar-last-selected-file
+ (speedbar-with-writable
+ (goto-char (point-min))
+ (if (and
+ speedbar-last-selected-file
+ (re-search-forward
+ (concat " \\(" (regexp-quote speedbar-last-selected-file)
+ "\\)\\(" (regexp-quote speedbar-vc-indicator)
+ "\\)?\n")
+ nil t))
+ (put-text-property (match-beginning 1)
+ (match-end 1)
+ 'face
+ 'speedbar-file-face))))))
+
+(defun speedbar-update-current-file ()
+ "Find the current file, and update our visuals to indicate its name.
+This is specific to file names. If the file name doesn't show up, but
+it should be in the list, then the directory cache needs to be
+updated."
+ (let* ((lastf (selected-frame))
+ (newcfd (save-excursion
+ (select-frame speedbar-attached-frame)
+ (let ((rf (if (buffer-file-name)
+ (buffer-file-name)
+ nil)))
+ (select-frame lastf)
+ rf)))
+ (newcf (if newcfd (file-name-nondirectory newcfd)))
+ (lastb (current-buffer))
+ (sucf-recursive (boundp 'sucf-recursive)))
+ (if (and newcf
+ ;; check here, that way we won't refresh to newcf until
+ ;; its been written, thus saving ourselves some time
+ (file-exists-p newcf)
+ (not (string= newcf speedbar-last-selected-file)))
+ (progn
+ ;; It is important to select the frame, otherwise the window
+ ;; we want the cursor to move in will not be updated by the
+ ;; search-forward command.
+ (select-frame speedbar-frame)
+ ;; Remove the old file...
+ (speedbar-clear-current-file)
+ ;; now highlight the new one.
+ (set-buffer speedbar-buffer)
+ (speedbar-with-writable
+ (goto-char (point-min))
+ (if (re-search-forward
+ (concat " \\(" (regexp-quote newcf) "\\)\\("
+ (regexp-quote speedbar-vc-indicator)
+ "\\)?\n") nil t)
+ ;; put the property on it
+ (put-text-property (match-beginning 1)
+ (match-end 1)
+ 'face
+ 'speedbar-selected-face)
+ ;; Oops, it's not in the list. Should it be?
+ (if (and (string-match speedbar-file-regexp newcf)
+ (string= (file-name-directory newcfd)
+ (expand-file-name default-directory)))
+ ;; yes, it is (we will ignore unknowns for now...)
+ (progn
+ (speedbar-refresh)
+ (if (re-search-forward
+ (concat " \\(" (regexp-quote newcf) "\\)\n") nil t)
+ ;; put the property on it
+ (put-text-property (match-beginning 1)
+ (match-end 1)
+ 'face
+ 'speedbar-selected-face)))
+ ;; if it's not in there now, whatever...
+ ))
+ (setq speedbar-last-selected-file newcf))
+ (if (not sucf-recursive)
+ (progn
+ (forward-line -1)
+ (speedbar-position-cursor-on-line)))
+ (set-buffer lastb)
+ (select-frame lastf)
+ )))
+ ;; return that we are done with this activity.
+ t)
+
+;; Load ange-ftp only if compiling to remove errors.
+;; Steven L Baur <steve@xemacs.org> said this was important:
+(eval-when-compile (or (featurep 'xemacs) (require 'ange-ftp)))
+
+(defun speedbar-check-vc ()
+ "Scan all files in a directory, and for each see if it's checked out.
+See `speedbar-this-file-in-vc' and `speedbar-vc-check-dir-p' for how
+to add more types of version control systems."
+ ;; Check for to-do to be reset. If reset but no RCS is available
+ ;; then set to nil (do nothing) otherwise, start at the beginning
+ (save-excursion
+ (set-buffer speedbar-buffer)
+ (if (and speedbar-vc-do-check (eq speedbar-vc-to-do-point t)
+ (speedbar-vc-check-dir-p default-directory)
+ (not (and (featurep 'ange-ftp)
+ (string-match (car
+ (if speedbar-xemacsp
+ ange-ftp-path-format
+ ange-ftp-name-format))
+ (expand-file-name default-directory)))))
+ (setq speedbar-vc-to-do-point 0))
+ (if (numberp speedbar-vc-to-do-point)
+ (progn
+ (goto-char speedbar-vc-to-do-point)
+ (while (and (not (input-pending-p))
+ (re-search-forward "^\\([0-9]+\\):\\s-*\\[[+-]\\] "
+ nil t))
+ (setq speedbar-vc-to-do-point (point))
+ (if (speedbar-check-vc-this-line (match-string 1))
+ (if (not (looking-at (regexp-quote speedbar-vc-indicator)))
+ (speedbar-with-writable (insert speedbar-vc-indicator)))
+ (if (looking-at (regexp-quote speedbar-vc-indicator))
+ (speedbar-with-writable
+ (delete-region (match-beginning 0) (match-end 0))))))
+ (if (input-pending-p)
+ ;; return that we are incomplete
+ nil
+ ;; we are done, set to-do to nil
+ (setq speedbar-vc-to-do-point nil)
+ ;; and return t
+ t))
+ t)))
+
+(defun speedbar-check-vc-this-line (depth)
+ "Return t if the file on this line is check of of a version control system.
+Parameter DEPTH is a string with the current depth of indentation of
+the file being checked."
+ (let* ((d (string-to-int depth))
+ (f (speedbar-line-path d))
+ (fn (buffer-substring-no-properties
+ ;; Skip-chars: thanks ptype@dra.hmg.gb
+ (point) (progn
+ (skip-chars-forward "^ "
+ (save-excursion (end-of-line)
+ (point)))
+ (point))))
+ (fulln (concat f fn)))
+ (if (<= 2 speedbar-verbosity-level)
+ (message "Speedbar vc check...%s" fulln))
+ (and (file-writable-p fulln)
+ (speedbar-this-file-in-vc f fn))))
+
+(defun speedbar-vc-check-dir-p (path)
+ "Return t if we should bother checking PATH for version control files.
+This can be overloaded to add new types of version control systems."
+ (or
+ ;; Local RCS
+ (file-exists-p (concat path "RCS/"))
+ ;; Local SCCS
+ (file-exists-p (concat path "SCCS/"))
+ ;; Remote SCCS project
+ (let ((proj-dir (getenv "PROJECTDIR")))
+ (if proj-dir
+ (file-exists-p (concat proj-dir "/SCCS"))
+ nil))
+ ;; User extension
+ (run-hook-with-args 'speedbar-vc-path-enable-hook path)
+ ))
+
+(defun speedbar-this-file-in-vc (path name)
+ "Check to see if the file in PATH with NAME is in a version control system.
+You can add new VC systems by overriding this function. You can
+optimize this function by overriding it and only doing those checks
+that will occur on your system."
+ (or
+ ;; RCS file name
+ (file-exists-p (concat path "RCS/" name ",v"))
+ ;; Local SCCS file name
+ (file-exists-p (concat path "SCCS/p." name))
+ ;; Remote SCCS file name
+ (let ((proj-dir (getenv "PROJECTDIR")))
+ (if proj-dir
+ (file-exists-p (concat proj-dir "/SCCS/p." name))
+ nil))
+ ;; User extension
+ (run-hook-with-args 'speedbar-vc-in-control-hook path name)
+ ))
+\f
+;;; Clicking Activity
+;;
+(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")
+ (mouse-set-point e)
+ (speedbar-position-cursor-on-line)
+ )
+
+(defun speedbar-position-cursor-on-line ()
+ "Position the cursor on a line."
+ (let ((oldpos (point)))
+ (beginning-of-line)
+ (if (looking-at "[0-9]+:\\s-*..?.? ")
+ (goto-char (1- (match-end 0)))
+ (goto-char oldpos))))
+
+(defun speedbar-power-click (e)
+ "Activate any speedbar button as a power click.
+This should be bound to mouse event E."
+ (interactive "e")
+ (let ((speedbar-power-click t))
+ (speedbar-click e)))
+
+(defun speedbar-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")
+ (mouse-set-point e)
+ (speedbar-do-function-pointer)
+ (speedbar-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)
+ (mouse-set-point e))
+ ((eq (car e) 'mouse-1)
+ (speedbar-quick-mouse e))
+ ((or (eq (car e) 'double-down-mouse-1)
+ (eq (car e) 'tripple-down-mouse-1))
+ (mouse-set-point e)
+ (speedbar-do-function-pointer)
+ (speedbar-quick-mouse e))))
+
+(defun speedbar-do-function-pointer ()
+ "Look under the cursor and examine the text properties.
+From this extract the file/tag name, token, indentation level and call
+a function if appropriate"
+ (let* ((fn (get-text-property (point) 'speedbar-function))
+ (tok (get-text-property (point) 'speedbar-token))
+ ;; The 1-,+ is safe because scaning starts AFTER the point
+ ;; specified. This lets the search include the character the
+ ;; cursor is on.
+ (tp (previous-single-property-change
+ (1+ (point)) 'speedbar-function))
+ (np (next-single-property-change
+ (point) 'speedbar-function))
+ (txt (buffer-substring-no-properties (or tp (point-min))
+ (or np (point-max))))
+ (dent (save-excursion (beginning-of-line)
+ (string-to-number
+ (if (looking-at "[0-9]+")
+ (buffer-substring-no-properties
+ (match-beginning 0) (match-end 0))
+ "0")))))
+ ;;(message "%S:%S:%S:%s" fn tok txt dent)
+ (and fn (funcall fn txt tok dent)))
+ (speedbar-position-cursor-on-line))
+\f
+;;; Reading info from the speedbar buffer
+;;
+(defun speedbar-line-file (&optional p)
+ "Retrieve the file or whatever from the line at P point.
+The return value is a string representing the file. If it is a
+directory, then it is the directory name."
+ (save-excursion
+ (save-match-data
+ (beginning-of-line)
+ (if (looking-at (concat
+ "\\([0-9]+\\): *[[<][-+?][]>] \\([^ \n]+\\)\\("
+ (regexp-quote speedbar-vc-indicator)
+ "\\)?"))
+ (let* ((depth (string-to-int (match-string 1)))
+ (path (speedbar-line-path depth))
+ (f (match-string 2)))
+ (concat path f))
+ nil))))
+
+(defun speedbar-goto-this-file (file)
+ "If FILE is displayed, goto this line and return t.
+Otherwise do not move and return nil."
+ (let ((path (substring (file-name-directory (expand-file-name file))
+ (length (expand-file-name default-directory))))
+ (dest (point)))
+ (save-match-data
+ (goto-char (point-min))
+ ;; scan all the directories
+ (while (and path (not (eq path t)))
+ (if (string-match "^/?\\([^/]+\\)" path)
+ (let ((pp (match-string 1 path)))
+ (if (save-match-data
+ (re-search-forward (concat "> " (regexp-quote pp) "$")
+ nil t))
+ (setq path (substring path (match-end 1)))
+ (setq path nil)))
+ (setq path t)))
+ ;; find the file part
+ (if (or (not path) (string= (file-name-nondirectory file) ""))
+ ;; only had a dir part
+ (if path
+ (progn
+ (speedbar-position-cursor-on-line)
+ t)
+ (goto-char dest) nil)
+ ;; find the file part
+ (let ((nd (file-name-nondirectory file)))
+ (if (re-search-forward
+ (concat "] \\(" (regexp-quote nd)
+ "\\)\\(" (regexp-quote speedbar-vc-indicator) "\\)?$")
+ nil t)
+ (progn
+ (speedbar-position-cursor-on-line)
+ t)
+ (goto-char dest)
+ nil))))))
+
+(defun speedbar-line-path (depth)
+ "Retrieve the pathname associated with the current line.
+This may require traversing backwards from DEPTH and combining the default
+directory with these items."
+ (save-excursion
+ (save-match-data
+ (let ((path nil))
+ (setq depth (1- depth))
+ (while (/= depth -1)
+ (if (not (re-search-backward (format "^%d:" depth) nil t))
+ (error "Error building path of tag")
+ (cond ((looking-at "[0-9]+:\\s-*<->\\s-+\\([^\n]+\\)$")
+ (setq path (concat (buffer-substring-no-properties
+ (match-beginning 1) (match-end 1))
+ "/"
+ path)))
+ ((looking-at "[0-9]+:\\s-*[-]\\s-+\\([^\n]+\\)$")
+ ;; This is the start of our path.
+ (setq path (buffer-substring-no-properties
+ (match-beginning 1) (match-end 1))))))
+ (setq depth (1- depth)))
+ (if (and path
+ (string-match (concat (regexp-quote speedbar-vc-indicator) "$")
+ path))
+ (setq path (substring path 0 (match-beginning 0))))
+ (concat default-directory path)))))
+
+(defun speedbar-path-line (path)
+ "Position the cursor on the line specified by PATH."
+ (save-match-data
+ (if (string-match "/$" path)
+ (setq path (substring path 0 (match-beginning 0))))
+ (let ((nomatch t) (depth 0)
+ (fname (file-name-nondirectory path))
+ (pname (file-name-directory path)))
+ (if (not (member pname speedbar-shown-directories))
+ (error "Internal Error: File %s not shown in speedbar." path))
+ (goto-char (point-min))
+ (while (and nomatch
+ (re-search-forward
+ (concat "[]>] \\(" (regexp-quote fname)
+ "\\)\\(" (regexp-quote speedbar-vc-indicator) "\\)?$")
+ nil t))
+ (beginning-of-line)
+ (looking-at "\\([0-9]+\\):")
+ (setq depth (string-to-int (match-string 0))
+ nomatch (not (string= pname (speedbar-line-path depth))))
+ (end-of-line))
+ (beginning-of-line)
+ (not nomatch))))
+
+(defun speedbar-edit-line ()
+ "Edit whatever tag or file is on the current speedbar line."
+ (interactive)
+ (or (save-excursion
+ (beginning-of-line)
+ ;; If this fails, then it is a non-standard click, and as such,
+ ;; perfectly allowed.
+ (if (re-search-forward "[]>}] [a-zA-Z0-9]"
+ (save-excursion (end-of-line) (point))
+ t)
+ (speedbar-do-function-pointer)
+ nil))
+ (speedbar-do-function-pointer)))
+
+(defun speedbar-expand-line ()
+ "Expand the line under the cursor."
+ (interactive)
+ (beginning-of-line)
+ (re-search-forward ":\\s-*.\\+. " (save-excursion (end-of-line) (point)))
+ (forward-char -2)
+ (speedbar-do-function-pointer))
+
+(defun speedbar-contract-line ()
+ "Contract the line under the cursor."
+ (interactive)
+ (beginning-of-line)
+ (re-search-forward ":\\s-*.-. " (save-excursion (end-of-line) (point)))
+ (forward-char -2)
+ (speedbar-do-function-pointer))
+
+(if speedbar-xemacsp
+ (defalias 'speedbar-mouse-event-p 'button-press-event-p)
+ (defun speedbar-mouse-event-p (event)
+ "Return t if the event is a mouse related event"
+ ;; And Emacs does it this way
+ (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)
+ (progn
+ (select-frame speedbar-attached-frame)
+ (other-frame 0))))
+
+(defun speedbar-find-file (text token indent)
+ "Speedbar click handler for filenames.
+TEXT, the file will be displayed in the attached frame.
+TOKEN is unused, but required by the click handler. INDENT is the
+current indentation level."
+ (let ((cdd (speedbar-line-path indent)))
+ (speedbar-find-file-in-frame (concat cdd text))
+ (speedbar-stealthy-updates)
+ (run-hooks 'speedbar-visiting-file-hook)
+ ;; Reset the timer with a new timeout when cliking a file
+ ;; in case the user was navigating directories, we can cancel
+ ;; that other timer.
+ (speedbar-set-timer speedbar-update-speed))
+ (speedbar-maybee-jump-to-attached-frame))
+
+(defun speedbar-dir-follow (text token indent)
+ "Speedbar click handler for directory names.
+Clicking a directory will cause the speedbar to list files in the
+the subdirectory TEXT. TOKEN is an unused requirement. The
+subdirectory chosen will be at INDENT level."
+ (setq default-directory
+ (concat (expand-file-name (concat (speedbar-line-path indent) text))
+ "/"))
+ ;; Because we leave speedbar as the current buffer,
+ ;; update contents will change directory without
+ ;; having to touch the attached frame.
+ (speedbar-update-contents)
+ (speedbar-set-timer speedbar-navigating-speed)
+ (setq speedbar-last-selected-file nil)
+ (speedbar-stealthy-updates))
+
+(defun speedbar-delete-subblock (indent)
+ "Delete text from point to indentation level INDENT or greater.
+Handles end-of-sublist smartly."
+ (speedbar-with-writable
+ (save-excursion
+ (end-of-line) (forward-char 1)
+ (while (and (not (save-excursion
+ (re-search-forward (format "^%d:" indent)
+ nil t)))
+ (>= indent 0))
+ (setq indent (1- indent)))
+ (delete-region (point) (if (>= indent 0)
+ (match-beginning 0)
+ (point-max))))))
+
+(defun speedbar-dired (text token indent)
+ "Speedbar click handler for directory expand button.
+Clicking this button expands or contracts a directory. TEXT is the
+button clicked which has either a + or -. TOKEN is the directory to be
+expanded. INDENT is the current indentation level."
+ (cond ((string-match "+" text) ;we have to expand this dir
+ (setq speedbar-shown-directories
+ (cons (expand-file-name
+ (concat (speedbar-line-path indent) token "/"))
+ speedbar-shown-directories))
+ (speedbar-change-expand-button-char ?-)
+ (speedbar-reset-scanners)
+ (save-excursion
+ (end-of-line) (forward-char 1)
+ (speedbar-with-writable
+ (speedbar-default-directory-list
+ (concat (speedbar-line-path indent) token "/")
+ (1+ indent)))))
+ ((string-match "-" text) ;we have to contract this node
+ (speedbar-reset-scanners)
+ (let ((oldl speedbar-shown-directories)
+ (newl nil)
+ (td (expand-file-name
+ (concat (speedbar-line-path indent) token))))
+ (while oldl
+ (if (not (string-match (concat "^" (regexp-quote td)) (car oldl)))
+ (setq newl (cons (car oldl) newl)))
+ (setq oldl (cdr oldl)))
+ (setq speedbar-shown-directories newl))
+ (speedbar-change-expand-button-char ?+)
+ (speedbar-delete-subblock indent)
+ )
+ (t (error "Ooops... not sure what to do.")))
+ (speedbar-center-buffer-smartly)
+ (setq speedbar-last-selected-file nil)
+ (save-excursion (speedbar-stealthy-updates)))
+
+(defun speedbar-directory-buttons-follow (text token indent)
+ "Speedbar click handler for default directory buttons.
+TEXT is the button clicked on. TOKEN is the directory to follow.
+INDENT is the current indentation level and is unused."
+ (setq default-directory token)
+ ;; Because we leave speedbar as the current buffer,
+ ;; update contents will change directory without
+ ;; having to touch the attached frame.
+ (speedbar-update-contents)
+ (speedbar-set-timer speedbar-navigating-speed))
+
+(defun speedbar-tag-file (text token indent)
+ "The cursor is on a selected line. Expand the tags in the specified file.
+The parameter TEXT and TOKEN are required, where TEXT is the button
+clicked, and TOKEN is the file to expand. INDENT is the current
+indentation level."
+ (cond ((string-match "+" text) ;we have to expand this file
+ (let* ((fn (expand-file-name (concat (speedbar-line-path indent)
+ token)))
+ (lst (if speedbar-use-imenu-flag
+ (let ((tim (speedbar-fetch-dynamic-imenu fn)))
+ (if (eq tim t)
+ (speedbar-fetch-dynamic-etags fn)
+ tim))
+ (speedbar-fetch-dynamic-etags fn))))
+ ;; if no list, then remove expando button
+ (if (not lst)
+ (speedbar-change-expand-button-char ??)
+ (speedbar-change-expand-button-char ?-)
+ (speedbar-with-writable
+ (save-excursion
+ (end-of-line) (forward-char 1)
+ (speedbar-insert-generic-list indent
+ lst 'speedbar-tag-expand
+ 'speedbar-tag-find))))))
+ ((string-match "-" text) ;we have to contract this node
+ (speedbar-change-expand-button-char ?+)
+ (speedbar-delete-subblock indent))
+ (t (error "Ooops... not sure what to do.")))
+ (speedbar-center-buffer-smartly))
+
+(defun speedbar-tag-find (text token indent)
+ "For the tag TEXT in a file TOKEN, goto that position.
+INDENT is the current indentation level."
+ (let ((file (speedbar-line-path indent)))
+ (speedbar-find-file-in-frame file)
+ (save-excursion (speedbar-stealthy-updates))
+ ;; Reset the timer with a new timeout when cliking a file
+ ;; in case the user was navigating directories, we can cancel
+ ;; that other timer.
+ (speedbar-set-timer speedbar-update-speed)
+ (goto-char token)
+ (run-hooks 'speedbar-visiting-tag-hook)
+ ;;(recenter)
+ (speedbar-maybee-jump-to-attached-frame)
+ ))
+
+(defun speedbar-tag-expand (text token indent)
+ "Expand a tag sublist. Imenu will return sub-lists of specialized tag types.
+Etags does not support this feature. TEXT will be the button
+string. TOKEN will be the list, and INDENT is the current indentation
+level."
+ (cond ((string-match "+" text) ;we have to expand this file
+ (speedbar-change-expand-button-char ?-)
+ (speedbar-with-writable
+ (save-excursion
+ (end-of-line) (forward-char 1)
+ (speedbar-insert-generic-list indent
+ token 'speedbar-tag-expand
+ 'speedbar-tag-find))))
+ ((string-match "-" text) ;we have to contract this node
+ (speedbar-change-expand-button-char ?+)
+ (speedbar-delete-subblock indent))
+ (t (error "Ooops... not sure what to do.")))
+ (speedbar-center-buffer-smartly))
+\f
+;;; Loading files into the attached frame.
+;;
+(defun speedbar-find-file-in-frame (file)
+ "This will load FILE into the speedbar attached frame.
+If the file is being displayed in a different frame already, then raise that
+frame instead."
+ (let* ((buff (find-file-noselect file))
+ (bwin (get-buffer-window buff 0)))
+ (if bwin
+ (progn
+ (select-window bwin)
+ (raise-frame (window-frame bwin)))
+ (if speedbar-power-click
+ (let ((pop-up-frames t)) (select-window (display-buffer buff)))
+ (select-frame speedbar-attached-frame)
+ (switch-to-buffer buff))))
+ )
+
+;;; Centering Utility
+;;
+(defun speedbar-center-buffer-smartly ()
+ "Recenter a speedbar buffer so the current indentation level is all visible.
+This assumes that the cursor is on a file, or tag of a file which the user is
+interested in."
+ (if (<= (count-lines (point-min) (point-max))
+ (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))
+ (error "Center error"))
+ (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)))))
+
+\f
+;;; Tag Management -- Imenu
+;;
+(if (not speedbar-use-imenu-flag)
+
+ nil
+
+(eval-when-compile (if (locate-library "imenu") (require 'imenu)))
+
+(defun speedbar-fetch-dynamic-imenu (file)
+ "Load FILE into a buffer, and generate tags using Imenu.
+Returns the tag list, or t for an error."
+ ;; Load this AND compile it in
+ (require 'imenu)
+ (save-excursion
+ (set-buffer (find-file-noselect file))
+ (if speedbar-power-click (setq imenu--index-alist nil))
+ (condition-case nil
+ (let ((index-alist (imenu--make-index-alist t)))
+ (if speedbar-sort-tags
+ (sort (copy-alist index-alist)
+ (lambda (a b) (string< (car a) (car b))))
+ index-alist))
+ (error t))))
+)
+\f
+;;; Tag Management -- etags (old XEmacs compatibility part)
+;;
+(defvar speedbar-fetch-etags-parse-list
+ '(;; Note that java has the same parse-group as c
+ ("\\.\\([cChH]\\|c\\+\\+\\|cpp\\|cc\\|hh\\|java\\)\\'" .
+ speedbar-parse-c-or-c++tag)
+ ("^\\.emacs$\\|.\\(el\\|l\\|lsp\\)\\'" .
+ "def[^i]+\\s-+\\(\\(\\w\\|[-_]\\)+\\)\\s-*\C-?")
+ ("\\.tex\\'" . speedbar-parse-tex-string)
+ ("\\.p\\'" .
+ "\\(\\(FUNCTION\\|function\\|PROCEDURE\\|procedure\\)\\s-+\\([a-zA-Z0-9_.:]+\\)\\)\\s-*(?^?")
+ )
+ "Associations of file extensions and expressions for extracting tags.
+To add a new file type, you would want to add a new association to the
+list, where the car is the file match, and the cdr is the way to
+extract an element from the tags output. If the output is complex,
+use a function symbol instead of regexp. The function should expect
+to be at the beginning of a line in the etags buffer.
+
+This variable is ignored if `speedbar-use-imenu-flag' is non-nil.")
+
+(defvar speedbar-fetch-etags-command "etags"
+ "*Command used to create an etags file.
+
+This variable is ignored if `speedbar-use-imenu-flag' is t")
+
+(defvar speedbar-fetch-etags-arguments '("-D" "-I" "-o" "-")
+ "*List of arguments to use with `speedbar-fetch-etags-command'.
+This creates an etags output buffer. Use `speedbar-toggle-etags' to
+modify this list conveniently.
+
+This variable is ignored if `speedbar-use-imenu-flag' is t")
+
+(defun speedbar-toggle-etags (flag)
+ "Toggle FLAG in `speedbar-fetch-etags-arguments'.
+FLAG then becomes a member of etags command line arguments. If flag
+is \"sort\", then toggle the value of `speedbar-sort-tags'. If its
+value is \"show\" then toggle the value of
+`speedbar-show-unknown-files'.
+
+ This function is a convenience function for XEmacs menu created by
+Farzin Guilak <farzin@protocol.com>"
+ (interactive)
+ (cond
+ ((equal flag "sort")
+ (setq speedbar-sort-tags (not speedbar-sort-tags)))
+ ((equal flag "show")
+ (setq speedbar-show-unknown-files (not speedbar-show-unknown-files)))
+ ((or (equal flag "-C")
+ (equal flag "-S")
+ (equal flag "-D"))
+ (if (member flag speedbar-fetch-etags-arguments)
+ (setq speedbar-fetch-etags-arguments
+ (delete flag speedbar-fetch-etags-arguments))
+ (add-to-list 'speedbar-fetch-etags-arguments flag)))
+ (t nil)))
+
+(defun speedbar-fetch-dynamic-etags (file)
+ "For FILE, run etags and create a list of symbols extracted.
+Each symbol will be associated with its line position in FILE."
+ (let ((newlist nil))
+ (unwind-protect
+ (save-excursion
+ (if (get-buffer "*etags tmp*")
+ (kill-buffer "*etags tmp*")) ;kill to clean it up
+ (if (<= 1 speedbar-verbosity-level) (message "Fetching etags..."))
+ (set-buffer (get-buffer-create "*etags tmp*"))
+ (apply 'call-process speedbar-fetch-etags-command nil
+ (current-buffer) nil
+ (append speedbar-fetch-etags-arguments (list file)))
+ (goto-char (point-min))
+ (if (<= 1 speedbar-verbosity-level) (message "Fetching etags..."))
+ (let ((expr
+ (let ((exprlst speedbar-fetch-etags-parse-list)
+ (ans nil))
+ (while (and (not ans) exprlst)
+ (if (string-match (car (car exprlst)) file)
+ (setq ans (car exprlst)))
+ (setq exprlst (cdr exprlst)))
+ (cdr ans))))
+ (if expr
+ (let (tnl)
+ (while (not (save-excursion (end-of-line) (eobp)))
+ (save-excursion
+ (setq tnl (speedbar-extract-one-symbol expr)))
+ (if tnl (setq newlist (cons tnl newlist)))
+ (forward-line 1)))
+ (message "Sorry, no support for a file of that extension"))))
+ )
+ (if speedbar-sort-tags
+ (sort newlist (lambda (a b) (string< (car a) (car b))))
+ (reverse newlist))))
+
+;; This bit donated by Farzin Guilak <farzin@protocol.com> but I'm not
+;; sure it's needed with the different sorting method.
+;;
+;(defun speedbar-clean-etags()
+; "Removes spaces before the ^? character, and removes `#define',
+;return types, etc. preceding tags. This ensures that the sort operation
+;works on the tags, not the return types."
+; (save-excursion
+; (goto-char (point-min))
+; (while
+; (re-search-forward "(?[ \t](?\C-?" nil t)
+; (replace-match "\C-?" nil nil))
+; (goto-char (point-min))
+; (while
+; (re-search-forward "\\(.*[ \t]+\\)\\([^ \t\n]+.*\C-?\\)" nil t)
+; (delete-region (match-beginning 1) (match-end 1)))))
+
+(defun speedbar-extract-one-symbol (expr)
+ "At point, return nil, or one alist in the form: ( symbol . position )
+The line should contain output from etags. Parse the output using the
+regular expression EXPR"
+ (let* ((sym (if (stringp expr)
+ (if (save-excursion
+ (re-search-forward expr (save-excursion
+ (end-of-line)
+ (point)) t))
+ (buffer-substring-no-properties (match-beginning 1)
+ (match-end 1)))
+ (funcall expr)))
+ (pos (let ((j (re-search-forward "[\C-?\C-a]\\([0-9]+\\),\\([0-9]+\\)"
+ (save-excursion
+ (end-of-line)
+ (point))
+ t)))
+ (if (and j sym)
+ (1+ (string-to-int (buffer-substring-no-properties
+ (match-beginning 2)
+ (match-end 2))))
+ 0))))
+ (if (/= pos 0)
+ (cons sym pos)
+ nil)))
+
+(defun speedbar-parse-c-or-c++tag ()
+ "Parse a c or c++ tag, which tends to be a little complex."
+ (save-excursion
+ (let ((bound (save-excursion (end-of-line) (point))))
+ (cond ((re-search-forward "\C-?\\([^\C-a]+\\)\C-a" bound t)
+ (buffer-substring-no-properties (match-beginning 1)
+ (match-end 1)))
+ ((re-search-forward "\\<\\([^ \t]+\\)\\s-+new(" bound t)
+ (buffer-substring-no-properties (match-beginning 1)
+ (match-end 1)))
+ ((re-search-forward "\\<\\([^ \t(]+\\)\\s-*(\C-?" bound t)
+ (buffer-substring-no-properties (match-beginning 1)
+ (match-end 1)))
+ (t nil))
+ )))
+
+(defun speedbar-parse-tex-string ()
+ "Parse a Tex string. Only find data which is relevant."
+ (save-excursion
+ (let ((bound (save-excursion (end-of-line) (point))))
+ (cond ((re-search-forward "\\(\\(sub\\)*section\\|chapter\\|cite\\)\\s-*{[^\C-?}]*}?" bound t)
+ (buffer-substring-no-properties (match-beginning 0)
+ (match-end 0)))
+ (t nil)))))
+
+\f
+;;; Color loading section This is messy *Blech!*
+;;
+(defface speedbar-button-face '((((class color) (background light))
+ (:foreground "green4"))
+ (((class color) (background dark))
+ (:foreground "green3")))
+ "Face used for +/- buttons."
+ :group 'speedbar-faces)
+
+(defface speedbar-file-face '((((class color) (background light))
+ (:foreground "cyan4"))
+ (((class color) (background dark))
+ (:foreground "cyan"))
+ (t (:bold t)))
+ "Face used for file names."
+ :group 'speedbar-faces)
+
+(defface speedbar-directory-face '((((class color) (background light))
+ (:foreground "blue4"))
+ (((class color) (background dark))
+ (:foreground "light blue")))
+ "Faced used for directory names."
+ :group 'speedbar-faces)
+(defface speedbar-tag-face '((((class color) (background light))
+ (:foreground "brown"))
+ (((class color) (background dark))
+ (:foreground "yellow")))
+ "Face used for displaying tags."
+ :group 'speedbar-faces)
+
+(defface speedbar-selected-face '((((class color) (background light))
+ (:foreground "red" :underline t))
+ (((class color) (background dark))
+ (:foreground "red" :underline t))
+ (t (:underline t)))
+ "Face used to underline the file in the active window."
+ :group 'speedbar-faces)
+
+(defface speedbar-highlight-face '((((class color) (background light))
+ (:background "green"))
+ (((class color) (background dark))
+ (:background "sea green"))
+ (((class grayscale monochrome)
+ (background light))
+ (:background "black"))
+ (((class grayscale monochrome)
+ (background dark))
+ (:background "white")))
+ "Face used for highlighting buttons with the mouse."
+ :group 'speedbar-faces)
+
+;; some edebug hooks
+(add-hook 'edebug-setup-hook
+ (lambda ()
+ (def-edebug-spec speedbar-with-writable def-body)))
+
+(provide 'speedbar)
+;;; speedbar ends here
+
+;; run load-time hooks
+(run-hooks 'speedbar-load-hook)
projects / emacs.git / commitdiff