emacs: lisp/speedbar.el comparison

comparison lisp/speedbar.el @ 28902:5292e9f1f2ca

Updated the commentary section. xemacs20p now uses >= when detecting. require `defimage' safely. (speedbar-easymenu-definition-base): Add toggle for images. (speedbar-easymenu-definition-special): Add flush cache & expand. (speedbar-visiting-tag-hook): Set new defaults. Added options. (speedbar-reconfigure-keymaps-hook): New variable. (speedbar-frame-parameters): Updated documentation. (speedbar-use-imenu-flag): Updated custom tag (speedbar-dynamic-tags-function-list): New variable. (speedbar-tag-hierarchy-method): Updated doc & custom. (speedbar-indentation-width, speedbar-indentation-width) new variables. (speedbar-hide-button-brackets-flag): customizable. (speedbar-vc-indicator): Doc update. (speedbar-ignored-path-expressions): Updated default value. (speedbar-supported-extension-expressions): Updated default value. (speedbar-syntax-table): Remove {} paren status. (speedbar-file-key-map, speedbar-buffers-key-map): Add "=" to act as "+". Added overlay aliases. (speedbar-mode): Use `speedbar-mode-line-update' instead of `force-mode-line-update'. (speedbar-mode, speedbar-quick-mouse, speedbar-click, speedbar-double-click): Use `speedbar-mouse-set-point' instead of `mouse-set-point' (speedbar-reconfigure-keymaps): Run configure keymap hooks. (speedbar-item-info-tag-helper): Revamped to handle a wider range of arbitrary text, and new helper functions. (speedbar-item-copy, speedbar-item-rename): Fixed trailing \ in filename finder. (speedbar-make-button): Call `speedbar-insert-image-button-maybe'. (speedbar-directory-buttons): Update path search/expansion. (speedbar-make-tag-line): Pay attention to `speedbar-indentation-width'. Use more care w/ invisible properties. (speedbar-change-expand-button-char): Call `speedbar-insert-image-button-maybe'. (speedbar-apply-one-tag-hierarchy-method): Deleted (and replaced). (speedbar-sort-tag-hierarchy, speedbar-prefix-group-tag-hierarchy, speedbar-trim-words-tag-hierarchy, speedbar-simple-group-tag-hierarchy): New functions (speedbar-create-tag-hierarchy): Update doc, use new tag hooks. (speedbar-insert-imenu-list, speedbar-insert-etags-list): New functions. (speedbar-mouse-set-point): New function (speedbar-power-click): Updated documentation. (speedbar-line-token, speedbar-goto-this-file): Handle more types of tag prefix text. (speedbar-expand-line, speedbar-contract-line): Make more robust to strange text. (speedbar-expand-line): Takes universal argument to flush the cache. (speedbar-flush-expand-line): New function. (speedbar-tag-file): Use new `speedbar-fetch-dynamic-tags' fn. Use new generator insertion method. (speedbar-fetch-dynamic-tags): New function. (speedbar-fetch-dynamic-imenu): Removed code now handled in `speedbar-fetch-dynamic-imenu'. (speedbar-fetch-dynamic-etags): Fix current buffer problem. (speedbar-buffer-easymenu-definition): Added "Kill Buffer", and "Revert Buffer" menu items. (speedbar-buffer-buttons-engine): Be smarter when creating a filename tag (for expansion purposes.). (speedbar-highlight-one-tag-line, speedbar-unhighlight-one-tag-line, speedbar-recenter-to-top, speedbar-recenter): New functions. (defimage-speedbar): Image loading abstraction. (speedbar-directory-+, speedbar-directory--, speedbar-file-+, speedbar-file--, speedbar-file-, speedbar-tag-, speedbar-tag-+, speedbar-tag--, speedbar-tag-gt, speedbar-tag-v, speedbar-tag-type, speedbar-tag-mail): New images. (speedbar-expand-image-button-alist): New variable. (speedbar-insert-image-button-maybe): Insert an image over some buttons.

author	Eric M. Ludlam <zappo@gnu.org>
date	Sat, 13 May 2000 23:13:25 +0000
parents	98c01a50be97
children	89a795d90175

comparison

equal deleted inserted replaced

-:0e7bbb764f47
+:5292e9f1f2ca
 ;;; speedbar --- quick access to files and tags in a frame
-;;; Copyright (C) 1996, 97, 98, 99 Free Software Foundation
+;;; Copyright (C) 1996, 97, 98, 99, 00 Free Software Foundation
 ;; Author: Eric M. Ludlam <zappo@gnu.org>
-;; Version: 0.8.1
+;; Version: 0.11
 ;; Keywords: file, tags, tools
 ;; This file is part of GNU Emacs.
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; 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)
 ;;
 ;;; Developing for speedbar
 ;;
 ;; Adding a speedbar specialized display mode:
 ;;
 ;; over ridable, but more will be added as the need is discovered.
 ;;; TODO:
 ;; - More functions to create buttons and options
 ;; - Timeout directories we haven't visited in a while.
-;; - Remeber tags when refreshing the display.  (Refresh tags too?)
-;; - More 'special mode support.
 (require 'assoc)
 (require 'easymenu)
+(condition-case nil
+(require 'image)
+(error nil))
 (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)))
+				(>= emacs-major-version 20)))
 ;; customization stuff
 (defgroup speedbar nil
 "File and tag browser frame."
 :group 'tags
 (defcustom speedbar-visiting-file-hook nil
 "Hooks run when speedbar visits a file in the selected frame."
 :group 'speedbar
 :type 'hook)
-(defcustom speedbar-visiting-tag-hook nil
+(defcustom speedbar-visiting-tag-hook '(speedbar-highlight-one-tag-line)
 "Hooks run when speedbar visits a tag in the selected frame."
 :group 'speedbar
-:type 'hook)
+:type 'hook
+:options '(speedbar-highlight-one-tag-line
+	     speedbar-recenter-to-top
+	     speedbar-recenter
+	     ))
 (defcustom speedbar-load-hook nil
 "Hooks run when speedbar is loaded."
+:group 'speedbar
+:type 'hook)
+(defcustom speedbar-reconfigure-keymaps-hook nil
+"Hooks run when the keymaps are regenerated."
 :group 'speedbar
 :type 'hook)
 (defcustom speedbar-show-unknown-files nil
 "*Non-nil show files we can't expand with a ? in the expand button.
 				       (width . 20)
 				       (border-width . 0)
 				       (menu-bar-lines . 0)
 				       (unsplittable . t))
 "*Parameters to use when creating the speedbar frame in Emacs.
-Parameters not listed here which will be added automatically are
+Any parameter supported by a frame may be added.  The parameter `height'
-`height' which will be initialized to the height of the frame speedbar
+will be initialized to the height of the frame speedbar is
-is attached to."
+attached to and added to this list before the new frame is initialized."
 :group 'speedbar
 :type '(repeat (sexp :tag "Parameter:")))
 ;; These values by Hrvoje Niksic <hniksic@srce.hr>
 (defcustom speedbar-frame-plist
 (defcustom speedbar-use-imenu-flag (stringp (locate-library "imenu"))
 "*Non-nil means use imenu for file parsing.  nil to use etags.
 XEmacs prior to 20.4 doesn't support imenu, therefore the default is to
 use etags instead.  Etags support is not as robust as imenu support."
-:tag "User Imenu"
+:tag "Use Imenu for tags"
 :group 'speedbar
 :type 'boolean)
+(defvar speedbar-dynamic-tags-function-list
+'((speedbar-fetch-dynamic-imenu . speedbar-insert-imenu-list)
+(speedbar-fetch-dynamic-etags . speedbar-insert-etags-list))
+"Set to a functions which will return and insert a list of tags.
+Each element is of the form ( FETCH .  INSERT ) where FETCH
+is a funciotn which takes one parameter (the file to tag) and returns a
+list of tags.  The tag list can be of any form as long as the
+corresponding insert method can handle it.  If it returns t, then an
+error occured, and the next fetch routine is tried.
+INSERT is a function which takes an INDENTation level, and a LIST of
+tags to insert.  It will then create the speedbar buttons.")
 (defcustom speedbar-track-mouse-flag t
 "*Non-nil means to display info about the line under the mouse."
 :group 'speedbar
 :type 'boolean)
 "*If Non-nil, sort tags in the speedbar display.  *Obsolete*."
 :group 'speedbar
 :type 'boolean)
 (defcustom speedbar-tag-hierarchy-method
-'(prefix-group trim-words)
+'(speedbar-prefix-group-tag-hierarchy
-"*List of methods which speedbar will use to organize tags into groups.
+speedbar-trim-words-tag-hierarchy)
-Groups are defined as expandable meta-tags.  Imenu supports such
+"*List of hooks which speedbar will use to organize tags into groups.
-things in some languages, such as separating variables from functions.
+Groups are defined as expandable meta-tags.  Imenu supports
-Available methods are:
+such things in some languages, such as separating variables from
-sort         - Sort tags.  (sometimes unnecessary)
+functions.  Each hook takes one argument LST, and may destructivly
-trim-words   - Trim all tags by a common prefix, broken @ word sections.
+create a new list of the same form.  LST is a list of elements of the
-prefix-group - Try to guess groups by prefix.
+form:
-simple-group - If imenu already returned some meta groups, stick all
+(ELT1 ELT2 ... ELTn)
-tags that are not in a group into a sub-group."
+where each ELT is of the form
+(TAG-NAME-STRING . NUMBER-OR-MARKER)
+or
+(GROUP-NAME-STRING ELT1 EL2... ELTn)"
 :group 'speedbar
-:type '(repeat
+:type 'hook
-	  (radio
+:options '(speedbar-sort-tag-hierarchy
-	   (const :tag "Sort the tags." sort)
+	     speedbar-trim-words-tag-hierarchy
-	   (const :tag "Trim words to common prefix." trim-words)
+	     speedbar-prefix-group-tag-hierarchy
-	   (const :tag "Create groups from common prefixes." prefix-group)
+	     speedbar-simple-group-tag-hierarchy)
-	   (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
 are expanded in the current framework.  If nil, then the current
 hierarchy would be replaced with the new directory."
 :group 'speedbar
 :type 'boolean)
-(defvar speedbar-hide-button-brackets-flag nil
+(defcustom speedbar-indentation-width 1
-"*Non-nil means speedbar will hide the brackets around the + or -.")
+"*When sub-nodes are expanded, the number of spaces used for indentation."
+:group 'speedbar
+:type 'integer)
+(defcustom speedbar-hide-button-brackets-flag nil
+"*Non-nil means speedbar will hide the brackets around the + or -."
+:group 'speedbar
+:type 'boolean)
+(defcustom speedbar-use-images (and (or (fboundp 'defimage)
+					(fboundp 'make-image-specifier))
+				    window-system)
+"*Non nil if speedbar should display icons."
+:group 'speedbar
+:type 'boolean)
 (defcustom speedbar-before-popup-hook nil
 "*Hooks called before popping up the speedbar frame."
 :group 'speedbar
 :type 'hook)
 :group 'speedbar-vc
 :type 'boolean)
 (defvar speedbar-vc-indicator "*"
 "Text used to mark files which are currently checked out.
-Currently only RCS is supported.  Other version control systems can be
+Other version control systems can be added by examining the function
-added by examining the function `speedbar-this-file-in-vc' and
+`speedbar-vc-path-enable-hook' and `speedbar-vc-in-control-hook'.")
-`speedbar-vc-check-dir-p'")
 (defcustom speedbar-vc-path-enable-hook nil
 "*Return non-nil if the current path should be checked for Version Control.
 Functions in this hook must accept one parameter which is the path
 being checked."
 `speedbar-extension-list-to-regex' (A misnamed function in this case.)
 Use the function `speedbar-add-ignored-path-regexp', or customize the
 variable `speedbar-ignored-path-expressions' to modify this variable.")
 (defcustom speedbar-ignored-path-expressions
-'("/logs?/\\'")
+'("[/\\]logs?[/\\]\\'")
 "*List of regular expressions matching directories speedbar will ignore.
 They should included paths to directories which are notoriously very
 large and take a long time to load in.  Use the function
 `speedbar-add-ignored-path-regexp' to add new items to this list after
 speedbar is loaded.  You may place anything you like in this list
 ;; change in the future.
 (defcustom speedbar-supported-extension-expressions
 (append '(".[ch]\\(\\+\\+\\|pp\\|c\\|h\\|xx\\)?" ".tex\\(i\\(nfo\\)?\\)?"
 	    ".el" ".emacs" ".l" ".lsp" ".p" ".java" ".f\\(90\\|77\\|or\\)?")
 	  (if speedbar-use-imenu-flag
-	      '(".ada" ".pl" ".tcl" ".m" ".scm" ".pm" ".py"
+	      '(".ada" ".p[lm]" ".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\\)?")))
+		"[Mm]akefile\\(\\.in\\)?")))
 "*List of regular expressions which will match files supported by tagging.
 Do not prefix the `.' char with a double \\ to quote it, as the period
 will be stripped by a simplified optimizer when compiled into a
 singular expression.  This variable will be turned into
 `speedbar-file-regexp' for use with speedbar.  You should use the
 ;; turn off paren matching around here.
 (modify-syntax-entry ?\' " " speedbar-syntax-table)
 (modify-syntax-entry ?\" " " speedbar-syntax-table)
 (modify-syntax-entry ?( " " speedbar-syntax-table)
 (modify-syntax-entry ?) " " speedbar-syntax-table)
+(modify-syntax-entry ?{ " " speedbar-syntax-table)
+(modify-syntax-entry ?} " " speedbar-syntax-table)
 (modify-syntax-entry ?[ " " speedbar-syntax-table)
 (modify-syntax-entry ?] " " speedbar-syntax-table))
 (defvar speedbar-key-map nil
 "Keymap used in speedbar buffer.")
 ;; 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-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 "O" 'speedbar-item-object-delete)
 (define-key speedbar-file-key-map "R" 'speedbar-item-rename)
 )
 (defvar speedbar-easymenu-definition-base
-'("Speedbar"
+`("Speedbar"
 ["Update" speedbar-refresh t]
 ["Auto Update" speedbar-toggle-updates
 :style toggle :selected speedbar-update-flag]
+,(if (and (or (fboundp 'defimage)
+		  (fboundp 'make-image-specifier))
+	      window-system)
+	 ["Use Images" speedbar-toggle-images
+	  :style toggle :selected speedbar-use-images])
 )
 "Base part of the speedbar menu.")
 (defvar speedbar-easymenu-definition-special
 '(["Edit Item On Line" speedbar-edit-line t]
 ["Show All Files" speedbar-toggle-show-all-files
 :style toggle :selected speedbar-show-unknown-files]
 ["Expand File Tags" speedbar-expand-line
+(save-excursion (beginning-of-line)
+		     (looking-at "[0-9]+: *.\\+. "))]
+["Flush Cache & Expand" speedbar-flush-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]+: *.-. "))]
 (defalias 'speedbar-frame-parameter 'frame-parameter)
 (defun speedbar-frame-parameter (frame parameter)
 "Return FRAME's PARAMETER value."
 (cdr (assoc parameter (frame-parameters frame)))))
+(if (fboundp 'make-overlay)
+(progn
+(defalias 'speedbar-make-overlay 'make-overlay)
+(defalias 'speedbar-overlay-put 'overlay-put)
+(defalias 'speedbar-delete-overlay 'delete-overlay)
+(defalias 'speedbar-overlay-start 'overlay-start)
+(defalias 'speedbar-overlay-end 'overlay-end)
+(defalias 'speedbar-mode-line-update 'force-mode-line-update))
+(defalias 'speedbar-make-overlay 'make-extent)
+(defalias 'speedbar-overlay-put 'set-extent-property)
+(defalias 'speedbar-delete-overlay 'delete-extent)
+(defalias 'speedbar-overlay-start 'extent-start)
+(defalias 'speedbar-overlay-end 'extent-end)
+(defalias 'speedbar-mode-line-update 'redraw-modeline))
 ;;; Mode definitions/ user commands
 ;;
 ;;;###autoload
 			  nil		; Do normal operations.
 			(cond ((eq count 1)
 			       (speedbar-quick-mouse event))
 			      ((or (eq count 2)
 				   (eq count 3))
-			       (mouse-set-point event)
+			       (speedbar-mouse-set-point event)
 			       (speedbar-do-function-pointer)
 			       (speedbar-quick-mouse event)))
 			;; Don't do normal operations.
 			t)))))
 (make-local-hook 'kill-buffer-hook)
 			  (concat p4 p5))
 		  (list (concat p1 p2 p3 p4 p5)))))
 	  (if (not (equal mode-line-format tf))
 	      (progn
 		(setq mode-line-format tf)
-		(force-mode-line-update)))))))
+		(speedbar-mode-line-update)))))))
 (defun speedbar-temp-buffer-show-function (buffer)
 "Placed in the variable `temp-buffer-show-function' in `speedbar-mode'.
 If a user requests help using \\[help-command] <Key> the temp BUFFER will be
 redirected into a window on the attached frame."
 ;; 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))))))
