475
|
1 ; buggestions to mly@ai.mit.edu
|
|
2
|
|
3 ;; who says one can't have typeout windows in gnu emacs?
|
|
4 ;; like ^r select buffer from its emacs lunar or tmacs libraries.
|
|
5
|
|
6 ;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
|
|
7
|
|
8 ;; This file is part of GNU Emacs.
|
|
9
|
|
10 ;; GNU Emacs 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 1, or (at your option)
|
|
13 ;; any later version.
|
|
14
|
|
15 ;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to
|
|
22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
23
|
|
24
|
|
25 (require 'electric)
|
|
26
|
|
27 ;; this depends on the format of list-buffers (from src/buffer.c) and
|
|
28 ;; on stuff in lisp/buff-menu.el
|
|
29
|
|
30 (defvar electric-buffer-menu-mode-map nil)
|
|
31
|
|
32 ;;;###autoload
|
|
33 (defun electric-buffer-list (arg)
|
|
34 "Pops up a buffer describing the set of Emacs buffers.
|
|
35 Vaguely like ITS lunar select buffer; combining typeoutoid buffer
|
|
36 listing with menuoid buffer selection.
|
|
37
|
|
38 If the very next character typed is a space then the buffer list
|
|
39 window disappears. Otherwise, one may move around in the buffer list
|
|
40 window, marking buffers to be selected, saved or deleted.
|
|
41
|
|
42 To exit and select a new buffer, type a space when the cursor is on
|
|
43 the appropriate line of the buffer-list window. Other commands are
|
|
44 much like those of buffer-menu-mode.
|
|
45
|
|
46 Calls value of `electric-buffer-menu-mode-hook' on entry if non-nil.
|
|
47
|
|
48 \\{electric-buffer-menu-mode-map}"
|
|
49 (interactive "P")
|
|
50 (let (select buffer)
|
|
51 (save-window-excursion
|
|
52 (save-window-excursion (list-buffers arg))
|
|
53 (setq buffer (window-buffer (Electric-pop-up-window "*Buffer List*")))
|
|
54 (unwind-protect
|
|
55 (progn
|
|
56 (set-buffer buffer)
|
|
57 (Electric-buffer-menu-mode)
|
|
58 (setq select
|
|
59 (catch 'electric-buffer-menu-select
|
|
60 (message "<<< Press Space to bury the buffer list >>>")
|
|
61 (if (= (setq unread-command-char (read-char)) ?\ )
|
|
62 (progn (setq unread-command-char -1)
|
|
63 (throw 'electric-buffer-menu-select nil)))
|
|
64 (let ((first (progn (goto-char (point-min))
|
|
65 (forward-line 2)
|
|
66 (point)))
|
|
67 (last (progn (goto-char (point-max))
|
|
68 (forward-line -1)
|
|
69 (point)))
|
|
70 (goal-column 0))
|
|
71 (goto-char first)
|
|
72 (Electric-command-loop 'electric-buffer-menu-select
|
|
73 nil
|
|
74 t
|
|
75 'electric-buffer-menu-looper
|
|
76 (cons first last))))))
|
|
77 (set-buffer buffer)
|
|
78 (Buffer-menu-mode)
|
|
79 (bury-buffer buffer)
|
|
80 (message "")))
|
|
81 (if select
|
|
82 (progn (set-buffer buffer)
|
|
83 (let ((opoint (point-marker)))
|
|
84 (Buffer-menu-execute)
|
|
85 (goto-char (point-min))
|
|
86 (if (prog1 (search-forward "\n>" nil t)
|
|
87 (goto-char opoint) (set-marker opoint nil))
|
|
88 (Buffer-menu-select)
|
|
89 (switch-to-buffer (Buffer-menu-buffer t))))))))
|
|
90
|
|
91 (defun electric-buffer-menu-looper (state condition)
|
|
92 (cond ((and condition
|
|
93 (not (memq (car condition) '(buffer-read-only
|
|
94 end-of-buffer
|
|
95 beginning-of-buffer))))
|
|
96 (signal (car condition) (cdr condition)))
|
|
97 ((< (point) (car state))
|
|
98 (goto-char (point-min))
|
|
99 (forward-line 2))
|
|
100 ((> (point) (cdr state))
|
|
101 (goto-char (point-max))
|
|
102 (forward-line -1)
|
|
103 (if (pos-visible-in-window-p (point-max))
|
|
104 (recenter -1)))))
|
|
105
|
|
106 (put 'Electric-buffer-menu-mode 'mode-class 'special)
|
|
107 (defun Electric-buffer-menu-mode ()
|
|
108 "Major mode for editing a list of buffers.
|
|
109 Each line describes one of the buffers in Emacs.
|
|
110 Letters do not insert themselves; instead, they are commands.
|
|
111 \\<electric-buffer-menu-mode-map>
|
|
112 \\[keyboard-quit] or \\[Electric-buffer-menu-quit] -- exit buffer menu, returning to previous window and buffer
|
|
113 configuration. If the very first character typed is a space, it
|
|
114 also has this effect.
|
|
115 \\[Electric-buffer-menu-select] -- select buffer of line point is on.
|
|
116 Also show buffers marked with m in other windows,
|
|
117 deletes buffers marked with \"D\", and saves those marked with \"S\".
|
|
118 \\[Buffer-menu-mark] -- mark buffer to be displayed.
|
|
119 \\[Buffer-menu-not-modified] -- clear modified-flag on that buffer.
|
|
120 \\[Buffer-menu-save] -- mark that buffer to be saved.
|
|
121 \\[Buffer-menu-delete] or \\[Buffer-menu-delete-backwards] -- mark that buffer to be deleted.
|
|
122 \\[Buffer-menu-unmark] -- remove all kinds of marks from current line.
|
|
123 \\[Electric-buffer-menu-mode-view-buffer] -- view buffer, returning when done.
|
|
124 \\[Buffer-menu-backup-unmark] -- back up a line and remove marks.
|
|
125
|
|
126 \\{electric-buffer-menu-mode-map}
|
|
127
|
|
128 Entry to this mode via command electric-buffer-list calls the value of
|
|
129 electric-buffer-menu-mode-hook if it is non-nil."
|
|
130 (kill-all-local-variables)
|
|
131 (use-local-map electric-buffer-menu-mode-map)
|
|
132 (setq mode-name "Electric Buffer Menu")
|
|
133 (setq mode-line-buffer-identification "Electric Buffer List")
|
|
134 (make-local-variable 'Helper-return-blurb)
|
|
135 (setq Helper-return-blurb "return to buffer editing")
|
|
136 (setq truncate-lines t)
|
|
137 (setq buffer-read-only t)
|
|
138 (setq major-mode 'Electric-buffer-menu-mode)
|
|
139 (goto-char (point-min))
|
|
140 (if (search-forward "\n." nil t) (forward-char -1))
|
|
141 (run-hooks 'electric-buffer-menu-mode-hook))
|
|
142
|
|
143 ;; generally the same as Buffer-menu-mode-map
|
|
144 ;; (except we don't indirect to global-map)
|
|
145 (put 'Electric-buffer-menu-undefined 'suppress-keymap t)
|
|
146 (if electric-buffer-menu-mode-map
|
|
147 nil
|
|
148 (let ((map (make-keymap)))
|
|
149 (fillarray map 'Electric-buffer-menu-undefined)
|
|
150 (define-key map "\e" (make-keymap))
|
|
151 (fillarray (lookup-key map "\e") 'Electric-buffer-menu-undefined)
|
|
152 (define-key map "\C-z" 'suspend-emacs)
|
|
153 (define-key map "v" 'Electric-buffer-menu-mode-view-buffer)
|
|
154 (define-key map "\C-h" 'Helper-help)
|
|
155 (define-key map "?" 'Helper-describe-bindings)
|
|
156 (define-key map "\C-c" nil)
|
|
157 (define-key map "\C-c\C-c" 'Electric-buffer-menu-quit)
|
|
158 (define-key map "\C-]" 'Electric-buffer-menu-quit)
|
|
159 (define-key map "q" 'Electric-buffer-menu-quit)
|
|
160 (define-key map " " 'Electric-buffer-menu-select)
|
|
161 (define-key map "\C-l" 'recenter)
|
|
162 (define-key map "s" 'Buffer-menu-save)
|
|
163 (define-key map "d" 'Buffer-menu-delete)
|
|
164 (define-key map "k" 'Buffer-menu-delete)
|
|
165 (define-key map "\C-d" 'Buffer-menu-delete-backwards)
|
|
166 ;(define-key map "\C-k" 'Buffer-menu-delete)
|
|
167 (define-key map "\177" 'Buffer-menu-backup-unmark)
|
|
168 (define-key map "~" 'Buffer-menu-not-modified)
|
|
169 (define-key map "u" 'Buffer-menu-unmark)
|
|
170 (let ((i ?0))
|
|
171 (while (<= i ?9)
|
|
172 (define-key map (char-to-string i) 'digit-argument)
|
|
173 (define-key map (concat "\e" (char-to-string i)) 'digit-argument)
|
|
174 (setq i (1+ i))))
|
|
175 (define-key map "-" 'negative-argument)
|
|
176 (define-key map "\e-" 'negative-argument)
|
|
177 (define-key map "m" 'Buffer-menu-mark)
|
|
178 (define-key map "\C-u" 'universal-argument)
|
|
179 (define-key map "\C-p" 'previous-line)
|
|
180 (define-key map "\C-n" 'next-line)
|
|
181 (define-key map "p" 'previous-line)
|
|
182 (define-key map "n" 'next-line)
|
|
183 (define-key map "\C-v" 'scroll-up)
|
|
184 (define-key map "\ev" 'scroll-down)
|
|
185 (define-key map ">" 'scroll-right)
|
|
186 (define-key map "<" 'scroll-left)
|
|
187 (define-key map "\e\C-v" 'scroll-other-window)
|
|
188 (define-key map "\e>" 'end-of-buffer)
|
|
189 (define-key map "\e<" 'beginning-of-buffer)
|
|
190 (setq electric-buffer-menu-mode-map map)))
|
|
191
|
|
192 (defun Electric-buffer-menu-exit ()
|
|
193 (interactive)
|
|
194 (setq unread-command-char last-input-char)
|
|
195 ;; for robustness
|
|
196 (condition-case ()
|
|
197 (throw 'electric-buffer-menu-select nil)
|
|
198 (error (Buffer-menu-mode)
|
|
199 (other-buffer))))
|
|
200
|
|
201 (defun Electric-buffer-menu-select ()
|
|
202 "Leave Electric Buffer Menu, selecting buffers and executing changes.
|
|
203 Saves buffers marked \"S\". Deletes buffers marked \"K\".
|
|
204 Selects buffer at point and displays buffers marked \">\" in other windows."
|
|
205 (interactive)
|
|
206 (throw 'electric-buffer-menu-select (point)))
|
|
207
|
|
208 (defun Electric-buffer-menu-quit ()
|
|
209 "Leave Electric Buffer Menu, restoring previous window configuration.
|
|
210 Does not execute select, save, or delete commands."
|
|
211 (interactive)
|
|
212 (throw 'electric-buffer-menu-select nil))
|
|
213
|
|
214 (defun Electric-buffer-menu-undefined ()
|
|
215 (interactive)
|
|
216 (ding)
|
|
217 (message (if (and (eq (key-binding "\C-c\C-c") 'Electric-buffer-menu-quit)
|
|
218 (eq (key-binding " ") 'Electric-buffer-menu-select)
|
|
219 (eq (key-binding "\C-h") 'Helper-help)
|
|
220 (eq (key-binding "?") 'Helper-describe-bindings))
|
|
221 "Type C-c C-c to exit, Space to select, C-h for help, ? for commands"
|
|
222 (substitute-command-keys "\
|
|
223 Type \\[Electric-buffer-menu-quit] to exit, \
|
|
224 \\[Electric-buffer-menu-select] to select, \
|
|
225 \\[Helper-help] for help, \\[Helper-describe-bindings] for commands.")))
|
|
226 (sit-for 4))
|
|
227
|
|
228 (defun Electric-buffer-menu-mode-view-buffer ()
|
|
229 "View buffer on current line in Electric Buffer Menu.
|
|
230 Returns to Electric Buffer Menu when done."
|
|
231 (interactive)
|
|
232 (let ((bufnam (Buffer-menu-buffer nil)))
|
|
233 (if bufnam
|
|
234 (view-buffer bufnam)
|
|
235 (ding)
|
|
236 (message "Buffer %s does not exist!" bufnam)
|
|
237 (sit-for 4))))
|
|
238
|
|
239
|
|
240
|
|
241
|