Mercurial > hg > xemacs-beta

comparison lisp/utils/speedbspec.el @ 167:85ec50267440 r20-3b10

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b10
author cvs
date Mon, 13 Aug 2007 09:45:46 +0200
parents
children
comparison
equal deleted inserted replaced
166:7a77eb660975 167:85ec50267440
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