-;;; speedbar --- quick access to files and tags
+;;; speedbar --- quick access to files and tags in a frame
-;;; Copyright (C) 1996, 97, 98 Free Software Foundation
-;;
-;; Author: Eric M. Ludlam <zappo@gnu.ai.mit.edu>
-;; Version: 0.6.2
+;;; Copyright (C) 1996, 97, 98, 99 Free Software Foundation
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+;; Version: 0.8.1
;; 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,
;;
;; 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:
+;; Simply type `M-x speedbar', and it will be autoloaded for you.
+
+;; If you want to choose it from a menu, such as "Tools", you can do this:
;;
-;; 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)
+;; (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
;; 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
+;; 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'.
;;
;; 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.
+;; To enable mouse tracking with information in the minibuffer of
+;; the attached frame, use the variable `speedbar-track-mouse-flag'.
;;
-;; See optional file `speedbspec.el' for additional configurations
-;; which allow speedbar to create specialized lists for special modes
-;; that are not file-related.
+;; Tag layout can be modified through `speedbar-tag-hierarchy-method',
+;; which controls how tags are layed out. It is actually a list of
+;; functions that filter the data. The default groups large tag lists
+;; into sub-lists. A long flat list can be used instead if needed.
+;; Other filters could be easily added.
;;
;; 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/
+;;; Developing for speedbar
;;
-;; 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:
+;; Adding a speedbar specialized display mode:
;;
-;; 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
+;; Speedbar can be configured to create a special display for certain
+;; modes that do not display tradition file/tag data. Rmail, Info,
+;; and the debugger are examples. These modes can, however, benefit
+;; from a speedbar style display in their own way.
;;
-
-;;; 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'
+;; If your `major-mode' is `foo-mode', the only requirement is to
+;; create a function called `foo-speedbar-buttons' which takes one
+;; argument, BUFFER. BUFFER will be the buffer speedbar wants filled.
+;; In `foo-speedbar-buttons' there are several functions that make
+;; building a speedbar display easy. See the documentation for
+;; `speedbar-with-writable' (needed because the buffer is usually
+;; read-only) `speedbar-make-tag-line', `speedbar-insert-button', and
+;; `speedbar-insert-generic-list'. If you use
+;; `speedbar-insert-generic-list', also read the doc for
+;; `speedbar-tag-hierarchy-method' in case you wish to override it.
+;; The function `speedbar-with-attached-buffer' brings you back to the
+;; buffer speedbar is displaying for.
+;;
+;; For those functions that make buttons, the "function" should be a
+;; symbol that is the function to call when clicked on. The "token"
+;; is extra data you can pass along. The "function" must take three
+;; parameters. They are (TEXT TOKEN INDENT). TEXT is the text of the
+;; button clicked on. TOKEN is the data passed in when you create the
+;; button. INDENT is an indentation level, or 0. You can store
+;; indentation levels with `speedbar-make-tag-line' which creates a
+;; line with an expander (eg. [+]) and a text button.
+;;
+;; Some useful functions when writing expand functions, and click
+;; functions are `speedbar-change-expand-button-char',
+;; `speedbar-delete-subblock', and `speedbar-center-buffer-smartly'.
+;; The variable `speedbar-power-click' is set to t in your functions
+;; when the user shift-clicks. This indications anything from
+;; refreshing cached data to making a buffer appear in a new frame.
+;;
+;; If you wish to add to the default speedbar menu for the case of
+;; `foo-mode', create a variable `foo-speedbar-menu-items'. This
+;; should be a list compatible with the `easymenu' package. It will
+;; be spliced into the main menu. (Available with click-mouse-3). If
+;; you wish to have extra key bindings in your special mode, create a
+;; variable `foo-speedbar-key-map'. Instead of using `make-keymap',
+;; or `make-sparse-keymap', use the function
+;; `speedbar-make-specialized-keymap'. This lets you inherit all of
+;; speedbar's default bindings with low overhead.
+;;
+;; Adding a speedbar top-level display mode:
+;;
+;; Unlike the specialized modes, there are no name requirements,
+;; however the methods for writing a button display, menu, and keymap
+;; are the same. Once you create these items, you can call the
+;; function `speedbar-add-expansion-list'. It takes one parameter
+;; which is a list element of the form (NAME MENU KEYMAP &rest
+;; BUTTON-FUNCTIONS). NAME is a string that will show up in the
+;; Displays menu item. MENU is a symbol containing the menu items to
+;; splice in. KEYMAP is a symbol holding the keymap to use, and
+;; BUTTON-FUNCTIONS are the function names to call, in order, to create
+;; the display.
+;; Another tweekable variable is `speedbar-stealthy-function-list'
+;; which is of the form (NAME &rest FUNCTION ...). NAME is the string
+;; name matching `speedbar-add-expansion-list'. (It does not need to
+;; exist.). This provides additional display info which might be
+;; time-consuming to calculate.
+;; Lastly, `speedbar-mode-functions-list' allows you to set special
+;; function overrides. At the moment very few functions are
+;; over ridable, but more will be added as the need is discovered.
;;; 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))))))
+(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)))
;; customization stuff
(defgroup speedbar nil
"File and tag browser frame."
:group 'tags
- :group 'tools)
+ :group 'tools
+ :group 'convenience
+ :version "20.3")
(defgroup speedbar-faces nil
"Faces used in 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-initial-expansion-mode-alist
+ '(("buffers" speedbar-buffer-easymenu-definition speedbar-buffers-key-map
+ speedbar-buffer-buttons)
+ ("quick buffers" speedbar-buffer-easymenu-definition speedbar-buffers-key-map
+ speedbar-buffer-buttons-temp)
+ ;; Files last, means first in the Displays menu
+ ("files" speedbar-easymenu-definition-special speedbar-file-key-map
+ speedbar-directory-buttons speedbar-default-directory-list)
+ )
+ "List of named expansion elements for filling the speedbar frame.
+These expansion lists are only valid for regular files. Special modes
+still get to override this list on a mode-by-mode basis. This list of
+lists is of the form (NAME MENU KEYMAP FN1 FN2 ...). NAME is a string
+representing the types of things to be displayed. MENU is an easymenu
+structure used when in this mode. KEYMAP is a local keymap to install
+over the regular speedbar keymap. FN1 ... are functions that will be
+called in order. 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-initial-expansion-list-name "files"
+ "A symbol name representing the expansion list to use.
+The expansion list `speedbar-initial-expansion-mode-alist' contains
+the names and associated functions to use for buttons in speedbar.")
+
+(defvar speedbar-previously-used-expansion-list-name "files"
+ "Save the last expansion list method.
+This is used for returning to a previous expansion list method when
+the user is done with the current expansion list.")
(defvar speedbar-stealthy-function-list
- '(speedbar-update-current-file speedbar-check-vc)
+ '(("files"
+ speedbar-update-current-file speedbar-check-vc speedbar-check-objects)
+ )
"List of functions to periodically call stealthily.
+This list is of the form:
+ '( (\"NAME\" FUNCTION ...)
+ ...)
+where NAME is the name of the major display mode these functions are
+for, and the remaining elements FUNCTION are functions to call in order.
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.")
+(defvar speedbar-mode-functions-list
+ '(("files" (speedbar-item-info . speedbar-files-item-info)
+ (speedbar-line-path . speedbar-files-line-path))
+ ("buffers" (speedbar-item-info . speedbar-buffers-item-info)
+ (speedbar-line-path . speedbar-buffers-line-path))
+ ("quick buffers" (speedbar-item-info . speedbar-buffers-item-info)
+ (speedbar-line-path . speedbar-buffers-line-path))
+ )
+ "List of function tables to use for different major display modes.
+It is not necessary to define any functions for a specialized mode.
+This just provides a simple way of adding lots of customizations.
+Each sublist is of the form:
+ (\"NAME\" (FUNCTIONSYMBOL . REPLACEMENTFUNCTION) ...)
+Where NAME is the name of the specialized mode. The rest of the list
+is a set of dotted pairs of the form FUNCTIONSYMBOL, which is the name
+of a function you would like to replace, and REPLACEMENTFUNCTION,
+which is a function you can call instead. Not all functions can be
+replaced this way. Replaceable functions must provide that
+functionality individually.")
+
(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
: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.
+ "Default function list for creating specialized button lists.
+This list is set by modes that wish to have special speedbar displays.
+The list is of function names. Each function is called with one
+parameter BUFFER, the originating buffer. The current buffer is the
+speedbar buffer.")
- Each function is called with the default and frame belonging to
-speedbar, and with one parameter; the buffer requesting
-the speedbar display.")
+(defvar speedbar-special-mode-key-map nil
+ "Default keymap used when identifying a specialized display mode.
+This keymap is local to each buffer that wants to define special keybindings
+effective when it's display is shown.")
(defcustom speedbar-visiting-file-hook nil
"Hooks run when speedbar visits a file in the selected frame."
:group 'speedbar
:type 'integer)
-(defcustom speedbar-navigating-speed 10
+;; When I moved to a repeating timer, I had the horrible missfortune
+;; of loosing the ability for adaptive speed choice. This update
+;; speed currently causes long delays when it should have been turned off.
+(defcustom speedbar-navigating-speed speedbar-update-speed
"*Idle time to wait after navigation commands in speedbar are executed.
Navigation commands included expanding/contracting nodes, and moving
between different directories."
(defcustom speedbar-frame-parameters '((minibuffer . nil)
(width . 20)
- (scroll-bar-width . 10)
(border-width . 0)
(menu-bar-lines . 0)
(unsplittable . t))
'(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"])
+ menubar-visible-p nil)
"*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
:group 'speedbar
:type 'boolean)
+(defcustom speedbar-track-mouse-flag t
+ "*Non-nil means to display info about the line under the mouse."
+ :group 'speedbar
+ :type 'boolean)
+
(defcustom speedbar-sort-tags nil
- "*If Non-nil, sort tags in the speedbar display."
+ "*If Non-nil, sort tags in the speedbar display. *Obsolete*."
:group 'speedbar
:type 'boolean)
+(defcustom speedbar-tag-hierarchy-method
+ '(prefix-group trim-words)
+ "*List of methods which speedbar will use to organize tags into groups.
+Groups are defined as expandable meta-tags. Imenu supports such
+things in some languages, such as separating variables from functions.
+Available methods are:
+ sort - Sort tags. (sometimes unnecessary)
+ trim-words - Trim all tags by a common prefix, broken @ word sections.
+ prefix-group - Try to guess groups by prefix.
+ simple-group - If imenu already returned some meta groups, stick all
+ tags that are not in a group into a sub-group."
+ :group 'speedbar
+ :type '(repeat
+ (radio
+ (const :tag "Sort the tags." sort)
+ (const :tag "Trim words to common prefix." trim-words)
+ (const :tag "Create groups from common prefixes." prefix-group)
+ (const :tag "Group loose tags into their own group." simple-group))
+ ))
+
+(defcustom speedbar-tag-group-name-minimum-length 4
+ "*The minimum length of a prefix group name before expanding.
+Thus, if the `speedbar-tag-hierarchy-method' includes `prefix-group'
+and one such groups common characters is less than this number of
+characters, then the group name will be changed to the form of:
+ worda to wordb
+instead of just
+ word
+This way we won't get silly looking listings."
+ :group 'speedbar
+ :type 'integer)
+
+(defcustom speedbar-tag-split-minimum-length 20
+ "*Minimum length before we stop trying to create sub-lists in tags.
+This is used by all tag-hierarchy methods that break large lists into
+sub-lists."
+ :group 'speedbar
+ :type 'integer)
+
+(defcustom speedbar-tag-regroup-maximum-length 10
+ "*Maximum length of submenus that are regrouped.
+If the regrouping option is used, then if two or more short subgroups
+are next to each other, then they are combined until this number of
+items is reached."
+ :group 'speedbar
+ :type 'integer)
+
(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
:group 'speedbar
:type 'boolean)
+(defvar speedbar-hide-button-brackets-flag nil
+ "*Non-nil means speedbar will hide the brackets around the + or -.")
+
(defcustom speedbar-before-popup-hook nil
"*Hooks called before popping up the speedbar frame."
:group 'speedbar
:group 'speedbar
:type 'integer)
+(defvar speedbar-indicator-separator " "
+ "String separating file text from indicator characters.")
+
(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 " *"
+(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
(defvar speedbar-vc-to-do-point nil
"Local variable maintaining the current version control check position.")
+(defcustom speedbar-obj-do-check t
+ "*Non-nil check all files in speedbar to see if they have an object file.
+Any file checked out is marked with `speedbar-obj-indicator', and the
+marking is based on `speedbar-obj-alist'"
+ :group 'speedbar-vc
+ :type 'boolean)
+
+(defvar speedbar-obj-to-do-point nil
+ "Local variable maintaining the current version control check position.")
+
+(defvar speedbar-obj-indicator '("#" . "!")
+ "Text used to mark files that have a corresponding hidden object file.
+The car is for an up-to-date object. The cdr is for an out of date object.
+The expression `speedbar-obj-alist' defines who gets tagged.")
+
+(defvar speedbar-obj-alist
+ '(("\\.\\([cpC]\\|cpp\\|cc\\)$" . ".o")
+ ("\\.el$" . ".elc")
+ ("\\.java$" . ".class")
+ ("\\.f\\(or\\|90\\|77\\)?$" . ".o")
+ ("\\.tex$" . ".dvi")
+ ("\\.texi$" . ".info"))
+ "Alist of file extensions, and their corresponding object file type.")
+
+(defvar speedbar-indicator-regex
+ (concat (regexp-quote speedbar-indicator-separator)
+ "\\("
+ (regexp-quote speedbar-vc-indicator)
+ "\\|"
+ (regexp-quote (car speedbar-obj-indicator))
+ "\\|"
+ (regexp-quote (cdr speedbar-obj-indicator))
+ "\\)*")
+ "Regular expression used when identifying files.
+Permits stripping of indicator characters from a line.")
+
+(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)
+
(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."
+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)) ?.)
speedbar-ignored-path-regexp
(speedbar-extension-list-to-regex val))))
+(defcustom speedbar-directory-unshown-regexp "^\\(CVS\\|RCS\\|SCCS\\)\\'"
+ "*Regular expression matching directories not to show in speedbar.
+They should include commonly existing directories which are not
+useful, such as version control."
+ :group 'speedbar
+ :type 'string)
+
(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 "\\|#[^#]+#$\\|\\.\\.?\\'"))
+ ;; backup refdir lockfile
+ (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")
+ (append '(".[ch]\\(\\+\\+\\|pp\\|c\\|h\\|xx\\)?" ".tex\\(i\\(nfo\\)?\\)?"
+ ".el" ".emacs" ".l" ".lsp" ".p" ".java" ".f\\(90\\|77\\|or\\)?")
(if speedbar-use-imenu-flag
- '(".f90" ".ada" ".pl" ".tcl" ".m"
+ '(".ada" ".pl" ".tcl" ".m" ".scm" ".pm" ".py"
+ ;; html is not supported by default, but an imenu tags package
+ ;; is available. Also, html files are nice to be able to see.
+ ".s?html"
"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
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."
+ (interactive "sExtionsion: ")
(if (not (listp extension)) (setq extension (list extension)))
(while extension
(if (member (car extension) speedbar-supported-extension-expressions)
"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'."
+ (interactive "sPath regex: ")
(if (not (listp path-expression))
(setq path-expression (list path-expression)))
(while path-expression
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))
+(defvar speedbar-update-flag (and
+ (or (fboundp 'run-with-idle-timer)
+ (fboundp 'start-itimer)
+ (boundp 'post-command-idle-hook))
+ window-system)
"*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:
(modify-syntax-entry ?[ " " speedbar-syntax-table)
(modify-syntax-entry ?] " " speedbar-syntax-table))
-
(defvar speedbar-key-map nil
"Keymap used in speedbar buffer.")
(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)
+ (define-key speedbar-key-map "Q" 'delete-frame)
;; navigation
(define-key speedbar-key-map "n" 'speedbar-next)
(define-key speedbar-key-map "p" 'speedbar-prev)
+ (define-key speedbar-key-map "\M-n" 'speedbar-restricted-next)
+ (define-key speedbar-key-map "\M-p" 'speedbar-restricted-prev)
+ (define-key speedbar-key-map "\C-\M-n" 'speedbar-forward-list)
+ (define-key speedbar-key-map "\C-\M-p" 'speedbar-backward-list)
(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)
+ ;; Short cuts I happen to find useful
+ (define-key speedbar-key-map "r"
+ (lambda () (interactive)
+ (speedbar-change-initial-expansion-list
+ speedbar-previously-used-expansion-list-name)))
+ (define-key speedbar-key-map "b"
+ (lambda () (interactive)
+ (speedbar-change-initial-expansion-list "quick buffers")))
+ (define-key speedbar-key-map "f"
+ (lambda () (interactive)
+ (speedbar-change-initial-expansion-list "files")))
+
+ ;; Overrides
+ (substitute-key-definition 'switch-to-buffer
+ 'speedbar-switch-buffer-attached-frame
+ speedbar-key-map global-map)
(if speedbar-xemacsp
(progn
;; mouse bindings so we can manipulate the items on each line
(define-key speedbar-key-map 'button2 'speedbar-click)
(define-key speedbar-key-map '(shift button2) 'speedbar-power-click)
- (define-key speedbar-key-map 'button3 'speedbar-xemacs-popup-kludge)
- (define-key speedbar-key-map '(meta button3) 'speedbar-mouse-item-info))
+ ;; Info doc fix from Bob Weiner
+ (if (featurep 'infodoc)
+ nil
+ (define-key speedbar-key-map 'button3 'speedbar-xemacs-popup-kludge))
+ (define-key speedbar-key-map '(meta button3) 'speedbar-mouse-item-info)
+ )
+
;; mouse bindings so we can manipulate the items on each line
(define-key speedbar-key-map [down-mouse-1] 'speedbar-double-click)
(define-key speedbar-key-map [mouse-2] 'speedbar-click)
(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)
- ))
+ ;; another handy place users might click to get our menu.
+ (define-key speedbar-key-map [mode-line down-mouse-1]
+ 'speedbar-emacs-popup-kludge)
+
+ ;; We can't switch buffers with the buffer mouse menu. Lets hack it.
+ (define-key speedbar-key-map [C-down-mouse-1] 'speedbar-hack-buffer-menu)
+
+ ;; Lastly, we want to track the mouse. Play here
+ (define-key speedbar-key-map [mouse-movement] 'speedbar-track-mouse)
+ ))
+
+(defun speedbar-make-specialized-keymap ()
+ "Create a keymap for use w/ a speedbar major or minor display mode.
+This basically creates a sparse keymap, and makes it's parent be
+`speedbar-key-map'."
+ (let ((k (make-sparse-keymap)))
+ (set-keymap-parent k speedbar-key-map)
+ k))
+
+(defvar speedbar-file-key-map nil
+ "Keymap used in speedbar buffer while files are displayed.")
+
+(if speedbar-file-key-map
+ nil
+ (setq speedbar-file-key-map (speedbar-make-specialized-keymap))
+
+ ;; Basic tree features
+ (define-key speedbar-file-key-map "e" 'speedbar-edit-line)
+ (define-key speedbar-file-key-map "\C-m" 'speedbar-edit-line)
+ (define-key speedbar-file-key-map "+" 'speedbar-expand-line)
+ (define-key speedbar-file-key-map "-" 'speedbar-contract-line)
+
+ ;; file based commands
+ (define-key speedbar-file-key-map "U" 'speedbar-up-directory)
+ (define-key speedbar-file-key-map "I" 'speedbar-item-info)
+ (define-key speedbar-file-key-map "B" 'speedbar-item-byte-compile)
+ (define-key speedbar-file-key-map "L" 'speedbar-item-load)
+ (define-key speedbar-file-key-map "C" 'speedbar-item-copy)
+ (define-key speedbar-file-key-map "D" 'speedbar-item-delete)
+ (define-key speedbar-file-key-map "O" 'speedbar-item-object-delete)
+ (define-key speedbar-file-key-map "R" 'speedbar-item-rename)
+ )
(defvar speedbar-easymenu-definition-base
'("Speedbar"
'(["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
+ ["Expand File Tags" speedbar-expand-line
(save-excursion (beginning-of-line)
(looking-at "[0-9]+: *.\\+. "))]
- ["Contract Item" speedbar-contract-line
+ ["Contract File Tags" speedbar-contract-line
(save-excursion (beginning-of-line)
(looking-at "[0-9]+: *.-. "))]
- ["Sort Tags" speedbar-toggle-sorting
- :style toggle :selected speedbar-sort-tags]
+; ["Sort Tags" speedbar-toggle-sorting
+; :style toggle :selected speedbar-sort-tags]
"----"
- ["Item Information" speedbar-item-info t]
+ ["File/Tag Information" speedbar-item-info t]
["Load Lisp File" speedbar-item-load
(save-excursion
(beginning-of-line)
- (looking-at "[0-9]+: *\\[[+-]\\] .+\\(\\.el\\)\\( \\*\\)?$"))]
+ (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
+ (looking-at "[0-9]+: *\\[[+-]\\] .+\\(\\.el\\)\\( \\|$\\)"))]
+ ["Copy File" speedbar-item-copy
(save-excursion (beginning-of-line) (looking-at "[0-9]+: *\\["))]
- ["Rename Item" speedbar-item-rename
+ ["Rename File" speedbar-item-rename
+ (save-excursion (beginning-of-line) (looking-at "[0-9]+: *[[<]"))]
+ ["Delete File" speedbar-item-delete
(save-excursion (beginning-of-line) (looking-at "[0-9]+: *[[<]"))]
- ["Delete Item" speedbar-item-delete
- (save-excursion (beginning-of-line) (looking-at "[0-9]+: *[[<]"))])
+ ["Delete Object" speedbar-item-object-delete
+ (save-excursion (beginning-of-line)
+ (looking-at "[0-9]+: *\\[[+-]\\] [^ \n]+ \\*?[!#]$"))]
+ )
"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]))
+ (append
+ (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
+ (list ["Customize..." speedbar-customize t]))
+ (list
+ ["Close" speedbar-close-frame t]
+ ["Quit" delete-frame t] ))
"Menu items appearing at the end of the speedbar menu.")
(defvar speedbar-desired-buffer nil
"Never set this by hand. Value is t when S-mouse activity occurs.")
\f
+;;; Compatibility
+;;
+(if (fboundp 'frame-parameter)
+
+ (defalias 'speedbar-frame-parameter 'frame-parameter)
+
+ (defun speedbar-frame-parameter (frame parameter)
+ "Return FRAME's PARAMETER value."
+ (cdr (assoc parameter (frame-parameters frame)))))
+\f
;;; Mode definitions/ user commands
;;
`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))
(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))))))
+ ;; Only guess height if it is not specified.
+ (if (member 'height speedbar-frame-plist)
+ (make-frame speedbar-frame-plist)
+ (make-frame (nconc (list 'height
+ (speedbar-needed-height))
+ speedbar-frame-plist)))
+ (let* ((mh (speedbar-frame-parameter nil 'menu-bar-lines))
+ (cfx (speedbar-frame-parameter nil 'left))
+ (cfy (speedbar-frame-parameter nil 'top))
+ (cfw (frame-pixel-width))
+ (params
+ ;; Only add a guessed height if one is not specified
+ ;; in the input parameters.
+ (if (assoc 'height speedbar-frame-parameters)
+ speedbar-frame-parameters
+ (append
+ speedbar-frame-parameters
+ (list (cons 'height (+ mh (frame-height)))))))
+ (frame
+ (if (or (< emacs-major-version 20)
+ (not (eq window-system 'x)))
+ (make-frame params)
+ (let ((x-pointer-shape x-pointer-top-left-arrow)
+ (x-sensitive-text-pointer-shape
+ x-pointer-hand2))
+ (make-frame params)))))
+ ;; Position speedbar frame.
+ (if (or (not window-system) (eq window-system 'pc)
+ (assoc 'left speedbar-frame-parameters)
+ (assoc 'top speedbar-frame-parameters))
+ ;; Do no positioning if not on a windowing system,
+ ;; or if left/top were specified in the parameters.
+ frame
+ (let ((cfx
+ (if (not (consp cfx))
+ cfx
+ ;; If cfx is a list, that means we grow
+ ;; from a specific edge of the display.
+ ;; Convert that to the distance from the
+ ;; left side of the display.
+ (if (eq (car cfx) '-)
+ ;; A - means distance from the right edge
+ ;; of the display, or DW - cfx - framewidth
+ (- (x-display-pixel-width) (car (cdr cfx))
+ (frame-pixel-width))
+ (car (cdr cfx))))))
+ (modify-frame-parameters
+ frame
+ (list
+ (cons
+ 'left
+ ;; Decide which side to put it
+ ;; on. 200 is just a buffer
+ ;; for the left edge of the
+ ;; screen. The extra 10 is just
+ ;; dressings for window decorations.
+ (let ((sfw (frame-pixel-width frame)))
+ (let ((left-guess (- cfx 10 sfw))
+ (right-guess (+ cfx cfw 5)))
+ (let ((left-margin left-guess)
+ (right-margin
+ (- (x-display-pixel-width)
+ right-guess 5 sfw)))
+ (cond ((>= left-margin 0) left-guess)
+ ((>= right-margin 0) right-guess)
+ ;; otherwise choose side we overlap less
+ ((> left-margin right-margin) 0)
+ (t (- (x-display-pixel-width) sfw 5)))))))
+ (cons 'top cfy)))
+ frame)))))
;; reset the selection variable
(setq speedbar-last-selected-file nil)
;; Put the buffer into the frame
(select-frame speedbar-frame)
(switch-to-buffer speedbar-buffer)
(set-window-dedicated-p (selected-window) t))
+ (if (and (or (null window-system) (eq window-system 'pc))
+ (fboundp 'set-frame-name))
+ (progn
+ (select-frame speedbar-frame)
+ (set-frame-name "Speedbar")))
(speedbar-set-timer speedbar-update-speed)))))
;;;###autoload
(if (eq (selected-frame) speedbar-frame)
(if (frame-live-p speedbar-attached-frame)
(select-frame speedbar-attached-frame))
+ ;; If updates are off, then refresh the frame (they want it now...)
+ (if (not speedbar-update-flag)
+ (let ((speedbar-update-flag t))
+ (speedbar-timer-fn)))
;; make sure we have a frame
(if (not (frame-live-p speedbar-frame)) (speedbar-frame-mode 1))
;; go there
- (select-frame speedbar-frame))
+ (select-frame speedbar-frame)
+ )
(other-frame 0))
(defun speedbar-close-frame ()
(select-frame speedbar-attached-frame)
(other-frame 0))
+(defun speedbar-switch-buffer-attached-frame (&optional buffer)
+ "Switch to BUFFER in speedbar's attached frame, and raise that frame.
+This overrides the default behavior of `switch-to-buffer' which is
+broken because of the dedicated speedbar frame."
+ (interactive)
+ ;; Assume we are in the speedbar frame.
+ (speedbar-get-focus)
+ ;; Now switch buffers
+ (if buffer
+ (switch-to-buffer buffer)
+ (call-interactively 'switch-to-buffer nil nil)))
+
(defmacro speedbar-frame-width ()
"Return the width of the speedbar frame in characters.
nil if it doesn't exist."
version control systems can be added by examining the documentation
for `speedbar-this-file-in-vc' and `speedbar-vc-check-dir-p'
+Files with a `#' or `!' character after them are source files that
+have an object file associated with them. The `!' indicates that the
+files is out of date. You can control what source/object associations
+exist through the variable `speedbar-obj-alist'.
+
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.
(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)
+ ;; Terminal minibuffer stuff does not require this.
+ (if (and window-system (not (eq window-system 'pc))
+ (null default-minibuffer-frame))
(progn
(make-local-variable 'default-minibuffer-frame)
(setq default-minibuffer-frame speedbar-attached-frame)))
+ ;; Correct use of `temp-buffer-show-function': Bob Weiner
+ (if (and (boundp 'temp-buffer-show-hook)
+ (boundp 'temp-buffer-show-function))
+ (progn (make-local-variable 'temp-buffer-show-hook)
+ (setq temp-buffer-show-hook temp-buffer-show-function)))
(make-local-variable 'temp-buffer-show-function)
(setq temp-buffer-show-function 'speedbar-temp-buffer-show-function)
(if speedbar-xemacsp
speedbar-buffer)
(speedbar-frame-mode -1)))))
t t)
+ (toggle-read-only 1)
(speedbar-set-mode-line-format)
- (if (not speedbar-xemacsp)
- (setq auto-show-mode nil)) ;no auto-show for Emacs
+ (if speedbar-xemacsp
+ (progn
+ (make-local-variable 'mouse-motion-handler)
+ (setq mouse-motion-handler 'speedbar-track-mouse-xemacs))
+ (if speedbar-track-mouse-flag
+ (progn
+ (make-local-variable 'track-mouse)
+ (setq track-mouse t))) ;this could be messy.
+ (setq auto-show-mode nil)) ;no auto-show for Emacs
(run-hooks 'speedbar-mode-hook))
(speedbar-update-contents)
speedbar-buffer)
+(defmacro speedbar-with-attached-buffer (&rest forms)
+ "Execute FORMS in the attached frame's special buffer.
+Optionally select that frame if necessary."
+ `(save-selected-window
+ (speedbar-set-timer speedbar-update-speed)
+ (select-frame speedbar-attached-frame)
+ ,@forms
+ (speedbar-maybee-jump-to-attached-frame)))
+
+(defun speedbar-message (fmt &rest args)
+ "Like message, but for use in the speedbar frame.
+Argument FMT is the format string, and ARGS are the arguments for message."
+ (save-selected-window
+ (select-frame speedbar-attached-frame)
+ (apply 'message fmt args)))
+
+(defun speedbar-y-or-n-p (prompt)
+ "Like `y-or-n-p', but for use in the speedbar frame.
+Argument PROMPT is the prompt to use."
+ (save-selected-window
+ (if (and default-minibuffer-frame (not (eq default-minibuffer-frame
+ speedbar-attached-frame)))
+ (select-frame speedbar-attached-frame))
+ (y-or-n-p prompt)))
+
+(defun speedbar-show-info-under-mouse (&optional event)
+ "Call the info function for the line under the mouse.
+Optional EVENT is currently not used."
+ (let ((pos (mouse-position))) ; we ignore event until I use it later.
+ (if (equal (car pos) speedbar-frame)
+ (save-excursion
+ (save-window-excursion
+ (apply 'set-mouse-position pos)
+ (speedbar-item-info))))))
+
(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
(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 ()
+ ;; Fix for using this hook on some platforms: Bob Weiner
+ (cond ((not speedbar-xemacsp)
+ (run-hooks 'temp-buffer-show-hook))
+ ((fboundp 'run-hook-with-args)
+ (run-hook-with-args 'temp-buffer-show-hook buffer))
+ ((and (boundp 'temp-buffer-show-hook)
+ (listp temp-buffer-show-hook))
+ (mapcar (function (lambda (hook) (funcall hook buffer)))
+ temp-buffer-show-hook))))
+
+(defvar speedbar-previous-menu nil
+ "The menu before the last `speedbar-reconfigure-keymaps' was called.")
+
+(defun speedbar-reconfigure-keymaps ()
"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))))
+ (let ((md (append
+ speedbar-easymenu-definition-base
+ (if speedbar-shown-directories
+ ;; file display mode version
+ (speedbar-initial-menu)
+ (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)))
+ ;; Dynamic menu stuff
+ '("-")
+ (list (cons "Displays"
+ (let ((displays nil)
+ (alist speedbar-initial-expansion-mode-alist))
+ (while alist
+ (setq displays
+ (cons
+ (vector
+ (capitalize (car (car alist)))
+ (list
+ 'speedbar-change-initial-expansion-list
+ (car (car alist)))
+ t)
+ displays))
+ (setq alist (cdr alist)))
+ displays)))
+ ;; The trailer
+ speedbar-easymenu-definition-trailer))
+ (localmap (save-excursion
+ (let ((cf (selected-frame)))
+ (prog2
+ (select-frame speedbar-attached-frame)
+ (if (local-variable-p
+ 'speedbar-special-mode-key-map
+ (current-buffer))
+ speedbar-special-mode-key-map)
+ (select-frame cf))))))
+ (save-excursion
+ (set-buffer speedbar-buffer)
+ (use-local-map (or localmap
+ (speedbar-initial-keymap)
+ ;; This creates a small keymap we can glom the
+ ;; menu adjustments into.
+ (speedbar-make-specialized-keymap)))
+ ;; Delete the old menu if applicable.
+ (if speedbar-previous-menu (easy-menu-remove speedbar-previous-menu))
+ (setq speedbar-previous-menu md)
+ ;; Now add the new menu
+ (if (not speedbar-xemacsp)
+ (easy-menu-define speedbar-menu-map (current-local-map)
+ "Speedbar menu" md)
+ (easy-menu-add md (current-local-map))
+ (set-buffer-menubar (list md))))))
\f
;;; User Input stuff
(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)
+ (t (speedbar-message
+ "Click on the edge of the modeline to scroll left/right")))
+ ;;(speedbar-message "X: Pixel %d Char Pixels %d On char %d" xp cpw oc)
))
(defun speedbar-customize ()
(select-frame sf))
(speedbar-maybee-jump-to-attached-frame))
+(defun speedbar-track-mouse (event)
+ "For motion EVENT, display info about the current line."
+ (interactive "e")
+ (if (not speedbar-track-mouse-flag)
+ nil
+ (save-excursion
+ (let ((char (nth 1 (car (cdr event)))))
+ (if (not (numberp char))
+ (speedbar-message nil)
+ (goto-char char)
+ ;; (speedbar-message "%S" event)
+ (speedbar-item-info)
+ )))))
+
+(defun speedbar-track-mouse-xemacs (event)
+ "For motion EVENT, display info about the current line."
+ (if (functionp (default-value 'mouse-motion-handler))
+ (funcall (default-value 'mouse-motion-handler) event))
+ (if speedbar-track-mouse-flag
+ (save-excursion
+ (save-window-excursion
+ (condition-case ()
+ (progn (mouse-set-point event)
+ ;; Prevent focus-related bugs.
+ (if (eq major-mode 'speedbar-mode)
+ (speedbar-item-info)))
+ (error nil))))))
+
;; In XEmacs, we make popup menus work on the item over mouse (as
;; opposed to where the point happens to be.) We attain this by
;; temporarily moving the point to that place.
"Pop up a menu related to the clicked on item.
Must be bound to EVENT."
(interactive "e")
+ (select-frame speedbar-frame)
(save-excursion
(goto-char (event-closest-point event))
(beginning-of-line)
(mouse-major-mode-menu e)
(mouse-major-mode-menu e nil))))
+(defun speedbar-hack-buffer-menu (e)
+ "Control mouse 1 is buffer menu.
+This hack overrides it so that the right thing happens in the main
+Emacs frame, not in the speedbar frame.
+Argument E is the event causing this activity."
+ (interactive "e")
+ (let ((fn (lookup-key global-map (if speedbar-xemacsp
+ '(control button1)
+ [C-down-mouse-1])))
+ (newbuff nil))
+ (unwind-protect
+ (save-excursion
+ (set-window-dedicated-p (selected-window) nil)
+ (call-interactively fn)
+ (setq newbuff (current-buffer)))
+ (switch-to-buffer speedbar-buffer)
+ (set-window-dedicated-p (selected-window) t))
+ (if (not (eq newbuff speedbar-buffer))
+ (speedbar-with-attached-buffer
+ (switch-to-buffer newbuff)))))
+
(defun speedbar-next (arg)
"Move to the next ARGth line in a speedbar buffer."
(interactive "p")
(interactive "p")
(speedbar-next (if arg (- arg) -1)))
+(defun speedbar-restricted-move (arg)
+ "Move to the next ARGth line in a speedbar buffer at the same depth.
+This means that movement is restricted to a subnode, and that siblings
+of intermediate nodes are skipped."
+ (if (not (numberp arg)) (signal 'wrong-type-argument (list arg 'numberp)))
+ ;; First find the extent for which we are allowed to move.
+ (let ((depth (save-excursion (beginning-of-line)
+ (if (looking-at "[0-9]+:")
+ (string-to-int (match-string 0))
+ 0)))
+ (crement (if (< arg 0) 1 -1)) ; decrement or increment
+ (lastmatch (point)))
+ (while (/= arg 0)
+ (forward-line (- crement))
+ (let ((subdepth (save-excursion (beginning-of-line)
+ (if (looking-at "[0-9]+:")
+ (string-to-int (match-string 0))
+ 0))))
+ (cond ((or (< subdepth depth)
+ (progn (end-of-line) (eobp))
+ (progn (beginning-of-line) (bobp)))
+ ;; We have reached the end of this block.
+ (goto-char lastmatch)
+ (setq arg 0)
+ (error "End of sub-list"))
+ ((= subdepth depth)
+ (setq lastmatch (point)
+ arg (+ arg crement))))))
+ (speedbar-position-cursor-on-line)))
+
+(defun speedbar-restricted-next (arg)
+ "Move to the next ARGth line in a speedbar buffer at the same depth.
+This means that movement is restricted to a subnode, and that siblings
+of intermediate nodes are skipped."
+ (interactive "p")
+ (speedbar-restricted-move (or arg 1))
+ (speedbar-item-info))
+
+
+(defun speedbar-restricted-prev (arg)
+ "Move to the previous ARGth line in a speedbar buffer at the same depth.
+This means that movement is restricted to a subnode, and that siblings
+of intermediate nodes are skipped."
+ (interactive "p")
+ (speedbar-restricted-move (if arg (- arg) -1))
+ (speedbar-item-info))
+
+(defun speedbar-navigate-list (arg)
+ "Move across ARG groups of similarly typed items in speedbar.
+Stop on the first line of the next type of item, or on the last or first item
+if we reach a buffer boundary."
+ (interactive "p")
+ (beginning-of-line)
+ (if (looking-at "[0-9]+: *[[<{][-+?][]>}] ")
+ (let ((str (regexp-quote (match-string 0))))
+ (while (looking-at str)
+ (speedbar-restricted-move arg)
+ (beginning-of-line))))
+ (speedbar-position-cursor-on-line))
+
+(defun speedbar-forward-list ()
+ "Move forward over the current list.
+A LIST in speedbar is a group of similarly typed items, such as directories,
+files, or the directory button."
+ (interactive)
+ (speedbar-navigate-list 1)
+ (speedbar-item-info))
+
+(defun speedbar-backward-list ()
+ "Move backward over the current list.
+A LIST in speedbar is a group of similarly typed items, such as directories,
+files, or the directory button."
+ (interactive)
+ (speedbar-navigate-list -1)
+ (speedbar-item-info))
+
(defun speedbar-scroll-up (&optional arg)
"Page down one screen-full of the speedbar, or ARG lines."
(interactive "P")
(defun speedbar-refresh ()
"Refresh the current speedbar display, disposing of any cached data."
(interactive)
- (let ((dl speedbar-shown-directories))
+ (let ((dl speedbar-shown-directories)
+ (dm (and (boundp 'deactivate-mark) deactivate-mark)))
(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")))
+ (setq dl (cdr dl)))
+ (if (<= 1 speedbar-verbosity-level)
+ (speedbar-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)
+ (speedbar-message "Refreshing speedbar...done"))
+ (if (boundp 'deactivate-mark) (setq deactivate-mark dm))))
(defun speedbar-item-load ()
- "Load the item under the cursor or mouse if it is a lisp file."
+ "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)))
+ (speedbar-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..."))))
+ (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."
+ "Byte compile the item under the cursor or mouse if it is a Lisp file."
(interactive)
(let ((f (speedbar-line-file))
(sf (selected-frame)))
(progn
(select-frame speedbar-attached-frame)
(byte-compile-file f nil)
- (select-frame sf)))
+ (select-frame sf)
+ (speedbar-reset-scanners)))
))
(defun speedbar-mouse-item-info (event)
(mouse-set-point event)
(speedbar-item-info))
+(defun speedbar-generic-item-info ()
+ "Attempt to derive, and then display information about thils line item.
+File style information is displayed with `speedbar-item-info'."
+ (save-excursion
+ (beginning-of-line)
+ ;; Skip invisible number info.
+ (if (looking-at "\\([0-9]+\\):") (goto-char (match-end 0)))
+ ;; Skip items in "folder" type text characters.
+ (if (looking-at "\\s-*[[<({].[]>)}] ") (goto-char (match-end 0)))
+ ;; Get the text
+ (speedbar-message "Text: %s" (buffer-substring-no-properties
+ (point) (progn (end-of-line) (point))))))
+
(defun speedbar-item-info ()
- "Display info in the mini-buffer about the button the mouse is over."
+ "Display info in the mini-buffer about the button the mouse is over.
+This function can be replaced in `speedbar-mode-functions-list' as
+`speedbar-item-info'"
(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)
+ (let (message-log-max)
+ (funcall (or (speedbar-fetch-replacement-function 'speedbar-item-info)
+ 'speedbar-generic-item-info))))
+
+(defun speedbar-item-info-file-helper (&optional filename)
+ "Display info about a file that is on the current line.
+nil if not applicable. If FILENAME, then use that instead of reading
+it from the speedbar buffer."
+ (let* ((item (or filename (speedbar-line-file)))
+ (attr (if item (file-attributes item) nil)))
+ (if (and item attr) (speedbar-message "%s %-6d %s" (nth 8 attr)
+ (nth 7 attr) item)
+ nil)))
+
+(defun speedbar-item-info-tag-helper ()
+ "Display info about a tag that is on the current line.
+nil if not applicable."
+ (save-excursion
+ (beginning-of-line)
+ (if (re-search-forward " > \\([^ ]+\\)$"
+ (save-excursion(end-of-line)(point)) t)
+ (let ((tag (match-string 1))
+ (attr (get-text-property (match-beginning 1)
+ 'speedbar-token))
+ (item nil))
(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.")))
- ))))
+ (speedbar-message "Tag: %s in %s @ %s"
+ tag item (if attr
+ (if (markerp attr)
+ (marker-position attr)
+ attr)
+ 0)))
+ (if (re-search-forward "{[+-]} \\([^\n]+\\)$"
+ (save-excursion(end-of-line)(point)) t)
+ (speedbar-message "Group of tags \"%s\"" (match-string 1))
+ nil))))
+
+(defun speedbar-files-item-info ()
+ "Display info in the mini-buffer about the button the mouse is over."
+ (if (not speedbar-shown-directories)
+ (speedbar-generic-item-info)
+ (or (speedbar-item-info-file-helper)
+ (speedbar-item-info-tag-helper)
+ (speedbar-generic-item-info))))
(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 (not f) (error "Not a file"))
(if (file-directory-p f)
- (error "Cannot copy directory.")
+ (error "Cannot copy directory")
(let* ((rt (read-file-name (format "Copy %s to: "
(file-name-nondirectory f))
(file-name-directory f)))
(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)))
+ (speedbar-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 (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)))
+ (speedbar-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.
(speedbar-refresh)
(speedbar-goto-this-file rt)
)))))
- (error "Not a file."))))
+ (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))
+ (if (not f) (error "Not a file"))
+ (if (speedbar-y-or-n-p (format "Delete %s? " f))
(progn
(if (file-directory-p f)
(delete-directory f)
(delete-file f))
- (message "Okie dokie..")
+ (speedbar-message "Okie dokie..")
(let ((p (point)))
(speedbar-refresh)
(goto-char p))
))
))
+(defun speedbar-item-object-delete ()
+ "Delete the object associated from the item under the cursor.
+The file is removed from disk. The object is determined from the
+variable `speedbar-obj-alist'."
+ (interactive)
+ (let* ((f (speedbar-line-file))
+ (obj nil)
+ (oa speedbar-obj-alist))
+ (if (not f) (error "Not a file"))
+ (while (and oa (not (string-match (car (car oa)) f)))
+ (setq oa (cdr oa)))
+ (setq obj (concat (file-name-sans-extension f) (cdr (car oa))))
+ (if (and oa (file-exists-p obj)
+ (speedbar-y-or-n-p (format "Delete %s? " obj)))
+ (progn
+ (delete-file obj)
+ (speedbar-reset-scanners)))))
+
(defun speedbar-enable-update ()
"Enable automatic updating in speedbar via timers."
(interactive)
(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.
+ "Select a window in which BUFFER is shown.
If it is not shown, force it to appear in the default window."
(let ((win (get-buffer-window buffer speedbar-attached-frame)))
(if win
(select-window win)
- (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)
- )))
+ (set-window-buffer (selected-window) buffer))))
(defun speedbar-insert-button (text face mouse function
&optional token prevline)
(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)"
+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 token (put-text-property start end 'speedbar-token token))
)
\f
+;;; Initial Expansion list management
+;;
+(defun speedbar-initial-expansion-list ()
+ "Return the current default expansion list.
+This is based on `speedbar-initial-expansion-list-name' referencing
+`speedbar-initial-expansion-mode-alist'."
+ ;; cdr1 - name, cdr2 - menu
+ (cdr (cdr (cdr (assoc speedbar-initial-expansion-list-name
+ speedbar-initial-expansion-mode-alist)))))
+
+(defun speedbar-initial-menu ()
+ "Return the current default menu data.
+This is based on `speedbar-initial-expansion-list-name' referencing
+`speedbar-initial-expansion-mode-alist'."
+ (symbol-value
+ (car (cdr (assoc speedbar-initial-expansion-list-name
+ speedbar-initial-expansion-mode-alist)))))
+
+(defun speedbar-initial-keymap ()
+ "Return the current default menu data.
+This is based on `speedbar-initial-expansion-list-name' referencing
+`speedbar-initial-expansion-mode-alist'."
+ (symbol-value
+ (car (cdr (cdr (assoc speedbar-initial-expansion-list-name
+ speedbar-initial-expansion-mode-alist))))))
+
+(defun speedbar-initial-stealthy-functions ()
+ "Return a list of functions to call stealthily.
+This is based on `speedbar-initial-expansion-list-name' referencing
+`speedbar-stealthy-function-list'."
+ (cdr (assoc speedbar-initial-expansion-list-name
+ speedbar-stealthy-function-list)))
+
+(defun speedbar-add-expansion-list (new-list)
+ "Add NEW-LIST to the list of expansion lists."
+ (add-to-list 'speedbar-initial-expansion-mode-alist new-list))
+
+(defun speedbar-change-initial-expansion-list (new-default)
+ "Change speedbar's default expansion list to NEW-DEFAULT."
+ (interactive
+ (list
+ (completing-read (format "Speedbar Mode (default %s): "
+ speedbar-previously-used-expansion-list-name)
+ speedbar-initial-expansion-mode-alist
+ nil t "" nil
+ speedbar-previously-used-expansion-list-name)))
+ (setq speedbar-previously-used-expansion-list-name
+ speedbar-initial-expansion-list-name
+ speedbar-initial-expansion-list-name new-default)
+ (speedbar-refresh)
+ (speedbar-reconfigure-keymaps))
+
+(defun speedbar-fetch-replacement-function (function)
+ "Return a current mode specific replacement for function, or nil.
+Scans `speedbar-mode-functions-list' first for the current mode, then
+for FUNCTION."
+ (cdr (assoc function
+ (cdr (assoc speedbar-initial-expansion-list-name
+ speedbar-mode-functions-list)))))
+
+(defun speedbar-add-mode-functions-list (new-list)
+ "Add NEW-LIST to the list of mode functions.
+See `speedbar-mode-functions-list' for details."
+ (add-to-list 'speedbar-mode-functions-list new-list))
+
+\f
+;;; Special speedbar display management
+;;
+(defun speedbar-maybe-add-localized-support (buffer)
+ "Quick check function called on BUFFERs by the speedbar timer function.
+Maintains the value of local variables which control speedbars use
+of the special mode functions."
+ (or speedbar-special-mode-expansion-list
+ (speedbar-add-localized-speedbar-support buffer)))
+
+(defun speedbar-add-localized-speedbar-support (buffer)
+ "Add localized speedbar support to BUFFER's mode if it is available."
+ (interactive "bBuffer: ")
+ (if (stringp buffer) (setq buffer (get-buffer buffer)))
+ (if (not (buffer-live-p buffer))
+ nil
+ (save-excursion
+ (set-buffer buffer)
+ (save-match-data
+ (let ((ms (symbol-name major-mode)) v)
+ (if (not (string-match "-mode$" ms))
+ nil ;; do nothing to broken mode
+ (setq ms (substring ms 0 (match-beginning 0)))
+ (setq v (intern-soft (concat ms "-speedbar-buttons")))
+ (make-local-variable 'speedbar-special-mode-expansion-list)
+ (if (not v)
+ (setq speedbar-special-mode-expansion-list t)
+ ;; If it is autoloaded, we need to load it now so that
+ ;; we have access to the varialbe -speedbar-menu-items.
+ ;; Is this XEmacs safe?
+ (let ((sf (symbol-function v)))
+ (if (and (listp sf) (eq (car sf) 'autoload))
+ (load-library (car (cdr sf)))))
+ (setq speedbar-special-mode-expansion-list (list v))
+ (setq v (intern-soft (concat ms "-speedbar-key-map")))
+ (if (not v)
+ nil ;; don't add special keymap
+ (make-local-variable 'speedbar-special-mode-key-map)
+ (setq speedbar-special-mode-key-map
+ (symbol-value v)))
+ (setq v (intern-soft (concat ms "-speedbar-menu-items")))
+ (if (not v)
+ nil ;; don't add special menus
+ (make-local-variable 'speedbar-easymenu-definition-special)
+ (setq speedbar-easymenu-definition-special
+ (symbol-value v)))
+ )))))))
+
+(defun speedbar-remove-localized-speedbar-support (buffer)
+ "Remove any traces that BUFFER supports speedbar in a specialized way."
+ (save-excursion
+ (set-buffer buffer)
+ (kill-local-variable 'speedbar-special-mode-expansion-list)
+ (kill-local-variable 'speedbar-special-mode-key-map)
+ (kill-local-variable 'speedbar-easymenu-definition-special)))
+\f
;;; File button management
;;
(defun speedbar-file-lists (directory)
(dirs nil)
(files nil))
(while dir
- (if (not (string-match speedbar-file-unshown-regexp (car dir)))
+ (if (not
+ (or (string-match speedbar-file-unshown-regexp (car dir))
+ (string-match speedbar-directory-unshown-regexp (car dir))))
(if (file-directory-p (car dir))
(setq dirs (cons (car dir) dirs))
(setq files (cons (car dir) files))))
'speedbar-directory-face
'speedbar-highlight-face
'speedbar-directory-buttons-follow
- (if (= (match-beginning 1) p)
+ (if (and (= (match-beginning 1) p)
+ (not (char-equal (char-after (+ p 1)) ?:)))
(expand-file-name "~/") ;the tilde
(buffer-substring-no-properties
p (match-end 0)))))
(mf (if exp-button-function 'speedbar-highlight-face nil))
)
(speedbar-make-button start end bf mf exp-button-function exp-button-data)
+ (if speedbar-hide-button-brackets-flag
+ (progn
+ (put-text-property start (1+ start) 'invisible t)
+ (put-text-property end (1- end) 'invisible t)))
)
(insert-char ? 1 nil)
(put-text-property (1- (point)) (point) 'invisible nil)
(speedbar-with-writable
(goto-char (match-beginning 1))
(delete-char 1)
- (insert-char char 1 t)))))
+ (insert-char char 1 t)
+ (put-text-property (point) (1- (point)) 'invisible nil)))))
\f
;;; Build button lists
"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 )"
+cell of the form ( 'DIRLIST . 'FILELIST )"
;; Start inserting all the directories
(let ((dirs (car files)))
(while dirs
(car dirs) 'speedbar-dir-follow nil
'speedbar-directory-face level)
(setq dirs (cdr dirs))))
- (let ((lst (car (cdr files))))
+ (let ((lst (car (cdr files)))
+ (case-fold-search t))
(while lst
(let* ((known (string-match speedbar-file-regexp (car lst)))
(expchar (if known ?+ ??))
(setq sf (cdr sf)))))
)))
+(defun speedbar-apply-one-tag-hierarchy-method (lst method)
+ "Adjust the tag hierarchy LST by METHOD."
+ (cond
+ ((eq method 'sort)
+ (sort (copy-alist lst)
+ (lambda (a b) (string< (car a) (car b)))))
+ ((eq method 'prefix-group)
+ (let ((newlst nil)
+ (sublst nil)
+ (work-list nil)
+ (junk-list nil)
+ (short-group-list nil)
+ (short-start-name nil)
+ (short-end-name nil)
+ (num-shorts-grouped 0)
+ (bins (make-vector 256 nil))
+ (diff-idx 0))
+ ;; Break out sub-lists
+ (while lst
+ (if (listp (cdr-safe (car-safe lst)))
+ (setq newlst (cons (car lst) newlst))
+ (setq sublst (cons (car lst) sublst)))
+ (setq lst (cdr lst)))
+ ;; Reverse newlst because it was made backwards.
+ ;; Sublist doesn't need reversing because the act
+ ;; of binning things will reverse it for us.
+ (setq newlst (nreverse newlst))
+ ;; Now, first find out how long our list is. Never let a
+ ;; list get-shorter than our minimum.
+ (if (<= (length sublst) speedbar-tag-split-minimum-length)
+ (setq work-list (nreverse sublst))
+ (setq diff-idx (length (try-completion "" sublst)))
+ ;; Sort the whole list into bins.
+ (while sublst
+ (let ((e (car sublst))
+ (s (car (car sublst))))
+ (cond ((<= (length s) diff-idx)
+ ;; 0 storage bin for shorty.
+ (aset bins 0 (cons e (aref bins 0))))
+ (t
+ ;; stuff into a bin based on ascii value at diff
+ (aset bins (aref s diff-idx)
+ (cons e (aref bins (aref s diff-idx)))))))
+ (setq sublst (cdr sublst)))
+ ;; Go through all our bins Stick singles into our
+ ;; junk-list, everything else as sublsts in work-list.
+ ;; If two neighboring lists are both small, make a grouped
+ ;; group combinding those two sub-lists.
+ (setq diff-idx 0)
+ (while (> 256 diff-idx)
+ (let ((l (nreverse ;; Reverse the list since they are stuck in
+ ;; backwards.
+ (aref bins diff-idx))))
+ (if l
+ (let ((tmp (cons (try-completion "" l) l)))
+ (if (or (> (length l) speedbar-tag-regroup-maximum-length)
+ (> (+ (length l) (length short-group-list))
+ speedbar-tag-split-minimum-length))
+ (progn
+ ;; We have reached a longer list, so we
+ ;; must finish off a grouped group.
+ (cond
+ ((and short-group-list
+ (= (length short-group-list)
+ num-shorts-grouped))
+ ;; All singles? Junk list
+ (setq junk-list (append short-group-list
+ junk-list)))
+ ((= num-shorts-grouped 1)
+ ;; Only one short group? Just stick it in
+ ;; there by itself. Make a group, and find
+ ;; a subexpression
+ (let ((subexpression (try-completion
+ "" short-group-list)))
+ (if (< (length subexpression)
+ speedbar-tag-group-name-minimum-length)
+ (setq subexpression
+ (concat short-start-name
+ " ("
+ (substring
+ (car (car short-group-list))
+ (length short-start-name))
+ ")")))
+ (setq work-list
+ (cons (cons subexpression
+ short-group-list)
+ work-list))))
+ (short-group-list
+ ;; Multiple groups to be named in a special
+ ;; way by displaying the range over which we
+ ;; have grouped them.
+ (setq work-list
+ (cons (cons (concat short-start-name
+ " to "
+ short-end-name)
+ (nreverse short-group-list))
+ work-list))))
+ ;; Reset short group list information every time.
+ (setq short-group-list nil
+ short-start-name nil
+ short-end-name nil
+ num-shorts-grouped 0)))
+ ;; Ok, now that we cleaned up the short-group-list,
+ ;; we can deal with this new list, to decide if it
+ ;; should go on one of these sub-lists or not.
+ (if (< (length l) speedbar-tag-regroup-maximum-length)
+ (setq short-group-list (append short-group-list l)
+ num-shorts-grouped (1+ num-shorts-grouped)
+ short-end-name (car tmp)
+ short-start-name (if short-start-name
+ short-start-name
+ (car tmp)))
+ (setq work-list (cons tmp work-list))))))
+ (setq diff-idx (1+ diff-idx))))
+ ;; Did we run out of things? Drop our new list onto the end.
+ (cond
+ ((and short-group-list (= (length short-group-list) num-shorts-grouped))
+ ;; All singles? Junk list
+ (setq junk-list (append short-group-list junk-list)))
+ ((= num-shorts-grouped 1)
+ ;; Only one short group? Just stick it in
+ ;; there by itself.
+ (setq work-list
+ (cons (cons (try-completion "" short-group-list)
+ short-group-list)
+ work-list)))
+ (short-group-list
+ ;; Multiple groups to be named in a special
+ ;; way by displaying the range over which we
+ ;; have grouped them.
+ (setq work-list
+ (cons (cons (concat short-start-name " to " short-end-name)
+ short-group-list)
+ work-list))))
+ ;; Reverse the work list nreversed when consing.
+ (setq work-list (nreverse work-list))
+ ;; Now, stick our new list onto the end of
+ (if work-list
+ (if junk-list
+ (append newlst work-list junk-list)
+ (append newlst work-list))
+ (append newlst junk-list))))
+ ((eq method 'trim-words)
+ (let ((newlst nil)
+ (sublst nil)
+ (trim-prefix nil)
+ (trim-chars 0)
+ (trimlst nil))
+ (while lst
+ (if (listp (cdr-safe (car-safe lst)))
+ (setq newlst (cons (car lst) newlst))
+ (setq sublst (cons (car lst) sublst)))
+ (setq lst (cdr lst)))
+ ;; Get the prefix to trim by. Make sure that we don't trim
+ ;; off silly pieces, only complete understandable words.
+ (setq trim-prefix (try-completion "" sublst))
+ (if (or (= (length sublst) 1)
+ (not trim-prefix)
+ (not (string-match "\\(\\w+\\W+\\)+" trim-prefix)))
+ (append (nreverse newlst) (nreverse sublst))
+ (setq trim-prefix (substring trim-prefix (match-beginning 0)
+ (match-end 0)))
+ (setq trim-chars (length trim-prefix))
+ (while sublst
+ (setq trimlst (cons
+ (cons (substring (car (car sublst)) trim-chars)
+ (cdr (car sublst)))
+ trimlst)
+ sublst (cdr sublst)))
+ ;; Put the lists together
+ (append (nreverse newlst) trimlst))))
+ ((eq method 'simple-group)
+ (let ((newlst nil)
+ (sublst nil))
+ (while lst
+ (if (listp (cdr-safe (car-safe lst)))
+ (setq newlst (cons (car lst) newlst))
+ (setq sublst (cons (car lst) sublst)))
+ (setq lst (cdr lst)))
+ (if (not newlst)
+ (nreverse sublst)
+ (setq newlst (cons (cons "Tags" (nreverse sublst)) newlst))
+ (nreverse newlst))))
+ (t lst)))
+
+(defun speedbar-create-tag-hierarchy (lst)
+ "Adjust the tag hierarchy in LST, and return it.
+This uses `speedbar-tag-hierarchy-method' to determine how to adjust
+the list. See it's value for details."
+ (let* ((f (save-excursion
+ (forward-line -1)
+ (speedbar-line-path)))
+ (methods (if (get-file-buffer f)
+ (save-excursion (set-buffer (get-file-buffer f))
+ speedbar-tag-hierarchy-method)
+ speedbar-tag-hierarchy-method)))
+ (while methods
+ (setq lst (speedbar-apply-one-tag-hierarchy-method lst (car methods))
+ methods (cdr methods)))
+ lst))
+
(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
;; Remove imenu rescan button
(if (string= (car (car lst)) "*Rescan*")
(setq lst (cdr lst)))
+ ;; Adjust the list.
+ (setq lst (speedbar-create-tag-hierarchy lst))
;; insert the parts
(while lst
(cond ((null (car-safe lst)) nil) ;this would be a separator
(car (car lst)) ;button name
nil nil 'speedbar-tag-face
(1+ level)))
- (t (message "Ooops!")))
+ (t (speedbar-message "Ooops!")))
(setq lst (cdr lst))))
\f
;;; Timed functions
(interactive)
;; Set the current special buffer
(setq speedbar-desired-buffer nil)
+ ;; Check for special modes
+ (speedbar-maybe-add-localized-support (current-buffer))
+ ;; Choose the correct method of doodling.
(if (and speedbar-mode-specific-contents-flag
+ (listp speedbar-special-mode-expansion-list)
speedbar-special-mode-expansion-list
(local-variable-p
'speedbar-special-mode-expansion-list
"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)
+ (funclst (speedbar-initial-expansion-list))
(cache speedbar-full-text-cache)
;; disable stealth during update
(speedbar-stealthy-function-list nil)
;; 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)
+ (progn
+ (setq cache nil)
+ ;; If the current directory is not the last element in the dir
+ ;; list, then we ALSO need to zap the list of expanded directories
+ (if (/= (length (member cbd speedbar-shown-directories)) 1)
+ (setq speedbar-shown-directories (list cbd))))
;; Build cbd-parent, and see if THAT is in the current shown
;; directories. First, go through pains to get the parent directory
(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 (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)
;; default the shown directories to this list...
(setq speedbar-shown-directories (list cbd)))
))
- (setq speedbar-last-selected-file nil)
+ (if (not expand-local) (setq speedbar-last-selected-file nil))
(speedbar-with-writable
(if (and expand-local
;; Find this directory as a speedbar node.
(funcall (car funclst) cbd 0)
(setq funclst (cdr funclst))))))
(goto-char (point-min)))))
- (speedbar-reconfigure-menubar))
+ (speedbar-reconfigure-keymaps))
(defun speedbar-update-special-contents ()
"Used the mode-specific variable to fill in the speedbar buffer.
(funcall (car funclst) specialbuff)
(setq funclst (cdr funclst))))
(goto-char (point-min))))
- (speedbar-reconfigure-menubar))
+ (speedbar-reconfigure-keymaps))
(defun speedbar-timer-fn ()
- "Run whenever emacs is idle to update the speedbar item."
+ "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)
+ ;; Only do stuff if the frame is visible, not an icon, and if
+ ;; it is currently flagged to do something.
+ (if (and speedbar-update-flag
+ (frame-visible-p speedbar-frame)
+ (not (eq (frame-visible-p speedbar-frame) 'icon)))
(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))
+ (if (window-minibuffer-p (selected-window))
+ nil
+ ;; Check for special modes
+ (speedbar-maybe-add-localized-support (current-buffer))
+ ;; Update for special mode all the time!
+ (if (and speedbar-mode-specific-contents-flag
+ (listp speedbar-special-mode-expansion-list)
+ 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)
+ (speedbar-message
+ "Updating speedbar to special mode: %s..."
+ major-mode))
+ (speedbar-update-special-contents)
+ (if (<= 2 speedbar-verbosity-level)
+ (progn
+ (speedbar-message
+ "Updating speedbar to special mode: %s...done"
+ major-mode)
+ (speedbar-message nil))))
+ ;; 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)
+ (speedbar-message "Updating speedbar to: %s..."
+ default-directory))
+ (speedbar-update-directory-contents)
+ (if (<= 1 speedbar-verbosity-level)
+ (progn
+ (speedbar-message "Updating speedbar to: %s...done"
+ default-directory)
+ (speedbar-message nil)))))
+ (select-frame af)))
;; Now run stealthy updates of time-consuming items
- (speedbar-stealthy-updates)))))
+ (speedbar-stealthy-updates)))
+ ;; Now run the mouse tracking system
+ (speedbar-show-info-under-mouse)))
(run-hooks 'speedbar-timer-hook))
\f
;;; Stealthy activities
;;
+(defvar speedbar-stealthy-update-recurse nil
+ "Recursion avoidance variable for stealthy update.")
+
(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))
- )))
+ (if (not speedbar-stealthy-update-recurse)
+ (let ((l (speedbar-initial-stealthy-functions))
+ (speedbar-stealthy-update-recurse t))
+ (unwind-protect
+ (speedbar-with-writable
+ (while (and l (funcall (car l)))
+ ;;(sit-for 0)
+ (setq l (cdr l))))
+ ;;(speedbar-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)
+ (setq speedbar-vc-to-do-point t
+ speedbar-obj-to-do-point t)
(run-hooks 'speedbar-scanner-reset-hook)
)
+(defun speedbar-find-selected-file (file)
+ "Goto the line where FILE is."
+ (goto-char (point-min))
+ (let ((m nil))
+ (while (and (setq m (re-search-forward
+ (concat " \\(" (file-name-nondirectory file)
+ "\\)\\(" speedbar-indicator-regex "\\)?\n")
+ nil t))
+ (not (string= file
+ (concat
+ (speedbar-line-path
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (beginning-of-line)
+ (save-match-data
+ (looking-at "[0-9]+:")
+ (string-to-number (match-string 0)))))
+ (match-string 1))))))
+ (if m
+ (progn
+ (goto-char (match-beginning 1))
+ (match-string 1)))))
+
(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))
+ (if (speedbar-find-selected-file speedbar-last-selected-file)
(put-text-property (match-beginning 1)
(match-end 1)
'face
nil)))
(select-frame lastf)
rf)))
- (newcf (if newcfd (file-name-nondirectory newcfd)))
+ (newcf (if newcfd newcfd))
(lastb (current-buffer))
- (sucf-recursive (boundp 'sucf-recursive)))
+ (sucf-recursive (boundp 'sucf-recursive))
+ (case-fold-search t))
(if (and newcf
;; check here, that way we won't refresh to newcf until
;; its been written, thus saving ourselves some time
;; 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)
+ (if (speedbar-find-selected-file newcf)
+ ;; 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)
;; yes, it is (we will ignore unknowns for now...)
(progn
(speedbar-refresh)
- (if (re-search-forward
- (concat " \\(" (regexp-quote newcf) "\\)\n") nil t)
+ (if (speedbar-find-selected-file newcf)
;; put the property on it
(put-text-property (match-beginning 1)
(match-end 1)
(setq speedbar-last-selected-file newcf))
(if (not sucf-recursive)
(progn
- (forward-line -1)
- (speedbar-position-cursor-on-line)))
+ (speedbar-center-buffer-smartly)
+ (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.
+(defun speedbar-add-indicator (indicator-string &optional replace-this)
+ "Add INDICATOR-STRING to the end of this speedbar line.
+If INDICATOR-STRING is space, and REPLACE-THIS is a character, then
+an the existing indicator is removed. If there is already an
+indicator, then do not add a space."
+ (beginning-of-line)
+ ;; The nature of the beast: Assume we are in "the right place"
+ (end-of-line)
+ (skip-chars-backward (concat " " speedbar-vc-indicator
+ (car speedbar-obj-indicator)
+ (cdr speedbar-obj-indicator)))
+ (if (and (not (looking-at speedbar-indicator-regex))
+ (not (string= indicator-string " ")))
+ (insert speedbar-indicator-separator))
+ (speedbar-with-writable
+ (save-excursion
+ (if (and replace-this
+ (re-search-forward replace-this (save-excursion (end-of-line)
+ (point))
+ t))
+ (delete-region (match-beginning 0) (match-end 0))))
+ (end-of-line)
+ (if (not (string= " " indicator-string))
+ (insert indicator-string))))
+
+;; Load efs/ange-ftp only if compiling to remove byte-compiler warnings.
;; Steven L Baur <steve@xemacs.org> said this was important:
-(eval-when-compile (or (featurep 'xemacs) (require 'ange-ftp)))
+(eval-when-compile (or (featurep 'xemacs)
+ (condition-case () (require 'efs)
+ (error (require 'ange-ftp)))))
(defun speedbar-check-vc ()
"Scan all files in a directory, and for each see if it's checked out.
(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)))))
+ (not (or (and (featurep 'ange-ftp)
+ (string-match
+ (car (if speedbar-xemacsp
+ ange-ftp-path-format
+ ange-ftp-name-format))
+ (expand-file-name default-directory)))
+ ;; efs support: Bob Weiner
+ (and (featurep 'efs)
+ (string-match
+ (car efs-path-regexp)
+ (expand-file-name default-directory))))))
(setq speedbar-vc-to-do-point 0))
(if (numberp speedbar-vc-to-do-point)
(progn
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))))))
+ (speedbar-add-indicator speedbar-vc-indicator
+ (regexp-quote speedbar-vc-indicator))
+ (speedbar-add-indicator " "
+ (regexp-quote speedbar-vc-indicator))))
(if (input-pending-p)
;; return that we are incomplete
nil
(point))))
(fulln (concat f fn)))
(if (<= 2 speedbar-verbosity-level)
- (message "Speedbar vc check...%s" fulln))
+ (speedbar-message "Speedbar vc check...%s" fulln))
(and (file-writable-p fulln)
(speedbar-this-file-in-vc f fn))))
(or
;; RCS file name
(file-exists-p (concat path "RCS/" name ",v"))
+ (file-exists-p (concat path "RCS/" name))
;; Local SCCS file name
- (file-exists-p (concat path "SCCS/p." name))
+ (file-exists-p (concat path "SCCS/s." name))
;; Remote SCCS file name
(let ((proj-dir (getenv "PROJECTDIR")))
(if proj-dir
- (file-exists-p (concat proj-dir "/SCCS/p." name))
+ (file-exists-p (concat proj-dir "/SCCS/s." name))
nil))
;; User extension
(run-hook-with-args 'speedbar-vc-in-control-hook path name)
))
+
+;; Objet File scanning
+(defun speedbar-check-objects ()
+ "Scan all files in a directory, and for each see if there is an object.
+See `speedbar-check-obj-this-line' and `speedbar-obj-alist' for how
+to add more object types."
+ ;; 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-obj-do-check (eq speedbar-obj-to-do-point t))
+ (setq speedbar-obj-to-do-point 0))
+ (if (numberp speedbar-obj-to-do-point)
+ (progn
+ (goto-char speedbar-obj-to-do-point)
+ (while (and (not (input-pending-p))
+ (re-search-forward "^\\([0-9]+\\):\\s-*\\[[+-]\\] "
+ nil t))
+ (setq speedbar-obj-to-do-point (point))
+ (let ((ind (speedbar-check-obj-this-line (match-string 1))))
+ (if (not ind) (setq ind " "))
+ (speedbar-add-indicator ind (concat
+ (car speedbar-obj-indicator)
+ "\\|"
+ (cdr speedbar-obj-indicator)))))
+ (if (input-pending-p)
+ ;; return that we are incomplete
+ nil
+ ;; we are done, set to-do to nil
+ (setq speedbar-obj-to-do-point nil)
+ ;; and return t
+ t))
+ t)))
+
+(defun speedbar-check-obj-this-line (depth)
+ "Return t if the file on this line has an associated object.
+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)
+ (speedbar-message "Speedbar obj check...%s" fulln))
+ (let ((oa speedbar-obj-alist))
+ (while (and oa (not (string-match (car (car oa)) fulln)))
+ (setq oa (cdr oa)))
+ (if (not (and oa (file-exists-p (concat (file-name-sans-extension fulln)
+ (cdr (car oa))))))
+ nil
+ ;; Find out if the object is out of date or not.
+ (let ((date1 (nth 5 (file-attributes fulln)))
+ (date2 (nth 5 (file-attributes (concat
+ (file-name-sans-extension fulln)
+ (cdr (car oa)))))))
+ (if (or (< (car date1) (car date2))
+ (and (= (car date1) (car date2))
+ (< (nth 1 date1) (nth 1 date2))))
+ (car speedbar-obj-indicator)
+ (cdr speedbar-obj-indicator)))))))
\f
;;; Clicking Activity
;;
((eq (car e) 'mouse-1)
(speedbar-quick-mouse e))
((or (eq (car e) 'double-down-mouse-1)
- (eq (car e) 'tripple-down-mouse-1))
+ (eq (car e) 'triple-down-mouse-1))
(mouse-set-point e)
(speedbar-do-function-pointer)
(speedbar-quick-mouse e))))
(buffer-substring-no-properties
(match-beginning 0) (match-end 0))
"0")))))
- ;;(message "%S:%S:%S:%s" fn tok txt dent)
+ ;;(speedbar-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-text (&optional p)
+ "Retrieve the text after prefix junk for the current line.
+Optional argument P is where to start the search from."
+ (save-excursion
+ (if p (goto-char p))
+ (beginning-of-line)
+ (if (looking-at (concat
+ "\\([0-9]+\\): *[[<{][-+?][]>}] \\([^ \n]+\\)\\("
+ speedbar-indicator-regex "\\)?"))
+ (match-string 2)
+ nil)))
+
+(defun speedbar-line-token (&optional p)
+ "Retrieve the token information after the prefix junk for the current line.
+Optional argument P is where to start the search from."
+ (save-excursion
+ (if p (goto-char p))
+ (beginning-of-line)
+ (if (looking-at (concat
+ "\\([0-9]+\\): *[[<{][-+?][]>}] \\([^ \n]+\\)\\("
+ speedbar-indicator-regex "\\)?"))
+ (progn
+ (goto-char (match-beginning 2))
+ (get-text-property (point) 'speedbar-token))
+ nil)))
+
(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)
- "\\)?"))
+ (save-match-data
+ (let ((f (speedbar-line-text p)))
+ (if f
(let* ((depth (string-to-int (match-string 1)))
- (path (speedbar-line-path depth))
- (f (match-string 2)))
+ (path (speedbar-line-path depth)))
(concat path f))
nil))))
(let ((nd (file-name-nondirectory file)))
(if (re-search-forward
(concat "] \\(" (regexp-quote nd)
- "\\)\\(" (regexp-quote speedbar-vc-indicator) "\\)?$")
+ "\\)\\(" speedbar-indicator-regex "\\)$")
nil t)
(progn
(speedbar-position-cursor-on-line)
(goto-char dest)
nil))))))
-(defun speedbar-line-path (depth)
+(defun speedbar-line-path (&optional depth)
+ "Retrieve the pathname associated with the current line.
+This may require traversing backwards from DEPTH and combining the default
+directory with these items. This function is replaceable in
+`speedbar-mode-functions-list' as `speedbar-line-path'"
+ (let ((rf (speedbar-fetch-replacement-function 'speedbar-line-path)))
+ (if rf (funcall rf depth) default-directory)))
+
+(defun speedbar-files-line-path (&optional 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
+ (if (not depth)
+ (progn
+ (beginning-of-line)
+ (looking-at "^\\([0-9]+\\):")
+ (setq depth (string-to-int (match-string 1)))))
(let ((path nil))
(setq depth (1- depth))
(while (/= depth -1)
(match-beginning 1) (match-end 1))))))
(setq depth (1- depth)))
(if (and path
- (string-match (concat (regexp-quote speedbar-vc-indicator) "$")
+ (string-match (concat speedbar-indicator-regex "$")
path))
(setq path (substring path 0 (match-beginning 0))))
(concat default-directory path)))))
(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))
+ (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) "\\)?$")
+ "\\)\\(" speedbar-indicator-regex "\\)?$")
nil t))
(beginning-of-line)
(looking-at "\\([0-9]+\\):")
(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]"
+ (if (re-search-forward "[]>?}] [^ ]"
(save-excursion (end-of-line) (point))
t)
(speedbar-do-function-pointer)
"/"))
;; Because we leave speedbar as the current buffer,
;; update contents will change directory without
- ;; having to touch the attached frame.
- (speedbar-update-contents)
+ ;; having to touch the attached frame. Turn off smart expand just
+ ;; in case.
+ (let ((speedbar-smart-directory-expand-flag nil))
+ (speedbar-update-contents))
(speedbar-set-timer speedbar-navigating-speed)
(setq speedbar-last-selected-file nil)
(speedbar-stealthy-updates))
(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))))))
+ (let ((start (point)))
+ (while (and (looking-at "^\\([0-9]+\\):")
+ (> (string-to-int (match-string 1)) indent)
+ (not (eobp)))
+ (forward-line 1)
+ (beginning-of-line))
+ (delete-region start (point))))))
(defun speedbar-dired (text token indent)
"Speedbar click handler for directory expand button.
(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))
+ (setq speedbar-shown-directories (nreverse newl)))
(speedbar-change-expand-button-char ?+)
(speedbar-delete-subblock indent)
)
- (t (error "Ooops... not sure what to do.")))
+ (t (error "Ooops... not sure what to do")))
(speedbar-center-buffer-smartly)
(setq speedbar-last-selected-file nil)
(save-excursion (speedbar-stealthy-updates)))
"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)
+ (if (string-match "^[A-z]:$" token)
+ (setq default-directory (concat token (char-to-string directory-sep-char)))
+ (setq default-directory token))
;; Because we leave speedbar as the current buffer,
;; update contents will change directory without
;; having to touch the attached frame.
((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.")))
+ (t (error "Ooops... not sure what to do")))
(speedbar-center-buffer-smartly))
(defun speedbar-tag-find (text token indent)
(speedbar-with-writable
(save-excursion
(end-of-line) (forward-char 1)
- (speedbar-insert-generic-list indent
- token 'speedbar-tag-expand
+ (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.")))
+ (t (error "Ooops... not sure what to do")))
(speedbar-center-buffer-smartly))
\f
;;; Loading files into the attached frame.
(let ((pop-up-frames t)) (select-window (display-buffer buff)))
(select-frame speedbar-attached-frame)
(switch-to-buffer buff))))
- )
+ )
;;; Centering Utility
;;
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)))
+ (1- (window-height (selected-window))))
;; whole buffer fits
(let ((cp (point)))
(goto-char (point-min))
(end-of-line)
(if (re-search-backward exp nil t)
(setq start (point))
- (error "Center error"))
+ (setq start (point-min)))
(save-excursion ;Not sure about this part.
(end-of-line)
(setq p (point))
speedbar-parse-c-or-c++tag)
("^\\.emacs$\\|.\\(el\\|l\\|lsp\\)\\'" .
"def[^i]+\\s-+\\(\\(\\w\\|[-_]\\)+\\)\\s-*\C-?")
+; ("\\.\\([fF]\\|for\\|FOR\\|77\\|90\\)\\'" .
+; speedbar-parse-fortran77-tag)
("\\.tex\\'" . speedbar-parse-tex-string)
("\\.p\\'" .
"\\(\\(FUNCTION\\|function\\|PROCEDURE\\|procedure\\)\\s-+\\([a-zA-Z0-9_.:]+\\)\\)\\s-*(?^?")
(save-excursion
(if (get-buffer "*etags tmp*")
(kill-buffer "*etags tmp*")) ;kill to clean it up
- (if (<= 1 speedbar-verbosity-level) (message "Fetching etags..."))
+ (if (<= 1 speedbar-verbosity-level)
+ (speedbar-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..."))
+ (if (<= 1 speedbar-verbosity-level)
+ (speedbar-message "Fetching etags..."))
(let ((expr
(let ((exprlst speedbar-fetch-etags-parse-list)
(ans nil))
(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"))))
+ (speedbar-message
+ "Sorry, no support for a file of that extension"))))
)
(if speedbar-sort-tags
(sort newlist (lambda (a b) (string< (car a) (car b))))
; (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 )
+ "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)
(t nil)))))
\f
+;;; BUFFER DISPLAY mode.
+;;
+(defvar speedbar-buffers-key-map nil
+ "Keymap used when in the buffers display mode.")
+
+(if speedbar-buffers-key-map
+ nil
+ (setq speedbar-buffers-key-map (speedbar-make-specialized-keymap))
+
+ ;; Basic tree features
+ (define-key speedbar-buffers-key-map "e" 'speedbar-edit-line)
+ (define-key speedbar-buffers-key-map "\C-m" 'speedbar-edit-line)
+ (define-key speedbar-buffers-key-map "+" 'speedbar-expand-line)
+ (define-key speedbar-buffers-key-map "-" 'speedbar-contract-line)
+
+ ;; Buffer specific keybindings
+ (define-key speedbar-buffers-key-map "k" 'speedbar-buffer-kill-buffer)
+ (define-key speedbar-buffers-key-map "r" 'speedbar-buffer-revert-buffer)
+
+ )
+
+(defvar speedbar-buffer-easymenu-definition
+ '(["Jump to buffer" speedbar-edit-line t]
+ ["Expand File Tags" speedbar-expand-line
+ (save-excursion (beginning-of-line)
+ (looking-at "[0-9]+: *.\\+. "))]
+ ["Contract File Tags" speedbar-contract-line
+ (save-excursion (beginning-of-line)
+ (looking-at "[0-9]+: *.-. "))]
+ )
+ "Menu item elements shown when displaying a buffer list.")
+
+(defun speedbar-buffer-buttons (directory zero)
+ "Create speedbar buttons based on the buffers currently loaded.
+DIRECTORY is the path to the currently active buffer, and ZERO is 0."
+ (speedbar-buffer-buttons-engine nil))
+
+(defun speedbar-buffer-buttons-temp (directory zero)
+ "Create speedbar buttons based on the buffers currently loaded.
+DIRECTORY is the path to the currently active buffer, and ZERO is 0."
+ (speedbar-buffer-buttons-engine t))
+
+(defun speedbar-buffer-buttons-engine (temp)
+ "Create speedbar buffer buttons.
+If TEMP is non-nil, then clicking on a buffer restores the previous display."
+ (insert "Active Buffers:\n")
+ (let ((bl (buffer-list)))
+ (while bl
+ (if (string-match "^[ *]" (buffer-name (car bl)))
+ nil
+ (let* ((known (string-match speedbar-file-regexp
+ (buffer-name (car bl))))
+ (expchar (if known ?+ ??))
+ (fn (if known 'speedbar-tag-file nil))
+ (fname (save-excursion (set-buffer (car bl))
+ (buffer-file-name))))
+ (speedbar-make-tag-line 'bracket expchar fn fname
+ (buffer-name (car bl))
+ 'speedbar-buffer-click temp
+ 'speedbar-file-face 0)))
+ (setq bl (cdr bl)))
+ (setq bl (buffer-list))
+ (insert "Scratch Buffers:\n")
+ (while bl
+ (if (not (string-match "^\\*" (buffer-name (car bl))))
+ nil
+ (if (eq (car bl) speedbar-buffer)
+ nil
+ (speedbar-make-tag-line 'bracket ?? nil nil
+ (buffer-name (car bl))
+ 'speedbar-buffer-click temp
+ 'speedbar-file-face 0)))
+ (setq bl (cdr bl)))
+ (setq bl (buffer-list))
+ (insert "Hidden Buffers:\n")
+ (while bl
+ (if (not (string-match "^ " (buffer-name (car bl))))
+ nil
+ (if (eq (car bl) speedbar-buffer)
+ nil
+ (speedbar-make-tag-line 'bracket ?? nil nil
+ (buffer-name (car bl))
+ 'speedbar-buffer-click temp
+ 'speedbar-file-face 0)))
+ (setq bl (cdr bl)))))
+
+(defun speedbar-buffers-item-info ()
+ "Display information about the current buffer on the current line."
+ (or (speedbar-item-info-tag-helper)
+ (let* ((item (speedbar-line-text))
+ (buffer (if item (get-buffer item) nil)))
+ (and buffer
+ (speedbar-message "%s%s %S %d %s"
+ (if (buffer-modified-p buffer) "* " "")
+ item
+ (save-excursion (set-buffer buffer) major-mode)
+ (save-excursion (set-buffer buffer)
+ (buffer-size))
+ (or (buffer-file-name buffer) "<No file>"))))))
+
+(defun speedbar-buffers-line-path (&optional depth)
+ "Fetch the full path to the file (buffer) specified on the current line.
+Optional argument DEPTH specifies the current depth of the back search."
+ (end-of-line)
+ ;; Buffers are always at level 0
+ (if (not (re-search-backward "^0:" nil t))
+ nil
+ (let* ((bn (speedbar-line-text))
+ (buffer (if bn (get-buffer bn))))
+ (if buffer (file-name-directory (buffer-file-name buffer))))))
+
+(defun speedbar-buffer-click (text token indent)
+ "When the users clicks on a buffer-button in speedbar.
+TEXT is the buffer's name, TOKEN and INDENT are unused."
+ (if speedbar-power-click
+ (let ((pop-up-frames t)) (select-window (display-buffer text)))
+ (select-frame speedbar-attached-frame)
+ (switch-to-buffer text)
+ (if token (speedbar-change-initial-expansion-list
+ speedbar-previously-used-expansion-list-name))))
+
+(defun speedbar-buffer-kill-buffer ()
+ "Kill the buffer the cursor is on in the speedbar buffer."
+ (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 "[]>?}] [^ ]"
+ (save-excursion (end-of-line) (point))
+ t)
+ (let ((text (progn
+ (forward-char -1)
+ (buffer-substring (point) (save-excursion
+ (end-of-line)
+ (point))))))
+ (if (and (get-buffer text)
+ (speedbar-y-or-n-p (format "Kill buffer %s? " text)))
+ (kill-buffer text))
+ (speedbar-refresh))))))
+
+(defun speedbar-buffer-revert-buffer ()
+ "Revert the buffer the cursor is on in the speedbar buffer."
+ (interactive)
+ (save-excursion
+ (beginning-of-line)
+ ;; If this fails, then it is a non-standard click, and as such,
+ ;; perfectly allowed
+ (if (re-search-forward "[]>?}] [^ ]"
+ (save-excursion (end-of-line) (point))
+ t)
+ (let ((text (progn
+ (forward-char -1)
+ (buffer-substring (point) (save-excursion
+ (end-of-line)
+ (point))))))
+ (if (get-buffer text)
+ (progn
+ (set-buffer text)
+ (revert-buffer t)))))))
+
+
+\f
;;; Color loading section This is messy *Blech!*
;;
(defface speedbar-button-face '((((class color) (background light))
HCoop / bpt / emacs.git / blobdiff