Mercurial > emacs
comparison lisp/speedbar.el @ 22735:ca02f300fc41
More commentary.
(speedbar-xemacsp) Moved definition.
(speedbar-initial-expansion-mode-list) was
`speedbar-initial-expansion-list' and now has multiple modes.
(speedbar-stealthy-function-list) now has mode labels.
(speedbar-initial-expansion-list-name,
speedbar-previously-used-expansion-list-name,
speedbar-special-mode-key-map, speedbar-track-mouse-flag,
speedbar-tag-hierarchy-method, speedbar-tag-split-minimum-length,
speedbar-tag-regroup-maximum-length,
speedbar-hide-button-brackets-flag) New variables
(speedbar-special-mode-expansion-list) updated documentation.
(speedbar-navigating-speed, speedbar-update-speed) phasing out.
(speedbar-vc-indicator) removed space from this var.
(speedbar-indicator-separator, speedbar-obj-do-check,
speedbar-obj-to-do-point, speedbar-obj-indicator, speedbar-obj-alist,
speedbar-indicator-regex) new variables.
(speedbar-directory-unshown-regexp) New variable.
(speedbar-supported-extension-expressions) Added more extensions.
(speedbar-add-supported-extension,
speedbar-add-ignored-path-regexp) Made interactive.
(speedbar-update-flag) nil w/ no window system.
(speedbar-file-key-map) Moved some key bindings from
`speedbar-key-map' to this map.
(speedbar-make-specialized-keymap) New function.
(speedbar-file-key-map) New key map.
(speedbar-easymenu-definition-special) Updated to new functions.
(speedbar-easymenu-definition-trailer) Changed conditional part.
(speedbar-frame-mode) Removed commented code, fixed W32 cursor
bug, Updated to better handle terminal frames.
(speedbar-switch-buffer-attached-frame) New function.
(speedbar-mode) Updated documentation, no local keymap,
correct `temp-buffer-show-function' use, enable mouse-tracking.
(speedbar-show-info-under-mouse) New function.
(speedbar-reconfigure-keymaps) Was `speedbar-reconfigure-menubar'.
Enable major display mode specific menus & key maps.
(speedbar-temp-buffer-show-function) Fix use of `temp-buffer-show-hook'
(speedbar-track-mouse, speedbar-track-mouse-xemacs) New functions.
(speedbar-restricted-move, speedbar-restricted-next,
speedbar-restricted-prev, speedbar-navigate-list,
speedbar-forward-list, speedbar-backward-list) New commands.
(speedbar-refresh) Updated message printing & verbosity.
(speedbar-item-load) Updated message.
(speedbar-item-byte-compile) Updated doc & reset scanners.
(speedbar-item-info) Overhauled with more details.
(speedbar-item-copy) Update messages.
(speedbar-generic-item-info) New function
(speedbar-item-delete) Update messages.
(speedbar-item-object-delete) New function.
(speedbar-select-window) Update doc. Use `show-buffer'.
(speedbar-make-button) Update doc.
(speedbar-initial-expansion-list, speedbar-initial-menu,
speedbar-initial-keymap, speedbar-initial-stealthy-functions,
speedbar-add-expansion-list,
speedbar-change-initial-expansion-list) New functions.
(speedbar-maybe-add-localized-support,
speedbar-add-localized-speedbar-support,
speedbar-remove-localized-speedbar-support) Imported from speedbspec
(speedbar-file-lists) Filter out some directories.
(speedbar-make-tag-line) Can hide brackets.
(speedbar-change-expand-button-char) Protect invisible text prop.
(speedbar-insert-files-at-point) Ignore case during comares.
(speedbar-apply-one-tag-hierarchy-method,
speedbar-create-tag-hierarchy) New functions.
(speedbar-insert-generic-list) Now calls hierarchy functions on tags.
(speedbar-update-contents) Handles localized support.
(speedbar-update-directory-contents) Uses fn for expansion list,
Fixed directory cacheing bug.
(speedbar-timer-fn) Calls localized support function.
(speedbar-stealthy-update-recurse) New variable
(speedbar-stealthy-updates) Handle new stealth function format.
(speedbar-clear-current-file) Handle indicator regex.
(speedbar-update-current-file) Ignores case, update handle
indicator regex, Fix line positioning.
(speedbar-add-indicator) Handles obj indicators now.
(speedbar-check-objects, speedbar-check-obj-this-line) New functions.
(speedbar-double-click) Fix tripple click error.
(speedbar-line-file, speedbar-goto-this-file) Handle indicator regex.
(speedbar-line-path) Only try to get a file when in "files" display.
(speedbar-line-depth) Handle indicator regex.
(speedbar-dir-follow) Turn of smart-adjust to disable cache use.
(speedbar-directory-buttons-follow) Hack for W32 emacs directories.
(speedbar-buffers-key-map) New key map.
(speedbar-buffer-easymenu-definition) New meny items.
(speedbar-buffer-buttons, speedbar-buffer-buttons-temp,
speedbar-buffer-buttons-engine, speedbar-buffer-click,
speedbar-buffer-kill-buffer, speedbar-buffer-revert-buffer)
New functions.
author | Karl Heuer <kwzh@gnu.org> |
---|---|
date | Fri, 10 Jul 1998 16:48:06 +0000 |
parents | a77d473867b8 |
children | 322179a8fd20 |
comparison
equal
deleted
inserted
replaced
22734:09db8bddedc5 | 22735:ca02f300fc41 |
---|---|
1 ;;; speedbar --- quick access to files and tags | 1 ;;; speedbar --- quick access to files and tags in a frame |
2 | 2 |
3 ;;; Copyright (C) 1996, 97, 98 Free Software Foundation | 3 ;;; Copyright (C) 1996, 97, 98 Free Software Foundation |
4 ;; | 4 |
5 ;; Author: Eric M. Ludlam <zappo@gnu.ai.mit.edu> | 5 ;; Author: Eric M. Ludlam <zappo@gnu.org> |
6 ;; Version: 0.6.2 | 6 ;; Version: 0.7 |
7 ;; Keywords: file, tags, tools, convenience | 7 ;; Keywords: file, tags, tools |
8 ;; | 8 ;; X-RCS: $Id: speedbar.el,v 1.112 1998/06/16 12:53:18 kwzh Exp kwzh $ |
9 | |
9 ;; This file is part of GNU Emacs. | 10 ;; This file is part of GNU Emacs. |
10 ;; | 11 |
11 ;; GNU Emacs is free software; you can redistribute it and/or modify | 12 ;; GNU Emacs is free software; you can redistribute it and/or modify |
12 ;; it under the terms of the GNU General Public License as published by | 13 ;; it under the terms of the GNU General Public License as published by |
13 ;; the Free Software Foundation; either version 2, or (at your option) | 14 ;; the Free Software Foundation; either version 2, or (at your option) |
14 ;; any later version. | 15 ;; any later version. |
15 ;; | 16 |
16 ;; GNU Emacs is distributed in the hope that it will be useful, | 17 ;; GNU Emacs is distributed in the hope that it will be useful, |
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | 18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | 19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
19 ;; GNU General Public License for more details. | 20 ;; GNU General Public License for more details. |
20 ;; | 21 |
21 ;; You should have received a copy of the GNU General Public License | 22 ;; You should have received a copy of the GNU General Public License |
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the | 23 ;; along with GNU Emacs; see the file COPYING. If not, write to the |
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | 24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
24 ;; Boston, MA 02111-1307, USA. | 25 ;; Boston, MA 02111-1307, USA. |
25 | 26 |
30 ;; in order to make the last active frame display that file location. | 31 ;; in order to make the last active frame display that file location. |
31 ;; | 32 ;; |
32 ;; Starting Speedbar: | 33 ;; Starting Speedbar: |
33 ;; | 34 ;; |
34 ;; If speedbar came to you as a part of Emacs, simply type | 35 ;; If speedbar came to you as a part of Emacs, simply type |
35 ;; `M-x speedbar', and it will be autoloaded for you. A "Speedbar" | 36 ;; `M-x speedbar', and it will be autoloaded for you. |
36 ;; submenu will be added under "Tools". | |
37 ;; | 37 ;; |
38 ;; If speedbar is not a part of your distribution, then add | 38 ;; If speedbar is not a part of your distribution, then add |
39 ;; this to your .emacs file: | 39 ;; this to your .emacs file: |
40 ;; | 40 ;; |
41 ;; (autoload 'speedbar-frame-mode "speedbar" "Popup a speedbar frame" t) | 41 ;; (autoload 'speedbar-frame-mode "speedbar" "Popup a speedbar frame" t) |
42 ;; (autoload 'speedbar-get-focus "speedbar" "Jump to speedbar frame" t) | 42 ;; (autoload 'speedbar-get-focus "speedbar" "Jump to speedbar frame" t) |
43 ;; | 43 ;; |
44 ;; If you want to choose it from a menu, you can do this: | 44 ;; If you want to choose it from a menu, such as "Tools", you can do this: |
45 ;; | 45 ;; |
46 ;; Emacs: | 46 ;; Emacs: |
47 ;; (define-key-after (lookup-key global-map [menu-bar tools]) | 47 ;; (define-key-after (lookup-key global-map [menu-bar tools]) |
48 ;; [speedbar] '("Speedbar" . speedbar-frame-mode) [calendar]) | 48 ;; [speedbar] '("Speedbar" . speedbar-frame-mode) [calendar]) |
49 ;; | 49 ;; |
86 ;; regular expression matching a type of path. You may add list | 86 ;; regular expression matching a type of path. You may add list |
87 ;; elements to `speedbar-ignored-path-expressions' as long as it is | 87 ;; elements to `speedbar-ignored-path-expressions' as long as it is |
88 ;; done before speedbar is loaded. | 88 ;; done before speedbar is loaded. |
89 ;; | 89 ;; |
90 ;; To add new file types to imenu, see the documentation in the | 90 ;; To add new file types to imenu, see the documentation in the |
91 ;; file imenu.el that comes with emacs. To add new file types which | 91 ;; file imenu.el that comes with Emacs. To add new file types which |
92 ;; etags supports, you need to modify the variable | 92 ;; etags supports, you need to modify the variable |
93 ;; `speedbar-fetch-etags-parse-list'. | 93 ;; `speedbar-fetch-etags-parse-list'. |
94 ;; | 94 ;; |
95 ;; If the updates are going too slow for you, modify the variable | 95 ;; If the updates are going too slow for you, modify the variable |
96 ;; `speedbar-update-speed' to a longer idle time before updates. | 96 ;; `speedbar-update-speed' to a longer idle time before updates. |
99 ;; will navigate to a directory which is eventually replaced after | 99 ;; will navigate to a directory which is eventually replaced after |
100 ;; you go back to editing a file (unless you pull up a new file.) | 100 ;; you go back to editing a file (unless you pull up a new file.) |
101 ;; The delay time before this happens is in | 101 ;; The delay time before this happens is in |
102 ;; `speedbar-navigating-speed', and defaults to 10 seconds. | 102 ;; `speedbar-navigating-speed', and defaults to 10 seconds. |
103 ;; | 103 ;; |
104 ;; Users XEmacs previous to 20 may want to change the default | 104 ;; To enable mouse tracking with information in the minibuffer of |
105 ;; the attached frame, use the variable `speedbar-track-mouse-flag'. | |
106 ;; | |
107 ;; Tag layout can be modified through `speedbar-tag-hierarchy-method', | |
108 ;; which controls how tags are layed out. It is actually a list of | |
109 ;; functions that filter the data. The default groups large tag lists | |
110 ;; into sub-lists. A long flat list can be used instead if needed. | |
111 ;; Other filters could be easily added. | |
112 ;; | |
113 ;; Users of XEmacs previous to 20 may want to change the default | |
105 ;; timeouts for `speedbar-update-speed' to something longer as XEmacs | 114 ;; timeouts for `speedbar-update-speed' to something longer as XEmacs |
106 ;; doesn't have idle timers, the speedbar timer keeps going off | 115 ;; doesn't have idle timers, the speedbar timer keeps going off |
107 ;; arbitrarily while you're typing. It's quite pesky. | 116 ;; arbitrarily while you're typing. It's quite pesky. |
108 ;; | 117 ;; |
109 ;; Users of really old emacsen without the needed timers will not | 118 ;; Users of really old emacsen without the needed timers will not |
110 ;; have speedbar updating automatically. Use "r" to refresh the | 119 ;; have speedbar updating automatically. Use "r" to refresh the |
111 ;; display after changing directories. Remember, do not interrupt the | 120 ;; display after changing directories. Remember, do not interrupt the |
112 ;; stealthy updates or your display may not be completely refreshed. | 121 ;; stealthy updates or your display may not be completely refreshed. |
113 ;; | 122 ;; |
114 ;; See optional file `speedbspec.el' for additional configurations | |
115 ;; which allow speedbar to create specialized lists for special modes | |
116 ;; that are not file-related. | |
117 ;; | |
118 ;; AUC-TEX users: The imenu tags for AUC-TEX mode don't work very | 123 ;; AUC-TEX users: The imenu tags for AUC-TEX mode don't work very |
119 ;; well. Use the imenu keywords from tex-mode.el for better results. | 124 ;; well. Use the imenu keywords from tex-mode.el for better results. |
120 ;; | 125 ;; |
121 ;; This file requires the library package assoc (association lists) | 126 ;; This file requires the library package assoc (association lists) |
122 ;; and the package custom (for easy configuration of speedbar) | 127 ;; and the package custom (for easy configuration of speedbar) |
123 ;; http://www.dina.kvl.dk/~abraham/custom/ | 128 ;; http://www.dina.kvl.dk/~abraham/custom/ |
124 ;; | 129 ;; |
125 ;; If you do not have custom installed, you can still get face colors | 130 ;;; Developing for speedbar |
126 ;; by modifying the faces directly in your .emacs file, or setting | 131 ;; |
127 ;; them in your .Xdefaults file. | 132 ;; Adding a speedbar specialized display mode: |
128 ;; Here is an example .Xdefaults for a dark background: | 133 ;; |
129 ;; | 134 ;; Speedbar can be configured to create a special display for certain |
130 ;; emacs*speedbar-button-face.attributeForeground: Aquamarine | 135 ;; modes that do not display tradition file/tag data. Rmail, Info, |
131 ;; emacs*speedbar-selected-face.attributeForeground: red | 136 ;; and the debugger are examples. These modes can, however, benefit |
132 ;; emacs*speedbar-selected-face.attributeUnderline: true | 137 ;; from a speedbar style display in their own way. |
133 ;; emacs*speedbar-directory-face.attributeForeground: magenta | 138 ;; |
134 ;; emacs*speedbar-file-face.attributeForeground: green3 | 139 ;; If your `major-mode' is `foo-mode', the only requirement is to |
135 ;; emacs*speedbar-highlight-face.attributeBackground: sea green | 140 ;; create a function called `foo-speedbar-buttons' which takes one |
136 ;; emacs*speedbar-tag-face.attributeForeground: yellow | 141 ;; argument, BUFFER. BUFFER will be the buffer speedbar wants filled. |
137 | 142 ;; In `foo-speedbar-buttons' there are several functions that make |
138 ;;; Speedbar updates can be found at: | 143 ;; building a speedbar display easy. See the documentation for |
139 ;; ftp://ftp.ultranet.com/pub/zappo/speedbar*.tar.gz | 144 ;; `speedbar-with-writable' (needed because the buffer is usually |
140 ;; | 145 ;; read-only) `speedbar-make-tag-line', `speedbar-insert-button', and |
141 | 146 ;; `speedbar-insert-generic-list'. If you use |
142 ;;; Change log: | 147 ;; `speedbar-insert-generic-list', also read the doc for |
143 ;; 0.1 Initial Revision | 148 ;; `speedbar-tag-hierarchy-method' in case you wish to override it. |
144 ;; 0.2 Fixed problem with x-pointer-shape causing future frames not | 149 ;; The function `speedbar-with-attached-buffer' brings you back to the |
145 ;; to be created. | 150 ;; buffer speedbar is displaying for. |
146 ;; Fixed annoying habit of `speedbar-update-contents' to make | 151 ;; |
147 ;; it possible to accidentally kill the speedbar buffer. | 152 ;; For those functions that make buttons, the "function" should be a |
148 ;; Clicking directory names now only changes the contents of | 153 ;; symbol that is the function to call when clicked on. The "token" |
149 ;; the speedbar, and does not cause a dired mode to appear. | 154 ;; is extra data you can pass along. The "function" must take three |
150 ;; Clicking the <+> next to the directory does cause dired to | 155 ;; parameters. They are (TEXT TOKEN INDENT). TEXT is the text of the |
151 ;; be run. | 156 ;; button clicked on. TOKEN is the data passed in when you create the |
152 ;; Added XEmacs support, which means timer support moved to a | 157 ;; button. INDENT is an indentation level, or 0. You can store |
153 ;; platform independant call. | 158 ;; indentation levels with `speedbar-make-tag-line' which creates a |
154 ;; Added imenu support. Now modes are supported by imenu | 159 ;; line with an expander (eg. [+]) and a text button. |
155 ;; first, and etags only if the imenu call doesn't work. | 160 ;; |
156 ;; Imenu is a little faster than etags, and is more emacs | 161 ;; Some useful functions when writing expand functions, and click |
157 ;; friendly. | 162 ;; functions are `speedbar-change-expand-button-char', |
158 ;; Added more user control variables described in the commentary. | 163 ;; `speedbar-delete-subblock', and `speedbar-center-buffer-smartly'. |
159 ;; Added smart recentering when nodes are opened and closed. | 164 ;; The variable `speedbar-power-click' is set to t in your functions |
160 ;; 0.3 x-pointer-shape fixed for emacs 19.35, so I put that check in. | 165 ;; when the user shift-clicks. This indications anything from |
161 ;; Added invisible codes to the beginning of each line. | 166 ;; refreshing cached data to making a buffer appear in a new frame. |
162 ;; Added list aproach to node expansion for easier addition of new | 167 ;; |
163 ;; types of things to expand by | 168 ;; If you wish to add to the default speedbar menu for the case of |
164 ;; Added multi-level path name support | 169 ;; `foo-mode', create a variable `foo-speedbar-menu-items'. This |
165 ;; Added multi-level tag name support. | 170 ;; should be a list compatible with the `easymenu' package. It will |
166 ;; Only mouse-2 is now used for node expansion | 171 ;; be spliced into the main menu. (Available with click-mouse-3). If |
167 ;; Added keys e + - to edit expand, and contract node lines | 172 ;; you wish to have extra key bindings in your special mode, create a |
168 ;; Added longer legal file regexp for all those modes which support | 173 ;; variable `foo-speedbar-key-map'. Instead of using `make-keymap', |
169 ;; imenu. (pascal, fortran90, ada, pearl) | 174 ;; or `make-sparse-keymap', use the function |
170 ;; Added pascal support to etags from Dave Penkler <dave_penkler@grenoble.hp.com> | 175 ;; `speedbar-make-specialized-keymap'. This lets you inherit all of |
171 ;; Fixed centering algorithm | 176 ;; speedbar's default bindings with low overhead. |
172 ;; Tried to choose background independent colors. Made more robust. | 177 ;; |
173 ;; Rearranged code into a more logical order | 178 ;; Adding a speedbar top-level display mode: |
174 ;; 0.3.1 Fixed doc & broken keybindings | 179 ;; |
175 ;; Added mode hooks. | 180 ;; Unlike the specialized modes, there are no name requirements, |
176 ;; Improved color selection to be background mode smart | 181 ;; however the methods for writing a button display, menu, and keymap |
177 ;; `nil' passed to `speedbar-frame-mode' now toggles the frame as | 182 ;; are the same. Once you create these items, you can call the |
178 ;; advertised in the doc string | 183 ;; function `speedbar-add-expansion-list'. It takes one parameter |
179 ;; 0.4a Added modified patch from Dan Schmidt <dfan@lglass.com> allowing a | 184 ;; which is a list element of the form (NAME MENU KEYMAP &rest |
180 ;; directory cache to be maintained speeding up revisiting of files. | 185 ;; BUTTON-FUNCTIONS). NAME is a string that will show up in the |
181 ;; Default raise-lower behavior is now off by default. | 186 ;; Displays menu item. MENU is a symbol containing the menu items to |
182 ;; Added some menu items for edit expand and contract. | 187 ;; splice in. KEYMAP is a symbol holding the keymap to use, and |
183 ;; Pre 19.31 emacsen can run without idle timers. | 188 ;; BUTTON-FUNCTIONS are the function names to call, in order, to create |
184 ;; Added some patch information from Farzin Guilak <farzin@protocol.com> | 189 ;; the display. |
185 ;; adding xemacs specifics, and some etags upgrades. | |
186 ;; Added ability to set a faces symbol-value to a string | |
187 ;; representing the desired foreground color. (idea from | |
188 ;; Farzin Guilak, but implemented differently) | |
189 ;; Fixed problem with 1 character buttons. | |
190 ;; Added support for new Imenu marker technique. | |
191 ;; Added `speedbar-load-hooks' for things to run only once on | |
192 ;; load such as updating one of the many lists. | |
193 ;; Added `speedbar-supported-extension-expressions' which is a | |
194 ;; list of extensions that speedbar will tag. This variable | |
195 ;; should only be updated with `speedbar-add-supported-extension' | |
196 ;; Moved configure dialog support to a separate file so | |
197 ;; speedbar is not dependant on eieio to run | |
198 ;; Fixed list-contraction problem when the item was at the end | |
199 ;; of a sublist. | |
200 ;; Fixed XEmacs multi-frame timer selecting bug problem. | |
201 ;; Added `speedbar-ignored-modes' which is a list of major modes | |
202 ;; speedbar will not follow when it is displayed in the selected frame | |
203 ;; 0.4 When the file being edited is not in the list, and is a file | |
204 ;; that should be in the list, the speedbar cache is replaced. | |
205 ;; Temp buffers are now shown in the attached frame not the | |
206 ;; speedbar frame | |
207 ;; New variables `speedbar-vc-*' and `speedbar-stealthy-function-list' | |
208 ;; added. `speedbar-update-current-file' is now a member of | |
209 ;; the stealthy list. New function `speedbar-check-vc' will | |
210 ;; examine each file and mark it if it is checked out. To | |
211 ;; add new version control types, override the function | |
212 ;; `speedbar-this-file-in-vc' and `speedbar-vc-check-dir-p'. | |
213 ;; The stealth list is interruptible so that long operations | |
214 ;; do not interrupt someones editing flow. Other long | |
215 ;; speedbar updates will be added to the stealthy list in the | |
216 ;; future should interesting ones be needed. | |
217 ;; Added many new functions including: | |
218 ;; `speedbar-item-byte-compile' `speedbar-item-load' | |
219 ;; `speedbar-item-copy' `speedbar-item-rename' `speedbar-item-delete' | |
220 ;; and `speedbar-item-info' | |
221 ;; If the user kills the speedbar buffer in some way, the frame will | |
222 ;; be removed. | |
223 ;; 0.4.1 Bug fixes | |
224 ;; <mark.jeffries@nomura.co.uk> added `speedbar-update-flag', | |
225 ;; XEmacs fixes for menus, and tag sorting, and quit key. | |
226 ;; Modeline now updates itself based on window-width. | |
227 ;; Frame is cached when closed to make pulling it up again faster. | |
228 ;; Speedbars window is now marked as dedicated. | |
229 ;; Added bindings: <grossjoh@charly.informatik.uni-dortmund.de> | |
230 ;; Long directories are now span multiple lines autmoatically | |
231 ;; Added `speedbar-directory-button-trim-method' to specify how to | |
232 ;; sorten the directory button to fit on the screen. | |
233 ;; 0.4.2 Add one level of full-text cache. | |
234 ;; Add `speedbar-get-focus' to switchto/raise the speedbar frame. | |
235 ;; Editing thing-on-line will auto-raise the attached frame. | |
236 ;; Bound `U' to `speedbar-up-directory' command. | |
237 ;; Refresh will now maintain all subdirectories that were open | |
238 ;; when the refresh was requested. (This does not include the | |
239 ;; tags, only the directories) | |
240 ;; 0.4.3 Bug fixes | |
241 ;; 0.4.4 Added `speedbar-ignored-path-expressions' and friends. | |
242 ;; Configuration menu items not displayed if dialog-mode not present | |
243 ;; Speedbar buffer now starts with a space, and is not deleted | |
244 ;; ewhen the speedbar frame is closed. This prevents the invisible | |
245 ;; frame from preventing buffer switches with other buffers. | |
246 ;; Fixed very bad bug in the -add-[extension|path] functions. | |
247 ;; Added `speedbar-find-file-in-frame' which will always pop up a frame | |
248 ;; that is already display a buffer selected in the speedbar buffer. | |
249 ;; Added S-mouse2 as "power click" for always poping up a new frame. | |
250 ;; and always rescanning with imenu (ditching the imenu cache), and | |
251 ;; always rescanning directories. | |
252 ;; 0.4.5 XEmacs bugfixes and enhancements. | |
253 ;; Window Title simplified. | |
254 ;; 0.4.6 Fixed problems w/ dedicated minibuffer frame. | |
255 ;; Fixed errors reported by checkdoc. | |
256 ;; 0.5 Mode-specific contents added. Controlled w/ the variable | |
257 ;; `speedbar-mode-specific-contents-flag'. See speedbspec | |
258 ;; for info on enabling this feature. | |
259 ;; `speedbar-load-hook' name change and pointer check against | |
260 ;; major-mode. Suggested by Sam Steingold <sds@ptc.com> | |
261 ;; Quit auto-selects the attached frame. | |
262 ;; Ranamed `speedbar-do-updates' to `speedbar-update-flag' | |
263 ;; Passes checkdoc. | |
264 ;; 0.5.1 Advice from ptype@dra.hmg.gb: | |
265 ;; Use `post-command-idle-hook' in older emacsen | |
266 ;; `speedbar-sort-tags' now works with imenu. | |
267 ;; Unknown files (marked w/ ?) can now be operated on w/ | |
268 ;; file commands. | |
269 ;; `speedbar-vc-*-hook's for easilly adding new version control systems. | |
270 ;; Checkin/out w/ vc will reset the scanners and update the * marker. | |
271 ;; Fixed ange-ftp require compile time problem. | |
272 ;; Fixed XEmacs menu bar bug. | |
273 ;; Added `speedbar-activity-change-focus-flag' to control if the | |
274 ;; focus changes w/ mouse events. | |
275 ;; Added `speedbar-sort-tags' toggle to the menubar. | |
276 ;; Added `speedbar-smart-directory-expand-flag' to toggle how | |
277 ;; new directories might be inserted into the speedbar hierarchy. | |
278 ;; Added `speedbar-visiting-[tag|file]hook' which is called whenever | |
279 ;; speedbar pulls up a file or tag in the attached frame. Setting | |
280 ;; this to `reposition-window' will do nice things to function tags. | |
281 ;; Fixed text-cache default-directory bug. | |
282 ;; Emacs 20 char= support. | |
283 ;; 0.5.2 Customization | |
284 ;; For older emacsen, you will need to download the new defcustom | |
285 ;; package to get nice faces for speedbar | |
286 ;; mouse1 Double-click is now the same as middle click. | |
287 ;; No mouse pointer shape stuff for XEmacs (is there any?) | |
288 ;; 0.5.3 Regressive support for non-custom enabled emacsen. | |
289 ;; Fixed serious problem w/ 0.5.2 and ignored paths. | |
290 ;; `condition-case' no longer used in timer fcn. | |
291 ;; `speedbar-edit-line' is now smarter w/ special modes. | |
292 ;; 0.5.4 Fixed more problems for Emacs 20 so speedbar loads correctly. | |
293 ;; Updated some documentation strings. | |
294 ;; Added customization menu item, and customized some more variables. | |
295 ;; 0.5.5 Fixed so that there can be no ignored paths | |
296 ;; Added .l & .lsp as lisp, suggested by: sshteingold@cctrading.com | |
297 ;; You can now adjust height in `speedbar-frame-parameters' | |
298 ;; XEmacs fix for use of `local-variable-p' | |
299 ;; 0.5.6 Folded in XEmacs suggestions from Hrvoje Niksic <hniksic@srce.hr> | |
300 ;; Several custom changes (group definitions, trim-method & others) | |
301 ;; Keymap changes, and ways to add menu items. | |
302 ;; Timer use changes for XEmacs 20.4 | |
303 ;; Regular expression enhancements. | |
304 ;; 0.6 Fixed up some frame definition stuff, use more convenience fns. | |
305 ;; Rehashed frame creation code for better compatibility. | |
306 ;; Fixed setting of kill-buffer hook. | |
307 ;; Default speedbar has no menubar, mouse-3 is popup menu, | |
308 ;; XEmacs double-click capability (Hrvoje Niksic <hniksic@srce.hr>) | |
309 ;; General documentation fixup. | |
310 ;; 0.6.1 Fixed button-3 menu for Emacs 20. | |
311 ;; 0.6.2 Added autoload tag to `speedbar-get-focus' | |
312 | 190 |
313 ;;; TODO: | 191 ;;; TODO: |
314 ;; - More functions to create buttons and options | 192 ;; - More functions to create buttons and options |
315 ;; - filtering algorithms to reduce the number of tags/files displayed. | |
316 ;; - Timeout directories we haven't visited in a while. | 193 ;; - Timeout directories we haven't visited in a while. |
317 ;; - Remeber tags when refreshing the display. (Refresh tags too?) | 194 ;; - Remeber tags when refreshing the display. (Refresh tags too?) |
318 ;; - More 'special mode support. | 195 ;; - More 'special mode support. |
319 ;; - C- Mouse 3 menu too much indirection | |
320 | 196 |
321 (require 'assoc) | 197 (require 'assoc) |
322 (require 'easymenu) | 198 (require 'easymenu) |
199 | |
200 (defvar speedbar-xemacsp (string-match "XEmacs" emacs-version) | |
201 "Non-nil if we are running in the XEmacs environment.") | |
202 (defvar speedbar-xemacs20p (and speedbar-xemacsp | |
203 (= emacs-major-version 20))) | |
323 | 204 |
324 ;; From custom web page for compatibility between versions of custom: | 205 ;; From custom web page for compatibility between versions of custom: |
325 (eval-and-compile | 206 (eval-and-compile |
326 (condition-case () | 207 (condition-case () |
327 (require 'custom) | 208 (require 'custom) |
328 (error nil)) | 209 (error nil)) |
329 (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) | 210 (if (and (featurep 'custom) (fboundp 'custom-declare-variable) |
211 ;; Some XEmacsen w/ custom don't have :set keyword. | |
212 ;; This protects them against custom. | |
213 (fboundp 'custom-initialize-set)) | |
330 nil ;; We've got what we needed | 214 nil ;; We've got what we needed |
331 ;; We have the old custom-library, hack around it! | 215 ;; We have the old custom-library, hack around it! |
332 (defmacro defgroup (&rest args) | 216 (defmacro defgroup (&rest args) |
333 nil) | 217 nil) |
334 (defmacro defface (var values doc &rest args) | 218 (defmacro defface (var values doc &rest args) |
359 "Version control display in speedbar." | 243 "Version control display in speedbar." |
360 :prefix "speedbar-" | 244 :prefix "speedbar-" |
361 :group 'speedbar) | 245 :group 'speedbar) |
362 | 246 |
363 ;;; Code: | 247 ;;; Code: |
364 (defvar speedbar-xemacsp (string-match "XEmacs" emacs-version) | 248 (defvar speedbar-initial-expansion-mode-alist |
365 "Non-nil if we are running in the XEmacs environment.") | 249 '(("buffers" speedbar-buffer-easymenu-definition speedbar-buffers-key-map |
366 (defvar speedbar-xemacs20p (and speedbar-xemacsp (= emacs-major-version 20))) | 250 speedbar-buffer-buttons) |
367 | 251 ("quick buffers" speedbar-buffer-easymenu-definition speedbar-buffers-key-map |
368 (defvar speedbar-initial-expansion-list | 252 speedbar-buffer-buttons-temp) |
369 '(speedbar-directory-buttons speedbar-default-directory-list) | 253 ;; Files last, means first in the Displays menu |
370 "List of functions to call to fill in the speedbar buffer. | 254 ("files" speedbar-easymenu-definition-special speedbar-file-key-map |
371 Whenever a top level update is issued all functions in this list are | 255 speedbar-directory-buttons speedbar-default-directory-list) |
372 run. These functions will always get the default directory to use | 256 ) |
373 passed in as the first parameter, and a 0 as the second parameter. | 257 "List of named expansion elements for filling the speedbar frame. |
374 The 0 indicates the uppermost indentation level. They must assume | 258 These expansion lists are only valid for regular files. Special modes |
375 that the cursor is at the position where they start inserting | 259 still get to override this list on a mode-by-mode basis. This list of |
376 buttons.") | 260 lists is of the form (NAME MENU KEYMAP FN1 FN2 ...). NAME is a string |
261 representing the types of things to be displayed. MENU is an easymenu | |
262 structure used when in this mode. KEYMAP is a local keymap to install | |
263 over the regular speedbar keymap. FN1 ... are functions that will be | |
264 called in order. These functions will always get the default | |
265 directory to use passed in as the first parameter, and a 0 as the | |
266 second parameter. The 0 indicates the uppermost indentation level. | |
267 They must assume that the cursor is at the position where they start | |
268 inserting buttons.") | |
269 | |
270 (defcustom speedbar-initial-expansion-list-name "files" | |
271 "A symbol name representing the expansion list to use. | |
272 The expansion list `speedbar-initial-expansion-mode-alist' contains | |
273 the names and associated functions to use for buttons in speedbar." | |
274 :group 'speedbar | |
275 :type '(radio (const :tag "File Directorys" file) | |
276 )) | |
277 | |
278 (defvar speedbar-previously-used-expansion-list-name "files" | |
279 "Save the last expansion list method. | |
280 This is used for returning to a previous expansion list method when | |
281 the user is done with the current expansion list.") | |
377 | 282 |
378 (defvar speedbar-stealthy-function-list | 283 (defvar speedbar-stealthy-function-list |
379 '(speedbar-update-current-file speedbar-check-vc) | 284 '(("files" |
285 speedbar-update-current-file speedbar-check-vc speedbar-check-objects) | |
286 ) | |
380 "List of functions to periodically call stealthily. | 287 "List of functions to periodically call stealthily. |
288 This list is of the form: | |
289 '( (\"NAME\" FUNCTION ...) | |
290 ...) | |
291 where NAME is the name of the major display mode these functions are | |
292 for, and the remaining elements FUNCTION are functions to call in order. | |
381 Each function must return nil if interrupted, or t if completed. | 293 Each function must return nil if interrupted, or t if completed. |
382 Stealthy functions which have a single operation should always return | 294 Stealthy functions which have a single operation should always return |
383 t. Functions which take a long time should maintain a state (where | 295 t. Functions which take a long time should maintain a state (where |
384 they are in their speedbar related calculations) and permit | 296 they are in their speedbar related calculations) and permit |
385 interruption. See `speedbar-check-vc' as a good example.") | 297 interruption. See `speedbar-check-vc' as a good example.") |
390 frame." | 302 frame." |
391 :group 'speedbar | 303 :group 'speedbar |
392 :type 'boolean) | 304 :type 'boolean) |
393 | 305 |
394 (defvar speedbar-special-mode-expansion-list nil | 306 (defvar speedbar-special-mode-expansion-list nil |
395 "Mode specific list of functions to call to fill in speedbar. | 307 "Default function list for creating specialized button lists. |
396 Some modes, such as Info or RMAIL, do not relate quite as easily into | 308 This list is set by modes that wish to have special speedbar displays. |
397 a simple list of files. When this variable is non-nil and buffer-local, | 309 The list is of function names. Each function is called with one |
398 then these functions are used, creating specialized contents. These | 310 parameter BUFFER, the originating buffer. The current buffer is the |
399 functions are called each time the speedbar timer is called. This | 311 speedbar buffer.") |
400 allows a mode to update its contents regularly. | 312 |
401 | 313 (defvar speedbar-special-mode-key-map nil |
402 Each function is called with the default and frame belonging to | 314 "Default keymap used when identifying a specialized display mode. |
403 speedbar, and with one parameter; the buffer requesting | 315 This keymap is local to each buffer that wants to define special keybindings |
404 the speedbar display.") | 316 effective when it's display is shown.") |
405 | 317 |
406 (defcustom speedbar-visiting-file-hook nil | 318 (defcustom speedbar-visiting-file-hook nil |
407 "Hooks run when speedbar visits a file in the selected frame." | 319 "Hooks run when speedbar visits a file in the selected frame." |
408 :group 'speedbar | 320 :group 'speedbar |
409 :type 'hook) | 321 :type 'hook) |
434 Updates occur to allow speedbar to display directory information | 346 Updates occur to allow speedbar to display directory information |
435 relevant to the buffer you are currently editing." | 347 relevant to the buffer you are currently editing." |
436 :group 'speedbar | 348 :group 'speedbar |
437 :type 'integer) | 349 :type 'integer) |
438 | 350 |
439 (defcustom speedbar-navigating-speed 10 | 351 ;; When I moved to a repeating timer, I had the horrible missfortune |
352 ;; of loosing the ability for adaptive speed choice. This update | |
353 ;; speed currently causes long delays when it should have been turned off. | |
354 (defcustom speedbar-navigating-speed speedbar-update-speed | |
440 "*Idle time to wait after navigation commands in speedbar are executed. | 355 "*Idle time to wait after navigation commands in speedbar are executed. |
441 Navigation commands included expanding/contracting nodes, and moving | 356 Navigation commands included expanding/contracting nodes, and moving |
442 between different directories." | 357 between different directories." |
443 :group 'speedbar | 358 :group 'speedbar |
444 :type 'integer) | 359 :type 'integer) |
481 use etags instead. Etags support is not as robust as imenu support." | 396 use etags instead. Etags support is not as robust as imenu support." |
482 :tag "User Imenu" | 397 :tag "User Imenu" |
483 :group 'speedbar | 398 :group 'speedbar |
484 :type 'boolean) | 399 :type 'boolean) |
485 | 400 |
486 (defcustom speedbar-sort-tags nil | 401 (defcustom speedbar-track-mouse-flag t |
487 "*If Non-nil, sort tags in the speedbar display." | 402 "*Non-nil means to display info about the line under the mouse." |
488 :group 'speedbar | 403 :group 'speedbar |
489 :type 'boolean) | 404 :type 'boolean) |
405 | |
406 (defcustom speedbar-sort-tags nil | |
407 "*If Non-nil, sort tags in the speedbar display. *Obsolete*." | |
408 :group 'speedbar | |
409 :type 'boolean) | |
410 | |
411 (defcustom speedbar-tag-hierarchy-method | |
412 '(prefix-group trim-words) | |
413 "*List of methods which speedbar will use to organize tags into groups. | |
414 Groups are defined as expandable meta-tags. Imenu supports such | |
415 things in some languages, such as separating variables from functions. | |
416 Available methods are: | |
417 sort - Sort tags. (sometimes unnecessary) | |
418 trim-words - Trim all tags by a common prefix, broken @ word sections. | |
419 prefix-group - Try to guess groups by prefix. | |
420 simple-group - If imenu already returned some meta groups, stick all | |
421 tags that are not in a group into a sub-group." | |
422 :group 'speedbar | |
423 :type '(repeat | |
424 (radio | |
425 (const :tag "Sort the tags." sort) | |
426 (const :tag "Trim words to common prefix." trim-words) | |
427 (const :tag "Create groups from common prefixes." prefix-group) | |
428 (const :tag "Group loose tags into their own group." simple-group)) | |
429 )) | |
430 | |
431 (defcustom speedbar-tag-split-minimum-length 20 | |
432 "*Minimum length before we stop trying to create sub-lists in tags. | |
433 This is used by all tag-hierarchy methods that break large lists into | |
434 sub-lists." | |
435 :group 'speedbar | |
436 :type 'integer) | |
437 | |
438 (defcustom speedbar-tag-regroup-maximum-length 10 | |
439 "*Maximum length of submenus that are regrouped. | |
440 If the regrouping option is used, then if two or more short subgroups | |
441 are next to each other, then they are combined until this number of | |
442 items is reached." | |
443 :group 'speedbar | |
444 :type 'integer) | |
490 | 445 |
491 (defcustom speedbar-activity-change-focus-flag nil | 446 (defcustom speedbar-activity-change-focus-flag nil |
492 "*Non-nil means the selected frame will change based on activity. | 447 "*Non-nil means the selected frame will change based on activity. |
493 Thus, if a file is selected for edit, the buffer will appear in the | 448 Thus, if a file is selected for edit, the buffer will appear in the |
494 selected frame and the focus will change to that frame." | 449 selected frame and the focus will change to that frame." |
516 are expanded in the current framework. If nil, then the current | 471 are expanded in the current framework. If nil, then the current |
517 hierarchy would be replaced with the new directory." | 472 hierarchy would be replaced with the new directory." |
518 :group 'speedbar | 473 :group 'speedbar |
519 :type 'boolean) | 474 :type 'boolean) |
520 | 475 |
476 (defvar speedbar-hide-button-brackets-flag nil | |
477 "*Non-nil means speedbar will hide the brackets around the + or -.") | |
478 | |
521 (defcustom speedbar-before-popup-hook nil | 479 (defcustom speedbar-before-popup-hook nil |
522 "*Hooks called before popping up the speedbar frame." | 480 "*Hooks called before popping up the speedbar frame." |
523 :group 'speedbar | 481 :group 'speedbar |
524 :type 'hook) | 482 :type 'hook) |
525 | 483 |
543 1 means medium level verbosity. 2 and higher are higher levels of | 501 1 means medium level verbosity. 2 and higher are higher levels of |
544 verbosity." | 502 verbosity." |
545 :group 'speedbar | 503 :group 'speedbar |
546 :type 'integer) | 504 :type 'integer) |
547 | 505 |
506 (defvar speedbar-indicator-separator " " | |
507 "String separating file text from indicator characters.") | |
508 | |
548 (defcustom speedbar-vc-do-check t | 509 (defcustom speedbar-vc-do-check t |
549 "*Non-nil check all files in speedbar to see if they have been checked out. | 510 "*Non-nil check all files in speedbar to see if they have been checked out. |
550 Any file checked out is marked with `speedbar-vc-indicator'" | 511 Any file checked out is marked with `speedbar-vc-indicator'" |
551 :group 'speedbar-vc | 512 :group 'speedbar-vc |
552 :type 'boolean) | 513 :type 'boolean) |
553 | 514 |
554 (defvar speedbar-vc-indicator " *" | 515 (defvar speedbar-vc-indicator "*" |
555 "Text used to mark files which are currently checked out. | 516 "Text used to mark files which are currently checked out. |
556 Currently only RCS is supported. Other version control systems can be | 517 Currently only RCS is supported. Other version control systems can be |
557 added by examining the function `speedbar-this-file-in-vc' and | 518 added by examining the function `speedbar-this-file-in-vc' and |
558 `speedbar-vc-check-dir-p'") | 519 `speedbar-vc-check-dir-p'") |
520 | |
521 (defcustom speedbar-vc-path-enable-hook nil | |
522 "*Return non-nil if the current path should be checked for Version Control. | |
523 Functions in this hook must accept one parameter which is the path | |
524 being checked." | |
525 :group 'speedbar-vc | |
526 :type 'hook) | |
527 | |
528 (defcustom speedbar-vc-in-control-hook nil | |
529 "*Return non-nil if the specified file is under Version Control. | |
530 Functions in this hook must accept two parameters. The PATH of the | |
531 current file, and the FILENAME of the file being checked." | |
532 :group 'speedbar-vc | |
533 :type 'hook) | |
534 | |
535 (defvar speedbar-vc-to-do-point nil | |
536 "Local variable maintaining the current version control check position.") | |
537 | |
538 (defcustom speedbar-obj-do-check t | |
539 "*Non-nil check all files in speedbar to see if they have an object file. | |
540 Any file checked out is marked with `speedbar-obj-indicator', and the | |
541 marking is based on `speedbar-obj-alist'" | |
542 :group 'speedbar-vc | |
543 :type 'boolean) | |
544 | |
545 (defvar speedbar-obj-to-do-point nil | |
546 "Local variable maintaining the current version control check position.") | |
547 | |
548 (defvar speedbar-obj-indicator '("#" . "!") | |
549 "Text used to mark files that have a corresponding hidden object file. | |
550 The car is for an up-to-date object. The cdr is for an out of date object. | |
551 The expression `speedbar-obj-alist' defines who gets tagged.") | |
552 | |
553 (defvar speedbar-obj-alist | |
554 '(("\\.\\([cpC]\\|cpp\\|cc\\)$" . ".o") | |
555 ("\\.el$" . ".elc") | |
556 ("\\.java$" . ".class") | |
557 ("\\.f\\(or\\|90\\|77\\)?$" . ".o") | |
558 ("\\.tex$" . ".dvi") | |
559 ("\\.texi$" . ".info")) | |
560 "Alist of file extensions, and their corresponding object file type.") | |
561 | |
562 (defvar speedbar-indicator-regex | |
563 (concat (regexp-quote speedbar-indicator-separator) | |
564 "\\(" | |
565 (regexp-quote speedbar-vc-indicator) | |
566 "\\|" | |
567 (regexp-quote (car speedbar-obj-indicator)) | |
568 "\\|" | |
569 (regexp-quote (cdr speedbar-obj-indicator)) | |
570 "\\)*") | |
571 "Regular expression used when identifying files. | |
572 Permits stripping of indicator characters from a line.") | |
559 | 573 |
560 (defcustom speedbar-scanner-reset-hook nil | 574 (defcustom speedbar-scanner-reset-hook nil |
561 "*Hook called whenever generic scanners are reset. | 575 "*Hook called whenever generic scanners are reset. |
562 Set this to implement your own scanning / rescan safe functions with | 576 Set this to implement your own scanning / rescan safe functions with |
563 state data." | 577 state data." |
564 :group 'speedbar | 578 :group 'speedbar |
565 :type 'hook) | 579 :type 'hook) |
566 | 580 |
567 (defcustom speedbar-vc-path-enable-hook nil | |
568 "*Return non-nil if the current path should be checked for Version Control. | |
569 Functions in this hook must accept one parameter which is the path | |
570 being checked." | |
571 :group 'speedbar-vc | |
572 :type 'hook) | |
573 | |
574 (defcustom speedbar-vc-in-control-hook nil | |
575 "*Return non-nil if the specified file is under Version Control. | |
576 Functions in this hook must accept two parameters. The PATH of the | |
577 current file, and the FILENAME of the file being checked." | |
578 :group 'speedbar-vc | |
579 :type 'hook) | |
580 | |
581 (defvar speedbar-vc-to-do-point nil | |
582 "Local variable maintaining the current version control check position.") | |
583 | |
584 (defvar speedbar-ignored-modes nil | 581 (defvar speedbar-ignored-modes nil |
585 "*List of major modes which speedbar will not switch directories for.") | 582 "*List of major modes which speedbar will not switch directories for.") |
586 | 583 |
587 (defun speedbar-extension-list-to-regex (extlist) | 584 (defun speedbar-extension-list-to-regex (extlist) |
588 "Takes EXTLIST, a list of extensions and transforms it into regexp. | 585 "Takes EXTLIST, a list of extensions and transforms it into regexp. |
589 All the preceding . are stripped for an optimized expression starting | 586 All the preceding `.' are stripped for an optimized expression starting |
590 with . followed by extensions, followed by full-filenames." | 587 with `.' followed by extensions, followed by full-filenames." |
591 (let ((regex1 nil) (regex2 nil)) | 588 (let ((regex1 nil) (regex2 nil)) |
592 (while extlist | 589 (while extlist |
593 (if (= (string-to-char (car extlist)) ?.) | 590 (if (= (string-to-char (car extlist)) ?.) |
594 (setq regex1 (concat regex1 (if regex1 "\\|" "") | 591 (setq regex1 (concat regex1 (if regex1 "\\|" "") |
595 (substring (car extlist) 1))) | 592 (substring (car extlist) 1))) |
623 :set (lambda (sym val) | 620 :set (lambda (sym val) |
624 (setq speedbar-ignored-path-expressions val | 621 (setq speedbar-ignored-path-expressions val |
625 speedbar-ignored-path-regexp | 622 speedbar-ignored-path-regexp |
626 (speedbar-extension-list-to-regex val)))) | 623 (speedbar-extension-list-to-regex val)))) |
627 | 624 |
625 (defcustom speedbar-directory-unshown-regexp "^\\(CVS\\|RCS\\|SCCS\\)\\'" | |
626 "*Regular expression matching directories not to show in speedbar. | |
627 They should include commonly existing directories which are not | |
628 useful, such as version control." | |
629 :group 'speedbar | |
630 :type 'string) | |
631 | |
628 (defvar speedbar-file-unshown-regexp | 632 (defvar speedbar-file-unshown-regexp |
629 (let ((nstr "") (noext completion-ignored-extensions)) | 633 (let ((nstr "") (noext completion-ignored-extensions)) |
630 (while noext | 634 (while noext |
631 (setq nstr (concat nstr (regexp-quote (car noext)) "\\'" | 635 (setq nstr (concat nstr (regexp-quote (car noext)) "\\'" |
632 (if (cdr noext) "\\|" "")) | 636 (if (cdr noext) "\\|" "")) |
636 It is generated from the variable `completion-ignored-extensions'") | 640 It is generated from the variable `completion-ignored-extensions'") |
637 | 641 |
638 ;; this is dangerous to customize, because the defaults will probably | 642 ;; this is dangerous to customize, because the defaults will probably |
639 ;; change in the future. | 643 ;; change in the future. |
640 (defcustom speedbar-supported-extension-expressions | 644 (defcustom speedbar-supported-extension-expressions |
641 (append '(".[CcHh]\\(\\+\\+\\|pp\\|c\\|h\\)?" ".tex\\(i\\(nfo\\)?\\)?" | 645 (append '(".[ch]\\(\\+\\+\\|pp\\|c\\|h\\|xx\\)?" ".tex\\(i\\(nfo\\)?\\)?" |
642 ".el" ".emacs" ".l" ".lsp" ".p" ".java") | 646 ".el" ".emacs" ".l" ".lsp" ".p" ".java" ".f\\(90\\|77\\|or\\)?") |
643 (if speedbar-use-imenu-flag | 647 (if speedbar-use-imenu-flag |
644 '(".f90" ".ada" ".pl" ".tcl" ".m" | 648 '(".ada" ".pl" ".tcl" ".m" ".scm" ".pm" ".py" |
649 ;; html is not supported by default, but an imenu tags package | |
650 ;; is available. Also, html files are nice to be able to see. | |
651 ".s?html" | |
645 "Makefile\\(\\.in\\)?"))) | 652 "Makefile\\(\\.in\\)?"))) |
646 "*List of regular expressions which will match files supported by tagging. | 653 "*List of regular expressions which will match files supported by tagging. |
647 Do not prefix the `.' char with a double \\ to quote it, as the period | 654 Do not prefix the `.' char with a double \\ to quote it, as the period |
648 will be stripped by a simplified optimizer when compiled into a | 655 will be stripped by a simplified optimizer when compiled into a |
649 singular expression. This variable will be turned into | 656 singular expression. This variable will be turned into |
668 "Add EXTENSION as a new supported extension for speedbar tagging. | 675 "Add EXTENSION as a new supported extension for speedbar tagging. |
669 This should start with a `.' if it is not a complete file name, and | 676 This should start with a `.' if it is not a complete file name, and |
670 the dot should NOT be quoted in with \\. Other regular expression | 677 the dot should NOT be quoted in with \\. Other regular expression |
671 matchers are allowed however. EXTENSION may be a single string or a | 678 matchers are allowed however. EXTENSION may be a single string or a |
672 list of strings." | 679 list of strings." |
680 (interactive "sExtionsion: ") | |
673 (if (not (listp extension)) (setq extension (list extension))) | 681 (if (not (listp extension)) (setq extension (list extension))) |
674 (while extension | 682 (while extension |
675 (if (member (car extension) speedbar-supported-extension-expressions) | 683 (if (member (car extension) speedbar-supported-extension-expressions) |
676 nil | 684 nil |
677 (setq speedbar-supported-extension-expressions | 685 (setq speedbar-supported-extension-expressions |
682 | 690 |
683 (defun speedbar-add-ignored-path-regexp (path-expression) | 691 (defun speedbar-add-ignored-path-regexp (path-expression) |
684 "Add PATH-EXPRESSION as a new ignored path for speedbar tracking. | 692 "Add PATH-EXPRESSION as a new ignored path for speedbar tracking. |
685 This function will modify `speedbar-ignored-path-regexp' and add | 693 This function will modify `speedbar-ignored-path-regexp' and add |
686 PATH-EXPRESSION to `speedbar-ignored-path-expressions'." | 694 PATH-EXPRESSION to `speedbar-ignored-path-expressions'." |
695 (interactive "sPath regex: ") | |
687 (if (not (listp path-expression)) | 696 (if (not (listp path-expression)) |
688 (setq path-expression (list path-expression))) | 697 (setq path-expression (list path-expression))) |
689 (while path-expression | 698 (while path-expression |
690 (if (member (car path-expression) speedbar-ignored-path-expressions) | 699 (if (member (car path-expression) speedbar-ignored-path-expressions) |
691 nil | 700 nil |
700 (setq speedbar-file-regexp (speedbar-extension-list-to-regex | 709 (setq speedbar-file-regexp (speedbar-extension-list-to-regex |
701 speedbar-supported-extension-expressions) | 710 speedbar-supported-extension-expressions) |
702 speedbar-ignored-path-regexp (speedbar-extension-list-to-regex | 711 speedbar-ignored-path-regexp (speedbar-extension-list-to-regex |
703 speedbar-ignored-path-expressions))) | 712 speedbar-ignored-path-expressions))) |
704 | 713 |
705 (defvar speedbar-update-flag (or (fboundp 'run-with-idle-timer) | 714 (defvar speedbar-update-flag (and |
706 (fboundp 'start-itimer) | 715 (or (fboundp 'run-with-idle-timer) |
707 (boundp 'post-command-idle-hook)) | 716 (fboundp 'start-itimer) |
717 (boundp 'post-command-idle-hook)) | |
718 window-system) | |
708 "*Non-nil means to automatically update the display. | 719 "*Non-nil means to automatically update the display. |
709 When this is nil then speedbar will not follow the attached frame's path. | 720 When this is nil then speedbar will not follow the attached frame's path. |
710 When speedbar is active, use: | 721 When speedbar is active, use: |
711 | 722 |
712 \\<speedbar-key-map> `\\[speedbar-toggle-updates]' | 723 \\<speedbar-key-map> `\\[speedbar-toggle-updates]' |
725 (modify-syntax-entry ?( " " speedbar-syntax-table) | 736 (modify-syntax-entry ?( " " speedbar-syntax-table) |
726 (modify-syntax-entry ?) " " speedbar-syntax-table) | 737 (modify-syntax-entry ?) " " speedbar-syntax-table) |
727 (modify-syntax-entry ?[ " " speedbar-syntax-table) | 738 (modify-syntax-entry ?[ " " speedbar-syntax-table) |
728 (modify-syntax-entry ?] " " speedbar-syntax-table)) | 739 (modify-syntax-entry ?] " " speedbar-syntax-table)) |
729 | 740 |
730 | |
731 (defvar speedbar-key-map nil | 741 (defvar speedbar-key-map nil |
732 "Keymap used in speedbar buffer.") | 742 "Keymap used in speedbar buffer.") |
733 | 743 |
734 (if speedbar-key-map | 744 (if speedbar-key-map |
735 nil | 745 nil |
736 (setq speedbar-key-map (make-keymap)) | 746 (setq speedbar-key-map (make-keymap)) |
737 (suppress-keymap speedbar-key-map t) | 747 (suppress-keymap speedbar-key-map t) |
738 | 748 |
739 ;; control | 749 ;; control |
740 (define-key speedbar-key-map "e" 'speedbar-edit-line) | |
741 (define-key speedbar-key-map "\C-m" 'speedbar-edit-line) | |
742 (define-key speedbar-key-map "+" 'speedbar-expand-line) | |
743 (define-key speedbar-key-map "-" 'speedbar-contract-line) | |
744 (define-key speedbar-key-map "g" 'speedbar-refresh) | 750 (define-key speedbar-key-map "g" 'speedbar-refresh) |
745 (define-key speedbar-key-map "t" 'speedbar-toggle-updates) | 751 (define-key speedbar-key-map "t" 'speedbar-toggle-updates) |
746 (define-key speedbar-key-map "q" 'speedbar-close-frame) | 752 (define-key speedbar-key-map "q" 'speedbar-close-frame) |
747 (define-key speedbar-key-map "U" 'speedbar-up-directory) | |
748 | 753 |
749 ;; navigation | 754 ;; navigation |
750 (define-key speedbar-key-map "n" 'speedbar-next) | 755 (define-key speedbar-key-map "n" 'speedbar-next) |
751 (define-key speedbar-key-map "p" 'speedbar-prev) | 756 (define-key speedbar-key-map "p" 'speedbar-prev) |
757 (define-key speedbar-key-map "\M-n" 'speedbar-restricted-next) | |
758 (define-key speedbar-key-map "\M-p" 'speedbar-restricted-prev) | |
759 (define-key speedbar-key-map "\C-\M-n" 'speedbar-forward-list) | |
760 (define-key speedbar-key-map "\C-\M-p" 'speedbar-backward-list) | |
752 (define-key speedbar-key-map " " 'speedbar-scroll-up) | 761 (define-key speedbar-key-map " " 'speedbar-scroll-up) |
753 (define-key speedbar-key-map [delete] 'speedbar-scroll-down) | 762 (define-key speedbar-key-map [delete] 'speedbar-scroll-down) |
754 | 763 |
755 ;; After much use, I suddenly desired in my heart to perform dired | 764 ;; Short cuts I happen to find useful |
756 ;; style operations since the directory was RIGHT THERE! | 765 (define-key speedbar-key-map "r" |
757 (define-key speedbar-key-map "I" 'speedbar-item-info) | 766 (lambda () (interactive) |
758 (define-key speedbar-key-map "B" 'speedbar-item-byte-compile) | 767 (speedbar-change-initial-expansion-list |
759 (define-key speedbar-key-map "L" 'speedbar-item-load) | 768 speedbar-previously-used-expansion-list-name))) |
760 (define-key speedbar-key-map "C" 'speedbar-item-copy) | 769 (define-key speedbar-key-map "b" |
761 (define-key speedbar-key-map "D" 'speedbar-item-delete) | 770 (lambda () (interactive) |
762 (define-key speedbar-key-map "R" 'speedbar-item-rename) | 771 (speedbar-change-initial-expansion-list "quick buffers"))) |
772 (define-key speedbar-key-map "f" | |
773 (lambda () (interactive) | |
774 (speedbar-change-initial-expansion-list "files"))) | |
775 | |
776 ;; Overrides | |
777 (substitute-key-definition 'switch-to-buffer | |
778 'speedbar-switch-buffer-attached-frame | |
779 speedbar-key-map global-map) | |
763 | 780 |
764 (if speedbar-xemacsp | 781 (if speedbar-xemacsp |
765 (progn | 782 (progn |
766 ;; mouse bindings so we can manipulate the items on each line | 783 ;; mouse bindings so we can manipulate the items on each line |
767 (define-key speedbar-key-map 'button2 'speedbar-click) | 784 (define-key speedbar-key-map 'button2 'speedbar-click) |
768 (define-key speedbar-key-map '(shift button2) 'speedbar-power-click) | 785 (define-key speedbar-key-map '(shift button2) 'speedbar-power-click) |
769 (define-key speedbar-key-map 'button3 'speedbar-xemacs-popup-kludge) | 786 ;; Info doc fix from Bob Weiner |
770 (define-key speedbar-key-map '(meta button3) 'speedbar-mouse-item-info)) | 787 (if (featurep 'infodoc) |
788 nil | |
789 (define-key speedbar-key-map 'button3 'speedbar-xemacs-popup-kludge)) | |
790 (define-key speedbar-key-map '(meta button3) 'speedbar-mouse-item-info) | |
791 ) | |
792 | |
771 ;; mouse bindings so we can manipulate the items on each line | 793 ;; mouse bindings so we can manipulate the items on each line |
772 (define-key speedbar-key-map [down-mouse-1] 'speedbar-double-click) | 794 (define-key speedbar-key-map [down-mouse-1] 'speedbar-double-click) |
773 (define-key speedbar-key-map [mouse-2] 'speedbar-click) | 795 (define-key speedbar-key-map [mouse-2] 'speedbar-click) |
774 ;; This is the power click for new frames, or refreshing a cache | 796 ;; This is the power click for new frames, or refreshing a cache |
775 (define-key speedbar-key-map [S-mouse-2] 'speedbar-power-click) | 797 (define-key speedbar-key-map [S-mouse-2] 'speedbar-power-click) |
777 ;;(define-key speedbar-key-map [down-mouse-2] 'speedbar-quick-mouse) | 799 ;;(define-key speedbar-key-map [down-mouse-2] 'speedbar-quick-mouse) |
778 (define-key speedbar-key-map [M-mouse-2] 'speedbar-mouse-item-info) | 800 (define-key speedbar-key-map [M-mouse-2] 'speedbar-mouse-item-info) |
779 | 801 |
780 (define-key speedbar-key-map [down-mouse-3] 'speedbar-emacs-popup-kludge) | 802 (define-key speedbar-key-map [down-mouse-3] 'speedbar-emacs-popup-kludge) |
781 | 803 |
782 ;;***** Disable disabling: Remove menubar completely. | |
783 ;; disable all menus - we don't have a lot of space to play with | |
784 ;; in such a skinny frame. This will cleverly find and nuke some | |
785 ;; user-defined menus as well if they are there. Too bad it | |
786 ;; rely's on the structure of a keymap to work. | |
787 ; (let ((k (lookup-key global-map [menu-bar]))) | |
788 ; (while k | |
789 ; (if (and (listp (car k)) (listp (cdr (car k)))) | |
790 ; (define-key speedbar-key-map (vector 'menu-bar (car (car k))) | |
791 ; 'undefined)) | |
792 ; (setq k (cdr k)))) | |
793 | |
794 ;; This lets the user scroll as if we had a scrollbar... well maybe not | 804 ;; This lets the user scroll as if we had a scrollbar... well maybe not |
795 (define-key speedbar-key-map [mode-line mouse-2] 'speedbar-mouse-hscroll) | 805 (define-key speedbar-key-map [mode-line mouse-2] 'speedbar-mouse-hscroll) |
796 )) | 806 ;; another handy place users might click to get our menu. |
807 (define-key speedbar-key-map [mode-line down-mouse-1] | |
808 'speedbar-emacs-popup-kludge) | |
809 | |
810 ;; Lastly, we want to track the mouse. Play here | |
811 (define-key speedbar-key-map [mouse-movement] 'speedbar-track-mouse) | |
812 )) | |
813 | |
814 (defun speedbar-make-specialized-keymap () | |
815 "Create a keymap for use w/ a speedbar major or minor display mode. | |
816 This basically creates a sparse keymap, and makes it's parent be | |
817 `speedbar-key-map'." | |
818 (let ((k (make-sparse-keymap))) | |
819 (set-keymap-parent k speedbar-key-map) | |
820 k)) | |
821 | |
822 (defvar speedbar-file-key-map nil | |
823 "Keymap used in speedbar buffer while files are displayed.") | |
824 | |
825 (if speedbar-file-key-map | |
826 nil | |
827 (setq speedbar-file-key-map (speedbar-make-specialized-keymap)) | |
828 | |
829 ;; Basic tree features | |
830 (define-key speedbar-file-key-map "e" 'speedbar-edit-line) | |
831 (define-key speedbar-file-key-map "\C-m" 'speedbar-edit-line) | |
832 (define-key speedbar-file-key-map "+" 'speedbar-expand-line) | |
833 (define-key speedbar-file-key-map "-" 'speedbar-contract-line) | |
834 | |
835 ;; file based commands | |
836 (define-key speedbar-file-key-map "U" 'speedbar-up-directory) | |
837 (define-key speedbar-file-key-map "I" 'speedbar-item-info) | |
838 (define-key speedbar-file-key-map "B" 'speedbar-item-byte-compile) | |
839 (define-key speedbar-file-key-map "L" 'speedbar-item-load) | |
840 (define-key speedbar-file-key-map "C" 'speedbar-item-copy) | |
841 (define-key speedbar-file-key-map "D" 'speedbar-item-delete) | |
842 (define-key speedbar-file-key-map "O" 'speedbar-item-object-delete) | |
843 (define-key speedbar-file-key-map "R" 'speedbar-item-rename) | |
844 ) | |
797 | 845 |
798 (defvar speedbar-easymenu-definition-base | 846 (defvar speedbar-easymenu-definition-base |
799 '("Speedbar" | 847 '("Speedbar" |
800 ["Update" speedbar-refresh t] | 848 ["Update" speedbar-refresh t] |
801 ["Auto Update" speedbar-toggle-updates | 849 ["Auto Update" speedbar-toggle-updates |
805 | 853 |
806 (defvar speedbar-easymenu-definition-special | 854 (defvar speedbar-easymenu-definition-special |
807 '(["Edit Item On Line" speedbar-edit-line t] | 855 '(["Edit Item On Line" speedbar-edit-line t] |
808 ["Show All Files" speedbar-toggle-show-all-files | 856 ["Show All Files" speedbar-toggle-show-all-files |
809 :style toggle :selected speedbar-show-unknown-files] | 857 :style toggle :selected speedbar-show-unknown-files] |
810 ["Expand Item" speedbar-expand-line | 858 ["Expand File Tags" speedbar-expand-line |
811 (save-excursion (beginning-of-line) | 859 (save-excursion (beginning-of-line) |
812 (looking-at "[0-9]+: *.\\+. "))] | 860 (looking-at "[0-9]+: *.\\+. "))] |
813 ["Contract Item" speedbar-contract-line | 861 ["Contract File Tags" speedbar-contract-line |
814 (save-excursion (beginning-of-line) | 862 (save-excursion (beginning-of-line) |
815 (looking-at "[0-9]+: *.-. "))] | 863 (looking-at "[0-9]+: *.-. "))] |
816 ["Sort Tags" speedbar-toggle-sorting | 864 ; ["Sort Tags" speedbar-toggle-sorting |
817 :style toggle :selected speedbar-sort-tags] | 865 ; :style toggle :selected speedbar-sort-tags] |
818 "----" | 866 "----" |
819 ["Item Information" speedbar-item-info t] | 867 ["File/Tag Information" speedbar-item-info t] |
820 ["Load Lisp File" speedbar-item-load | 868 ["Load Lisp File" speedbar-item-load |
821 (save-excursion | 869 (save-excursion |
822 (beginning-of-line) | 870 (beginning-of-line) |
823 (looking-at "[0-9]+: *\\[[+-]\\] .+\\(\\.el\\)\\( \\*\\)?$"))] | 871 (looking-at "[0-9]+: *\\[[+-]\\] .+\\(\\.el\\)\\( \\|$\\)"))] |
824 ["Byte Compile File" speedbar-item-byte-compile | 872 ["Byte Compile File" speedbar-item-byte-compile |
825 (save-excursion | 873 (save-excursion |
826 (beginning-of-line) | 874 (beginning-of-line) |
827 (looking-at "[0-9]+: *\\[[+-]\\] .+\\(\\.el\\)\\( \\*\\)?$"))] | 875 (looking-at "[0-9]+: *\\[[+-]\\] .+\\(\\.el\\)\\( \\|$\\)"))] |
828 ["Copy Item" speedbar-item-copy | 876 ["Copy File" speedbar-item-copy |
829 (save-excursion (beginning-of-line) (looking-at "[0-9]+: *\\["))] | 877 (save-excursion (beginning-of-line) (looking-at "[0-9]+: *\\["))] |
830 ["Rename Item" speedbar-item-rename | 878 ["Rename File" speedbar-item-rename |
831 (save-excursion (beginning-of-line) (looking-at "[0-9]+: *[[<]"))] | 879 (save-excursion (beginning-of-line) (looking-at "[0-9]+: *[[<]"))] |
832 ["Delete Item" speedbar-item-delete | 880 ["Delete File" speedbar-item-delete |
833 (save-excursion (beginning-of-line) (looking-at "[0-9]+: *[[<]"))]) | 881 (save-excursion (beginning-of-line) (looking-at "[0-9]+: *[[<]"))] |
882 ["Delete Object" speedbar-item-object-delete | |
883 (save-excursion (beginning-of-line) | |
884 (looking-at "[0-9]+: *\\[[+-]\\] [^ \n]+ \\*?[!#]$"))] | |
885 ) | |
834 "Additional menu items while in file-mode.") | 886 "Additional menu items while in file-mode.") |
835 | 887 |
836 (defvar speedbar-easymenu-definition-trailer | 888 (defvar speedbar-easymenu-definition-trailer |
837 (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) | 889 (list |
838 '("----" | 890 (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) |
839 ["Customize..." speedbar-customize t] | 891 ["Customize..." speedbar-customize t]) |
840 ["Close" speedbar-close-frame t]) | 892 ["Close" speedbar-close-frame t]) |
841 '("----" | |
842 ["Close" speedbar-close-frame t])) | |
843 "Menu items appearing at the end of the speedbar menu.") | 893 "Menu items appearing at the end of the speedbar menu.") |
844 | 894 |
845 (defvar speedbar-desired-buffer nil | 895 (defvar speedbar-desired-buffer nil |
846 "Non-nil when speedbar is showing buttons specific a special mode. | 896 "Non-nil when speedbar is showing buttons specific a special mode. |
847 In this case it is the originating buffer.") | 897 In this case it is the originating buffer.") |
888 `speedbar-mode' will be displayed. Currently, only one speedbar is | 938 `speedbar-mode' will be displayed. Currently, only one speedbar is |
889 supported at a time. | 939 supported at a time. |
890 `speedbar-before-popup-hook' is called before popping up the speedbar frame. | 940 `speedbar-before-popup-hook' is called before popping up the speedbar frame. |
891 `speedbar-before-delete-hook' is called before the frame is deleted." | 941 `speedbar-before-delete-hook' is called before the frame is deleted." |
892 (interactive "P") | 942 (interactive "P") |
893 (if (if (and speedbar-xemacsp (fboundp 'console-on-window-system-p)) | |
894 (not (console-on-window-system-p)) | |
895 (not (symbol-value 'window-system))) | |
896 (error "Speedbar is not useful outside of a windowing environment")) | |
897 ;;; RMS says this should not modify the menu. | |
898 ; (if speedbar-xemacsp | |
899 ; (add-menu-button '("Tools") | |
900 ; ["Speedbar" speedbar-frame-mode | |
901 ; :style toggle | |
902 ; :selected (and (boundp 'speedbar-frame) | |
903 ; (frame-live-p speedbar-frame) | |
904 ; (frame-visible-p speedbar-frame))] | |
905 ; "--") | |
906 ; (define-key-after (lookup-key global-map [menu-bar tools]) | |
907 ; [speedbar] '("Speedbar" . speedbar-frame-mode) [calendar])) | |
908 ;; toggle frame on and off. | 943 ;; toggle frame on and off. |
909 (if (not arg) (if (and (frame-live-p speedbar-frame) | 944 (if (not arg) (if (and (frame-live-p speedbar-frame) |
910 (frame-visible-p speedbar-frame)) | 945 (frame-visible-p speedbar-frame)) |
911 (setq arg -1) (setq arg 1))) | 946 (setq arg -1) (setq arg 1))) |
912 ;; turn the frame off on neg number | 947 ;; turn the frame off on neg number |
954 (list (cons | 989 (list (cons |
955 'height | 990 'height |
956 (if speedbar-xemacsp | 991 (if speedbar-xemacsp |
957 (speedbar-needed-height) | 992 (speedbar-needed-height) |
958 (+ mh (frame-height)))))))) | 993 (+ mh (frame-height)))))))) |
959 (if (< emacs-major-version 20);;a bug is fixed in v20 & later | 994 (if (or (< emacs-major-version 20);;a bug is fixed in v20 |
995 (not (eq window-system 'x))) | |
960 (make-frame params) | 996 (make-frame params) |
961 (let ((x-pointer-shape x-pointer-top-left-arrow) | 997 (let ((x-pointer-shape x-pointer-top-left-arrow) |
962 (x-sensitive-text-pointer-shape x-pointer-hand2)) | 998 (x-sensitive-text-pointer-shape x-pointer-hand2)) |
963 (make-frame params)))))) | 999 (make-frame params)))))) |
964 ;; reset the selection variable | 1000 ;; reset the selection variable |
979 selected. If the speedbar frame is active, then select the attached frame." | 1015 selected. If the speedbar frame is active, then select the attached frame." |
980 (interactive) | 1016 (interactive) |
981 (if (eq (selected-frame) speedbar-frame) | 1017 (if (eq (selected-frame) speedbar-frame) |
982 (if (frame-live-p speedbar-attached-frame) | 1018 (if (frame-live-p speedbar-attached-frame) |
983 (select-frame speedbar-attached-frame)) | 1019 (select-frame speedbar-attached-frame)) |
1020 ;; If updates are off, then refresh the frame (they want it now...) | |
1021 (if (not speedbar-update-flag) | |
1022 (let ((speedbar-update-flag t)) | |
1023 (speedbar-timer-fn))) | |
984 ;; make sure we have a frame | 1024 ;; make sure we have a frame |
985 (if (not (frame-live-p speedbar-frame)) (speedbar-frame-mode 1)) | 1025 (if (not (frame-live-p speedbar-frame)) (speedbar-frame-mode 1)) |
986 ;; go there | 1026 ;; go there |
987 (select-frame speedbar-frame)) | 1027 (select-frame speedbar-frame) |
1028 ) | |
988 (other-frame 0)) | 1029 (other-frame 0)) |
989 | 1030 |
990 (defun speedbar-close-frame () | 1031 (defun speedbar-close-frame () |
991 "Turn off a currently active speedbar." | 1032 "Turn off a currently active speedbar." |
992 (interactive) | 1033 (interactive) |
993 (speedbar-frame-mode -1) | 1034 (speedbar-frame-mode -1) |
994 (select-frame speedbar-attached-frame) | 1035 (select-frame speedbar-attached-frame) |
995 (other-frame 0)) | 1036 (other-frame 0)) |
1037 | |
1038 (defun speedbar-switch-buffer-attached-frame (&optional buffer) | |
1039 "Switch to BUFFER in speedbar's attached frame, and raise that frame. | |
1040 This overrides the default behavior of `switch-to-buffer' which is | |
1041 broken because of the dedicated speedbar frame." | |
1042 (interactive) | |
1043 ;; Assume we are in the speedbar frame. | |
1044 (speedbar-get-focus) | |
1045 ;; Now switch buffers | |
1046 (if buffer | |
1047 (switch-to-buffer buffer) | |
1048 (call-interactively 'switch-to-buffer nil nil))) | |
996 | 1049 |
997 (defmacro speedbar-frame-width () | 1050 (defmacro speedbar-frame-width () |
998 "Return the width of the speedbar frame in characters. | 1051 "Return the width of the speedbar frame in characters. |
999 nil if it doesn't exist." | 1052 nil if it doesn't exist." |
1000 '(frame-width speedbar-frame)) | 1053 '(frame-width speedbar-frame)) |
1030 Files with a `*' character after their name are files checked out of a | 1083 Files with a `*' character after their name are files checked out of a |
1031 version control system. (currently only RCS is supported.) New | 1084 version control system. (currently only RCS is supported.) New |
1032 version control systems can be added by examining the documentation | 1085 version control systems can be added by examining the documentation |
1033 for `speedbar-this-file-in-vc' and `speedbar-vc-check-dir-p' | 1086 for `speedbar-this-file-in-vc' and `speedbar-vc-check-dir-p' |
1034 | 1087 |
1088 Files with a `#' or `!' character after them are source files that | |
1089 have an object file associated with them. The `!' indicates that the | |
1090 files is out of date. You can control what source/object associations | |
1091 exist through the variable `speedbar-obj-alist'. | |
1092 | |
1035 Click on the [+] to display a list of tags from that file. Click on | 1093 Click on the [+] to display a list of tags from that file. Click on |
1036 the [-] to retract the list. Click on the file name to edit the file | 1094 the [-] to retract the list. Click on the file name to edit the file |
1037 in the attached frame. | 1095 in the attached frame. |
1038 | 1096 |
1039 If you open tags, you might find a node starting with {+}, which is a | 1097 If you open tags, you might find a node starting with {+}, which is a |
1046 (save-excursion | 1104 (save-excursion |
1047 (setq speedbar-buffer (set-buffer (get-buffer-create " SPEEDBAR"))) | 1105 (setq speedbar-buffer (set-buffer (get-buffer-create " SPEEDBAR"))) |
1048 (kill-all-local-variables) | 1106 (kill-all-local-variables) |
1049 (setq major-mode 'speedbar-mode) | 1107 (setq major-mode 'speedbar-mode) |
1050 (setq mode-name "Speedbar") | 1108 (setq mode-name "Speedbar") |
1051 (use-local-map speedbar-key-map) | |
1052 (set-syntax-table speedbar-syntax-table) | 1109 (set-syntax-table speedbar-syntax-table) |
1053 (setq font-lock-keywords nil) ;; no font-locking please | 1110 (setq font-lock-keywords nil) ;; no font-locking please |
1054 (setq truncate-lines t) | 1111 (setq truncate-lines t) |
1055 (make-local-variable 'frame-title-format) | 1112 (make-local-variable 'frame-title-format) |
1056 (setq frame-title-format "Speedbar") | 1113 (setq frame-title-format "Speedbar") |
1057 ;; Set this up special just for the speedbar buffer | 1114 ;; Set this up special just for the speedbar buffer |
1058 (if (null default-minibuffer-frame) | 1115 ;; Terminal minibuffer stuff does not require this. |
1116 (if (and window-system (null default-minibuffer-frame)) | |
1059 (progn | 1117 (progn |
1060 (make-local-variable 'default-minibuffer-frame) | 1118 (make-local-variable 'default-minibuffer-frame) |
1061 (setq default-minibuffer-frame speedbar-attached-frame))) | 1119 (setq default-minibuffer-frame speedbar-attached-frame))) |
1120 ;; Correct use of `temp-buffer-show-function': Bob Weiner | |
1121 (if (and (boundp 'temp-buffer-show-hook) | |
1122 (boundp 'temp-buffer-show-function)) | |
1123 (progn (make-local-variable 'temp-buffer-show-hook) | |
1124 (setq temp-buffer-show-hook temp-buffer-show-function))) | |
1062 (make-local-variable 'temp-buffer-show-function) | 1125 (make-local-variable 'temp-buffer-show-function) |
1063 (setq temp-buffer-show-function 'speedbar-temp-buffer-show-function) | 1126 (setq temp-buffer-show-function 'speedbar-temp-buffer-show-function) |
1064 (if speedbar-xemacsp | 1127 (if speedbar-xemacsp |
1065 (progn | 1128 (progn |
1066 ;; Argh! mouse-track-click-hook doesn't understand the | 1129 ;; Argh! mouse-track-click-hook doesn't understand the |
1086 (if (eq (current-buffer) | 1149 (if (eq (current-buffer) |
1087 speedbar-buffer) | 1150 speedbar-buffer) |
1088 (speedbar-frame-mode -1))))) | 1151 (speedbar-frame-mode -1))))) |
1089 t t) | 1152 t t) |
1090 (speedbar-set-mode-line-format) | 1153 (speedbar-set-mode-line-format) |
1091 (if (not speedbar-xemacsp) | 1154 (if speedbar-xemacsp |
1092 (setq auto-show-mode nil)) ;no auto-show for Emacs | 1155 (progn |
1156 (make-local-variable 'mouse-motion-handler) | |
1157 (setq mouse-motion-handler 'speedbar-track-mouse-xemacs)) | |
1158 (if speedbar-track-mouse-flag | |
1159 (progn | |
1160 (make-local-variable 'track-mouse) | |
1161 (setq track-mouse t))) ;this could be messy. | |
1162 (setq auto-show-mode nil)) ;no auto-show for Emacs | |
1093 (run-hooks 'speedbar-mode-hook)) | 1163 (run-hooks 'speedbar-mode-hook)) |
1094 (speedbar-update-contents) | 1164 (speedbar-update-contents) |
1095 speedbar-buffer) | 1165 speedbar-buffer) |
1166 | |
1167 (defun speedbar-show-info-under-mouse (&optional event) | |
1168 "Call the info function for the line under the mouse. | |
1169 Optional EVENT is currently not used." | |
1170 (let ((pos (mouse-position))) ; we ignore event until I use it later. | |
1171 (if (equal (car pos) speedbar-frame) | |
1172 (save-excursion | |
1173 (save-window-excursion | |
1174 (apply 'set-mouse-position pos) | |
1175 (speedbar-item-info)))))) | |
1096 | 1176 |
1097 (defun speedbar-set-mode-line-format () | 1177 (defun speedbar-set-mode-line-format () |
1098 "Set the format of the mode line based on the current speedbar environment. | 1178 "Set the format of the mode line based on the current speedbar environment. |
1099 This gives visual indications of what is up. It EXPECTS the speedbar | 1179 This gives visual indications of what is up. It EXPECTS the speedbar |
1100 frame and window to be the currently active frame and window." | 1180 frame and window to be the currently active frame and window." |
1130 If a user requests help using \\[help-command] <Key> the temp BUFFER will be | 1210 If a user requests help using \\[help-command] <Key> the temp BUFFER will be |
1131 redirected into a window on the attached frame." | 1211 redirected into a window on the attached frame." |
1132 (if speedbar-attached-frame (select-frame speedbar-attached-frame)) | 1212 (if speedbar-attached-frame (select-frame speedbar-attached-frame)) |
1133 (pop-to-buffer buffer nil) | 1213 (pop-to-buffer buffer nil) |
1134 (other-window -1) | 1214 (other-window -1) |
1135 (run-hooks 'temp-buffer-show-hook)) | 1215 ;; Fix for using this hook: Bob Weiner |
1136 | 1216 (cond ((fboundp 'run-hook-with-args) |
1137 (defun speedbar-reconfigure-menubar () | 1217 (run-hook-with-args 'temp-buffer-show-hook buffer)) |
1218 ((and (boundp 'temp-buffer-show-hook) | |
1219 (listp temp-buffer-show-hook)) | |
1220 (mapcar (function (lambda (hook) (funcall hook buffer))) | |
1221 temp-buffer-show-hook)))) | |
1222 | |
1223 (defun speedbar-reconfigure-keymaps () | |
1138 "Reconfigure the menu-bar in a speedbar frame. | 1224 "Reconfigure the menu-bar in a speedbar frame. |
1139 Different menu items are displayed depending on the current display mode | 1225 Different menu items are displayed depending on the current display mode |
1140 and the existence of packages." | 1226 and the existence of packages." |
1141 (let ((md (append speedbar-easymenu-definition-base | 1227 (let ((md (append |
1142 (if speedbar-shown-directories | 1228 speedbar-easymenu-definition-base |
1143 ;; file display mode version | 1229 (if speedbar-shown-directories |
1144 speedbar-easymenu-definition-special | 1230 ;; file display mode version |
1145 (save-excursion | 1231 (speedbar-initial-menu) |
1146 (select-frame speedbar-attached-frame) | 1232 (save-excursion |
1147 (if (local-variable-p | 1233 (select-frame speedbar-attached-frame) |
1148 'speedbar-easymenu-definition-special | 1234 (if (local-variable-p |
1149 (current-buffer)) | 1235 'speedbar-easymenu-definition-special |
1150 ;; If bound locally, we can use it | 1236 (current-buffer)) |
1151 speedbar-easymenu-definition-special))) | 1237 ;; If bound locally, we can use it |
1152 ;; The trailer | 1238 speedbar-easymenu-definition-special))) |
1153 speedbar-easymenu-definition-trailer))) | 1239 ;; Dynamic menu stuff |
1154 (easy-menu-define speedbar-menu-map speedbar-key-map "Speedbar menu" md) | 1240 '("-") |
1155 (if speedbar-xemacsp | 1241 (list (cons "Displays" |
1156 (save-excursion | 1242 (let ((displays nil) |
1157 (set-buffer speedbar-buffer) | 1243 (alist speedbar-initial-expansion-mode-alist)) |
1158 ;; For the benefit of button3 | 1244 (while alist |
1159 (if (and (not (assoc "Speedbar" mode-popup-menu))) | 1245 (setq displays |
1160 (easy-menu-add md)) | 1246 (cons |
1161 (set-buffer-menubar (list md))) | 1247 (vector |
1162 (easy-menu-add md)))) | 1248 (capitalize (car (car alist))) |
1249 (list | |
1250 'speedbar-change-initial-expansion-list | |
1251 (car (car alist))) | |
1252 t) | |
1253 displays)) | |
1254 (setq alist (cdr alist))) | |
1255 displays))) | |
1256 ;; The trailer | |
1257 speedbar-easymenu-definition-trailer)) | |
1258 (localmap (save-excursion | |
1259 (let ((cf (selected-frame))) | |
1260 (prog2 | |
1261 (select-frame speedbar-attached-frame) | |
1262 (if (local-variable-p | |
1263 'speedbar-special-mode-key-map | |
1264 (current-buffer)) | |
1265 speedbar-special-mode-key-map) | |
1266 (select-frame cf)))))) | |
1267 (save-excursion | |
1268 (set-buffer speedbar-buffer) | |
1269 (use-local-map (or localmap | |
1270 (speedbar-initial-keymap) | |
1271 ;; This creates a small keymap we can glom the | |
1272 ;; menu adjustments into. | |
1273 (speedbar-make-specialized-keymap))) | |
1274 (if (not speedbar-xemacsp) | |
1275 (easy-menu-define speedbar-menu-map (current-local-map) | |
1276 "Speedbar menu" md) | |
1277 (if (and (not (assoc "Speedbar" mode-popup-menu))) | |
1278 (easy-menu-add md (current-local-map))) | |
1279 (set-buffer-menubar (list md)))))) | |
1163 | 1280 |
1164 | 1281 |
1165 ;;; User Input stuff | 1282 ;;; User Input stuff |
1166 ;; | 1283 ;; |
1167 | 1284 |
1193 (select-frame speedbar-attached-frame) | 1310 (select-frame speedbar-attached-frame) |
1194 (customize-group 'speedbar) | 1311 (customize-group 'speedbar) |
1195 (select-frame sf)) | 1312 (select-frame sf)) |
1196 (speedbar-maybee-jump-to-attached-frame)) | 1313 (speedbar-maybee-jump-to-attached-frame)) |
1197 | 1314 |
1315 (defun speedbar-track-mouse (event) | |
1316 "For motion EVENT, display info about the current line." | |
1317 (interactive "e") | |
1318 (if (not speedbar-track-mouse-flag) | |
1319 nil | |
1320 (save-excursion | |
1321 (let ((char (nth 1 (car (cdr event))))) | |
1322 (if (not (numberp char)) | |
1323 (message nil) | |
1324 (goto-char char) | |
1325 ;; (message "%S" event) | |
1326 (speedbar-item-info) | |
1327 ))))) | |
1328 | |
1329 (defun speedbar-track-mouse-xemacs (event) | |
1330 "For motion EVENT, display info about the current line." | |
1331 (if (functionp (default-value 'mouse-motion-handler)) | |
1332 (funcall (default-value 'mouse-motion-handler) event)) | |
1333 (if speedbar-track-mouse-flag | |
1334 (save-excursion | |
1335 (save-window-excursion | |
1336 (condition-case () | |
1337 (progn (mouse-set-point event) | |
1338 ;; Prevent focus-related bugs. | |
1339 (if (eq major-mode 'speedbar-mode) | |
1340 (speedbar-item-info))) | |
1341 (error nil)))))) | |
1342 | |
1198 ;; In XEmacs, we make popup menus work on the item over mouse (as | 1343 ;; In XEmacs, we make popup menus work on the item over mouse (as |
1199 ;; opposed to where the point happens to be.) We attain this by | 1344 ;; opposed to where the point happens to be.) We attain this by |
1200 ;; temporarily moving the point to that place. | 1345 ;; temporarily moving the point to that place. |
1201 ;; Hrvoje Niksic <hniksic@srce.hr> | 1346 ;; Hrvoje Niksic <hniksic@srce.hr> |
1202 (defun speedbar-xemacs-popup-kludge (event) | 1347 (defun speedbar-xemacs-popup-kludge (event) |
1203 "Pop up a menu related to the clicked on item. | 1348 "Pop up a menu related to the clicked on item. |
1204 Must be bound to EVENT." | 1349 Must be bound to EVENT." |
1205 (interactive "e") | 1350 (interactive "e") |
1351 (select-frame speedbar-frame) | |
1206 (save-excursion | 1352 (save-excursion |
1207 (goto-char (event-closest-point event)) | 1353 (goto-char (event-closest-point event)) |
1208 (beginning-of-line) | 1354 (beginning-of-line) |
1209 (forward-char (min 5 (- (save-excursion (end-of-line) (point)) | 1355 (forward-char (min 5 (- (save-excursion (end-of-line) (point)) |
1210 (save-excursion (beginning-of-line) (point))))) | 1356 (save-excursion (beginning-of-line) (point))))) |
1239 (defun speedbar-prev (arg) | 1385 (defun speedbar-prev (arg) |
1240 "Move to the previous ARGth line in a speedbar buffer." | 1386 "Move to the previous ARGth line in a speedbar buffer." |
1241 (interactive "p") | 1387 (interactive "p") |
1242 (speedbar-next (if arg (- arg) -1))) | 1388 (speedbar-next (if arg (- arg) -1))) |
1243 | 1389 |
1390 (defun speedbar-restricted-move (arg) | |
1391 "Move to the next ARGth line in a speedbar buffer at the same depth. | |
1392 This means that movement is restricted to a subnode, and that siblings | |
1393 of intermediate nodes are skipped." | |
1394 (if (not (numberp arg)) (signal 'wrong-type-argument (list arg 'numberp))) | |
1395 ;; First find the extent for which we are allowed to move. | |
1396 (let ((depth (save-excursion (beginning-of-line) | |
1397 (if (looking-at "[0-9]+:") | |
1398 (string-to-int (match-string 0)) | |
1399 0))) | |
1400 (crement (if (< arg 0) 1 -1)) ; decrement or increment | |
1401 (lastmatch (point))) | |
1402 (while (/= arg 0) | |
1403 (forward-line (- crement)) | |
1404 (let ((subdepth (save-excursion (beginning-of-line) | |
1405 (if (looking-at "[0-9]+:") | |
1406 (string-to-int (match-string 0)) | |
1407 0)))) | |
1408 (cond ((or (< subdepth depth) | |
1409 (progn (end-of-line) (eobp)) | |
1410 (progn (beginning-of-line) (bobp))) | |
1411 ;; We have reached the end of this block. | |
1412 (goto-char lastmatch) | |
1413 (setq arg 0) | |
1414 (error "End of sub-list")) | |
1415 ((= subdepth depth) | |
1416 (setq lastmatch (point) | |
1417 arg (+ arg crement)))))) | |
1418 (speedbar-position-cursor-on-line))) | |
1419 | |
1420 (defun speedbar-restricted-next (arg) | |
1421 "Move to the next ARGth line in a speedbar buffer at the same depth. | |
1422 This means that movement is restricted to a subnode, and that siblings | |
1423 of intermediate nodes are skipped." | |
1424 (interactive "p") | |
1425 (speedbar-restricted-move (or arg 1)) | |
1426 (speedbar-item-info)) | |
1427 | |
1428 | |
1429 (defun speedbar-restricted-prev (arg) | |
1430 "Move to the previous ARGth line in a speedbar buffer at the same depth. | |
1431 This means that movement is restricted to a subnode, and that siblings | |
1432 of intermediate nodes are skipped." | |
1433 (interactive "p") | |
1434 (speedbar-restricted-move (if arg (- arg) -1)) | |
1435 (speedbar-item-info)) | |
1436 | |
1437 (defun speedbar-navigate-list (arg) | |
1438 "Move across ARG groups of similarly typed items in speedbar. | |
1439 Stop on the first line of the next type of item, or on the last or first item | |
1440 if we reach a buffer boundary." | |
1441 (interactive "p") | |
1442 (beginning-of-line) | |
1443 (if (looking-at "[0-9]+: *[[<{][-+?][]>}] ") | |
1444 (let ((str (regexp-quote (match-string 0)))) | |
1445 (while (looking-at str) | |
1446 (speedbar-restricted-move arg) | |
1447 (beginning-of-line)))) | |
1448 (speedbar-position-cursor-on-line)) | |
1449 | |
1450 (defun speedbar-forward-list () | |
1451 "Move forward over the current list. | |
1452 A LIST in speedbar is a group of similarly typed items, such as directories, | |
1453 files, or the directory button." | |
1454 (interactive) | |
1455 (speedbar-navigate-list 1) | |
1456 (speedbar-item-info)) | |
1457 | |
1458 (defun speedbar-backward-list () | |
1459 "Move backward over the current list. | |
1460 A LIST in speedbar is a group of similarly typed items, such as directories, | |
1461 files, or the directory button." | |
1462 (interactive) | |
1463 (speedbar-navigate-list -1) | |
1464 (speedbar-item-info)) | |
1465 | |
1244 (defun speedbar-scroll-up (&optional arg) | 1466 (defun speedbar-scroll-up (&optional arg) |
1245 "Page down one screen-full of the speedbar, or ARG lines." | 1467 "Page down one screen-full of the speedbar, or ARG lines." |
1246 (interactive "P") | 1468 (interactive "P") |
1247 (scroll-up arg) | 1469 (scroll-up arg) |
1248 (speedbar-position-cursor-on-line)) | 1470 (speedbar-position-cursor-on-line)) |
1272 (if (<= 1 speedbar-verbosity-level) (message "Refreshing speedbar...")) | 1494 (if (<= 1 speedbar-verbosity-level) (message "Refreshing speedbar...")) |
1273 (speedbar-update-contents) | 1495 (speedbar-update-contents) |
1274 (speedbar-stealthy-updates) | 1496 (speedbar-stealthy-updates) |
1275 ;; Reset the timer in case it got really hosed for some reason... | 1497 ;; Reset the timer in case it got really hosed for some reason... |
1276 (speedbar-set-timer speedbar-update-speed) | 1498 (speedbar-set-timer speedbar-update-speed) |
1277 (if (<= 1 speedbar-verbosity-level) (message "Refreshing speedbar...done"))) | 1499 (if (<= 1 speedbar-verbosity-level) |
1500 (progn | |
1501 (message "Refreshing speedbar...done") | |
1502 (sit-for 0) | |
1503 (message nil)))) | |
1278 | 1504 |
1279 (defun speedbar-item-load () | 1505 (defun speedbar-item-load () |
1280 "Load the item under the cursor or mouse if it is a lisp file." | 1506 "Load the item under the cursor or mouse if it is a Lisp file." |
1281 (interactive) | 1507 (interactive) |
1282 (let ((f (speedbar-line-file))) | 1508 (let ((f (speedbar-line-file))) |
1283 (if (and (file-exists-p f) (string-match "\\.el\\'" f)) | 1509 (if (and (file-exists-p f) (string-match "\\.el\\'" f)) |
1284 (if (and (file-exists-p (concat f "c")) | 1510 (if (and (file-exists-p (concat f "c")) |
1285 (y-or-n-p (format "Load %sc? " f))) | 1511 (y-or-n-p (format "Load %sc? " f))) |
1286 ;; If the compiled version exists, load that instead... | 1512 ;; If the compiled version exists, load that instead... |
1287 (load-file (concat f "c")) | 1513 (load-file (concat f "c")) |
1288 (load-file f)) | 1514 (load-file f)) |
1289 (error "Not a loadable file...")))) | 1515 (error "Not a loadable file")))) |
1290 | 1516 |
1291 (defun speedbar-item-byte-compile () | 1517 (defun speedbar-item-byte-compile () |
1292 "Byte compile the item under the cursor or mouse if it is a lisp file." | 1518 "Byte compile the item under the cursor or mouse if it is a Lisp file." |
1293 (interactive) | 1519 (interactive) |
1294 (let ((f (speedbar-line-file)) | 1520 (let ((f (speedbar-line-file)) |
1295 (sf (selected-frame))) | 1521 (sf (selected-frame))) |
1296 (if (and (file-exists-p f) (string-match "\\.el\\'" f)) | 1522 (if (and (file-exists-p f) (string-match "\\.el\\'" f)) |
1297 (progn | 1523 (progn |
1298 (select-frame speedbar-attached-frame) | 1524 (select-frame speedbar-attached-frame) |
1299 (byte-compile-file f nil) | 1525 (byte-compile-file f nil) |
1300 (select-frame sf))) | 1526 (select-frame sf) |
1527 (speedbar-reset-scanners))) | |
1301 )) | 1528 )) |
1302 | 1529 |
1303 (defun speedbar-mouse-item-info (event) | 1530 (defun speedbar-mouse-item-info (event) |
1304 "Provide information about what the user clicked on. | 1531 "Provide information about what the user clicked on. |
1305 This should be bound to a mouse EVENT." | 1532 This should be bound to a mouse EVENT." |
1306 (interactive "e") | 1533 (interactive "e") |
1307 (mouse-set-point event) | 1534 (mouse-set-point event) |
1308 (speedbar-item-info)) | 1535 (speedbar-item-info)) |
1309 | 1536 |
1537 (defun speedbar-generic-item-info () | |
1538 "Attempt to derive, and then display information about thils line item. | |
1539 File style information is displayed with `speedbar-item-info'." | |
1540 (save-excursion | |
1541 (beginning-of-line) | |
1542 ;; Skip invisible number info. | |
1543 (if (looking-at "\\([0-9]+\\):") (goto-char (match-end 0))) | |
1544 ;; Skip items in "folder" type text characters. | |
1545 (if (looking-at "\\s-*[[<({].[]>)}] ") (goto-char (match-end 0))) | |
1546 ;; Get the text | |
1547 (message "Text: %s" (buffer-substring-no-properties | |
1548 (point) (progn (end-of-line) (point)))))) | |
1549 | |
1310 (defun speedbar-item-info () | 1550 (defun speedbar-item-info () |
1311 "Display info in the mini-buffer about the button the mouse is over." | 1551 "Display info in the mini-buffer about the button the mouse is over." |
1312 (interactive) | 1552 (interactive) |
1313 (if (not speedbar-shown-directories) | 1553 (if (not speedbar-shown-directories) |
1314 nil | 1554 (speedbar-generic-item-info) |
1315 (let* ((item (speedbar-line-file)) | 1555 (let* ((item (speedbar-line-file)) |
1316 (attr (if item (file-attributes item) nil))) | 1556 (attr (if item (file-attributes item) nil))) |
1317 (if item (message "%s %d %s" (nth 8 attr) (nth 7 attr) item) | 1557 (if (and item attr) (message "%s %-6d %s" (nth 8 attr) (nth 7 attr) item) |
1318 (save-excursion | 1558 (save-excursion |
1319 (beginning-of-line) | 1559 (beginning-of-line) |
1320 (looking-at "\\([0-9]+\\):") | 1560 (if (not (looking-at "\\([0-9]+\\):")) |
1321 (setq item (speedbar-line-path (string-to-int (match-string 1)))) | 1561 (speedbar-generic-item-info) |
1322 (if (re-search-forward "> \\([^ ]+\\)$" | 1562 (setq item (speedbar-line-path (string-to-int (match-string 1)))) |
1323 (save-excursion(end-of-line)(point)) t) | 1563 (if (re-search-forward "> \\([^ ]+\\)$" |
1324 (progn | 1564 (save-excursion(end-of-line)(point)) t) |
1325 (setq attr (get-text-property (match-beginning 1) | 1565 (progn |
1326 'speedbar-token)) | 1566 (setq attr (get-text-property (match-beginning 1) |
1327 (message "Tag %s in %s at position %s" | 1567 'speedbar-token)) |
1328 (match-string 1) item (if attr attr 0))) | 1568 (message "Tag: %s in %s @ %s" |
1329 (message "No special info for this line."))) | 1569 (match-string 1) item |
1330 )))) | 1570 (if attr |
1571 (if (markerp attr) (marker-position attr) attr) | |
1572 0))) | |
1573 (if (re-search-forward "{[+-]} \\([^\n]+\\)$" | |
1574 (save-excursion(end-of-line)(point)) t) | |
1575 (message "Group of tags \"%s\"" (match-string 1)) | |
1576 (speedbar-generic-item-info))))))))) | |
1331 | 1577 |
1332 (defun speedbar-item-copy () | 1578 (defun speedbar-item-copy () |
1333 "Copy the item under the cursor. | 1579 "Copy the item under the cursor. |
1334 Files can be copied to new names or places." | 1580 Files can be copied to new names or places." |
1335 (interactive) | 1581 (interactive) |
1336 (let ((f (speedbar-line-file))) | 1582 (let ((f (speedbar-line-file))) |
1337 (if (not f) (error "Not a file.")) | 1583 (if (not f) (error "Not a file")) |
1338 (if (file-directory-p f) | 1584 (if (file-directory-p f) |
1339 (error "Cannot copy directory.") | 1585 (error "Cannot copy directory") |
1340 (let* ((rt (read-file-name (format "Copy %s to: " | 1586 (let* ((rt (read-file-name (format "Copy %s to: " |
1341 (file-name-nondirectory f)) | 1587 (file-name-nondirectory f)) |
1342 (file-name-directory f))) | 1588 (file-name-directory f))) |
1343 (refresh (member (expand-file-name (file-name-directory rt)) | 1589 (refresh (member (expand-file-name (file-name-directory rt)) |
1344 speedbar-shown-directories))) | 1590 speedbar-shown-directories))) |
1385 (if refresh | 1631 (if refresh |
1386 (progn | 1632 (progn |
1387 (speedbar-refresh) | 1633 (speedbar-refresh) |
1388 (speedbar-goto-this-file rt) | 1634 (speedbar-goto-this-file rt) |
1389 ))))) | 1635 ))))) |
1390 (error "Not a file.")))) | 1636 (error "Not a file")))) |
1391 | 1637 |
1392 (defun speedbar-item-delete () | 1638 (defun speedbar-item-delete () |
1393 "Delete the item under the cursor. Files are removed from disk." | 1639 "Delete the item under the cursor. Files are removed from disk." |
1394 (interactive) | 1640 (interactive) |
1395 (let ((f (speedbar-line-file))) | 1641 (let ((f (speedbar-line-file))) |
1396 (if (not f) (error "Not a file.")) | 1642 (if (not f) (error "Not a file")) |
1397 (if (y-or-n-p (format "Delete %s? " f)) | 1643 (if (y-or-n-p (format "Delete %s? " f)) |
1398 (progn | 1644 (progn |
1399 (if (file-directory-p f) | 1645 (if (file-directory-p f) |
1400 (delete-directory f) | 1646 (delete-directory f) |
1401 (delete-file f)) | 1647 (delete-file f)) |
1403 (let ((p (point))) | 1649 (let ((p (point))) |
1404 (speedbar-refresh) | 1650 (speedbar-refresh) |
1405 (goto-char p)) | 1651 (goto-char p)) |
1406 )) | 1652 )) |
1407 )) | 1653 )) |
1654 | |
1655 (defun speedbar-item-object-delete () | |
1656 "Delete the object associated from the item under the cursor. | |
1657 The file is removed from disk. The object is determined from the | |
1658 variable `speedbar-obj-alist'." | |
1659 (interactive) | |
1660 (let* ((f (speedbar-line-file)) | |
1661 (obj nil) | |
1662 (oa speedbar-obj-alist)) | |
1663 (if (not f) (error "Not a file")) | |
1664 (while (and oa (not (string-match (car (car oa)) f))) | |
1665 (setq oa (cdr oa))) | |
1666 (setq obj (concat (file-name-sans-extension f) (cdr (car oa)))) | |
1667 (if (and oa (file-exists-p obj) | |
1668 (y-or-n-p (format "Delete %s? " obj))) | |
1669 (progn | |
1670 (delete-file obj) | |
1671 (speedbar-reset-scanners))))) | |
1408 | 1672 |
1409 (defun speedbar-enable-update () | 1673 (defun speedbar-enable-update () |
1410 "Enable automatic updating in speedbar via timers." | 1674 "Enable automatic updating in speedbar via timers." |
1411 (interactive) | 1675 (interactive) |
1412 (setq speedbar-update-flag t) | 1676 (setq speedbar-update-flag t) |
1499 '(toggle-read-only -1) | 1763 '(toggle-read-only -1) |
1500 (cons 'progn forms))) | 1764 (cons 'progn forms))) |
1501 (put 'speedbar-with-writable 'lisp-indent-function 0) | 1765 (put 'speedbar-with-writable 'lisp-indent-function 0) |
1502 | 1766 |
1503 (defun speedbar-select-window (buffer) | 1767 (defun speedbar-select-window (buffer) |
1504 "Select a window in which BUFFER is show. | 1768 "Select a window in which BUFFER is shown. |
1505 If it is not shown, force it to appear in the default window." | 1769 If it is not shown, force it to appear in the default window." |
1506 (let ((win (get-buffer-window buffer speedbar-attached-frame))) | 1770 (let ((win (get-buffer-window buffer speedbar-attached-frame))) |
1507 (if win | 1771 (if win |
1508 (select-window win) | 1772 (select-window win) |
1509 (show-buffer (selected-window) buffer)))) | 1773 (set-window-buffer (selected-window) buffer)))) |
1510 | 1774 |
1511 (defmacro speedbar-with-attached-buffer (&rest forms) | 1775 (defmacro speedbar-with-attached-buffer (&rest forms) |
1512 "Execute FORMS in the attached frame's special buffer. | 1776 "Execute FORMS in the attached frame's special buffer. |
1513 Optionally select that frame if necessary." | 1777 Optionally select that frame if necessary." |
1514 ;; Reset the timer with a new timeout when cliking a file | 1778 ;; Reset the timer with a new timeout when cliking a file |
1548 (put-text-property start (point) 'mouse-face nil))) | 1812 (put-text-property start (point) 'mouse-face nil))) |
1549 | 1813 |
1550 (defun speedbar-make-button (start end face mouse function &optional token) | 1814 (defun speedbar-make-button (start end face mouse function &optional token) |
1551 "Create a button from START to END, with FACE as the display face. | 1815 "Create a button from START to END, with FACE as the display face. |
1552 MOUSE is the mouse face. When this button is clicked on FUNCTION | 1816 MOUSE is the mouse face. When this button is clicked on FUNCTION |
1553 will be run with the TOKEN parameter (any lisp object)" | 1817 will be run with the TOKEN parameter (any Lisp object)" |
1554 (put-text-property start end 'face face) | 1818 (put-text-property start end 'face face) |
1555 (put-text-property start end 'mouse-face mouse) | 1819 (put-text-property start end 'mouse-face mouse) |
1556 (put-text-property start end 'invisible nil) | 1820 (put-text-property start end 'invisible nil) |
1557 (if function (put-text-property start end 'speedbar-function function)) | 1821 (if function (put-text-property start end 'speedbar-function function)) |
1558 (if token (put-text-property start end 'speedbar-token token)) | 1822 (if token (put-text-property start end 'speedbar-token token)) |
1559 ) | 1823 ) |
1824 | |
1825 ;;; Initial Expansion list management | |
1826 ;; | |
1827 (defun speedbar-initial-expansion-list () | |
1828 "Return the current default expansion list. | |
1829 This is based on `speedbar-initial-expansion-list-name' referencing | |
1830 `speedbar-initial-expansion-mode-alist'." | |
1831 ;; cdr1 - name, cdr2 - menu | |
1832 (cdr (cdr (cdr (assoc speedbar-initial-expansion-list-name | |
1833 speedbar-initial-expansion-mode-alist))))) | |
1834 | |
1835 (defun speedbar-initial-menu () | |
1836 "Return the current default menu data. | |
1837 This is based on `speedbar-initial-expansion-list-name' referencing | |
1838 `speedbar-initial-expansion-mode-alist'." | |
1839 (symbol-value | |
1840 (car (cdr (assoc speedbar-initial-expansion-list-name | |
1841 speedbar-initial-expansion-mode-alist))))) | |
1842 | |
1843 (defun speedbar-initial-keymap () | |
1844 "Return the current default menu data. | |
1845 This is based on `speedbar-initial-expansion-list-name' referencing | |
1846 `speedbar-initial-expansion-mode-alist'." | |
1847 (symbol-value | |
1848 (car (cdr (cdr (assoc speedbar-initial-expansion-list-name | |
1849 speedbar-initial-expansion-mode-alist)))))) | |
1850 | |
1851 (defun speedbar-initial-stealthy-functions () | |
1852 "Return a list of functions to call stealthily. | |
1853 This is based on `speedbar-initial-expansion-list-name' referencing | |
1854 `speedbar-stealthy-function-list'." | |
1855 (cdr (assoc speedbar-initial-expansion-list-name | |
1856 speedbar-stealthy-function-list))) | |
1857 | |
1858 (defun speedbar-add-expansion-list (new-list) | |
1859 "Add NEW-LIST to the list of expansion lists." | |
1860 (add-to-list 'speedbar-initial-expansion-mode-alist new-list)) | |
1861 | |
1862 (defun speedbar-change-initial-expansion-list (new-default) | |
1863 "Change speedbar's default expansion list to NEW-DEFAULT." | |
1864 (interactive | |
1865 (list | |
1866 (completing-read (format "Speedbar Mode (default %s): " | |
1867 speedbar-previously-used-expansion-list-name) | |
1868 speedbar-initial-expansion-mode-alist | |
1869 nil t "" nil | |
1870 speedbar-previously-used-expansion-list-name))) | |
1871 (setq speedbar-previously-used-expansion-list-name | |
1872 speedbar-initial-expansion-list-name | |
1873 speedbar-initial-expansion-list-name new-default) | |
1874 (speedbar-refresh) | |
1875 (speedbar-reconfigure-keymaps)) | |
1876 | |
1877 | |
1878 ;;; Special speedbar display management | |
1879 ;; | |
1880 (defun speedbar-maybe-add-localized-support (buffer) | |
1881 "Quick check function called on BUFFERs by the speedbar timer function. | |
1882 Maintains the value of local variables which control speedbars use | |
1883 of the special mode functions." | |
1884 (or speedbar-special-mode-expansion-list | |
1885 (speedbar-add-localized-speedbar-support buffer))) | |
1886 | |
1887 (defun speedbar-add-localized-speedbar-support (buffer) | |
1888 "Add localized speedbar support to BUFFER's mode if it is available." | |
1889 (interactive "bBuffer: ") | |
1890 (if (stringp buffer) (setq buffer (get-buffer buffer))) | |
1891 (if (not (buffer-live-p buffer)) | |
1892 nil | |
1893 (save-excursion | |
1894 (set-buffer buffer) | |
1895 (save-match-data | |
1896 (let ((ms (symbol-name major-mode)) v) | |
1897 (if (not (string-match "-mode$" ms)) | |
1898 nil ;; do nothing to broken mode | |
1899 (setq ms (substring ms 0 (match-beginning 0))) | |
1900 (setq v (intern-soft (concat ms "-speedbar-buttons"))) | |
1901 (make-local-variable 'speedbar-special-mode-expansion-list) | |
1902 (if (not v) | |
1903 (setq speedbar-special-mode-expansion-list t) | |
1904 ;; If it is autoloaded, we need to load it now so that | |
1905 ;; we have access to the varialbe -speedbar-menu-items. | |
1906 ;; Is this XEmacs safe? | |
1907 (let ((sf (symbol-function v))) | |
1908 (if (and (listp sf) (eq (car sf) 'autoload)) | |
1909 (load-library (car (cdr sf))))) | |
1910 (setq speedbar-special-mode-expansion-list (list v)) | |
1911 (setq v (intern-soft (concat ms "-speedbar-key-map"))) | |
1912 (if (not v) | |
1913 nil ;; don't add special keymap | |
1914 (make-local-variable 'speedbar-special-mode-key-map) | |
1915 (setq speedbar-special-mode-key-map | |
1916 (symbol-value v))) | |
1917 (setq v (intern-soft (concat ms "-speedbar-menu-items"))) | |
1918 (if (not v) | |
1919 nil ;; don't add special menus | |
1920 (make-local-variable 'speedbar-easymenu-definition-special) | |
1921 (setq speedbar-easymenu-definition-special | |
1922 (symbol-value v))) | |
1923 ))))))) | |
1924 | |
1925 (defun speedbar-remove-localized-speedbar-support (buffer) | |
1926 "Remove any traces that BUFFER supports speedbar in a specialized way." | |
1927 (save-excursion | |
1928 (set-buffer buffer) | |
1929 (kill-local-variable 'speedbar-special-mode-expansion-list) | |
1930 (kill-local-variable 'speedbar-special-mode-key-map) | |
1931 (kill-local-variable 'speedbar-easymenu-definition-special))) | |
1560 | 1932 |
1561 ;;; File button management | 1933 ;;; File button management |
1562 ;; | 1934 ;; |
1563 (defun speedbar-file-lists (directory) | 1935 (defun speedbar-file-lists (directory) |
1564 "Create file lists for DIRECTORY. | 1936 "Create file lists for DIRECTORY. |
1576 (let ((default-directory directory) | 1948 (let ((default-directory directory) |
1577 (dir (directory-files directory nil)) | 1949 (dir (directory-files directory nil)) |
1578 (dirs nil) | 1950 (dirs nil) |
1579 (files nil)) | 1951 (files nil)) |
1580 (while dir | 1952 (while dir |
1581 (if (not (string-match speedbar-file-unshown-regexp (car dir))) | 1953 (if (not |
1954 (or (string-match speedbar-file-unshown-regexp (car dir)) | |
1955 (string-match speedbar-directory-unshown-regexp (car dir)))) | |
1582 (if (file-directory-p (car dir)) | 1956 (if (file-directory-p (car dir)) |
1583 (setq dirs (cons (car dir) dirs)) | 1957 (setq dirs (cons (car dir) dirs)) |
1584 (setq files (cons (car dir) files)))) | 1958 (setq files (cons (car dir) files)))) |
1585 (setq dir (cdr dir))) | 1959 (setq dir (cdr dir))) |
1586 (let ((nl (cons (nreverse dirs) (list (nreverse files))))) | 1960 (let ((nl (cons (nreverse dirs) (list (nreverse files))))) |
1694 (end (progn (insert buttxt) (point))) | 2068 (end (progn (insert buttxt) (point))) |
1695 (bf (if exp-button-type 'speedbar-button-face nil)) | 2069 (bf (if exp-button-type 'speedbar-button-face nil)) |
1696 (mf (if exp-button-function 'speedbar-highlight-face nil)) | 2070 (mf (if exp-button-function 'speedbar-highlight-face nil)) |
1697 ) | 2071 ) |
1698 (speedbar-make-button start end bf mf exp-button-function exp-button-data) | 2072 (speedbar-make-button start end bf mf exp-button-function exp-button-data) |
2073 (if speedbar-hide-button-brackets-flag | |
2074 (progn | |
2075 (put-text-property start (1+ start) 'invisible t) | |
2076 (put-text-property end (1- end) 'invisible t))) | |
1699 ) | 2077 ) |
1700 (insert-char ? 1 nil) | 2078 (insert-char ? 1 nil) |
1701 (put-text-property (1- (point)) (point) 'invisible nil) | 2079 (put-text-property (1- (point)) (point) 'invisible nil) |
1702 (let ((start (point)) | 2080 (let ((start (point)) |
1703 (end (progn (insert tag-button) (point)))) | 2081 (end (progn (insert tag-button) (point)))) |
1715 (if (re-search-forward ":\\s-*.\\([-+?]\\)" (save-excursion (end-of-line) | 2093 (if (re-search-forward ":\\s-*.\\([-+?]\\)" (save-excursion (end-of-line) |
1716 (point)) t) | 2094 (point)) t) |
1717 (speedbar-with-writable | 2095 (speedbar-with-writable |
1718 (goto-char (match-beginning 1)) | 2096 (goto-char (match-beginning 1)) |
1719 (delete-char 1) | 2097 (delete-char 1) |
1720 (insert-char char 1 t))))) | 2098 (insert-char char 1 t) |
2099 (put-text-property (point) (1- (point)) 'invisible nil))))) | |
1721 | 2100 |
1722 | 2101 |
1723 ;;; Build button lists | 2102 ;;; Build button lists |
1724 ;; | 2103 ;; |
1725 (defun speedbar-insert-files-at-point (files level) | 2104 (defun speedbar-insert-files-at-point (files level) |
1726 "Insert list of FILES starting at point, and indenting all files to LEVEL. | 2105 "Insert list of FILES starting at point, and indenting all files to LEVEL. |
1727 Tag expandable items with a +, otherwise a ?. Don't highlight ? as we | 2106 Tag expandable items with a +, otherwise a ?. Don't highlight ? as we |
1728 don't know how to manage them. The input parameter FILES is a cons | 2107 don't know how to manage them. The input parameter FILES is a cons |
1729 cell of the form ( 'DIRLIST . 'FILELIST )" | 2108 cell of the form ( 'DIRLIST . 'FILELIST )" |
1730 ;; Start inserting all the directories | 2109 ;; Start inserting all the directories |
1731 (let ((dirs (car files))) | 2110 (let ((dirs (car files))) |
1732 (while dirs | 2111 (while dirs |
1733 (speedbar-make-tag-line 'angle ?+ 'speedbar-dired (car dirs) | 2112 (speedbar-make-tag-line 'angle ?+ 'speedbar-dired (car dirs) |
1734 (car dirs) 'speedbar-dir-follow nil | 2113 (car dirs) 'speedbar-dir-follow nil |
1735 'speedbar-directory-face level) | 2114 'speedbar-directory-face level) |
1736 (setq dirs (cdr dirs)))) | 2115 (setq dirs (cdr dirs)))) |
1737 (let ((lst (car (cdr files)))) | 2116 (let ((lst (car (cdr files))) |
2117 (case-fold-search t)) | |
1738 (while lst | 2118 (while lst |
1739 (let* ((known (string-match speedbar-file-regexp (car lst))) | 2119 (let* ((known (string-match speedbar-file-regexp (car lst))) |
1740 (expchar (if known ?+ ??)) | 2120 (expchar (if known ?+ ??)) |
1741 (fn (if known 'speedbar-tag-file nil))) | 2121 (fn (if known 'speedbar-tag-file nil))) |
1742 (if (or speedbar-show-unknown-files (/= expchar ??)) | 2122 (if (or speedbar-show-unknown-files (/= expchar ??)) |
1768 (goto-char (match-end 0)) | 2148 (goto-char (match-end 0)) |
1769 (speedbar-do-function-pointer))) | 2149 (speedbar-do-function-pointer))) |
1770 (setq sf (cdr sf))))) | 2150 (setq sf (cdr sf))))) |
1771 ))) | 2151 ))) |
1772 | 2152 |
2153 (defun speedbar-apply-one-tag-hierarchy-method (lst method) | |
2154 "Adjust the tag hierarchy LST by METHOD." | |
2155 (cond | |
2156 ((eq method 'sort) | |
2157 (sort (copy-alist lst) | |
2158 (lambda (a b) (string< (car a) (car b))))) | |
2159 ((eq method 'prefix-group) | |
2160 (let ((newlst nil) | |
2161 (sublst nil) | |
2162 (work-list nil) | |
2163 (junk-list nil) | |
2164 (short-group-list nil) | |
2165 (short-start-name nil) | |
2166 (short-end-name nil) | |
2167 (num-shorts-grouped 0) | |
2168 (bins (make-vector 256 nil)) | |
2169 (diff-idx 0)) | |
2170 ;; Break out sub-lists | |
2171 (while lst | |
2172 (if (listp (cdr-safe (car-safe lst))) | |
2173 (setq newlst (cons (car lst) newlst)) | |
2174 (setq sublst (cons (car lst) sublst))) | |
2175 (setq lst (cdr lst))) | |
2176 ;; Now, first find out how long our list is. Never let a | |
2177 ;; list get-shorter than our minimum. | |
2178 (if (<= (length sublst) speedbar-tag-split-minimum-length) | |
2179 (setq work-list (nreverse sublst)) | |
2180 (setq diff-idx (length (try-completion "" sublst))) | |
2181 ;; Sort the whole list into bins. | |
2182 (while sublst | |
2183 (let ((e (car sublst)) | |
2184 (s (car (car sublst)))) | |
2185 (cond ((<= (length s) diff-idx) | |
2186 ;; 0 storage bin for shorty. | |
2187 (aset bins 0 (cons e (aref bins 0)))) | |
2188 (t | |
2189 ;; stuff into a bin based on ascii value at diff | |
2190 (aset bins (aref s diff-idx) | |
2191 (cons e (aref bins (aref s diff-idx))))))) | |
2192 (setq sublst (cdr sublst))) | |
2193 ;; Go through all our bins Stick singles into our | |
2194 ;; junk-list, everything else as sublsts in work-list. | |
2195 ;; If two neighboring lists are both small, make a grouped | |
2196 ;; group combinding those two sub-lists. | |
2197 (setq diff-idx 0) | |
2198 (while (> 256 diff-idx) | |
2199 (let ((l (aref bins diff-idx))) | |
2200 (if l | |
2201 (let ((tmp (cons (try-completion "" l) l))) | |
2202 (if (or (> (length l) speedbar-tag-regroup-maximum-length) | |
2203 (> (+ (length l) (length short-group-list)) | |
2204 speedbar-tag-split-minimum-length)) | |
2205 (progn | |
2206 ;; We have reached a longer list, so we | |
2207 ;; must finish off a grouped group. | |
2208 (cond | |
2209 ((and short-group-list | |
2210 (= (length short-group-list) | |
2211 num-shorts-grouped)) | |
2212 ;; All singles? Junk list | |
2213 (setq junk-list (append short-group-list | |
2214 junk-list))) | |
2215 ((= num-shorts-grouped 1) | |
2216 ;; Only one short group? Just stick it in | |
2217 ;; there by itself. | |
2218 (setq work-list | |
2219 (cons (cons (try-completion | |
2220 "" short-group-list) | |
2221 (nreverse short-group-list)) | |
2222 work-list))) | |
2223 (short-group-list | |
2224 ;; Multiple groups to be named in a special | |
2225 ;; way by displaying the range over which we | |
2226 ;; have grouped them. | |
2227 (setq work-list | |
2228 (cons (cons (concat short-start-name | |
2229 " to " | |
2230 short-end-name) | |
2231 (nreverse short-group-list)) | |
2232 work-list)))) | |
2233 ;; Reset short group list information every time. | |
2234 (setq short-group-list nil | |
2235 short-start-name nil | |
2236 short-end-name nil | |
2237 num-shorts-grouped 0))) | |
2238 ;; Ok, now that we cleaned up the short-group-list, | |
2239 ;; we can deal with this new list, to decide if it | |
2240 ;; should go on one of these sub-lists or not. | |
2241 (if (< (length l) speedbar-tag-regroup-maximum-length) | |
2242 (setq short-group-list (append short-group-list l) | |
2243 num-shorts-grouped (1+ num-shorts-grouped) | |
2244 short-end-name (car tmp) | |
2245 short-start-name (if short-start-name | |
2246 short-start-name | |
2247 (car tmp))) | |
2248 (setq work-list (cons tmp work-list)))))) | |
2249 (setq diff-idx (1+ diff-idx)))) | |
2250 ;; Did we run out of things? Drop our new list onto the end. | |
2251 (cond | |
2252 ((and short-group-list (= (length short-group-list) num-shorts-grouped)) | |
2253 ;; All singles? Junk list | |
2254 (setq junk-list (append short-group-list junk-list))) | |
2255 ((= num-shorts-grouped 1) | |
2256 ;; Only one short group? Just stick it in | |
2257 ;; there by itself. | |
2258 (setq work-list | |
2259 (cons (cons (try-completion "" short-group-list) | |
2260 (nreverse short-group-list)) | |
2261 work-list))) | |
2262 (short-group-list | |
2263 ;; Multiple groups to be named in a special | |
2264 ;; way by displaying the range over which we | |
2265 ;; have grouped them. | |
2266 (setq work-list | |
2267 (cons (cons (concat short-start-name " to " short-end-name) | |
2268 (nreverse short-group-list)) | |
2269 work-list)))) | |
2270 ;; Now, stick our new list onto the end of | |
2271 (if work-list | |
2272 (if junk-list | |
2273 (append (nreverse newlst) | |
2274 (nreverse work-list) | |
2275 junk-list) | |
2276 (append (nreverse newlst) | |
2277 (nreverse work-list))) | |
2278 (append (nreverse newlst) junk-list)))) | |
2279 ((eq method 'trim-words) | |
2280 (let ((newlst nil) | |
2281 (sublst nil) | |
2282 (trim-prefix nil) | |
2283 (trim-chars 0) | |
2284 (trimlst nil)) | |
2285 (while lst | |
2286 (if (listp (cdr-safe (car-safe lst))) | |
2287 (setq newlst (cons (car lst) newlst)) | |
2288 (setq sublst (cons (car lst) sublst))) | |
2289 (setq lst (cdr lst))) | |
2290 ;; Get the prefix to trim by. Make sure that we don't trim | |
2291 ;; off silly pieces, only complete understandable words. | |
2292 (setq trim-prefix (try-completion "" sublst)) | |
2293 (if (or (= (length sublst) 1) | |
2294 (not trim-prefix) | |
2295 (not (string-match "\\(\\w+\\W+\\)+" trim-prefix))) | |
2296 (append (nreverse newlst) (nreverse sublst)) | |
2297 (setq trim-prefix (substring trim-prefix (match-beginning 0) | |
2298 (match-end 0))) | |
2299 (setq trim-chars (length trim-prefix)) | |
2300 (while sublst | |
2301 (setq trimlst (cons | |
2302 (cons (substring (car (car sublst)) trim-chars) | |
2303 (cdr (car sublst))) | |
2304 trimlst) | |
2305 sublst (cdr sublst))) | |
2306 ;; Put the lists together | |
2307 (append (nreverse newlst) trimlst)))) | |
2308 ((eq method 'simple-group) | |
2309 (let ((newlst nil) | |
2310 (sublst nil)) | |
2311 (while lst | |
2312 (if (listp (cdr-safe (car-safe lst))) | |
2313 (setq newlst (cons (car lst) newlst)) | |
2314 (setq sublst (cons (car lst) sublst))) | |
2315 (setq lst (cdr lst))) | |
2316 (if (not newlst) | |
2317 (nreverse sublst) | |
2318 (setq newlst (cons (cons "Tags" (nreverse sublst)) newlst)) | |
2319 (nreverse newlst)))) | |
2320 (t lst))) | |
2321 | |
2322 (defun speedbar-create-tag-hierarchy (lst) | |
2323 "Adjust the tag hierarchy in LST, and return it. | |
2324 This uses `speedbar-tag-hierarchy-method' to determine how to adjust | |
2325 the list. See it's value for details." | |
2326 (let ((methods speedbar-tag-hierarchy-method)) | |
2327 (while methods | |
2328 (setq lst (speedbar-apply-one-tag-hierarchy-method lst (car methods)) | |
2329 methods (cdr methods))) | |
2330 lst)) | |
2331 | |
1773 (defun speedbar-insert-generic-list (level lst expand-fun find-fun) | 2332 (defun speedbar-insert-generic-list (level lst expand-fun find-fun) |
1774 "At LEVEL, insert a generic multi-level alist LST. | 2333 "At LEVEL, insert a generic multi-level alist LST. |
1775 Associations with lists get {+} tags (to expand into more nodes) and | 2334 Associations with lists get {+} tags (to expand into more nodes) and |
1776 those with positions just get a > as the indicator. {+} buttons will | 2335 those with positions just get a > as the indicator. {+} buttons will |
1777 have the function EXPAND-FUN and the token is the CDR list. The token | 2336 have the function EXPAND-FUN and the token is the CDR list. The token |
1778 name will have the function FIND-FUN and not token." | 2337 name will have the function FIND-FUN and not token." |
1779 ;; Remove imenu rescan button | 2338 ;; Remove imenu rescan button |
1780 (if (string= (car (car lst)) "*Rescan*") | 2339 (if (string= (car (car lst)) "*Rescan*") |
1781 (setq lst (cdr lst))) | 2340 (setq lst (cdr lst))) |
2341 ;; Adjust the list. | |
2342 (setq lst (speedbar-create-tag-hierarchy lst)) | |
1782 ;; insert the parts | 2343 ;; insert the parts |
1783 (while lst | 2344 (while lst |
1784 (cond ((null (car-safe lst)) nil) ;this would be a separator | 2345 (cond ((null (car-safe lst)) nil) ;this would be a separator |
1785 ((or (numberp (cdr-safe (car-safe lst))) | 2346 ((or (numberp (cdr-safe (car-safe lst))) |
1786 (markerp (cdr-safe (car-safe lst)))) | 2347 (markerp (cdr-safe (car-safe lst)))) |
1803 (defun speedbar-update-contents () | 2364 (defun speedbar-update-contents () |
1804 "Generically update the contents of the speedbar buffer." | 2365 "Generically update the contents of the speedbar buffer." |
1805 (interactive) | 2366 (interactive) |
1806 ;; Set the current special buffer | 2367 ;; Set the current special buffer |
1807 (setq speedbar-desired-buffer nil) | 2368 (setq speedbar-desired-buffer nil) |
2369 ;; Check for special modes | |
2370 (speedbar-maybe-add-localized-support (current-buffer)) | |
2371 ;; Choose the correct method of doodling. | |
1808 (if (and speedbar-mode-specific-contents-flag | 2372 (if (and speedbar-mode-specific-contents-flag |
2373 (listp speedbar-special-mode-expansion-list) | |
1809 speedbar-special-mode-expansion-list | 2374 speedbar-special-mode-expansion-list |
1810 (local-variable-p | 2375 (local-variable-p |
1811 'speedbar-special-mode-expansion-list | 2376 'speedbar-special-mode-expansion-list |
1812 (current-buffer))) | 2377 (current-buffer))) |
1813 ;;(eq (get major-mode 'mode-class 'special))) | 2378 ;;(eq (get major-mode 'mode-class 'special))) |
1816 | 2381 |
1817 (defun speedbar-update-directory-contents () | 2382 (defun speedbar-update-directory-contents () |
1818 "Update the contents of the speedbar buffer based on the current directory." | 2383 "Update the contents of the speedbar buffer based on the current directory." |
1819 (let ((cbd (expand-file-name default-directory)) | 2384 (let ((cbd (expand-file-name default-directory)) |
1820 cbd-parent | 2385 cbd-parent |
1821 (funclst speedbar-initial-expansion-list) | 2386 (funclst (speedbar-initial-expansion-list)) |
1822 (cache speedbar-full-text-cache) | 2387 (cache speedbar-full-text-cache) |
1823 ;; disable stealth during update | 2388 ;; disable stealth during update |
1824 (speedbar-stealthy-function-list nil) | 2389 (speedbar-stealthy-function-list nil) |
1825 (use-cache nil) | 2390 (use-cache nil) |
1826 (expand-local nil) | 2391 (expand-local nil) |
1830 (set-buffer speedbar-buffer) | 2395 (set-buffer speedbar-buffer) |
1831 ;; If we are updating contents to where we are, then this is | 2396 ;; If we are updating contents to where we are, then this is |
1832 ;; really a request to update existing contents, so we must be | 2397 ;; really a request to update existing contents, so we must be |
1833 ;; careful with our text cache! | 2398 ;; careful with our text cache! |
1834 (if (member cbd speedbar-shown-directories) | 2399 (if (member cbd speedbar-shown-directories) |
1835 (setq cache nil) | 2400 (progn |
2401 (setq cache nil) | |
2402 ;; If the current directory is not the last element in the dir | |
2403 ;; list, then we ALSO need to zap the list of expanded directories | |
2404 (if (/= (length (member cbd speedbar-shown-directories)) 1) | |
2405 (setq speedbar-shown-directories (list cbd)))) | |
1836 | 2406 |
1837 ;; Build cbd-parent, and see if THAT is in the current shown | 2407 ;; Build cbd-parent, and see if THAT is in the current shown |
1838 ;; directories. First, go through pains to get the parent directory | 2408 ;; directories. First, go through pains to get the parent directory |
1839 (if (and speedbar-smart-directory-expand-flag | 2409 (if (and speedbar-smart-directory-expand-flag |
1840 (save-match-data | 2410 (save-match-data |
1841 (setq cbd-parent cbd) | 2411 (setq cbd-parent cbd) |
1842 (if (string-match "/$" cbd-parent) | 2412 (if (string-match "/$" cbd-parent) |
1843 (setq cbd-parent (substring cbd-parent 0 (match-beginning 0)))) | 2413 (setq cbd-parent (substring cbd-parent 0 |
2414 (match-beginning 0)))) | |
1844 (setq cbd-parent (file-name-directory cbd-parent))) | 2415 (setq cbd-parent (file-name-directory cbd-parent))) |
1845 (member cbd-parent speedbar-shown-directories)) | 2416 (member cbd-parent speedbar-shown-directories)) |
1846 (setq expand-local t) | 2417 (setq expand-local t) |
1847 | 2418 |
1848 ;; If this directory is NOT in the current list of available | 2419 ;; If this directory is NOT in the current list of available |
1881 (while funclst | 2452 (while funclst |
1882 (setq default-directory cbd) | 2453 (setq default-directory cbd) |
1883 (funcall (car funclst) cbd 0) | 2454 (funcall (car funclst) cbd 0) |
1884 (setq funclst (cdr funclst)))))) | 2455 (setq funclst (cdr funclst)))))) |
1885 (goto-char (point-min))))) | 2456 (goto-char (point-min))))) |
1886 (speedbar-reconfigure-menubar)) | 2457 (speedbar-reconfigure-keymaps)) |
1887 | 2458 |
1888 (defun speedbar-update-special-contents () | 2459 (defun speedbar-update-special-contents () |
1889 "Used the mode-specific variable to fill in the speedbar buffer. | 2460 "Used the mode-specific variable to fill in the speedbar buffer. |
1890 This should only be used by modes classified as special." | 2461 This should only be used by modes classified as special." |
1891 (let ((funclst speedbar-special-mode-expansion-list) | 2462 (let ((funclst speedbar-special-mode-expansion-list) |
1908 ;; We do not erase the buffer because these functions may | 2479 ;; We do not erase the buffer because these functions may |
1909 ;; decide NOT to update themselves. | 2480 ;; decide NOT to update themselves. |
1910 (funcall (car funclst) specialbuff) | 2481 (funcall (car funclst) specialbuff) |
1911 (setq funclst (cdr funclst)))) | 2482 (setq funclst (cdr funclst)))) |
1912 (goto-char (point-min)))) | 2483 (goto-char (point-min)))) |
1913 (speedbar-reconfigure-menubar)) | 2484 (speedbar-reconfigure-keymaps)) |
1914 | 2485 |
1915 (defun speedbar-timer-fn () | 2486 (defun speedbar-timer-fn () |
1916 "Run whenever emacs is idle to update the speedbar item." | 2487 "Run whenever Emacs is idle to update the speedbar item." |
1917 (if (not (and (frame-live-p speedbar-frame) | 2488 (if (not (and (frame-live-p speedbar-frame) |
1918 (frame-live-p speedbar-attached-frame))) | 2489 (frame-live-p speedbar-attached-frame))) |
1919 (speedbar-set-timer nil) | 2490 (speedbar-set-timer nil) |
1920 ;; Save all the match data so that we don't mess up executing fns | 2491 ;; Save all the match data so that we don't mess up executing fns |
1921 (save-match-data | 2492 (save-match-data |
1925 (select-frame speedbar-attached-frame) | 2496 (select-frame speedbar-attached-frame) |
1926 ;; make sure we at least choose a window to | 2497 ;; make sure we at least choose a window to |
1927 ;; get a good directory from | 2498 ;; get a good directory from |
1928 (if (string-match "\\*Minibuf-[0-9]+\\*" (buffer-name)) | 2499 (if (string-match "\\*Minibuf-[0-9]+\\*" (buffer-name)) |
1929 (other-window 1)) | 2500 (other-window 1)) |
2501 ;; Check for special modes | |
2502 (speedbar-maybe-add-localized-support (current-buffer)) | |
1930 ;; Update for special mode all the time! | 2503 ;; Update for special mode all the time! |
1931 (if (and speedbar-mode-specific-contents-flag | 2504 (if (and speedbar-mode-specific-contents-flag |
2505 (listp speedbar-special-mode-expansion-list) | |
1932 speedbar-special-mode-expansion-list | 2506 speedbar-special-mode-expansion-list |
1933 (local-variable-p | 2507 (local-variable-p |
1934 'speedbar-special-mode-expansion-list | 2508 'speedbar-special-mode-expansion-list |
1935 (current-buffer))) | 2509 (current-buffer))) |
1936 ;;(eq (get major-mode 'mode-class 'special))) | 2510 ;;(eq (get major-mode 'mode-class 'special))) |
1960 (if (<= 1 speedbar-verbosity-level) | 2534 (if (<= 1 speedbar-verbosity-level) |
1961 (message "Updating speedbar to: %s...done" | 2535 (message "Updating speedbar to: %s...done" |
1962 default-directory)))) | 2536 default-directory)))) |
1963 (select-frame af)) | 2537 (select-frame af)) |
1964 ;; Now run stealthy updates of time-consuming items | 2538 ;; Now run stealthy updates of time-consuming items |
1965 (speedbar-stealthy-updates))))) | 2539 (speedbar-stealthy-updates))) |
2540 ;; Now run the mouse tracking system | |
2541 (speedbar-show-info-under-mouse))) | |
1966 (run-hooks 'speedbar-timer-hook)) | 2542 (run-hooks 'speedbar-timer-hook)) |
1967 | 2543 |
1968 | 2544 |
1969 ;;; Stealthy activities | 2545 ;;; Stealthy activities |
1970 ;; | 2546 ;; |
2547 (defvar speedbar-stealthy-update-recurse nil | |
2548 "Recursion avoidance variable for stealthy update.") | |
2549 | |
1971 (defun speedbar-stealthy-updates () | 2550 (defun speedbar-stealthy-updates () |
1972 "For a given speedbar, run all items in the stealthy function list. | 2551 "For a given speedbar, run all items in the stealthy function list. |
1973 Each item returns t if it completes successfully, or nil if | 2552 Each item returns t if it completes successfully, or nil if |
1974 interrupted by the user." | 2553 interrupted by the user." |
1975 (let ((l speedbar-stealthy-function-list)) | 2554 (if (not speedbar-stealthy-update-recurse) |
1976 (unwind-protect | 2555 (let ((l (speedbar-initial-stealthy-functions)) |
1977 (while (and l (funcall (car l))) | 2556 (speedbar-stealthy-update-recurse t)) |
1978 (sit-for 0) | 2557 (unwind-protect |
1979 (setq l (cdr l))) | 2558 (while (and l (funcall (car l))) |
1980 ;(message "Exit with %S" (car l)) | 2559 ;(sit-for 0) |
1981 ))) | 2560 (setq l (cdr l))) |
2561 ;;(message "Exit with %S" (car l)) | |
2562 )))) | |
1982 | 2563 |
1983 (defun speedbar-reset-scanners () | 2564 (defun speedbar-reset-scanners () |
1984 "Reset any variables used by functions in the stealthy list as state. | 2565 "Reset any variables used by functions in the stealthy list as state. |
1985 If new functions are added, their state needs to be updated here." | 2566 If new functions are added, their state needs to be updated here." |
1986 (setq speedbar-vc-to-do-point t) | 2567 (setq speedbar-vc-to-do-point t |
2568 speedbar-obj-to-do-point t) | |
1987 (run-hooks 'speedbar-scanner-reset-hook) | 2569 (run-hooks 'speedbar-scanner-reset-hook) |
1988 ) | 2570 ) |
1989 | 2571 |
1990 (defun speedbar-clear-current-file () | 2572 (defun speedbar-clear-current-file () |
1991 "Locate the file thought to be current, and remove its highlighting." | 2573 "Locate the file thought to be current, and remove its highlighting." |
1996 (goto-char (point-min)) | 2578 (goto-char (point-min)) |
1997 (if (and | 2579 (if (and |
1998 speedbar-last-selected-file | 2580 speedbar-last-selected-file |
1999 (re-search-forward | 2581 (re-search-forward |
2000 (concat " \\(" (regexp-quote speedbar-last-selected-file) | 2582 (concat " \\(" (regexp-quote speedbar-last-selected-file) |
2001 "\\)\\(" (regexp-quote speedbar-vc-indicator) | 2583 "\\)\\(" speedbar-indicator-regex "\\)?\n") |
2002 "\\)?\n") | |
2003 nil t)) | 2584 nil t)) |
2004 (put-text-property (match-beginning 1) | 2585 (put-text-property (match-beginning 1) |
2005 (match-end 1) | 2586 (match-end 1) |
2006 'face | 2587 'face |
2007 'speedbar-file-face)))))) | 2588 'speedbar-file-face)))))) |
2019 nil))) | 2600 nil))) |
2020 (select-frame lastf) | 2601 (select-frame lastf) |
2021 rf))) | 2602 rf))) |
2022 (newcf (if newcfd (file-name-nondirectory newcfd))) | 2603 (newcf (if newcfd (file-name-nondirectory newcfd))) |
2023 (lastb (current-buffer)) | 2604 (lastb (current-buffer)) |
2024 (sucf-recursive (boundp 'sucf-recursive))) | 2605 (sucf-recursive (boundp 'sucf-recursive)) |
2606 (case-fold-search t)) | |
2025 (if (and newcf | 2607 (if (and newcf |
2026 ;; check here, that way we won't refresh to newcf until | 2608 ;; check here, that way we won't refresh to newcf until |
2027 ;; its been written, thus saving ourselves some time | 2609 ;; its been written, thus saving ourselves some time |
2028 (file-exists-p newcf) | 2610 (file-exists-p newcf) |
2029 (not (string= newcf speedbar-last-selected-file))) | 2611 (not (string= newcf speedbar-last-selected-file))) |
2038 (set-buffer speedbar-buffer) | 2620 (set-buffer speedbar-buffer) |
2039 (speedbar-with-writable | 2621 (speedbar-with-writable |
2040 (goto-char (point-min)) | 2622 (goto-char (point-min)) |
2041 (if (re-search-forward | 2623 (if (re-search-forward |
2042 (concat " \\(" (regexp-quote newcf) "\\)\\(" | 2624 (concat " \\(" (regexp-quote newcf) "\\)\\(" |
2043 (regexp-quote speedbar-vc-indicator) | 2625 speedbar-indicator-regex "\\)?$") nil t) |
2044 "\\)?\n") nil t) | |
2045 ;; put the property on it | 2626 ;; put the property on it |
2046 (put-text-property (match-beginning 1) | 2627 (put-text-property (match-beginning 1) |
2047 (match-end 1) | 2628 (match-end 1) |
2048 'face | 2629 'face |
2049 'speedbar-selected-face) | 2630 'speedbar-selected-face) |
2063 'speedbar-selected-face))) | 2644 'speedbar-selected-face))) |
2064 ;; if it's not in there now, whatever... | 2645 ;; if it's not in there now, whatever... |
2065 )) | 2646 )) |
2066 (setq speedbar-last-selected-file newcf)) | 2647 (setq speedbar-last-selected-file newcf)) |
2067 (if (not sucf-recursive) | 2648 (if (not sucf-recursive) |
2068 (progn | 2649 (speedbar-position-cursor-on-line)) |
2069 (forward-line -1) | |
2070 (speedbar-position-cursor-on-line))) | |
2071 (set-buffer lastb) | 2650 (set-buffer lastb) |
2072 (select-frame lastf) | 2651 (select-frame lastf) |
2073 ))) | 2652 ))) |
2074 ;; return that we are done with this activity. | 2653 ;; return that we are done with this activity. |
2075 t) | 2654 t) |
2076 | 2655 |
2077 ;; Load ange-ftp only if compiling to remove errors. | 2656 (defun speedbar-add-indicator (indicator-string &optional replace-this) |
2657 "Add INDICATOR-STRING to the end of this speedbar line. | |
2658 If INDICATOR-STRING is space, and REPLACE-THIS is a character, then | |
2659 an the existing indicator is removed. If there is already an | |
2660 indicator, then do not add a space." | |
2661 (beginning-of-line) | |
2662 ;; The nature of the beast: Assume we are in "the right place" | |
2663 (end-of-line) | |
2664 (skip-chars-backward (concat " " speedbar-vc-indicator | |
2665 (car speedbar-obj-indicator) | |
2666 (cdr speedbar-obj-indicator))) | |
2667 (if (and (not (looking-at speedbar-indicator-regex)) | |
2668 (not (string= indicator-string " "))) | |
2669 (insert speedbar-indicator-separator)) | |
2670 (speedbar-with-writable | |
2671 (save-excursion | |
2672 (if (and replace-this | |
2673 (re-search-forward replace-this (save-excursion (end-of-line) | |
2674 (point)) | |
2675 t)) | |
2676 (delete-region (match-beginning 0) (match-end 0)))) | |
2677 (end-of-line) | |
2678 (if (not (string= " " indicator-string)) | |
2679 (insert indicator-string)))) | |
2680 | |
2681 ;; Load efs/ange-ftp only if compiling to remove byte-compiler warnings. | |
2078 ;; Steven L Baur <steve@xemacs.org> said this was important: | 2682 ;; Steven L Baur <steve@xemacs.org> said this was important: |
2079 (eval-when-compile (or (featurep 'xemacs) (require 'ange-ftp))) | 2683 (eval-when-compile (or (featurep 'xemacs) |
2684 (condition-case () (require 'efs) | |
2685 (error (require 'ange-ftp))))) | |
2080 | 2686 |
2081 (defun speedbar-check-vc () | 2687 (defun speedbar-check-vc () |
2082 "Scan all files in a directory, and for each see if it's checked out. | 2688 "Scan all files in a directory, and for each see if it's checked out. |
2083 See `speedbar-this-file-in-vc' and `speedbar-vc-check-dir-p' for how | 2689 See `speedbar-this-file-in-vc' and `speedbar-vc-check-dir-p' for how |
2084 to add more types of version control systems." | 2690 to add more types of version control systems." |
2086 ;; then set to nil (do nothing) otherwise, start at the beginning | 2692 ;; then set to nil (do nothing) otherwise, start at the beginning |
2087 (save-excursion | 2693 (save-excursion |
2088 (set-buffer speedbar-buffer) | 2694 (set-buffer speedbar-buffer) |
2089 (if (and speedbar-vc-do-check (eq speedbar-vc-to-do-point t) | 2695 (if (and speedbar-vc-do-check (eq speedbar-vc-to-do-point t) |
2090 (speedbar-vc-check-dir-p default-directory) | 2696 (speedbar-vc-check-dir-p default-directory) |
2091 (not (and (featurep 'ange-ftp) | 2697 (not (or (and (featurep 'ange-ftp) |
2092 (string-match (car | 2698 (string-match |
2093 (if speedbar-xemacsp | 2699 (car (if speedbar-xemacsp |
2094 ange-ftp-path-format | 2700 ange-ftp-path-format |
2095 ange-ftp-name-format)) | 2701 ange-ftp-name-format)) |
2096 (expand-file-name default-directory))))) | 2702 (expand-file-name default-directory))) |
2703 ;; efs support: Bob Weiner | |
2704 (and (featurep 'efs) | |
2705 (string-match | |
2706 (car efs-path-regexp) | |
2707 (expand-file-name default-directory)))))) | |
2097 (setq speedbar-vc-to-do-point 0)) | 2708 (setq speedbar-vc-to-do-point 0)) |
2098 (if (numberp speedbar-vc-to-do-point) | 2709 (if (numberp speedbar-vc-to-do-point) |
2099 (progn | 2710 (progn |
2100 (goto-char speedbar-vc-to-do-point) | 2711 (goto-char speedbar-vc-to-do-point) |
2101 (while (and (not (input-pending-p)) | 2712 (while (and (not (input-pending-p)) |
2102 (re-search-forward "^\\([0-9]+\\):\\s-*\\[[+-]\\] " | 2713 (re-search-forward "^\\([0-9]+\\):\\s-*\\[[+-]\\] " |
2103 nil t)) | 2714 nil t)) |
2104 (setq speedbar-vc-to-do-point (point)) | 2715 (setq speedbar-vc-to-do-point (point)) |
2105 (if (speedbar-check-vc-this-line (match-string 1)) | 2716 (if (speedbar-check-vc-this-line (match-string 1)) |
2106 (if (not (looking-at (regexp-quote speedbar-vc-indicator))) | 2717 (speedbar-add-indicator speedbar-vc-indicator |
2107 (speedbar-with-writable (insert speedbar-vc-indicator))) | 2718 (regexp-quote speedbar-vc-indicator)) |
2108 (if (looking-at (regexp-quote speedbar-vc-indicator)) | 2719 (speedbar-add-indicator " " |
2109 (speedbar-with-writable | 2720 (regexp-quote speedbar-vc-indicator)))) |
2110 (delete-region (match-beginning 0) (match-end 0)))))) | |
2111 (if (input-pending-p) | 2721 (if (input-pending-p) |
2112 ;; return that we are incomplete | 2722 ;; return that we are incomplete |
2113 nil | 2723 nil |
2114 ;; we are done, set to-do to nil | 2724 ;; we are done, set to-do to nil |
2115 (setq speedbar-vc-to-do-point nil) | 2725 (setq speedbar-vc-to-do-point nil) |
2169 (file-exists-p (concat proj-dir "/SCCS/p." name)) | 2779 (file-exists-p (concat proj-dir "/SCCS/p." name)) |
2170 nil)) | 2780 nil)) |
2171 ;; User extension | 2781 ;; User extension |
2172 (run-hook-with-args 'speedbar-vc-in-control-hook path name) | 2782 (run-hook-with-args 'speedbar-vc-in-control-hook path name) |
2173 )) | 2783 )) |
2784 | |
2785 ;; Objet File scanning | |
2786 (defun speedbar-check-objects () | |
2787 "Scan all files in a directory, and for each see if there is an object. | |
2788 See `speedbar-check-obj-this-line' and `speedbar-obj-alist' for how | |
2789 to add more object types." | |
2790 ;; Check for to-do to be reset. If reset but no RCS is available | |
2791 ;; then set to nil (do nothing) otherwise, start at the beginning | |
2792 (save-excursion | |
2793 (set-buffer speedbar-buffer) | |
2794 (if (and speedbar-obj-do-check (eq speedbar-obj-to-do-point t)) | |
2795 (setq speedbar-obj-to-do-point 0)) | |
2796 (if (numberp speedbar-obj-to-do-point) | |
2797 (progn | |
2798 (goto-char speedbar-obj-to-do-point) | |
2799 (while (and (not (input-pending-p)) | |
2800 (re-search-forward "^\\([0-9]+\\):\\s-*\\[[+-]\\] " | |
2801 nil t)) | |
2802 (setq speedbar-obj-to-do-point (point)) | |
2803 (let ((ind (speedbar-check-obj-this-line (match-string 1)))) | |
2804 (if (not ind) (setq ind " ")) | |
2805 (speedbar-add-indicator ind (concat | |
2806 (car speedbar-obj-indicator) | |
2807 "\\|" | |
2808 (cdr speedbar-obj-indicator))))) | |
2809 (if (input-pending-p) | |
2810 ;; return that we are incomplete | |
2811 nil | |
2812 ;; we are done, set to-do to nil | |
2813 (setq speedbar-obj-to-do-point nil) | |
2814 ;; and return t | |
2815 t)) | |
2816 t))) | |
2817 | |
2818 (defun speedbar-check-obj-this-line (depth) | |
2819 "Return t if the file on this line has an associated object. | |
2820 Parameter DEPTH is a string with the current depth of indentation of | |
2821 the file being checked." | |
2822 (let* ((d (string-to-int depth)) | |
2823 (f (speedbar-line-path d)) | |
2824 (fn (buffer-substring-no-properties | |
2825 ;; Skip-chars: thanks ptype@dra.hmg.gb | |
2826 (point) (progn | |
2827 (skip-chars-forward "^ " | |
2828 (save-excursion (end-of-line) | |
2829 (point))) | |
2830 (point)))) | |
2831 (fulln (concat f fn))) | |
2832 (if (<= 2 speedbar-verbosity-level) | |
2833 (message "Speedbar obj check...%s" fulln)) | |
2834 (let ((oa speedbar-obj-alist)) | |
2835 (while (and oa (not (string-match (car (car oa)) fulln))) | |
2836 (setq oa (cdr oa))) | |
2837 (if (not (and oa (file-exists-p (concat (file-name-sans-extension fulln) | |
2838 (cdr (car oa)))))) | |
2839 nil | |
2840 ;; Find out if the object is out of date or not. | |
2841 (let ((date1 (nth 5 (file-attributes fulln))) | |
2842 (date2 (nth 5 (file-attributes (concat | |
2843 (file-name-sans-extension fulln) | |
2844 (cdr (car oa))))))) | |
2845 (if (or (< (car date1) (car date2)) | |
2846 (and (= (car date1) (car date2)) | |
2847 (< (nth 1 date1) (nth 1 date2)))) | |
2848 (car speedbar-obj-indicator) | |
2849 (cdr speedbar-obj-indicator))))))) | |
2174 | 2850 |
2175 ;;; Clicking Activity | 2851 ;;; Clicking Activity |
2176 ;; | 2852 ;; |
2177 (defun speedbar-quick-mouse (e) | 2853 (defun speedbar-quick-mouse (e) |
2178 "Since mouse events are strange, this will keep the mouse nicely positioned. | 2854 "Since mouse events are strange, this will keep the mouse nicely positioned. |
2217 (cond ((eq (car e) 'down-mouse-1) | 2893 (cond ((eq (car e) 'down-mouse-1) |
2218 (mouse-set-point e)) | 2894 (mouse-set-point e)) |
2219 ((eq (car e) 'mouse-1) | 2895 ((eq (car e) 'mouse-1) |
2220 (speedbar-quick-mouse e)) | 2896 (speedbar-quick-mouse e)) |
2221 ((or (eq (car e) 'double-down-mouse-1) | 2897 ((or (eq (car e) 'double-down-mouse-1) |
2222 (eq (car e) 'tripple-down-mouse-1)) | 2898 (eq (car e) 'triple-down-mouse-1)) |
2223 (mouse-set-point e) | 2899 (mouse-set-point e) |
2224 (speedbar-do-function-pointer) | 2900 (speedbar-do-function-pointer) |
2225 (speedbar-quick-mouse e)))) | 2901 (speedbar-quick-mouse e)))) |
2226 | 2902 |
2227 (defun speedbar-do-function-pointer () | 2903 (defun speedbar-do-function-pointer () |
2258 (save-excursion | 2934 (save-excursion |
2259 (save-match-data | 2935 (save-match-data |
2260 (beginning-of-line) | 2936 (beginning-of-line) |
2261 (if (looking-at (concat | 2937 (if (looking-at (concat |
2262 "\\([0-9]+\\): *[[<][-+?][]>] \\([^ \n]+\\)\\(" | 2938 "\\([0-9]+\\): *[[<][-+?][]>] \\([^ \n]+\\)\\(" |
2263 (regexp-quote speedbar-vc-indicator) | 2939 speedbar-indicator-regex "\\)?")) |
2264 "\\)?")) | |
2265 (let* ((depth (string-to-int (match-string 1))) | 2940 (let* ((depth (string-to-int (match-string 1))) |
2266 (path (speedbar-line-path depth)) | 2941 (path (speedbar-line-path depth)) |
2267 (f (match-string 2))) | 2942 (f (match-string 2))) |
2268 (concat path f)) | 2943 (concat path f)) |
2269 nil)))) | 2944 nil)))) |
2296 (goto-char dest) nil) | 2971 (goto-char dest) nil) |
2297 ;; find the file part | 2972 ;; find the file part |
2298 (let ((nd (file-name-nondirectory file))) | 2973 (let ((nd (file-name-nondirectory file))) |
2299 (if (re-search-forward | 2974 (if (re-search-forward |
2300 (concat "] \\(" (regexp-quote nd) | 2975 (concat "] \\(" (regexp-quote nd) |
2301 "\\)\\(" (regexp-quote speedbar-vc-indicator) "\\)?$") | 2976 "\\)\\(" speedbar-indicator-regex "\\)$") |
2302 nil t) | 2977 nil t) |
2303 (progn | 2978 (progn |
2304 (speedbar-position-cursor-on-line) | 2979 (speedbar-position-cursor-on-line) |
2305 t) | 2980 t) |
2306 (goto-char dest) | 2981 (goto-char dest) |
2308 | 2983 |
2309 (defun speedbar-line-path (depth) | 2984 (defun speedbar-line-path (depth) |
2310 "Retrieve the pathname associated with the current line. | 2985 "Retrieve the pathname associated with the current line. |
2311 This may require traversing backwards from DEPTH and combining the default | 2986 This may require traversing backwards from DEPTH and combining the default |
2312 directory with these items." | 2987 directory with these items." |
2313 (save-excursion | 2988 (cond |
2314 (save-match-data | 2989 ((string= speedbar-initial-expansion-list-name "files") |
2315 (let ((path nil)) | 2990 (save-excursion |
2316 (setq depth (1- depth)) | 2991 (save-match-data |
2317 (while (/= depth -1) | 2992 (let ((path nil)) |
2318 (if (not (re-search-backward (format "^%d:" depth) nil t)) | 2993 (setq depth (1- depth)) |
2319 (error "Error building path of tag") | 2994 (while (/= depth -1) |
2320 (cond ((looking-at "[0-9]+:\\s-*<->\\s-+\\([^\n]+\\)$") | 2995 (if (not (re-search-backward (format "^%d:" depth) nil t)) |
2321 (setq path (concat (buffer-substring-no-properties | 2996 (error "Error building path of tag") |
2322 (match-beginning 1) (match-end 1)) | 2997 (cond ((looking-at "[0-9]+:\\s-*<->\\s-+\\([^\n]+\\)$") |
2323 "/" | 2998 (setq path (concat (buffer-substring-no-properties |
2324 path))) | 2999 (match-beginning 1) (match-end 1)) |
2325 ((looking-at "[0-9]+:\\s-*[-]\\s-+\\([^\n]+\\)$") | 3000 "/" |
2326 ;; This is the start of our path. | 3001 path))) |
2327 (setq path (buffer-substring-no-properties | 3002 ((looking-at "[0-9]+:\\s-*[-]\\s-+\\([^\n]+\\)$") |
2328 (match-beginning 1) (match-end 1)))))) | 3003 ;; This is the start of our path. |
2329 (setq depth (1- depth))) | 3004 (setq path (buffer-substring-no-properties |
2330 (if (and path | 3005 (match-beginning 1) (match-end 1)))))) |
2331 (string-match (concat (regexp-quote speedbar-vc-indicator) "$") | 3006 (setq depth (1- depth))) |
2332 path)) | 3007 (if (and path |
2333 (setq path (substring path 0 (match-beginning 0)))) | 3008 (string-match (concat speedbar-indicator-regex "$") |
2334 (concat default-directory path))))) | 3009 path)) |
3010 (setq path (substring path 0 (match-beginning 0)))) | |
3011 (concat default-directory path))))) | |
3012 (t | |
3013 ;; If we aren't in file mode, then return an empty string to make | |
3014 ;; sure that we can still get some stuff done. | |
3015 ""))) | |
2335 | 3016 |
2336 (defun speedbar-path-line (path) | 3017 (defun speedbar-path-line (path) |
2337 "Position the cursor on the line specified by PATH." | 3018 "Position the cursor on the line specified by PATH." |
2338 (save-match-data | 3019 (save-match-data |
2339 (if (string-match "/$" path) | 3020 (if (string-match "/$" path) |
2340 (setq path (substring path 0 (match-beginning 0)))) | 3021 (setq path (substring path 0 (match-beginning 0)))) |
2341 (let ((nomatch t) (depth 0) | 3022 (let ((nomatch t) (depth 0) |
2342 (fname (file-name-nondirectory path)) | 3023 (fname (file-name-nondirectory path)) |
2343 (pname (file-name-directory path))) | 3024 (pname (file-name-directory path))) |
2344 (if (not (member pname speedbar-shown-directories)) | 3025 (if (not (member pname speedbar-shown-directories)) |
2345 (error "Internal Error: File %s not shown in speedbar." path)) | 3026 (error "Internal Error: File %s not shown in speedbar" path)) |
2346 (goto-char (point-min)) | 3027 (goto-char (point-min)) |
2347 (while (and nomatch | 3028 (while (and nomatch |
2348 (re-search-forward | 3029 (re-search-forward |
2349 (concat "[]>] \\(" (regexp-quote fname) | 3030 (concat "[]>] \\(" (regexp-quote fname) |
2350 "\\)\\(" (regexp-quote speedbar-vc-indicator) "\\)?$") | 3031 "\\)\\(" speedbar-indicator-regex "\\)?$") |
2351 nil t)) | 3032 nil t)) |
2352 (beginning-of-line) | 3033 (beginning-of-line) |
2353 (looking-at "\\([0-9]+\\):") | 3034 (looking-at "\\([0-9]+\\):") |
2354 (setq depth (string-to-int (match-string 0)) | 3035 (setq depth (string-to-int (match-string 0)) |
2355 nomatch (not (string= pname (speedbar-line-path depth)))) | 3036 nomatch (not (string= pname (speedbar-line-path depth)))) |
2429 (setq default-directory | 3110 (setq default-directory |
2430 (concat (expand-file-name (concat (speedbar-line-path indent) text)) | 3111 (concat (expand-file-name (concat (speedbar-line-path indent) text)) |
2431 "/")) | 3112 "/")) |
2432 ;; Because we leave speedbar as the current buffer, | 3113 ;; Because we leave speedbar as the current buffer, |
2433 ;; update contents will change directory without | 3114 ;; update contents will change directory without |
2434 ;; having to touch the attached frame. | 3115 ;; having to touch the attached frame. Turn off smart expand just |
2435 (speedbar-update-contents) | 3116 ;; in case. |
3117 (let ((speedbar-smart-directory-expand-flag nil)) | |
3118 (speedbar-update-contents)) | |
2436 (speedbar-set-timer speedbar-navigating-speed) | 3119 (speedbar-set-timer speedbar-navigating-speed) |
2437 (setq speedbar-last-selected-file nil) | 3120 (setq speedbar-last-selected-file nil) |
2438 (speedbar-stealthy-updates)) | 3121 (speedbar-stealthy-updates)) |
2439 | 3122 |
2440 (defun speedbar-delete-subblock (indent) | 3123 (defun speedbar-delete-subblock (indent) |
2482 (setq oldl (cdr oldl))) | 3165 (setq oldl (cdr oldl))) |
2483 (setq speedbar-shown-directories newl)) | 3166 (setq speedbar-shown-directories newl)) |
2484 (speedbar-change-expand-button-char ?+) | 3167 (speedbar-change-expand-button-char ?+) |
2485 (speedbar-delete-subblock indent) | 3168 (speedbar-delete-subblock indent) |
2486 ) | 3169 ) |
2487 (t (error "Ooops... not sure what to do."))) | 3170 (t (error "Ooops... not sure what to do"))) |
2488 (speedbar-center-buffer-smartly) | 3171 (speedbar-center-buffer-smartly) |
2489 (setq speedbar-last-selected-file nil) | 3172 (setq speedbar-last-selected-file nil) |
2490 (save-excursion (speedbar-stealthy-updates))) | 3173 (save-excursion (speedbar-stealthy-updates))) |
2491 | 3174 |
2492 (defun speedbar-directory-buttons-follow (text token indent) | 3175 (defun speedbar-directory-buttons-follow (text token indent) |
2493 "Speedbar click handler for default directory buttons. | 3176 "Speedbar click handler for default directory buttons. |
2494 TEXT is the button clicked on. TOKEN is the directory to follow. | 3177 TEXT is the button clicked on. TOKEN is the directory to follow. |
2495 INDENT is the current indentation level and is unused." | 3178 INDENT is the current indentation level and is unused." |
2496 (setq default-directory token) | 3179 (if (string-match "^[A-Z]:$" token) |
3180 (setq default-directory (concat token "\\")) | |
3181 (setq default-directory token)) | |
2497 ;; Because we leave speedbar as the current buffer, | 3182 ;; Because we leave speedbar as the current buffer, |
2498 ;; update contents will change directory without | 3183 ;; update contents will change directory without |
2499 ;; having to touch the attached frame. | 3184 ;; having to touch the attached frame. |
2500 (speedbar-update-contents) | 3185 (speedbar-update-contents) |
2501 (speedbar-set-timer speedbar-navigating-speed)) | 3186 (speedbar-set-timer speedbar-navigating-speed)) |
2525 lst 'speedbar-tag-expand | 3210 lst 'speedbar-tag-expand |
2526 'speedbar-tag-find)))))) | 3211 'speedbar-tag-find)))))) |
2527 ((string-match "-" text) ;we have to contract this node | 3212 ((string-match "-" text) ;we have to contract this node |
2528 (speedbar-change-expand-button-char ?+) | 3213 (speedbar-change-expand-button-char ?+) |
2529 (speedbar-delete-subblock indent)) | 3214 (speedbar-delete-subblock indent)) |
2530 (t (error "Ooops... not sure what to do."))) | 3215 (t (error "Ooops... not sure what to do"))) |
2531 (speedbar-center-buffer-smartly)) | 3216 (speedbar-center-buffer-smartly)) |
2532 | 3217 |
2533 (defun speedbar-tag-find (text token indent) | 3218 (defun speedbar-tag-find (text token indent) |
2534 "For the tag TEXT in a file TOKEN, goto that position. | 3219 "For the tag TEXT in a file TOKEN, goto that position. |
2535 INDENT is the current indentation level." | 3220 INDENT is the current indentation level." |
2554 (cond ((string-match "+" text) ;we have to expand this file | 3239 (cond ((string-match "+" text) ;we have to expand this file |
2555 (speedbar-change-expand-button-char ?-) | 3240 (speedbar-change-expand-button-char ?-) |
2556 (speedbar-with-writable | 3241 (speedbar-with-writable |
2557 (save-excursion | 3242 (save-excursion |
2558 (end-of-line) (forward-char 1) | 3243 (end-of-line) (forward-char 1) |
2559 (speedbar-insert-generic-list indent | 3244 (speedbar-insert-generic-list indent token 'speedbar-tag-expand |
2560 token 'speedbar-tag-expand | |
2561 'speedbar-tag-find)))) | 3245 'speedbar-tag-find)))) |
2562 ((string-match "-" text) ;we have to contract this node | 3246 ((string-match "-" text) ;we have to contract this node |
2563 (speedbar-change-expand-button-char ?+) | 3247 (speedbar-change-expand-button-char ?+) |
2564 (speedbar-delete-subblock indent)) | 3248 (speedbar-delete-subblock indent)) |
2565 (t (error "Ooops... not sure what to do."))) | 3249 (t (error "Ooops... not sure what to do"))) |
2566 (speedbar-center-buffer-smartly)) | 3250 (speedbar-center-buffer-smartly)) |
2567 | 3251 |
2568 ;;; Loading files into the attached frame. | 3252 ;;; Loading files into the attached frame. |
2569 ;; | 3253 ;; |
2570 (defun speedbar-find-file-in-frame (file) | 3254 (defun speedbar-find-file-in-frame (file) |
2579 (raise-frame (window-frame bwin))) | 3263 (raise-frame (window-frame bwin))) |
2580 (if speedbar-power-click | 3264 (if speedbar-power-click |
2581 (let ((pop-up-frames t)) (select-window (display-buffer buff))) | 3265 (let ((pop-up-frames t)) (select-window (display-buffer buff))) |
2582 (select-frame speedbar-attached-frame) | 3266 (select-frame speedbar-attached-frame) |
2583 (switch-to-buffer buff)))) | 3267 (switch-to-buffer buff)))) |
2584 ) | 3268 ) |
2585 | 3269 |
2586 ;;; Centering Utility | 3270 ;;; Centering Utility |
2587 ;; | 3271 ;; |
2588 (defun speedbar-center-buffer-smartly () | 3272 (defun speedbar-center-buffer-smartly () |
2589 "Recenter a speedbar buffer so the current indentation level is all visible. | 3273 "Recenter a speedbar buffer so the current indentation level is all visible. |
2676 '(;; Note that java has the same parse-group as c | 3360 '(;; Note that java has the same parse-group as c |
2677 ("\\.\\([cChH]\\|c\\+\\+\\|cpp\\|cc\\|hh\\|java\\)\\'" . | 3361 ("\\.\\([cChH]\\|c\\+\\+\\|cpp\\|cc\\|hh\\|java\\)\\'" . |
2678 speedbar-parse-c-or-c++tag) | 3362 speedbar-parse-c-or-c++tag) |
2679 ("^\\.emacs$\\|.\\(el\\|l\\|lsp\\)\\'" . | 3363 ("^\\.emacs$\\|.\\(el\\|l\\|lsp\\)\\'" . |
2680 "def[^i]+\\s-+\\(\\(\\w\\|[-_]\\)+\\)\\s-*\C-?") | 3364 "def[^i]+\\s-+\\(\\(\\w\\|[-_]\\)+\\)\\s-*\C-?") |
3365 ; ("\\.\\([fF]\\|for\\|FOR\\|77\\|90\\)\\'" . | |
3366 ; speedbar-parse-fortran77-tag) | |
2681 ("\\.tex\\'" . speedbar-parse-tex-string) | 3367 ("\\.tex\\'" . speedbar-parse-tex-string) |
2682 ("\\.p\\'" . | 3368 ("\\.p\\'" . |
2683 "\\(\\(FUNCTION\\|function\\|PROCEDURE\\|procedure\\)\\s-+\\([a-zA-Z0-9_.:]+\\)\\)\\s-*(?^?") | 3369 "\\(\\(FUNCTION\\|function\\|PROCEDURE\\|procedure\\)\\s-+\\([a-zA-Z0-9_.:]+\\)\\)\\s-*(?^?") |
2684 ) | 3370 ) |
2685 "Associations of file extensions and expressions for extracting tags. | 3371 "Associations of file extensions and expressions for extracting tags. |
2779 ; (while | 3465 ; (while |
2780 ; (re-search-forward "\\(.*[ \t]+\\)\\([^ \t\n]+.*\C-?\\)" nil t) | 3466 ; (re-search-forward "\\(.*[ \t]+\\)\\([^ \t\n]+.*\C-?\\)" nil t) |
2781 ; (delete-region (match-beginning 1) (match-end 1))))) | 3467 ; (delete-region (match-beginning 1) (match-end 1))))) |
2782 | 3468 |
2783 (defun speedbar-extract-one-symbol (expr) | 3469 (defun speedbar-extract-one-symbol (expr) |
2784 "At point, return nil, or one alist in the form: ( symbol . position ) | 3470 "At point, return nil, or one alist in the form: (SYMBOL . POSITION) |
2785 The line should contain output from etags. Parse the output using the | 3471 The line should contain output from etags. Parse the output using the |
2786 regular expression EXPR" | 3472 regular expression EXPR" |
2787 (let* ((sym (if (stringp expr) | 3473 (let* ((sym (if (stringp expr) |
2788 (if (save-excursion | 3474 (if (save-excursion |
2789 (re-search-forward expr (save-excursion | 3475 (re-search-forward expr (save-excursion |
2830 (buffer-substring-no-properties (match-beginning 0) | 3516 (buffer-substring-no-properties (match-beginning 0) |
2831 (match-end 0))) | 3517 (match-end 0))) |
2832 (t nil))))) | 3518 (t nil))))) |
2833 | 3519 |
2834 | 3520 |
3521 ;;; BUFFER DISPLAY mode. | |
3522 ;; | |
3523 (defvar speedbar-buffers-key-map nil | |
3524 "Keymap used when in the buffers display mode.") | |
3525 | |
3526 (if speedbar-buffers-key-map | |
3527 nil | |
3528 (setq speedbar-buffers-key-map (speedbar-make-specialized-keymap)) | |
3529 | |
3530 ;; Basic tree features | |
3531 (define-key speedbar-buffers-key-map "e" 'speedbar-edit-line) | |
3532 (define-key speedbar-buffers-key-map "\C-m" 'speedbar-edit-line) | |
3533 (define-key speedbar-buffers-key-map "+" 'speedbar-expand-line) | |
3534 (define-key speedbar-buffers-key-map "-" 'speedbar-contract-line) | |
3535 | |
3536 ;; Buffer specific keybindings | |
3537 (define-key speedbar-buffers-key-map "k" 'speedbar-buffer-kill-buffer) | |
3538 (define-key speedbar-buffers-key-map "r" 'speedbar-buffer-revert-buffer) | |
3539 | |
3540 ) | |
3541 | |
3542 (defvar speedbar-buffer-easymenu-definition | |
3543 '(["Jump to buffer" speedbar-edit-line t] | |
3544 ["Expand File Tags" speedbar-expand-line | |
3545 (save-excursion (beginning-of-line) | |
3546 (looking-at "[0-9]+: *.\\+. "))] | |
3547 ["Contract File Tags" speedbar-contract-line | |
3548 (save-excursion (beginning-of-line) | |
3549 (looking-at "[0-9]+: *.-. "))] | |
3550 ) | |
3551 "Menu item elements shown when displaying a buffer list.") | |
3552 | |
3553 (defun speedbar-buffer-buttons (directory zero) | |
3554 "Create speedbar buttons based on the buffers currently loaded. | |
3555 DIRECTORY is the path to the currently active buffer, and ZERO is 0." | |
3556 (speedbar-buffer-buttons-engine nil)) | |
3557 | |
3558 (defun speedbar-buffer-buttons-temp (directory zero) | |
3559 "Create speedbar buttons based on the buffers currently loaded. | |
3560 DIRECTORY is the path to the currently active buffer, and ZERO is 0." | |
3561 (speedbar-buffer-buttons-engine t)) | |
3562 | |
3563 (defun speedbar-buffer-buttons-engine (temp) | |
3564 "Create speedbar buffer buttons. | |
3565 If TEMP is non-nil, then clicking on a buffer restores the previous display." | |
3566 (insert "Active Buffers:\n") | |
3567 (let ((bl (buffer-list))) | |
3568 (while bl | |
3569 (if (string-match "^[ *]" (buffer-name (car bl))) | |
3570 nil | |
3571 (let* ((known (string-match speedbar-file-regexp | |
3572 (buffer-name (car bl)))) | |
3573 (expchar (if known ?+ ??)) | |
3574 (fn (if known 'speedbar-tag-file nil)) | |
3575 (fname (save-excursion (set-buffer (car bl)) | |
3576 (buffer-file-name)))) | |
3577 (speedbar-make-tag-line 'bracket expchar fn fname | |
3578 (buffer-name (car bl)) | |
3579 'speedbar-buffer-click temp | |
3580 'speedbar-file-face 0))) | |
3581 (setq bl (cdr bl))) | |
3582 (setq bl (buffer-list)) | |
3583 (insert "Scratch Buffers:\n") | |
3584 (while bl | |
3585 (if (not (string-match "^\\*" (buffer-name (car bl)))) | |
3586 nil | |
3587 (if (eq (car bl) speedbar-buffer) | |
3588 nil | |
3589 (speedbar-make-tag-line 'bracket ?? nil nil | |
3590 (buffer-name (car bl)) | |
3591 'speedbar-buffer-click temp | |
3592 'speedbar-file-face 0))) | |
3593 (setq bl (cdr bl))) | |
3594 (setq bl (buffer-list)) | |
3595 (insert "Hidden Buffers:\n") | |
3596 (while bl | |
3597 (if (not (string-match "^ " (buffer-name (car bl)))) | |
3598 nil | |
3599 (if (eq (car bl) speedbar-buffer) | |
3600 nil | |
3601 (speedbar-make-tag-line 'bracket ?? nil nil | |
3602 (buffer-name (car bl)) | |
3603 'speedbar-buffer-click temp | |
3604 'speedbar-file-face 0))) | |
3605 (setq bl (cdr bl))))) | |
3606 | |
3607 (defun speedbar-buffer-click (text token indent) | |
3608 "When the users clicks on a buffer-button in speedbar. | |
3609 TEXT is the buffer's name, TOKEN and INDENT are unused." | |
3610 (if speedbar-power-click | |
3611 (let ((pop-up-frames t)) (select-window (display-buffer text))) | |
3612 (select-frame speedbar-attached-frame) | |
3613 (switch-to-buffer text) | |
3614 (if token (speedbar-change-initial-expansion-list | |
3615 speedbar-previously-used-expansion-list-name)))) | |
3616 | |
3617 (defun speedbar-buffer-kill-buffer () | |
3618 "Kill the buffer the cursor is on in the speedbar buffer." | |
3619 (interactive) | |
3620 (or (save-excursion | |
3621 (beginning-of-line) | |
3622 ;; If this fails, then it is a non-standard click, and as such, | |
3623 ;; perfectly allowed. | |
3624 (if (re-search-forward "[]>}] [a-zA-Z0-9]" | |
3625 (save-excursion (end-of-line) (point)) | |
3626 t) | |
3627 (let ((text (progn | |
3628 (forward-char -1) | |
3629 (buffer-substring (point) (save-excursion | |
3630 (end-of-line) | |
3631 (point)))))) | |
3632 (if (and (get-buffer text) | |
3633 (y-or-n-p (format "Kill buffer %s? " text))) | |
3634 (kill-buffer text))))))) | |
3635 | |
3636 (defun speedbar-buffer-revert-buffer () | |
3637 "Revert the buffer the cursor is on in the speedbar buffer." | |
3638 (interactive) | |
3639 (save-excursion | |
3640 (beginning-of-line) | |
3641 ;; If this fails, then it is a non-standard click, and as such, | |
3642 ;; perfectly allowed | |
3643 (if (re-search-forward "[]>}] [a-zA-Z0-9]" | |
3644 (save-excursion (end-of-line) (point)) | |
3645 t) | |
3646 (let ((text (progn | |
3647 (forward-char -1) | |
3648 (buffer-substring (point) (save-excursion | |
3649 (end-of-line) | |
3650 (point)))))) | |
3651 (if (get-buffer text) | |
3652 (progn | |
3653 (set-buffer text) | |
3654 (revert-buffer t))))))) | |
3655 | |
3656 | |
3657 | |
2835 ;;; Color loading section This is messy *Blech!* | 3658 ;;; Color loading section This is messy *Blech!* |
2836 ;; | 3659 ;; |
2837 (defface speedbar-button-face '((((class color) (background light)) | 3660 (defface speedbar-button-face '((((class color) (background light)) |
2838 (:foreground "green4")) | 3661 (:foreground "green4")) |
2839 (((class color) (background dark)) | 3662 (((class color) (background dark)) |