167
|
1 ;;; speedbar --- quick access to files and tags -*-byte-compile-warnings:nil;-*-
|
|
2
|
|
3 ;; Copyright (C) 1996, 1997 Eric M. Ludlam
|
|
4 ;;
|
|
5 ;; Author: Eric M. Ludlam <zappo@gnu.ai.mit.edu>
|
|
6 ;; Version: 0.5
|
|
7 ;; Keywords: file, tags, tools
|
203
|
8 ;; X-RCS: $Id: speedbar.el,v 1.4 1997/10/12 01:39:54 steve Exp $
|
167
|
9 ;;
|
|
10 ;; This program is free software; you can redistribute it and/or modify
|
|
11 ;; it under the terms of the GNU General Public License as published by
|
|
12 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
13 ;; any later version.
|
|
14 ;;
|
|
15 ;; This program is distributed in the hope that it will be useful,
|
|
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
18 ;; GNU General Public License for more details.
|
|
19 ;;
|
|
20 ;; You should have received a copy of the GNU General Public License
|
|
21 ;; along with this program; if not, you can either send email to this
|
|
22 ;; program's author (see below) or write to:
|
|
23 ;;
|
|
24 ;; The Free Software Foundation, Inc.
|
|
25 ;; 675 Mass Ave.
|
|
26 ;; Cambridge, MA 02139, USA.
|
|
27 ;;
|
|
28 ;; Please send bug reports, etc. to zappo@gnu.ai.mit.edu.
|
|
29 ;;
|
100
|
30
|
167
|
31 ;;; Commentary:
|
|
32 ;;
|
|
33 ;; The speedbar provides a frame in which files, and locations in
|
|
34 ;; files are displayed. These items can be clicked on with mouse-2
|
|
35 ;; in order to make the last active frame display that file location.
|
|
36 ;;
|
|
37 ;; To use speedbar, add this to your .emacs file:
|
|
38 ;;
|
|
39 ;; (autoload 'speedbar-frame-mode "speedbar" "Popup a speedbar frame" t)
|
|
40 ;; (autoload 'speedbar-get-focus "speedbar" "Jump to speedbar frame" t)
|
|
41 ;;
|
|
42 ;; If you want to choose it from a menu or something, do this:
|
|
43 ;;
|
|
44 ;; (define-key-after (lookup-key global-map [menu-bar tools])
|
|
45 ;; [speedbar] '("Speedbar" . speedbar-frame-mode) [calendar])
|
|
46 ;;
|
|
47 ;; If you want to access speedbar using only the keyboard, do this:
|
|
48 ;;
|
|
49 ;; (define-key global-map [f4] 'speedbar-get-focus)
|
|
50 ;;
|
|
51 ;; This will let you hit f4 (or whatever key you choose) to jump
|
|
52 ;; focus to the speedbar frame. Pressing RET or e to jump to a file
|
|
53 ;; or tag will move you back to the attached frame. The command
|
|
54 ;; `speedbar-get-fucus' will also create a speedbar frame if it does
|
|
55 ;; not exist.
|
|
56 ;;
|
|
57 ;; Once a speedbar frame is active, it takes advantage of idle time
|
|
58 ;; to keep it's contents updated. The contents is usually a list of
|
|
59 ;; files in the directory of the currently active buffer. When
|
|
60 ;; applicable, tags in the active file can be expanded.
|
|
61 ;;
|
|
62 ;; To add new supported files types into speedbar, use the function
|
|
63 ;; `speedbar-add-supported-extension' If speedbar complains that the
|
|
64 ;; file type is not supported, that means there is no built in
|
|
65 ;; support from imenu, and the etags part wasn't set up correctly. You
|
|
66 ;; may add elements to `speedbar-supported-extension-expressions' as long
|
|
67 ;; as it is done before speedbar is loaded.
|
|
68 ;;
|
|
69 ;; To prevent speedbar from following you into certain directories
|
|
70 ;; use the function `speedbar-add-ignored-path-regexp' too add a new
|
|
71 ;; regular expression matching a type of path. You may add list
|
|
72 ;; elements to `speedbar-ignored-path-expressions' as long as it is
|
|
73 ;; done before speedbar is loaded.
|
|
74 ;;
|
|
75 ;; To add new file types to imenu, see the documentation in the
|
|
76 ;; file imenu.el that comes with emacs. To add new file types which
|
|
77 ;; etags supports, you need to modify the variable
|
|
78 ;; `speedbar-fetch-etags-parse-list'.
|
|
79 ;;
|
|
80 ;; If the updates are going too slow for you, modify the variable
|
|
81 ;; `speedbar-update-speed' to a longer idle time before updates.
|
|
82 ;;
|
|
83 ;; If you navigate directories, you will probably notice that you
|
|
84 ;; will navigate to a directory which is eventually replaced after
|
|
85 ;; you go back to editing a file (unless you pull up a new file.)
|
|
86 ;; The delay time before this happens is in
|
|
87 ;; `speedbar-navigating-speed', and defaults to 10 seconds.
|
|
88 ;;
|
|
89 ;; XEmacs users may want to change the default timeouts for
|
|
90 ;; `speedbar-update-speed' to something longer as XEmacs doesn't have
|
|
91 ;; idle timers, the speedbar timer keeps going off arbitrarilly while
|
|
92 ;; you're typing. It's quite pesky.
|
|
93 ;;
|
|
94 ;; Users of emacs previous to to v 19.31 (when idle timers
|
|
95 ;; where introduced) will not have speedbar updating automatically.
|
|
96 ;; Use "r" to refresh the display after changing directories.
|
|
97 ;; Remember, do not interrupt the stealthy updates or you display may
|
|
98 ;; not be completely refreshed.
|
|
99 ;;
|
|
100 ;; See optional file `speedbspec.el' for additional configurations
|
|
101 ;; which allow speedbar to create specialized lists for special modes
|
|
102 ;; that are not file-related.
|
|
103 ;;
|
|
104 ;; See optional file `speedbcfg.el' for interactive buffers
|
|
105 ;; allowing simple configuration of colors and features of speedbar.
|
|
106 ;;
|
|
107 ;; AUC-TEX users: The imenu tags for AUC-TEX mode don't work very
|
|
108 ;; well. Use the imenu keywords from tex-mode.el for better results.
|
|
109 ;;
|
|
110 ;; This file requires the library package assoc (association lists)
|
100
|
111
|
|
112 ;;; Speedbar updates can be found at:
|
167
|
113 ;; ftp://ftp.ultranet.com/pub/zappo/speedbar*.tar.gz
|
|
114 ;;
|
100
|
115
|
167
|
116 ;;; Change log:
|
|
117 ;; 0.1 Initial Revision
|
|
118 ;; 0.2 Fixed problem with x-pointer-shape causing future frames not
|
|
119 ;; to be created.
|
|
120 ;; Fixed annoying habit of `speedbar-update-contents' to make
|
|
121 ;; it possible to accidentally kill the speedbar buffer.
|
|
122 ;; Clicking directory names now only changes the contents of
|
|
123 ;; the speedbar, and does not cause a dired mode to appear.
|
|
124 ;; Clicking the <+> next to the directory does cause dired to
|
|
125 ;; be run.
|
|
126 ;; Added XEmacs support, which means timer support moved to a
|
|
127 ;; platform independant call.
|
|
128 ;; Added imenu support. Now modes are supported by imenu
|
|
129 ;; first, and etags only if the imenu call doesn't work.
|
|
130 ;; Imenu is a little faster than etags, and is more emacs
|
|
131 ;; friendly.
|
|
132 ;; Added more user control variables described in the commentary.
|
|
133 ;; Added smart recentering when nodes are opened and closed.
|
|
134 ;; 0.3 x-pointer-shape fixed for emacs 19.35, so I put that check in.
|
|
135 ;; Added invisible codes to the beginning of each line.
|
|
136 ;; Added list aproach to node expansion for easier addition of new
|
|
137 ;; types of things to expand by
|
|
138 ;; Added multi-level path name support
|
|
139 ;; Added multi-level tag name support.
|
|
140 ;; Only mouse-2 is now used for node expansion
|
|
141 ;; Added keys e + - to edit expand, and contract node lines
|
|
142 ;; Added longer legal file regexp for all those modes which support
|
|
143 ;; imenu. (pascal, fortran90, ada, pearl)
|
|
144 ;; Added pascal support to etags from Dave Penkler <dave_penkler@grenoble.hp.com>
|
|
145 ;; Fixed centering algorithm
|
|
146 ;; Tried to choose background independent colors. Made more robust.
|
|
147 ;; Rearranged code into a more logical order
|
|
148 ;; 0.3.1 Fixed doc & broken keybindings
|
|
149 ;; Added mode hooks.
|
|
150 ;; Improved color selection to be background mode smart
|
|
151 ;; `nil' passed to `speedbar-frame-mode' now toggles the frame as
|
|
152 ;; advertised in the doc string
|
|
153 ;; 0.4a Added modified patch from Dan Schmidt <dfan@lglass.com> allowing a
|
|
154 ;; directory cache to be maintained speeding up revisiting of files.
|
|
155 ;; Default raise-lower behavior is now off by default.
|
|
156 ;; Added some menu items for edit expand and contract.
|
|
157 ;; Pre 19.31 emacsen can run without idle timers.
|
|
158 ;; Added some patch information from Farzin Guilak <farzin@protocol.com>
|
|
159 ;; adding xemacs specifics, and some etags upgrades.
|
|
160 ;; Added ability to set a faces symbol-value to a string
|
|
161 ;; representing the desired foreground color. (idea from
|
|
162 ;; Farzin Guilak, but implemented differently)
|
|
163 ;; Fixed problem with 1 character buttons.
|
|
164 ;; Added support for new Imenu marker technique.
|
|
165 ;; Added `speedbar-load-hooks' for things to run only once on
|
|
166 ;; load such as updating one of the many lists.
|
|
167 ;; Added `speedbar-supported-extension-expressions' which is a
|
|
168 ;; list of extensions that speedbar will tag. This variable
|
|
169 ;; should only be updated with `speedbar-add-supported-extension'
|
|
170 ;; Moved configure dialog support to a separate file so
|
|
171 ;; speedbar is not dependant on eieio to run
|
|
172 ;; Fixed list-contraction problem when the item was at the end
|
|
173 ;; of a sublist.
|
|
174 ;; Fixed XEmacs multi-frame timer selecting bug problem.
|
|
175 ;; Added `speedbar-ignored-modes' which is a list of major modes
|
|
176 ;; speedbar will not follow when it is displayed in the selected frame
|
|
177 ;; 0.4 When the file being edited is not in the list, and is a file
|
|
178 ;; that should be in the list, the speedbar cache is replaced.
|
|
179 ;; Temp buffers are now shown in the attached frame not the
|
|
180 ;; speedbar frame
|
|
181 ;; New variables `speedbar-vc-*' and `speedbar-stealthy-function-list'
|
|
182 ;; added. `speedbar-update-current-file' is now a member of
|
|
183 ;; the stealthy list. New function `speedbar-check-vc' will
|
|
184 ;; examine each file and mark it if it is checked out. To
|
|
185 ;; add new version control types, override the function
|
|
186 ;; `speedbar-this-file-in-vc' and `speedbar-vc-check-dir-p'.
|
|
187 ;; The stealth list is interruptible so that long operations
|
|
188 ;; do not interrupt someones editing flow. Other long
|
|
189 ;; speedbar updates will be added to the stealthy list in the
|
|
190 ;; future should interesting ones be needed.
|
|
191 ;; Added many new functions including:
|
|
192 ;; `speedbar-item-byte-compile' `speedbar-item-load'
|
|
193 ;; `speedbar-item-copy' `speedbar-item-rename' `speedbar-item-delete'
|
|
194 ;; and `speedbar-item-info'
|
|
195 ;; If the user kills the speedbar buffer in some way, the frame will
|
|
196 ;; be removed.
|
|
197 ;; 0.4.1 Bug fixes
|
|
198 ;; <mark.jeffries@nomura.co.uk> added `speedbar-update-flag',
|
|
199 ;; XEmacs fixes for menus, and tag sorting, and quit key.
|
|
200 ;; Modeline now updates itself based on window-width.
|
|
201 ;; Frame is cached when closed to make pulling it up again faster.
|
|
202 ;; Speedbars window is now marked as dedicated.
|
|
203 ;; Added bindings: <grossjoh@charly.informatik.uni-dortmund.de>
|
|
204 ;; Long directories are now span multiple lines autmoatically
|
|
205 ;; Added `speedbar-directory-button-trim-method' to specify how to
|
|
206 ;; sorten the directory button to fit on the screen.
|
|
207 ;; 0.4.2 Add one level of full-text cache.
|
|
208 ;; Add `speedbar-get-focus' to switchto/raise the speedbar frame.
|
|
209 ;; Editing thing-on-line will auto-raise the attached frame.
|
|
210 ;; Bound `U' to `speedbar-up-directory' command.
|
|
211 ;; Refresh will now maintain all subdirectories that were open
|
|
212 ;; when the refresh was requested. (This does not include the
|
|
213 ;; tags, only the directories)
|
|
214 ;; 0.4.3 Bug fixes
|
|
215 ;; 0.4.4 Added `speedbar-ignored-path-expressions' and friends.
|
|
216 ;; Configuration menu items not displayed if dialog-mode not present
|
|
217 ;; Speedbar buffer now starts with a space, and is not deleted
|
|
218 ;; ewhen the speedbar frame is closed. This prevents the invisible
|
|
219 ;; frame from preventing buffer switches with other buffers.
|
|
220 ;; Fixed very bad bug in the -add-[extension|path] functions.
|
|
221 ;; Added `speedbar-find-file-in-frame' which will always pop up a frame
|
|
222 ;; that is already display a buffer selected in the speedbar buffer.
|
|
223 ;; Added S-mouse2 as "power click" for always poping up a new frame.
|
|
224 ;; and always rescanning with imenu (ditching the imenu cache), and
|
|
225 ;; always rescanning directories.
|
|
226 ;; 0.4.5 XEmacs bugfixes and enhancements.
|
|
227 ;; Window Title simplified.
|
|
228 ;; 0.4.6 Fixed problems w/ dedicated minibuffer frame.
|
|
229 ;; Fixed errors reported by checkdoc.
|
|
230 ;; 0.5 Mode-specific contents added. Controlled w/ the variable
|
|
231 ;; `speedbar-mode-specific-contents-flag'. See speedbspec
|
|
232 ;; for info on enabling this feature.
|
|
233 ;; `speedbar-load-hook' name change and pointer check against
|
|
234 ;; major-mode. Suggested by Sam Steingold <sds@ptc.com>
|
|
235 ;; Quit auto-selects the attached frame.
|
|
236 ;; Ranamed `speedbar-do-updates' to `speedbar-update-flag'
|
|
237 ;; Passes checkdoc.
|
|
238
|
100
|
239 ;;; TODO:
|
167
|
240 ;; 1) More functions to create buttons and options
|
|
241 ;; 2) filtering algoritms to reduce the number of tags/files displayed.
|
|
242 ;; 3) Timeout directories we haven't visited in a while.
|
|
243 ;; 4) Remeber tags when refreshing the display. (Refresh tags too?)
|
|
244 ;; 5) More 'special mode support.
|
|
245 ;; 6) Smart way to auto-expand instead of directory switch
|
100
|
246
|
167
|
247 ;;; Code:
|
|
248 (require 'assoc)
|
|
249 (require 'easymenu)
|
|
250
|
|
251 (defvar speedbar-xemacsp (string-match "XEmacs" emacs-version)
|
|
252 "Non-nil if we are running in the XEmacs environment.")
|
100
|
253
|
|
254 (defvar speedbar-initial-expansion-list
|
|
255 '(speedbar-directory-buttons speedbar-default-directory-list)
|
167
|
256 "List of functions to call to fill in the speedbar buffer.
|
|
257 Whenever a top level update is issued all functions in this list are
|
|
258 run. These functions will always get the default directory to use
|
|
259 passed in as the first parameter, and a 0 as the second parameter.
|
|
260 The 0 indicates the uppermost indentation level. They must assume
|
|
261 that the cursor is at the position where they start inserting
|
|
262 buttons.")
|
|
263
|
|
264 (defvar speedbar-stealthy-function-list
|
|
265 '(speedbar-update-current-file speedbar-check-vc)
|
|
266 "List of functions to periodically call stealthily.
|
|
267 Each function must return nil if interrupted, or t if completed.
|
|
268 Stealthy functions which have a single operation should always return
|
|
269 t. Functions which take a long time should maintain a state (where
|
|
270 they are in their speedbar related calculations) and permit
|
|
271 interruption. See `speedbar-check-vc' as a good example.")
|
|
272
|
|
273 (defvar speedbar-mode-specific-contents-flag t
|
|
274 "*Non-nil means speedbar will show specail-mode contents.
|
|
275 This permits some modes to create customized contents for the speedbar
|
|
276 frame.")
|
|
277
|
|
278 (defvar speedbar-special-mode-expansion-list nil
|
|
279 "Mode specific list of functions to call to fill in speedbar.
|
|
280 Some modes, such as Info or RMAIL, do not relate quite as easily into
|
|
281 a simple list of files. When this variable is non-nil and buffer-local,
|
|
282 then these functions are used, creating specialized contents. These
|
|
283 functions are called each time the speedbar timer is called. This
|
|
284 allows a mode to update it's contents regularly.
|
|
285
|
|
286 Each function is called with the default and frame belonging to
|
|
287 speedbar, and with one parameter; the buffer requesting
|
|
288 the speedbar display.")
|
|
289
|
|
290 (defvar speedbar-load-hook nil
|
|
291 "Hooks run when speedbar is loaded.")
|
|
292
|
|
293 (defvar speedbar-desired-buffer nil
|
|
294 "Non-nil when speedbar is showing buttons specific a special mode.
|
|
295 In this case it is the originating buffer.")
|
100
|
296
|
|
297 (defvar speedbar-show-unknown-files nil
|
167
|
298 "*Non-nil show files we can't expand with a ? in the expand button.
|
|
299 nil means don't show the file in the list.")
|
100
|
300
|
203
|
301 ;; XEmacs timers aren't based on idleness. Therefore tune it down a little
|
100
|
302 ;; or suffer mightilly!
|
|
303 (defvar speedbar-update-speed (if speedbar-xemacsp 5 1)
|
167
|
304 "*Idle time in seconds needed before speedbar will update itself.
|
|
305 Updates occur to allow speedbar to display directory information
|
|
306 relevant to the buffer you are currently editing.")
|
100
|
307 (defvar speedbar-navigating-speed 10
|
167
|
308 "*Idle time to wait after navigation commands in speedbar are executed.
|
|
309 Navigation commands included expanding/contracting nodes, and moving
|
|
310 between different directories.")
|
100
|
311
|
167
|
312 (defvar speedbar-frame-parameters (list
|
203
|
313 ;; XEmacs fails to delete speedbar
|
167
|
314 ;; if minibuffer is off.
|
|
315 ;(cons 'minibuffer
|
|
316 ; (if speedbar-xemacsp t nil))
|
|
317 ;; The above behavior seems to have fixed
|
|
318 ;; itself somewhere along the line.
|
|
319 ;; let me know if any problems arise.
|
|
320 '(minibuffer . nil)
|
|
321 '(width . 20)
|
|
322 '(scroll-bar-width . 10)
|
|
323 '(border-width . 0)
|
|
324 '(unsplittable . t) )
|
|
325 "*Parameters to use when creating the speedbar frame.
|
|
326 Parameters not listed here which will be added automatically are
|
|
327 `height' which will be initialized to the height of the frame speedbar
|
|
328 is attached to. To add more frame defaults, `cons' new alist members
|
|
329 onto this variable through the `speedbar-load-hook'")
|
100
|
330
|
167
|
331 (defvar speedbar-use-imenu-flag (stringp (locate-library "imenu"))
|
|
332 "*Non-nil means use imenu for file parsing. nil to use etags.
|
|
333 XEmacs doesn't support imenu, therefore the default is to use etags
|
|
334 instead. Etags support is not as robust as imenu support.")
|
100
|
335
|
167
|
336 (defvar speedbar-sort-tags nil
|
|
337 "*If Non-nil, sort tags in the speedbar display. (Etags only)
|
|
338 See imenu.el source for how imenu does sorting.")
|
|
339
|
|
340 (defvar speedbar-directory-button-trim-method 'span
|
|
341 "*Indicates how the directory button will be displayed.
|
|
342 Possible values are:
|
|
343 'span - span large directories over multiple lines.
|
|
344 'trim - trim large directories to only show the last few.
|
|
345 nil - no trimming.")
|
100
|
346
|
|
347 (defvar speedbar-before-delete-hook nil
|
167
|
348 "*Hooks called before deleting the speedbar frame.")
|
100
|
349
|
|
350 (defvar speedbar-mode-hook nil
|
167
|
351 "*Hooks called after creating a speedbar buffer.")
|
100
|
352
|
|
353 (defvar speedbar-timer-hook nil
|
167
|
354 "*Hooks called after running the speedbar timer function.")
|
|
355
|
|
356 (defvar speedbar-verbosity-level 1
|
|
357 "*Verbosity level of the speedbar. 0 means say nothing.
|
|
358 1 means medium level verbosity. 2 and higher are higher levels of
|
|
359 verbosity.")
|
|
360
|
|
361 (defvar speedbar-vc-indicator " *"
|
|
362 "*Text used to mark files which are currently checked out.
|
|
363 Currently only RCS is supported. Other version control systems can be
|
|
364 added by examining the function `speedbar-this-file-in-vc' and
|
|
365 `speedbar-vc-check-dir-p'")
|
|
366
|
|
367 (defvar speedbar-vc-do-check t
|
|
368 "*Non-nil check all files in speedbar to see if they have been checked out.
|
|
369 Any file checked out is marked with `speedbar-vc-indicator'")
|
|
370
|
|
371 (defvar speedbar-vc-to-do-point nil
|
|
372 "Local variable maintaining the current version control check position.")
|
|
373
|
|
374 (defvar speedbar-ignored-modes nil
|
|
375 "*List of major modes which speedbar will not switch directories for.")
|
|
376
|
|
377 (defvar speedbar-ignored-path-expressions
|
|
378 '("/log/$")
|
|
379 "*List of regular expressions matching directories speedbar will ignore.
|
|
380 They should included paths to directories which are notoriously very
|
|
381 large and take a long time to load in. Use the function
|
|
382 `speedbar-add-ignored-path-regexp' to add new items to this list after
|
|
383 speedbar is loaded. You may place anything you like in this list
|
|
384 before speedbar has been loaded.")
|
100
|
385
|
|
386 (defvar speedbar-file-unshown-regexp
|
|
387 (let ((nstr "") (noext completion-ignored-extensions))
|
|
388 (while noext
|
|
389 (setq nstr (concat nstr (regexp-quote (car noext)) "$"
|
|
390 (if (cdr noext) "\\|" ""))
|
|
391 noext (cdr noext)))
|
|
392 (concat nstr "\\|#[^#]+#$\\|\\.\\.?$"))
|
167
|
393 "*Regexp matching files we don't want displayed in a speedbar buffer.
|
|
394 It is generated from the variable `completion-ignored-extensions'")
|
|
395
|
|
396 (defvar speedbar-supported-extension-expressions
|
|
397 (append '(".[CcHh]\\(++\\|pp\\|c\\|h\\)?" ".tex\\(i\\(nfo\\)?\\)?"
|
|
398 ".el" ".emacs" ".p" ".java")
|
|
399 (if speedbar-use-imenu-flag
|
|
400 '(".f90" ".ada" ".pl" ".tcl" ".m"
|
|
401 "Makefile\\(\\.in\\)?")))
|
|
402 "*List of regular expressions which will match files supported by tagging.
|
|
403 Do not prefix the `.' char with a double \\ to quote it, as the period
|
|
404 will be stripped by a simplified optimizer when compiled into a
|
|
405 singular expression. This variable will be turned into
|
|
406 `speedbar-file-regexp' for use with speedbar. You should use the
|
|
407 function `speedbar-add-supported-extension' to add a new extension at
|
|
408 runtime, or use the configuration dialog to set it in your .emacs
|
|
409 file.")
|
|
410
|
|
411 (defun speedbar-extension-list-to-regex (extlist)
|
|
412 "Takes EXTLIST, a list of extensions and transforms it into regexp.
|
|
413 All the preceding . are stripped for an optimized expression starting
|
|
414 with . followed by extensions, followed by full-filenames."
|
|
415 (let ((regex1 nil) (regex2 nil))
|
|
416 (while extlist
|
|
417 (if (= (string-to-char (car extlist)) ?.)
|
|
418 (setq regex1 (concat regex1 (if regex1 "\\|" "")
|
|
419 (substring (car extlist) 1)))
|
|
420 (setq regex2 (concat regex2 (if regex2 "\\|" "") (car extlist))))
|
|
421 (setq extlist (cdr extlist)))
|
|
422 ;; concat all the sub-exressions together, making sure all types
|
|
423 ;; of parts exist during concatination.
|
|
424 (concat "\\("
|
|
425 (if regex1 (concat "\\(\\.\\(" regex1 "\\)\\)") "")
|
|
426 (if (and regex1 regex2) "\\|" "")
|
|
427 (if regex2 (concat "\\(" regex2 "\\)") "")
|
|
428 "\\)$")))
|
|
429
|
|
430 (defvar speedbar-ignored-path-regexp
|
|
431 (speedbar-extension-list-to-regex speedbar-ignored-path-expressions)
|
|
432 "Regular expression matching paths speedbar will not switch to.
|
|
433 Created from `speedbar-ignored-path-expressions' with the function
|
|
434 `speedbar-extension-list-to-regex' (A misnamed function in this case.)
|
|
435 Use the function `speedbar-add-ignored-path-regexp' to modify this
|
|
436 variable.")
|
100
|
437
|
167
|
438 (defvar speedbar-file-regexp
|
|
439 (speedbar-extension-list-to-regex speedbar-supported-extension-expressions)
|
|
440 "Regular expression matching files we know how to expand.
|
|
441 Created from `speedbar-supported-extension-expression' with the
|
|
442 function `speedbar-extension-list-to-regex'")
|
|
443
|
|
444 (defun speedbar-add-supported-extension (extension)
|
|
445 "Add EXTENSION as a new supported extension for speedbar tagging.
|
|
446 This should start with a `.' if it is not a complete file name, and
|
|
447 the dot should NOT be quoted in with \\. Other regular expression
|
|
448 matchers are allowed however. EXTENSION may be a single string or a
|
|
449 list of strings."
|
|
450 (if (not (listp extension)) (setq extension (list extension)))
|
|
451 (while extension
|
|
452 (if (member (car extension) speedbar-supported-extension-expressions)
|
|
453 nil
|
|
454 (setq speedbar-supported-extension-expressions
|
|
455 (cons (car extension) speedbar-supported-extension-expressions)))
|
|
456 (setq extension (cdr extension)))
|
|
457 (setq speedbar-file-regexp (speedbar-extension-list-to-regex
|
|
458 speedbar-supported-extension-expressions)))
|
|
459
|
|
460 (defun speedbar-add-ignored-path-regexp (path-expression)
|
|
461 "Add PATH-EXPRESSION as a new ignored path for speedbar tracking.
|
|
462 This function will modify `speedbar-ignored-path-regexp' and add
|
|
463 PATH-EXPRESSION to `speedbar-ignored-path-expressions'."
|
|
464 (if (not (listp path-expression))
|
|
465 (setq path-expression (list path-expression)))
|
|
466 (while path-expression
|
|
467 (if (member (car path-expression) speedbar-ignored-path-expressions)
|
|
468 nil
|
|
469 (setq speedbar-ignored-path-expressions
|
|
470 (cons (car path-expression) speedbar-ignored-path-expressions)))
|
|
471 (setq path-expression (cdr path-expression)))
|
|
472 (setq speedbar-ignored-path-regexp (speedbar-extension-list-to-regex
|
|
473 speedbar-ignored-path-expressions)))
|
|
474
|
|
475 (defvar speedbar-update-flag (or (not (fboundp 'run-with-idle-timer))
|
|
476 (not (fboundp 'start-itimer)))
|
|
477 "*Non-nil means to automatically update the display.
|
|
478 When this is nil then speedbar will not follow the attached frame's path.
|
|
479 When speedbar is active, use:
|
|
480
|
|
481 \\<speedbar-key-map> `\\[speedbar-toggle-updates]'
|
|
482
|
|
483 to toggle this value.")
|
100
|
484
|
|
485 (defvar speedbar-syntax-table nil
|
167
|
486 "Syntax-table used on the speedbar.")
|
100
|
487
|
|
488 (if speedbar-syntax-table
|
|
489 nil
|
|
490 (setq speedbar-syntax-table (make-syntax-table))
|
|
491 ;; turn off paren matching around here.
|
|
492 (modify-syntax-entry ?\' " " speedbar-syntax-table)
|
|
493 (modify-syntax-entry ?\" " " speedbar-syntax-table)
|
|
494 (modify-syntax-entry ?( " " speedbar-syntax-table)
|
|
495 (modify-syntax-entry ?) " " speedbar-syntax-table)
|
|
496 (modify-syntax-entry ?[ " " speedbar-syntax-table)
|
|
497 (modify-syntax-entry ?] " " speedbar-syntax-table))
|
167
|
498
|
100
|
499
|
|
500 (defvar speedbar-key-map nil
|
|
501 "Keymap used in speedbar buffer.")
|
167
|
502
|
|
503 (autoload 'speedbar-configure-options "speedbcfg" "Configure speedbar variables" t)
|
|
504 (autoload 'speedbar-configure-faces "speedbcfg" "Configure speedbar faces" t)
|
100
|
505
|
|
506 (if speedbar-key-map
|
|
507 nil
|
|
508 (setq speedbar-key-map (make-keymap))
|
|
509 (suppress-keymap speedbar-key-map t)
|
|
510
|
167
|
511 ;; control
|
100
|
512 (define-key speedbar-key-map "e" 'speedbar-edit-line)
|
167
|
513 (define-key speedbar-key-map "\C-m" 'speedbar-edit-line)
|
100
|
514 (define-key speedbar-key-map "+" 'speedbar-expand-line)
|
|
515 (define-key speedbar-key-map "-" 'speedbar-contract-line)
|
167
|
516 (define-key speedbar-key-map "g" 'speedbar-refresh)
|
|
517 (define-key speedbar-key-map "t" 'speedbar-toggle-updates)
|
|
518 (define-key speedbar-key-map "q" 'speedbar-close-frame)
|
|
519 (define-key speedbar-key-map "U" 'speedbar-up-directory)
|
|
520
|
|
521 ;; navigation
|
|
522 (define-key speedbar-key-map "n" 'speedbar-next)
|
|
523 (define-key speedbar-key-map "p" 'speedbar-prev)
|
|
524 (define-key speedbar-key-map " " 'speedbar-scroll-up)
|
|
525 (define-key speedbar-key-map "\C-?" 'speedbar-scroll-down)
|
|
526
|
|
527 ;; After much use, I suddenly desired in my heart to perform dired
|
|
528 ;; style operations since the directory was RIGHT THERE!
|
|
529 (define-key speedbar-key-map "I" 'speedbar-item-info)
|
|
530 (define-key speedbar-key-map "B" 'speedbar-item-byte-compile)
|
|
531 (define-key speedbar-key-map "L" 'speedbar-item-load)
|
|
532 (define-key speedbar-key-map "C" 'speedbar-item-copy)
|
|
533 (define-key speedbar-key-map "D" 'speedbar-item-delete)
|
|
534 (define-key speedbar-key-map "R" 'speedbar-item-rename)
|
100
|
535
|
|
536 (if (string-match "XEmacs" emacs-version)
|
|
537 (progn
|
|
538 ;; bind mouse bindings so we can manipulate the items on each line
|
|
539 (define-key speedbar-key-map 'button2 'speedbar-click)
|
167
|
540 (define-key speedbar-key-map '(shift button2) 'speedbar-power-click)
|
|
541 (define-key speedbar-key-map '(meta button3) 'speedbar-mouse-item-info)
|
100
|
542
|
167
|
543 ;; Setup XEmacs Menubar w/ etags specific items
|
|
544 (defvar speedbar-menu
|
|
545 '("Speed Bar"
|
|
546 ["Run Speedbar" (speedbar-frame-mode 1) t]
|
|
547 ["Refresh" speedbar-refresh t]
|
|
548 ["Allow Auto Updates"
|
|
549 speedbar-toggle-updates
|
|
550 :style toggle
|
|
551 :selected speedbar-update-flag]
|
|
552 "-----"
|
|
553 ["Sort etags in Speedbar"
|
|
554 (speedbar-toggle-etags "sort")
|
|
555 :style toggle
|
|
556 :selected speedbar-sort-tags]
|
|
557 ["Show unknown files"
|
|
558 (speedbar-toggle-etags "show")
|
|
559 :style toggle
|
|
560 :selected speedbar-show-unknown-files]
|
|
561 "-----"
|
|
562 ["Use C++ Tagging"
|
|
563 (speedbar-toggle-etags "-C")
|
|
564 :style toggle
|
|
565 :selected (member "-C" speedbar-fetch-etags-arguments)]
|
|
566 ["Tag preprocessor defs"
|
|
567 (speedbar-toggle-etags "-D")
|
|
568 :style toggle
|
|
569 :selected (not (member "-D" speedbar-fetch-etags-arguments))]
|
|
570 ["Use indentation"
|
|
571 (speedbar-toggle-etags "-S")
|
|
572 :style toggle
|
|
573 :selected (not (member "-S" speedbar-fetch-etags-arguments))]))
|
|
574
|
|
575 (add-submenu '("Tools") speedbar-menu nil)
|
|
576
|
100
|
577 )
|
|
578 ;; bind mouse bindings so we can manipulate the items on each line
|
|
579 (define-key speedbar-key-map [mouse-2] 'speedbar-click)
|
167
|
580 ;; This is the power click for poping up new frames
|
|
581 (define-key speedbar-key-map [S-mouse-2] 'speedbar-power-click)
|
|
582 ;; This adds a small unecessary visual effect
|
|
583 ;;(define-key speedbar-key-map [down-mouse-2] 'speedbar-quick-mouse)
|
|
584 (define-key speedbar-key-map [M-mouse-2] 'speedbar-mouse-item-info)
|
100
|
585
|
|
586 ;; disable all menus - we don't have a lot of space to play with
|
167
|
587 ;; in such a skinny frame. This will cleverly find and nuke some
|
|
588 ;; user-defined menus as well if they are there. Too bad it
|
|
589 ;; rely's on the structure of a keymap to work.
|
|
590 (let ((k (lookup-key global-map [menu-bar])))
|
|
591 (while k
|
|
592 (if (and (listp (car k)) (listp (cdr (car k))))
|
|
593 (define-key speedbar-key-map (vector 'menu-bar (car (car k)))
|
|
594 'undefined))
|
|
595 (setq k (cdr k))))
|
100
|
596
|
|
597 ;; This lets the user scroll as if we had a scrollbar... well maybe not
|
|
598 (define-key speedbar-key-map [mode-line mouse-2] 'speedbar-mouse-hscroll)
|
|
599 ))
|
|
600
|
167
|
601 (defvar speedbar-easymenu-definition-base
|
|
602 '("Speedbar"
|
|
603 ["Update" speedbar-refresh t]
|
|
604 ["Auto Update" speedbar-toggle-updates
|
|
605 :style toggle :selected speedbar-update-flag]
|
|
606 )
|
|
607 "Base part of the speedbar menu.")
|
|
608
|
|
609 (defvar speedbar-easymenu-definition-special
|
|
610 '(["Edit Item On Line" speedbar-edit-line t]
|
|
611 ["Show All Files" speedbar-toggle-show-all-files
|
|
612 :style toggle :selected speedbar-show-unknown-files]
|
|
613 ["Expand Item" speedbar-expand-line
|
|
614 (save-excursion (beginning-of-line)
|
|
615 (looking-at "[0-9]+: *.\\+. "))]
|
|
616 ["Contract Item" speedbar-contract-line
|
|
617 (save-excursion (beginning-of-line)
|
|
618 (looking-at "[0-9]+: *.-. "))]
|
|
619 "----"
|
|
620 ["Item Information" speedbar-item-info t]
|
|
621 ["Load Lisp File" speedbar-item-load
|
|
622 (save-excursion
|
|
623 (beginning-of-line)
|
|
624 (looking-at "[0-9]+: *\\[[+-]\\] .+\\(\\.el\\)\\( \\*\\)?$"))]
|
|
625 ["Byte Compile File" speedbar-item-byte-compile
|
|
626 (save-excursion
|
|
627 (beginning-of-line)
|
|
628 (looking-at "[0-9]+: *\\[[+-]\\] .+\\(\\.el\\)\\( \\*\\)?$"))]
|
|
629 ["Copy Item" speedbar-item-copy
|
|
630 (save-excursion (beginning-of-line) (looking-at "[0-9]+: *\\["))]
|
|
631 ["Rename Item" speedbar-item-rename
|
|
632 (save-excursion (beginning-of-line) (looking-at "[0-9]+: *[[<]"))]
|
|
633 ["Delete Item" speedbar-item-delete
|
|
634 (save-excursion (beginning-of-line) (looking-at "[0-9]+: *[[<]"))])
|
|
635 "Additional menu items while in file-mode.")
|
|
636
|
|
637 (defvar speedbar-easymenu-definition-trailer
|
|
638 '("----"
|
|
639 ["Close" speedbar-close-frame t])
|
|
640 "Menu items appearing at the end of the speedbar menu.")
|
100
|
641
|
|
642 (defvar speedbar-buffer nil
|
|
643 "The buffer displaying the speedbar.")
|
|
644 (defvar speedbar-frame nil
|
|
645 "The frame displaying speedbar.")
|
167
|
646 (defvar speedbar-cached-frame nil
|
|
647 "The frame that was last created, then removed from the display.")
|
|
648 (defvar speedbar-full-text-cache nil
|
|
649 "The last open directory is saved in it's entirety for ultra-fast switching.")
|
100
|
650 (defvar speedbar-timer nil
|
|
651 "The speedbar timer used for updating the buffer.")
|
|
652 (defvar speedbar-attached-frame nil
|
167
|
653 "The frame which started speedbar mode.
|
|
654 This is the frame from which all data displayed in the speedbar is
|
|
655 gathered, and in which files and such are displayed.")
|
100
|
656
|
|
657 (defvar speedbar-last-selected-file nil
|
167
|
658 "The last file which was selected in speedbar buffer.")
|
100
|
659
|
|
660 (defvar speedbar-shown-directories nil
|
167
|
661 "Maintain list of directories simultaneously open in the current speedbar.")
|
|
662
|
|
663 (defvar speedbar-directory-contents-alist nil
|
|
664 "An association list of directories and their contents.
|
|
665 Each sublist was returned by `speedbar-file-lists'. This list is
|
|
666 maintained to speed up the refresh rate when switching between
|
|
667 directories.")
|
|
668
|
|
669 (defvar speedbar-power-click nil
|
|
670 "Never set this by hand. Value is t when S-mouse activity occurs.")
|
100
|
671
|
|
672
|
|
673 ;;; Mode definitions/ user commands
|
167
|
674 ;;
|
177
|
675 ;;;###autoload
|
167
|
676 (defalias 'speedbar 'speedbar-frame-mode)
|
177
|
677 ;;;###autoload
|
100
|
678 (defun speedbar-frame-mode (&optional arg)
|
167
|
679 "Enable or disable speedbar. Positive ARG means turn on, negative turn off.
|
|
680 nil means toggle. Once the speedbar frame is activated, a buffer in
|
|
681 `speedbar-mode' will be displayed. Currently, only one speedbar is
|
|
682 supported at a time."
|
100
|
683 (interactive "P")
|
|
684 (if (not window-system)
|
167
|
685 (error "Speedbar is not useful outside of a windowing environment"))
|
100
|
686 ;; toggle frame on and off.
|
|
687 (if (not arg) (if speedbar-frame (setq arg -1) (setq arg 1)))
|
|
688 ;; turn the frame off on neg number
|
|
689 (if (and (numberp arg) (< arg 0))
|
|
690 (progn
|
|
691 (run-hooks 'speedbar-before-delete-hook)
|
|
692 (if (and speedbar-frame (frame-live-p speedbar-frame))
|
167
|
693 (if speedbar-xemacsp
|
|
694 (delete-frame speedbar-frame)
|
|
695 (setq speedbar-cached-frame speedbar-frame)
|
|
696 (modify-frame-parameters speedbar-frame '((visibility . nil)))))
|
100
|
697 (setq speedbar-frame nil)
|
167
|
698 (speedbar-set-timer nil)
|
|
699 ;; Used to delete the buffer. This has the annoying affect of
|
|
700 ;; preventing whatever took it's place from ever appearing
|
|
701 ;; as the default after a C-x b was typed
|
|
702 ;;(if (bufferp speedbar-buffer)
|
|
703 ;; (kill-buffer speedbar-buffer))
|
|
704 )
|
100
|
705 ;; Set this as our currently attached frame
|
|
706 (setq speedbar-attached-frame (selected-frame))
|
|
707 ;; Get the frame to work in
|
167
|
708 (if (frame-live-p speedbar-cached-frame)
|
|
709 (progn
|
|
710 (setq speedbar-frame speedbar-cached-frame)
|
|
711 (modify-frame-parameters speedbar-frame '((visibility . t)))
|
|
712 ;; Get the buffer to play with
|
|
713 (speedbar-mode)
|
|
714 (select-frame speedbar-frame)
|
|
715 (if (not (eq (current-buffer) speedbar-buffer))
|
|
716 (switch-to-buffer speedbar-buffer))
|
|
717 (set-window-dedicated-p (selected-window) t)
|
|
718 (raise-frame speedbar-frame)
|
|
719 (speedbar-set-timer speedbar-update-speed)
|
|
720 )
|
|
721 (if (frame-live-p speedbar-frame)
|
|
722 (raise-frame speedbar-frame)
|
|
723 (let ((params (cons (cons 'height (frame-height))
|
|
724 speedbar-frame-parameters)))
|
|
725 (setq speedbar-frame
|
177
|
726 (if (or speedbar-xemacsp
|
|
727 (< emacs-major-version 20)) ;a bug is fixed in v20 & later
|
167
|
728 (make-frame params)
|
|
729 (let ((x-pointer-shape x-pointer-top-left-arrow)
|
|
730 (x-sensitive-text-pointer-shape x-pointer-hand2))
|
|
731 (make-frame params)))))
|
|
732 ;; reset the selection variable
|
|
733 (setq speedbar-last-selected-file nil)
|
|
734 ;; Put the buffer into the frame
|
|
735 (save-window-excursion
|
|
736 ;; Get the buffer to play with
|
|
737 (speedbar-mode)
|
|
738 (select-frame speedbar-frame)
|
|
739 (switch-to-buffer speedbar-buffer)
|
|
740 (set-window-dedicated-p (selected-window) t)
|
|
741 ;; Turn off toolbar and menubar under XEmacs
|
|
742 (if speedbar-xemacsp
|
|
743 (progn
|
|
744 (set-specifier default-toolbar-visible-p
|
|
745 (cons (selected-frame) nil))
|
|
746 ;; These lines make the menu-bar go away nicely, but
|
|
747 ;; they also cause xemacs much heartache.
|
|
748 ;;(set-specifier menubar-visible-p (cons (selected-frame) nil))
|
|
749 ;;(make-local-variable 'current-menubar)
|
|
750 ;;(setq current-menubar speedbar-menu)
|
|
751 ;;(add-submenu nil speedbar-menu nil)
|
|
752 )))
|
|
753 (speedbar-set-timer speedbar-update-speed)
|
|
754 ))))
|
100
|
755
|
|
756 (defun speedbar-close-frame ()
|
167
|
757 "Turn off a currently active speedbar."
|
100
|
758 (interactive)
|
167
|
759 (speedbar-frame-mode -1)
|
|
760 (select-frame speedbar-attached-frame)
|
|
761 (other-frame 0))
|
|
762
|
|
763 (defun speedbar-frame-width ()
|
|
764 "Return the width of the speedbar frame in characters.
|
|
765 nil if it doesn't exist."
|
177
|
766 (and speedbar-frame
|
|
767 (frame-live-p speedbar-frame)
|
|
768 (cdr (assoc 'width (frame-parameters speedbar-frame)))))
|
100
|
769
|
|
770 (defun speedbar-mode ()
|
167
|
771 "Major mode for managing a display of directories and tags.
|
|
772 \\<speedbar-key-map>
|
|
773 The first line represents the default path of the speedbar frame.
|
|
774 Each directory segment is a button which jumps speedbar's default
|
|
775 directory to that path. Buttons are activated by clicking `\\[speedbar-click]'.
|
|
776 In some situations using `\\[speedbar-power-click]' is a `power click' which will
|
|
777 rescan cached items, or pop up new frames.
|
100
|
778
|
|
779 Each line starting with <+> represents a directory. Click on the <+>
|
|
780 to insert the directory listing into the current tree. Click on the
|
|
781 <-> to retract that list. Click on the directory name to go to that
|
|
782 directory as the default.
|
|
783
|
|
784 Each line starting with [+] is a file. If the variable
|
|
785 `speedbar-show-unknown-files' is t, the lines starting with [?] are
|
|
786 files which don't have imenu support, but are not expressly ignored.
|
|
787 Files are completely ignored if they match `speedbar-file-unshown-regexp'
|
|
788 which is generated from `completion-ignored-extensions'.
|
|
789
|
167
|
790 Files with a `*' character after their name are files checked out of a
|
|
791 version control system. (currently only RCS is supported.) New
|
|
792 version control systems can be added by examining the documentation
|
|
793 for `speedbar-this-file-in-vc' and `speedbar-vc-check-dir-p'
|
|
794
|
100
|
795 Click on the [+] to display a list of tags from that file. Click on
|
|
796 the [-] to retract the list. Click on the file name to edit the file
|
|
797 in the attached frame.
|
|
798
|
|
799 If you open tags, you might find a node starting with {+}, which is a
|
167
|
800 category of tags. Click the {+} to expand the category. Jump-able
|
100
|
801 tags start with >. Click the name of the tag to go to that position
|
|
802 in the selected file.
|
|
803
|
167
|
804 \\{speedbar-key-map}"
|
|
805 ;; NOT interactive
|
|
806 (save-excursion
|
|
807 (setq speedbar-buffer (set-buffer (get-buffer-create " SPEEDBAR")))
|
|
808 (kill-all-local-variables)
|
|
809 (setq major-mode 'speedbar-mode)
|
|
810 (setq mode-name "Speedbar")
|
|
811 (use-local-map speedbar-key-map)
|
|
812 (set-syntax-table speedbar-syntax-table)
|
|
813 (setq font-lock-keywords nil) ;; no font-locking please
|
|
814 (setq truncate-lines t)
|
|
815 (make-local-variable 'frame-title-format)
|
|
816 (setq frame-title-format "Speedbar")
|
|
817 ;; Set this up special just for the speedbar buffer
|
|
818 (if (null default-minibuffer-frame)
|
|
819 (progn
|
|
820 (make-local-variable 'default-minibuffer-frame)
|
|
821 (setq default-minibuffer-frame speedbar-attached-frame)))
|
|
822 (make-local-variable 'temp-buffer-show-function)
|
|
823 (setq temp-buffer-show-function 'speedbar-temp-buffer-show-function)
|
|
824 (setq kill-buffer-hook '(lambda () (let ((skilling (boundp 'skilling)))
|
|
825 (if skilling
|
|
826 nil
|
|
827 (if (eq (current-buffer)
|
|
828 speedbar-buffer)
|
|
829 (speedbar-frame-mode -1))))))
|
|
830 (speedbar-set-mode-line-format)
|
|
831 (if (not speedbar-xemacsp)
|
|
832 (setq auto-show-mode nil)) ;no auto-show for Emacs
|
|
833 (run-hooks 'speedbar-mode-hook))
|
100
|
834 (speedbar-update-contents)
|
167
|
835 speedbar-buffer)
|
|
836
|
|
837 (defun speedbar-set-mode-line-format ()
|
|
838 "Set the format of the mode line based on the current speedbar environment.
|
|
839 This gives visual indications of what is up. It EXPECTS the speedbar
|
|
840 frame and window to be the currently active frame and window."
|
|
841 (if (frame-live-p speedbar-frame)
|
|
842 (save-excursion
|
|
843 (set-buffer speedbar-buffer)
|
|
844 (let* ((w (or (speedbar-frame-width) 20))
|
|
845 (p1 "<<")
|
|
846 (p5 ">>")
|
|
847 (p3 (if speedbar-update-flag "SPEEDBAR" "SLOWBAR"))
|
|
848 (blank (- w (length p1) (length p3) (length p5)
|
|
849 (if line-number-mode 4 0)))
|
|
850 (p2 (if (> blank 0)
|
|
851 (make-string (/ blank 2) ? )
|
|
852 ""))
|
|
853 (p4 (if (> blank 0)
|
|
854 (make-string (+ (/ blank 2) (% blank 2)) ? )
|
|
855 ""))
|
|
856 (tf
|
|
857 (if line-number-mode
|
|
858 (list (concat p1 p2 p3) '(line-number-mode " %3l")
|
|
859 (concat p4 p5))
|
|
860 (list (concat p1 p2 p3 p4 p5)))))
|
|
861 (if (not (equal mode-line-format tf))
|
|
862 (progn
|
|
863 (setq mode-line-format tf)
|
|
864 (force-mode-line-update)))))))
|
100
|
865
|
167
|
866 (defun speedbar-temp-buffer-show-function (buffer)
|
|
867 "Placed in the variable `temp-buffer-show-function' in `speedbar-mode'.
|
|
868 If a user requests help using \\[help-command] <Key> the temp BUFFER will be
|
|
869 redirected into a window on the attached frame."
|
|
870 (if speedbar-attached-frame (select-frame speedbar-attached-frame))
|
|
871 (pop-to-buffer buffer nil)
|
|
872 (other-window -1)
|
|
873 (run-hooks 'temp-buffer-show-hook))
|
|
874
|
|
875 (defun speedbar-reconfigure-menubar ()
|
|
876 "Reconfigure the menu-bar in a speedbar frame.
|
|
877 Different menu items are displayed depending on the current display mode
|
|
878 and the existence of packages."
|
|
879 (let ((km (make-sparse-keymap))
|
|
880 (cf (selected-frame))
|
|
881 (md (append speedbar-easymenu-definition-base
|
|
882 (if speedbar-shown-directories
|
|
883 ;; file display mode version
|
|
884 speedbar-easymenu-definition-special
|
|
885 (save-excursion
|
|
886 (select-frame speedbar-attached-frame)
|
|
887 (if (local-variable-p
|
|
888 'speedbar-easymenu-definition-special)
|
|
889 ;; If bound locally, we can use it
|
|
890 speedbar-easymenu-definition-special)))
|
|
891 ;; The trailer
|
|
892 speedbar-easymenu-definition-trailer)))
|
|
893 (easy-menu-define speedbar-menu-map speedbar-key-map "Speedbar menu" md)
|
177
|
894 ;; (if speedbar-xemacsp (set-buffer-menubar (list km)))
|
|
895 ))
|
167
|
896
|
|
897
|
|
898 ;;; User Input stuff
|
|
899 ;;
|
100
|
900 (defun speedbar-mouse-hscroll (e)
|
167
|
901 "Read a mouse event E from the mode line, and horizontally scroll.
|
|
902 If the mouse is being clicked on the far left, or far right of the
|
|
903 mode-line. This is only useful for non-XEmacs"
|
100
|
904 (interactive "e")
|
|
905 (let* ((xp (car (nth 2 (car (cdr e)))))
|
|
906 (cpw (/ (frame-pixel-width)
|
|
907 (frame-width)))
|
|
908 (oc (1+ (/ xp cpw)))
|
|
909 )
|
|
910 (cond ((< oc 3)
|
|
911 (scroll-left 2))
|
|
912 ((> oc (- (window-width) 3))
|
|
913 (scroll-right 2))
|
|
914 (t (message "Click on the edge of the modeline to scroll left/right")))
|
|
915 ;;(message "X: Pixel %d Char Pixels %d On char %d" xp cpw oc)
|
|
916 ))
|
|
917
|
177
|
918 ;;;###autoload
|
167
|
919 (defun speedbar-get-focus ()
|
|
920 "Change frame focus to or from the speedbar frame.
|
|
921 If the selected frame is not speedbar, then speedbar frame is
|
|
922 selected. If the speedbar frame is active, then select the attached frame."
|
|
923 (interactive)
|
|
924 (if (eq (selected-frame) speedbar-frame)
|
|
925 (if (frame-live-p speedbar-attached-frame)
|
|
926 (select-frame speedbar-attached-frame))
|
|
927 ;; make sure we have a frame
|
|
928 (if (not (frame-live-p speedbar-frame)) (speedbar-frame-mode 1))
|
|
929 ;; go there
|
|
930 (select-frame speedbar-frame))
|
|
931 (other-frame 0))
|
|
932
|
|
933 (defun speedbar-next (arg)
|
|
934 "Move to the next ARGth line in a speedbar buffer."
|
|
935 (interactive "p")
|
|
936 (forward-line (or arg 1))
|
|
937 (speedbar-item-info)
|
|
938 (speedbar-position-cursor-on-line))
|
|
939
|
|
940 (defun speedbar-prev (arg)
|
|
941 "Move to the previous ARGth line in a speedbar buffer."
|
|
942 (interactive "p")
|
|
943 (speedbar-next (if arg (- arg) -1)))
|
|
944
|
|
945 (defun speedbar-scroll-up (&optional arg)
|
|
946 "Page down one screen-full of the speedbar, or ARG lines."
|
|
947 (interactive "P")
|
|
948 (scroll-up arg)
|
|
949 (speedbar-position-cursor-on-line))
|
|
950
|
|
951 (defun speedbar-scroll-down (&optional arg)
|
|
952 "Page up one screen-full of the speedbar, or ARG lines."
|
|
953 (interactive "P")
|
|
954 (scroll-down arg)
|
|
955 (speedbar-position-cursor-on-line))
|
|
956
|
|
957 (defun speedbar-up-directory ()
|
|
958 "Keyboard accelerator for moving the default directory up one.
|
|
959 Assumes that the current buffer is the speedbar buffer"
|
|
960 (interactive)
|
|
961 (setq default-directory (expand-file-name (concat default-directory "../")))
|
|
962 (speedbar-update-contents))
|
100
|
963
|
167
|
964 ;;; Speedbar file activity
|
|
965 ;;
|
|
966 (defun speedbar-refresh ()
|
|
967 "Refresh the current speedbar display, disposing of any cached data."
|
|
968 (interactive)
|
|
969 (let ((dl speedbar-shown-directories))
|
|
970 (while dl
|
|
971 (adelete 'speedbar-directory-contents-alist (car dl))
|
|
972 (setq dl (cdr dl))))
|
|
973 (if (<= 1 speedbar-verbosity-level) (message "Refreshing speedbar..."))
|
|
974 (speedbar-update-contents)
|
|
975 (speedbar-stealthy-updates)
|
|
976 ;; Reset the timer in case it got really hosed for some reason...
|
|
977 (speedbar-set-timer speedbar-update-speed)
|
|
978 (if (<= 1 speedbar-verbosity-level) (message "Refreshing speedbar...done")))
|
|
979
|
|
980 (defun speedbar-item-load ()
|
|
981 "Byte compile the item under the cursor or mouse if it is a lisp file."
|
|
982 (interactive)
|
|
983 (let ((f (speedbar-line-file)))
|
|
984 (if (and (file-exists-p f) (string-match "\\.el$" f))
|
|
985 (if (and (file-exists-p (concat f "c"))
|
|
986 (y-or-n-p (format "Load %sc? " f)))
|
|
987 ;; If the compiled version exists, load that instead...
|
|
988 (load-file (concat f "c"))
|
|
989 (load-file f))
|
|
990 (error "Not a loadable file..."))))
|
|
991
|
|
992 (defun speedbar-item-byte-compile ()
|
|
993 "Byte compile the item under the cursor or mouse if it is a lisp file."
|
|
994 (interactive)
|
|
995 (let ((f (speedbar-line-file))
|
|
996 (sf (selected-frame)))
|
|
997 (if (and (file-exists-p f) (string-match "\\.el$" f))
|
|
998 (progn
|
|
999 (select-frame speedbar-attached-frame)
|
|
1000 (byte-compile-file f nil)
|
|
1001 (select-frame sf)))
|
|
1002 ))
|
|
1003
|
|
1004 (defun speedbar-mouse-item-info (event)
|
|
1005 "Provide information about what the user clicked on.
|
|
1006 This should be bound to a mouse EVENT."
|
|
1007 (interactive "e")
|
|
1008 (mouse-set-point event)
|
|
1009 (speedbar-item-info))
|
|
1010
|
|
1011 (defun speedbar-item-info ()
|
|
1012 "Display info in the mini-buffer about the button the mouse is over."
|
|
1013 (interactive)
|
|
1014 (if (not speedbar-shown-directories)
|
|
1015 nil
|
|
1016 (let* ((item (speedbar-line-file))
|
|
1017 (attr (if item (file-attributes item) nil)))
|
|
1018 (if item (message "%s %d %s" (nth 8 attr) (nth 7 attr) item)
|
|
1019 (save-excursion
|
|
1020 (beginning-of-line)
|
|
1021 (looking-at "\\([0-9]+\\):")
|
|
1022 (setq item (speedbar-line-path (string-to-int (match-string 1))))
|
|
1023 (if (re-search-forward "> \\([^ ]+\\)$"
|
|
1024 (save-excursion(end-of-line)(point)) t)
|
|
1025 (progn
|
|
1026 (setq attr (get-text-property (match-beginning 1)
|
|
1027 'speedbar-token))
|
|
1028 (message "Tag %s in %s at position %s"
|
|
1029 (match-string 1) item (if attr attr 0)))
|
|
1030 (message "No special info for this line.")))
|
|
1031 ))))
|
|
1032
|
|
1033 (defun speedbar-item-copy ()
|
|
1034 "Copy the item under the cursor.
|
|
1035 Files can be copied to new names or places."
|
|
1036 (interactive)
|
|
1037 (let ((f (speedbar-line-file)))
|
|
1038 (if (not f) (error "Not a file."))
|
|
1039 (if (file-directory-p f)
|
|
1040 (error "Cannot copy directory.")
|
|
1041 (let* ((rt (read-file-name (format "Copy %s to: "
|
|
1042 (file-name-nondirectory f))
|
|
1043 (file-name-directory f)))
|
|
1044 (refresh (member (expand-file-name (file-name-directory rt))
|
|
1045 speedbar-shown-directories)))
|
|
1046 ;; Create the right file name part
|
|
1047 (if (file-directory-p rt)
|
|
1048 (setq rt
|
|
1049 (concat (expand-file-name rt)
|
|
1050 (if (string-match "/$" rt) "" "/")
|
|
1051 (file-name-nondirectory f))))
|
|
1052 (if (or (not (file-exists-p rt))
|
|
1053 (y-or-n-p (format "Overwrite %s with %s? " rt f)))
|
|
1054 (progn
|
|
1055 (copy-file f rt t t)
|
|
1056 ;; refresh display if the new place is currently displayed.
|
|
1057 (if refresh
|
|
1058 (progn
|
|
1059 (speedbar-refresh)
|
|
1060 (if (not (speedbar-goto-this-file rt))
|
|
1061 (speedbar-goto-this-file f))))
|
|
1062 ))))))
|
|
1063
|
|
1064 (defun speedbar-item-rename ()
|
|
1065 "Rename the item under the cursor or mouse.
|
|
1066 Files can be renamed to new names or moved to new directories."
|
|
1067 (interactive)
|
|
1068 (let ((f (speedbar-line-file)))
|
|
1069 (if f
|
|
1070 (let* ((rt (read-file-name (format "Rename %s to: "
|
|
1071 (file-name-nondirectory f))
|
|
1072 (file-name-directory f)))
|
|
1073 (refresh (member (expand-file-name (file-name-directory rt))
|
|
1074 speedbar-shown-directories)))
|
|
1075 ;; Create the right file name part
|
|
1076 (if (file-directory-p rt)
|
|
1077 (setq rt
|
|
1078 (concat (expand-file-name rt)
|
|
1079 (if (string-match "/$" rt) "" "/")
|
|
1080 (file-name-nondirectory f))))
|
|
1081 (if (or (not (file-exists-p rt))
|
|
1082 (y-or-n-p (format "Overwrite %s with %s? " rt f)))
|
|
1083 (progn
|
|
1084 (rename-file f rt t)
|
|
1085 ;; refresh display if the new place is currently displayed.
|
|
1086 (if refresh
|
|
1087 (progn
|
|
1088 (speedbar-refresh)
|
|
1089 (speedbar-goto-this-file rt)
|
|
1090 )))))
|
|
1091 (error "Not a file."))))
|
|
1092
|
|
1093 (defun speedbar-item-delete ()
|
|
1094 "Delete the item under the cursor. Files are removed from disk."
|
|
1095 (interactive)
|
|
1096 (let ((f (speedbar-line-file)))
|
|
1097 (if (not f) (error "Not a file."))
|
|
1098 (if (y-or-n-p (format "Delete %s? " f))
|
|
1099 (progn
|
|
1100 (if (file-directory-p f)
|
|
1101 (delete-directory f)
|
|
1102 (delete-file f))
|
|
1103 (message "Okie dokie..")
|
|
1104 (let ((p (point)))
|
|
1105 (speedbar-refresh)
|
|
1106 (goto-char p))
|
|
1107 ))
|
|
1108 ))
|
|
1109
|
|
1110 (defun speedbar-enable-update ()
|
|
1111 "Enable automatic updating in speedbar via timers."
|
|
1112 (interactive)
|
|
1113 (setq speedbar-update-flag t)
|
|
1114 (speedbar-set-mode-line-format)
|
|
1115 (speedbar-set-timer speedbar-update-speed))
|
|
1116
|
|
1117 (defun speedbar-disable-update ()
|
|
1118 "Disable automatic updating and stop consuming resources."
|
|
1119 (interactive)
|
|
1120 (setq speedbar-update-flag nil)
|
|
1121 (speedbar-set-mode-line-format)
|
|
1122 (speedbar-set-timer nil))
|
|
1123
|
|
1124 (defun speedbar-toggle-updates ()
|
|
1125 "Toggle automatic update for the speedbar frame."
|
|
1126 (interactive)
|
|
1127 (if speedbar-update-flag
|
|
1128 (speedbar-disable-update)
|
|
1129 (speedbar-enable-update)))
|
|
1130
|
|
1131 (defun speedbar-toggle-show-all-files ()
|
|
1132 "Toggle display of files speedbar can not tag."
|
|
1133 (interactive)
|
|
1134 (setq speedbar-show-unknown-files (not speedbar-show-unknown-files))
|
|
1135 (speedbar-refresh))
|
|
1136
|
100
|
1137 ;;; Utility functions
|
167
|
1138 ;;
|
100
|
1139 (defun speedbar-set-timer (timeout)
|
167
|
1140 "Unset an old timer (if there is one) and activate a new timer with TIMEOUT.
|
|
1141 TIMEOUT is the number of seconds until the speedbar timer is called
|
|
1142 again."
|
|
1143 (cond
|
203
|
1144 ;; XEmacs
|
100
|
1145 (speedbar-xemacsp
|
167
|
1146 (if speedbar-timer
|
100
|
1147 (progn (delete-itimer speedbar-timer)
|
|
1148 (setq speedbar-timer nil)))
|
|
1149 (if timeout
|
|
1150 (setq speedbar-timer (start-itimer "speedbar"
|
|
1151 'speedbar-timer-fn
|
|
1152 timeout
|
|
1153 nil))))
|
167
|
1154 ;; Post 19.31 Emacs
|
|
1155 ((fboundp 'run-with-idle-timer)
|
|
1156 (if speedbar-timer
|
100
|
1157 (progn (cancel-timer speedbar-timer)
|
|
1158 (setq speedbar-timer nil)))
|
|
1159 (if timeout
|
167
|
1160 (setq speedbar-timer
|
100
|
1161 (run-with-idle-timer timeout nil 'speedbar-timer-fn))))
|
167
|
1162 ;; Older or other Emacsen with no timers. Set up so that it's
|
|
1163 ;; obvious this emacs can't handle the updates
|
|
1164 (t
|
|
1165 (setq speedbar-update-flag nil)))
|
|
1166 ;; change this if it changed for some reason
|
|
1167 (speedbar-set-mode-line-format))
|
100
|
1168
|
|
1169 (defmacro speedbar-with-writable (&rest forms)
|
167
|
1170 "Allow the buffer to be writable and evaluate FORMS.
|
|
1171 Turn read only back on when done."
|
100
|
1172 (list 'let '((speedbar-with-writable-buff (current-buffer)))
|
|
1173 '(toggle-read-only -1)
|
|
1174 (cons 'progn forms)
|
|
1175 '(save-excursion (set-buffer speedbar-with-writable-buff)
|
|
1176 (toggle-read-only 1))))
|
|
1177 (put 'speedbar-with-writable 'lisp-indent-function 0)
|
|
1178
|
167
|
1179 (defun speedbar-select-window (buffer)
|
|
1180 "Select a window in which BUFFER is show.
|
|
1181 If it is not shown, force it to appear in the default window."
|
|
1182 (let ((win (get-buffer-window buffer speedbar-attached-frame)))
|
|
1183 (if win
|
|
1184 (select-window win)
|
|
1185 (show-buffer (selected-window) buffer))))
|
|
1186
|
|
1187 (defmacro speedbar-with-attached-buffer (&rest forms)
|
|
1188 "Execute FORMS in the attached frame's special buffer.
|
|
1189 Optionally select that frame if necessary."
|
|
1190 ;; Reset the timer with a new timeout when cliking a file
|
|
1191 ;; in case the user was navigating directories, we can cancel
|
|
1192 ;; that other timer.
|
|
1193 (list
|
|
1194 'progn
|
|
1195 '(speedbar-set-timer speedbar-update-speed)
|
|
1196 (list
|
|
1197 'let '((cf (selected-frame)))
|
|
1198 '(select-frame speedbar-attached-frame)
|
|
1199 '(speedbar-select-window speedbar-desired-buffer)
|
|
1200 (cons 'progn forms)
|
|
1201 '(select-frame cf)
|
|
1202 '(speedbar-maybee-jump-to-attached-frame)
|
|
1203 )))
|
|
1204
|
|
1205 (defun speedbar-insert-button (text face mouse function
|
|
1206 &optional token prevline)
|
|
1207 "Insert TEXT as the next logical speedbar button.
|
|
1208 FACE is the face to put on the button, MOUSE is the highlight face to use.
|
|
1209 When the user clicks on TEXT, FUNCTION is called with the TOKEN parameter.
|
|
1210 This function assumes that the current buffer is the speedbar buffer.
|
|
1211 If PREVLINE, then put this button on the previous line.
|
|
1212
|
|
1213 This is a convenience function for special mode that create their own
|
|
1214 specialized speedbar displays."
|
|
1215 (goto-char (point-max))
|
|
1216 (if (/= (current-column) 0) (insert "\n"))
|
|
1217 (if prevline (progn (delete-char -1) (insert " "))) ;back up if desired...
|
|
1218 (let ((start (point)))
|
|
1219 (insert text)
|
|
1220 (speedbar-make-button start (point) face mouse function token))
|
|
1221 (let ((start (point)))
|
|
1222 (insert "\n")
|
|
1223 (put-text-property start (point) 'face nil)
|
|
1224 (put-text-property start (point) 'mouse-face nil)))
|
|
1225
|
100
|
1226 (defun speedbar-make-button (start end face mouse function &optional token)
|
167
|
1227 "Create a button from START to END, with FACE as the display face.
|
|
1228 MOUSE is the mouse face. When this button is clicked on FUNCTION
|
|
1229 will be run with the TOKEN parameter (any lisp object)"
|
100
|
1230 (put-text-property start end 'face face)
|
|
1231 (put-text-property start end 'mouse-face mouse)
|
|
1232 (put-text-property start end 'invisible nil)
|
|
1233 (if function (put-text-property start end 'speedbar-function function))
|
|
1234 (if token (put-text-property start end 'speedbar-token token))
|
|
1235 )
|
167
|
1236
|
|
1237 ;;; File button management
|
|
1238 ;;
|
100
|
1239 (defun speedbar-file-lists (directory)
|
167
|
1240 "Create file lists for DIRECTORY.
|
|
1241 The car is the list of directories, the cdr is list of files not
|
|
1242 matching ignored headers. Cache any directory files found in
|
|
1243 `speedbar-directory-contents-alist' and use that cache before scanning
|
|
1244 the file-system"
|
|
1245 (setq directory (expand-file-name directory))
|
|
1246 ;; If in powerclick mode, then the directory we are getting
|
|
1247 ;; should be rescanned.
|
|
1248 (if speedbar-power-click
|
|
1249 (adelete 'speedbar-directory-contents-alist directory))
|
|
1250 ;; find the directory, either in the cache, or build it.
|
|
1251 (or (cdr-safe (assoc directory speedbar-directory-contents-alist))
|
|
1252 (let ((default-directory directory)
|
|
1253 (dir (directory-files directory nil))
|
|
1254 (dirs nil)
|
|
1255 (files nil))
|
|
1256 (while dir
|
|
1257 (if (not (string-match speedbar-file-unshown-regexp (car dir)))
|
|
1258 (if (file-directory-p (car dir))
|
|
1259 (setq dirs (cons (car dir) dirs))
|
|
1260 (setq files (cons (car dir) files))))
|
|
1261 (setq dir (cdr dir)))
|
|
1262 (let ((nl (cons (nreverse dirs) (list (nreverse files)))))
|
|
1263 (aput 'speedbar-directory-contents-alist directory nl)
|
|
1264 nl))
|
|
1265 ))
|
100
|
1266
|
|
1267 (defun speedbar-directory-buttons (directory index)
|
167
|
1268 "Insert a single button group at point for DIRECTORY.
|
|
1269 Each directory path part is a different button. If part of the path
|
|
1270 matches the user directory ~, then it is replaced with a ~.
|
|
1271 INDEX is not used, but is required by the caller."
|
100
|
1272 (let* ((tilde (expand-file-name "~"))
|
|
1273 (dd (expand-file-name directory))
|
|
1274 (junk (string-match (regexp-quote tilde) dd))
|
|
1275 (displayme (if junk
|
|
1276 (concat "~" (substring dd (match-end 0)))
|
|
1277 dd))
|
|
1278 (p (point)))
|
|
1279 (if (string-match "^~/?$" displayme) (setq displayme (concat tilde "/")))
|
|
1280 (insert displayme)
|
|
1281 (save-excursion
|
|
1282 (goto-char p)
|
|
1283 (while (re-search-forward "\\([^/]+\\)/" nil t)
|
|
1284 (speedbar-make-button (match-beginning 1) (match-end 1)
|
|
1285 'speedbar-directory-face
|
|
1286 'speedbar-highlight-face
|
|
1287 'speedbar-directory-buttons-follow
|
|
1288 (if (= (match-beginning 1) p)
|
|
1289 (expand-file-name "~/") ;the tilde
|
|
1290 (buffer-substring-no-properties
|
167
|
1291 p (match-end 0)))))
|
|
1292 ;; Nuke the beginning of the directory if it's too long...
|
|
1293 (cond ((eq speedbar-directory-button-trim-method 'span)
|
|
1294 (beginning-of-line)
|
|
1295 (let ((ww (or (speedbar-frame-width) 20)))
|
|
1296 (move-to-column ww nil)
|
|
1297 (while (>= (current-column) ww)
|
|
1298 (re-search-backward "/" nil t)
|
|
1299 (if (<= (current-column) 2)
|
|
1300 (progn
|
|
1301 (re-search-forward "/" nil t)
|
|
1302 (if (< (current-column) 4)
|
|
1303 (re-search-forward "/" nil t))
|
|
1304 (forward-char -1)))
|
|
1305 (if (looking-at "/?$")
|
|
1306 (beginning-of-line)
|
|
1307 (insert "/...\n ")
|
|
1308 (move-to-column ww nil)))))
|
|
1309 ((eq speedbar-directory-button-trim-method 'trim)
|
|
1310 (end-of-line)
|
|
1311 (let ((ww (or (speedbar-frame-width) 20))
|
|
1312 (tl (current-column)))
|
|
1313 (if (< ww tl)
|
|
1314 (progn
|
|
1315 (move-to-column (- tl ww))
|
|
1316 (if (re-search-backward "/" nil t)
|
|
1317 (progn
|
|
1318 (delete-region (point-min) (point))
|
|
1319 (insert "$")
|
|
1320 )))))))
|
|
1321 )
|
100
|
1322 (if (string-match "^/[^/]+/$" displayme)
|
|
1323 (progn
|
|
1324 (insert " ")
|
|
1325 (let ((p (point)))
|
|
1326 (insert "<root>")
|
|
1327 (speedbar-make-button p (point)
|
|
1328 'speedbar-directory-face
|
|
1329 'speedbar-highlight-face
|
|
1330 'speedbar-directory-buttons-follow
|
|
1331 "/"))))
|
167
|
1332 (end-of-line)
|
100
|
1333 (insert-char ?\n 1 nil)))
|
|
1334
|
|
1335 (defun speedbar-make-tag-line (exp-button-type
|
|
1336 exp-button-char exp-button-function
|
|
1337 exp-button-data
|
|
1338 tag-button tag-button-function tag-button-data
|
|
1339 tag-button-face depth)
|
167
|
1340 "Create a tag line with EXP-BUTTON-TYPE for the small expansion button.
|
|
1341 This is the button that expands or contracts a node (if applicable),
|
|
1342 and EXP-BUTTON-CHAR the character in it (+, -, ?, etc). EXP-BUTTON-FUNCTION
|
|
1343 is the function to call if it's clicked on. Button types are
|
|
1344 'bracket, 'angle, 'curly, or nil. EXP-BUTTON-DATA is extra data
|
|
1345 attached to the text forming the expansion button.
|
100
|
1346
|
167
|
1347 Next, TAG-BUTTON is the text of the tag. TAG-BUTTON-FUNCTION is the
|
|
1348 function to call if clicked on, and TAG-BUTTON-DATA is the data to
|
|
1349 attach to the text field (such a tag positioning, etc).
|
|
1350 TAG-BUTTON-FACE is a face used for this type of tag.
|
100
|
1351
|
|
1352 Lastly, DEPTH shows the depth of expansion.
|
|
1353
|
167
|
1354 This function assumes that the cursor is in the speedbar window at the
|
100
|
1355 position to insert a new item, and that the new item will end with a CR"
|
|
1356 (let ((start (point))
|
|
1357 (end (progn
|
|
1358 (insert (int-to-string depth) ":")
|
|
1359 (point))))
|
|
1360 (put-text-property start end 'invisible t)
|
|
1361 )
|
|
1362 (insert-char ? depth nil)
|
|
1363 (put-text-property (- (point) depth) (point) 'invisible nil)
|
|
1364 (let* ((exp-button (cond ((eq exp-button-type 'bracket) "[%c]")
|
|
1365 ((eq exp-button-type 'angle) "<%c>")
|
|
1366 ((eq exp-button-type 'curly) "{%c}")
|
|
1367 (t ">")))
|
|
1368 (buttxt (format exp-button exp-button-char))
|
|
1369 (start (point))
|
|
1370 (end (progn (insert buttxt) (point)))
|
|
1371 (bf (if exp-button-type 'speedbar-button-face nil))
|
|
1372 (mf (if exp-button-function 'speedbar-highlight-face nil))
|
|
1373 )
|
|
1374 (speedbar-make-button start end bf mf exp-button-function exp-button-data)
|
|
1375 )
|
|
1376 (insert-char ? 1 nil)
|
|
1377 (put-text-property (1- (point)) (point) 'invisible nil)
|
|
1378 (let ((start (point))
|
|
1379 (end (progn (insert tag-button) (point))))
|
|
1380 (insert-char ?\n 1 nil)
|
|
1381 (put-text-property (1- (point)) (point) 'invisible nil)
|
167
|
1382 (speedbar-make-button start end tag-button-face
|
100
|
1383 (if tag-button-function 'speedbar-highlight-face nil)
|
|
1384 tag-button-function tag-button-data))
|
|
1385 )
|
|
1386
|
|
1387 (defun speedbar-change-expand-button-char (char)
|
167
|
1388 "Change the expansion button character to CHAR for the current line."
|
100
|
1389 (save-excursion
|
|
1390 (beginning-of-line)
|
167
|
1391 (if (re-search-forward ":\\s-*.\\([-+?]\\)" (save-excursion (end-of-line)
|
100
|
1392 (point)) t)
|
|
1393 (speedbar-with-writable
|
|
1394 (goto-char (match-beginning 1))
|
|
1395 (delete-char 1)
|
|
1396 (insert-char char 1 t)))))
|
|
1397
|
|
1398
|
|
1399 ;;; Build button lists
|
167
|
1400 ;;
|
100
|
1401 (defun speedbar-insert-files-at-point (files level)
|
167
|
1402 "Insert list of FILES starting at point, and indenting all files to LEVEL.
|
|
1403 Tag expandable items with a +, otherwise a ?. Don't highlight ? as we
|
|
1404 don't know how to manage them. The input parameter FILES is a cons
|
|
1405 cell of the form ( 'DIRLIST . 'FILELIST )"
|
100
|
1406 ;; Start inserting all the directories
|
|
1407 (let ((dirs (car files)))
|
|
1408 (while dirs
|
|
1409 (speedbar-make-tag-line 'angle ?+ 'speedbar-dired (car dirs)
|
|
1410 (car dirs) 'speedbar-dir-follow nil
|
|
1411 'speedbar-directory-face level)
|
|
1412 (setq dirs (cdr dirs))))
|
|
1413 (let ((lst (car (cdr files))))
|
|
1414 (while lst
|
|
1415 (let* ((known (string-match speedbar-file-regexp (car lst)))
|
|
1416 (expchar (if known ?+ ??))
|
|
1417 (fn (if known 'speedbar-tag-file nil)))
|
|
1418 (if (or speedbar-show-unknown-files (/= expchar ??))
|
|
1419 (speedbar-make-tag-line 'bracket expchar fn (car lst)
|
|
1420 (car lst) 'speedbar-find-file nil
|
|
1421 'speedbar-file-face level)))
|
|
1422 (setq lst (cdr lst)))))
|
|
1423
|
|
1424 (defun speedbar-default-directory-list (directory index)
|
167
|
1425 "Insert files for DIRECTORY with level INDEX at point."
|
100
|
1426 (speedbar-insert-files-at-point
|
|
1427 (speedbar-file-lists directory) index)
|
167
|
1428 (speedbar-reset-scanners)
|
|
1429 (if (= index 0)
|
|
1430 ;; If the shown files variable has extra directories, then
|
|
1431 ;; it is our responsibility to redraw them all
|
|
1432 ;; Luckilly, the nature of inserting items into this list means
|
|
1433 ;; that by reversing it, we can easilly go in the right order
|
|
1434 (let ((sf (cdr (reverse speedbar-shown-directories))))
|
|
1435 (setq speedbar-shown-directories
|
|
1436 (list (expand-file-name default-directory)))
|
|
1437 ;; exand them all as we find them
|
|
1438 (while sf
|
|
1439 (if (speedbar-goto-this-file (car sf))
|
|
1440 (progn
|
|
1441 (beginning-of-line)
|
|
1442 (if (looking-at "[0-9]+:[ ]*<")
|
|
1443 (progn
|
|
1444 (goto-char (match-end 0))
|
|
1445 (speedbar-do-function-pointer)))
|
|
1446 (setq sf (cdr sf)))))
|
|
1447 )))
|
100
|
1448
|
|
1449 (defun speedbar-insert-generic-list (level lst expand-fun find-fun)
|
167
|
1450 "At LEVEL, insert a generic multi-level alist LST.
|
|
1451 Associations with lists get {+} tags (to expand into more nodes) and
|
|
1452 those with positions just get a > as the indicator. {+} buttons will
|
|
1453 have the function EXPAND-FUN and the token is the CDR list. The token
|
|
1454 name will have the function FIND-FUN and not token."
|
100
|
1455 ;; Remove imenu rescan button
|
|
1456 (if (string= (car (car lst)) "*Rescan*")
|
|
1457 (setq lst (cdr lst)))
|
|
1458 ;; insert the parts
|
|
1459 (while lst
|
|
1460 (cond ((null (car-safe lst)) nil) ;this would be a separator
|
167
|
1461 ((or (numberp (cdr-safe (car-safe lst)))
|
|
1462 (markerp (cdr-safe (car-safe lst))))
|
100
|
1463 (speedbar-make-tag-line nil nil nil nil ;no expand button data
|
|
1464 (car (car lst)) ;button name
|
167
|
1465 find-fun ;function
|
100
|
1466 (cdr (car lst)) ;token is position
|
167
|
1467 'speedbar-tag-face
|
100
|
1468 (1+ level)))
|
|
1469 ((listp (cdr-safe (car-safe lst)))
|
|
1470 (speedbar-make-tag-line 'curly ?+ expand-fun (cdr (car lst))
|
|
1471 (car (car lst)) ;button name
|
167
|
1472 nil nil 'speedbar-tag-face
|
100
|
1473 (1+ level)))
|
|
1474 (t (message "Ooops!")))
|
|
1475 (setq lst (cdr lst))))
|
|
1476
|
|
1477 ;;; Timed functions
|
167
|
1478 ;;
|
100
|
1479 (defun speedbar-update-contents ()
|
167
|
1480 "Generically update the contents of the speedbar buffer."
|
100
|
1481 (interactive)
|
167
|
1482 ;; Set the current special buffer
|
|
1483 (setq speedbar-desired-buffer nil)
|
|
1484 (if (and speedbar-mode-specific-contents-flag
|
|
1485 speedbar-special-mode-expansion-list
|
|
1486 (local-variable-p
|
|
1487 'speedbar-special-mode-expansion-list))
|
|
1488 ;(eq (get major-mode 'mode-class 'special)))
|
|
1489 (speedbar-update-special-contents)
|
|
1490 (speedbar-update-directory-contents)))
|
|
1491
|
|
1492 (defun speedbar-update-directory-contents ()
|
|
1493 "Update the contents of the speedbar buffer based on the current directory."
|
|
1494 (let ((cbd (expand-file-name default-directory))
|
|
1495 (funclst speedbar-initial-expansion-list)
|
|
1496 (cache speedbar-full-text-cache)
|
|
1497 ;; disable stealth during update
|
|
1498 (speedbar-stealthy-function-list nil)
|
|
1499 (use-cache nil)
|
|
1500 ;; Because there is a bug I can't find just yet
|
|
1501 (inhibit-quit nil))
|
100
|
1502 (save-excursion
|
|
1503 (set-buffer speedbar-buffer)
|
167
|
1504 ;; If we are updating contents to a where we are, then this is
|
|
1505 ;; really a request to update existing contents, so we must be
|
|
1506 ;; careful with our text cache!
|
|
1507 (if (member cbd speedbar-shown-directories)
|
|
1508 (setq cache nil)
|
|
1509 ;; If this directory is NOT in the current list of available
|
|
1510 ;; paths, then use the cache, and set the cache to our new
|
|
1511 ;; value. Make sure to unhighlight the current file, or if we
|
|
1512 ;; come back to this directory, it might be a different file
|
|
1513 ;; and then we get a mess!
|
|
1514 (if (> (point-max) 1)
|
|
1515 (progn
|
|
1516 (speedbar-clear-current-file)
|
|
1517 (setq speedbar-full-text-cache
|
|
1518 (cons speedbar-shown-directories (buffer-string)))))
|
|
1519
|
|
1520 ;; Check if our new directory is in the list of directories
|
|
1521 ;; show in the text-cahce
|
|
1522 (if (member cbd (car cache))
|
|
1523 (setq speedbar-shown-directories (car cache)
|
|
1524 use-cache t)
|
|
1525 ;; default the shown directories to this list...
|
|
1526 (setq speedbar-shown-directories (list cbd)))
|
|
1527 )
|
|
1528 (setq speedbar-last-selected-file nil)
|
100
|
1529 (speedbar-with-writable
|
|
1530 (setq default-directory cbd)
|
167
|
1531 (erase-buffer)
|
|
1532 (if use-cache
|
|
1533 (insert (cdr cache))
|
|
1534 (while funclst
|
|
1535 (funcall (car funclst) cbd 0)
|
|
1536 (setq funclst (cdr funclst)))))
|
|
1537 (goto-char (point-min))))
|
|
1538 (speedbar-reconfigure-menubar))
|
|
1539
|
|
1540 (defun speedbar-update-special-contents ()
|
|
1541 "Used the mode-specific variable to fill in the speedbar buffer.
|
|
1542 This should only be used by modes classified as special."
|
|
1543 (let ((funclst speedbar-special-mode-expansion-list)
|
|
1544 (specialbuff (current-buffer)))
|
|
1545 (save-excursion
|
|
1546 (setq speedbar-desired-buffer specialbuff)
|
|
1547 (set-buffer speedbar-buffer)
|
|
1548 ;; If we are leaving a directory, cache it.
|
|
1549 (if (not speedbar-shown-directories)
|
|
1550 ;; Do nothing
|
|
1551 nil
|
|
1552 ;; Clean up directory maintenance stuff
|
|
1553 (speedbar-clear-current-file)
|
|
1554 (setq speedbar-full-text-cache
|
|
1555 (cons speedbar-shown-directories (buffer-string))
|
|
1556 speedbar-shown-directories nil))
|
|
1557 ;; Now fill in the buffer with our newly found specialized list.
|
|
1558 (speedbar-with-writable
|
100
|
1559 (while funclst
|
167
|
1560 ;; We do not erase the buffer because these functions may
|
|
1561 ;; decide NOT to update themselves.
|
|
1562 (funcall (car funclst) specialbuff)
|
|
1563 (setq funclst (cdr funclst))))
|
|
1564 (goto-char (point-min))))
|
|
1565 (speedbar-reconfigure-menubar))
|
100
|
1566
|
|
1567 (defun speedbar-timer-fn ()
|
167
|
1568 "Run whenever emacs is idle to update the speedbar item."
|
|
1569 (if (not (and (frame-live-p speedbar-frame)
|
100
|
1570 (frame-live-p speedbar-attached-frame)))
|
|
1571 (speedbar-set-timer nil)
|
167
|
1572 (condition-case nil
|
|
1573 ;; Save all the match data so that we don't mess up executing fns
|
|
1574 (save-match-data
|
|
1575 (if (and (frame-visible-p speedbar-frame) speedbar-update-flag)
|
|
1576 (let ((af (selected-frame)))
|
|
1577 (save-window-excursion
|
|
1578 (select-frame speedbar-attached-frame)
|
|
1579 ;; make sure we at least choose a window to
|
|
1580 ;; get a good directory from
|
|
1581 (if (string-match "\\*Minibuf-[0-9]+\\*" (buffer-name))
|
|
1582 (other-window 1))
|
|
1583 ;; Update for special mode all the time!
|
|
1584 (if (and speedbar-mode-specific-contents-flag
|
|
1585 speedbar-special-mode-expansion-list
|
|
1586 (local-variable-p
|
|
1587 'speedbar-special-mode-expansion-list))
|
|
1588 ;(eq (get major-mode 'mode-class 'special)))
|
|
1589 (speedbar-update-special-contents)
|
|
1590 ;; Update all the contents if directories change!
|
|
1591 (if (or (member (expand-file-name default-directory)
|
|
1592 speedbar-shown-directories)
|
|
1593 (string-match speedbar-ignored-path-regexp
|
|
1594 (expand-file-name default-directory))
|
|
1595 (member major-mode speedbar-ignored-modes)
|
|
1596 (eq af speedbar-frame)
|
|
1597 (not (buffer-file-name)))
|
|
1598 nil
|
|
1599 (if (<= 1 speedbar-verbosity-level)
|
|
1600 (message "Updating speedbar to: %s..."
|
|
1601 default-directory))
|
|
1602 (speedbar-update-directory-contents)
|
|
1603 (if (<= 1 speedbar-verbosity-level)
|
|
1604 (message "Updating speedbar to: %s...done"
|
|
1605 default-directory))))
|
|
1606 (select-frame af))
|
|
1607 ;; Now run stealthy updates of time-consuming items
|
|
1608 (speedbar-stealthy-updates))))
|
|
1609 ;; errors that might occur
|
|
1610 (error (message "Speedbar error!")))
|
|
1611 ;; Reset the timer
|
|
1612 (speedbar-set-timer speedbar-update-speed))
|
100
|
1613 (run-hooks 'speedbar-timer-hook)
|
|
1614 )
|
|
1615
|
167
|
1616
|
|
1617 ;;; Stealthy activities
|
|
1618 ;;
|
|
1619 (defun speedbar-stealthy-updates ()
|
|
1620 "For a given speedbar, run all items in the stealthy function list.
|
|
1621 Each item returns t if it completes successfully, or nil if
|
|
1622 interrupted by the user."
|
|
1623 (let ((l speedbar-stealthy-function-list))
|
|
1624 (unwind-protect
|
|
1625 (while (and l (funcall (car l)))
|
|
1626 (sit-for 0)
|
|
1627 (setq l (cdr l)))
|
|
1628 ;(message "Exit with %S" (car l))
|
|
1629 )))
|
|
1630
|
|
1631 (defun speedbar-reset-scanners ()
|
|
1632 "Reset any variables used by functions in the stealthy list as state.
|
|
1633 If new functions are added, their state needs to be updated here."
|
|
1634 (setq speedbar-vc-to-do-point t)
|
|
1635 )
|
|
1636
|
|
1637 (defun speedbar-clear-current-file ()
|
|
1638 "Locate the file thought to be current, and unhighlight it."
|
|
1639 (save-excursion
|
|
1640 (set-buffer speedbar-buffer)
|
|
1641 (if speedbar-last-selected-file
|
|
1642 (speedbar-with-writable
|
|
1643 (goto-char (point-min))
|
|
1644 (if (and
|
|
1645 speedbar-last-selected-file
|
|
1646 (re-search-forward
|
|
1647 (concat " \\(" (regexp-quote speedbar-last-selected-file)
|
|
1648 "\\)\\(" (regexp-quote speedbar-vc-indicator)
|
|
1649 "\\)?\n")
|
|
1650 nil t))
|
|
1651 (put-text-property (match-beginning 1)
|
|
1652 (match-end 1)
|
|
1653 'face
|
|
1654 'speedbar-file-face))))))
|
|
1655
|
100
|
1656 (defun speedbar-update-current-file ()
|
167
|
1657 "Find the current file is, and update our visuals to indicate its name.
|
|
1658 This is specific to file names. If the file name doesn't show up, but
|
|
1659 it should be in the list, then the directory cache needs to be
|
|
1660 updated."
|
100
|
1661 (let* ((lastf (selected-frame))
|
167
|
1662 (newcfd (save-excursion
|
|
1663 (select-frame speedbar-attached-frame)
|
|
1664 (let ((rf (if (buffer-file-name)
|
|
1665 (buffer-file-name)
|
|
1666 nil)))
|
|
1667 (select-frame lastf)
|
|
1668 rf)))
|
|
1669 (newcf (if newcfd (file-name-nondirectory newcfd)))
|
|
1670 (lastb (current-buffer))
|
|
1671 (sucf-recursive (boundp 'sucf-recursive)))
|
|
1672 (if (and newcf
|
|
1673 ;; check here, that way we won't refresh to newcf until
|
|
1674 ;; its been written, thus saving ourselves some time
|
|
1675 (file-exists-p newcf)
|
|
1676 (not (string= newcf speedbar-last-selected-file)))
|
100
|
1677 (progn
|
167
|
1678 ;; It is important to select the frame, otherwise the window
|
|
1679 ;; we want the cursor to move in will not be updated by the
|
|
1680 ;; search-forward command.
|
100
|
1681 (select-frame speedbar-frame)
|
167
|
1682 ;; Remove the old file...
|
|
1683 (speedbar-clear-current-file)
|
|
1684 ;; now highlight the new one.
|
100
|
1685 (set-buffer speedbar-buffer)
|
|
1686 (speedbar-with-writable
|
|
1687 (goto-char (point-min))
|
167
|
1688 (if (re-search-forward
|
|
1689 (concat " \\(" (regexp-quote newcf) "\\)\\("
|
|
1690 (regexp-quote speedbar-vc-indicator)
|
|
1691 "\\)?\n") nil t)
|
|
1692 ;; put the property on it
|
|
1693 (put-text-property (match-beginning 1)
|
|
1694 (match-end 1)
|
|
1695 'face
|
|
1696 'speedbar-selected-face)
|
|
1697 ;; Oops, it's not in the list. Should it be?
|
|
1698 (if (and (string-match speedbar-file-regexp newcf)
|
|
1699 (string= (file-name-directory newcfd)
|
|
1700 (expand-file-name default-directory)))
|
|
1701 ;; yes, it is (we will ignore unknowns for now...)
|
|
1702 (progn
|
|
1703 (speedbar-refresh)
|
|
1704 (if (re-search-forward
|
|
1705 (concat " \\(" (regexp-quote newcf) "\\)\n") nil t)
|
|
1706 ;; put the property on it
|
|
1707 (put-text-property (match-beginning 1)
|
|
1708 (match-end 1)
|
|
1709 'face
|
|
1710 'speedbar-selected-face)))
|
|
1711 ;; if it's not in there now, whatever...
|
|
1712 ))
|
100
|
1713 (setq speedbar-last-selected-file newcf))
|
167
|
1714 (if (not sucf-recursive)
|
|
1715 (progn
|
|
1716 (forward-line -1)
|
|
1717 (speedbar-position-cursor-on-line)))
|
100
|
1718 (set-buffer lastb)
|
167
|
1719 (select-frame lastf)
|
|
1720 )))
|
|
1721 ;; return that we are done with this activity.
|
|
1722 t)
|
|
1723
|
|
1724 ;; If it's being used, check for it
|
|
1725 (eval-when-compile (or (featurep 'xemacs) (require 'ange-ftp)))
|
|
1726
|
|
1727 (defun speedbar-check-vc ()
|
|
1728 "Scan all files in a directory, and for each see if it's checked out.
|
|
1729 See `speedbar-this-file-in-vc' and `speedbar-vc-check-dir-p' for how
|
|
1730 to add more types of version control systems."
|
|
1731 ;; Check for to-do to be reset. If reset but no RCS is available
|
|
1732 ;; then set to nil (do nothing) otherwise, start at the beginning
|
|
1733 (save-excursion
|
|
1734 (set-buffer speedbar-buffer)
|
|
1735 (if (and speedbar-vc-do-check (eq speedbar-vc-to-do-point t)
|
|
1736 (speedbar-vc-check-dir-p default-directory)
|
|
1737 (not (and (featurep 'ange-ftp)
|
|
1738 (string-match (car
|
|
1739 (if speedbar-xemacsp
|
|
1740 ange-ftp-path-format
|
|
1741 ange-ftp-name-format))
|
|
1742 (expand-file-name default-directory)))))
|
|
1743 (setq speedbar-vc-to-do-point 0))
|
|
1744 (if (numberp speedbar-vc-to-do-point)
|
|
1745 (progn
|
|
1746 (goto-char speedbar-vc-to-do-point)
|
|
1747 (while (and (not (input-pending-p))
|
|
1748 (re-search-forward "^\\([0-9]+\\):\\s-*\\[[+-]\\] " nil t))
|
|
1749 (setq speedbar-vc-to-do-point (point))
|
|
1750 (if (speedbar-check-vc-this-line)
|
|
1751 (speedbar-with-writable
|
|
1752 (insert speedbar-vc-indicator))))
|
|
1753 (if (input-pending-p)
|
|
1754 ;; return that we are incomplete
|
|
1755 nil
|
|
1756 ;; we are done, set to-do to nil
|
|
1757 (setq speedbar-vc-to-do-point nil)
|
|
1758 ;; and return t
|
|
1759 t))
|
|
1760 t)))
|
|
1761
|
|
1762 (defun speedbar-check-vc-this-line ()
|
|
1763 "Return t if the file on this line is check of of a version control system.
|
|
1764 The one caller-requirement is that the last regexp matching operation
|
|
1765 has the current depth stored in (MATCHSTRING 1), and that the cursor
|
|
1766 is right in front of the file name."
|
|
1767 (let* ((d (string-to-int (match-string 1)))
|
|
1768 (f (speedbar-line-path d))
|
|
1769 (fn (buffer-substring-no-properties
|
|
1770 (point) (progn (end-of-line) (point))))
|
|
1771 (fulln (concat f fn)))
|
|
1772 (if (<= 2 speedbar-verbosity-level)
|
|
1773 (message "Speedbar vc check...%s" fulln))
|
|
1774 (and (file-writable-p fulln)
|
|
1775 (speedbar-this-file-in-vc f fn))))
|
|
1776
|
|
1777 (defun speedbar-vc-check-dir-p (path)
|
|
1778 "Return t if we should bother checking PATH for version control files.
|
|
1779 This can be overloaded to add new types of version control systems."
|
|
1780 (or
|
|
1781 (file-exists-p (concat path "RCS/"))
|
|
1782 ;; If SCCS is added in `speedbar-this-file-in-vc'
|
|
1783 ;; (file-exists-p (concat path "SCCS/"))
|
|
1784 ;; (file-exists-p (getenv "SCCSPATHTHINGIDONTREMEMBER"))
|
|
1785 ))
|
|
1786
|
|
1787 (defun speedbar-this-file-in-vc (path name)
|
|
1788 "Check to see if the file in PATH with NAME is in a version control system.
|
|
1789 You can add new VC systems by overriding this function. You can
|
|
1790 optimize this function by overriding it and only doing those checks
|
|
1791 that will occur on your system."
|
|
1792 (or
|
|
1793 (file-exists-p (concat path "RCS/" name ",v"))
|
|
1794 ;; Is this right? I don't recall
|
|
1795 ;;(file-exists-p (concat path "SCCS/," fn))
|
|
1796 ;;(file-exists-p (concat (getenv "SCCSPATHTHING") "/SCCS/," fn))
|
|
1797 ))
|
100
|
1798
|
|
1799 ;;; Clicking Activity
|
167
|
1800 ;;
|
100
|
1801 (defun speedbar-quick-mouse (e)
|
167
|
1802 "Since mouse events are strange, this will keep the mouse nicely positioned.
|
|
1803 This should be bound to mouse event E."
|
100
|
1804 (interactive "e")
|
|
1805 (mouse-set-point e)
|
167
|
1806 (speedbar-position-cursor-on-line)
|
100
|
1807 )
|
|
1808
|
|
1809 (defun speedbar-position-cursor-on-line ()
|
|
1810 "Position the cursor on a line."
|
167
|
1811 (let ((oldpos (point)))
|
|
1812 (beginning-of-line)
|
|
1813 (if (looking-at "[0-9]+:\\s-*..?.? ")
|
|
1814 (goto-char (1- (match-end 0)))
|
|
1815 (goto-char oldpos))))
|
|
1816
|
|
1817 (defun speedbar-power-click (e)
|
|
1818 "Activate any speedbar button as a power click.
|
|
1819 This should be bound to mouse event E."
|
|
1820 (interactive "e")
|
|
1821 (let ((speedbar-power-click t))
|
|
1822 (speedbar-click e)))
|
|
1823
|
|
1824 (defun speedbar-click (e)
|
|
1825 "Activate any speedbar buttons where the mouse is clicked.
|
|
1826 This must be bound to a mouse event. A button is any location of text
|
|
1827 with a mouse face that has a text property called `speedbar-function'.
|
|
1828 This should be bound to mouse event E."
|
|
1829 (interactive "e")
|
|
1830 (mouse-set-point e)
|
|
1831 (speedbar-do-function-pointer)
|
|
1832 (speedbar-quick-mouse e))
|
|
1833
|
|
1834 (defun speedbar-do-function-pointer ()
|
|
1835 "Look under the cursor and examine the text properties.
|
|
1836 From this extract the file/tag name, token, indentation level and call
|
|
1837 a function if appropriate"
|
|
1838 (let* ((fn (get-text-property (point) 'speedbar-function))
|
|
1839 (tok (get-text-property (point) 'speedbar-token))
|
|
1840 ;; The 1-,+ is safe because scaning starts AFTER the point
|
|
1841 ;; specified. This lets the search include the character the
|
|
1842 ;; cursor is on.
|
|
1843 (tp (previous-single-property-change
|
|
1844 (1+ (point)) 'speedbar-function))
|
|
1845 (np (next-single-property-change
|
|
1846 (point) 'speedbar-function))
|
|
1847 (txt (buffer-substring-no-properties (or tp (point-min))
|
|
1848 (or np (point-max))))
|
|
1849 (dent (save-excursion (beginning-of-line)
|
|
1850 (string-to-number
|
|
1851 (if (looking-at "[0-9]+")
|
|
1852 (buffer-substring-no-properties
|
|
1853 (match-beginning 0) (match-end 0))
|
|
1854 "0")))))
|
|
1855 ;;(message "%S:%S:%S:%s" fn tok txt dent)
|
|
1856 (and fn (funcall fn txt tok dent)))
|
|
1857 (speedbar-position-cursor-on-line))
|
|
1858
|
|
1859 ;;; Reading info from the speedbar buffer
|
|
1860 ;;
|
|
1861 (defun speedbar-line-file (&optional p)
|
|
1862 "Retrieve the file or whatever from the line at P point.
|
|
1863 The return value is a string representing the file. If it is a
|
|
1864 directory, then it is the directory name."
|
|
1865 (save-excursion
|
|
1866 (save-match-data
|
|
1867 (beginning-of-line)
|
|
1868 (if (looking-at (concat
|
|
1869 "\\([0-9]+\\): *[[<][-+][]>] \\([^ \n]+\\)\\("
|
|
1870 (regexp-quote speedbar-vc-indicator)
|
|
1871 "\\)?"))
|
|
1872 (let* ((depth (string-to-int (match-string 1)))
|
|
1873 (path (speedbar-line-path depth))
|
|
1874 (f (match-string 2)))
|
|
1875 (concat path f))
|
|
1876 nil))))
|
|
1877
|
|
1878 (defun speedbar-goto-this-file (file)
|
|
1879 "If FILE is displayed, goto this line and return t.
|
|
1880 Otherwise do not move and return nil."
|
|
1881 (let ((path (substring (file-name-directory (expand-file-name file))
|
|
1882 (length (expand-file-name default-directory))))
|
|
1883 (dest (point)))
|
|
1884 (save-match-data
|
|
1885 (goto-char (point-min))
|
|
1886 ;; scan all the directories
|
|
1887 (while (and path (not (eq path t)))
|
|
1888 (if (string-match "^/?\\([^/]+\\)" path)
|
|
1889 (let ((pp (match-string 1 path)))
|
|
1890 (if (save-match-data
|
|
1891 (re-search-forward (concat "> " (regexp-quote pp) "$")
|
|
1892 nil t))
|
|
1893 (setq path (substring path (match-end 1)))
|
|
1894 (setq path nil)))
|
|
1895 (setq path t)))
|
|
1896 ;; find the file part
|
|
1897 (if (or (not path) (string= (file-name-nondirectory file) ""))
|
|
1898 ;; only had a dir part
|
|
1899 (if path
|
|
1900 (progn
|
|
1901 (speedbar-position-cursor-on-line)
|
|
1902 t)
|
|
1903 (goto-char dest) nil)
|
|
1904 ;; find the file part
|
|
1905 (let ((nd (file-name-nondirectory file)))
|
|
1906 (if (re-search-forward
|
|
1907 (concat "] \\(" (regexp-quote nd)
|
|
1908 "\\)\\(" (regexp-quote speedbar-vc-indicator) "\\)?$")
|
|
1909 nil t)
|
|
1910 (progn
|
|
1911 (speedbar-position-cursor-on-line)
|
|
1912 t)
|
|
1913 (goto-char dest)
|
|
1914 nil))))))
|
100
|
1915
|
|
1916 (defun speedbar-line-path (depth)
|
167
|
1917 "Retrieve the pathname associated with the current line.
|
|
1918 This may require traversing backwards from DEPTH and combining the default
|
|
1919 directory with these items."
|
100
|
1920 (save-excursion
|
167
|
1921 (save-match-data
|
|
1922 (let ((path nil))
|
|
1923 (setq depth (1- depth))
|
|
1924 (while (/= depth -1)
|
|
1925 (if (not (re-search-backward (format "^%d:" depth) nil t))
|
|
1926 (error "Error building path of tag")
|
|
1927 (cond ((looking-at "[0-9]+:\\s-*<->\\s-+\\([^\n]+\\)$")
|
|
1928 (setq path (concat (buffer-substring-no-properties
|
|
1929 (match-beginning 1) (match-end 1))
|
|
1930 "/"
|
|
1931 path)))
|
|
1932 ((looking-at "[0-9]+:\\s-*[-]\\s-+\\([^\n]+\\)$")
|
|
1933 ;; This is the start of our path.
|
|
1934 (setq path (buffer-substring-no-properties
|
|
1935 (match-beginning 1) (match-end 1))))))
|
|
1936 (setq depth (1- depth)))
|
|
1937 (if (and path
|
|
1938 (string-match (concat (regexp-quote speedbar-vc-indicator) "$")
|
|
1939 path))
|
|
1940 (setq path (substring path 0 (match-beginning 0))))
|
|
1941 (concat default-directory path)))))
|
100
|
1942
|
|
1943 (defun speedbar-edit-line ()
|
|
1944 "Edit whatever tag or file is on the current speedbar line."
|
|
1945 (interactive)
|
167
|
1946 (save-excursion
|
|
1947 (beginning-of-line)
|
|
1948 ;; If this fails, then it is a non-standard click, and as such,
|
|
1949 ;; perfectly allowed.
|
|
1950 (re-search-forward "[]>}] [a-zA-Z0-9]"
|
|
1951 (save-excursion (end-of-line) (point)) t)
|
|
1952 (speedbar-do-function-pointer)))
|
100
|
1953
|
|
1954 (defun speedbar-expand-line ()
|
|
1955 "Expand the line under the cursor."
|
|
1956 (interactive)
|
|
1957 (beginning-of-line)
|
|
1958 (re-search-forward ":\\s-*.\\+. " (save-excursion (end-of-line) (point)))
|
|
1959 (forward-char -2)
|
|
1960 (speedbar-do-function-pointer))
|
|
1961
|
|
1962 (defun speedbar-contract-line ()
|
167
|
1963 "Contract the line under the cursor."
|
100
|
1964 (interactive)
|
|
1965 (beginning-of-line)
|
|
1966 (re-search-forward ":\\s-*.-. " (save-excursion (end-of-line) (point)))
|
|
1967 (forward-char -2)
|
|
1968 (speedbar-do-function-pointer))
|
|
1969
|
167
|
1970 (defun speedbar-maybee-jump-to-attached-frame ()
|
|
1971 "Jump to the attached frame ONLY if this was not a mouse event."
|
|
1972 (if (numberp last-input-char)
|
|
1973 (progn
|
|
1974 (select-frame speedbar-attached-frame)
|
|
1975 (other-frame 0))))
|
100
|
1976
|
|
1977 (defun speedbar-find-file (text token indent)
|
167
|
1978 "Speedbar click handler for filenames.
|
|
1979 TEXT, the file will be displayed in the attached frame.
|
|
1980 TOKEN is unused, but required by the click handler. INDENT is the
|
|
1981 current indentation level."
|
100
|
1982 (let ((cdd (speedbar-line-path indent)))
|
167
|
1983 (speedbar-find-file-in-frame (concat cdd text))
|
|
1984 (speedbar-stealthy-updates)
|
100
|
1985 ;; Reset the timer with a new timeout when cliking a file
|
|
1986 ;; in case the user was navigating directories, we can cancel
|
|
1987 ;; that other timer.
|
167
|
1988 (speedbar-set-timer speedbar-update-speed))
|
|
1989 (speedbar-maybee-jump-to-attached-frame))
|
100
|
1990
|
|
1991 (defun speedbar-dir-follow (text token indent)
|
167
|
1992 "Speedbar click handler for directory names.
|
|
1993 Clicking a directory will cause the speedbar to list files in the
|
|
1994 the subdirectory TEXT. TOKEN is an unused requirement. The
|
|
1995 subdirectory chosen will be at INDENT level."
|
|
1996 (setq default-directory
|
100
|
1997 (concat (expand-file-name (concat (speedbar-line-path indent) text))
|
|
1998 "/"))
|
|
1999 ;; Because we leave speedbar as the current buffer,
|
|
2000 ;; update contents will change directory without
|
|
2001 ;; having to touch the attached frame.
|
|
2002 (speedbar-update-contents)
|
|
2003 (speedbar-set-timer speedbar-navigating-speed)
|
|
2004 (setq speedbar-last-selected-file nil)
|
167
|
2005 (speedbar-stealthy-updates))
|
100
|
2006
|
167
|
2007 (defun speedbar-delete-subblock (indent)
|
|
2008 "Delete text from point to indentation level INDENT or greater.
|
|
2009 Handles end-of-sublist smartly."
|
|
2010 (speedbar-with-writable
|
|
2011 (save-excursion
|
|
2012 (end-of-line) (forward-char 1)
|
|
2013 (while (and (not (save-excursion
|
|
2014 (re-search-forward (format "^%d:" indent)
|
|
2015 nil t)))
|
|
2016 (>= indent 0))
|
|
2017 (setq indent (1- indent)))
|
|
2018 (delete-region (point) (if (>= indent 0)
|
|
2019 (match-beginning 0)
|
|
2020 (point-max))))))
|
100
|
2021
|
|
2022 (defun speedbar-dired (text token indent)
|
167
|
2023 "Speedbar click handler for directory expand button.
|
|
2024 Clicking this button expands or contracts a directory. TEXT is the
|
|
2025 button clicked which has either a + or -. TOKEN is the directory to be
|
|
2026 expanded. INDENT is the current indentation level."
|
|
2027 (cond ((string-match "+" text) ;we have to expand this dir
|
|
2028 (setq speedbar-shown-directories
|
|
2029 (cons (expand-file-name
|
100
|
2030 (concat (speedbar-line-path indent) token "/"))
|
|
2031 speedbar-shown-directories))
|
|
2032 (speedbar-change-expand-button-char ?-)
|
167
|
2033 (speedbar-reset-scanners)
|
100
|
2034 (save-excursion
|
|
2035 (end-of-line) (forward-char 1)
|
|
2036 (speedbar-with-writable
|
167
|
2037 (speedbar-default-directory-list
|
100
|
2038 (concat (speedbar-line-path indent) token "/")
|
|
2039 (1+ indent)))))
|
|
2040 ((string-match "-" text) ;we have to contract this node
|
167
|
2041 (speedbar-reset-scanners)
|
100
|
2042 (let ((oldl speedbar-shown-directories)
|
|
2043 (newl nil)
|
167
|
2044 (td (expand-file-name
|
100
|
2045 (concat (speedbar-line-path indent) token))))
|
|
2046 (while oldl
|
|
2047 (if (not (string-match (concat "^" (regexp-quote td)) (car oldl)))
|
|
2048 (setq newl (cons (car oldl) newl)))
|
|
2049 (setq oldl (cdr oldl)))
|
|
2050 (setq speedbar-shown-directories newl))
|
|
2051 (speedbar-change-expand-button-char ?+)
|
167
|
2052 (speedbar-delete-subblock indent)
|
100
|
2053 )
|
|
2054 (t (error "Ooops... not sure what to do.")))
|
|
2055 (speedbar-center-buffer-smartly)
|
|
2056 (setq speedbar-last-selected-file nil)
|
167
|
2057 (save-excursion (speedbar-stealthy-updates)))
|
100
|
2058
|
167
|
2059 (defun speedbar-directory-buttons-follow (text token indent)
|
|
2060 "Speedbar click handler for default directory buttons.
|
|
2061 TEXT is the button clicked on. TOKEN is the directory to follow.
|
|
2062 INDENT is the current indentation level and is unused."
|
100
|
2063 (setq default-directory token)
|
|
2064 ;; Because we leave speedbar as the current buffer,
|
|
2065 ;; update contents will change directory without
|
|
2066 ;; having to touch the attached frame.
|
|
2067 (speedbar-update-contents)
|
|
2068 (speedbar-set-timer speedbar-navigating-speed))
|
|
2069
|
|
2070 (defun speedbar-tag-file (text token indent)
|
167
|
2071 "The cursor is on a selected line. Expand the tags in the specified file.
|
|
2072 The parameter TEXT and TOKEN are required, where TEXT is the button
|
|
2073 clicked, and TOKEN is the file to expand. INDENT is the current
|
|
2074 indentation level."
|
100
|
2075 (cond ((string-match "+" text) ;we have to expand this file
|
|
2076 (let* ((fn (expand-file-name (concat (speedbar-line-path indent)
|
|
2077 token)))
|
167
|
2078 (lst (if speedbar-use-imenu-flag
|
100
|
2079 (let ((tim (speedbar-fetch-dynamic-imenu fn)))
|
|
2080 (if (eq tim t)
|
|
2081 (speedbar-fetch-dynamic-etags fn)
|
|
2082 tim))
|
|
2083 (speedbar-fetch-dynamic-etags fn))))
|
|
2084 ;; if no list, then remove expando button
|
|
2085 (if (not lst)
|
|
2086 (speedbar-change-expand-button-char ??)
|
|
2087 (speedbar-change-expand-button-char ?-)
|
|
2088 (speedbar-with-writable
|
|
2089 (save-excursion
|
|
2090 (end-of-line) (forward-char 1)
|
|
2091 (speedbar-insert-generic-list indent
|
|
2092 lst 'speedbar-tag-expand
|
|
2093 'speedbar-tag-find))))))
|
|
2094 ((string-match "-" text) ;we have to contract this node
|
|
2095 (speedbar-change-expand-button-char ?+)
|
167
|
2096 (speedbar-delete-subblock indent))
|
100
|
2097 (t (error "Ooops... not sure what to do.")))
|
|
2098 (speedbar-center-buffer-smartly))
|
|
2099
|
|
2100 (defun speedbar-tag-find (text token indent)
|
167
|
2101 "For the tag TEXT in a file TOKEN, goto that position.
|
|
2102 INDENT is the current indentation level."
|
100
|
2103 (let ((file (speedbar-line-path indent)))
|
167
|
2104 (speedbar-find-file-in-frame file)
|
|
2105 (save-excursion (speedbar-stealthy-updates))
|
100
|
2106 ;; Reset the timer with a new timeout when cliking a file
|
|
2107 ;; in case the user was navigating directories, we can cancel
|
|
2108 ;; that other timer.
|
|
2109 (speedbar-set-timer speedbar-update-speed)
|
167
|
2110 (goto-char token)
|
|
2111 ;;(recenter)
|
|
2112 (speedbar-maybee-jump-to-attached-frame)
|
|
2113 ))
|
100
|
2114
|
|
2115 (defun speedbar-tag-expand (text token indent)
|
167
|
2116 "Expand a tag sublist. Imenu will return sub-lists of specialized tag types.
|
|
2117 Etags does not support this feature. TEXT will be the button
|
|
2118 string. TOKEN will be the list, and INDENT is the current indentation
|
|
2119 level."
|
100
|
2120 (cond ((string-match "+" text) ;we have to expand this file
|
|
2121 (speedbar-change-expand-button-char ?-)
|
|
2122 (speedbar-with-writable
|
|
2123 (save-excursion
|
|
2124 (end-of-line) (forward-char 1)
|
|
2125 (speedbar-insert-generic-list indent
|
|
2126 token 'speedbar-tag-expand
|
|
2127 'speedbar-tag-find))))
|
|
2128 ((string-match "-" text) ;we have to contract this node
|
|
2129 (speedbar-change-expand-button-char ?+)
|
167
|
2130 (speedbar-delete-subblock indent))
|
100
|
2131 (t (error "Ooops... not sure what to do.")))
|
|
2132 (speedbar-center-buffer-smartly))
|
167
|
2133
|
|
2134 ;;; Loading files into the attached frame.
|
|
2135 ;;
|
|
2136 (defun speedbar-find-file-in-frame (file)
|
|
2137 "This will load FILE into the speedbar attached frame.
|
|
2138 If the file is being displayed in a different frame already, then raise that
|
|
2139 frame instead."
|
|
2140 (let* ((buff (find-file-noselect file))
|
|
2141 (bwin (get-buffer-window buff 0)))
|
|
2142 (if bwin
|
|
2143 (progn
|
|
2144 (select-window bwin)
|
|
2145 (raise-frame (window-frame bwin)))
|
|
2146 (if speedbar-power-click
|
|
2147 (let ((pop-up-frames t)) (select-window (display-buffer buff)))
|
|
2148 (select-frame speedbar-attached-frame)
|
|
2149 (switch-to-buffer buff))))
|
|
2150 )
|
100
|
2151
|
|
2152 ;;; Centering Utility
|
167
|
2153 ;;
|
100
|
2154 (defun speedbar-center-buffer-smartly ()
|
167
|
2155 "Recenter a speedbar buffer so the current indentation level is all visible.
|
|
2156 This assumes that the cursor is on a file, or tag of a file which the user is
|
100
|
2157 interested in."
|
167
|
2158 (if (<= (count-lines (point-min) (point-max))
|
100
|
2159 (window-height (selected-window)))
|
|
2160 ;; whole buffer fits
|
|
2161 (let ((cp (point)))
|
|
2162 (goto-char (point-min))
|
|
2163 (recenter 0)
|
|
2164 (goto-char cp))
|
|
2165 ;; too big
|
|
2166 (let (depth start end exp p)
|
|
2167 (save-excursion
|
|
2168 (beginning-of-line)
|
|
2169 (setq depth (if (looking-at "[0-9]+")
|
|
2170 (string-to-int (buffer-substring-no-properties
|
|
2171 (match-beginning 0) (match-end 0)))
|
|
2172 0))
|
|
2173 (setq exp (format "^%d:\\s-*[[{<]\\([?+-]\\)[]>}]" depth)))
|
|
2174 (save-excursion
|
|
2175 (end-of-line)
|
|
2176 (if (re-search-backward exp nil t)
|
|
2177 (setq start (point))
|
|
2178 (error "Center error"))
|
|
2179 (save-excursion ;Not sure about this part.
|
|
2180 (end-of-line)
|
|
2181 (setq p (point))
|
|
2182 (while (and (not (re-search-forward exp nil t))
|
|
2183 (>= depth 0))
|
|
2184 (setq depth (1- depth))
|
|
2185 (setq exp (format "^%d:\\s-*[[{<]\\([?+-]\\)[]>}]" depth)))
|
|
2186 (if (/= (point) p)
|
|
2187 (setq end (point))
|
|
2188 (setq end (point-max)))))
|
|
2189 ;; Now work out the details of centering
|
|
2190 (let ((nl (count-lines start end))
|
|
2191 (cp (point)))
|
|
2192 (if (> nl (window-height (selected-window)))
|
|
2193 ;; We can't fit it all, so just center on cursor
|
|
2194 (progn (goto-char start)
|
|
2195 (recenter 1))
|
|
2196 ;; we can fit everything on the screen, but...
|
|
2197 (if (and (pos-visible-in-window-p start (selected-window))
|
|
2198 (pos-visible-in-window-p end (selected-window)))
|
|
2199 ;; we are all set!
|
|
2200 nil
|
|
2201 ;; we need to do something...
|
|
2202 (goto-char start)
|
|
2203 (let ((newcent (/ (- (window-height (selected-window)) nl) 2))
|
|
2204 (lte (count-lines start (point-max))))
|
|
2205 (if (and (< (+ newcent lte) (window-height (selected-window)))
|
|
2206 (> (- (window-height (selected-window)) lte 1)
|
|
2207 newcent))
|
|
2208 (setq newcent (- (window-height (selected-window))
|
|
2209 lte 1)))
|
|
2210 (recenter newcent))))
|
|
2211 (goto-char cp)))))
|
|
2212
|
|
2213
|
|
2214 ;;; Tag Management -- Imenu
|
167
|
2215 ;;
|
|
2216 (if (string-match "XEmacs" emacs-version)
|
|
2217
|
|
2218 nil
|
|
2219
|
|
2220 (eval-when-compile (if (locate-library "imenu") (require 'imenu)))
|
|
2221
|
100
|
2222 (defun speedbar-fetch-dynamic-imenu (file)
|
167
|
2223 "Load FILE into a buffer, and generate tags using Imenu.
|
|
2224 Returns the tag list, or t for an error."
|
|
2225 ;; Load this AND compile it in
|
|
2226 (require 'imenu)
|
100
|
2227 (save-excursion
|
|
2228 (set-buffer (find-file-noselect file))
|
|
2229 (condition-case nil
|
167
|
2230 (progn
|
|
2231 (if speedbar-power-click (setq imenu--index-alist nil))
|
|
2232 (imenu--make-index-alist t))
|
100
|
2233 (error t))))
|
167
|
2234 )
|
100
|
2235
|
167
|
2236 ;;; Tag Management -- etags (XEmacs compatibility part)
|
|
2237 ;;
|
100
|
2238 (defvar speedbar-fetch-etags-parse-list
|
167
|
2239 '(;; Note that java has the same parse-group as c
|
|
2240 ("\\.\\([cChH]\\|c++\\|cpp\\|cc\\|hh\\|java\\)$" . speedbar-parse-c-or-c++tag)
|
|
2241 ("\\.el\\|\\.emacs" . "defun\\s-+\\(\\(\\w\\|[-_]\\)+\\)\\s-*\C-?")
|
100
|
2242 ("\\.tex$" . speedbar-parse-tex-string)
|
|
2243 ("\\.p" .
|
|
2244 "\\(\\(FUNCTION\\|function\\|PROCEDURE\\|procedure\\)\\s-+\\([a-zA-Z0-9_.:]+\\)\\)\\s-*(?^?")
|
|
2245
|
|
2246 )
|
167
|
2247 "Associations of file extensions and expressions for extracting tags.
|
|
2248 To add a new file type, you would want to add a new association to the
|
|
2249 list, where the car is the file match, and the cdr is the way to
|
|
2250 extract an element from the tags output. If the output is complex,
|
|
2251 use a function symbol instead of regexp. The function should expect
|
|
2252 to be at the beginning of a line in the etags buffer.
|
100
|
2253
|
167
|
2254 This variable is ignored if `speedbar-use-imenu-flag' is t")
|
100
|
2255
|
|
2256 (defvar speedbar-fetch-etags-command "etags"
|
|
2257 "*Command used to create an etags file.
|
|
2258
|
167
|
2259 This variable is ignored if `speedbar-use-imenu-flag' is t")
|
100
|
2260
|
|
2261 (defvar speedbar-fetch-etags-arguments '("-D" "-I" "-o" "-")
|
167
|
2262 "*List of arguments to use with `speedbar-fetch-etags-command'.
|
|
2263 This creates an etags output buffer. Use `speedbar-toggle-etags' to
|
|
2264 modify this list conveniently.
|
|
2265
|
|
2266 This variable is ignored if `speedbar-use-imenu-flag' is t")
|
|
2267
|
|
2268 (defun speedbar-toggle-etags (flag)
|
|
2269 "Toggle FLAG in `speedbar-fetch-etags-arguments'.
|
|
2270 FLAG then becomes a member of etags command line arguments. If flag
|
|
2271 is \"sort\", then toggle the value of `speedbar-sort-tags'. If it's
|
|
2272 value is \"show\" then toggle the value of
|
|
2273 `speedbar-show-unknown-files'.
|
100
|
2274
|
167
|
2275 This function is a convenience function for XEmacs menu created by
|
|
2276 Farzin Guilak <farzin@protocol.com>"
|
|
2277 (interactive)
|
|
2278 (cond
|
|
2279 ((equal flag "sort")
|
|
2280 (setq speedbar-sort-tags (not speedbar-sort-tags)))
|
|
2281 ((equal flag "show")
|
|
2282 (setq speedbar-show-unknown-files (not speedbar-show-unknown-files)))
|
|
2283 ((or (equal flag "-C")
|
|
2284 (equal flag "-S")
|
|
2285 (equal flag "-D"))
|
|
2286 (if (member flag speedbar-fetch-etags-arguments)
|
|
2287 (setq speedbar-fetch-etags-arguments
|
|
2288 (delete flag speedbar-fetch-etags-arguments))
|
|
2289 (add-to-list 'speedbar-fetch-etags-arguments flag)))
|
|
2290 (t nil)))
|
100
|
2291
|
|
2292 (defun speedbar-fetch-dynamic-etags (file)
|
167
|
2293 "For FILE, run etags and create a list of symbols extracted.
|
|
2294 Each symbol will be associated with it's line position in FILE."
|
100
|
2295 (let ((newlist nil))
|
|
2296 (unwind-protect
|
|
2297 (save-excursion
|
|
2298 (if (get-buffer "*etags tmp*")
|
|
2299 (kill-buffer "*etags tmp*")) ;kill to clean it up
|
167
|
2300 (if (<= 1 speedbar-verbosity-level) (message "Fetching etags..."))
|
100
|
2301 (set-buffer (get-buffer-create "*etags tmp*"))
|
167
|
2302 (apply 'call-process speedbar-fetch-etags-command nil
|
|
2303 (current-buffer) nil
|
100
|
2304 (append speedbar-fetch-etags-arguments (list file)))
|
|
2305 (goto-char (point-min))
|
167
|
2306 (if (<= 1 speedbar-verbosity-level) (message "Fetching etags..."))
|
|
2307 (let ((expr
|
100
|
2308 (let ((exprlst speedbar-fetch-etags-parse-list)
|
|
2309 (ans nil))
|
|
2310 (while (and (not ans) exprlst)
|
|
2311 (if (string-match (car (car exprlst)) file)
|
|
2312 (setq ans (car exprlst)))
|
|
2313 (setq exprlst (cdr exprlst)))
|
|
2314 (cdr ans))))
|
|
2315 (if expr
|
|
2316 (let (tnl)
|
|
2317 (while (not (save-excursion (end-of-line) (eobp)))
|
|
2318 (save-excursion
|
|
2319 (setq tnl (speedbar-extract-one-symbol expr)))
|
|
2320 (if tnl (setq newlist (cons tnl newlist)))
|
|
2321 (forward-line 1)))
|
|
2322 (message "Sorry, no support for a file of that extension"))))
|
|
2323 )
|
167
|
2324 (if speedbar-sort-tags
|
|
2325 (sort newlist (lambda (a b) (string< (car a) (car b))))
|
|
2326 (reverse newlist))))
|
|
2327
|
|
2328 ;; This bit donated by Farzin Guilak <farzin@protocol.com> but I'm not
|
|
2329 ;; sure it's needed with the different sorting method.
|
|
2330 ;;
|
|
2331 ;(defun speedbar-clean-etags()
|
|
2332 ; "Removes spaces before the ^? character, and removes `#define',
|
|
2333 ;return types, etc. preceding tags. This ensures that the sort operation
|
|
2334 ;works on the tags, not the return types."
|
|
2335 ; (save-excursion
|
|
2336 ; (goto-char (point-min))
|
|
2337 ; (while
|
|
2338 ; (re-search-forward "(?[ \t](?\C-?" nil t)
|
|
2339 ; (replace-match "\C-?" nil nil))
|
|
2340 ; (goto-char (point-min))
|
|
2341 ; (while
|
|
2342 ; (re-search-forward "\\(.*[ \t]+\\)\\([^ \t\n]+.*\C-?\\)" nil t)
|
|
2343 ; (delete-region (match-beginning 1) (match-end 1)))))
|
100
|
2344
|
|
2345 (defun speedbar-extract-one-symbol (expr)
|
167
|
2346 "At point, return nil, or one alist in the form: ( symbol . position )
|
|
2347 The line should contain output from etags. Parse the output using the
|
|
2348 regular expression EXPR"
|
100
|
2349 (let* ((sym (if (stringp expr)
|
|
2350 (if (save-excursion
|
167
|
2351 (re-search-forward expr (save-excursion
|
100
|
2352 (end-of-line)
|
|
2353 (point)) t))
|
|
2354 (buffer-substring-no-properties (match-beginning 1)
|
|
2355 (match-end 1)))
|
|
2356 (funcall expr)))
|
|
2357 (pos (let ((j (re-search-forward "[\C-?\C-a]\\([0-9]+\\),\\([0-9]+\\)"
|
|
2358 (save-excursion
|
|
2359 (end-of-line)
|
|
2360 (point))
|
|
2361 t)))
|
|
2362 (if (and j sym)
|
|
2363 (1+ (string-to-int (buffer-substring-no-properties
|
167
|
2364 (match-beginning 2)
|
100
|
2365 (match-end 2))))
|
|
2366 0))))
|
|
2367 (if (/= pos 0)
|
|
2368 (cons sym pos)
|
|
2369 nil)))
|
|
2370
|
|
2371 (defun speedbar-parse-c-or-c++tag ()
|
|
2372 "Parse a c or c++ tag, which tends to be a little complex."
|
|
2373 (save-excursion
|
|
2374 (let ((bound (save-excursion (end-of-line) (point))))
|
|
2375 (cond ((re-search-forward "\C-?\\([^\C-a]+\\)\C-a" bound t)
|
|
2376 (buffer-substring-no-properties (match-beginning 1)
|
|
2377 (match-end 1)))
|
|
2378 ((re-search-forward "\\<\\([^ \t]+\\)\\s-+new(" bound t)
|
|
2379 (buffer-substring-no-properties (match-beginning 1)
|
|
2380 (match-end 1)))
|
|
2381 ((re-search-forward "\\<\\([^ \t(]+\\)\\s-*(\C-?" bound t)
|
|
2382 (buffer-substring-no-properties (match-beginning 1)
|
|
2383 (match-end 1)))
|
|
2384 (t nil))
|
|
2385 )))
|
|
2386
|
|
2387 (defun speedbar-parse-tex-string ()
|
167
|
2388 "Parse a Tex string. Only find data which is relevant."
|
100
|
2389 (save-excursion
|
|
2390 (let ((bound (save-excursion (end-of-line) (point))))
|
|
2391 (cond ((re-search-forward "\\(section\\|chapter\\|cite\\)\\s-*{[^\C-?}]*}?" bound t)
|
|
2392 (buffer-substring-no-properties (match-beginning 0)
|
|
2393 (match-end 0)))
|
|
2394 (t nil)))))
|
|
2395
|
|
2396
|
167
|
2397 ;;; Color loading section This is messy *Blech!*
|
|
2398 ;;
|
100
|
2399 (defun speedbar-load-color (sym l-fg l-bg d-fg d-bg &optional bold italic underline)
|
167
|
2400 "Create a color for SYM with a L-FG and L-BG color, or D-FG and D-BG.
|
|
2401 Optionally make BOLD, ITALIC, or UNDERLINE if applicable. If the background
|
|
2402 attribute of the current frame is determined to be light (white, for example)
|
|
2403 then L-FG and L-BG is used. If not, then D-FG and D-BG is used. This will
|
|
2404 allocate the colors in the best possible manor. This will allow me to store
|
|
2405 multiple defaults and dynamically determine which colors to use."
|
100
|
2406 (let* ((params (frame-parameters))
|
|
2407 (disp-res (if (fboundp 'x-get-resource)
|
|
2408 (if speedbar-xemacsp
|
|
2409 (x-get-resource ".displayType" "DisplayType" 'string)
|
|
2410 (x-get-resource ".displayType" "DisplayType"))
|
|
2411 nil))
|
|
2412 (display-type
|
|
2413 (cond (disp-res (intern (downcase disp-res)))
|
|
2414 ((and (fboundp 'x-display-color-p) (x-display-color-p)) 'color)
|
|
2415 (t 'mono)))
|
|
2416 (bg-res (if (fboundp 'x-get-resource)
|
|
2417 (if speedbar-xemacsp
|
|
2418 (x-get-resource ".backgroundMode" "BackgroundMode" 'string)
|
|
2419 (x-get-resource ".backgroundMode" "BackgroundMode"))
|
|
2420 nil))
|
|
2421 (bgmode
|
|
2422 (cond (bg-res (intern (downcase bg-res)))
|
167
|
2423 ((let* ((bgc (or (cdr (assq 'background-color params))
|
|
2424 (if speedbar-xemacsp
|
|
2425 (x-get-resource ".background"
|
|
2426 "Background" 'string)
|
|
2427 (x-get-resource ".background"
|
|
2428 "Background"))
|
|
2429 ;; if no other options, default is white
|
|
2430 "white"))
|
|
2431 (bgcr (if speedbar-xemacsp
|
|
2432 (color-instance-rgb-components
|
|
2433 (make-color-instance bgc))
|
|
2434 (x-color-values bgc)))
|
|
2435 (wcr (if speedbar-xemacsp
|
|
2436 (color-instance-rgb-components
|
|
2437 (make-color-instance "white"))
|
|
2438 (x-color-values "white"))))
|
|
2439 (< (apply '+ bgcr) (/ (apply '+ wcr) 3)))
|
100
|
2440 'dark)
|
|
2441 (t 'light))) ;our default
|
|
2442 (set-p (function (lambda (face-name resource)
|
|
2443 (if speedbar-xemacsp
|
167
|
2444 (x-get-resource
|
100
|
2445 (concat face-name ".attribute" resource)
|
|
2446 (concat "Face.Attribute" resource)
|
|
2447 'string)
|
167
|
2448 (x-get-resource
|
100
|
2449 (concat face-name ".attribute" resource)
|
|
2450 (concat "Face.Attribute" resource)))
|
|
2451 )))
|
167
|
2452 (nbg (cond ((eq bgmode 'dark) d-bg)
|
100
|
2453 (t l-bg)))
|
|
2454 (nfg (cond ((eq bgmode 'dark) d-fg)
|
|
2455 (t l-fg))))
|
|
2456
|
|
2457 (if (not (eq display-type 'color))
|
|
2458 ;; we need a face of some sort, so just make due with default
|
|
2459 (progn
|
|
2460 (copy-face 'default sym)
|
|
2461 (if bold (condition-case nil
|
|
2462 (make-face-bold sym)
|
167
|
2463 (error (message "Cannot make face %s bold!"
|
100
|
2464 (symbol-name sym)))))
|
|
2465 (if italic (condition-case nil
|
|
2466 (make-face-italic sym)
|
|
2467 (error (message "Cannot make face %s italic!"
|
|
2468 (symbol-name sym)))))
|
|
2469 (set-face-underline-p sym underline)
|
|
2470 )
|
|
2471 ;; make a colorized version of a face. Be sure to check Xdefaults
|
|
2472 ;; for possible overrides first!
|
|
2473 (let ((newface (make-face sym)))
|
|
2474 ;; For each attribute, check if it might already be set by Xdefaults
|
|
2475 (if (and nfg (not (funcall set-p (symbol-name sym) "Foreground")))
|
167
|
2476 (set-face-foreground newface nfg))
|
100
|
2477 (if (and nbg (not (funcall set-p (symbol-name sym) "Background")))
|
167
|
2478 (set-face-background newface nbg))
|
|
2479
|
100
|
2480 (if bold (condition-case nil
|
167
|
2481 (make-face-bold newface)
|
100
|
2482 (error (message "Cannot make face %s bold!"
|
|
2483 (symbol-name sym)))))
|
|
2484 (if italic (condition-case nil
|
167
|
2485 (make-face-italic newface)
|
100
|
2486 (error (message "Cannot make face %s italic!"
|
167
|
2487 (symbol-name newface)))))
|
|
2488 (set-face-underline-p newface underline)
|
100
|
2489 ))))
|
|
2490
|
167
|
2491 (if (x-display-color-p)
|
100
|
2492 (progn
|
167
|
2493 (speedbar-load-color 'speedbar-button-face "green4" nil "green3" nil nil nil nil)
|
100
|
2494 (speedbar-load-color 'speedbar-file-face "cyan4" nil "cyan" nil nil nil nil)
|
|
2495 (speedbar-load-color 'speedbar-directory-face "blue4" nil "light blue" nil nil nil nil)
|
|
2496 (speedbar-load-color 'speedbar-tag-face "brown" nil "yellow" nil nil nil nil)
|
|
2497 (speedbar-load-color 'speedbar-selected-face "red" nil "red" nil nil nil t)
|
|
2498 (speedbar-load-color 'speedbar-highlight-face nil "green" nil "sea green" nil nil nil)
|
|
2499 ) ; color
|
|
2500 (make-face 'speedbar-button-face)
|
|
2501 ;;(make-face 'speedbar-file-face)
|
|
2502 (copy-face 'bold 'speedbar-file-face)
|
|
2503 (make-face 'speedbar-directory-face)
|
|
2504 (make-face 'speedbar-tag-face)
|
|
2505 ;;(make-face 'speedbar-selected-face)
|
|
2506 (copy-face 'underline 'speedbar-selected-face)
|
|
2507 ;;(make-face 'speedbar-highlight-face)
|
|
2508 (copy-face 'highlight 'speedbar-highlight-face)
|
|
2509
|
|
2510 ) ;; monochrome
|
|
2511
|
167
|
2512 ;; some edebug hooks
|
|
2513 (add-hook 'edebug-setup-hook
|
|
2514 (lambda ()
|
|
2515 (def-edebug-spec speedbar-with-writable def-body)))
|
|
2516
|
|
2517 ;; run load-time hooks
|
|
2518 (run-hooks 'speedbar-load-hook)
|
|
2519
|
100
|
2520 (provide 'speedbar)
|
167
|
2521 ;;; speedbar ends here
|