;;; speedbar --- quick access to files and tags in a frame
-;;; Copyright (C) 1996, 97, 98 Free Software Foundation
+;;; Copyright (C) 1996, 97, 98, 99 Free Software Foundation
;; Author: Eric M. Ludlam <zappo@gnu.org>
-;; Version: 0.7.3
+;; Version: 0.8.1
;; Keywords: file, tags, tools
-;; X-RCS: $Id: speedbar.el,v 1.17 1998/10/04 13:00:45 zappo Exp zappo $
+;; X-RCS: $Id: speedbar.el,v 1.21 1999/02/16 00:33:44 rms Exp kwzh $
;; This file is part of GNU Emacs.
;; 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
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
"Additional menu items while in file-mode.")
(defvar speedbar-easymenu-definition-trailer
- (list
+ (append
(if (and (featurep 'custom) (fboundp 'custom-declare-variable))
- ["Customize..." speedbar-customize t])
- ["Close" speedbar-close-frame t]
- ["Quit" delete-frame t] )
+ (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
(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."
(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 ()
(save-excursion
(let ((char (nth 1 (car (cdr event)))))
(if (not (numberp char))
- (message nil)
+ (speedbar-message nil)
(goto-char char)
- ;; (message "%S" event)
+ ;; (speedbar-message "%S" event)
(speedbar-item-info)
)))))
(adelete 'speedbar-directory-contents-alist (car dl))
(setq dl (cdr dl)))
(if (<= 1 speedbar-verbosity-level)
- (message "Refreshing speedbar..."))
+ (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)
- (message "Refreshing speedbar...done"))
+ (speedbar-message "Refreshing speedbar...done"))
(if (boundp 'deactivate-mark) (setq deactivate-mark dm))))
(defun speedbar-item-load ()
(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))
;; Skip items in "folder" type text characters.
(if (looking-at "\\s-*[[<({].[]>)}] ") (goto-char (match-end 0)))
;; Get the text
- (message "Text: %s" (buffer-substring-no-properties
- (point) (progn (end-of-line) (point))))))
+ (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)
+ (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))))
+ (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)
- (let* ((item (speedbar-line-file))
- (attr (if item (file-attributes item) nil)))
- (if (and item attr) (message "%s %-6d %s" (nth 8 attr) (nth 7 attr) item)
- (save-excursion
- (beginning-of-line)
- (if (not (looking-at "\\([0-9]+\\):"))
- (speedbar-generic-item-info)
- (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 @ %s"
- (match-string 1) item
- (if attr
- (if (markerp attr) (marker-position attr) attr)
- 0)))
- (if (re-search-forward "{[+-]} \\([^\n]+\\)$"
- (save-excursion(end-of-line)(point)) t)
- (message "Group of tags \"%s\"" (match-string 1))
- (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.
(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.
(interactive)
(let ((f (speedbar-line-file)))
(if (not f) (error "Not a file"))
- (if (y-or-n-p (format "Delete %s? " f))
+ (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))
(setq oa (cdr oa)))
(setq obj (concat (file-name-sans-extension f) (cdr (car oa))))
(if (and oa (file-exists-p obj)
- (y-or-n-p (format "Delete %s? " obj)))
+ (speedbar-y-or-n-p (format "Delete %s? " obj)))
(progn
(delete-file obj)
(speedbar-reset-scanners)))))
(select-window win)
(set-window-buffer (selected-window) buffer))))
-(defmacro speedbar-with-attached-buffer (&rest forms)
- "Execute FORMS in the attached frame's special buffer.
-Optionally select that frame if necessary."
- ;; Reset the timer with a new timeout when cliking a file
- ;; in case the user was navigating directories, we can cancel
- ;; that other timer.
- (list
- 'progn
- '(speedbar-set-timer speedbar-update-speed)
- (list
- 'let '((cf (selected-frame)))
- '(select-frame speedbar-attached-frame)
- '(speedbar-select-window speedbar-desired-buffer)
- (cons 'progn forms)
- '(select-frame cf)
- '(speedbar-maybee-jump-to-attached-frame)
- )))
-
(defun speedbar-insert-button (text face mouse function
&optional token prevline)
"Insert TEXT as the next logical speedbar button.
(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
;;
(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
;;(eq (get major-mode 'mode-class 'special)))
(progn
(if (<= 2 speedbar-verbosity-level)
- (message "Updating speedbar to special mode: %s..."
- major-mode))
+ (speedbar-message
+ "Updating speedbar to special mode: %s..."
+ major-mode))
(speedbar-update-special-contents)
(if (<= 2 speedbar-verbosity-level)
(progn
- (message "Updating speedbar to special mode: %s...done"
- major-mode)
- (message nil))))
+ (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)
(not (buffer-file-name)))
nil
(if (<= 1 speedbar-verbosity-level)
- (message "Updating speedbar to: %s..."
+ (speedbar-message "Updating speedbar to: %s..."
default-directory))
(speedbar-update-directory-contents)
(if (<= 1 speedbar-verbosity-level)
(progn
- (message "Updating speedbar to: %s...done"
+ (speedbar-message "Updating speedbar to: %s...done"
default-directory)
- (message nil)))))
+ (speedbar-message nil)))))
(select-frame af)))
;; Now run stealthy updates of time-consuming items
(speedbar-stealthy-updates)))
(while (and l (funcall (car l)))
;;(sit-for 0)
(setq l (cdr l))))
- ;;(message "Exit with %S" (car l))
+ ;;(speedbar-message "Exit with %S" (car l))
))))
(defun speedbar-reset-scanners ()
(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))))
(point))))
(fulln (concat f fn)))
(if (<= 2 speedbar-verbosity-level)
- (message "Speedbar obj check...%s" fulln))
+ (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)))
(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]+\\)\\("
- speedbar-indicator-regex "\\)?"))
+ (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))))
(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."
- (cond
- ((string= speedbar-initial-expansion-list-name "files")
- (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)
- (if (not (re-search-backward (format "^%d:" depth) nil t))
- (error "Error building path of tag")
- (cond ((looking-at "[0-9]+:\\s-*<->\\s-+\\([^\n]+\\)$")
- (setq path (concat (buffer-substring-no-properties
- (match-beginning 1) (match-end 1))
- "/"
- path)))
- ((looking-at "[0-9]+:\\s-*[-]\\s-+\\([^\n]+\\)$")
- ;; This is the start of our path.
- (setq path (buffer-substring-no-properties
- (match-beginning 1) (match-end 1))))))
- (setq depth (1- depth)))
- (if (and path
- (string-match (concat speedbar-indicator-regex "$")
- path))
- (setq path (substring path 0 (match-beginning 0))))
- (concat default-directory path)))))
- (t
- ;; If we aren't in file mode, then return an empty string to make
- ;; sure that we can still get some stuff done.
- "")))
+ (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)
+ (if (not (re-search-backward (format "^%d:" depth) nil t))
+ (error "Error building path of tag")
+ (cond ((looking-at "[0-9]+:\\s-*<->\\s-+\\([^\n]+\\)$")
+ (setq path (concat (buffer-substring-no-properties
+ (match-beginning 1) (match-end 1))
+ "/"
+ path)))
+ ((looking-at "[0-9]+:\\s-*[-]\\s-+\\([^\n]+\\)$")
+ ;; This is the start of our path.
+ (setq path (buffer-substring-no-properties
+ (match-beginning 1) (match-end 1))))))
+ (setq depth (1- depth)))
+ (if (and path
+ (string-match (concat speedbar-indicator-regex "$")
+ path))
+ (setq path (substring path 0 (match-beginning 0))))
+ (concat default-directory path)))))
(defun speedbar-path-line (path)
"Position the cursor on the line specified by PATH."
(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)
)
(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))))
'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."
(end-of-line)
(point))))))
(if (and (get-buffer text)
- (y-or-n-p (format "Kill buffer %s? " text)))
+ (speedbar-y-or-n-p (format "Kill buffer %s? " text)))
(kill-buffer text))
(speedbar-refresh))))))