+	(set-buffer-menubar (list md))))
+(run-hooks 'speedbar-reconfigure-keymaps-hook)))
 ;;; User Input stuff
 ;;
 (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 " > \\([^ ]+\\)$"
+(if (re-search-forward " [-+=]?> \\([^\n]+\\)"
 			   (save-excursion(end-of-line)(point)) t)
 	(let ((tag (match-string 1))
-	      (attr (get-text-property (match-beginning 1)
+	      (attr (speedbar-line-token))
-				       'speedbar-token))
 	      (item nil))
-	  (looking-at "\\([0-9]+\\):")
+	  (if (and (featurep 'semantic) (semantic-token-p attr))
-	  (setq item (speedbar-line-path (string-to-int (match-string 1))))
+	      (speedbar-message (semantic-summerize-nonterminal attr))
-	  (speedbar-message "Tag: %s  in %s @ %s"
+	    (looking-at "\\([0-9]+\\):")
-			    tag item (if attr
+	    (setq item (file-name-nondirectory (speedbar-line-path)))
-					 (if (markerp attr)
+	    (speedbar-message "Tag: %s  in %s" tag item)))
-					     (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))))
+	(if (re-search-forward " [+-]?[()|@] \\([^\n]+\\)$" nil t)
+	    (let* ((detailtext (match-string 1))
+		   (detail (or (speedbar-line-token) detailtext))
+		  (parent (save-excursion
+			    (beginning-of-line)
+			    (let ((dep (if (looking-at "[0-9]+:")
+					   (1- (string-to-int (match-string 0)))
+					 0)))
+			      (re-search-backward (concat "^"
+							   (int-to-string dep)
+							   ":")
+						  nil t))
+			    (if (looking-at "[0-9]+: +[-+=>]> \\([^\n]+\\)$")
+				(speedbar-line-token)
+			      nil))))
+	      (if (and (featurep 'semantic) (semantic-token-p detail))
+		  (speedbar-message
+		   (semantic-summerize-nonterminal detail parent))
+		(if parent
+		    (speedbar-message "Detail: %s of tag %s" detail
+				      (if (and (featurep 'semantic)
+					       (semantic-token-p parent))
+					  (semantic-token-name parent)
+					parent))
+		  (speedbar-message "Detail: %s" detail))))
+	  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)
 			      speedbar-shown-directories)))
 	;; Create the right file name part
 	(if (file-directory-p rt)
 	    (setq rt
 		  (concat (expand-file-name rt)
-			  (if (string-match "/$" rt) "" "/")
+			  (if (string-match "[/\\]$" rt) "" "/")
 			  (file-name-nondirectory f))))
 	(if (or (not (file-exists-p rt))
 		(speedbar-y-or-n-p (format "Overwrite %s with %s? " rt f)))
 	    (progn
 	      (copy-file f rt t t)
 				speedbar-shown-directories)))
 	  ;; Create the right file name part
 	  (if (file-directory-p rt)
 	      (setq rt
 		    (concat (expand-file-name rt)
-			    (if (string-match "/\\'" rt) "" "/")
+			    (if (string-match "[/\\]\\'" rt) "" "/")
 			    (file-name-nondirectory f))))
 	  (if (or (not (file-exists-p rt))
 		  (speedbar-y-or-n-p (format "Overwrite %s with %s? " rt f)))
 	      (progn
 		(rename-file f rt t)
 "Toggle automatic update for the speedbar frame."
 (interactive)
 (if speedbar-update-flag
 (speedbar-disable-update)
 (speedbar-enable-update)))
+(defun speedbar-toggle-images ()
+"Toggle automatic update for the speedbar frame."
+(interactive)
+(setq speedbar-use-images (not speedbar-use-images))
+(speedbar-refresh))
 (defun speedbar-toggle-sorting ()
 "Toggle automatic update for the speedbar frame."
 (interactive)
 (setq speedbar-sort-tags (not speedbar-sort-tags)))
 (put-text-property start end 'face face)
 (put-text-property start end 'mouse-face mouse)
 (put-text-property start end 'invisible nil)
 (if function (put-text-property start end 'speedbar-function function))
 (if token (put-text-property start end 'speedbar-token token))
+;; So far the only text we have is less that 3 chars.
+(if (<= (- end start) 3)
+(speedbar-insert-image-button-maybe start (- end start)))
 )
 ;;; Initial Expansion list management
 ;;
 (defun speedbar-initial-expansion-list ()
 (defun speedbar-directory-buttons (directory index)
 "Insert a single button group at point for DIRECTORY.
 Each directory path part is a different button.  If part of the path
 matches the user directory ~, then it is replaced with a ~.
 INDEX is not used, but is required by the caller."
-(let* ((tilde (expand-file-name "~"))
+(let* ((tilde (expand-file-name "~/"))
 	 (dd (expand-file-name directory))
 	 (junk (string-match (regexp-quote tilde) dd))
 	 (displayme (if junk
-			(concat "~" (substring dd (match-end 0)))
+			(concat "~/" (substring dd (match-end 0)))
 		      dd))
 	 (p (point)))
-(if (string-match "^~/?\\'" displayme) (setq displayme (concat tilde "/")))
+(if (string-match "^~[/\\]?\\'" displayme) (setq displayme tilde))
 (insert displayme)
 (save-excursion
 (goto-char p)
-(while (re-search-forward "\\([^/]+\\)/" nil t)
+(while (re-search-forward "\\([^/\\]+\\)[/\\]" nil t)
 	(speedbar-make-button (match-beginning 1) (match-end 1)
 			      'speedbar-directory-face
 			      'speedbar-highlight-face
 			      'speedbar-directory-buttons-follow
 			      (if (and (= (match-beginning 1) p)
-(not (char-equal (char-after (+ p 1)) ?:)))
+				       (not (char-equal (char-after (+ p 1)) ?:)))
 				  (expand-file-name "~/")  ;the tilde
 				(buffer-substring-no-properties
 				 p (match-end 0)))))
 ;; Nuke the beginning of the directory if it's too long...
 (cond ((eq speedbar-directory-button-trim-method 'span)
 	     (beginning-of-line)
 	     (let ((ww (or (speedbar-frame-width) 20)))
 	       (move-to-column ww nil)
 	       (while (>= (current-column) ww)
-		 (re-search-backward "/" nil t)
+		 (re-search-backward "[/\\]" nil t)
 		 (if (<= (current-column) 2)
 		     (progn
-		       (re-search-forward "/" nil t)
+		       (re-search-forward "[/\\]" nil t)
 		       (if (< (current-column) 4)
-			   (re-search-forward "/" nil t))
+			   (re-search-forward "[/\\]" nil t))
 		       (forward-char -1)))
-		 (if (looking-at "/?$")
+		 (if (looking-at "[/\\]?$")
 		     (beginning-of-line)
 		   (insert "/...\n ")
 		   (move-to-column ww nil)))))
 	    ((eq speedbar-directory-button-trim-method 'trim)
 	     (end-of-line)
 	     (let ((ww (or (speedbar-frame-width) 20))
 		   (tl (current-column)))
 	       (if (< ww tl)
 		   (progn
 		     (move-to-column (- tl ww))
-		     (if (re-search-backward "/" nil t)
+		     (if (re-search-backward "[/\\]" nil t)
 			 (progn
 			   (delete-region (point-min) (point))
 			   (insert "$")
 			   )))))))
 )
-(if (string-match "\\`/[^/]+/\\'" displayme)
+(if (string-match "\\`[/\\][^/\\]+[/\\]\\'" displayme)
 	(progn
 	  (insert "  ")
 	  (let ((p (point)))
 	    (insert "<root>")
 	    (speedbar-make-button p (point)
 This function assumes that the cursor is in the speedbar window at the
 position to insert a new item, and that the new item will end with a CR"
 (let ((start (point))
 	(end (progn
 	       (insert (int-to-string depth) ":")
-	       (point))))
+	       (point)))
+	(depthspacesize (* depth speedbar-indentation-width)))
 (put-text-property start end 'invisible t)
-)
+(insert-char ?  depthspacesize nil)
-(insert-char ?  depth nil)
+(put-text-property (- (point) depthspacesize) (point) 'invisible nil)
-(put-text-property (- (point) depth) (point) 'invisible nil)
+(let* ((exp-button (cond ((eq exp-button-type 'bracket) "[%c]")
-(let* ((exp-button (cond ((eq exp-button-type 'bracket) "[%c]")
+			     ((eq exp-button-type 'angle) "<%c>")
-			   ((eq exp-button-type 'angle) "<%c>")
+			     ((eq exp-button-type 'curly) "{%c}")
-			   ((eq exp-button-type 'curly) "{%c}")
+			     (t ">")))
-			   (t ">")))
+	   (buttxt (format exp-button exp-button-char))
-	 (buttxt (format exp-button exp-button-char))
+	   (start (point))
-	 (start (point))
+	   (end (progn (insert buttxt) (point)))
-	 (end (progn (insert buttxt) (point)))
+	   (bf (if exp-button-type 'speedbar-button-face nil))
-	 (bf (if exp-button-type 'speedbar-button-face nil))
+	   (mf (if exp-button-function 'speedbar-highlight-face nil))
-	 (mf (if exp-button-function 'speedbar-highlight-face nil))
+	   )
-	 )
+(speedbar-make-button start end bf mf exp-button-function exp-button-data)
-(speedbar-make-button start end bf mf exp-button-function exp-button-data)
+(if speedbar-hide-button-brackets-flag
-(if speedbar-hide-button-brackets-flag
+	  (progn
-	(progn
+	    (put-text-property start (1+ start) 'invisible t)
-	  (put-text-property start (1+ start) 'invisible t)
+	    (put-text-property end (1- end) 'invisible t)))
-	  (put-text-property end (1- end) 'invisible t)))
+)
-)
+(insert-char ?  1 nil)
-(insert-char ?  1 nil)
-(put-text-property (1- (point)) (point) 'invisible nil)
-(let ((start (point))
-	(end (progn (insert tag-button) (point))))
-(insert-char ?\n 1 nil)
 (put-text-property (1- (point)) (point) 'invisible nil)
-(speedbar-make-button start end tag-button-face
+(let ((start (point))
-			  (if tag-button-function 'speedbar-highlight-face nil)
+	  (end (progn (insert tag-button) (point))))
-			  tag-button-function tag-button-data))
+(insert-char ?\n 1 nil)
-)
+(put-text-property (1- (point)) (point) 'invisible nil)
+(speedbar-make-button start end tag-button-face
+			    (if tag-button-function 'speedbar-highlight-face nil)
+			    tag-button-function tag-button-data))
+))
 (defun speedbar-change-expand-button-char (char)
 "Change the expansion button character to CHAR for the current line."
 (save-excursion
 (beginning-of-line)
 (if (re-search-forward ":\\s-*.\\([-+?]\\)" (save-excursion (end-of-line)
 								(point)) t)
 	(speedbar-with-writable
 	  (goto-char (match-beginning 1))
 	  (delete-char 1)
 	  (insert-char char 1 t)
-	  (put-text-property (point) (1- (point)) 'invisible nil)))))
+	  (put-text-property (point) (1- (point)) 'invisible nil)
+	  ;; make sure we fix the image on the text here.
+	  (speedbar-insert-image-button-maybe (- (point) 2) 3)))))
 ;;; Build button lists
 ;;
 (defun speedbar-insert-files-at-point (files level)
 		      (goto-char (match-end 0))
 		  (speedbar-do-function-pointer)))
 		(setq sf (cdr sf)))))
 	)))
-(defun speedbar-apply-one-tag-hierarchy-method (lst method)
+(defun speedbar-sort-tag-hierarchy (lst)
-"Adjust the tag hierarchy LST by METHOD."
+"Sort all elements of tag hierarchy LST."
-(cond
+(sort (copy-alist lst)
-((eq method 'sort)
+	(lambda (a b) (string< (car a) (car b)))))
-(sort (copy-alist lst)
-	  (lambda (a b) (string< (car a) (car b)))))
+(defun speedbar-prefix-group-tag-hierarchy (lst)
-((eq method 'prefix-group)
+"Prefix group names for tag hierarchy LST."
 (let ((newlst nil)
-	  (sublst nil)
+	(sublst nil)
-	  (work-list nil)
+	(work-list nil)
-	  (junk-list nil)
+	(junk-list nil)
-	  (short-group-list nil)
+	(short-group-list nil)
-	  (short-start-name nil)
+	(short-start-name nil)
-	  (short-end-name nil)
+	(short-end-name nil)
-	  (num-shorts-grouped 0)
+	(num-shorts-grouped 0)
-	  (bins (make-vector 256 nil))
+	(bins (make-vector 256 nil))
-	  (diff-idx 0))
+	(diff-idx 0))
 ;; Break out sub-lists
 (while lst
-	(if (listp (cdr-safe (car-safe lst)))
+(if (and (listp (cdr-safe (car-safe lst)))
-	    (setq newlst (cons (car lst) newlst))
+	       ;; This one is for bovine tokens
-	  (setq sublst (cons (car lst) sublst)))
+	       (not (symbolp (car-safe (cdr-safe (car-safe lst))))))
-	(setq lst (cdr lst)))
+	  (setq newlst (cons (car lst) newlst))
-;; Reverse newlst because it was made backwards.
+	(setq sublst (cons (car lst) sublst)))
-;; Sublist doesn't need reversing because the act
+(setq lst (cdr lst)))
-;; of binning things will reverse it for us.
+;; Reverse newlst because it was made backwards.
-(setq newlst (nreverse newlst))
+;; Sublist doesn't need reversing because the act
-;; Now, first find out how long our list is.  Never let a
+;; of binning things will reverse it for us.
-;; list get-shorter than our minimum.
+(setq newlst (nreverse newlst))
-(if (<= (length sublst) speedbar-tag-split-minimum-length)
+;; Now, first find out how long our list is.  Never let a
-	  (setq work-list (nreverse sublst))
+;; list get-shorter than our minimum.
-	(setq diff-idx (length (try-completion "" sublst)))
+(if (<= (length sublst) speedbar-tag-split-minimum-length)
-	;; Sort the whole list into bins.
+	(setq work-list (nreverse sublst))
-	(while sublst
+(setq diff-idx (length (try-completion "" sublst)))
-	  (let ((e (car sublst))
+;; Sort the whole list into bins.
-		(s (car (car sublst))))
+(while sublst
-	    (cond ((<= (length s) diff-idx)
+	(let ((e (car sublst))
-		   ;; 0 storage bin for shorty.
+	      (s (car (car sublst))))
-		   (aset bins 0 (cons e (aref bins 0))))
+	  (cond ((<= (length s) diff-idx)
-		  (t
+		 ;; 0 storage bin for shorty.
-		   ;; stuff into a bin based on ascii value at diff
+		 (aset bins 0 (cons e (aref bins 0))))
-		   (aset bins (aref s diff-idx)
+		(t
-			 (cons e (aref bins (aref s diff-idx)))))))
+		 ;; stuff into a bin based on ascii value at diff
-	  (setq sublst (cdr sublst)))
+		 (aset bins (aref s diff-idx)
-	;; Go through all our bins  Stick singles into our
+		       (cons e (aref bins (aref s diff-idx)))))))
-	;; junk-list, everything else as sublsts in work-list.
+	(setq sublst (cdr sublst)))
-	;; If two neighboring lists are both small, make a grouped
+;; Go through all our bins  Stick singles into our
-	;; group combinding those two sub-lists.
+;; junk-list, everything else as sublsts in work-list.
-	(setq diff-idx 0)
+;; If two neighboring lists are both small, make a grouped
-	(while (> 256 diff-idx)
+;; group combinding those two sub-lists.
-	  (let ((l (nreverse ;; Reverse the list since they are stuck in
+(setq diff-idx 0)
-		    ;; backwards.
+(while (> 256 diff-idx)
-		    (aref bins diff-idx))))
+	(let ((l (nreverse;; Reverse the list since they are stuck in
-	    (if l
+		  ;; backwards.
-		(let ((tmp (cons (try-completion "" l) l)))
+		  (aref bins diff-idx))))
-		  (if (or (> (length l) speedbar-tag-regroup-maximum-length)
+	  (if l
-			  (> (+ (length l) (length short-group-list))
+	      (let ((tmp (cons (try-completion "" l) l)))
-			     speedbar-tag-split-minimum-length))
+		(if (or (> (length l) speedbar-tag-regroup-maximum-length)
-		      (progn
+			(> (+ (length l) (length short-group-list))
-			;; We have reached a longer list, so we
+			   speedbar-tag-split-minimum-length))
-			;; must finish off a grouped group.
+		    (progn
-			(cond
+		      ;; We have reached a longer list, so we
-			 ((and short-group-list
+		      ;; must finish off a grouped group.
-			       (= (length short-group-list)
+		      (cond
-				  num-shorts-grouped))
+		       ((and short-group-list
-			  ;; All singles?  Junk list
+			     (= (length short-group-list)
-			  (setq junk-list (append short-group-list
+				num-shorts-grouped))
-						  junk-list)))
+			;; All singles?  Junk list
-			 ((= num-shorts-grouped 1)
+			(setq junk-list (append short-group-list
-			  ;; Only one short group?  Just stick it in
+						junk-list)))
-			  ;; there by itself.  Make a group, and find
+		       ((= num-shorts-grouped 1)
-			  ;; a subexpression
+			;; Only one short group?  Just stick it in
-			  (let ((subexpression (try-completion
+			;; there by itself.  Make a group, and find
-						"" short-group-list)))
+			;; a subexpression
-			    (if (< (length subexpression)
+			(let ((subexpression (try-completion
-				   speedbar-tag-group-name-minimum-length)
+					      "" short-group-list)))
-				(setq subexpression
+			  (if (< (length subexpression)
-				      (concat short-start-name
+				 speedbar-tag-group-name-minimum-length)
-					      " ("
+			      (setq subexpression
-					      (substring
+				    (concat short-start-name
-					       (car (car short-group-list))
+					    " ("
-					       (length short-start-name))
+					    (substring
-					      ")")))
+					     (car (car short-group-list))
-			    (setq work-list
+					     (length short-start-name))
-				  (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
+				(cons (cons subexpression
-						    " to "
+					    short-group-list)
-						    short-end-name)
-					    (nreverse short-group-list))
 				      work-list))))
-			;; Reset short group list information every time.
+		       (short-group-list
-			(setq short-group-list nil
+			;; Multiple groups to be named in a special
-			      short-start-name nil
+			;; way by displaying the range over which we
-			      short-end-name nil
+			;; have grouped them.
-			      num-shorts-grouped 0)))
+			(setq work-list
-		  ;; Ok, now that we cleaned up the short-group-list,
+			      (cons (cons (concat short-start-name
-		  ;; we can deal with this new list, to decide if it
+						  " to "
-		  ;; should go on one of these sub-lists or not.
+						  short-end-name)
-		  (if (< (length l) speedbar-tag-regroup-maximum-length)
+					  (nreverse short-group-list))
-		      (setq short-group-list (append short-group-list l)
+				    work-list))))
-			    num-shorts-grouped (1+ num-shorts-grouped)
+		      ;; Reset short group list information every time.
-			    short-end-name (car tmp)
+		      (setq short-group-list nil
-			    short-start-name (if short-start-name
+			    short-start-name nil
-						 short-start-name
+			    short-end-name nil
-					       (car tmp)))
+			    num-shorts-grouped 0)))
-		    (setq work-list (cons tmp work-list))))))
+		;; Ok, now that we cleaned up the short-group-list,
-	  (setq diff-idx (1+ diff-idx))))
+		;; we can deal with this new list, to decide if it
-;; Did we run out of things?  Drop our new list onto the end.
+		;; should go on one of these sub-lists or not.
-(cond
+		(if (< (length l) speedbar-tag-regroup-maximum-length)
-((and short-group-list (= (length short-group-list) num-shorts-grouped))
+		    (setq short-group-list (append short-group-list l)
-	;; All singles?  Junk list
+			  num-shorts-grouped (1+ num-shorts-grouped)
-	(setq junk-list (append short-group-list junk-list)))
+			  short-end-name (car tmp)
-((= num-shorts-grouped 1)
+			  short-start-name (if short-start-name
-	;; Only one short group?  Just stick it in
+					       short-start-name
-	;; there by itself.
+					     (car tmp)))
-	(setq work-list
+		  (setq work-list (cons tmp work-list))))))
-	      (cons (cons (try-completion "" short-group-list)
+	(setq diff-idx (1+ diff-idx))))
-			  short-group-list)
+;; Did we run out of things?  Drop our new list onto the end.
-		    work-list)))
+(cond
-(short-group-list
+((and short-group-list (= (length short-group-list) num-shorts-grouped))
-	;; Multiple groups to be named in a special
+;; All singles?  Junk list
-	;; way by displaying the range over which we
+(setq junk-list (append short-group-list junk-list)))
-	;; have grouped them.
+((= num-shorts-grouped 1)
-	(setq work-list
+;; Only one short group?  Just stick it in
-	      (cons (cons (concat short-start-name " to " short-end-name)
+;; there by itself.
-			  short-group-list)
+(setq work-list
-		    work-list))))
+	    (cons (cons (try-completion "" short-group-list)
-;; Reverse the work list nreversed when consing.
+			short-group-list)
-(setq work-list (nreverse work-list))
+		  work-list)))
-;; Now, stick our new list onto the end of
+(short-group-list
-(if work-list
+;; Multiple groups to be named in a special
-	  (if junk-list
+;; way by displaying the range over which we
-	      (append newlst work-list junk-list)
+;; have grouped them.
-	    (append newlst work-list))
+(setq work-list
-	(append  newlst junk-list))))
+	    (cons (cons (concat short-start-name " to " short-end-name)
-((eq method 'trim-words)
+			short-group-list)
-(let ((newlst nil)
+		  work-list))))
-	  (sublst nil)
+;; Reverse the work list nreversed when consing.
-	  (trim-prefix nil)
+(setq work-list (nreverse work-list))
-	  (trim-chars 0)
+;; Now, stick our new list onto the end of
-	  (trimlst nil))
+(if work-list
-(while lst
+	(if junk-list
-	(if (listp (cdr-safe (car-safe lst)))
+	    (append newlst work-list junk-list)
-	    (setq newlst (cons (car lst) newlst))
+	  (append newlst work-list))
-	  (setq sublst (cons (car lst) sublst)))
+(append  newlst junk-list))))
-	(setq lst (cdr lst)))
-;; Get the prefix to trim by.  Make sure that we don't trim
+(defun speedbar-trim-words-tag-hierarchy (lst)
-;; off silly pieces, only complete understandable words.
+"Trim all words in a tag hierarchy.
-(setq trim-prefix (try-completion "" sublst))
+Base trimming information on word separators, and group names.
-(if (or (= (length sublst) 1)
+Argument LST is the list of tags to trim."
-	      (not trim-prefix)
+(let ((newlst nil)
-	      (not (string-match "\\(\\w+\\W+\\)+" trim-prefix)))
+	(sublst nil)
-	  (append (nreverse newlst) (nreverse sublst))
+	(trim-prefix nil)
-	(setq trim-prefix (substring trim-prefix (match-beginning 0)
+	(trim-chars 0)
-				     (match-end 0)))
+	(trimlst nil))
-	(setq trim-chars (length trim-prefix))
+(while lst
-	(while sublst
+(if (listp (cdr-safe (car-safe lst)))
-	  (setq trimlst (cons
+	  (setq newlst (cons (car lst) newlst))
-			 (cons (substring (car (car sublst)) trim-chars)
+	(setq sublst (cons (car lst) sublst)))
-			       (cdr (car sublst)))
+(setq lst (cdr lst)))
-			 trimlst)
+;; Get the prefix to trim by.  Make sure that we don't trim
-		sublst (cdr sublst)))
+;; off silly pieces, only complete understandable words.
-	;; Put the lists together
+(setq trim-prefix (try-completion "" sublst))
-	(append (nreverse newlst) trimlst))))
+(if (or (= (length sublst) 1)
-((eq method 'simple-group)
+	    (not trim-prefix)
-(let ((newlst nil)
+	    (not (string-match "\\(\\w+\\W+\\)+" trim-prefix)))
-	  (sublst nil))
+	(append (nreverse newlst) (nreverse sublst))
-(while lst
+(setq trim-prefix (substring trim-prefix (match-beginning 0)
-	(if (listp (cdr-safe (car-safe lst)))
+				   (match-end 0)))
-	    (setq newlst (cons (car lst) newlst))
+(setq trim-chars (length trim-prefix))
-	  (setq sublst (cons (car lst) sublst)))
+(while sublst
-	(setq lst (cdr lst)))
+	(setq trimlst (cons
-(if (not newlst)
+		       (cons (substring (car (car sublst)) trim-chars)
-	  (nreverse sublst)
+			     (cdr (car sublst)))
-	(setq newlst (cons (cons "Tags" (nreverse sublst)) newlst))
+		       trimlst)
-	(nreverse newlst))))
+	      sublst (cdr sublst)))
-(t lst)))
+;; Put the lists together
+(append (nreverse newlst) trimlst))))
+(defun speedbar-simple-group-tag-hierarchy (lst)
+"Create a simple 'Tags' group with orphaned tags.
+Argument LST is the list of tags to sort into groups."
+(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))))
 (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."
+the list."
 (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)))
+		    speedbar-tag-hierarchy-method))
+	 (lst (if (fboundp 'copy-tree)
+		  (copy-tree lst)
+		lst)))
 (while methods
-(setq lst (speedbar-apply-one-tag-hierarchy-method lst (car methods))
+(setq lst (funcall (car methods) lst)
 	    methods (cdr methods)))
 lst))
 (defun speedbar-insert-generic-list (level lst expand-fun find-fun)
 "At LEVEL, insert a generic multi-level alist LST.
 				   (car (car lst)) ;button name
 				   nil nil 'speedbar-tag-face
 				   (1+ level)))
 	  (t (speedbar-message "Ooops!")))
 (setq lst (cdr lst))))
+(defun speedbar-insert-imenu-list (indent lst)
+"At level INDENT, insert the imenu generated LST."
+(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
+				'speedbar-tag-expand
+				'speedbar-tag-find))
 ;;; Timed functions
 ;;
 (defun speedbar-update-contents ()
 "Generically update the contents of the speedbar buffer."
 	;; Build cbd-parent, and see if THAT is in the current shown
 	;; directories.  First, go through pains to get the parent directory
 	(if (and speedbar-smart-directory-expand-flag
 		 (save-match-data
 		   (setq cbd-parent cbd)
-		   (if (string-match "/$" cbd-parent)
+		   (if (string-match "[/\\]$" cbd-parent)
 		       (setq cbd-parent (substring cbd-parent 0
 						   (match-beginning 0))))
 		   (setq cbd-parent (file-name-directory cbd-parent)))
 		 (member cbd-parent speedbar-shown-directories))
 	    (setq expand-local t)
 	      (car speedbar-obj-indicator)
 	    (cdr speedbar-obj-indicator)))))))
 ;;; Clicking Activity
 ;;
+(defun speedbar-mouse-set-point (e)
+"Set POINT based on event E.
+Handle clicking on images in XEmacs."
+(if (and (fboundp 'event-over-glyph-p) (event-over-glyph-p e))
+;; We are in XEmacs, and clicked on a picture
+(let ((ext (event-glyph-extent e)))
+	;; This position is back inside the extent where the
+	;; junk we pushed into the property list lives.
+	(if (extent-end-position ext)
+	    (goto-char (1- (extent-end-position ext)))
+	  (mouse-set-point e)))
+;; We are not in XEmacs, OR we didn't click on a picture.
+(mouse-set-point e)))
 (defun speedbar-quick-mouse (e)
 "Since mouse events are strange, this will keep the mouse nicely positioned.
 This should be bound to mouse event E."
 (interactive "e")
-(mouse-set-point e)
+(speedbar-mouse-set-point e)
 (speedbar-position-cursor-on-line)
 )
 (defun speedbar-position-cursor-on-line ()
 "Position the cursor on a line."
 	(goto-char (1- (match-end 0)))
 (goto-char oldpos))))
 (defun speedbar-power-click (e)
 "Activate any speedbar button as a power click.
+A power click will dispose of cached data (if available) or bring a buffer
+up into a different window.
 This should be bound to mouse event E."
 (interactive "e")
 (let ((speedbar-power-click t))
 (speedbar-click e)))
 "Activate any speedbar buttons where the mouse is clicked.
 This must be bound to a mouse event.  A button is any location of text
 with a mouse face that has a text property called `speedbar-function'.
 This should be bound to mouse event E."
 (interactive "e")
-(mouse-set-point e)
+(speedbar-mouse-set-point e)
 (speedbar-do-function-pointer)
 (speedbar-quick-mouse e))
 (defun speedbar-double-click (e)
 "Activate any speedbar buttons where the mouse is clicked.
 with a mouse face that has a text property called `speedbar-function'.
 This should be bound to mouse event E."
 (interactive "e")
 ;; Emacs only.  XEmacs handles this via `mouse-track-click-hook'.
 (cond ((eq (car e) 'down-mouse-1)
-	 (mouse-set-point e))
+	 (speedbar-mouse-set-point e))
 	((eq (car e) 'mouse-1)
 	 (speedbar-quick-mouse e))
 	((or (eq (car e) 'double-down-mouse-1)
 	     (eq (car e) 'triple-down-mouse-1))
-	 (mouse-set-point e)
+	 (speedbar-mouse-set-point e)
 	 (speedbar-do-function-pointer)
 	 (speedbar-quick-mouse e))))
 (defun speedbar-do-function-pointer ()
 "Look under the cursor and examine the text properties.
 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]+\\)\\("
+		     "\\([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."
 	(dest (point)))
 (save-match-data
 (goto-char (point-min))
 ;; scan all the directories
 (while (and path (not (eq path t)))
-	(if (string-match "^/?\\([^/]+\\)" path)
+	(if (string-match "^[/\\]?\\([^/\\]+\\)" path)
 	    (let ((pp (match-string 1 path)))
 	      (if (save-match-data
 		    (re-search-forward (concat "> " (regexp-quote pp) "$")
 				       nil t))
 		  (setq path (substring path (match-end 1)))
 	(concat default-directory path)))))
 (defun speedbar-path-line (path)
 "Position the cursor on the line specified by PATH."
 (save-match-data
-(if (string-match "/$" path)
+(if (string-match "[/\\]$" path)
 	(setq path (substring path 0 (match-beginning 0))))
 (let ((nomatch t) (depth 0)
 	  (fname (file-name-nondirectory path))
 	  (pname (file-name-directory path)))
 (if (not (member pname speedbar-shown-directories))
 			       t)
 	    (speedbar-do-function-pointer)
 	  nil))
 (speedbar-do-function-pointer)))
-(defun speedbar-expand-line ()
+(defun speedbar-expand-line (arg)
-"Expand the line under the cursor."
+"Expand the line under the cursor.
+With universal argument ARG, flush cached data."
+(interactive "P")
+(beginning-of-line)
+(let ((speedbar-power-click arg))
+(condition-case nil
+	(progn
+	  (re-search-forward ":\\s-*.\\+. "
+			     (save-excursion (end-of-line) (point)))
+	  (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)
-(beginning-of-line)
+(speedbar-expand-line 1))
-(re-search-forward ":\\s-*.\\+. " (save-excursion (end-of-line) (point)))
-(forward-char -2)
-(speedbar-do-function-pointer))
 (defun speedbar-contract-line ()
 "Contract the line under the cursor."
 (interactive)
 (beginning-of-line)
-(re-search-forward ":\\s-*.-. " (save-excursion (end-of-line) (point)))
+(condition-case nil
-(forward-char -2)
+(progn
-(speedbar-do-function-pointer))
+	(re-search-forward ":\\s-*.-. "
+			   (save-excursion (end-of-line) (point)))
+	(forward-char -2)
+	(speedbar-do-function-pointer))
+(error (speedbar-position-cursor-on-line))))
 (if speedbar-xemacsp
 (defalias 'speedbar-mouse-event-p 'button-press-event-p)
 (defun speedbar-mouse-event-p (event)
 "Return t if the event is a mouse related event"
 clicked, and TOKEN is the file to expand.  INDENT is the current
 indentation level."
 (cond ((string-match "+" text)	;we have to expand this file
 	 (let* ((fn (expand-file-name (concat (speedbar-line-path indent)
 					      token)))
-		(lst (if speedbar-use-imenu-flag
+		(mode nil)
-			(let ((tim (speedbar-fetch-dynamic-imenu fn)))
+		(lst (speedbar-fetch-dynamic-tags fn)))
-			  (if (eq tim t)
-			      (speedbar-fetch-dynamic-etags fn)
-			    tim))
-		      (speedbar-fetch-dynamic-etags fn))))
 	   ;; if no list, then remove expando button
 	   (if (not lst)
 	       (speedbar-change-expand-button-char ??)
 	     (speedbar-change-expand-button-char ?-)
 	     (speedbar-with-writable
 	       (save-excursion
 		 (end-of-line) (forward-char 1)
-		 (speedbar-insert-generic-list indent
+		 (funcall (car lst) indent (cdr lst)))))))
-					       lst 'speedbar-tag-expand
-					       'speedbar-tag-find))))))
 	((string-match "-" text)	;we have to contract this node
 	 (speedbar-change-expand-button-char ?+)
 	 (speedbar-delete-subblock indent))
 	(t (error "Ooops...  not sure what to do")))
 (speedbar-center-buffer-smartly))
 				   lte 1)))
 	      (recenter newcent))))
 	(goto-char cp)))))
+;;; Tag Management -- List of expanders:
+;;
+(defun speedbar-fetch-dynamic-tags (file)
+"Return a list of tags generated dynamically from FILE.
+This uses the entries in `speedbar-dynamic-tags-function-list'
+to find the proper tags.  It is up to each of those individual
+functions to do caching and flushing if appropriate."
+(save-excursion
+(set-buffer (find-file-noselect file))
+;; If there is a buffer-local value of
+;; speedbar-dynamic-tags-function-list, it will now be available.
+(let ((dtf speedbar-dynamic-tags-function-list)
+	  (ret t))
+(while (and (eq ret t) dtf)
+	(setq ret
+	      (if (fboundp (car (car dtf)))
+		  (funcall (car (car dtf)) (buffer-file-name))
+		t))
+	(if (eq ret t)
+	    (setq dtf (cdr dtf))))
+(if (eq ret t)
+	  ;; No valid tag list, return nil
+	  nil
+	;; We have some tags.  Return the list with the insert fn
+	;; prepended
+	(cons (cdr (car dtf)) ret)))))
 ;;; Tag Management -- Imenu
 ;;
 (if (not speedbar-use-imenu-flag)
 nil
 (defun speedbar-fetch-dynamic-imenu (file)
 "Load FILE into a buffer, and generate tags using Imenu.
 Returns the tag list, or t for an error."
 ;; Load this AND compile it in
 (require 'imenu)
-(save-excursion
+(if speedbar-power-click (setq imenu--index-alist nil))
-(set-buffer (find-file-noselect file))
+(condition-case nil
-(if speedbar-power-click (setq imenu--index-alist nil))
+(let ((index-alist (imenu--make-index-alist t)))
-(condition-case nil
+	(if speedbar-sort-tags
-	(let ((index-alist (imenu--make-index-alist t)))
+	    (sort (copy-alist index-alist)
-	  (if speedbar-sort-tags
+		  (lambda (a b) (string< (car a) (car b))))
-	      (sort (copy-alist index-alist)
+	  index-alist))
-		    (lambda (a b) (string< (car a) (car b))))
+(error t)))
-	    index-alist))
-(error t))))
 )
 ;;; Tag Management -- etags  (old XEmacs compatibility part)
 ;;
 (defvar speedbar-fetch-etags-parse-list
 			 (setq ans (car exprlst)))
 		     (setq exprlst (cdr exprlst)))
 		   (cdr ans))))
 	    (if expr
 		(let (tnl)
+		  (set-buffer (get-buffer-create "*etags tmp*"))
 		  (while (not (save-excursion (end-of-line) (eobp)))
 		    (save-excursion
 		      (setq tnl (speedbar-extract-one-symbol expr)))
 		    (if tnl (setq newlist (cons tnl newlist)))
 		    (forward-line 1)))
 ;; 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-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]+: *.\\+. "))]
+["Flush Cache & Expand" speedbar-flush-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]+: *.-. "))]
+["Kill Buffer" speedbar-buffer-kill-buffer
+(save-excursion (beginning-of-line)
+		     (looking-at "[0-9]+: *.-. "))]
+["Revert Buffer" speedbar-buffer-revert-buffer
 (save-excursion (beginning-of-line)
 		     (looking-at "[0-9]+: *.-. "))]
 )
 "Menu item elements shown when displaying a buffer list.")
 				    (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
+	  (speedbar-make-tag-line 'bracket expchar fn
+				  (if fname (file-name-nondirectory fname))
 				  (buffer-name (car bl))
 				  'speedbar-buffer-click temp
 				  'speedbar-file-face 0)))
 (setq bl (cdr bl)))
 (setq bl (buffer-list))
 	  (if (get-buffer text)
 	      (progn
 		(set-buffer text)
 		(revert-buffer t)))))))
-;;; Color loading section  This is messy *Blech!*
+;;; Useful hook values and such.
+;;
+(defvar speedbar-highlight-one-tag-line nil
+"Overlay used for highlighting the most recently jumped to tag line.")
+(defun speedbar-highlight-one-tag-line ()
+"Highlight the current line, unhighlighting a previously jumped to line."
+(speedbar-unhighlight-one-tag-line)
+(setq speedbar-highlight-one-tag-line
+	(speedbar-make-overlay (save-excursion (beginning-of-line) (point))
+			       (save-excursion (end-of-line)
+					       (forward-char 1)
+					       (point))))
+(speedbar-overlay-put speedbar-highlight-one-tag-line 'face
+			'speedbar-highlight-face)
+(add-hook 'pre-command-hook 'speedbar-unhighlight-one-tag-line)
+)
+(defun speedbar-unhighlight-one-tag-line ()
+"Unhighlight the currently highlight line."
+(if speedbar-highlight-one-tag-line
+(progn
+	(speedbar-delete-overlay speedbar-highlight-one-tag-line)
+	(setq speedbar-highlight-one-tag-line nil)))
+(remove-hook 'pre-command-hook 'speedbar-unhighlight-one-tag-line))
+(defun speedbar-recenter-to-top ()
+"Recenter the current buffer so POINT is on the top of the window."
+(recenter 1))
+(defun speedbar-recenter ()
+"Recenter the current buffer so POINT is in the center of the window."
+(recenter (window-hight (/ (selected-window) 2))))
+;;; Color loading section.
 ;;
 (defface speedbar-button-face '((((class color) (background light))
 				 (:foreground "green4"))
 				(((class color) (background dark))
 				 (:foreground "green3")))
 				     (background dark))
 				    (:background "white")))
 "Face used for highlighting buttons with the mouse."
 :group 'speedbar-faces)
+;;; Image loading and inlining
+;;
+;;; Some images if defimage is available:
+(eval-when-compile
+(if (fboundp 'defimage)
+(defalias 'defimage-speedbar 'defimage)
+(if (not (fboundp 'make-glyph))
+(defmacro defimage-speedbar (variable imagespec docstring)
+"Don't bother loading up an image...
+Argument VARIABLE is the varible to define.
+Argument IMAGESPEC is the list defining the image to create.
+Argument DOCSTRING is the documentation for VARIABLE."
+`(defvar ,variable nil ,docstring))
+;; ELSE
+(defun speedbar-find-image-on-load-path (image)
+"Find the image file IMAGE on the load path."
+(let ((l load-path)
+	(r nil))
+(while (and l (not r))
+(if (file-exists-p (concat (car l) "/" image))
+	  (setq r (concat (car l) "/" image)))
+(setq l (cdr l)))
+r))
+(defun speedbar-convert-emacs21-imagespec-to-xemacs (spec)
+"Convert the Emacs21 Image SPEC into an XEmacs image spec."
+(let* ((sl (car spec))
+	 (itype (nth 1 sl))
+	 (ifile (nth 3 sl)))
+(vector itype ':file (speedbar-find-image-on-load-path ifile))))
+(defmacro defimage-speedbar (variable imagespec docstring)
+"Devine VARIABLE as an image if `defimage' is not available..
+IMAGESPEC is the image data, and DOCSTRING is documentation for the image."
+`(defvar ,variable
+;; The Emacs21 version of defimage looks just like the XEmacs image
+;; specifier, except that it needs a :type keyword.  If we line
+;; stuff up right, we can use this cheat to support XEmacs specifiers.
+(condition-case nil
+	 (make-glyph
+	  (make-image-specifier
+	   (speedbar-convert-emacs21-imagespec-to-xemacs (quote ,imagespec)))
+	  'buffer)
+(error nil))
+,docstring))
+)))
+(defimage-speedbar speedbar-directory-+
+((:type xpm :file "sb-dir+.xpm" :ascent center))
+"Image used for closed directories with stuff in them.")
+(defimage-speedbar speedbar-directory--
+((:type xpm :file "sb-dir-.xpm" :ascent center))
+"Image used for open directories with stuff in them.")
+(defimage-speedbar speedbar-file-+
+((:type xpm :file "sb-file+.xpm" :ascent center))
+"Image used for closed files with stuff in them.")
+(defimage-speedbar speedbar-file--
+((:type xpm :file "sb-file-.xpm" :ascent center))
+"Image used for open files with stuff in them.")
+(defimage-speedbar speedbar-file-
+((:type xpm :file "sb-file.xpm" :ascent center))
+"Image used for files that can't be opened.")
+(defimage-speedbar speedbar-tag-
+((:type xpm :file "sb-tag.xpm" :ascent center))
+"Image used for tags.")
+(defimage-speedbar speedbar-tag-+
+((:type xpm :file "sb-tag+.xpm" :ascent center))
+"Image used for closed tag groups.")
+(defimage-speedbar speedbar-tag--
+((:type xpm :file "sb-tag-.xpm" :ascent center))
+"Image used for open tag groups.")
+(defimage-speedbar speedbar-tag-gt
+((:type xpm :file "sb-tag-gt.xpm" :ascent center))
+"Image used for open tag groups.")
+(defimage-speedbar speedbar-tag-v
+((:type xpm :file "sb-tag-v.xpm" :ascent center))
+"Image used for open tag groups.")
+(defimage-speedbar speedbar-tag-type
+((:type xpm :file "sb-tag-type.xpm" :ascent center))
+"Image used for open tag groups.")
+(defimage-speedbar speedbar-mail
+((:type xpm :file "sb-mail.xpm" :ascent center))
+"Image used for open tag groups.")
+(defvar speedbar-expand-image-button-alist
+'(("<+>" . speedbar-directory-+)
+("<->" . speedbar-directory--)
+("[+]" . speedbar-file-+)
+("[-]" . speedbar-file--)
+("[?]" . speedbar-file-)
+("{+}" . speedbar-tag-+)
+("{-}" . speedbar-tag--)
+("<M>" . speedbar-mail)
+(" =>" . speedbar-tag-)
+(" +>" . speedbar-tag-gt)
+(" ->" . speedbar-tag-v)
+(">" . speedbar-tag-)
+("@" . speedbar-tag-type)
+("  @" . speedbar-tag-type)
+)
+"List of text and image associations.")
+(defun speedbar-insert-image-button-maybe (start length)
+"Insert an image button based on text starting at START for LENGTH chars.
+If buttontext is unknown, just insert that text.
+If we have an image associated with it, use that image."
+(if speedbar-use-images
+(let* ((bt (buffer-substring start (+ length start)))
+	     (a (assoc bt speedbar-expand-image-button-alist)))
+	;; Regular images (created with `insert-image' are intangible
+	;; which (I suppose) make them more compatible with XEmacs 21.
+	;; Unfortunatly, there is a giant pile o code dependent on the
+	;; underlying text.  This means if we leave it tangible, then I
+	;; don't have to change said giant piles o code.
+	(if (and a (symbol-value (cdr a)))
+	    (if (fboundp 'set-extent-property)
+		(add-text-properties (+ start (length bt)) start
+				     (list 'end-glyph (symbol-value (cdr a))
+					   'rear-nonsticky (list 'display)
+					   'invisible t
+					   'detachable t))
+	      (add-text-properties start (+ start (length bt))
+				   (list 'display (symbol-value (cdr a))
+					 'rear-nonsticky (list 'display))))
+	  ;(message "Bad text [%s]" (buffer-substring start (+ start length)))
+	  ))))
 ;; some edebug hooks
 (add-hook 'edebug-setup-hook
 	  (lambda ()
 	    (def-edebug-spec speedbar-with-writable def-body)))

Mercurial > emacs

comparison lisp/speedbar.el @ 28902:5292e9f1f2ca