Mercurial > hg > xemacs-beta

comparison lisp/electric/ebuff-menu.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 4b173ad71786
children b9518feda344
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
1 ;;; ebuff-menu.el --- electric-buffer-list mode 1 ;;; ebuff-menu.el --- electric-buffer-list mode
2 2
3 ;; Copyright (C) 1985, 1986, 1994 Free Software Foundation, Inc. 3 ;; Copyright (C) 1985, 1986, 1992, 1993, 1994 Free Software Foundation, Inc.
4 4
5 ;; Author: Richard Mlynarik <mly@ai.mit.edu> 5 ;; Author: Richard Mlynarik <mly@ai.mit.edu>
6 ;; Keywords: frames
7 6
8 ;; This file is part of XEmacs. 7 ;; This file is part of XEmacs.
9 8
10 ;; XEmacs is free software; you can redistribute it and/or modify it 9 ;; 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 10 ;; under the terms of the GNU General Public License as published by
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License for more details. 17 ;; General Public License for more details.
19 18
20 ;; You should have received a copy of the GNU General Public License 19 ;; 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 20 ;; along with XEmacs; see the file COPYING. If not, write to the Free
22 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 21 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
23 ;; 02111-1307, USA. 22
24 23 ;;; Synched up with: FSF 19.30.
25 ;;; Synched up with: FSF 19.34.
26 24
27 ;;; Commentary: 25 ;;; Commentary:
28 26
29 ;; Who says one can't have typeout windows in GNU Emacs? The entry 27 ;; 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 28 ;; point, `electric-buffer-list' works like ^r select buffer from the
31 ;; ITS Emacs lunar or tmacs libraries. 29 ;; ITS Emacs lunar or tmacs libraries.
32 30
33 ;;; Code: 31 ;;; Code:
34 32
35 (require 'electric) 33 (require 'electric)
36 ;; XEmacs change
37 (require 'buff-menu) 34 (require 'buff-menu)
38 35
39 ;; this depends on the format of list-buffers (from src/buffer.c) and 36 ;; this depends on the format of list-buffers (from src/buffer.c) and
40 ;; on stuff in lisp/buff-menu.el 37 ;; on stuff in lisp/buff-menu.el
41 38
46 "Pops up a buffer describing the set of Emacs buffers. 43 "Pops up a buffer describing the set of Emacs buffers.
47 Vaguely like ITS lunar select buffer; combining typeoutoid buffer 44 Vaguely like ITS lunar select buffer; combining typeoutoid buffer
48 listing with menuoid buffer selection. 45 listing with menuoid buffer selection.
49 46
50 If the very next character typed is a space then the buffer list 47 If the very next character typed is a space then the buffer list
51 window disappears. Otherwise, one may move around in the buffer list 48 window disappears. Otherwise, one may move around in the
52 window, marking buffers to be selected, saved or deleted. 49 buffer list window, marking buffers to be selected, saved or deleted.
53 50
54 To exit and select a new buffer, type a space when the cursor is on 51 To exit and select a new buffer, type a space when the cursor is on the
55 the appropriate line of the buffer-list window. Other commands are 52 appropriate line of the buffer-list window.
56 much like those of buffer-menu-mode. 53
54 Other commands are much like those of buffer-menu-mode.
57 55
58 Calls value of `electric-buffer-menu-mode-hook' on entry if non-nil. 56 Calls value of `electric-buffer-menu-mode-hook' on entry if non-nil.
59 57
60 Non-null optional arg FILES-ONLY means mention only file buffers. 58 Non-null optional arg FILES-ONLY means mention only file buffers.
61 When called from Lisp code, FILES-ONLY may be a regular expression, 59 When called from Lisp code, FILES-ONLY may be a regular expression,
64 62
65 \\{electric-buffer-menu-mode-map}" 63 \\{electric-buffer-menu-mode-map}"
66 (interactive (list (if current-prefix-arg t nil))) 64 (interactive (list (if current-prefix-arg t nil)))
67 (let (select buffer) 65 (let (select buffer)
68 (save-window-excursion 66 (save-window-excursion
69 (save-window-excursion (list-buffers files-only)) 67 (save-excursion
70 (setq buffer (window-buffer (Electric-pop-up-window "*Buffer List*"))) 68 (save-window-excursion
71 (unwind-protect 69 (let ((temp-buffer-show-function 'ignore))
72 (progn 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
73 (set-buffer buffer) 98 (set-buffer buffer)
74 (Electric-buffer-menu-mode) 99 (Buffer-menu-mode))
75 (setq select 100 (bury-buffer buffer)
76 (catch 'electric-buffer-menu-select 101 (message nil))))
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 "")))
106 (if select 102 (if select
107 (progn (set-buffer buffer) 103 (progn
108 (let ((opoint (point-marker))) 104 (set-buffer buffer)
109 (Buffer-menu-execute) 105 (let ((opoint (point-marker)))
110 (goto-char (point-min)) 106 (Buffer-menu-execute)
111 (if (prog1 (search-forward "\n>" nil t) 107 (goto-char (point-min))
112 (goto-char opoint) (set-marker opoint nil)) 108 (cond ((prog1 (search-forward "\n>" nil t)
113 (Buffer-menu-select) 109 (goto-char opoint) (set-marker opoint nil))
114 (switch-to-buffer (Buffer-menu-buffer t)))))))) 110 (Buffer-menu-select))
111 ((bufferp select)
112 (switch-to-buffer select))
113 (t
114 (switch-to-buffer (Buffer-menu-buffer t)))))))))
115 115
116 (defun electric-buffer-menu-looper (state condition) 116 (defun electric-buffer-menu-looper (state condition)
117 (cond ((and condition 117 (cond ((and condition
118 (not (memq (car condition) '(buffer-read-only 118 (not (memq (car condition) '(buffer-read-only
119 end-of-buffer 119 end-of-buffer
154 `electric-buffer-menu-mode-hook' if it is non-nil." 154 `electric-buffer-menu-mode-hook' if it is non-nil."
155 (kill-all-local-variables) 155 (kill-all-local-variables)
156 (use-local-map electric-buffer-menu-mode-map) 156 (use-local-map electric-buffer-menu-mode-map)
157 (setq mode-name "Electric Buffer Menu") 157 (setq mode-name "Electric Buffer Menu")
158 (setq mode-line-buffer-identification "Electric Buffer List") 158 (setq mode-line-buffer-identification "Electric Buffer List")
159 ;; XEmacs
160 (if (memq 'mode-name mode-line-format) 159 (if (memq 'mode-name mode-line-format)
161 (progn (setq mode-line-format (copy-sequence mode-line-format)) 160 (progn (setq mode-line-format (copy-sequence mode-line-format))
162 (setcar (memq 'mode-name mode-line-format) "Buffers"))) 161 (setcar (memq 'mode-name mode-line-format) "Buffers")))
163 (make-local-variable 'Helper-return-blurb) 162 (make-local-variable 'Helper-return-blurb)
164 (setq Helper-return-blurb "return to buffer editing") 163 (setq Helper-return-blurb "return to buffer editing")
165 (setq truncate-lines t) 164 (setq truncate-lines t)
166 ;; XEmacs
167 (setq buffer-scrollbar-height 0) 165 (setq buffer-scrollbar-height 0)
168 (setq buffer-read-only t) 166 (setq buffer-read-only t)
169 (setq major-mode 'Electric-buffer-menu-mode) 167 (setq major-mode 'Electric-buffer-menu-mode)
170 ;; XEmacs
171 (setq mode-motion-hook 'mode-motion-highlight-line) 168 (setq mode-motion-hook 'mode-motion-highlight-line)
172 (goto-char (point-min)) 169 (goto-char (point-min))
173 (if (search-forward "\n." nil t) (forward-char -1)) 170 (if (search-forward "\n." nil t) (forward-char -1))
174 (run-hooks 'electric-buffer-menu-mode-hook)) 171 (run-hooks 'electric-buffer-menu-mode-hook))
175 172
176 ;; generally the same as Buffer-menu-mode-map 173 ;; generally the same as Buffer-menu-mode-map
177 ;; (except we don't indirect to global-map) 174 ;; (except we don't indirect to global-map)
178 (put 'Electric-buffer-menu-undefined 'suppress-keymap t) 175 (put 'Electric-buffer-menu-undefined 'suppress-keymap t)
179 (if electric-buffer-menu-mode-map 176 (if electric-buffer-menu-mode-map
180 nil 177 nil
181 (let ((map (make-keymap)) (submap (make-keymap))) 178 (let ((map (make-keymap)))
182 ;(fillarray (car (cdr map)) 'Electric-buffer-menu-undefined) ; FSF 179 (set-keymap-name map 'electric-buffer-menu-mode-map)
180 ;;#### Urk! There must be a buffer way in Lucid Emacs.
183 (let ((i 0)) 181 (let ((i 0))
184 (while (< i 128) 182 (while (< i 128)
185 (define-key map (make-string 1 i) 'Electric-buffer-menu-undefined) 183 (define-key map (make-string 1 i) 'Electric-buffer-menu-undefined)
186 (setq i (1+ i)))) 184 (setq i (1+ i))))
187 (define-key map "\e" submap) 185 (define-key map "\e" (make-keymap))
188 ;(fillarray (car (cdr submap)) 'Electric-buffer-menu-undefined) ; FSF
189 (let ((map2 (lookup-key map "\e")) 186 (let ((map2 (lookup-key map "\e"))
190 (i 0)) 187 (i 0))
191 (while (< i 128) 188 (while (< i 128)
192 (define-key map2 (make-string 1 i) 'Electric-buffer-menu-undefined) 189 (define-key map2 (make-string 1 i) 'Electric-buffer-menu-undefined)
193 (setq i (1+ i)))) 190 (setq i (1+ i))))
194 (define-key map "\C-z" 'suspend-emacs) 191 ;; (define-key map "\C-z" 'suspend-emacs)
195 (define-key map "v" 'Electric-buffer-menu-mode-view-buffer) 192 (define-key map "v" 'Electric-buffer-menu-mode-view-buffer)
196 (define-key map (char-to-string help-char) 'Helper-help) 193 ;; (define-key map "\C-h" 'Helper-help)
194 (define-key map '(control h) 'Helper-help)
197 (define-key map "?" 'Helper-describe-bindings) 195 (define-key map "?" 'Helper-describe-bindings)
198 (define-key map "\C-c" nil) 196 (define-key map "\C-c" nil)
199 (define-key map "\C-c\C-c" 'Electric-buffer-menu-quit) 197 (define-key map "\C-c\C-c" 'Electric-buffer-menu-quit)
200 (define-key map "\C-]" 'Electric-buffer-menu-quit) 198 (define-key map "\C-]" 'Electric-buffer-menu-quit)
201 (define-key map "q" 'Electric-buffer-menu-quit) 199 (define-key map "q" 'Electric-buffer-menu-quit)
202 (define-key map " " 'Electric-buffer-menu-select) 200 (define-key map " " 'Electric-buffer-menu-select)
203 (define-key map "\C-m" 'Electric-buffer-menu-select) 201 (define-key map "\r" 'Electric-buffer-menu-select) ;; XEmacs change
204 (define-key map "\C-l" 'recenter) 202 (define-key map "\C-l" 'recenter)
205 (define-key map "s" 'Buffer-menu-save) 203 (define-key map "s" 'Buffer-menu-save)
206 (define-key map "d" 'Buffer-menu-delete) 204 (define-key map "d" 'Buffer-menu-delete)
207 (define-key map "k" 'Buffer-menu-delete) 205 (define-key map "k" 'Buffer-menu-delete)
208 (define-key map "\C-d" 'Buffer-menu-delete-backwards) 206 (define-key map "\C-d" 'Buffer-menu-delete-backwards)
209 ;(define-key map "\C-k" 'Buffer-menu-delete) 207 ;(define-key map "\C-k" 'Buffer-menu-delete)
210 (define-key map "\177" 'Buffer-menu-backup-unmark) 208 (define-key map "\177" 'Buffer-menu-backup-unmark)
211 ;; XEmacs
212 (define-key map 'backspace 'Buffer-menu-backup-unmark) 209 (define-key map 'backspace 'Buffer-menu-backup-unmark)
213 (define-key map "~" 'Buffer-menu-not-modified) 210 (define-key map "~" 'Buffer-menu-not-modified)
214 (define-key map "u" 'Buffer-menu-unmark) 211 (define-key map "u" 'Buffer-menu-unmark)
215 (let ((i ?0)) 212 (let ((i ?0))
216 (while (<= i ?9) 213 (while (<= i ?9)
233 (define-key map "\e\C-v" 'scroll-other-window) 230 (define-key map "\e\C-v" 'scroll-other-window)
234 (define-key map "\e>" 'end-of-buffer) 231 (define-key map "\e>" 'end-of-buffer)
235 (define-key map "\e<" 'beginning-of-buffer) 232 (define-key map "\e<" 'beginning-of-buffer)
236 (define-key map "\e\e" nil) 233 (define-key map "\e\e" nil)
237 (define-key map "\e\e\e" 'Electric-buffer-menu-quit) 234 (define-key map "\e\e\e" 'Electric-buffer-menu-quit)
238 ;; XEmacs
239 (define-key map [home] 'beginning-of-buffer) 235 (define-key map [home] 'beginning-of-buffer)
240 (define-key map [down] 'next-line) 236 (define-key map [down] 'next-line)
241 (define-key map [up] 'previous-line) 237 (define-key map [up] 'previous-line)
242 (define-key map [prior] 'scroll-down) 238 (define-key map [prior] 'scroll-down)
243 (define-key map [next] 'scroll-up) 239 (define-key map [next] 'scroll-up)
245 (define-key map 'button3 'Buffer-menu-popup-menu) 241 (define-key map 'button3 'Buffer-menu-popup-menu)
246 (setq electric-buffer-menu-mode-map map))) 242 (setq electric-buffer-menu-mode-map map)))
247 243
248 (defun Electric-buffer-menu-exit () 244 (defun Electric-buffer-menu-exit ()
249 (interactive) 245 (interactive)
250 ;; XEmacs
251 (setq unread-command-event last-input-event) 246 (setq unread-command-event last-input-event)
252 ;; for robustness 247 ;; for robustness
253 (condition-case () 248 (condition-case ()
254 (throw 'electric-buffer-menu-select nil) 249 (throw 'electric-buffer-menu-select nil)
255 (error (Buffer-menu-mode) 250 (error (Buffer-menu-mode)
256 (other-buffer)))) 251 (other-buffer))))
257 252
258 (defun Electric-buffer-menu-select () 253 (defun Electric-buffer-menu-select ()
259 "Leave Electric Buffer Menu, selecting buffers and executing changes. 254 "Leave Electric Buffer Menu, selecting buffers and executing changes.
260 Saves buffers marked \"S\". Deletes buffers marked \"K\". 255 Saves buffers marked \"S\". Deletes buffers marked \"K\".
261 Selects buffer at point and displays buffers marked \">\" in other windows." 256 Selects buffer at point and displays buffers marked \">\" in other
257 windows."
262 (interactive) 258 (interactive)
263 (throw 'electric-buffer-menu-select (point))) 259 (throw 'electric-buffer-menu-select (point)))
264 260
265 (defun Electric-buffer-menu-mouse-select (event) 261 (defun Electric-buffer-menu-mouse-select (event)
266 (interactive "e") 262 (interactive "e")
267 ;; XEmacs is simpler
268 (mouse-set-point event) 263 (mouse-set-point event)
269 (Electric-buffer-menu-select)) 264 (Electric-buffer-menu-select))
270 265
271 (defun Electric-buffer-menu-quit () 266 (defun Electric-buffer-menu-quit ()
272 "Leave Electric Buffer Menu, restoring previous window configuration. 267 "Leave Electric Buffer Menu, restoring previous window configuration.
275 (throw 'electric-buffer-menu-select nil)) 270 (throw 'electric-buffer-menu-select nil))
276 271
277 (defun Electric-buffer-menu-undefined () 272 (defun Electric-buffer-menu-undefined ()
278 (interactive) 273 (interactive)
279 (ding) 274 (ding)
280 (message "%s" 275 (message (substitute-command-keys "\
281 (if (and (eq (key-binding "\C-c\C-c") 'Electric-buffer-menu-quit)
282 (eq (key-binding " ") 'Electric-buffer-menu-select)
283 (eq (key-binding (char-to-string help-char)) 'Helper-help)
284 (eq (key-binding "?") 'Helper-describe-bindings))
285 (substitute-command-keys "Type C-c C-c to exit, Space to select,
286 Type \\[Electric-buffer-menu-quit] to exit, \ 276 Type \\[Electric-buffer-menu-quit] to exit, \
287 \\[Electric-buffer-menu-select] to select, \ 277 \\[Electric-buffer-menu-select] to select, \
288 \\[Helper-help] for help, \\[Helper-describe-bindings] for commands."))) 278 \\[Helper-help] for help, \\[Helper-describe-bindings] for commands."))
289 (sit-for 4)) 279 (sit-for 4))
290 280
291 (defun Electric-buffer-menu-mode-view-buffer () 281 (defun Electric-buffer-menu-mode-view-buffer ()
292 "View buffer on current line in Electric Buffer Menu. 282 "View buffer on current line in Electric Buffer Menu.
293 Returns to Electric Buffer Menu when done." 283 Returns to Electric Buffer Menu when done."