;;; speedbar --- quick access to files and tags in a frame
-;;; Copyright (C) 1996, 97, 98, 99, 00, 01, 02, 03, 04, 05 Free Software Foundation
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: file, tags, tools
"The current version of speedbar.")
(defvar speedbar-incompatible-version "0.14beta4"
"This version of speedbar is incompatible with this version.
-Due to massive API changes (removing the use of the word PATH)
+Due to massive API changes (removing the use of the word PATH)
this version is not backward compatible to 0.14 or earlier.")
;; 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)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; http://www.dina.kvl.dk/~abraham/custom/
;; custom is available in all versions of Emacs version 20 or better.
;;
+;;; Developing for speedbar
+;;
+;; Adding a speedbar specialized display mode:
+;;
+;; Speedbar can be configured to create a special display for certain
+;; modes that do not display traditional file/tag data. Rmail, Info,
+;; and the debugger are examples. These modes can, however, benefit
+;; from a speedbar style display in their own way.
+;;
+;; If your `major-mode' is `foo-mode', the only requirement is to
+;; create a function called `foo-speedbar-buttons' which takes one
+;; argument, BUFFER. BUFFER will be the buffer speedbar wants filled.
+;; In `foo-speedbar-buttons' there are several functions that make
+;; building a speedbar display easy. See the documentation for
+;; `speedbar-with-writable' (needed because the buffer is usually
+;; read-only) `speedbar-make-tag-line', `speedbar-insert-button', and
+;; `speedbar-insert-generic-list'. If you use
+;; `speedbar-insert-generic-list', also read the doc for
+;; `speedbar-tag-hierarchy-method' in case you wish to override it.
+;; The macro `speedbar-with-attached-buffer' brings you back to the
+;; buffer speedbar is displaying for.
+;;
+;; For those functions that make buttons, the "function" should be a
+;; symbol that is the function to call when clicked on. The "token"
+;; is extra data you can pass along. The "function" must take three
+;; parameters. They are (TEXT TOKEN INDENT). TEXT is the text of the
+;; button clicked on. TOKEN is the data passed in when you create the
+;; button. INDENT is an indentation level, or 0. You can store
+;; indentation levels with `speedbar-make-tag-line' which creates a
+;; line with an expander (eg. [+]) and a text button.
+;;
+;; Some useful functions when writing expand functions, and click
+;; functions are `speedbar-change-expand-button-char',
+;; `speedbar-delete-subblock', and `speedbar-center-buffer-smartly'.
+;; The variable `speedbar-power-click' is set to t in your functions
+;; when the user shift-clicks. This is an indication of anything from
+;; refreshing cached data to making a buffer appear in a new frame.
+;;
+;; If you wish to add to the default speedbar menu for the case of
+;; `foo-mode', create a variable `foo-speedbar-menu-items'. This
+;; should be a list compatible with the `easymenu' package. It will
+;; be spliced into the main menu. (Available with click-mouse-3). If
+;; you wish to have extra key bindings in your special mode, create a
+;; variable `foo-speedbar-key-map'. Instead of using `make-keymap',
+;; or `make-sparse-keymap', use the function
+;; `speedbar-make-specialized-keymap'. This lets you inherit all of
+;; speedbar's default bindings with low overhead.
+;;
+;; Adding a speedbar top-level display mode:
+;;
+;; Unlike the specialized modes, there are no name requirements,
+;; however the methods for writing a button display, menu, and keymap
+;; are the same. Once you create these items, you can call the
+;; function `speedbar-add-expansion-list'. It takes one parameter
+;; which is a list element of the form (NAME MENU KEYMAP &rest
+;; BUTTON-FUNCTIONS). NAME is a string that will show up in the
+;; Displays menu item. MENU is a symbol containing the menu items to
+;; splice in. KEYMAP is a symbol holding the keymap to use, and
+;; BUTTON-FUNCTIONS are the function names to call, in order, to create
+;; the display.
+;; Another tweakable variable is `speedbar-stealthy-function-list'
+;; which is of the form (NAME &rest FUNCTION ...). NAME is the string
+;; name matching `speedbar-add-expansion-list'. (It does not need to
+;; exist.). This provides additional display info which might be
+;; time-consuming to calculate.
+;; Lastly, `speedbar-mode-functions-list' allows you to set special
+;; function overrides.
;;; TODO:
;; - Timeout directories we haven't visited in a while.
(defcustom speedbar-show-unknown-files nil
"*Non-nil show files we can't expand with a ? in the expand button.
-nil means don't show the file in the list."
+A nil value means don't show the file in the list."
:group 'speedbar
:type 'boolean)
:type 'hook)
(defcustom speedbar-after-create-hook '(speedbar-frame-reposition-smartly)
- "*Hooks called before popping up the speedbar frame."
+ "*Hooks called after popping up the speedbar frame."
:group 'speedbar
:type 'hook)
(defun speedbar-make-specialized-keymap ()
"Create a keymap for use with a speedbar major or minor display mode.
-This basically creates a sparse keymap, and makes it's parent be
+This basically creates a sparse keymap, and makes its parent be
`speedbar-key-map'."
(let ((k (make-sparse-keymap)))
(set-keymap-parent k speedbar-key-map)
(looking-at "[0-9]+: *\\[[+-]\\] [^ \n]+ \\*?[!#]$"))]
)
"Additional menu items while in file-mode.")
-
+
(defvar speedbar-easymenu-definition-trailer
(append
(if (and (featurep 'custom) (fboundp 'custom-declare-variable))
(list ["Customize..." speedbar-customize t]))
(list
- ["Detach" speedbar-detach (and speedbar-frame
- (eq (selected-frame) speedbar-frame)) ]
["Close" dframe-close-frame t]
["Quit" delete-frame t] ))
"Menu items appearing at the end of the speedbar menu.")
(defalias 'speedbar-make-overlay
(if (featurep 'xemacs) 'make-extent 'make-overlay))
-(defalias 'speedbar-overlay-put
+(defalias 'speedbar-overlay-put
(if (featurep 'xemacs) 'set-extent-property 'overlay-put))
-(defalias 'speedbar-delete-overlay
+(defalias 'speedbar-delete-overlay
(if (featurep 'xemacs) 'delete-extent 'delete-overlay))
-(defalias 'speedbar-mode-line-update
+(defalias 'speedbar-mode-line-update
(if (featurep 'xemacs) 'redraw-modeline 'force-mode-line-update))
\f
;;; Mode definitions/ user commands
;;;###autoload
(defun speedbar-frame-mode (&optional arg)
"Enable or disable speedbar. Positive ARG means turn on, negative turn off.
-nil means toggle. Once the speedbar frame is activated, a buffer in
+A nil ARG means toggle. Once the speedbar frame is activated, a buffer in
`speedbar-mode' will be displayed. Currently, only one speedbar is
supported at a time.
`speedbar-before-popup-hook' is called before popping up the speedbar frame.
'speedbar-buffer
"Speedbar"
#'speedbar-frame-mode
- (if dframe-xemacsp
+ (if (featurep 'xemacs)
(append speedbar-frame-plist
;; This is a hack to get speedbar to iconfiy
;; with the selected frame.
(defun speedbar-frame-reposition-smartly ()
"Reposition the speedbar frame to be next to the attached frame."
- (cond ((and dframe-xemacsp
+ (cond ((and (featurep 'xemacs)
(or (member 'left speedbar-frame-plist)
(member 'top speedbar-frame-plist)))
(dframe-reposition-frame
(cons (car (cdr (member 'left speedbar-frame-plist)))
(car (cdr (member 'top speedbar-frame-plist)))))
)
- ((and (not dframe-xemacsp)
+ ((and (not (featurep 'xemacs))
(or (assoc 'left speedbar-frame-parameters)
(assoc 'top speedbar-frame-parameters)))
;; if left/top were specified in the parameters, pass them
(dframe-attached-frame speedbar-frame)
speedbar-default-position))))
-(defun speedbar-detach ()
- "Detach the current Speedbar from auto-updating.
-Doing this allows the creation of a second speedbar."
- (interactive)
- (let ((buffer speedbar-buffer))
- (dframe-detach 'speedbar-frame 'speedbar-cached-frame 'speedbar-buffer)
- (save-excursion
- (set-buffer buffer)
- ;; Permanently disable auto-updating in this speedbar buffer.
- (set (make-local-variable 'speedbar-update-flag) nil)
- (set (make-local-variable 'speedbar-update-flag-disable) t)
- ;; Make local copies of all the different variables to prevent
- ;; funny stuff later...
- )))
-
(defsubst speedbar-current-frame ()
"Return the frame to use for speedbar based on current context."
(dframe-current-frame 'speedbar-frame 'speedbar-mode))
"Handle a delete frame event E.
If the deleted frame is the frame SPEEDBAR is attached to,
we need to delete speedbar also."
- (let ((frame-to-be-deleted (car (car (cdr e)))))
- (if (eq frame-to-be-deleted dframe-attached-frame)
- (delete-frame speedbar-frame)))
- )
+ (when (and speedbar-frame
+ (eq (car (car (cdr e))) ;; frame to be deleted
+ dframe-attached-frame))
+ (delete-frame speedbar-frame)))
;;;###autoload
(defun speedbar-get-focus ()
(lambda () (let ((speedbar-update-flag t))
(speedbar-timer-fn)))))
-(defmacro speedbar-frame-width ()
+(defsubst speedbar-frame-width ()
"Return the width of the speedbar frame in characters.
-nil if it doesn't exist."
- '(window-width (get-buffer-window speedbar-buffer)))
+Return nil if it doesn't exist."
+ (frame-width speedbar-frame))
(defun speedbar-mode ()
"Major mode for managing a display of directories and tags.
;; Backwards compatibility
(defalias 'speedbar-with-attached-buffer 'dframe-with-attached-buffer)
(defalias 'speedbar-maybee-jump-to-attached-frame 'dframe-maybee-jump-to-attached-frame)
-
+
(defun speedbar-set-mode-line-format ()
"Set the format of the mode line based on the current speedbar environment.
This gives visual indications of what is up. It EXPECTS the speedbar
frame and window to be the currently active frame and window."
(if (and (frame-live-p (speedbar-current-frame))
- (or (not dframe-xemacsp)
+ (or (not (featurep 'xemacs))
(with-no-warnings
(specifier-instance has-modeline-p)))
speedbar-buffer)
(speedbar-initial-menu)
(save-excursion
(dframe-select-attached-frame speedbar-frame)
- (if (local-variable-p
- 'speedbar-easymenu-definition-special
- (current-buffer))
- ;; If bound locally, we can use it
- speedbar-easymenu-definition-special)))
+ (eval (nth 1 (assoc speedbar-initial-expansion-list-name
+ speedbar-initial-expansion-mode-alist)))))
;; Dynamic menu stuff
'("-")
(list (cons "Displays"
(if speedbar-previous-menu (easy-menu-remove speedbar-previous-menu))
(setq speedbar-previous-menu md)
;; Now add the new menu
- (if (not dframe-xemacsp)
+ (if (not (featurep 'xemacs))
(easy-menu-define speedbar-menu-map (current-local-map)
"Speedbar menu" md)
(easy-menu-add md (current-local-map))
(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."
+Return 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)
(defun speedbar-item-info-tag-helper ()
"Display info about a tag that is on the current line.
-nil if not applicable."
+Return nil if not applicable."
(save-excursion
(beginning-of-line)
(if (re-search-forward " [-+=]?> \\([^\n]+\\)"
(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). If FACE
+is t use the text properties of the string that is passed as an
+argument."
+ (unless (eq face t)
+ (put-text-property start end 'face face))
(add-text-properties
- start end `(face ,face mouse-face ,mouse invisible nil
+ start end `(mouse-face ,mouse invisible nil
speedbar-text ,(buffer-substring-no-properties start end)))
(if speedbar-use-tool-tips-flag
(put-text-property start end 'help-echo #'dframe-help-echo))
(if tag-button-function 'speedbar-highlight-face nil)
tag-button-function tag-button-data))
))
-
+
(defun speedbar-change-expand-button-char (char)
"Change the expansion button character to CHAR for the current line."
(save-excursion
(defun speedbar-default-directory-list (directory index)
"Insert files for DIRECTORY with level INDEX at point."
- (speedbar-insert-files-at-point
+ (speedbar-insert-files-at-point
(speedbar-file-lists directory) index)
(speedbar-reset-scanners)
(if (= index 0)
))))
(defun speedbar-generic-list-tag-p (sublst)
- "Non nil if SUBLST is a tag."
+ "Non-nil if SUBLST is a tag."
(and (stringp (car-safe sublst))
(or (and (number-or-marker-p (cdr-safe sublst))
(not (cdr-safe (cdr-safe sublst))))
"A wrapper for `try-completion'.
Passes STRING and ALIST to `try-completion' if ALIST
passes some tests."
- (if (and (listp alist) (not (null alist))
+ (if (and (consp alist)
(listp (car alist)) (stringp (car (car alist))))
(try-completion string alist)
nil))
(speedbar-insert-generic-list indent lst
'speedbar-tag-expand
'speedbar-tag-find))
-
+
(defun speedbar-insert-etags-list (indent lst)
"At level INDENT, insert the etags generated LST."
(speedbar-insert-generic-list indent lst
;; Choose the correct method of doodling.
(if (and speedbar-mode-specific-contents-flag
- (listp speedbar-special-mode-expansion-list)
- speedbar-special-mode-expansion-list
+ (consp speedbar-special-mode-expansion-list)
(local-variable-p
'speedbar-special-mode-expansion-list
(current-buffer)))
default-directory)
(speedbar-message nil))))
;; Else, we can do a short cut. No text cache.
- (let ((cbd (expand-file-name default-directory))
- )
+ (let ((cbd (expand-file-name default-directory)))
(set-buffer speedbar-buffer)
(speedbar-with-writable
- (erase-buffer)
- (dolist (func funclst)
- (setq default-directory cbd)
- (funcall func cbd 0))
- (speedbar-reconfigure-keymaps)
- (goto-char (point-min)))
- ))))
+ (let* ((window (get-buffer-window speedbar-buffer 0))
+ (p (window-point window))
+ (start (window-start window)))
+ (erase-buffer)
+ (dolist (func funclst)
+ (setq default-directory cbd)
+ (funcall func cbd 0))
+ (speedbar-reconfigure-keymaps)
+ (set-window-point window p)
+ (set-window-start window start)))))))
(defun speedbar-update-directory-contents ()
"Update the contents of the speedbar buffer based on the current directory."
-
- (save-excursion
-
(let ((cbd (expand-file-name default-directory))
cbd-parent
(funclst (speedbar-initial-expansion-list))
(speedbar-directory-line cbd))
;; Open it.
(speedbar-expand-line)
- (erase-buffer)
- (cond (use-cache
- (setq default-directory
- (nth (1- (length speedbar-shown-directories))
- speedbar-shown-directories))
- (insert (cdr cache)))
- (t
- (dolist (func funclst)
- (setq default-directory cbd)
- (funcall func cbd 0)))))
- (goto-char (point-min)))))
+ (let* ((window (get-buffer-window speedbar-buffer 0))
+ (p (window-point window))
+ (start (window-start window)))
+ (erase-buffer)
+ (cond (use-cache
+ (setq default-directory
+ (nth (1- (length speedbar-shown-directories))
+ speedbar-shown-directories))
+ (insert (cdr cache)))
+ (t
+ (dolist (func funclst)
+ (setq default-directory cbd)
+ (funcall func cbd 0))))
+ (set-window-point window p)
+ (set-window-start window start)))))
(speedbar-reconfigure-keymaps))
(defun speedbar-update-special-contents ()
(dolist (func funclst)
;; We do not erase the buffer because these functions may
;; decide NOT to update themselves.
- (funcall func specialbuff)))
-
- (goto-char (point-min))))
+ (funcall func specialbuff)))))
(speedbar-reconfigure-keymaps))
(defun speedbar-set-timer (timeout)
(frame-visible-p (speedbar-current-frame))
(not (eq (frame-visible-p (speedbar-current-frame)) 'icon)))
(let ((af (selected-frame)))
- (save-window-excursion
(dframe-select-attached-frame speedbar-frame)
;; make sure we at least choose a window to
;; get a good directory from
(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
+ (consp speedbar-special-mode-expansion-list)
(local-variable-p
'speedbar-special-mode-expansion-list
(current-buffer)))
"Updating speedbar to special mode: %s...done"
major-mode)
(speedbar-message nil))))
- ;; Update all the contents if directories change!
- (if (or (member major-mode speedbar-ignored-modes)
- (eq af (speedbar-current-frame))
- (not (buffer-file-name)))
- nil
- (speedbar-update-localized-contents)
- ))
- (select-frame af)))
+
+ ;; Update all the contents if directories change!
+ (unless (and (or (member major-mode speedbar-ignored-modes)
+ (eq af (speedbar-current-frame))
+ (not (buffer-file-name)))
+ ;; Always update for GUD.
+ (not (string-equal "GUD"
+ speedbar-initial-expansion-list-name)))
+ (speedbar-update-localized-contents)))
+ (select-frame af))
;; Now run stealthy updates of time-consuming items
(speedbar-stealthy-updates)))))
(run-hooks 'speedbar-timer-hook))
"Go to the line where FILE is."
(set-buffer speedbar-buffer)
-
+
(goto-char (point-min))
(let ((m nil))
(while (and (setq m (re-search-forward
(not (or (and (featurep 'ange-ftp)
(string-match
(car (symbol-value
- (if dframe-xemacsp
+ (if (featurep 'xemacs)
'ange-ftp-directory-format
'ange-ftp-name-format)))
(expand-file-name default-directory)))
(widen)
(let ((rf (speedbar-fetch-replacement-function 'speedbar-line-directory)))
(if rf (funcall rf depth) default-directory))))
-
+
(defun speedbar-files-line-directory (&optional depth)
"Retrieve the directoryname associated with the current line.
This may require traversing backwards from DEPTH and combining the default
(forward-char -2)
(speedbar-do-function-pointer))
(error (speedbar-position-cursor-on-line)))))
-
+
(defun speedbar-flush-expand-line ()
"Expand the line under the cursor and flush any cached information."
(interactive)
(speedbar-expand-line 1))
-
+
(defun speedbar-contract-line ()
"Contract the line under the cursor."
(interactive)
interested in."
(save-selected-window
-
+
(select-window (get-buffer-window speedbar-buffer t))
-
+
(set-buffer speedbar-buffer)
-
+
(if (<= (count-lines (point-min) (point-max))
(1- (window-height (selected-window))))
;; whole buffer fits