Mercurial > hg > xemacs-beta

comparison lisp/electric/ebuff-menu.el @ 4:b82b59fe008d r19-15b3

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