*** empty log message ***
[emacs.git] / lisp / buff-menu.el
blob398b362d4e4e57d2a72a4026f284869069e3491b
1 ;;; buff-menu.el --- buffer menu main function and support functions -*- coding:utf-8 -*-
3 ;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 2000, 2001, 2002, 2003,
4 ;; 2004, 2005, 2006 Free Software Foundation, Inc.
6 ;; Maintainer: FSF
7 ;; Keywords: convenience
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24 ;; Boston, MA 02110-1301, USA.
26 ;;; Commentary:
28 ;; Edit, delete, or change attributes of all currently active Emacs
29 ;; buffers from a list summarizing their state. A good way to browse
30 ;; any special or scratch buffers you have loaded, since you can't find
31 ;; them by filename. The single entry point is `list-buffers',
32 ;; normally bound to C-x C-b.
34 ;;; Change Log:
36 ;; Buffer-menu-view: New function
37 ;; Buffer-menu-view-other-window: New function
39 ;; Merged by esr with recent mods to Emacs 19 buff-menu, 23 Mar 1993
41 ;; Modified by Bob Weiner, Motorola, Inc., 4/14/89
43 ;; Added optional backup argument to 'Buffer-menu-unmark' to make it undelete
44 ;; current entry and then move to previous one.
46 ;; Based on FSF code dating back to 1985.
48 ;;; Code:
50 ;;Trying to preserve the old window configuration works well in
51 ;;simple scenarios, when you enter the buffer menu, use it, and exit it.
52 ;;But it does strange things when you switch back to the buffer list buffer
53 ;;with C-x b, later on, when the window configuration is different.
54 ;;The choice seems to be, either restore the window configuration
55 ;;in all cases, or in no cases.
56 ;;I decided it was better not to restore the window config at all. -- rms.
58 ;;But since then, I changed buffer-menu to use the selected window,
59 ;;so q now once again goes back to the previous window configuration.
61 ;;(defvar Buffer-menu-window-config nil
62 ;; "Window configuration saved from entry to `buffer-menu'.")
64 ;; Put buffer *Buffer List* into proper mode right away
65 ;; so that from now on even list-buffers is enough to get a buffer menu.
67 (defgroup Buffer-menu nil
68 "Show a menu of all buffers in a buffer."
69 :group 'tools
70 :group 'convenience)
72 (defcustom Buffer-menu-use-header-line t
73 "*Non-nil means to use an immovable header-line."
74 :type 'boolean
75 :group 'Buffer-menu)
77 (defface buffer-menu-buffer
78 '((t (:weight bold)))
79 "Face used to highlight buffer names in the buffer menu."
80 :group 'Buffer-menu)
81 (put 'Buffer-menu-buffer 'face-alias 'buffer-menu-buffer)
83 (defcustom Buffer-menu-buffer+size-width 26
84 "*How wide to jointly make the buffer name and size columns."
85 :type 'number
86 :group 'Buffer-menu)
88 (defcustom Buffer-menu-mode-width 16
89 "*How wide to make the mode name column."
90 :type 'number
91 :group 'Buffer-menu)
93 (defcustom Buffer-menu-use-frame-buffer-list t
94 "If non-nil, the Buffer Menu uses the selected frame's buffer list.
95 Buffers that were never selected in that frame are listed at the end.
96 If the value is nil, the Buffer Menu uses the global buffer list.
97 This variable matters if the Buffer Menu is sorted by visited order,
98 as it is by default."
99 :type 'boolean
100 :group 'Buffer-menu
101 :version "22.1")
103 ;; This should get updated & resorted when you click on a column heading
104 (defvar Buffer-menu-sort-column nil
105 "2 for sorting by buffer names. 5 for sorting by file names.
106 nil for default sorting by visited order.")
108 (defconst Buffer-menu-buffer-column 4)
110 (defvar Buffer-menu-mode-map nil
111 "Local keymap for `Buffer-menu-mode' buffers.")
113 (defvar Buffer-menu-files-only nil
114 "Non-nil if the current buffer-menu lists only file buffers.
115 This variable determines whether reverting the buffer lists only
116 file buffers. It affects both manual reverting and reverting by
117 Auto Revert Mode.")
119 (defvar Info-current-file) ;; from info.el
120 (defvar Info-current-node) ;; from info.el
122 (make-variable-buffer-local 'Buffer-menu-files-only)
124 (if Buffer-menu-mode-map
126 (setq Buffer-menu-mode-map (make-keymap))
127 (suppress-keymap Buffer-menu-mode-map t)
128 (define-key Buffer-menu-mode-map "q" 'quit-window)
129 (define-key Buffer-menu-mode-map "v" 'Buffer-menu-select)
130 (define-key Buffer-menu-mode-map "2" 'Buffer-menu-2-window)
131 (define-key Buffer-menu-mode-map "1" 'Buffer-menu-1-window)
132 (define-key Buffer-menu-mode-map "f" 'Buffer-menu-this-window)
133 (define-key Buffer-menu-mode-map "e" 'Buffer-menu-this-window)
134 (define-key Buffer-menu-mode-map "\C-m" 'Buffer-menu-this-window)
135 (define-key Buffer-menu-mode-map "o" 'Buffer-menu-other-window)
136 (define-key Buffer-menu-mode-map "\C-o" 'Buffer-menu-switch-other-window)
137 (define-key Buffer-menu-mode-map "s" 'Buffer-menu-save)
138 (define-key Buffer-menu-mode-map "d" 'Buffer-menu-delete)
139 (define-key Buffer-menu-mode-map "k" 'Buffer-menu-delete)
140 (define-key Buffer-menu-mode-map "\C-d" 'Buffer-menu-delete-backwards)
141 (define-key Buffer-menu-mode-map "\C-k" 'Buffer-menu-delete)
142 (define-key Buffer-menu-mode-map "x" 'Buffer-menu-execute)
143 (define-key Buffer-menu-mode-map " " 'next-line)
144 (define-key Buffer-menu-mode-map "n" 'next-line)
145 (define-key Buffer-menu-mode-map "p" 'previous-line)
146 (define-key Buffer-menu-mode-map "\177" 'Buffer-menu-backup-unmark)
147 (define-key Buffer-menu-mode-map "~" 'Buffer-menu-not-modified)
148 (define-key Buffer-menu-mode-map "?" 'describe-mode)
149 (define-key Buffer-menu-mode-map "u" 'Buffer-menu-unmark)
150 (define-key Buffer-menu-mode-map "m" 'Buffer-menu-mark)
151 (define-key Buffer-menu-mode-map "t" 'Buffer-menu-visit-tags-table)
152 (define-key Buffer-menu-mode-map "%" 'Buffer-menu-toggle-read-only)
153 (define-key Buffer-menu-mode-map "b" 'Buffer-menu-bury)
154 (define-key Buffer-menu-mode-map "g" 'Buffer-menu-revert)
155 (define-key Buffer-menu-mode-map "V" 'Buffer-menu-view)
156 (define-key Buffer-menu-mode-map "T" 'Buffer-menu-toggle-files-only)
157 (define-key Buffer-menu-mode-map [mouse-2] 'Buffer-menu-mouse-select)
158 (define-key Buffer-menu-mode-map [follow-link] 'mouse-face)
161 ;; Buffer Menu mode is suitable only for specially formatted data.
162 (put 'Buffer-menu-mode 'mode-class 'special)
164 (defun Buffer-menu-mode ()
165 "Major mode for editing a list of buffers.
166 Each line describes one of the buffers in Emacs.
167 Letters do not insert themselves; instead, they are commands.
168 \\<Buffer-menu-mode-map>
169 \\[Buffer-menu-mouse-select] -- select buffer you click on, in place of the buffer menu.
170 \\[Buffer-menu-this-window] -- select current line's buffer in place of the buffer menu.
171 \\[Buffer-menu-other-window] -- select that buffer in another window,
172 so the buffer menu buffer remains visible in its window.
173 \\[Buffer-menu-view] -- select current line's buffer, but in view-mode.
174 \\[Buffer-menu-view-other-window] -- select that buffer in
175 another window, in view-mode.
176 \\[Buffer-menu-switch-other-window] -- make another window display that buffer.
177 \\[Buffer-menu-mark] -- mark current line's buffer to be displayed.
178 \\[Buffer-menu-select] -- select current line's buffer.
179 Also show buffers marked with m, in other windows.
180 \\[Buffer-menu-1-window] -- select that buffer in full-frame window.
181 \\[Buffer-menu-2-window] -- select that buffer in one window,
182 together with buffer selected before this one in another window.
183 \\[Buffer-menu-visit-tags-table] -- visit-tags-table this buffer.
184 \\[Buffer-menu-not-modified] -- clear modified-flag on that buffer.
185 \\[Buffer-menu-save] -- mark that buffer to be saved, and move down.
186 \\[Buffer-menu-delete] -- mark that buffer to be deleted, and move down.
187 \\[Buffer-menu-delete-backwards] -- mark that buffer to be deleted, and move up.
188 \\[Buffer-menu-execute] -- delete or save marked buffers.
189 \\[Buffer-menu-unmark] -- remove all kinds of marks from current line.
190 With prefix argument, also move up one line.
191 \\[Buffer-menu-backup-unmark] -- back up a line and remove marks.
192 \\[Buffer-menu-toggle-read-only] -- toggle read-only status of buffer on this line.
193 \\[Buffer-menu-revert] -- update the list of buffers.
194 \\[Buffer-menu-toggle-files-only] -- toggle whether the menu displays only file buffers.
195 \\[Buffer-menu-bury] -- bury the buffer listed on this line."
196 (kill-all-local-variables)
197 (use-local-map Buffer-menu-mode-map)
198 (setq major-mode 'Buffer-menu-mode)
199 (setq mode-name "Buffer Menu")
200 (set (make-local-variable 'revert-buffer-function)
201 'Buffer-menu-revert-function)
202 (set (make-local-variable 'buffer-stale-function)
203 #'(lambda (&optional noconfirm) 'fast))
204 (setq truncate-lines t)
205 (setq buffer-read-only t)
206 (run-mode-hooks 'buffer-menu-mode-hook))
208 ;; This function exists so we can make the doc string of Buffer-menu-mode
209 ;; look nice.
210 (defun Buffer-menu-revert ()
211 "Update the list of buffers."
212 (interactive)
213 (revert-buffer))
215 (defun Buffer-menu-revert-function (ignore1 ignore2)
216 (or (eq buffer-undo-list t)
217 (setq buffer-undo-list nil))
218 ;; We can not use save-excursion here. The buffer gets erased.
219 (let ((opoint (point))
220 (eobp (eobp))
221 (ocol (current-column))
222 (oline (progn (move-to-column 4)
223 (get-text-property (point) 'buffer)))
224 (prop (point-min))
225 ;; do not make undo records for the reversion.
226 (buffer-undo-list t))
227 ;; We can be called by Auto Revert Mode with the "*Buffer Menu*"
228 ;; temporarily the current buffer. Make sure that the
229 ;; interactively current buffer is correctly identified with a `.'
230 ;; by `list-buffers-noselect'.
231 (with-current-buffer (window-buffer)
232 (list-buffers-noselect Buffer-menu-files-only))
233 (if oline
234 (while (setq prop (next-single-property-change prop 'buffer))
235 (when (eq (get-text-property prop 'buffer) oline)
236 (goto-char prop)
237 (move-to-column ocol)))
238 (goto-char (if eobp (point-max) opoint)))))
240 (defun Buffer-menu-toggle-files-only (arg)
241 "Toggle whether the current buffer-menu displays only file buffers.
242 With a positive ARG display only file buffers. With zero or
243 negative ARG, display other buffers as well."
244 (interactive "P")
245 (setq Buffer-menu-files-only
246 (cond ((not arg) (not Buffer-menu-files-only))
247 ((> (prefix-numeric-value arg) 0) t)))
248 (revert-buffer))
251 (defun Buffer-menu-buffer (error-if-non-existent-p)
252 "Return buffer described by this line of buffer menu."
253 (let* ((where (save-excursion
254 (beginning-of-line)
255 (+ (point) Buffer-menu-buffer-column)))
256 (name (and (not (eobp)) (get-text-property where 'buffer-name)))
257 (buf (and (not (eobp)) (get-text-property where 'buffer))))
258 (if name
259 (or (get-buffer name)
260 (and buf (buffer-name buf) buf)
261 (if error-if-non-existent-p
262 (error "No buffer named `%s'" name)
263 nil))
264 (or (and buf (buffer-name buf) buf)
265 (if error-if-non-existent-p
266 (error "No buffer on this line")
267 nil)))))
269 (defun buffer-menu (&optional arg)
270 "Make a menu of buffers so you can save, delete or select them.
271 With argument, show only buffers that are visiting files.
272 Type ? after invocation to get help on commands available.
273 Type q to remove the buffer menu from the display.
275 The first column shows `>' for a buffer you have
276 marked to be displayed, `D' for one you have marked for
277 deletion, and `.' for the current buffer.
279 The C column has a `.' for the buffer from which you came.
280 The R column has a `%' if the buffer is read-only.
281 The M column has a `*' if it is modified,
282 or `S' if you have marked it for saving.
283 After this come the buffer name, its size in characters,
284 its major mode, and the visited file name (if any)."
285 (interactive "P")
286 ;;; (setq Buffer-menu-window-config (current-window-configuration))
287 (switch-to-buffer (list-buffers-noselect arg))
288 (message
289 "Commands: d, s, x, u; f, o, 1, 2, m, v; ~, %%; q to quit; ? for help."))
291 (defun buffer-menu-other-window (&optional arg)
292 "Display a list of buffers in another window.
293 With the buffer list buffer, you can save, delete or select the buffers.
294 With argument, show only buffers that are visiting files.
295 Type ? after invocation to get help on commands available.
296 Type q to remove the buffer menu from the display.
297 For more information, see the function `buffer-menu'."
298 (interactive "P")
299 ;;; (setq Buffer-menu-window-config (current-window-configuration))
300 (switch-to-buffer-other-window (list-buffers-noselect arg))
301 (message
302 "Commands: d, s, x, u; f, o, 1, 2, m, v; ~, %%; q to quit; ? for help."))
304 (defun Buffer-menu-no-header ()
305 (beginning-of-line)
306 (if (or Buffer-menu-use-header-line
307 (not (eq (char-after) ?C)))
309 (ding)
310 (forward-line 1)
311 nil))
313 (defun Buffer-menu-mark ()
314 "Mark buffer on this line for being displayed by \\<Buffer-menu-mode-map>\\[Buffer-menu-select] command."
315 (interactive)
316 (when (Buffer-menu-no-header)
317 (let ((buffer-read-only nil))
318 (delete-char 1)
319 (insert ?>)
320 (forward-line 1))))
322 (defun Buffer-menu-unmark (&optional backup)
323 "Cancel all requested operations on buffer on this line and move down.
324 Optional prefix arg means move up."
325 (interactive "P")
326 (when (Buffer-menu-no-header)
327 (let* ((buf (Buffer-menu-buffer t))
328 (mod (buffer-modified-p buf))
329 (readonly (save-excursion (set-buffer buf) buffer-read-only))
330 (buffer-read-only nil))
331 (delete-char 3)
332 (insert (if readonly (if mod " %*" " % ") (if mod " *" " ")))))
333 (forward-line (if backup -1 1)))
335 (defun Buffer-menu-backup-unmark ()
336 "Move up and cancel all requested operations on buffer on line above."
337 (interactive)
338 (forward-line -1)
339 (Buffer-menu-unmark)
340 (forward-line -1))
342 (defun Buffer-menu-delete (&optional arg)
343 "Mark buffer on this line to be deleted by \\<Buffer-menu-mode-map>\\[Buffer-menu-execute] command.
344 Prefix arg is how many buffers to delete.
345 Negative arg means delete backwards."
346 (interactive "p")
347 (when (Buffer-menu-no-header)
348 (let ((buffer-read-only nil))
349 (if (or (null arg) (= arg 0))
350 (setq arg 1))
351 (while (> arg 0)
352 (delete-char 1)
353 (insert ?D)
354 (forward-line 1)
355 (setq arg (1- arg)))
356 (while (and (< arg 0)
357 (Buffer-menu-no-header))
358 (delete-char 1)
359 (insert ?D)
360 (forward-line -1)
361 (setq arg (1+ arg))))))
363 (defun Buffer-menu-delete-backwards (&optional arg)
364 "Mark buffer on this line to be deleted by \\<Buffer-menu-mode-map>\\[Buffer-menu-execute] command
365 and then move up one line. Prefix arg means move that many lines."
366 (interactive "p")
367 (Buffer-menu-delete (- (or arg 1))))
369 (defun Buffer-menu-save ()
370 "Mark buffer on this line to be saved by \\<Buffer-menu-mode-map>\\[Buffer-menu-execute] command."
371 (interactive)
372 (when (Buffer-menu-no-header)
373 (let ((buffer-read-only nil))
374 (forward-char 2)
375 (delete-char 1)
376 (insert ?S)
377 (forward-line 1))))
379 (defun Buffer-menu-not-modified (&optional arg)
380 "Mark buffer on this line as unmodified (no changes to save)."
381 (interactive "P")
382 (save-excursion
383 (set-buffer (Buffer-menu-buffer t))
384 (set-buffer-modified-p arg))
385 (save-excursion
386 (beginning-of-line)
387 (forward-char 2)
388 (if (= (char-after) (if arg ?\s ?*))
389 (let ((buffer-read-only nil))
390 (delete-char 1)
391 (insert (if arg ?* ?\s))))))
393 (defun Buffer-menu-beginning ()
394 (goto-char (point-min))
395 (unless Buffer-menu-use-header-line
396 (forward-line)))
398 (defun Buffer-menu-execute ()
399 "Save and/or delete buffers marked with \\<Buffer-menu-mode-map>\\[Buffer-menu-save] or \\<Buffer-menu-mode-map>\\[Buffer-menu-delete] commands."
400 (interactive)
401 (save-excursion
402 (Buffer-menu-beginning)
403 (while (re-search-forward "^..S" nil t)
404 (let ((modp nil))
405 (save-excursion
406 (set-buffer (Buffer-menu-buffer t))
407 (save-buffer)
408 (setq modp (buffer-modified-p)))
409 (let ((buffer-read-only nil))
410 (delete-char -1)
411 (insert (if modp ?* ?\s))))))
412 (save-excursion
413 (Buffer-menu-beginning)
414 (let ((buff-menu-buffer (current-buffer))
415 (buffer-read-only nil))
416 (while (re-search-forward "^D" nil t)
417 (forward-char -1)
418 (let ((buf (Buffer-menu-buffer nil)))
419 (or (eq buf nil)
420 (eq buf buff-menu-buffer)
421 (save-excursion (kill-buffer buf)))
422 (if (and buf (buffer-name buf))
423 (progn (delete-char 1)
424 (insert ?\s))
425 (delete-region (point) (progn (forward-line 1) (point)))
426 (unless (bobp)
427 (forward-char -1))))))))
429 (defun Buffer-menu-select ()
430 "Select this line's buffer; also display buffers marked with `>'.
431 You can mark buffers with the \\<Buffer-menu-mode-map>\\[Buffer-menu-mark] command.
432 This command deletes and replaces all the previously existing windows
433 in the selected frame."
434 (interactive)
435 (let ((buff (Buffer-menu-buffer t))
436 (menu (current-buffer))
437 (others ())
438 tem)
439 (Buffer-menu-beginning)
440 (while (re-search-forward "^>" nil t)
441 (setq tem (Buffer-menu-buffer t))
442 (let ((buffer-read-only nil))
443 (delete-char -1)
444 (insert ?\s))
445 (or (eq tem buff) (memq tem others) (setq others (cons tem others))))
446 (setq others (nreverse others)
447 tem (/ (1- (frame-height)) (1+ (length others))))
448 (delete-other-windows)
449 (switch-to-buffer buff)
450 (or (eq menu buff)
451 (bury-buffer menu))
452 (if (equal (length others) 0)
453 (progn
454 ;;; ;; Restore previous window configuration before displaying
455 ;;; ;; selected buffers.
456 ;;; (if Buffer-menu-window-config
457 ;;; (progn
458 ;;; (set-window-configuration Buffer-menu-window-config)
459 ;;; (setq Buffer-menu-window-config nil)))
460 (switch-to-buffer buff))
461 (while others
462 (split-window nil tem)
463 (other-window 1)
464 (switch-to-buffer (car others))
465 (setq others (cdr others)))
466 (other-window 1) ;back to the beginning!
471 (defun Buffer-menu-visit-tags-table ()
472 "Visit the tags table in the buffer on this line. See `visit-tags-table'."
473 (interactive)
474 (let ((file (buffer-file-name (Buffer-menu-buffer t))))
475 (if file
476 (visit-tags-table file)
477 (error "Specified buffer has no file"))))
479 (defun Buffer-menu-1-window ()
480 "Select this line's buffer, alone, in full frame."
481 (interactive)
482 (switch-to-buffer (Buffer-menu-buffer t))
483 (bury-buffer (other-buffer))
484 (delete-other-windows))
486 (defun Buffer-menu-mouse-select (event)
487 "Select the buffer whose line you click on."
488 (interactive "e")
489 (let (buffer)
490 (save-excursion
491 (set-buffer (window-buffer (posn-window (event-end event))))
492 (save-excursion
493 (goto-char (posn-point (event-end event)))
494 (setq buffer (Buffer-menu-buffer t))))
495 (select-window (posn-window (event-end event)))
496 (if (and (window-dedicated-p (selected-window))
497 (eq (selected-window) (frame-root-window)))
498 (switch-to-buffer-other-frame buffer)
499 (switch-to-buffer buffer))))
501 (defun Buffer-menu-this-window ()
502 "Select this line's buffer in this window."
503 (interactive)
504 (switch-to-buffer (Buffer-menu-buffer t)))
506 (defun Buffer-menu-other-window ()
507 "Select this line's buffer in other window, leaving buffer menu visible."
508 (interactive)
509 (switch-to-buffer-other-window (Buffer-menu-buffer t)))
511 (defun Buffer-menu-switch-other-window ()
512 "Make the other window select this line's buffer.
513 The current window remains selected."
514 (interactive)
515 (let ((pop-up-windows t)
516 same-window-buffer-names
517 same-window-regexps)
518 (display-buffer (Buffer-menu-buffer t))))
520 (defun Buffer-menu-2-window ()
521 "Select this line's buffer, with previous buffer in second window."
522 (interactive)
523 (let ((buff (Buffer-menu-buffer t))
524 (menu (current-buffer))
525 (pop-up-windows t)
526 same-window-buffer-names
527 same-window-regexps)
528 (delete-other-windows)
529 (switch-to-buffer (other-buffer))
530 (pop-to-buffer buff)
531 (bury-buffer menu)))
533 (defun Buffer-menu-toggle-read-only ()
534 "Toggle read-only status of buffer on this line, perhaps via version control."
535 (interactive)
536 (let (char)
537 (save-excursion
538 (set-buffer (Buffer-menu-buffer t))
539 (vc-toggle-read-only)
540 (setq char (if buffer-read-only ?% ?\s)))
541 (save-excursion
542 (beginning-of-line)
543 (forward-char 1)
544 (if (/= (following-char) char)
545 (let (buffer-read-only)
546 (delete-char 1)
547 (insert char))))))
549 (defun Buffer-menu-bury ()
550 "Bury the buffer listed on this line."
551 (interactive)
552 (when (Buffer-menu-no-header)
553 (save-excursion
554 (beginning-of-line)
555 (bury-buffer (Buffer-menu-buffer t))
556 (let ((line (buffer-substring (point) (progn (forward-line 1) (point))))
557 (buffer-read-only nil))
558 (delete-region (point) (progn (forward-line -1) (point)))
559 (goto-char (point-max))
560 (insert line))
561 (message "Buried buffer moved to the end"))))
564 (defun Buffer-menu-view ()
565 "View this line's buffer in View mode."
566 (interactive)
567 (view-buffer (Buffer-menu-buffer t)))
570 (defun Buffer-menu-view-other-window ()
571 "View this line's buffer in View mode in another window."
572 (interactive)
573 (view-buffer-other-window (Buffer-menu-buffer t)))
576 (define-key ctl-x-map "\C-b" 'list-buffers)
578 (defun list-buffers (&optional files-only)
579 "Display a list of names of existing buffers.
580 The list is displayed in a buffer named `*Buffer List*'.
581 Note that buffers with names starting with spaces are omitted.
582 Non-null optional arg FILES-ONLY means mention only file buffers.
584 For more information, see the function `buffer-menu'."
585 (interactive "P")
586 (display-buffer (list-buffers-noselect files-only)))
588 (defun Buffer-menu-buffer+size (name size &optional name-props size-props)
589 (if (> (+ (length name) (length size) 2) Buffer-menu-buffer+size-width)
590 (setq name
591 (if (string-match "<[0-9]+>$" name)
592 (concat (substring name 0
593 (- Buffer-menu-buffer+size-width
594 (max (length size) 3)
595 (match-end 0)
596 (- (match-beginning 0))
598 ":" ; narrow ellipsis
599 (match-string 0 name))
600 (concat (substring name 0
601 (- Buffer-menu-buffer+size-width
602 (max (length size) 3)
604 ":"))) ; narrow ellipsis
605 ;; Don't put properties on (buffer-name).
606 (setq name (copy-sequence name)))
607 (add-text-properties 0 (length name) name-props name)
608 (add-text-properties 0 (length size) size-props size)
609 (concat name
610 (make-string (- Buffer-menu-buffer+size-width
611 (length name)
612 (length size))
613 ?\s)
614 size))
616 (defun Buffer-menu-sort (column)
617 "Sort the buffer menu by COLUMN."
618 (interactive "P")
619 (when column
620 (setq column (prefix-numeric-value column))
621 (if (< column 2) (setq column 2))
622 (if (> column 5) (setq column 5)))
623 (setq Buffer-menu-sort-column column)
624 (let (buffer-read-only l buf m1 m2)
625 (save-excursion
626 (Buffer-menu-beginning)
627 (while (not (eobp))
628 (when (buffer-live-p (setq buf (get-text-property (+ (point) 4) 'buffer)))
629 (setq m1 (char-after)
630 m1 (if (memq m1 '(?> ?D)) m1)
631 m2 (char-after (+ (point) 2))
632 m2 (if (eq m2 ?S) m2))
633 (if (or m1 m2)
634 (push (list buf m1 m2) l)))
635 (forward-line)))
636 (Buffer-menu-revert)
637 (setq buffer-read-only)
638 (save-excursion
639 (Buffer-menu-beginning)
640 (while (not (eobp))
641 (when (setq buf (assq (get-text-property (+ (point) 4) 'buffer) l))
642 (setq m1 (cadr buf)
643 m2 (cadr (cdr buf)))
644 (when m1
645 (delete-char 1)
646 (insert m1)
647 (backward-char 1))
648 (when m2
649 (forward-char 2)
650 (delete-char 1)
651 (insert m2)))
652 (forward-line)))))
654 (defun Buffer-menu-sort-by-column (&optional e)
655 "Sort the buffer menu by the column clicked on."
656 (interactive (list last-input-event))
657 (if e (mouse-select-window e))
658 (let* ((pos (event-start e))
659 (obj (posn-object pos))
660 (col (if obj
661 (get-text-property (cdr obj) 'column (car obj))
662 (get-text-property (posn-point pos) 'column))))
663 (Buffer-menu-sort col)))
665 (defvar Buffer-menu-sort-button-map
666 (let ((map (make-sparse-keymap)))
667 ;; This keymap handles both nil and non-nil values for
668 ;; Buffer-menu-use-header-line.
669 (define-key map [header-line mouse-1] 'Buffer-menu-sort-by-column)
670 (define-key map [header-line mouse-2] 'Buffer-menu-sort-by-column)
671 (define-key map [mouse-2] 'Buffer-menu-sort-by-column)
672 (define-key map [follow-link] 'mouse-face)
673 (define-key map "\C-m" 'Buffer-menu-sort-by-column)
674 map)
675 "Local keymap for Buffer menu sort buttons.")
677 (defun Buffer-menu-make-sort-button (name column)
678 (if (equal column Buffer-menu-sort-column) (setq column nil))
679 (propertize name
680 'column column
681 'help-echo (concat
682 (if Buffer-menu-use-header-line
683 "mouse-1, mouse-2: sort by "
684 "mouse-2, RET: sort by ")
685 (if column (downcase name) "visited order"))
686 'mouse-face 'highlight
687 'keymap Buffer-menu-sort-button-map))
689 (defun list-buffers-noselect (&optional files-only buffer-list)
690 "Create and return a buffer with a list of names of existing buffers.
691 The buffer is named `*Buffer List*'.
692 Note that buffers with names starting with spaces are omitted.
693 Non-null optional arg FILES-ONLY means mention only file buffers.
695 If BUFFER-LIST is non-nil, it should be a list of buffers;
696 it means list those buffers and no others.
698 For more information, see the function `buffer-menu'."
699 (let* ((old-buffer (current-buffer))
700 (standard-output standard-output)
701 (mode-end (make-string (- Buffer-menu-mode-width 2) ?\s))
702 (header (concat "CRM "
703 (Buffer-menu-buffer+size
704 (Buffer-menu-make-sort-button "Buffer" 2)
705 (Buffer-menu-make-sort-button "Size" 3))
707 (Buffer-menu-make-sort-button "Mode" 4) mode-end
708 (Buffer-menu-make-sort-button "File" 5) "\n"))
709 list desired-point)
710 (when Buffer-menu-use-header-line
711 (let ((pos 0))
712 ;; Turn whitespace chars in the header into stretch specs so
713 ;; they work regardless of the header-line face.
714 (while (string-match "[ \t\n]+" header pos)
715 (setq pos (match-end 0))
716 (put-text-property (match-beginning 0) pos 'display
717 ;; Assume fixed-size chars in the buffer.
718 (list 'space :align-to pos)
719 header)))
720 ;; Try to better align the one-char headers.
721 (put-text-property 0 3 'face 'fixed-pitch header)
722 ;; Add a "dummy" leading space to align the beginning of the header
723 ;; line with the beginning of the text (rather than with the left
724 ;; scrollbar or the left fringe). –-Stef
725 (setq header (concat (propertize " " 'display '(space :align-to 0))
726 header)))
727 (with-current-buffer (get-buffer-create "*Buffer List*")
728 (setq buffer-read-only nil)
729 (erase-buffer)
730 (setq standard-output (current-buffer))
731 (unless Buffer-menu-use-header-line
732 ;; Use U+2014 (EM DASH) to underline if possible, else U+002D (HYPHEN-MINUS)
733 (let ((underline (if (char-displayable-p ?—) ?— ?-)))
734 (insert header
735 (apply 'string
736 (mapcar (lambda (c)
737 (if (memq c '(?\n ?\s)) c underline))
738 header)))))
739 ;; Collect info for every buffer we're interested in.
740 (dolist (buffer (or buffer-list
741 (buffer-list
742 (when Buffer-menu-use-frame-buffer-list
743 (selected-frame)))))
744 (with-current-buffer buffer
745 (let ((name (buffer-name))
746 (file buffer-file-name))
747 (unless (and (not buffer-list)
749 ;; Don't mention internal buffers.
750 (and (string= (substring name 0 1) " ") (null file))
751 ;; Maybe don't mention buffers without files.
752 (and files-only (not file))
753 (string= name "*Buffer List*")))
754 ;; Otherwise output info.
755 (let ((mode (concat (format-mode-line mode-name nil nil buffer)
756 (if mode-line-process
757 (format-mode-line mode-line-process
758 nil nil buffer))))
759 (bits (string
760 (if (eq buffer old-buffer) ?. ?\s)
761 ;; Handle readonly status. The output buffer
762 ;; is special cased to appear readonly; it is
763 ;; actually made so at a later date.
764 (if (or (eq buffer standard-output)
765 buffer-read-only)
766 ?% ?\s)
767 ;; Identify modified buffers.
768 (if (buffer-modified-p) ?* ?\s)
769 ;; Space separator.
770 ?\s)))
771 (unless file
772 ;; No visited file. Check local value of
773 ;; list-buffers-directory and, for Info buffers,
774 ;; Info-current-file.
775 (cond ((and (boundp 'list-buffers-directory)
776 list-buffers-directory)
777 (setq file list-buffers-directory))
778 ((eq major-mode 'Info-mode)
779 (setq file Info-current-file)
780 (cond
781 ((equal file "dir")
782 (setq file "*Info Directory*"))
783 ((eq file 'apropos)
784 (setq file "*Info Apropos*"))
785 ((eq file 'history)
786 (setq file "*Info History*"))
787 ((eq file 'toc)
788 (setq file "*Info TOC*"))
789 ((not (stringp file)) ;; avoid errors
790 (setq file nil))
792 (setq file (concat "("
793 (file-name-nondirectory file)
795 Info-current-node)))))))
796 (push (list buffer bits name (buffer-size) mode file)
797 list))))))
798 ;; Preserve the original buffer-list ordering, just in case.
799 (setq list (nreverse list))
800 ;; Place the buffers's info in the output buffer, sorted if necessary.
801 (dolist (buffer
802 (if Buffer-menu-sort-column
803 (sort list
804 (if (eq Buffer-menu-sort-column 3)
805 (lambda (a b)
806 (< (nth Buffer-menu-sort-column a)
807 (nth Buffer-menu-sort-column b)))
808 (lambda (a b)
809 (string< (nth Buffer-menu-sort-column a)
810 (nth Buffer-menu-sort-column b)))))
811 list))
812 (if (eq (car buffer) old-buffer)
813 (setq desired-point (point)))
814 (insert (cadr buffer)
815 ;; Put the buffer name into a text property
816 ;; so we don't have to extract it from the text.
817 ;; This way we avoid problems with unusual buffer names.
818 (Buffer-menu-buffer+size (nth 2 buffer)
819 (int-to-string (nth 3 buffer))
820 `(buffer-name ,(nth 2 buffer)
821 buffer ,(car buffer)
822 font-lock-face buffer-menu-buffer
823 mouse-face highlight
824 help-echo "mouse-2: select this buffer"))
826 (if (> (length (nth 4 buffer)) Buffer-menu-mode-width)
827 (substring (nth 4 buffer) 0 Buffer-menu-mode-width)
828 (nth 4 buffer)))
829 (when (nth 5 buffer)
830 (indent-to (+ Buffer-menu-buffer-column Buffer-menu-buffer+size-width
831 Buffer-menu-mode-width 4) 1)
832 (princ (abbreviate-file-name (nth 5 buffer))))
833 (princ "\n"))
834 (Buffer-menu-mode)
835 (when Buffer-menu-use-header-line
836 (setq header-line-format header))
837 ;; DESIRED-POINT doesn't have to be set; it is not when the
838 ;; current buffer is not displayed for some reason.
839 (and desired-point
840 (goto-char desired-point))
841 (setq Buffer-menu-files-only files-only)
842 (set-buffer-modified-p nil)
843 (current-buffer))))
845 ;; arch-tag: e7dfcfc9-6cb2-46e4-bf55-8ef1936d83c6
846 ;;; buff-menu.el ends here