Mercurial > hg > xemacs-beta

comparison lisp/electric/ebuff-menu.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children b82b59fe008d
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;; ebuff-menu.el --- electric-buffer-list mode
2
3 ;; Copyright (C) 1985, 1986, 1992, 1993, 1994 Free Software Foundation, Inc.
4
5 ;; Author: Richard Mlynarik <mly@ai.mit.edu>
6
7 ;; This file is part of XEmacs.
8
9 ;; XEmacs is free software; you can redistribute it and/or modify it
10 ;; under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2, or (at your option)
12 ;; any later version.
13
14 ;; XEmacs is distributed in the hope that it will be useful, but
15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 ;; General Public License for more details.
18
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with XEmacs; see the file COPYING. If not, write to the Free
21 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
22
23 ;;; Synched up with: FSF 19.30.
24
25 ;;; Commentary:
26
27 ;; Who says one can't have typeout windows in GNU Emacs? The entry
28 ;; point, `electric-buffer-list' works like ^r select buffer from the
29 ;; ITS Emacs lunar or tmacs libraries.
30
31 ;;; Code:
32
33 (require 'electric)
34 (require 'buff-menu)
35
36 ;; this depends on the format of list-buffers (from src/buffer.c) and
37 ;; on stuff in lisp/buff-menu.el
38
39 (defvar electric-buffer-menu-mode-map nil)
40
41 ;;;###autoload
42 (defun electric-buffer-list (&optional files-only)
43 "Pops up a buffer describing the set of Emacs buffers.
44 Vaguely like ITS lunar select buffer; combining typeoutoid buffer
45 listing with menuoid buffer selection.
46
47 If the very next character typed is a space then the buffer list
48 window disappears. Otherwise, one may move around in the
49 buffer list window, marking buffers to be selected, saved or deleted.
50
51 To exit and select a new buffer, type a space when the cursor is on the
52 appropriate line of the buffer-list window.
53
54 Other commands are much like those of buffer-menu-mode.
55
56 Calls value of `electric-buffer-menu-mode-hook' on entry if non-nil.
57
58 Non-null optional arg FILES-ONLY means mention only file buffers.
59 When called from Lisp code, FILES-ONLY may be a regular expression,
60 in which case only buffers whose names match that expression are listed,
61 or an arbitrary predicate function.
62
63 \\{electric-buffer-menu-mode-map}"
64 (interactive (list (if current-prefix-arg t nil)))
65 (let (select buffer)
66 (save-window-excursion
67 (save-excursion
68 (save-window-excursion
69 (let ((temp-buffer-show-function 'ignore))
70 (list-buffers files-only)))
71 (setq buffer (window-buffer (Electric-pop-up-window "*Buffer List*")))
72 (unwind-protect
73 (progn
74 (set-buffer buffer)
75 (Electric-buffer-menu-mode)
76 (setq select
77 (catch 'electric-buffer-menu-select
78 (message "<<< Press Return to bury the buffer list >>>")
79 (let ((start-point (point))
80 (first (progn (goto-char (point-min))
81 (forward-line 2)
82 (point)))
83 (last (progn (goto-char (point-max))
84 (forward-line -1)
85 (point)))
86 (goal-column 0))
87 ;; Use start-point if it is meaningful.
88 (goto-char (if (or (< start-point first)
89 (> start-point last))
90 first
91 start-point))
92 (Electric-command-loop 'electric-buffer-menu-select
93 nil
94 t
95 'electric-buffer-menu-looper
96 (cons first last))))))
97 (save-excursion
98 (set-buffer buffer)
99 (Buffer-menu-mode))
100 (bury-buffer buffer)
101 (message nil))))
102 (if select
103 (progn
104 (set-buffer buffer)
105 (let ((opoint (point-marker)))
106 (Buffer-menu-execute)
107 (goto-char (point-min))
108 (cond ((prog1 (search-forward "\n>" nil t)
109 (goto-char opoint) (set-marker opoint nil))
110 (Buffer-menu-select))
111 ((bufferp select)
112 (switch-to-buffer select))
113 (t
114 (switch-to-buffer (Buffer-menu-buffer t)))))))))
115
116 (defun electric-buffer-menu-looper (state condition)
117 (cond ((and condition
118 (not (memq (car condition) '(buffer-read-only
119 end-of-buffer
120 beginning-of-buffer))))
121 (signal (car condition) (cdr condition)))
122 ((< (point) (car state))
123 (goto-char (point-min))
124 (forward-line 2))
125 ((> (point) (cdr state))
126 (goto-char (point-max))
127 (forward-line -1)
128 (if (pos-visible-in-window-p (point-max))
129 (recenter -1)))))
130
131 (put 'Electric-buffer-menu-mode 'mode-class 'special)
132 (defun Electric-buffer-menu-mode ()
133 "Major mode for editing a list of buffers.
134 Each line describes one of the buffers in Emacs.
135 Letters do not insert themselves; instead, they are commands.
136 \\<electric-buffer-menu-mode-map>
137 \\[keyboard-quit] or \\[Electric-buffer-menu-quit] -- exit buffer menu, returning to previous window and buffer
138 configuration. If the very first character typed is a space, it
139 also has this effect.
140 \\[Electric-buffer-menu-select] -- select buffer of line point is on.
141 Also show buffers marked with m in other windows,
142 deletes buffers marked with \"D\", and saves those marked with \"S\".
143 \\[Buffer-menu-mark] -- mark buffer to be displayed.
144 \\[Buffer-menu-not-modified] -- clear modified-flag on that buffer.
145 \\[Buffer-menu-save] -- mark that buffer to be saved.
146 \\[Buffer-menu-delete] or \\[Buffer-menu-delete-backwards] -- mark that buffer to be deleted.
147 \\[Buffer-menu-unmark] -- remove all kinds of marks from current line.
148 \\[Electric-buffer-menu-mode-view-buffer] -- view buffer, returning when done.
149 \\[Buffer-menu-backup-unmark] -- back up a line and remove marks.
150
151 \\{electric-buffer-menu-mode-map}
152
153 Entry to this mode via command `electric-buffer-list' calls the value of
154 `electric-buffer-menu-mode-hook' if it is non-nil."
155 (kill-all-local-variables)
156 (use-local-map electric-buffer-menu-mode-map)
157 (setq mode-name "Electric Buffer Menu")
158 (setq mode-line-buffer-identification "Electric Buffer List")
159 (if (memq 'mode-name mode-line-format)
160 (progn (setq mode-line-format (copy-sequence mode-line-format))
161 (setcar (memq 'mode-name mode-line-format) "Buffers")))
162 (make-local-variable 'Helper-return-blurb)
163 (setq Helper-return-blurb "return to buffer editing")
164 (setq truncate-lines t)
165 (setq buffer-scrollbar-height 0)
166 (setq buffer-read-only t)
167 (setq major-mode 'Electric-buffer-menu-mode)
168 (setq mode-motion-hook 'mode-motion-highlight-line)
169 (goto-char (point-min))
170 (if (search-forward "\n." nil t) (forward-char -1))
171 (run-hooks 'electric-buffer-menu-mode-hook))
172
173 ;; generally the same as Buffer-menu-mode-map
174 ;; (except we don't indirect to global-map)
175 (put 'Electric-buffer-menu-undefined 'suppress-keymap t)
176 (if electric-buffer-menu-mode-map
177 nil
178 (let ((map (make-keymap)))
179 (set-keymap-name map 'electric-buffer-menu-mode-map)
180 ;;#### Urk! There must be a buffer way in Lucid Emacs.
181 (let ((i 0))
182 (while (< i 128)
183 (define-key map (make-string 1 i) 'Electric-buffer-menu-undefined)
184 (setq i (1+ i))))
185 (define-key map "\e" (make-keymap))
186 (let ((map2 (lookup-key map "\e"))
187 (i 0))
188 (while (< i 128)
189 (define-key map2 (make-string 1 i) 'Electric-buffer-menu-undefined)
190 (setq i (1+ i))))
191 ;; (define-key map "\C-z" 'suspend-emacs)
192 (define-key map "v" 'Electric-buffer-menu-mode-view-buffer)
193 ;; (define-key map "\C-h" 'Helper-help)
194 (define-key map '(control h) 'Helper-help)
195 (define-key map "?" 'Helper-describe-bindings)
196 (define-key map "\C-c" nil)
197 (define-key map "\C-c\C-c" 'Electric-buffer-menu-quit)
198 (define-key map "\C-]" 'Electric-buffer-menu-quit)
199 (define-key map "q" 'Electric-buffer-menu-quit)
200 (define-key map " " 'Electric-buffer-menu-select)
201 (define-key map "\r" 'Electric-buffer-menu-select) ;; XEmacs change
202 (define-key map "\C-l" 'recenter)
203 (define-key map "s" 'Buffer-menu-save)
204 (define-key map "d" 'Buffer-menu-delete)
205 (define-key map "k" 'Buffer-menu-delete)
206 (define-key map "\C-d" 'Buffer-menu-delete-backwards)
207 ;(define-key map "\C-k" 'Buffer-menu-delete)
208 (define-key map "\177" 'Buffer-menu-backup-unmark)
209 (define-key map 'backspace 'Buffer-menu-backup-unmark)
210 (define-key map "~" 'Buffer-menu-not-modified)
211 (define-key map "u" 'Buffer-menu-unmark)
212 (let ((i ?0))
213 (while (<= i ?9)
214 (define-key map (char-to-string i) 'digit-argument)
215 ;;#### Urk!
216 (define-key map (concat "\e" (char-to-string i)) 'digit-argument)
217 (setq i (1+ i))))
218 (define-key map "-" 'negative-argument)
219 (define-key map "\e-" 'negative-argument)
220 (define-key map "m" 'Buffer-menu-mark)
221 (define-key map "\C-u" 'universal-argument)
222 (define-key map "\C-p" 'previous-line)
223 (define-key map "\C-n" 'next-line)
224 (define-key map "p" 'previous-line)
225 (define-key map "n" 'next-line)
226 (define-key map "\C-v" 'scroll-up)
227 (define-key map "\ev" 'scroll-down)
228 (define-key map ">" 'scroll-right)
229 (define-key map "<" 'scroll-left)
230 (define-key map "\e\C-v" 'scroll-other-window)
231 (define-key map "\e>" 'end-of-buffer)
232 (define-key map "\e<" 'beginning-of-buffer)
233 (define-key map "\e\e" nil)
234 (define-key map "\e\e\e" 'Electric-buffer-menu-quit)
235 (define-key map [home] 'beginning-of-buffer)
236 (define-key map [down] 'next-line)
237 (define-key map [up] 'previous-line)
238 (define-key map [prior] 'scroll-down)
239 (define-key map [next] 'scroll-up)
240 (define-key map 'button2 'Electric-buffer-menu-mouse-select)
241 (define-key map 'button3 'Buffer-menu-popup-menu)
242 (setq electric-buffer-menu-mode-map map)))
243
244 (defun Electric-buffer-menu-exit ()
245 (interactive)
246 (setq unread-command-event last-input-event)
247 ;; for robustness
248 (condition-case ()
249 (throw 'electric-buffer-menu-select nil)
250 (error (Buffer-menu-mode)
251 (other-buffer))))
252
253 (defun Electric-buffer-menu-select ()
254 "Leave Electric Buffer Menu, selecting buffers and executing changes.
255 Saves buffers marked \"S\". Deletes buffers marked \"K\".
256 Selects buffer at point and displays buffers marked \">\" in other
257 windows."
258 (interactive)
259 (throw 'electric-buffer-menu-select (point)))
260
261 (defun Electric-buffer-menu-mouse-select (event)
262 (interactive "e")
263 (mouse-set-point event)
264 (Electric-buffer-menu-select))
265
266 (defun Electric-buffer-menu-quit ()
267 "Leave Electric Buffer Menu, restoring previous window configuration.
268 Does not execute select, save, or delete commands."
269 (interactive)
270 (throw 'electric-buffer-menu-select nil))
271
272 (defun Electric-buffer-menu-undefined ()
273 (interactive)
274 (ding)
275 (message (substitute-command-keys "\
276 Type \\[Electric-buffer-menu-quit] to exit, \
277 \\[Electric-buffer-menu-select] to select, \
278 \\[Helper-help] for help, \\[Helper-describe-bindings] for commands."))
279 (sit-for 4))
280
281 (defun Electric-buffer-menu-mode-view-buffer ()
282 "View buffer on current line in Electric Buffer Menu.
283 Returns to Electric Buffer Menu when done."
284 (interactive)
285 (let ((bufnam (Buffer-menu-buffer nil)))
286 (if bufnam
287 (view-buffer bufnam)
288 (ding)
289 (message "Buffer %s does not exist!" bufnam)
290 (sit-for 4))))
291
292 ;;; ebuff-menu.el ends here