aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorEric M. Ludlam2000-05-13 23:13:25 +0000
committerEric M. Ludlam2000-05-13 23:13:25 +0000
commite4a1da3c64ca39da7a739729b45ce4d963e79fab (patch)
tree3b60f186c3a5160b11b19033add46111cfb46278
parent771c9b9735e1437fd073aab706e7ac08ea496a7d (diff)
downloademacs-e4a1da3c64ca39da7a739729b45ce4d963e79fab.tar.gz
emacs-e4a1da3c64ca39da7a739729b45ce4d963e79fab.zip
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.
-rw-r--r--lisp/speedbar.el1006
1 files changed, 685 insertions, 321 deletions
diff --git a/lisp/speedbar.el b/lisp/speedbar.el
index b1293552140..2bd71901c9e 100644
--- a/lisp/speedbar.el
+++ b/lisp/speedbar.el
@@ -1,9 +1,9 @@
1;;; speedbar --- quick access to files and tags in a frame 1;;; speedbar --- quick access to files and tags in a frame
2 2
3;;; Copyright (C) 1996, 97, 98, 99 Free Software Foundation 3;;; Copyright (C) 1996, 97, 98, 99, 00 Free Software Foundation
4 4
5;; Author: Eric M. Ludlam <zappo@gnu.org> 5;; Author: Eric M. Ludlam <zappo@gnu.org>
6;; Version: 0.8.1 6;; Version: 0.11
7;; Keywords: file, tags, tools 7;; Keywords: file, tags, tools
8 8
9;; This file is part of GNU Emacs. 9;; This file is part of GNU Emacs.
@@ -95,6 +95,8 @@
95;; AUC-TEX users: The imenu tags for AUC-TEX mode don't work very 95;; AUC-TEX users: The imenu tags for AUC-TEX mode don't work very
96;; well. Use the imenu keywords from tex-mode.el for better results. 96;; well. Use the imenu keywords from tex-mode.el for better results.
97;; 97;;
98;; This file requires the library package assoc (association lists)
99;;
98;;; Developing for speedbar 100;;; Developing for speedbar
99;; 101;;
100;; Adding a speedbar specialized display mode: 102;; Adding a speedbar specialized display mode:
@@ -167,16 +169,18 @@
167;;; TODO: 169;;; TODO:
168;; - More functions to create buttons and options 170;; - More functions to create buttons and options
169;; - Timeout directories we haven't visited in a while. 171;; - Timeout directories we haven't visited in a while.
170;; - Remeber tags when refreshing the display. (Refresh tags too?)
171;; - More 'special mode support.
172 172
173(require 'assoc) 173(require 'assoc)
174(require 'easymenu) 174(require 'easymenu)
175 175
176(condition-case nil
177 (require 'image)
178 (error nil))
179
176(defvar speedbar-xemacsp (string-match "XEmacs" emacs-version) 180(defvar speedbar-xemacsp (string-match "XEmacs" emacs-version)
177 "Non-nil if we are running in the XEmacs environment.") 181 "Non-nil if we are running in the XEmacs environment.")
178(defvar speedbar-xemacs20p (and speedbar-xemacsp 182(defvar speedbar-xemacs20p (and speedbar-xemacsp
179 (= emacs-major-version 20))) 183 (>= emacs-major-version 20)))
180 184
181;; customization stuff 185;; customization stuff
182(defgroup speedbar nil 186(defgroup speedbar nil
@@ -290,16 +294,25 @@ effective when it's display is shown.")
290 :group 'speedbar 294 :group 'speedbar
291 :type 'hook) 295 :type 'hook)
292 296
293(defcustom speedbar-visiting-tag-hook nil 297(defcustom speedbar-visiting-tag-hook '(speedbar-highlight-one-tag-line)
294 "Hooks run when speedbar visits a tag in the selected frame." 298 "Hooks run when speedbar visits a tag in the selected frame."
295 :group 'speedbar 299 :group 'speedbar
296 :type 'hook) 300 :type 'hook
301 :options '(speedbar-highlight-one-tag-line
302 speedbar-recenter-to-top
303 speedbar-recenter
304 ))
297 305
298(defcustom speedbar-load-hook nil 306(defcustom speedbar-load-hook nil
299 "Hooks run when speedbar is loaded." 307 "Hooks run when speedbar is loaded."
300 :group 'speedbar 308 :group 'speedbar
301 :type 'hook) 309 :type 'hook)
302 310
311(defcustom speedbar-reconfigure-keymaps-hook nil
312 "Hooks run when the keymaps are regenerated."
313 :group 'speedbar
314 :type 'hook)
315
303(defcustom speedbar-show-unknown-files nil 316(defcustom speedbar-show-unknown-files nil
304 "*Non-nil show files we can't expand with a ? in the expand button. 317 "*Non-nil show files we can't expand with a ? in the expand button.
305nil means don't show the file in the list." 318nil means don't show the file in the list."
@@ -334,9 +347,9 @@ between different directories."
334 (menu-bar-lines . 0) 347 (menu-bar-lines . 0)
335 (unsplittable . t)) 348 (unsplittable . t))
336 "*Parameters to use when creating the speedbar frame in Emacs. 349 "*Parameters to use when creating the speedbar frame in Emacs.
337Parameters not listed here which will be added automatically are 350Any parameter supported by a frame may be added. The parameter `height'
338`height' which will be initialized to the height of the frame speedbar 351will be initialized to the height of the frame speedbar is
339is attached to." 352attached to and added to this list before the new frame is initialized."
340 :group 'speedbar 353 :group 'speedbar
341 :type '(repeat (sexp :tag "Parameter:"))) 354 :type '(repeat (sexp :tag "Parameter:")))
342 355
@@ -359,10 +372,22 @@ is attached to."
359 "*Non-nil means use imenu for file parsing. nil to use etags. 372 "*Non-nil means use imenu for file parsing. nil to use etags.
360XEmacs prior to 20.4 doesn't support imenu, therefore the default is to 373XEmacs prior to 20.4 doesn't support imenu, therefore the default is to
361use etags instead. Etags support is not as robust as imenu support." 374use etags instead. Etags support is not as robust as imenu support."
362 :tag "User Imenu" 375 :tag "Use Imenu for tags"
363 :group 'speedbar 376 :group 'speedbar
364 :type 'boolean) 377 :type 'boolean)
365 378
379(defvar speedbar-dynamic-tags-function-list
380 '((speedbar-fetch-dynamic-imenu . speedbar-insert-imenu-list)
381 (speedbar-fetch-dynamic-etags . speedbar-insert-etags-list))
382 "Set to a functions which will return and insert a list of tags.
383Each element is of the form ( FETCH . INSERT ) where FETCH
384is a funciotn which takes one parameter (the file to tag) and returns a
385list of tags. The tag list can be of any form as long as the
386corresponding insert method can handle it. If it returns t, then an
387error occured, and the next fetch routine is tried.
388INSERT is a function which takes an INDENTation level, and a LIST of
389tags to insert. It will then create the speedbar buttons.")
390
366(defcustom speedbar-track-mouse-flag t 391(defcustom speedbar-track-mouse-flag t
367 "*Non-nil means to display info about the line under the mouse." 392 "*Non-nil means to display info about the line under the mouse."
368 :group 'speedbar 393 :group 'speedbar
@@ -374,24 +399,26 @@ use etags instead. Etags support is not as robust as imenu support."
374 :type 'boolean) 399 :type 'boolean)
375 400
376(defcustom speedbar-tag-hierarchy-method 401(defcustom speedbar-tag-hierarchy-method
377 '(prefix-group trim-words) 402 '(speedbar-prefix-group-tag-hierarchy
378 "*List of methods which speedbar will use to organize tags into groups. 403 speedbar-trim-words-tag-hierarchy)
379Groups are defined as expandable meta-tags. Imenu supports such 404 "*List of hooks which speedbar will use to organize tags into groups.
380things in some languages, such as separating variables from functions. 405Groups are defined as expandable meta-tags. Imenu supports
381Available methods are: 406such things in some languages, such as separating variables from
382 sort - Sort tags. (sometimes unnecessary) 407functions. Each hook takes one argument LST, and may destructivly
383 trim-words - Trim all tags by a common prefix, broken @ word sections. 408create a new list of the same form. LST is a list of elements of the
384 prefix-group - Try to guess groups by prefix. 409form:
385 simple-group - If imenu already returned some meta groups, stick all 410 (ELT1 ELT2 ... ELTn)
386 tags that are not in a group into a sub-group." 411where each ELT is of the form
412 (TAG-NAME-STRING . NUMBER-OR-MARKER)
413or
414 (GROUP-NAME-STRING ELT1 EL2... ELTn)"
387 :group 'speedbar 415 :group 'speedbar
388 :type '(repeat 416 :type 'hook
389 (radio 417 :options '(speedbar-sort-tag-hierarchy
390 (const :tag "Sort the tags." sort) 418 speedbar-trim-words-tag-hierarchy
391 (const :tag "Trim words to common prefix." trim-words) 419 speedbar-prefix-group-tag-hierarchy
392 (const :tag "Create groups from common prefixes." prefix-group) 420 speedbar-simple-group-tag-hierarchy)
393 (const :tag "Group loose tags into their own group." simple-group)) 421 )
394 ))
395 422
396(defcustom speedbar-tag-group-name-minimum-length 4 423(defcustom speedbar-tag-group-name-minimum-length 4
397 "*The minimum length of a prefix group name before expanding. 424 "*The minimum length of a prefix group name before expanding.
@@ -450,8 +477,22 @@ hierarchy would be replaced with the new directory."
450 :group 'speedbar 477 :group 'speedbar
451 :type 'boolean) 478 :type 'boolean)
452 479
453(defvar speedbar-hide-button-brackets-flag nil 480(defcustom speedbar-indentation-width 1
454 "*Non-nil means speedbar will hide the brackets around the + or -.") 481 "*When sub-nodes are expanded, the number of spaces used for indentation."
482 :group 'speedbar
483 :type 'integer)
484
485(defcustom speedbar-hide-button-brackets-flag nil
486 "*Non-nil means speedbar will hide the brackets around the + or -."
487 :group 'speedbar
488 :type 'boolean)
489
490(defcustom speedbar-use-images (and (or (fboundp 'defimage)
491 (fboundp 'make-image-specifier))
492 window-system)
493 "*Non nil if speedbar should display icons."
494 :group 'speedbar
495 :type 'boolean)
455 496
456(defcustom speedbar-before-popup-hook nil 497(defcustom speedbar-before-popup-hook nil
457 "*Hooks called before popping up the speedbar frame." 498 "*Hooks called before popping up the speedbar frame."
@@ -491,9 +532,8 @@ Any file checked out is marked with `speedbar-vc-indicator'"
491 532
492(defvar speedbar-vc-indicator "*" 533(defvar speedbar-vc-indicator "*"
493 "Text used to mark files which are currently checked out. 534 "Text used to mark files which are currently checked out.
494Currently only RCS is supported. Other version control systems can be 535Other version control systems can be added by examining the function
495added by examining the function `speedbar-this-file-in-vc' and 536`speedbar-vc-path-enable-hook' and `speedbar-vc-in-control-hook'.")
496`speedbar-vc-check-dir-p'")
497 537
498(defcustom speedbar-vc-path-enable-hook nil 538(defcustom speedbar-vc-path-enable-hook nil
499 "*Return non-nil if the current path should be checked for Version Control. 539 "*Return non-nil if the current path should be checked for Version Control.
@@ -585,7 +625,7 @@ Use the function `speedbar-add-ignored-path-regexp', or customize the
585variable `speedbar-ignored-path-expressions' to modify this variable.") 625variable `speedbar-ignored-path-expressions' to modify this variable.")
586 626
587(defcustom speedbar-ignored-path-expressions 627(defcustom speedbar-ignored-path-expressions
588 '("/logs?/\\'") 628 '("[/\\]logs?[/\\]\\'")
589 "*List of regular expressions matching directories speedbar will ignore. 629 "*List of regular expressions matching directories speedbar will ignore.
590They should included paths to directories which are notoriously very 630They should included paths to directories which are notoriously very
591large and take a long time to load in. Use the function 631large and take a long time to load in. Use the function
@@ -623,11 +663,11 @@ It is generated from the variable `completion-ignored-extensions'")
623 (append '(".[ch]\\(\\+\\+\\|pp\\|c\\|h\\|xx\\)?" ".tex\\(i\\(nfo\\)?\\)?" 663 (append '(".[ch]\\(\\+\\+\\|pp\\|c\\|h\\|xx\\)?" ".tex\\(i\\(nfo\\)?\\)?"
624 ".el" ".emacs" ".l" ".lsp" ".p" ".java" ".f\\(90\\|77\\|or\\)?") 664 ".el" ".emacs" ".l" ".lsp" ".p" ".java" ".f\\(90\\|77\\|or\\)?")
625 (if speedbar-use-imenu-flag 665 (if speedbar-use-imenu-flag
626 '(".ada" ".pl" ".tcl" ".m" ".scm" ".pm" ".py" 666 '(".ada" ".p[lm]" ".tcl" ".m" ".scm" ".pm" ".py"
627 ;; html is not supported by default, but an imenu tags package 667 ;; html is not supported by default, but an imenu tags package
628 ;; is available. Also, html files are nice to be able to see. 668 ;; is available. Also, html files are nice to be able to see.
629 ".s?html" 669 ".s?html"
630 "Makefile\\(\\.in\\)?"))) 670 "[Mm]akefile\\(\\.in\\)?")))
631 "*List of regular expressions which will match files supported by tagging. 671 "*List of regular expressions which will match files supported by tagging.
632Do not prefix the `.' char with a double \\ to quote it, as the period 672Do not prefix the `.' char with a double \\ to quote it, as the period
633will be stripped by a simplified optimizer when compiled into a 673will be stripped by a simplified optimizer when compiled into a
@@ -713,6 +753,8 @@ to toggle this value.")
713 (modify-syntax-entry ?\" " " speedbar-syntax-table) 753 (modify-syntax-entry ?\" " " speedbar-syntax-table)
714 (modify-syntax-entry ?( " " speedbar-syntax-table) 754 (modify-syntax-entry ?( " " speedbar-syntax-table)
715 (modify-syntax-entry ?) " " speedbar-syntax-table) 755 (modify-syntax-entry ?) " " speedbar-syntax-table)
756 (modify-syntax-entry ?{ " " speedbar-syntax-table)
757 (modify-syntax-entry ?} " " speedbar-syntax-table)
716 (modify-syntax-entry ?[ " " speedbar-syntax-table) 758 (modify-syntax-entry ?[ " " speedbar-syntax-table)
717 (modify-syntax-entry ?] " " speedbar-syntax-table)) 759 (modify-syntax-entry ?] " " speedbar-syntax-table))
718 760
@@ -812,6 +854,7 @@ This basically creates a sparse keymap, and makes it's parent be
812 (define-key speedbar-file-key-map "e" 'speedbar-edit-line) 854 (define-key speedbar-file-key-map "e" 'speedbar-edit-line)
813 (define-key speedbar-file-key-map "\C-m" 'speedbar-edit-line) 855 (define-key speedbar-file-key-map "\C-m" 'speedbar-edit-line)
814 (define-key speedbar-file-key-map "+" 'speedbar-expand-line) 856 (define-key speedbar-file-key-map "+" 'speedbar-expand-line)
857 (define-key speedbar-file-key-map "=" 'speedbar-expand-line)
815 (define-key speedbar-file-key-map "-" 'speedbar-contract-line) 858 (define-key speedbar-file-key-map "-" 'speedbar-contract-line)
816 859
817 ;; file based commands 860 ;; file based commands
@@ -826,10 +869,15 @@ This basically creates a sparse keymap, and makes it's parent be
826 ) 869 )
827 870
828(defvar speedbar-easymenu-definition-base 871(defvar speedbar-easymenu-definition-base
829 '("Speedbar" 872 `("Speedbar"
830 ["Update" speedbar-refresh t] 873 ["Update" speedbar-refresh t]
831 ["Auto Update" speedbar-toggle-updates 874 ["Auto Update" speedbar-toggle-updates
832 :style toggle :selected speedbar-update-flag] 875 :style toggle :selected speedbar-update-flag]
876 ,(if (and (or (fboundp 'defimage)
877 (fboundp 'make-image-specifier))
878 window-system)
879 ["Use Images" speedbar-toggle-images
880 :style toggle :selected speedbar-use-images])
833 ) 881 )
834 "Base part of the speedbar menu.") 882 "Base part of the speedbar menu.")
835 883
@@ -840,6 +888,9 @@ This basically creates a sparse keymap, and makes it's parent be
840 ["Expand File Tags" speedbar-expand-line 888 ["Expand File Tags" speedbar-expand-line
841 (save-excursion (beginning-of-line) 889 (save-excursion (beginning-of-line)
842 (looking-at "[0-9]+: *.\\+. "))] 890 (looking-at "[0-9]+: *.\\+. "))]
891 ["Flush Cache & Expand" speedbar-flush-expand-line
892 (save-excursion (beginning-of-line)
893 (looking-at "[0-9]+: *.\\+. "))]
843 ["Contract File Tags" speedbar-contract-line 894 ["Contract File Tags" speedbar-contract-line
844 (save-excursion (beginning-of-line) 895 (save-excursion (beginning-of-line)
845 (looking-at "[0-9]+: *.-. "))] 896 (looking-at "[0-9]+: *.-. "))]
@@ -919,6 +970,21 @@ directories.")
919 (defun speedbar-frame-parameter (frame parameter) 970 (defun speedbar-frame-parameter (frame parameter)
920 "Return FRAME's PARAMETER value." 971 "Return FRAME's PARAMETER value."
921 (cdr (assoc parameter (frame-parameters frame))))) 972 (cdr (assoc parameter (frame-parameters frame)))))
973
974(if (fboundp 'make-overlay)
975 (progn
976 (defalias 'speedbar-make-overlay 'make-overlay)
977 (defalias 'speedbar-overlay-put 'overlay-put)
978 (defalias 'speedbar-delete-overlay 'delete-overlay)
979 (defalias 'speedbar-overlay-start 'overlay-start)
980 (defalias 'speedbar-overlay-end 'overlay-end)
981 (defalias 'speedbar-mode-line-update 'force-mode-line-update))
982 (defalias 'speedbar-make-overlay 'make-extent)
983 (defalias 'speedbar-overlay-put 'set-extent-property)
984 (defalias 'speedbar-delete-overlay 'delete-extent)
985 (defalias 'speedbar-overlay-start 'extent-start)
986 (defalias 'speedbar-overlay-end 'extent-end)
987 (defalias 'speedbar-mode-line-update 'redraw-modeline))
922 988
923;;; Mode definitions/ user commands 989;;; Mode definitions/ user commands
924;; 990;;
@@ -1191,7 +1257,7 @@ in the selected file.
1191 (speedbar-quick-mouse event)) 1257 (speedbar-quick-mouse event))
1192 ((or (eq count 2) 1258 ((or (eq count 2)
1193 (eq count 3)) 1259 (eq count 3))
1194 (mouse-set-point event) 1260 (speedbar-mouse-set-point event)
1195 (speedbar-do-function-pointer) 1261 (speedbar-do-function-pointer)
1196 (speedbar-quick-mouse event))) 1262 (speedbar-quick-mouse event)))
1197 ;; Don't do normal operations. 1263 ;; Don't do normal operations.
@@ -1283,7 +1349,7 @@ frame and window to be the currently active frame and window."
1283 (if (not (equal mode-line-format tf)) 1349 (if (not (equal mode-line-format tf))
1284 (progn 1350 (progn
1285 (setq mode-line-format tf) 1351 (setq mode-line-format tf)
1286 (force-mode-line-update))))))) 1352 (speedbar-mode-line-update)))))))
1287 1353
1288(defun speedbar-temp-buffer-show-function (buffer) 1354(defun speedbar-temp-buffer-show-function (buffer)
1289 "Placed in the variable `temp-buffer-show-function' in `speedbar-mode'. 1355 "Placed in the variable `temp-buffer-show-function' in `speedbar-mode'.
@@ -1364,7 +1430,8 @@ and the existence of packages."
1364 (easy-menu-define speedbar-menu-map (current-local-map) 1430 (easy-menu-define speedbar-menu-map (current-local-map)
1365 "Speedbar menu" md) 1431 "Speedbar menu" md)
1366 (easy-menu-add md (current-local-map)) 1432 (easy-menu-add md (current-local-map))
1367 (set-buffer-menubar (list md)))))) 1433 (set-buffer-menubar (list md))))
1434 (run-hooks 'speedbar-reconfigure-keymaps-hook)))
1368 1435
1369 1436
1370;;; User Input stuff 1437;;; User Input stuff
@@ -1681,24 +1748,45 @@ it from the speedbar buffer."
1681nil if not applicable." 1748nil if not applicable."
1682 (save-excursion 1749 (save-excursion
1683 (beginning-of-line) 1750 (beginning-of-line)
1684 (if (re-search-forward " > \\([^ ]+\\)$" 1751 (if (re-search-forward " [-+=]?> \\([^\n]+\\)"
1685 (save-excursion(end-of-line)(point)) t) 1752 (save-excursion(end-of-line)(point)) t)
1686 (let ((tag (match-string 1)) 1753 (let ((tag (match-string 1))
1687 (attr (get-text-property (match-beginning 1) 1754 (attr (speedbar-line-token))
1688 'speedbar-token))
1689 (item nil)) 1755 (item nil))
1690 (looking-at "\\([0-9]+\\):") 1756 (if (and (featurep 'semantic) (semantic-token-p attr))
1691 (setq item (speedbar-line-path (string-to-int (match-string 1)))) 1757 (speedbar-message (semantic-summerize-nonterminal attr))
1692 (speedbar-message "Tag: %s in %s @ %s" 1758 (looking-at "\\([0-9]+\\):")
1693 tag item (if attr 1759 (setq item (file-name-nondirectory (speedbar-line-path)))
1694 (if (markerp attr) 1760 (speedbar-message "Tag: %s in %s" tag item)))
1695 (marker-position attr)
1696 attr)
1697 0)))
1698 (if (re-search-forward "{[+-]} \\([^\n]+\\)$" 1761 (if (re-search-forward "{[+-]} \\([^\n]+\\)$"
1699 (save-excursion(end-of-line)(point)) t) 1762 (save-excursion(end-of-line)(point)) t)
1700 (speedbar-message "Group of tags \"%s\"" (match-string 1)) 1763 (speedbar-message "Group of tags \"%s\"" (match-string 1))
1701 nil)))) 1764 (if (re-search-forward " [+-]?[()|@] \\([^\n]+\\)$" nil t)
1765 (let* ((detailtext (match-string 1))
1766 (detail (or (speedbar-line-token) detailtext))
1767 (parent (save-excursion
1768 (beginning-of-line)
1769 (let ((dep (if (looking-at "[0-9]+:")
1770 (1- (string-to-int (match-string 0)))
1771 0)))
1772 (re-search-backward (concat "^"
1773 (int-to-string dep)
1774 ":")
1775 nil t))
1776 (if (looking-at "[0-9]+: +[-+=>]> \\([^\n]+\\)$")
1777 (speedbar-line-token)
1778 nil))))
1779 (if (and (featurep 'semantic) (semantic-token-p detail))
1780 (speedbar-message
1781 (semantic-summerize-nonterminal detail parent))
1782 (if parent
1783 (speedbar-message "Detail: %s of tag %s" detail
1784 (if (and (featurep 'semantic)
1785 (semantic-token-p parent))
1786 (semantic-token-name parent)
1787 parent))
1788 (speedbar-message "Detail: %s" detail))))
1789 nil)))))
1702 1790
1703(defun speedbar-files-item-info () 1791(defun speedbar-files-item-info ()
1704 "Display info in the mini-buffer about the button the mouse is over." 1792 "Display info in the mini-buffer about the button the mouse is over."
@@ -1725,7 +1813,7 @@ Files can be copied to new names or places."
1725 (if (file-directory-p rt) 1813 (if (file-directory-p rt)
1726 (setq rt 1814 (setq rt
1727 (concat (expand-file-name rt) 1815 (concat (expand-file-name rt)
1728 (if (string-match "/$" rt) "" "/") 1816 (if (string-match "[/\\]$" rt) "" "/")
1729 (file-name-nondirectory f)))) 1817 (file-name-nondirectory f))))
1730 (if (or (not (file-exists-p rt)) 1818 (if (or (not (file-exists-p rt))
1731 (speedbar-y-or-n-p (format "Overwrite %s with %s? " rt f))) 1819 (speedbar-y-or-n-p (format "Overwrite %s with %s? " rt f)))
@@ -1754,7 +1842,7 @@ Files can be renamed to new names or moved to new directories."
1754 (if (file-directory-p rt) 1842 (if (file-directory-p rt)
1755 (setq rt 1843 (setq rt
1756 (concat (expand-file-name rt) 1844 (concat (expand-file-name rt)
1757 (if (string-match "/\\'" rt) "" "/") 1845 (if (string-match "[/\\]\\'" rt) "" "/")
1758 (file-name-nondirectory f)))) 1846 (file-name-nondirectory f))))
1759 (if (or (not (file-exists-p rt)) 1847 (if (or (not (file-exists-p rt))
1760 (speedbar-y-or-n-p (format "Overwrite %s with %s? " rt f))) 1848 (speedbar-y-or-n-p (format "Overwrite %s with %s? " rt f)))
@@ -1824,6 +1912,12 @@ variable `speedbar-obj-alist'."
1824 (speedbar-disable-update) 1912 (speedbar-disable-update)
1825 (speedbar-enable-update))) 1913 (speedbar-enable-update)))
1826 1914
1915(defun speedbar-toggle-images ()
1916 "Toggle automatic update for the speedbar frame."
1917 (interactive)
1918 (setq speedbar-use-images (not speedbar-use-images))
1919 (speedbar-refresh))
1920
1827(defun speedbar-toggle-sorting () 1921(defun speedbar-toggle-sorting ()
1828 "Toggle automatic update for the speedbar frame." 1922 "Toggle automatic update for the speedbar frame."
1829 (interactive) 1923 (interactive)
@@ -1934,6 +2028,9 @@ will be run with the TOKEN parameter (any Lisp object)"
1934 (put-text-property start end 'invisible nil) 2028 (put-text-property start end 'invisible nil)
1935 (if function (put-text-property start end 'speedbar-function function)) 2029 (if function (put-text-property start end 'speedbar-function function))
1936 (if token (put-text-property start end 'speedbar-token token)) 2030 (if token (put-text-property start end 'speedbar-token token))
2031 ;; So far the only text we have is less that 3 chars.
2032 (if (<= (- end start) 3)
2033 (speedbar-insert-image-button-maybe start (- end start)))
1937 ) 2034 )
1938 2035
1939;;; Initial Expansion list management 2036;;; Initial Expansion list management
@@ -2094,24 +2191,24 @@ the file-system"
2094Each directory path part is a different button. If part of the path 2191Each directory path part is a different button. If part of the path
2095matches the user directory ~, then it is replaced with a ~. 2192matches the user directory ~, then it is replaced with a ~.
2096INDEX is not used, but is required by the caller." 2193INDEX is not used, but is required by the caller."
2097 (let* ((tilde (expand-file-name "~")) 2194 (let* ((tilde (expand-file-name "~/"))
2098 (dd (expand-file-name directory)) 2195 (dd (expand-file-name directory))
2099 (junk (string-match (regexp-quote tilde) dd)) 2196 (junk (string-match (regexp-quote tilde) dd))
2100 (displayme (if junk 2197 (displayme (if junk
2101 (concat "~" (substring dd (match-end 0))) 2198 (concat "~/" (substring dd (match-end 0)))
2102 dd)) 2199 dd))
2103 (p (point))) 2200 (p (point)))
2104 (if (string-match "^~/?\\'" displayme) (setq displayme (concat tilde "/"))) 2201 (if (string-match "^~[/\\]?\\'" displayme) (setq displayme tilde))
2105 (insert displayme) 2202 (insert displayme)
2106 (save-excursion 2203 (save-excursion
2107 (goto-char p) 2204 (goto-char p)
2108 (while (re-search-forward "\\([^/]+\\)/" nil t) 2205 (while (re-search-forward "\\([^/\\]+\\)[/\\]" nil t)
2109 (speedbar-make-button (match-beginning 1) (match-end 1) 2206 (speedbar-make-button (match-beginning 1) (match-end 1)
2110 'speedbar-directory-face 2207 'speedbar-directory-face
2111 'speedbar-highlight-face 2208 'speedbar-highlight-face
2112 'speedbar-directory-buttons-follow 2209 'speedbar-directory-buttons-follow
2113 (if (and (= (match-beginning 1) p) 2210 (if (and (= (match-beginning 1) p)
2114 (not (char-equal (char-after (+ p 1)) ?:))) 2211 (not (char-equal (char-after (+ p 1)) ?:)))
2115 (expand-file-name "~/") ;the tilde 2212 (expand-file-name "~/") ;the tilde
2116 (buffer-substring-no-properties 2213 (buffer-substring-no-properties
2117 p (match-end 0))))) 2214 p (match-end 0)))))
@@ -2121,14 +2218,14 @@ INDEX is not used, but is required by the caller."
2121 (let ((ww (or (speedbar-frame-width) 20))) 2218 (let ((ww (or (speedbar-frame-width) 20)))
2122 (move-to-column ww nil) 2219 (move-to-column ww nil)
2123 (while (>= (current-column) ww) 2220 (while (>= (current-column) ww)
2124 (re-search-backward "/" nil t) 2221 (re-search-backward "[/\\]" nil t)
2125 (if (<= (current-column) 2) 2222 (if (<= (current-column) 2)
2126 (progn 2223 (progn
2127 (re-search-forward "/" nil t) 2224 (re-search-forward "[/\\]" nil t)
2128 (if (< (current-column) 4) 2225 (if (< (current-column) 4)
2129 (re-search-forward "/" nil t)) 2226 (re-search-forward "[/\\]" nil t))
2130 (forward-char -1))) 2227 (forward-char -1)))
2131 (if (looking-at "/?$") 2228 (if (looking-at "[/\\]?$")
2132 (beginning-of-line) 2229 (beginning-of-line)
2133 (insert "/...\n ") 2230 (insert "/...\n ")
2134 (move-to-column ww nil))))) 2231 (move-to-column ww nil)))))
@@ -2139,13 +2236,13 @@ INDEX is not used, but is required by the caller."
2139 (if (< ww tl) 2236 (if (< ww tl)
2140 (progn 2237 (progn
2141 (move-to-column (- tl ww)) 2238 (move-to-column (- tl ww))
2142 (if (re-search-backward "/" nil t) 2239 (if (re-search-backward "[/\\]" nil t)
2143 (progn 2240 (progn
2144 (delete-region (point-min) (point)) 2241 (delete-region (point-min) (point))
2145 (insert "$") 2242 (insert "$")
2146 ))))))) 2243 )))))))
2147 ) 2244 )
2148 (if (string-match "\\`/[^/]+/\\'" displayme) 2245 (if (string-match "\\`[/\\][^/\\]+[/\\]\\'" displayme)
2149 (progn 2246 (progn
2150 (insert " ") 2247 (insert " ")
2151 (let ((p (point))) 2248 (let ((p (point)))
@@ -2182,38 +2279,38 @@ position to insert a new item, and that the new item will end with a CR"
2182 (let ((start (point)) 2279 (let ((start (point))
2183 (end (progn 2280 (end (progn
2184 (insert (int-to-string depth) ":") 2281 (insert (int-to-string depth) ":")
2185 (point)))) 2282 (point)))
2283 (depthspacesize (* depth speedbar-indentation-width)))
2186 (put-text-property start end 'invisible t) 2284 (put-text-property start end 'invisible t)
2187 ) 2285 (insert-char ? depthspacesize nil)
2188 (insert-char ? depth nil) 2286 (put-text-property (- (point) depthspacesize) (point) 'invisible nil)
2189 (put-text-property (- (point) depth) (point) 'invisible nil) 2287 (let* ((exp-button (cond ((eq exp-button-type 'bracket) "[%c]")
2190 (let* ((exp-button (cond ((eq exp-button-type 'bracket) "[%c]") 2288 ((eq exp-button-type 'angle) "<%c>")
2191 ((eq exp-button-type 'angle) "<%c>") 2289 ((eq exp-button-type 'curly) "{%c}")
2192 ((eq exp-button-type 'curly) "{%c}") 2290 (t ">")))
2193 (t ">"))) 2291 (buttxt (format exp-button exp-button-char))
2194 (buttxt (format exp-button exp-button-char)) 2292 (start (point))
2195 (start (point)) 2293 (end (progn (insert buttxt) (point)))
2196 (end (progn (insert buttxt) (point))) 2294 (bf (if exp-button-type 'speedbar-button-face nil))
2197 (bf (if exp-button-type 'speedbar-button-face nil)) 2295 (mf (if exp-button-function 'speedbar-highlight-face nil))
2198 (mf (if exp-button-function 'speedbar-highlight-face nil)) 2296 )
2199 ) 2297 (speedbar-make-button start end bf mf exp-button-function exp-button-data)
2200 (speedbar-make-button start end bf mf exp-button-function exp-button-data) 2298 (if speedbar-hide-button-brackets-flag
2201 (if speedbar-hide-button-brackets-flag 2299 (progn
2202 (progn 2300 (put-text-property start (1+ start) 'invisible t)
2203 (put-text-property start (1+ start) 'invisible t) 2301 (put-text-property end (1- end) 'invisible t)))
2204 (put-text-property end (1- end) 'invisible t))) 2302 )
2205 ) 2303 (insert-char ? 1 nil)
2206 (insert-char ? 1 nil)
2207 (put-text-property (1- (point)) (point) 'invisible nil)
2208 (let ((start (point))
2209 (end (progn (insert tag-button) (point))))
2210 (insert-char ?\n 1 nil)
2211 (put-text-property (1- (point)) (point) 'invisible nil) 2304 (put-text-property (1- (point)) (point) 'invisible nil)
2212 (speedbar-make-button start end tag-button-face 2305 (let ((start (point))
2213 (if tag-button-function 'speedbar-highlight-face nil) 2306 (end (progn (insert tag-button) (point))))
2214 tag-button-function tag-button-data)) 2307 (insert-char ?\n 1 nil)
2215) 2308 (put-text-property (1- (point)) (point) 'invisible nil)
2216 2309 (speedbar-make-button start end tag-button-face
2310 (if tag-button-function 'speedbar-highlight-face nil)
2311 tag-button-function tag-button-data))
2312 ))
2313
2217(defun speedbar-change-expand-button-char (char) 2314(defun speedbar-change-expand-button-char (char)
2218 "Change the expansion button character to CHAR for the current line." 2315 "Change the expansion button character to CHAR for the current line."
2219 (save-excursion 2316 (save-excursion
@@ -2224,7 +2321,9 @@ position to insert a new item, and that the new item will end with a CR"
2224 (goto-char (match-beginning 1)) 2321 (goto-char (match-beginning 1))
2225 (delete-char 1) 2322 (delete-char 1)
2226 (insert-char char 1 t) 2323 (insert-char char 1 t)
2227 (put-text-property (point) (1- (point)) 'invisible nil))))) 2324 (put-text-property (point) (1- (point)) 'invisible nil)
2325 ;; make sure we fix the image on the text here.
2326 (speedbar-insert-image-button-maybe (- (point) 2) 3)))))
2228 2327
2229 2328
2230;;; Build button lists 2329;;; Build button lists
@@ -2278,204 +2377,215 @@ cell of the form ( 'DIRLIST . 'FILELIST )"
2278 (setq sf (cdr sf))))) 2377 (setq sf (cdr sf)))))
2279 ))) 2378 )))
2280 2379
2281(defun speedbar-apply-one-tag-hierarchy-method (lst method) 2380(defun speedbar-sort-tag-hierarchy (lst)
2282 "Adjust the tag hierarchy LST by METHOD." 2381 "Sort all elements of tag hierarchy LST."
2283 (cond 2382 (sort (copy-alist lst)
2284 ((eq method 'sort) 2383 (lambda (a b) (string< (car a) (car b)))))
2285 (sort (copy-alist lst) 2384
2286 (lambda (a b) (string< (car a) (car b))))) 2385(defun speedbar-prefix-group-tag-hierarchy (lst)
2287 ((eq method 'prefix-group) 2386 "Prefix group names for tag hierarchy LST."
2288 (let ((newlst nil) 2387 (let ((newlst nil)
2289 (sublst nil) 2388 (sublst nil)
2290 (work-list nil) 2389 (work-list nil)
2291 (junk-list nil) 2390 (junk-list nil)
2292 (short-group-list nil) 2391 (short-group-list nil)
2293 (short-start-name nil) 2392 (short-start-name nil)
2294 (short-end-name nil) 2393 (short-end-name nil)
2295 (num-shorts-grouped 0) 2394 (num-shorts-grouped 0)
2296 (bins (make-vector 256 nil)) 2395 (bins (make-vector 256 nil))
2297 (diff-idx 0)) 2396 (diff-idx 0))
2298 ;; Break out sub-lists 2397 ;; Break out sub-lists
2299 (while lst 2398 (while lst
2300 (if (listp (cdr-safe (car-safe lst))) 2399 (if (and (listp (cdr-safe (car-safe lst)))
2301 (setq newlst (cons (car lst) newlst)) 2400 ;; This one is for bovine tokens
2302 (setq sublst (cons (car lst) sublst))) 2401 (not (symbolp (car-safe (cdr-safe (car-safe lst))))))
2303 (setq lst (cdr lst))) 2402 (setq newlst (cons (car lst) newlst))
2304 ;; Reverse newlst because it was made backwards. 2403 (setq sublst (cons (car lst) sublst)))
2305 ;; Sublist doesn't need reversing because the act 2404 (setq lst (cdr lst)))
2306 ;; of binning things will reverse it for us. 2405 ;; Reverse newlst because it was made backwards.
2307 (setq newlst (nreverse newlst)) 2406 ;; Sublist doesn't need reversing because the act
2308 ;; Now, first find out how long our list is. Never let a 2407 ;; of binning things will reverse it for us.
2309 ;; list get-shorter than our minimum. 2408 (setq newlst (nreverse newlst))
2310 (if (<= (length sublst) speedbar-tag-split-minimum-length) 2409 ;; Now, first find out how long our list is. Never let a
2311 (setq work-list (nreverse sublst)) 2410 ;; list get-shorter than our minimum.
2312 (setq diff-idx (length (try-completion "" sublst))) 2411 (if (<= (length sublst) speedbar-tag-split-minimum-length)
2313 ;; Sort the whole list into bins. 2412 (setq work-list (nreverse sublst))
2314 (while sublst 2413 (setq diff-idx (length (try-completion "" sublst)))
2315 (let ((e (car sublst)) 2414 ;; Sort the whole list into bins.
2316 (s (car (car sublst)))) 2415 (while sublst
2317 (cond ((<= (length s) diff-idx) 2416 (let ((e (car sublst))
2318 ;; 0 storage bin for shorty. 2417 (s (car (car sublst))))
2319 (aset bins 0 (cons e (aref bins 0)))) 2418 (cond ((<= (length s) diff-idx)
2320 (t 2419 ;; 0 storage bin for shorty.
2321 ;; stuff into a bin based on ascii value at diff 2420 (aset bins 0 (cons e (aref bins 0))))
2322 (aset bins (aref s diff-idx) 2421 (t
2323 (cons e (aref bins (aref s diff-idx))))))) 2422 ;; stuff into a bin based on ascii value at diff
2324 (setq sublst (cdr sublst))) 2423 (aset bins (aref s diff-idx)
2325 ;; Go through all our bins Stick singles into our 2424 (cons e (aref bins (aref s diff-idx)))))))
2326 ;; junk-list, everything else as sublsts in work-list. 2425 (setq sublst (cdr sublst)))
2327 ;; If two neighboring lists are both small, make a grouped 2426 ;; Go through all our bins Stick singles into our
2328 ;; group combinding those two sub-lists. 2427 ;; junk-list, everything else as sublsts in work-list.
2329 (setq diff-idx 0) 2428 ;; If two neighboring lists are both small, make a grouped
2330 (while (> 256 diff-idx) 2429 ;; group combinding those two sub-lists.
2331 (let ((l (nreverse ;; Reverse the list since they are stuck in 2430 (setq diff-idx 0)
2332 ;; backwards. 2431 (while (> 256 diff-idx)
2333 (aref bins diff-idx)))) 2432 (let ((l (nreverse;; Reverse the list since they are stuck in
2334 (if l 2433 ;; backwards.
2335 (let ((tmp (cons (try-completion "" l) l))) 2434 (aref bins diff-idx))))
2336 (if (or (> (length l) speedbar-tag-regroup-maximum-length) 2435 (if l
2337 (> (+ (length l) (length short-group-list)) 2436 (let ((tmp (cons (try-completion "" l) l)))
2338 speedbar-tag-split-minimum-length)) 2437 (if (or (> (length l) speedbar-tag-regroup-maximum-length)
2339 (progn 2438 (> (+ (length l) (length short-group-list))
2340 ;; We have reached a longer list, so we 2439 speedbar-tag-split-minimum-length))
2341 ;; must finish off a grouped group. 2440 (progn
2342 (cond 2441 ;; We have reached a longer list, so we
2343 ((and short-group-list 2442 ;; must finish off a grouped group.
2344 (= (length short-group-list) 2443 (cond
2345 num-shorts-grouped)) 2444 ((and short-group-list
2346 ;; All singles? Junk list 2445 (= (length short-group-list)
2347 (setq junk-list (append short-group-list 2446 num-shorts-grouped))
2348 junk-list))) 2447 ;; All singles? Junk list
2349 ((= num-shorts-grouped 1) 2448 (setq junk-list (append short-group-list
2350 ;; Only one short group? Just stick it in 2449 junk-list)))
2351 ;; there by itself. Make a group, and find 2450 ((= num-shorts-grouped 1)
2352 ;; a subexpression 2451 ;; Only one short group? Just stick it in
2353 (let ((subexpression (try-completion 2452 ;; there by itself. Make a group, and find
2354 "" short-group-list))) 2453 ;; a subexpression
2355 (if (< (length subexpression) 2454 (let ((subexpression (try-completion
2356 speedbar-tag-group-name-minimum-length) 2455 "" short-group-list)))
2357 (setq subexpression 2456 (if (< (length subexpression)
2358 (concat short-start-name 2457 speedbar-tag-group-name-minimum-length)
2359 " (" 2458 (setq subexpression
2360 (substring 2459 (concat short-start-name
2361 (car (car short-group-list)) 2460 " ("
2362 (length short-start-name)) 2461 (substring
2363 ")"))) 2462 (car (car short-group-list))
2364 (setq work-list 2463 (length short-start-name))
2365 (cons (cons subexpression 2464 ")")))
2366 short-group-list)
2367 work-list))))
2368 (short-group-list
2369 ;; Multiple groups to be named in a special
2370 ;; way by displaying the range over which we
2371 ;; have grouped them.
2372 (setq work-list 2465 (setq work-list
2373 (cons (cons (concat short-start-name 2466 (cons (cons subexpression
2374 " to " 2467 short-group-list)
2375 short-end-name)
2376 (nreverse short-group-list))
2377 work-list)))) 2468 work-list))))
2378 ;; Reset short group list information every time. 2469 (short-group-list
2379 (setq short-group-list nil 2470 ;; Multiple groups to be named in a special
2380 short-start-name nil 2471 ;; way by displaying the range over which we
2381 short-end-name nil 2472 ;; have grouped them.
2382 num-shorts-grouped 0))) 2473 (setq work-list
2383 ;; Ok, now that we cleaned up the short-group-list, 2474 (cons (cons (concat short-start-name
2384 ;; we can deal with this new list, to decide if it 2475 " to "
2385 ;; should go on one of these sub-lists or not. 2476 short-end-name)
2386 (if (< (length l) speedbar-tag-regroup-maximum-length) 2477 (nreverse short-group-list))
2387 (setq short-group-list (append short-group-list l) 2478 work-list))))
2388 num-shorts-grouped (1+ num-shorts-grouped) 2479 ;; Reset short group list information every time.
2389 short-end-name (car tmp) 2480 (setq short-group-list nil
2390 short-start-name (if short-start-name 2481 short-start-name nil
2391 short-start-name 2482 short-end-name nil
2392 (car tmp))) 2483 num-shorts-grouped 0)))
2393 (setq work-list (cons tmp work-list)))))) 2484 ;; Ok, now that we cleaned up the short-group-list,
2394 (setq diff-idx (1+ diff-idx)))) 2485 ;; we can deal with this new list, to decide if it
2395 ;; Did we run out of things? Drop our new list onto the end. 2486 ;; should go on one of these sub-lists or not.
2396 (cond 2487 (if (< (length l) speedbar-tag-regroup-maximum-length)
2397 ((and short-group-list (= (length short-group-list) num-shorts-grouped)) 2488 (setq short-group-list (append short-group-list l)
2398 ;; All singles? Junk list 2489 num-shorts-grouped (1+ num-shorts-grouped)
2399 (setq junk-list (append short-group-list junk-list))) 2490 short-end-name (car tmp)
2400 ((= num-shorts-grouped 1) 2491 short-start-name (if short-start-name
2401 ;; Only one short group? Just stick it in 2492 short-start-name
2402 ;; there by itself. 2493 (car tmp)))
2403 (setq work-list 2494 (setq work-list (cons tmp work-list))))))
2404 (cons (cons (try-completion "" short-group-list) 2495 (setq diff-idx (1+ diff-idx))))
2405 short-group-list) 2496 ;; Did we run out of things? Drop our new list onto the end.
2406 work-list))) 2497 (cond
2407 (short-group-list 2498 ((and short-group-list (= (length short-group-list) num-shorts-grouped))
2408 ;; Multiple groups to be named in a special 2499 ;; All singles? Junk list
2409 ;; way by displaying the range over which we 2500 (setq junk-list (append short-group-list junk-list)))
2410 ;; have grouped them. 2501 ((= num-shorts-grouped 1)
2411 (setq work-list 2502 ;; Only one short group? Just stick it in
2412 (cons (cons (concat short-start-name " to " short-end-name) 2503 ;; there by itself.
2413 short-group-list) 2504 (setq work-list
2414 work-list)))) 2505 (cons (cons (try-completion "" short-group-list)
2415 ;; Reverse the work list nreversed when consing. 2506 short-group-list)
2416 (setq work-list (nreverse work-list)) 2507 work-list)))
2417 ;; Now, stick our new list onto the end of 2508 (short-group-list
2418 (if work-list 2509 ;; Multiple groups to be named in a special
2419 (if junk-list 2510 ;; way by displaying the range over which we
2420 (append newlst work-list junk-list) 2511 ;; have grouped them.
2421 (append newlst work-list)) 2512 (setq work-list
2422 (append newlst junk-list)))) 2513 (cons (cons (concat short-start-name " to " short-end-name)
2423 ((eq method 'trim-words) 2514 short-group-list)
2424 (let ((newlst nil) 2515 work-list))))
2425 (sublst nil) 2516 ;; Reverse the work list nreversed when consing.
2426 (trim-prefix nil) 2517 (setq work-list (nreverse work-list))
2427 (trim-chars 0) 2518 ;; Now, stick our new list onto the end of
2428 (trimlst nil)) 2519 (if work-list
2429 (while lst 2520 (if junk-list
2430 (if (listp (cdr-safe (car-safe lst))) 2521 (append newlst work-list junk-list)
2431 (setq newlst (cons (car lst) newlst)) 2522 (append newlst work-list))
2432 (setq sublst (cons (car lst) sublst))) 2523 (append newlst junk-list))))
2433 (setq lst (cdr lst))) 2524
2434 ;; Get the prefix to trim by. Make sure that we don't trim 2525(defun speedbar-trim-words-tag-hierarchy (lst)
2435 ;; off silly pieces, only complete understandable words. 2526 "Trim all words in a tag hierarchy.
2436 (setq trim-prefix (try-completion "" sublst)) 2527Base trimming information on word separators, and group names.
2437 (if (or (= (length sublst) 1) 2528Argument LST is the list of tags to trim."
2438 (not trim-prefix) 2529 (let ((newlst nil)
2439 (not (string-match "\\(\\w+\\W+\\)+" trim-prefix))) 2530 (sublst nil)
2440 (append (nreverse newlst) (nreverse sublst)) 2531 (trim-prefix nil)
2441 (setq trim-prefix (substring trim-prefix (match-beginning 0) 2532 (trim-chars 0)
2442 (match-end 0))) 2533 (trimlst nil))
2443 (setq trim-chars (length trim-prefix)) 2534 (while lst
2444 (while sublst 2535 (if (listp (cdr-safe (car-safe lst)))
2445 (setq trimlst (cons 2536 (setq newlst (cons (car lst) newlst))
2446 (cons (substring (car (car sublst)) trim-chars) 2537 (setq sublst (cons (car lst) sublst)))
2447 (cdr (car sublst))) 2538 (setq lst (cdr lst)))
2448 trimlst) 2539 ;; Get the prefix to trim by. Make sure that we don't trim
2449 sublst (cdr sublst))) 2540 ;; off silly pieces, only complete understandable words.
2450 ;; Put the lists together 2541 (setq trim-prefix (try-completion "" sublst))
2451 (append (nreverse newlst) trimlst)))) 2542 (if (or (= (length sublst) 1)
2452 ((eq method 'simple-group) 2543 (not trim-prefix)
2453 (let ((newlst nil) 2544 (not (string-match "\\(\\w+\\W+\\)+" trim-prefix)))
2454 (sublst nil)) 2545 (append (nreverse newlst) (nreverse sublst))
2455 (while lst 2546 (setq trim-prefix (substring trim-prefix (match-beginning 0)
2456 (if (listp (cdr-safe (car-safe lst))) 2547 (match-end 0)))
2457 (setq newlst (cons (car lst) newlst)) 2548 (setq trim-chars (length trim-prefix))
2458 (setq sublst (cons (car lst) sublst))) 2549 (while sublst
2459 (setq lst (cdr lst))) 2550 (setq trimlst (cons
2460 (if (not newlst) 2551 (cons (substring (car (car sublst)) trim-chars)
2461 (nreverse sublst) 2552 (cdr (car sublst)))
2462 (setq newlst (cons (cons "Tags" (nreverse sublst)) newlst)) 2553 trimlst)
2463 (nreverse newlst)))) 2554 sublst (cdr sublst)))
2464 (t lst))) 2555 ;; Put the lists together
2556 (append (nreverse newlst) trimlst))))
2557
2558(defun speedbar-simple-group-tag-hierarchy (lst)
2559 "Create a simple 'Tags' group with orphaned tags.
2560Argument LST is the list of tags to sort into groups."
2561 (let ((newlst nil)
2562 (sublst nil))
2563 (while lst
2564 (if (listp (cdr-safe (car-safe lst)))
2565 (setq newlst (cons (car lst) newlst))
2566 (setq sublst (cons (car lst) sublst)))
2567 (setq lst (cdr lst)))
2568 (if (not newlst)
2569 (nreverse sublst)
2570 (setq newlst (cons (cons "Tags" (nreverse sublst)) newlst))
2571 (nreverse newlst))))
2465 2572
2466(defun speedbar-create-tag-hierarchy (lst) 2573(defun speedbar-create-tag-hierarchy (lst)
2467 "Adjust the tag hierarchy in LST, and return it. 2574 "Adjust the tag hierarchy in LST, and return it.
2468This uses `speedbar-tag-hierarchy-method' to determine how to adjust 2575This uses `speedbar-tag-hierarchy-method' to determine how to adjust
2469the list. See it's value for details." 2576the list."
2470 (let* ((f (save-excursion 2577 (let* ((f (save-excursion
2471 (forward-line -1) 2578 (forward-line -1)
2472 (speedbar-line-path))) 2579 (speedbar-line-path)))
2473 (methods (if (get-file-buffer f) 2580 (methods (if (get-file-buffer f)
2474 (save-excursion (set-buffer (get-file-buffer f)) 2581 (save-excursion (set-buffer (get-file-buffer f))
2475 speedbar-tag-hierarchy-method) 2582 speedbar-tag-hierarchy-method)
2476 speedbar-tag-hierarchy-method))) 2583 speedbar-tag-hierarchy-method))
2584 (lst (if (fboundp 'copy-tree)
2585 (copy-tree lst)
2586 lst)))
2477 (while methods 2587 (while methods
2478 (setq lst (speedbar-apply-one-tag-hierarchy-method lst (car methods)) 2588 (setq lst (funcall (car methods) lst)
2479 methods (cdr methods))) 2589 methods (cdr methods)))
2480 lst)) 2590 lst))
2481 2591
@@ -2508,6 +2618,18 @@ name will have the function FIND-FUN and not token."
2508 (1+ level))) 2618 (1+ level)))
2509 (t (speedbar-message "Ooops!"))) 2619 (t (speedbar-message "Ooops!")))
2510 (setq lst (cdr lst)))) 2620 (setq lst (cdr lst))))
2621
2622(defun speedbar-insert-imenu-list (indent lst)
2623 "At level INDENT, insert the imenu generated LST."
2624 (speedbar-insert-generic-list indent lst
2625 'speedbar-tag-expand
2626 'speedbar-tag-find))
2627
2628(defun speedbar-insert-etags-list (indent lst)
2629 "At level INDENT, insert the etags generated LST."
2630 (speedbar-insert-generic-list indent lst
2631 'speedbar-tag-expand
2632 'speedbar-tag-find))
2511 2633
2512;;; Timed functions 2634;;; Timed functions
2513;; 2635;;
@@ -2559,7 +2681,7 @@ name will have the function FIND-FUN and not token."
2559 (if (and speedbar-smart-directory-expand-flag 2681 (if (and speedbar-smart-directory-expand-flag
2560 (save-match-data 2682 (save-match-data
2561 (setq cbd-parent cbd) 2683 (setq cbd-parent cbd)
2562 (if (string-match "/$" cbd-parent) 2684 (if (string-match "[/\\]$" cbd-parent)
2563 (setq cbd-parent (substring cbd-parent 0 2685 (setq cbd-parent (substring cbd-parent 0
2564 (match-beginning 0)))) 2686 (match-beginning 0))))
2565 (setq cbd-parent (file-name-directory cbd-parent))) 2687 (setq cbd-parent (file-name-directory cbd-parent)))
@@ -3028,11 +3150,25 @@ the file being checked."
3028 3150
3029;;; Clicking Activity 3151;;; Clicking Activity
3030;; 3152;;
3153(defun speedbar-mouse-set-point (e)
3154 "Set POINT based on event E.
3155Handle clicking on images in XEmacs."
3156 (if (and (fboundp 'event-over-glyph-p) (event-over-glyph-p e))
3157 ;; We are in XEmacs, and clicked on a picture
3158 (let ((ext (event-glyph-extent e)))
3159 ;; This position is back inside the extent where the
3160 ;; junk we pushed into the property list lives.
3161 (if (extent-end-position ext)
3162 (goto-char (1- (extent-end-position ext)))
3163 (mouse-set-point e)))
3164 ;; We are not in XEmacs, OR we didn't click on a picture.
3165 (mouse-set-point e)))
3166
3031(defun speedbar-quick-mouse (e) 3167(defun speedbar-quick-mouse (e)
3032 "Since mouse events are strange, this will keep the mouse nicely positioned. 3168 "Since mouse events are strange, this will keep the mouse nicely positioned.
3033This should be bound to mouse event E." 3169This should be bound to mouse event E."
3034 (interactive "e") 3170 (interactive "e")
3035 (mouse-set-point e) 3171 (speedbar-mouse-set-point e)
3036 (speedbar-position-cursor-on-line) 3172 (speedbar-position-cursor-on-line)
3037 ) 3173 )
3038 3174
@@ -3046,6 +3182,8 @@ This should be bound to mouse event E."
3046 3182
3047(defun speedbar-power-click (e) 3183(defun speedbar-power-click (e)
3048 "Activate any speedbar button as a power click. 3184 "Activate any speedbar button as a power click.
3185A power click will dispose of cached data (if available) or bring a buffer
3186up into a different window.
3049This should be bound to mouse event E." 3187This should be bound to mouse event E."
3050 (interactive "e") 3188 (interactive "e")
3051 (let ((speedbar-power-click t)) 3189 (let ((speedbar-power-click t))
@@ -3057,7 +3195,7 @@ This must be bound to a mouse event. A button is any location of text
3057with a mouse face that has a text property called `speedbar-function'. 3195with a mouse face that has a text property called `speedbar-function'.
3058This should be bound to mouse event E." 3196This should be bound to mouse event E."
3059 (interactive "e") 3197 (interactive "e")
3060 (mouse-set-point e) 3198 (speedbar-mouse-set-point e)
3061 (speedbar-do-function-pointer) 3199 (speedbar-do-function-pointer)
3062 (speedbar-quick-mouse e)) 3200 (speedbar-quick-mouse e))
3063 3201
@@ -3069,12 +3207,12 @@ This should be bound to mouse event E."
3069 (interactive "e") 3207 (interactive "e")
3070 ;; Emacs only. XEmacs handles this via `mouse-track-click-hook'. 3208 ;; Emacs only. XEmacs handles this via `mouse-track-click-hook'.
3071 (cond ((eq (car e) 'down-mouse-1) 3209 (cond ((eq (car e) 'down-mouse-1)
3072 (mouse-set-point e)) 3210 (speedbar-mouse-set-point e))
3073 ((eq (car e) 'mouse-1) 3211 ((eq (car e) 'mouse-1)
3074 (speedbar-quick-mouse e)) 3212 (speedbar-quick-mouse e))
3075 ((or (eq (car e) 'double-down-mouse-1) 3213 ((or (eq (car e) 'double-down-mouse-1)
3076 (eq (car e) 'triple-down-mouse-1)) 3214 (eq (car e) 'triple-down-mouse-1))
3077 (mouse-set-point e) 3215 (speedbar-mouse-set-point e)
3078 (speedbar-do-function-pointer) 3216 (speedbar-do-function-pointer)
3079 (speedbar-quick-mouse e)))) 3217 (speedbar-quick-mouse e))))
3080 3218
@@ -3124,12 +3262,12 @@ Optional argument P is where to start the search from."
3124 (if p (goto-char p)) 3262 (if p (goto-char p))
3125 (beginning-of-line) 3263 (beginning-of-line)
3126 (if (looking-at (concat 3264 (if (looking-at (concat
3127 "\\([0-9]+\\): *[[<{][-+?][]>}] \\([^ \n]+\\)\\(" 3265 "\\([0-9]+\\): *[[<{]?[-+?=][]>}@()|] \\([^ \n]+\\)\\("
3128 speedbar-indicator-regex "\\)?")) 3266 speedbar-indicator-regex "\\)?"))
3129 (progn 3267 (progn
3130 (goto-char (match-beginning 2)) 3268 (goto-char (match-beginning 2))
3131 (get-text-property (point) 'speedbar-token)) 3269 (get-text-property (point) 'speedbar-token))
3132 nil))) 3270 nil)))
3133 3271
3134(defun speedbar-line-file (&optional p) 3272(defun speedbar-line-file (&optional p)
3135 "Retrieve the file or whatever from the line at P point. 3273 "Retrieve the file or whatever from the line at P point.
@@ -3153,7 +3291,7 @@ Otherwise do not move and return nil."
3153 (goto-char (point-min)) 3291 (goto-char (point-min))
3154 ;; scan all the directories 3292 ;; scan all the directories
3155 (while (and path (not (eq path t))) 3293 (while (and path (not (eq path t)))
3156 (if (string-match "^/?\\([^/]+\\)" path) 3294 (if (string-match "^[/\\]?\\([^/\\]+\\)" path)
3157 (let ((pp (match-string 1 path))) 3295 (let ((pp (match-string 1 path)))
3158 (if (save-match-data 3296 (if (save-match-data
3159 (re-search-forward (concat "> " (regexp-quote pp) "$") 3297 (re-search-forward (concat "> " (regexp-quote pp) "$")
@@ -3224,7 +3362,7 @@ directory with these items."
3224(defun speedbar-path-line (path) 3362(defun speedbar-path-line (path)
3225 "Position the cursor on the line specified by PATH." 3363 "Position the cursor on the line specified by PATH."
3226 (save-match-data 3364 (save-match-data
3227 (if (string-match "/$" path) 3365 (if (string-match "[/\\]$" path)
3228 (setq path (substring path 0 (match-beginning 0)))) 3366 (setq path (substring path 0 (match-beginning 0))))
3229 (let ((nomatch t) (depth 0) 3367 (let ((nomatch t) (depth 0)
3230 (fname (file-name-nondirectory path)) 3368 (fname (file-name-nondirectory path))
@@ -3259,21 +3397,36 @@ directory with these items."
3259 nil)) 3397 nil))
3260 (speedbar-do-function-pointer))) 3398 (speedbar-do-function-pointer)))
3261 3399
3262(defun speedbar-expand-line () 3400(defun speedbar-expand-line (arg)
3263 "Expand the line under the cursor." 3401 "Expand the line under the cursor.
3264 (interactive) 3402With universal argument ARG, flush cached data."
3403 (interactive "P")
3265 (beginning-of-line) 3404 (beginning-of-line)
3266 (re-search-forward ":\\s-*.\\+. " (save-excursion (end-of-line) (point))) 3405 (let ((speedbar-power-click arg))
3267 (forward-char -2) 3406 (condition-case nil
3268 (speedbar-do-function-pointer)) 3407 (progn
3269 3408 (re-search-forward ":\\s-*.\\+. "
3409 (save-excursion (end-of-line) (point)))
3410 (forward-char -2)
3411 (speedbar-do-function-pointer))
3412 (error (speedbar-position-cursor-on-line)))))
3413
3414(defun speedbar-flush-expand-line ()
3415 "Expand the line under the cursor and flush any cached information."
3416 (interactive)
3417 (speedbar-expand-line 1))
3418
3270(defun speedbar-contract-line () 3419(defun speedbar-contract-line ()
3271 "Contract the line under the cursor." 3420 "Contract the line under the cursor."
3272 (interactive) 3421 (interactive)
3273 (beginning-of-line) 3422 (beginning-of-line)
3274 (re-search-forward ":\\s-*.-. " (save-excursion (end-of-line) (point))) 3423 (condition-case nil
3275 (forward-char -2) 3424 (progn
3276 (speedbar-do-function-pointer)) 3425 (re-search-forward ":\\s-*.-. "
3426 (save-excursion (end-of-line) (point)))
3427 (forward-char -2)
3428 (speedbar-do-function-pointer))
3429 (error (speedbar-position-cursor-on-line))))
3277 3430
3278(if speedbar-xemacsp 3431(if speedbar-xemacsp
3279 (defalias 'speedbar-mouse-event-p 'button-press-event-p) 3432 (defalias 'speedbar-mouse-event-p 'button-press-event-p)
@@ -3399,12 +3552,8 @@ indentation level."
3399 (cond ((string-match "+" text) ;we have to expand this file 3552 (cond ((string-match "+" text) ;we have to expand this file
3400 (let* ((fn (expand-file-name (concat (speedbar-line-path indent) 3553 (let* ((fn (expand-file-name (concat (speedbar-line-path indent)
3401 token))) 3554 token)))
3402 (lst (if speedbar-use-imenu-flag 3555 (mode nil)
3403 (let ((tim (speedbar-fetch-dynamic-imenu fn))) 3556 (lst (speedbar-fetch-dynamic-tags fn)))
3404 (if (eq tim t)
3405 (speedbar-fetch-dynamic-etags fn)
3406 tim))
3407 (speedbar-fetch-dynamic-etags fn))))
3408 ;; if no list, then remove expando button 3557 ;; if no list, then remove expando button
3409 (if (not lst) 3558 (if (not lst)
3410 (speedbar-change-expand-button-char ??) 3559 (speedbar-change-expand-button-char ??)
@@ -3412,9 +3561,7 @@ indentation level."
3412 (speedbar-with-writable 3561 (speedbar-with-writable
3413 (save-excursion 3562 (save-excursion
3414 (end-of-line) (forward-char 1) 3563 (end-of-line) (forward-char 1)
3415 (speedbar-insert-generic-list indent 3564 (funcall (car lst) indent (cdr lst)))))))
3416 lst 'speedbar-tag-expand
3417 'speedbar-tag-find))))))
3418 ((string-match "-" text) ;we have to contract this node 3565 ((string-match "-" text) ;we have to contract this node
3419 (speedbar-change-expand-button-char ?+) 3566 (speedbar-change-expand-button-char ?+)
3420 (speedbar-delete-subblock indent)) 3567 (speedbar-delete-subblock indent))
@@ -3535,6 +3682,33 @@ interested in."
3535 (goto-char cp))))) 3682 (goto-char cp)))))
3536 3683
3537 3684
3685;;; Tag Management -- List of expanders:
3686;;
3687(defun speedbar-fetch-dynamic-tags (file)
3688 "Return a list of tags generated dynamically from FILE.
3689This uses the entries in `speedbar-dynamic-tags-function-list'
3690to find the proper tags. It is up to each of those individual
3691functions to do caching and flushing if appropriate."
3692 (save-excursion
3693 (set-buffer (find-file-noselect file))
3694 ;; If there is a buffer-local value of
3695 ;; speedbar-dynamic-tags-function-list, it will now be available.
3696 (let ((dtf speedbar-dynamic-tags-function-list)
3697 (ret t))
3698 (while (and (eq ret t) dtf)
3699 (setq ret
3700 (if (fboundp (car (car dtf)))
3701 (funcall (car (car dtf)) (buffer-file-name))
3702 t))
3703 (if (eq ret t)
3704 (setq dtf (cdr dtf))))
3705 (if (eq ret t)
3706 ;; No valid tag list, return nil
3707 nil
3708 ;; We have some tags. Return the list with the insert fn
3709 ;; prepended
3710 (cons (cdr (car dtf)) ret)))))
3711
3538;;; Tag Management -- Imenu 3712;;; Tag Management -- Imenu
3539;; 3713;;
3540(if (not speedbar-use-imenu-flag) 3714(if (not speedbar-use-imenu-flag)
@@ -3548,16 +3722,14 @@ interested in."
3548Returns the tag list, or t for an error." 3722Returns the tag list, or t for an error."
3549 ;; Load this AND compile it in 3723 ;; Load this AND compile it in
3550 (require 'imenu) 3724 (require 'imenu)
3551 (save-excursion 3725 (if speedbar-power-click (setq imenu--index-alist nil))
3552 (set-buffer (find-file-noselect file)) 3726 (condition-case nil
3553 (if speedbar-power-click (setq imenu--index-alist nil)) 3727 (let ((index-alist (imenu--make-index-alist t)))
3554 (condition-case nil 3728 (if speedbar-sort-tags
3555 (let ((index-alist (imenu--make-index-alist t))) 3729 (sort (copy-alist index-alist)
3556 (if speedbar-sort-tags 3730 (lambda (a b) (string< (car a) (car b))))
3557 (sort (copy-alist index-alist) 3731 index-alist))
3558 (lambda (a b) (string< (car a) (car b)))) 3732 (error t)))
3559 index-alist))
3560 (error t))))
3561) 3733)
3562 3734
3563;;; Tag Management -- etags (old XEmacs compatibility part) 3735;;; Tag Management -- etags (old XEmacs compatibility part)
@@ -3646,6 +3818,7 @@ Each symbol will be associated with its line position in FILE."
3646 (cdr ans)))) 3818 (cdr ans))))
3647 (if expr 3819 (if expr
3648 (let (tnl) 3820 (let (tnl)
3821 (set-buffer (get-buffer-create "*etags tmp*"))
3649 (while (not (save-excursion (end-of-line) (eobp))) 3822 (while (not (save-excursion (end-of-line) (eobp)))
3650 (save-excursion 3823 (save-excursion
3651 (setq tnl (speedbar-extract-one-symbol expr))) 3824 (setq tnl (speedbar-extract-one-symbol expr)))
@@ -3740,6 +3913,7 @@ regular expression EXPR"
3740 (define-key speedbar-buffers-key-map "e" 'speedbar-edit-line) 3913 (define-key speedbar-buffers-key-map "e" 'speedbar-edit-line)
3741 (define-key speedbar-buffers-key-map "\C-m" 'speedbar-edit-line) 3914 (define-key speedbar-buffers-key-map "\C-m" 'speedbar-edit-line)
3742 (define-key speedbar-buffers-key-map "+" 'speedbar-expand-line) 3915 (define-key speedbar-buffers-key-map "+" 'speedbar-expand-line)
3916 (define-key speedbar-buffers-key-map "=" 'speedbar-expand-line)
3743 (define-key speedbar-buffers-key-map "-" 'speedbar-contract-line) 3917 (define-key speedbar-buffers-key-map "-" 'speedbar-contract-line)
3744 3918
3745 ;; Buffer specific keybindings 3919 ;; Buffer specific keybindings
@@ -3753,9 +3927,18 @@ regular expression EXPR"
3753 ["Expand File Tags" speedbar-expand-line 3927 ["Expand File Tags" speedbar-expand-line
3754 (save-excursion (beginning-of-line) 3928 (save-excursion (beginning-of-line)
3755 (looking-at "[0-9]+: *.\\+. "))] 3929 (looking-at "[0-9]+: *.\\+. "))]
3930 ["Flush Cache & Expand" speedbar-flush-expand-line
3931 (save-excursion (beginning-of-line)
3932 (looking-at "[0-9]+: *.\\+. "))]
3756 ["Contract File Tags" speedbar-contract-line 3933 ["Contract File Tags" speedbar-contract-line
3757 (save-excursion (beginning-of-line) 3934 (save-excursion (beginning-of-line)
3758 (looking-at "[0-9]+: *.-. "))] 3935 (looking-at "[0-9]+: *.-. "))]
3936 ["Kill Buffer" speedbar-buffer-kill-buffer
3937 (save-excursion (beginning-of-line)
3938 (looking-at "[0-9]+: *.-. "))]
3939 ["Revert Buffer" speedbar-buffer-revert-buffer
3940 (save-excursion (beginning-of-line)
3941 (looking-at "[0-9]+: *.-. "))]
3759 ) 3942 )
3760 "Menu item elements shown when displaying a buffer list.") 3943 "Menu item elements shown when displaying a buffer list.")
3761 3944
@@ -3783,7 +3966,8 @@ If TEMP is non-nil, then clicking on a buffer restores the previous display."
3783 (fn (if known 'speedbar-tag-file nil)) 3966 (fn (if known 'speedbar-tag-file nil))
3784 (fname (save-excursion (set-buffer (car bl)) 3967 (fname (save-excursion (set-buffer (car bl))
3785 (buffer-file-name)))) 3968 (buffer-file-name))))
3786 (speedbar-make-tag-line 'bracket expchar fn fname 3969 (speedbar-make-tag-line 'bracket expchar fn
3970 (if fname (file-name-nondirectory fname))
3787 (buffer-name (car bl)) 3971 (buffer-name (car bl))
3788 'speedbar-buffer-click temp 3972 'speedbar-buffer-click temp
3789 'speedbar-file-face 0))) 3973 'speedbar-file-face 0)))
@@ -3888,9 +4072,43 @@ TEXT is the buffer's name, TOKEN and INDENT are unused."
3888 (set-buffer text) 4072 (set-buffer text)
3889 (revert-buffer t))))))) 4073 (revert-buffer t)))))))
3890 4074
4075
4076;;; Useful hook values and such.
4077;;
4078(defvar speedbar-highlight-one-tag-line nil
4079 "Overlay used for highlighting the most recently jumped to tag line.")
4080
4081(defun speedbar-highlight-one-tag-line ()
4082 "Highlight the current line, unhighlighting a previously jumped to line."
4083 (speedbar-unhighlight-one-tag-line)
4084 (setq speedbar-highlight-one-tag-line
4085 (speedbar-make-overlay (save-excursion (beginning-of-line) (point))
4086 (save-excursion (end-of-line)
4087 (forward-char 1)
4088 (point))))
4089 (speedbar-overlay-put speedbar-highlight-one-tag-line 'face
4090 'speedbar-highlight-face)
4091 (add-hook 'pre-command-hook 'speedbar-unhighlight-one-tag-line)
4092 )
4093
4094(defun speedbar-unhighlight-one-tag-line ()
4095 "Unhighlight the currently highlight line."
4096 (if speedbar-highlight-one-tag-line
4097 (progn
4098 (speedbar-delete-overlay speedbar-highlight-one-tag-line)
4099 (setq speedbar-highlight-one-tag-line nil)))
4100 (remove-hook 'pre-command-hook 'speedbar-unhighlight-one-tag-line))
4101
4102(defun speedbar-recenter-to-top ()
4103 "Recenter the current buffer so POINT is on the top of the window."
4104 (recenter 1))
4105
4106(defun speedbar-recenter ()
4107 "Recenter the current buffer so POINT is in the center of the window."
4108 (recenter (window-hight (/ (selected-window) 2))))
3891 4109
3892 4110
3893;;; Color loading section This is messy *Blech!* 4111;;; Color loading section.
3894;; 4112;;
3895(defface speedbar-button-face '((((class color) (background light)) 4113(defface speedbar-button-face '((((class color) (background light))
3896 (:foreground "green4")) 4114 (:foreground "green4"))
@@ -3941,6 +4159,152 @@ TEXT is the buffer's name, TOKEN and INDENT are unused."
3941 "Face used for highlighting buttons with the mouse." 4159 "Face used for highlighting buttons with the mouse."
3942 :group 'speedbar-faces) 4160 :group 'speedbar-faces)
3943 4161
4162
4163;;; Image loading and inlining
4164;;
4165
4166;;; Some images if defimage is available:
4167(eval-when-compile
4168
4169(if (fboundp 'defimage)
4170 (defalias 'defimage-speedbar 'defimage)
4171
4172 (if (not (fboundp 'make-glyph))
4173
4174(defmacro defimage-speedbar (variable imagespec docstring)
4175 "Don't bother loading up an image...
4176Argument VARIABLE is the varible to define.
4177Argument IMAGESPEC is the list defining the image to create.
4178Argument DOCSTRING is the documentation for VARIABLE."
4179 `(defvar ,variable nil ,docstring))
4180
4181;; ELSE
4182(defun speedbar-find-image-on-load-path (image)
4183 "Find the image file IMAGE on the load path."
4184 (let ((l load-path)
4185 (r nil))
4186 (while (and l (not r))
4187 (if (file-exists-p (concat (car l) "/" image))
4188 (setq r (concat (car l) "/" image)))
4189 (setq l (cdr l)))
4190 r))
4191
4192(defun speedbar-convert-emacs21-imagespec-to-xemacs (spec)
4193 "Convert the Emacs21 Image SPEC into an XEmacs image spec."
4194 (let* ((sl (car spec))
4195 (itype (nth 1 sl))
4196 (ifile (nth 3 sl)))
4197 (vector itype ':file (speedbar-find-image-on-load-path ifile))))
4198
4199(defmacro defimage-speedbar (variable imagespec docstring)
4200 "Devine VARIABLE as an image if `defimage' is not available..
4201IMAGESPEC is the image data, and DOCSTRING is documentation for the image."
4202 `(defvar ,variable
4203 ;; The Emacs21 version of defimage looks just like the XEmacs image
4204 ;; specifier, except that it needs a :type keyword. If we line
4205 ;; stuff up right, we can use this cheat to support XEmacs specifiers.
4206 (condition-case nil
4207 (make-glyph
4208 (make-image-specifier
4209 (speedbar-convert-emacs21-imagespec-to-xemacs (quote ,imagespec)))
4210 'buffer)
4211 (error nil))
4212 ,docstring))
4213
4214)))
4215
4216(defimage-speedbar speedbar-directory-+
4217 ((:type xpm :file "sb-dir+.xpm" :ascent center))
4218 "Image used for closed directories with stuff in them.")
4219
4220(defimage-speedbar speedbar-directory--
4221 ((:type xpm :file "sb-dir-.xpm" :ascent center))
4222 "Image used for open directories with stuff in them.")
4223
4224(defimage-speedbar speedbar-file-+
4225 ((:type xpm :file "sb-file+.xpm" :ascent center))
4226 "Image used for closed files with stuff in them.")
4227
4228(defimage-speedbar speedbar-file--
4229 ((:type xpm :file "sb-file-.xpm" :ascent center))
4230 "Image used for open files with stuff in them.")
4231
4232(defimage-speedbar speedbar-file-
4233 ((:type xpm :file "sb-file.xpm" :ascent center))
4234 "Image used for files that can't be opened.")
4235
4236(defimage-speedbar speedbar-tag-
4237 ((:type xpm :file "sb-tag.xpm" :ascent center))
4238 "Image used for tags.")
4239
4240(defimage-speedbar speedbar-tag-+
4241 ((:type xpm :file "sb-tag+.xpm" :ascent center))
4242 "Image used for closed tag groups.")
4243
4244(defimage-speedbar speedbar-tag--
4245 ((:type xpm :file "sb-tag-.xpm" :ascent center))
4246 "Image used for open tag groups.")
4247
4248(defimage-speedbar speedbar-tag-gt
4249 ((:type xpm :file "sb-tag-gt.xpm" :ascent center))
4250 "Image used for open tag groups.")
4251
4252(defimage-speedbar speedbar-tag-v
4253 ((:type xpm :file "sb-tag-v.xpm" :ascent center))
4254 "Image used for open tag groups.")
4255
4256(defimage-speedbar speedbar-tag-type
4257 ((:type xpm :file "sb-tag-type.xpm" :ascent center))
4258 "Image used for open tag groups.")
4259
4260(defimage-speedbar speedbar-mail
4261 ((:type xpm :file "sb-mail.xpm" :ascent center))
4262 "Image used for open tag groups.")
4263
4264(defvar speedbar-expand-image-button-alist
4265 '(("<+>" . speedbar-directory-+)
4266 ("<->" . speedbar-directory--)
4267 ("[+]" . speedbar-file-+)
4268 ("[-]" . speedbar-file--)
4269 ("[?]" . speedbar-file-)
4270 ("{+}" . speedbar-tag-+)
4271 ("{-}" . speedbar-tag--)
4272 ("<M>" . speedbar-mail)
4273 (" =>" . speedbar-tag-)
4274 (" +>" . speedbar-tag-gt)
4275 (" ->" . speedbar-tag-v)
4276 (">" . speedbar-tag-)
4277 ("@" . speedbar-tag-type)
4278 (" @" . speedbar-tag-type)
4279 )
4280 "List of text and image associations.")
4281
4282(defun speedbar-insert-image-button-maybe (start length)
4283 "Insert an image button based on text starting at START for LENGTH chars.
4284If buttontext is unknown, just insert that text.
4285If we have an image associated with it, use that image."
4286 (if speedbar-use-images
4287 (let* ((bt (buffer-substring start (+ length start)))
4288 (a (assoc bt speedbar-expand-image-button-alist)))
4289 ;; Regular images (created with `insert-image' are intangible
4290 ;; which (I suppose) make them more compatible with XEmacs 21.
4291 ;; Unfortunatly, there is a giant pile o code dependent on the
4292 ;; underlying text. This means if we leave it tangible, then I
4293 ;; don't have to change said giant piles o code.
4294 (if (and a (symbol-value (cdr a)))
4295 (if (fboundp 'set-extent-property)
4296 (add-text-properties (+ start (length bt)) start
4297 (list 'end-glyph (symbol-value (cdr a))
4298 'rear-nonsticky (list 'display)
4299 'invisible t
4300 'detachable t))
4301 (add-text-properties start (+ start (length bt))
4302 (list 'display (symbol-value (cdr a))
4303 'rear-nonsticky (list 'display))))
4304 ;(message "Bad text [%s]" (buffer-substring start (+ start length)))
4305 ))))
4306
4307
3944;; some edebug hooks 4308;; some edebug hooks
3945(add-hook 'edebug-setup-hook 4309(add-hook 'edebug-setup-hook
3946 (lambda () 4310 (lambda ()