|
167
|
1 ;;; speedbspec --- Buffer specialized configurations for speedbar
|
|
|
2
|
|
|
3 ;; Copyright (C) 1997 Eric M. Ludlam
|
|
|
4 ;;
|
|
|
5 ;; Author: Eric M. Ludlam <zappo@gnu.ai.mit.edu>
|
|
|
6 ;; Version: 0.1
|
|
|
7 ;; Keywords: file, tags, tools
|
|
|
8 ;; X-RCS: $Id: speedbspec.el,v 1.1 1997/06/29 23:13:34 steve Exp $
|
|
|
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 ;;
|
|
|
30
|
|
|
31 ;;; Commentary:
|
|
|
32 ;;
|
|
|
33 ;; Speedbar provides a frame in which files, and locations in
|
|
|
34 ;; files are displayed. These functions provide some mode-specific
|
|
|
35 ;; displays for some existing emacs modes.
|
|
|
36 ;;
|
|
|
37 ;; To provide special service to all the modes supported by this file,
|
|
|
38 ;; put the following in your .emacs file.
|
|
|
39 ;;
|
|
|
40 ;; (require 'speedbspec)
|
|
|
41 ;;
|
|
|
42 ;; This will load in the known functions, and the mode-enabling code
|
|
|
43 ;; into 'change-major-mode-hook.
|
|
|
44 ;;
|
|
|
45 ;; This file requires speedbar.
|
|
|
46
|
|
|
47 ;;; Change log:
|
|
|
48 ;; 0.1 - Initial revision requiring speedbar 0.5
|
|
|
49
|
|
|
50 ;;; Code:
|
|
|
51 (require 'speedbar)
|
|
|
52
|
|
|
53 ;;; Generic add-new-special-mode stuff
|
|
|
54 ;;
|
|
|
55 (defvar speedbar-localized-buffer-queue nil
|
|
|
56 "List of buffers to localize for speedbar.")
|
|
|
57
|
|
|
58 (defun speedbar-add-localized-speedbar-support-to-q ()
|
|
|
59 "Add speedbar support to all buffers in `speedbar-localized-buffer-queue'."
|
|
|
60 (remove-hook 'post-command-hook
|
|
|
61 'speedbar-add-localized-speedbar-support-to-q)
|
|
|
62 (while speedbar-localized-buffer-queue
|
|
|
63 (speedbar-add-localized-speedbar-support
|
|
|
64 (car speedbar-localized-buffer-queue))
|
|
|
65 (setq speedbar-localized-buffer-queue
|
|
|
66 (cdr speedbar-localized-buffer-queue))))
|
|
|
67
|
|
|
68 (defun speedbar-add-localized-speedbar-support (buffer)
|
|
|
69 "Add localized speedbar support to BUFFER's mode if it is available."
|
|
|
70 (if (not (buffer-live-p buffer))
|
|
|
71 nil
|
|
|
72 (save-excursion
|
|
|
73 (set-buffer buffer)
|
|
|
74 (save-match-data
|
|
|
75 (let ((ms (symbol-name major-mode))
|
|
|
76 v tmp)
|
|
|
77 (if (not (string-match "-mode$" ms))
|
|
|
78 nil ;; do nothing to broken mode
|
|
|
79 (setq ms (substring ms 0 (match-beginning 0)))
|
|
|
80 (setq v (intern-soft (concat ms "-speedbar-buttons")))
|
|
|
81 (if (not v)
|
|
|
82 nil ;; do nothing if not defined
|
|
|
83 (make-local-variable 'speedbar-special-mode-expansion-list)
|
|
|
84 (setq speedbar-special-mode-expansion-list (list v))
|
|
|
85 (setq v (intern-soft (concat ms "-speedbar-menu-items")))
|
|
|
86 (if (not v)
|
|
|
87 nil ;; don't add special menus
|
|
|
88 (make-local-variable 'speedbar-easymenu-definition-special)
|
|
|
89 (setq speedbar-easymenu-definition-special
|
|
|
90 (symbol-value v))))))))))
|
|
|
91
|
|
|
92 (defun speedbar-change-major-mode ()
|
|
|
93 "Run when the major mode is changed."
|
|
|
94 (setq speedbar-localized-buffer-queue
|
|
|
95 (add-to-list 'speedbar-localized-buffer-queue (current-buffer)))
|
|
|
96 (add-hook 'post-command-hook 'speedbar-add-localized-speedbar-support-to-q))
|
|
|
97
|
|
|
98 (add-hook 'change-major-mode-hook 'speedbar-change-major-mode)
|
|
|
99 (add-hook 'find-file-hooks 'speedbar-change-major-mode)
|
|
|
100
|
|
|
101 ;;; Info specific code
|
|
|
102 ;;
|
|
|
103 (defvar Info-last-speedbar-node nil
|
|
|
104 "Last node viewed with speedbar in the form '(NODE FILE).")
|
|
|
105
|
|
|
106 (defvar Info-speedbar-menu-items
|
|
|
107 '(["Browse Item On Line" speedbar-edit-line t])
|
|
|
108 "Additional menu-items to add to speedbar frame.")
|
|
|
109
|
|
|
110 (defun Info-speedbar-buttons (buffer)
|
|
|
111 "Create a speedbar display to help navigation in an Info file.
|
|
|
112 BUFFER is the buffer speedbar is requesting buttons for."
|
|
|
113 (goto-char (point-min))
|
|
|
114 (if (and (looking-at "<Directory>")
|
|
|
115 (save-excursion
|
|
|
116 (set-buffer buffer)
|
|
|
117 (and (equal (car Info-last-speedbar-node) Info-current-node)
|
|
|
118 (equal (cdr Info-last-speedbar-node) Info-current-file))))
|
|
|
119 nil
|
|
|
120 (erase-buffer)
|
|
|
121 (speedbar-insert-button "<Directory>" 'info-xref 'highlight
|
|
|
122 'Info-speedbar-button
|
|
|
123 'Info-directory)
|
|
|
124 (speedbar-insert-button "<Top>" 'info-xref 'highlight
|
|
|
125 'Info-speedbar-button
|
|
|
126 'Info-top-node)
|
|
|
127 (speedbar-insert-button "<Last>" 'info-xref 'highlight
|
|
|
128 'Info-speedbar-button
|
|
|
129 'Info-last)
|
|
|
130 (speedbar-insert-button "<Up>" 'info-xref 'highlight
|
|
|
131 'Info-speedbar-button
|
|
|
132 'Info-up)
|
|
|
133 (speedbar-insert-button "<Next>" 'info-xref 'highlight
|
|
|
134 'Info-speedbar-button
|
|
|
135 'Info-next)
|
|
|
136 (speedbar-insert-button "<Prev>" 'info-xref 'highlight
|
|
|
137 'Info-speedbar-button
|
|
|
138 'Info-prev)
|
|
|
139 (let ((completions nil))
|
|
|
140 (save-excursion
|
|
|
141 (set-buffer buffer)
|
|
|
142 (setq Info-last-speedbar-node
|
|
|
143 (cons Info-current-node Info-current-file))
|
|
|
144 (goto-char (point-min))
|
|
|
145 ;; Always skip the first one...
|
|
|
146 (re-search-forward "\n\\* \\([^:\t\n]*\\):" nil t)
|
|
|
147 (while (re-search-forward "\n\\* \\([^:\t\n]*\\):" nil t)
|
|
|
148 (setq completions (cons (buffer-substring (match-beginning 1)
|
|
|
149 (match-end 1))
|
|
|
150 completions))))
|
|
|
151 (setq completions (nreverse completions))
|
|
|
152 (while completions
|
|
|
153 (speedbar-make-tag-line nil nil nil nil
|
|
|
154 (car completions) 'Info-speedbar-menu
|
|
|
155 nil 'info-node 0)
|
|
|
156 (setq completions (cdr completions))))))
|
|
|
157
|
|
|
158 (defun Info-speedbar-button (text token indent)
|
|
|
159 "Called when user clicks <Directory> from speedbar.
|
|
|
160 TEXT, TOKEN, and INDENT are unused."
|
|
|
161 (speedbar-with-attached-buffer
|
|
|
162 (funcall token)
|
|
|
163 (setq Info-last-speedbar-node nil)
|
|
|
164 (speedbar-update-contents)))
|
|
|
165
|
|
|
166 (defun Info-speedbar-menu (text token indent)
|
|
|
167 "Goto the menu node specified in TEXT.
|
|
|
168 TOKEN and INDENT are not used."
|
|
|
169 (speedbar-with-attached-buffer
|
|
|
170 (Info-menu text)
|
|
|
171 (setq Info-last-speedbar-node nil)
|
|
|
172 (speedbar-update-contents)))
|
|
|
173
|
|
|
174 ;;; RMAIL specific code
|
|
|
175 ;;
|
|
|
176 (defvar rmail-speedbar-last-user nil
|
|
|
177 "The last user to be displayed in the speedbar.")
|
|
|
178
|
|
|
179 (defvar rmail-speedbar-menu-items
|
|
|
180 '(["Browse Item On Line" speedbar-edit-line t]
|
|
|
181 ["Move message to folder" rmail-move-message-to-folder-on-line
|
|
|
182 (save-excursion (beginning-of-line)
|
|
|
183 (looking-at "<M> "))])
|
|
|
184 "Additional menu-items to add to speedbar frame.")
|
|
|
185
|
|
|
186 (defun rmail-speedbar-buttons (buffer)
|
|
|
187 "Create buttons for BUFFER containing rmail messages.
|
|
|
188 Click on the address under Reply to: to reply to this person.
|
|
|
189 Under Folders: Click a name to read it, or on the <M> to move the
|
|
|
190 current message into that RMAIL folder."
|
|
|
191 (let ((from nil))
|
|
|
192 (save-excursion
|
|
|
193 (set-buffer buffer)
|
|
|
194 (goto-char (point-min))
|
|
|
195 (if (not (re-search-forward "^Reply-To: " nil t))
|
|
|
196 (if (not (re-search-forward "^From:? " nil t))
|
|
|
197 (setq from t)))
|
|
|
198 (if from
|
|
|
199 nil
|
|
|
200 (setq from (buffer-substring (point) (save-excursion
|
|
|
201 (end-of-line)
|
|
|
202 (point))))))
|
|
|
203 (goto-char (point-min))
|
|
|
204 (if (and (looking-at "Reply to:")
|
|
|
205 (equal from rmail-speedbar-last-user))
|
|
|
206 nil
|
|
|
207 (setq rmail-speedbar-last-user from)
|
|
|
208 (erase-buffer)
|
|
|
209 (insert "Reply To:\n")
|
|
|
210 (if (stringp from)
|
|
|
211 (speedbar-insert-button from 'speedbar-directory-face 'highlight
|
|
|
212 'rmail-speedbar-button 'rmail-reply))
|
|
|
213 (insert "Folders:\n")
|
|
|
214 (let* ((case-fold-search nil)
|
|
|
215 (df (directory-files (save-excursion (set-buffer buffer)
|
|
|
216 default-directory)
|
|
|
217 nil "^[A-Z0-9]+\\(\\.[A-Z0-9]+\\)?$")))
|
|
|
218 (while df
|
|
|
219 (speedbar-insert-button "<M>" 'speedbar-button-face 'highlight
|
|
|
220 'rmail-speedbar-move-message (car df))
|
|
|
221 (speedbar-insert-button (car df) 'speedbar-file-face 'highlight
|
|
|
222 'rmail-speedbar-find-file nil t)
|
|
|
223 (setq df (cdr df)))))))
|
|
|
224
|
|
|
225 (defun rmail-speedbar-button (text token indent)
|
|
|
226 "Execute an rmail command specified by TEXT.
|
|
|
227 The command used is TOKEN. INDENT is not used."
|
|
|
228 (speedbar-with-attached-buffer
|
|
|
229 (funcall token t)))
|
|
|
230
|
|
|
231 (defun rmail-speedbar-find-file (text token indent)
|
|
|
232 "Load in the rmail file TEXT.
|
|
|
233 TOKEN and INDENT are not used."
|
|
|
234 (speedbar-with-attached-buffer
|
|
|
235 (message "Loading in RMAIL file %s..." text)
|
|
|
236 (find-file text)))
|
|
|
237
|
|
|
238 (defun rmail-move-message-to-folder-on-line ()
|
|
|
239 "If the current line is a folder, move current message to it."
|
|
|
240 (interactive)
|
|
|
241 (save-excursion
|
|
|
242 (beginning-of-line)
|
|
|
243 (if (re-search-forward "<M> " (save-excursion (end-of-line) (point)) t)
|
|
|
244 (progn
|
|
|
245 (forward-char -2)
|
|
|
246 (speedbar-do-function-pointer)))))
|
|
|
247
|
|
|
248 (defun rmail-speedbar-move-message (text token indent)
|
|
|
249 "From button TEXT, copy current message to the rmail file specified by TOKEN.
|
|
|
250 TEXT and INDENT are not used."
|
|
|
251 (speedbar-with-attached-buffer
|
|
|
252 (message "Moving message to %s" token)
|
|
|
253 (rmail-output-to-rmail-file token)))
|
|
|
254
|
|
|
255 ;;; W3 speedbar help
|
|
|
256 (defvar w3-speedbar-last-buffer nil
|
|
|
257 "The last buffer shown by w3-speedbar.")
|
|
|
258
|
|
|
259 (defun w3-speedbar-buttons (buffer)
|
|
|
260 "Create speedbar buttons for the current web BUFFER displayed in w3 mode."
|
|
|
261 (save-excursion
|
|
|
262 (goto-char (point-min))
|
|
|
263 (if (and (looking-at "History:") (equal w3-speedbar-last-buffer buffer))
|
|
|
264 nil
|
|
|
265 (setq w3-speedbar-last-buffer buffer)
|
|
|
266 (erase-buffer)
|
|
|
267 (let ((links (save-excursion (set-buffer buffer) (w3-only-links)))
|
|
|
268 (part nil))
|
|
|
269 (insert "History:\n")
|
|
|
270 ;; This taken out of w3 which was used to create the history list,
|
|
|
271 ;; and is here modified to create the speedbar buttons
|
|
|
272 (cl-maphash
|
|
|
273 (function
|
|
|
274 (lambda (url desc)
|
|
|
275 (speedbar-insert-button (w3-speedbar-shorten-button url)
|
|
|
276 'speedbar-directory-face 'highlight
|
|
|
277 'w3-speedbar-link url)))
|
|
|
278 url-history-list)
|
|
|
279 (insert "Links:\n")
|
|
|
280 (while links
|
|
|
281 (setq part (car (cdr (member 'href (car links))))
|
|
|
282 links (cdr links))
|
|
|
283 (speedbar-insert-button (w3-speedbar-shorten-button part)
|
|
|
284 'speedbar-file-face 'highlight
|
|
|
285 'w3-speedbar-link part))))))
|
|
|
286
|
|
|
287 (defun w3-speedbar-shorten-button (button)
|
|
|
288 "Takes text BUTTON and shortens it as much as possible."
|
|
|
289 ;; I should make this more complex, but I'm not sure how...
|
|
|
290 (let ((fnnd (file-name-nondirectory button)))
|
|
|
291 (if (< 0 (length fnnd))
|
|
|
292 fnnd
|
|
|
293 (if (string-match "\\(ht\\|f\\)tp://" button)
|
|
|
294 (setq button (substring button (match-end 0))))
|
|
|
295 (if (string-match "/$" button)
|
|
|
296 (setq button (substring button 0 (match-beginning 0))))
|
|
|
297 button)))
|
|
|
298
|
|
|
299 (defun w3-speedbar-link (text token indent)
|
|
|
300 "Follow link described by TEXT which has the URL TOKEN.
|
|
|
301 INDENT is not used."
|
|
|
302 (speedbar-with-attached-buffer (w3-fetch token)))
|
|
|
303
|
|
|
304 (provide 'speedbspec)
|
|
|
305 ;;; speedbspec ends here
|
