|
0
|
1 ;;; ebuff-menu.el --- electric-buffer-list mode
|
|
|
2
|
|
72
|
3 ;; Copyright (C) 1985, 1986, 1994 Free Software Foundation, Inc.
|
|
0
|
4
|
|
|
5 ;; Author: Richard Mlynarik <mly@ai.mit.edu>
|
|
72
|
6 ;; Keywords: frames
|
|
0
|
7
|
|
|
8 ;; This file is part of XEmacs.
|
|
|
9
|
|
|
10 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
11 ;; 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 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
18 ;; General Public License for more details.
|
|
|
19
|
|
|
20 ;; You should have received a copy of the GNU General Public License
|
|
|
21 ;; along with XEmacs; see the file COPYING. If not, write to the Free
|
|
72
|
22 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
|
|
|
23 ;; 02111-1307, USA.
|
|
0
|
24
|
|
72
|
25 ;;; Synched up with: FSF 19.34.
|
|
0
|
26
|
|
|
27 ;;; Commentary:
|
|
|
28
|
|
|
29 ;; Who says one can't have typeout windows in GNU Emacs? The entry
|
|
|
30 ;; point, `electric-buffer-list' works like ^r select buffer from the
|
|
|
31 ;; ITS Emacs lunar or tmacs libraries.
|
|
|
32
|
|
|
33 ;;; Code:
|
|
|
34
|
|
|
35 (require 'electric)
|
|
72
|
36 ;; XEmacs change
|
|
0
|
37 (require 'buff-menu)
|
|
|
38
|
|
|
39 ;; this depends on the format of list-buffers (from src/buffer.c) and
|
|
|
40 ;; on stuff in lisp/buff-menu.el
|
|
|
41
|
|
|
42 (defvar electric-buffer-menu-mode-map nil)
|
|
|
43
|
|
|
44 ;;;###autoload
|
|
74
|
45 (defun electric-buffer-list (&optional files-only)
|
|
0
|
46 "Pops up a buffer describing the set of Emacs buffers.
|
|
|
47 Vaguely like ITS lunar select buffer; combining typeoutoid buffer
|
|
|
48 listing with menuoid buffer selection.
|
|
|
49
|
|
|
50 If the very next character typed is a space then the buffer list
|
|
72
|
51 window disappears. Otherwise, one may move around in the buffer list
|
|
|
52 window, marking buffers to be selected, saved or deleted.
|
|
0
|
53
|
|
72
|
54 To exit and select a new buffer, type a space when the cursor is on
|
|
|
55 the appropriate line of the buffer-list window. Other commands are
|
|
|
56 much like those of buffer-menu-mode.
|
|
0
|
57
|
|
|
58 Calls value of `electric-buffer-menu-mode-hook' on entry if non-nil.
|
|
|
59
|
|
74
|
60 Non-null optional arg FILES-ONLY means mention only file buffers.
|
|
|
61 When called from Lisp code, FILES-ONLY may be a regular expression,
|
|
|
62 in which case only buffers whose names match that expression are listed,
|
|
|
63 or an arbitrary predicate function.
|
|
|
64
|
|
0
|
65 \\{electric-buffer-menu-mode-map}"
|
|
74
|
66 (interactive (list (if current-prefix-arg t nil)))
|
|
0
|
67 (let (select buffer)
|
|
|
68 (save-window-excursion
|
|
74
|
69 (save-window-excursion (list-buffers files-only))
|
|
72
|
70 (setq buffer (window-buffer (Electric-pop-up-window "*Buffer List*")))
|
|
|
71 (unwind-protect
|
|
|
72 (progn
|
|
0
|
73 (set-buffer buffer)
|
|
72
|
74 (Electric-buffer-menu-mode)
|
|
|
75 (setq select
|
|
|
76 (catch 'electric-buffer-menu-select
|
|
|
77 (message "<<< Press Return to bury the buffer list >>>")
|
|
|
78 ;; XEmacs change
|
|
|
79 (if (eq (setq unread-command-events
|
|
|
80 (list (next-command-event)))
|
|
|
81 ?\ )
|
|
|
82 (progn (setq unread-command-events nil)
|
|
|
83 (throw 'electric-buffer-menu-select nil)))
|
|
|
84 (let ((start-point (point))
|
|
|
85 (first (progn (goto-char (point-min))
|
|
|
86 (forward-line 2)
|
|
|
87 (point)))
|
|
|
88 (last (progn (goto-char (point-max))
|
|
|
89 (forward-line -1)
|
|
|
90 (point)))
|
|
|
91 (goal-column 0))
|
|
|
92 ;; Use start-point if it is meaningful.
|
|
|
93 (goto-char (if (or (< start-point first)
|
|
|
94 (> start-point last))
|
|
|
95 first
|
|
|
96 start-point))
|
|
|
97 (Electric-command-loop 'electric-buffer-menu-select
|
|
|
98 nil
|
|
|
99 t
|
|
|
100 'electric-buffer-menu-looper
|
|
|
101 (cons first last))))))
|
|
|
102 (set-buffer buffer)
|
|
|
103 (Buffer-menu-mode)
|
|
|
104 (bury-buffer buffer)
|
|
|
105 (message "")))
|
|
0
|
106 (if select
|
|
72
|
107 (progn (set-buffer buffer)
|
|
|
108 (let ((opoint (point-marker)))
|
|
|
109 (Buffer-menu-execute)
|
|
|
110 (goto-char (point-min))
|
|
|
111 (if (prog1 (search-forward "\n>" nil t)
|
|
|
112 (goto-char opoint) (set-marker opoint nil))
|
|
|
113 (Buffer-menu-select)
|
|
|
114 (switch-to-buffer (Buffer-menu-buffer t))))))))
|
|
0
|
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")
|
|
72
|
159 ;; XEmacs
|
|
0
|
160 (if (memq 'mode-name mode-line-format)
|
|
|
161 (progn (setq mode-line-format (copy-sequence mode-line-format))
|
|
|
162 (setcar (memq 'mode-name mode-line-format) "Buffers")))
|
|
|
163 (make-local-variable 'Helper-return-blurb)
|
|
|
164 (setq Helper-return-blurb "return to buffer editing")
|
|
|
165 (setq truncate-lines t)
|
|
72
|
166 ;; XEmacs
|
|
0
|
167 (setq buffer-scrollbar-height 0)
|
|
|
168 (setq buffer-read-only t)
|
|
|
169 (setq major-mode 'Electric-buffer-menu-mode)
|
|
72
|
170 ;; XEmacs
|
|
0
|
171 (setq mode-motion-hook 'mode-motion-highlight-line)
|
|
|
172 (goto-char (point-min))
|
|
|
173 (if (search-forward "\n." nil t) (forward-char -1))
|
|
|
174 (run-hooks 'electric-buffer-menu-mode-hook))
|
|
|
175
|
|
|
176 ;; generally the same as Buffer-menu-mode-map
|
|
|
177 ;; (except we don't indirect to global-map)
|
|
|
178 (put 'Electric-buffer-menu-undefined 'suppress-keymap t)
|
|
|
179 (if electric-buffer-menu-mode-map
|
|
|
180 nil
|
|
72
|
181 (let ((map (make-keymap)) (submap (make-keymap)))
|
|
|
182 ;(fillarray (car (cdr map)) 'Electric-buffer-menu-undefined) ; FSF
|
|
8
|
183 (let ((i 0))
|
|
|
184 (while (< i 128)
|
|
|
185 (define-key map (make-string 1 i) 'Electric-buffer-menu-undefined)
|
|
|
186 (setq i (1+ i))))
|
|
72
|
187 (define-key map "\e" submap)
|
|
|
188 ;(fillarray (car (cdr submap)) 'Electric-buffer-menu-undefined) ; FSF
|
|
8
|
189 (let ((map2 (lookup-key map "\e"))
|
|
72
|
190 (i 0))
|
|
8
|
191 (while (< i 128)
|
|
|
192 (define-key map2 (make-string 1 i) 'Electric-buffer-menu-undefined)
|
|
|
193 (setq i (1+ i))))
|
|
72
|
194 (define-key map "\C-z" 'suspend-emacs)
|
|
0
|
195 (define-key map "v" 'Electric-buffer-menu-mode-view-buffer)
|
|
98
|
196 (define-key map (vector help-char) 'Helper-help)
|
|
0
|
197 (define-key map "?" 'Helper-describe-bindings)
|
|
|
198 (define-key map "\C-c" nil)
|
|
|
199 (define-key map "\C-c\C-c" 'Electric-buffer-menu-quit)
|
|
|
200 (define-key map "\C-]" 'Electric-buffer-menu-quit)
|
|
|
201 (define-key map "q" 'Electric-buffer-menu-quit)
|
|
72
|
202 (define-key map " " 'Electric-buffer-menu-select)
|
|
|
203 (define-key map "\C-m" 'Electric-buffer-menu-select)
|
|
0
|
204 (define-key map "\C-l" 'recenter)
|
|
|
205 (define-key map "s" 'Buffer-menu-save)
|
|
|
206 (define-key map "d" 'Buffer-menu-delete)
|
|
|
207 (define-key map "k" 'Buffer-menu-delete)
|
|
|
208 (define-key map "\C-d" 'Buffer-menu-delete-backwards)
|
|
|
209 ;(define-key map "\C-k" 'Buffer-menu-delete)
|
|
|
210 (define-key map "\177" 'Buffer-menu-backup-unmark)
|
|
72
|
211 ;; XEmacs
|
|
0
|
212 (define-key map 'backspace 'Buffer-menu-backup-unmark)
|
|
|
213 (define-key map "~" 'Buffer-menu-not-modified)
|
|
|
214 (define-key map "u" 'Buffer-menu-unmark)
|
|
|
215 (let ((i ?0))
|
|
|
216 (while (<= i ?9)
|
|
|
217 (define-key map (char-to-string i) 'digit-argument)
|
|
|
218 ;;#### Urk!
|
|
|
219 (define-key map (concat "\e" (char-to-string i)) 'digit-argument)
|
|
|
220 (setq i (1+ i))))
|
|
|
221 (define-key map "-" 'negative-argument)
|
|
|
222 (define-key map "\e-" 'negative-argument)
|
|
|
223 (define-key map "m" 'Buffer-menu-mark)
|
|
|
224 (define-key map "\C-u" 'universal-argument)
|
|
|
225 (define-key map "\C-p" 'previous-line)
|
|
|
226 (define-key map "\C-n" 'next-line)
|
|
|
227 (define-key map "p" 'previous-line)
|
|
|
228 (define-key map "n" 'next-line)
|
|
|
229 (define-key map "\C-v" 'scroll-up)
|
|
|
230 (define-key map "\ev" 'scroll-down)
|
|
|
231 (define-key map ">" 'scroll-right)
|
|
|
232 (define-key map "<" 'scroll-left)
|
|
|
233 (define-key map "\e\C-v" 'scroll-other-window)
|
|
|
234 (define-key map "\e>" 'end-of-buffer)
|
|
|
235 (define-key map "\e<" 'beginning-of-buffer)
|
|
|
236 (define-key map "\e\e" nil)
|
|
|
237 (define-key map "\e\e\e" 'Electric-buffer-menu-quit)
|
|
72
|
238 ;; XEmacs
|
|
0
|
239 (define-key map [home] 'beginning-of-buffer)
|
|
|
240 (define-key map [down] 'next-line)
|
|
|
241 (define-key map [up] 'previous-line)
|
|
|
242 (define-key map [prior] 'scroll-down)
|
|
|
243 (define-key map [next] 'scroll-up)
|
|
|
244 (define-key map 'button2 'Electric-buffer-menu-mouse-select)
|
|
|
245 (define-key map 'button3 'Buffer-menu-popup-menu)
|
|
|
246 (setq electric-buffer-menu-mode-map map)))
|
|
|
247
|
|
|
248 (defun Electric-buffer-menu-exit ()
|
|
|
249 (interactive)
|
|
72
|
250 ;; XEmacs
|
|
0
|
251 (setq unread-command-event last-input-event)
|
|
|
252 ;; for robustness
|
|
|
253 (condition-case ()
|
|
|
254 (throw 'electric-buffer-menu-select nil)
|
|
|
255 (error (Buffer-menu-mode)
|
|
|
256 (other-buffer))))
|
|
|
257
|
|
|
258 (defun Electric-buffer-menu-select ()
|
|
|
259 "Leave Electric Buffer Menu, selecting buffers and executing changes.
|
|
|
260 Saves buffers marked \"S\". Deletes buffers marked \"K\".
|
|
72
|
261 Selects buffer at point and displays buffers marked \">\" in other windows."
|
|
0
|
262 (interactive)
|
|
|
263 (throw 'electric-buffer-menu-select (point)))
|
|
|
264
|
|
|
265 (defun Electric-buffer-menu-mouse-select (event)
|
|
|
266 (interactive "e")
|
|
72
|
267 ;; XEmacs is simpler
|
|
0
|
268 (mouse-set-point event)
|
|
|
269 (Electric-buffer-menu-select))
|
|
|
270
|
|
|
271 (defun Electric-buffer-menu-quit ()
|
|
|
272 "Leave Electric Buffer Menu, restoring previous window configuration.
|
|
|
273 Does not execute select, save, or delete commands."
|
|
|
274 (interactive)
|
|
|
275 (throw 'electric-buffer-menu-select nil))
|
|
|
276
|
|
|
277 (defun Electric-buffer-menu-undefined ()
|
|
|
278 (interactive)
|
|
|
279 (ding)
|
|
72
|
280 (message "%s"
|
|
|
281 (if (and (eq (key-binding "\C-c\C-c") 'Electric-buffer-menu-quit)
|
|
|
282 (eq (key-binding " ") 'Electric-buffer-menu-select)
|
|
98
|
283 (eq (key-binding (vector help-char)) 'Helper-help)
|
|
72
|
284 (eq (key-binding "?") 'Helper-describe-bindings))
|
|
|
285 (substitute-command-keys "Type C-c C-c to exit, Space to select,
|
|
0
|
286 Type \\[Electric-buffer-menu-quit] to exit, \
|
|
|
287 \\[Electric-buffer-menu-select] to select, \
|
|
72
|
288 \\[Helper-help] for help, \\[Helper-describe-bindings] for commands.")))
|
|
0
|
289 (sit-for 4))
|
|
|
290
|
|
|
291 (defun Electric-buffer-menu-mode-view-buffer ()
|
|
|
292 "View buffer on current line in Electric Buffer Menu.
|
|
|
293 Returns to Electric Buffer Menu when done."
|
|
|
294 (interactive)
|
|
|
295 (let ((bufnam (Buffer-menu-buffer nil)))
|
|
|
296 (if bufnam
|
|
|
297 (view-buffer bufnam)
|
|
|
298 (ding)
|
|
|
299 (message "Buffer %s does not exist!" bufnam)
|
|
|
300 (sit-for 4))))
|
|
|
301
|
|
|
302 ;;; ebuff-menu.el ends here
|
