diff options
| author | Eric M. Ludlam | 2000-05-13 23:13:25 +0000 |
|---|---|---|
| committer | Eric M. Ludlam | 2000-05-13 23:13:25 +0000 |
| commit | e4a1da3c64ca39da7a739729b45ce4d963e79fab (patch) | |
| tree | 3b60f186c3a5160b11b19033add46111cfb46278 | |
| parent | 771c9b9735e1437fd073aab706e7ac08ea496a7d (diff) | |
| download | emacs-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.el | 1006 |
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. |
| 305 | nil means don't show the file in the list." | 318 | nil 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. |
| 337 | Parameters not listed here which will be added automatically are | 350 | Any parameter supported by a frame may be added. The parameter `height' |
| 338 | `height' which will be initialized to the height of the frame speedbar | 351 | will be initialized to the height of the frame speedbar is |
| 339 | is attached to." | 352 | attached 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. |
| 360 | XEmacs prior to 20.4 doesn't support imenu, therefore the default is to | 373 | XEmacs prior to 20.4 doesn't support imenu, therefore the default is to |
| 361 | use etags instead. Etags support is not as robust as imenu support." | 374 | use 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. | ||
| 383 | Each element is of the form ( FETCH . INSERT ) where FETCH | ||
| 384 | is a funciotn which takes one parameter (the file to tag) and returns a | ||
| 385 | list of tags. The tag list can be of any form as long as the | ||
| 386 | corresponding insert method can handle it. If it returns t, then an | ||
| 387 | error occured, and the next fetch routine is tried. | ||
| 388 | INSERT is a function which takes an INDENTation level, and a LIST of | ||
| 389 | tags 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) |
| 379 | Groups are defined as expandable meta-tags. Imenu supports such | 404 | "*List of hooks which speedbar will use to organize tags into groups. |
| 380 | things in some languages, such as separating variables from functions. | 405 | Groups are defined as expandable meta-tags. Imenu supports |
| 381 | Available methods are: | 406 | such things in some languages, such as separating variables from |
| 382 | sort - Sort tags. (sometimes unnecessary) | 407 | functions. Each hook takes one argument LST, and may destructivly |
| 383 | trim-words - Trim all tags by a common prefix, broken @ word sections. | 408 | create a new list of the same form. LST is a list of elements of the |
| 384 | prefix-group - Try to guess groups by prefix. | 409 | form: |
| 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." | 411 | where each ELT is of the form |
| 412 | (TAG-NAME-STRING . NUMBER-OR-MARKER) | ||
| 413 | or | ||
| 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. |
| 494 | Currently only RCS is supported. Other version control systems can be | 535 | Other version control systems can be added by examining the function |
| 495 | added 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 | |||
| 585 | variable `speedbar-ignored-path-expressions' to modify this variable.") | 625 | variable `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. |
| 590 | They should included paths to directories which are notoriously very | 630 | They should included paths to directories which are notoriously very |
| 591 | large and take a long time to load in. Use the function | 631 | large 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. |
| 632 | Do not prefix the `.' char with a double \\ to quote it, as the period | 672 | Do not prefix the `.' char with a double \\ to quote it, as the period |
| 633 | will be stripped by a simplified optimizer when compiled into a | 673 | will 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." | |||
| 1681 | nil if not applicable." | 1748 | nil 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" | |||
| 2094 | Each directory path part is a different button. If part of the path | 2191 | Each directory path part is a different button. If part of the path |
| 2095 | matches the user directory ~, then it is replaced with a ~. | 2192 | matches the user directory ~, then it is replaced with a ~. |
| 2096 | INDEX is not used, but is required by the caller." | 2193 | INDEX 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)) | 2527 | Base trimming information on word separators, and group names. |
| 2437 | (if (or (= (length sublst) 1) | 2528 | Argument 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. | ||
| 2560 | Argument 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. |
| 2468 | This uses `speedbar-tag-hierarchy-method' to determine how to adjust | 2575 | This uses `speedbar-tag-hierarchy-method' to determine how to adjust |
| 2469 | the list. See it's value for details." | 2576 | the 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. | ||
| 3155 | Handle 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. |
| 3033 | This should be bound to mouse event E." | 3169 | This 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. |
| 3185 | A power click will dispose of cached data (if available) or bring a buffer | ||
| 3186 | up into a different window. | ||
| 3049 | This should be bound to mouse event E." | 3187 | This 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 | |||
| 3057 | with a mouse face that has a text property called `speedbar-function'. | 3195 | with a mouse face that has a text property called `speedbar-function'. |
| 3058 | This should be bound to mouse event E." | 3196 | This 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) | 3402 | With 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. | ||
| 3689 | This uses the entries in `speedbar-dynamic-tags-function-list' | ||
| 3690 | to find the proper tags. It is up to each of those individual | ||
| 3691 | functions 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." | |||
| 3548 | Returns the tag list, or t for an error." | 3722 | Returns 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... | ||
| 4176 | Argument VARIABLE is the varible to define. | ||
| 4177 | Argument IMAGESPEC is the list defining the image to create. | ||
| 4178 | Argument 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.. | ||
| 4201 | IMAGESPEC 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. | ||
| 4284 | If buttontext is unknown, just insert that text. | ||
| 4285 | If 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 () |