;;; 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.2
+;; Version: 0.8.1
;; Keywords: file, tags, tools
-;; X-RCS: $Id: speedbar.el,v 1.6 1998/08/04 13:58:39 zappo Exp zappo $
;; This file is part of GNU Emacs.
;;
;; Starting Speedbar:
;;
-;; If speedbar came to you as a part of Emacs, simply type
-;; `M-x speedbar', and it will be autoloaded for you.
-;;
-;; 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)
-;;
+;; 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
;; into sub-lists. A long flat list can be used instead if needed.
;; Other filters could be easily added.
;;
-;; Users of 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.
-;;
;; 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
;;
;; Adding a speedbar specialized display mode:
;; 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
(defvar speedbar-xemacs20p (and speedbar-xemacsp
(= emacs-major-version 20)))
-;; 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)
- ;; Some XEmacsen w/ custom don't have :set keyword.
- ;; This protects them against custom.
- (fboundp 'custom-initialize-set))
- nil ;; We've got what we needed
- ;; We have the old custom-library, hack around it!
- (defmacro defgroup (&rest args)
- nil)
- (defmacro defface (var values doc &rest args)
- (` (progn
- (defvar (, var) (quote (, var)))
- ;; To make colors for your faces you need to set your .Xdefaults
- ;; or set them up ahead of time in your .emacs file.
- (make-face (, var))
- )))
- (defmacro defcustom (var value doc &rest args)
- (` (defvar (, var) (, value) (, doc))))))
-
;; customization stuff
(defgroup speedbar nil
"File and tag browser frame."
They must assume that the cursor is at the position where they start
inserting buttons.")
-(defcustom speedbar-initial-expansion-list-name "files"
+(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."
- :group 'speedbar
- :type '(radio (const :tag "File Directorys" file)
- ))
+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.
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
(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
(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
(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'")
(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 "Q" 'delete-frame)
;; navigation
(define-key speedbar-key-map "n" 'speedbar-next)
"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])
+ (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
;;
(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 (or (< emacs-major-version 20);;a bug is fixed in v20
- (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))))))
+ ;; 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 (or (null window-system) (eq window-system 'pc))
+ (if (and (or (null window-system) (eq window-system 'pc))
+ (fboundp 'set-frame-name))
(progn
(select-frame speedbar-frame)
(set-frame-name "Speedbar")))
speedbar-buffer)
(speedbar-frame-mode -1)))))
t t)
+ (toggle-read-only 1)
(speedbar-set-mode-line-format)
(if speedbar-xemacsp
(progn
(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."
(if speedbar-attached-frame (select-frame speedbar-attached-frame))
(pop-to-buffer buffer nil)
(other-window -1)
- ;; Fix for using this hook: Bob Weiner
- (cond ((fboundp 'run-hook-with-args)
+ ;; 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))
(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)
)))))
(set-window-dedicated-p (selected-window) nil)
(call-interactively fn)
(setq newbuff (current-buffer)))
- (switch-to-buffer " SPEEDBAR")
+ (switch-to-buffer speedbar-buffer)
(set-window-dedicated-p (selected-window) t))
- (speedbar-with-attached-buffer
- (switch-to-buffer newbuff))))
+ (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."
(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)))))
(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)
(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
;;
'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)))))
(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)
;; group combinding those two sub-lists.
(setq diff-idx 0)
(while (> 256 diff-idx)
- (let ((l (aref bins 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)
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)
- (nreverse short-group-list))
- work-list)))
+ ;; 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
(setq short-group-list nil
short-start-name nil
short-end-name nil
- num-shorts-grouped 0)))
+ 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.
;; there by itself.
(setq work-list
(cons (cons (try-completion "" short-group-list)
- (nreverse short-group-list))
+ short-group-list)
work-list)))
(short-group-list
;; Multiple groups to be named in a special
;; have grouped them.
(setq work-list
(cons (cons (concat short-start-name " to " short-end-name)
- (nreverse short-group-list))
+ short-group-list)
work-list))))
+ ;; Reverse the work list nreversed when consing.
+ (setq work-list (nreverse work-list))
;; Now, stick our new list onto the end of
(if work-list
(if junk-list
- (append (nreverse newlst)
- (nreverse work-list)
- junk-list)
- (append (nreverse newlst)
- (nreverse work-list)))
- (append (nreverse newlst) 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)
"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 ((methods speedbar-tag-hierarchy-method))
+ (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)))
(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
;; 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.
(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))
- ;; 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)
- (message "Updating speedbar to special mode: %s..."
- major-mode))
- (speedbar-update-special-contents)
- (if (<= 2 speedbar-verbosity-level)
+ (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
- (message "Updating speedbar to special mode: %s...done"
- major-mode)
- (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)
- (message "Updating speedbar to: %s..."
- default-directory))
- (speedbar-update-directory-contents)
- (if (<= 1 speedbar-verbosity-level)
- (progn
- (message "Updating speedbar to: %s...done"
- default-directory)
- (message nil)))))
- (select-frame af))
+ (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)))
;; Now run the mouse tracking system
(let ((l (speedbar-initial-stealthy-functions))
(speedbar-stealthy-update-recurse t))
(unwind-protect
- (while (and l (funcall (car l)))
- ;(sit-for 0)
- (setq l (cdr l)))
- ;;(message "Exit with %S" (car l))
+ (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 ()
(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))))
(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)
(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))))
(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."
- (cond
- ((string= speedbar-initial-expansion-list-name "files")
- (save-excursion
- (save-match-data
- (let ((path nil))
- (setq depth (1- depth))
- (while (/= depth -1)
- (if (not (re-search-backward (format "^%d:" depth) nil t))
- (error "Error building path of tag")
- (cond ((looking-at "[0-9]+:\\s-*<->\\s-+\\([^\n]+\\)$")
- (setq path (concat (buffer-substring-no-properties
- (match-beginning 1) (match-end 1))
- "/"
- path)))
- ((looking-at "[0-9]+:\\s-*[-]\\s-+\\([^\n]+\\)$")
- ;; This is the start of our path.
- (setq path (buffer-substring-no-properties
- (match-beginning 1) (match-end 1))))))
- (setq depth (1- depth)))
- (if (and path
- (string-match (concat 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."
"Delete text from point to indentation level INDENT or greater.
Handles end-of-sublist smartly."
(speedbar-with-writable
- (save-excursion
- (end-of-line) (forward-char 1)
- (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))))))
+ (save-excursion
+ (end-of-line) (forward-char 1)
+ (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)
)
(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))))))
HCoop / bpt / emacs.git / blobdiff