buff-menu.el 20.7 KB
Newer Older
Eric S. Raymond's avatar
Eric S. Raymond committed
1 2
;;; buff-menu.el --- buffer menu main function and support functions.

Karl Heuer's avatar
Karl Heuer committed
3
;; Copyright (C) 1985, 86, 87, 93, 94, 95 Free Software Foundation, Inc.
Jim Blandy's avatar
Jim Blandy committed
4

Eric S. Raymond's avatar
Eric S. Raymond committed
5 6
;; Maintainer: FSF

Jim Blandy's avatar
Jim Blandy committed
7 8 9 10
;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
Roland McGrath's avatar
Roland McGrath committed
11
;; the Free Software Foundation; either version 2, or (at your option)
Jim Blandy's avatar
Jim Blandy committed
12 13 14 15 16 17 18 19
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
Erik Naggum's avatar
Erik Naggum committed
20 21 22
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
Jim Blandy's avatar
Jim Blandy committed
23

24 25 26
;;; Commentary:

;; Edit, delete, or change attributes of all currently active Emacs
27
;; buffers from a list summarizing their state.  A good way to browse
28
;; any special or scratch buffers you have loaded, since you can't find
29 30 31 32 33
;; them by filename.  The single entry point is `Buffer-menu-mode',
;; normally bound to C-x C-b.

;;; Change Log:

34 35 36
;; Buffer-menu-view: New function
;; Buffer-menu-view-other-window: New function

37 38 39 40 41 42 43 44
;; Merged by esr with recent mods to Emacs 19 buff-menu, 23 Mar 1993
;;
;; Modified by Bob Weiner, Motorola, Inc., 4/14/89
;;
;; Added optional backup argument to 'Buffer-menu-unmark' to make it undelete
;; current entry and then move to previous one.
;;
;; Based on FSF code dating back to 1985.
45

Eric S. Raymond's avatar
Eric S. Raymond committed
46
;;; Code:
47
 
48 49 50 51 52 53 54 55 56 57 58
;;;Trying to preserve the old window configuration works well in
;;;simple scenarios, when you enter the buffer menu, use it, and exit it.
;;;But it does strange things when you switch back to the buffer list buffer
;;;with C-x b, later on, when the window configuration is different.
;;;The choice seems to be, either restore the window configuration
;;;in all cases, or in no cases.
;;;I decided it was better not to restore the window config at all. -- rms.

;;;But since then, I changed buffer-menu to use the selected window,
;;;so q now once again goes back to the previous window configuration.

59 60
;;;(defvar Buffer-menu-window-config nil
;;;  "Window configuration saved from entry to `buffer-menu'.")
Jim Blandy's avatar
Jim Blandy committed
61 62 63 64

; Put buffer *Buffer List* into proper mode right away
; so that from now on even list-buffers is enough to get a buffer menu.

65 66
(defvar Buffer-menu-buffer-column nil)

Jim Blandy's avatar
Jim Blandy committed
67 68 69 70 71 72
(defvar Buffer-menu-mode-map nil "")

(if Buffer-menu-mode-map
    ()
  (setq Buffer-menu-mode-map (make-keymap))
  (suppress-keymap Buffer-menu-mode-map t)
73
  (define-key Buffer-menu-mode-map "q" 'quit-window)
74
  (define-key Buffer-menu-mode-map "v" 'Buffer-menu-select)
Jim Blandy's avatar
Jim Blandy committed
75 76 77
  (define-key Buffer-menu-mode-map "2" 'Buffer-menu-2-window)
  (define-key Buffer-menu-mode-map "1" 'Buffer-menu-1-window)
  (define-key Buffer-menu-mode-map "f" 'Buffer-menu-this-window)
78
  (define-key Buffer-menu-mode-map "e" 'Buffer-menu-this-window)
79
  (define-key Buffer-menu-mode-map "\C-m" 'Buffer-menu-this-window)
Jim Blandy's avatar
Jim Blandy committed
80
  (define-key Buffer-menu-mode-map "o" 'Buffer-menu-other-window)
Roland McGrath's avatar
Roland McGrath committed
81
  (define-key Buffer-menu-mode-map "\C-o" 'Buffer-menu-switch-other-window)
Jim Blandy's avatar
Jim Blandy committed
82 83 84 85 86 87 88 89 90 91 92 93 94 95
  (define-key Buffer-menu-mode-map "s" 'Buffer-menu-save)
  (define-key Buffer-menu-mode-map "d" 'Buffer-menu-delete)
  (define-key Buffer-menu-mode-map "k" 'Buffer-menu-delete)
  (define-key Buffer-menu-mode-map "\C-d" 'Buffer-menu-delete-backwards)
  (define-key Buffer-menu-mode-map "\C-k" 'Buffer-menu-delete)
  (define-key Buffer-menu-mode-map "x" 'Buffer-menu-execute)
  (define-key Buffer-menu-mode-map " " 'next-line)
  (define-key Buffer-menu-mode-map "n" 'next-line)
  (define-key Buffer-menu-mode-map "p" 'previous-line)
  (define-key Buffer-menu-mode-map "\177" 'Buffer-menu-backup-unmark)
  (define-key Buffer-menu-mode-map "~" 'Buffer-menu-not-modified)
  (define-key Buffer-menu-mode-map "?" 'describe-mode)
  (define-key Buffer-menu-mode-map "u" 'Buffer-menu-unmark)
  (define-key Buffer-menu-mode-map "m" 'Buffer-menu-mark)
96 97
  (define-key Buffer-menu-mode-map "t" 'Buffer-menu-visit-tags-table)
  (define-key Buffer-menu-mode-map "%" 'Buffer-menu-toggle-read-only)
98
  (define-key Buffer-menu-mode-map "b" 'Buffer-menu-bury)
99
  (define-key Buffer-menu-mode-map "g" 'Buffer-menu-revert)
100
  (define-key Buffer-menu-mode-map "V" 'Buffer-menu-view)
101
  (define-key Buffer-menu-mode-map [mouse-2] 'Buffer-menu-mouse-select)
102
)
Jim Blandy's avatar
Jim Blandy committed
103 104 105 106 107 108 109 110 111

;; Buffer Menu mode is suitable only for specially formatted data.
(put 'Buffer-menu-mode 'mode-class 'special)

(defun Buffer-menu-mode ()
  "Major mode for editing a list of buffers.
Each line describes one of the buffers in Emacs.
Letters do not insert themselves; instead, they are commands.
\\<Buffer-menu-mode-map>
112 113 114 115
\\[Buffer-menu-mouse-select] -- select buffer you click on, in place of the buffer menu.
\\[Buffer-menu-this-window] -- select current line's buffer in place of the buffer menu.
\\[Buffer-menu-other-window] -- select that buffer in another window,
  so the buffer menu buffer remains visible in its window.
116 117 118
\\[Buffer-menu-view] -- select current line's buffer, but in view-mode.
\\[Buffer-menu-view-other-window] -- select that buffer in
  another window, in view-mode.
119 120 121 122
\\[Buffer-menu-switch-other-window] -- make another window display that buffer.
\\[Buffer-menu-mark] -- mark current line's buffer to be displayed.
\\[Buffer-menu-select] -- select current line's buffer.
  Also show buffers marked with m, in other windows.
Jim Blandy's avatar
Jim Blandy committed
123
\\[Buffer-menu-1-window] -- select that buffer in full-frame window.
Jim Blandy's avatar
Jim Blandy committed
124 125 126 127 128 129 130 131 132
\\[Buffer-menu-2-window] -- select that buffer in one window,
  together with buffer selected before this one in another window.
\\[Buffer-menu-visit-tags-table] -- visit-tags-table this buffer.
\\[Buffer-menu-not-modified] -- clear modified-flag on that buffer.
\\[Buffer-menu-save] -- mark that buffer to be saved, and move down.
\\[Buffer-menu-delete] -- mark that buffer to be deleted, and move down.
\\[Buffer-menu-delete-backwards] -- mark that buffer to be deleted, and move up.
\\[Buffer-menu-execute] -- delete or save marked buffers.
\\[Buffer-menu-unmark] -- remove all kinds of marks from current line.
133
  With prefix argument, also move up one line.
134
\\[Buffer-menu-backup-unmark] -- back up a line and remove marks.
135
\\[Buffer-menu-toggle-read-only] -- toggle read-only status of buffer on this line.
136 137
\\[Buffer-menu-revert] -- update the list of buffers.
\\[Buffer-menu-bury] -- bury the buffer listed on this line."
Jim Blandy's avatar
Jim Blandy committed
138 139 140 141
  (kill-all-local-variables)
  (use-local-map Buffer-menu-mode-map)
  (setq major-mode 'Buffer-menu-mode)
  (setq mode-name "Buffer Menu")
142 143
  (make-local-variable 'revert-buffer-function)
  (setq revert-buffer-function 'Buffer-menu-revert-function)
144 145
  (setq truncate-lines t)
  (setq buffer-read-only t)
Jim Blandy's avatar
Jim Blandy committed
146
  (run-hooks 'buffer-menu-mode-hook))
147

148 149 150 151 152
(defun Buffer-menu-revert ()
  "Update the list of buffers."
  (interactive)
  (revert-buffer))

153 154
(defun Buffer-menu-revert-function (ignore1 ignore2)
  (list-buffers))
Jim Blandy's avatar
Jim Blandy committed
155 156 157

(defun Buffer-menu-buffer (error-if-non-existent-p)
  "Return buffer described by this line of buffer menu."
158 159 160
  (let* ((where (save-excursion
		  (beginning-of-line)
		  (+ (point) Buffer-menu-buffer-column)))
161
	 (name (and (not (eobp)) (get-text-property where 'buffer-name))))
162 163 164 165 166 167 168 169
    (if name
	(or (get-buffer name)
	    (if error-if-non-existent-p
		(error "No buffer named `%s'" name)
	      nil))
      (if error-if-non-existent-p
	  (error "No buffer on this line")
	nil))))
Jim Blandy's avatar
Jim Blandy committed
170

Jim Blandy's avatar
Jim Blandy committed
171
(defun buffer-menu (&optional arg)
Jim Blandy's avatar
Jim Blandy committed
172 173 174
  "Make a menu of buffers so you can save, delete or select them.
With argument, show only buffers that are visiting files.
Type ? after invocation to get help on commands available.
175 176 177 178 179 180 181 182 183 184 185 186 187
Type q immediately to make the buffer menu go away."
  (interactive "P")
;;;  (setq Buffer-menu-window-config (current-window-configuration))
  (switch-to-buffer (list-buffers-noselect arg))
  (message
   "Commands: d, s, x, u; f, o, 1, 2, m, v; ~, %%; q to quit; ? for help."))

(defun buffer-menu-other-window (&optional arg)
  "Display a list of buffers in another window.
With the buffer list buffer, you can save, delete or select the buffers.
With argument, show only buffers that are visiting files.
Type ? after invocation to get help on commands available.
Type q immediately to make the buffer menu go away."
Jim Blandy's avatar
Jim Blandy committed
188
  (interactive "P")
189
;;;  (setq Buffer-menu-window-config (current-window-configuration))
190
  (switch-to-buffer-other-window (list-buffers-noselect arg))
Jim Blandy's avatar
Jim Blandy committed
191
  (message
192 193
   "Commands: d, s, x, u; f, o, 1, 2, m, v; ~, %%; q to quit; ? for help."))

Jim Blandy's avatar
Jim Blandy committed
194 195 196 197 198 199 200 201 202 203 204
(defun Buffer-menu-mark ()
  "Mark buffer on this line for being displayed by \\<Buffer-menu-mode-map>\\[Buffer-menu-select] command."
  (interactive)
  (beginning-of-line)
  (if (looking-at " [-M]")
      (ding)
    (let ((buffer-read-only nil))
      (delete-char 1)
      (insert ?>)
      (forward-line 1))))

205 206 207 208
(defun Buffer-menu-unmark (&optional backup)
  "Cancel all requested operations on buffer on this line and move down.
Optional ARG means move up."
  (interactive "P")
Jim Blandy's avatar
Jim Blandy committed
209 210 211 212 213 214 215 216 217
  (beginning-of-line)
  (if (looking-at " [-M]")
      (ding)
    (let* ((buf (Buffer-menu-buffer t))
	   (mod (buffer-modified-p buf))
	   (readonly (save-excursion (set-buffer buf) buffer-read-only))
	   (buffer-read-only nil))
      (delete-char 3)
      (insert (if readonly (if mod " *%" "  %") (if mod " * " "   ")))))
218
  (forward-line (if backup -1 1)))
Jim Blandy's avatar
Jim Blandy committed
219 220 221 222 223 224 225 226

(defun Buffer-menu-backup-unmark ()
  "Move up and cancel all requested operations on buffer on line above."
  (interactive)
  (forward-line -1)
  (Buffer-menu-unmark)
  (forward-line -1))

227 228 229 230 231
(defun Buffer-menu-delete (&optional arg)
  "Mark buffer on this line to be deleted by \\<Buffer-menu-mode-map>\\[Buffer-menu-execute] command.
Prefix arg is how many buffers to delete.
Negative arg means delete backwards."
  (interactive "p")
Jim Blandy's avatar
Jim Blandy committed
232 233 234 235
  (beginning-of-line)
  (if (looking-at " [-M]")		;header lines
      (ding)
    (let ((buffer-read-only nil))
236 237 238 239 240 241 242 243 244 245 246 247 248 249
      (if (or (null arg) (= arg 0))
	  (setq arg 1))
      (while (> arg 0)
	(delete-char 1)
	(insert ?D)
	(forward-line 1)
	(setq arg (1- arg)))
      (while (< arg 0)
	(delete-char 1)
	(insert ?D)
	(forward-line -1)
	(setq arg (1+ arg))))))

(defun Buffer-menu-delete-backwards (&optional arg)
Jim Blandy's avatar
Jim Blandy committed
250
  "Mark buffer on this line to be deleted by \\<Buffer-menu-mode-map>\\[Buffer-menu-execute] command
251 252 253 254 255
and then move up one line.  Prefix arg means move that many lines."
  (interactive "p")
  (Buffer-menu-delete (- (or arg 1)))
  (while (looking-at " [-M]")
    (forward-line 1)))
Jim Blandy's avatar
Jim Blandy committed
256 257 258 259 260 261 262 263

(defun Buffer-menu-save ()
  "Mark buffer on this line to be saved by \\<Buffer-menu-mode-map>\\[Buffer-menu-execute] command."
  (interactive)
  (beginning-of-line)
  (if (looking-at " [-M]")		;header lines
      (ding)
    (let ((buffer-read-only nil))
264
      (forward-char 1)
Jim Blandy's avatar
Jim Blandy committed
265 266 267 268
      (delete-char 1)
      (insert ?S)
      (forward-line 1))))

269
(defun Buffer-menu-not-modified (&optional arg)
Jim Blandy's avatar
Jim Blandy committed
270
  "Mark buffer on this line as unmodified (no changes to save)."
271
  (interactive "P")
Jim Blandy's avatar
Jim Blandy committed
272 273
  (save-excursion
    (set-buffer (Buffer-menu-buffer t))
274
    (set-buffer-modified-p arg))
Jim Blandy's avatar
Jim Blandy committed
275 276 277
  (save-excursion
   (beginning-of-line)
   (forward-char 1)
278
   (if (= (char-after (point)) (if arg ?  ?*))
Jim Blandy's avatar
Jim Blandy committed
279 280
       (let ((buffer-read-only nil))
	 (delete-char 1)
281
	 (insert (if arg ?* ? ))))))
Jim Blandy's avatar
Jim Blandy committed
282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316

(defun Buffer-menu-execute ()
  "Save and/or delete buffers marked with \\<Buffer-menu-mode-map>\\[Buffer-menu-save] or \\<Buffer-menu-mode-map>\\[Buffer-menu-delete] commands."
  (interactive)
  (save-excursion
    (goto-char (point-min))
    (forward-line 1)
    (while (re-search-forward "^.S" nil t)
      (let ((modp nil))
	(save-excursion
	  (set-buffer (Buffer-menu-buffer t))
	  (save-buffer)
	  (setq modp (buffer-modified-p)))
	(let ((buffer-read-only nil))
	  (delete-char -1)
	  (insert (if modp ?* ? ))))))
  (save-excursion
    (goto-char (point-min))
    (forward-line 1)
    (let ((buff-menu-buffer (current-buffer))
	  (buffer-read-only nil))
      (while (search-forward "\nD" nil t)
	(forward-char -1)
	(let ((buf (Buffer-menu-buffer nil)))
	  (or (eq buf nil)
	      (eq buf buff-menu-buffer)
	      (save-excursion (kill-buffer buf))))
	(if (Buffer-menu-buffer nil)
	    (progn (delete-char 1)
		   (insert ? ))
	  (delete-region (point) (progn (forward-line 1) (point)))
 	  (forward-char -1))))))

(defun Buffer-menu-select ()
  "Select this line's buffer; also display buffers marked with `>'.
317 318 319
You can mark buffers with the \\<Buffer-menu-mode-map>\\[Buffer-menu-mark] command.
This command deletes and replaces all the previously existing windows
in the selected frame."
Jim Blandy's avatar
Jim Blandy committed
320 321 322 323 324 325 326 327 328 329 330 331 332
  (interactive)
  (let ((buff (Buffer-menu-buffer t))
	(menu (current-buffer))	      
	(others ())
	tem)
    (goto-char (point-min))
    (while (search-forward "\n>" nil t)
      (setq tem (Buffer-menu-buffer t))
      (let ((buffer-read-only nil))
	(delete-char -1)
	(insert ?\ ))
      (or (eq tem buff) (memq tem others) (setq others (cons tem others))))
    (setq others (nreverse others)
Jim Blandy's avatar
Jim Blandy committed
333
	  tem (/ (1- (frame-height)) (1+ (length others))))
Jim Blandy's avatar
Jim Blandy committed
334 335 336 337
    (delete-other-windows)
    (switch-to-buffer buff)
    (or (eq menu buff)
	(bury-buffer menu))
338 339
    (if (equal (length others) 0)
	(progn
340 341 342 343 344 345
;;;	  ;; Restore previous window configuration before displaying
;;;	  ;; selected buffers.
;;;	  (if Buffer-menu-window-config
;;;	      (progn
;;;		(set-window-configuration Buffer-menu-window-config)
;;;		(setq Buffer-menu-window-config nil)))
346 347 348 349 350 351 352 353 354
	  (switch-to-buffer buff))
      (while others
	(split-window nil tem)
	(other-window 1)
	(switch-to-buffer (car others))
	(setq others (cdr others)))
      (other-window 1)  			;back to the beginning!
)))

355

Jim Blandy's avatar
Jim Blandy committed
356 357 358 359 360 361 362 363 364 365

(defun Buffer-menu-visit-tags-table ()
  "Visit the tags table in the buffer on this line.  See `visit-tags-table'."
  (interactive)
  (let ((file (buffer-file-name (Buffer-menu-buffer t))))
    (if file
	(visit-tags-table file)
      (error "Specified buffer has no file"))))

(defun Buffer-menu-1-window ()
Jim Blandy's avatar
Jim Blandy committed
366
  "Select this line's buffer, alone, in full frame."
Jim Blandy's avatar
Jim Blandy committed
367 368 369 370 371
  (interactive)
  (switch-to-buffer (Buffer-menu-buffer t))
  (bury-buffer (other-buffer))
  (delete-other-windows))

372 373 374 375 376 377 378 379 380 381
(defun Buffer-menu-mouse-select (event)
  "Select the buffer whose line you click on."
  (interactive "e")
  (let (buffer)
    (save-excursion
      (set-buffer (window-buffer (posn-window (event-end event))))
      (save-excursion
	(goto-char (posn-point (event-end event)))
	(setq buffer (Buffer-menu-buffer t))))
    (select-window (posn-window (event-end event)))
382 383 384 385
    (if (and (window-dedicated-p (selected-window))
	     (eq (selected-window) (frame-root-window)))
	(switch-to-buffer-other-frame buffer)
      (switch-to-buffer buffer))))
386

Jim Blandy's avatar
Jim Blandy committed
387 388 389 390 391 392 393 394 395 396
(defun Buffer-menu-this-window ()
  "Select this line's buffer in this window."
  (interactive)
  (switch-to-buffer (Buffer-menu-buffer t)))

(defun Buffer-menu-other-window ()
  "Select this line's buffer in other window, leaving buffer menu visible."
  (interactive)
  (switch-to-buffer-other-window (Buffer-menu-buffer t)))

Roland McGrath's avatar
Roland McGrath committed
397 398 399 400 401 402
(defun Buffer-menu-switch-other-window ()
  "Make the other window select this line's buffer.
The current window remains selected."
  (interactive)
  (display-buffer (Buffer-menu-buffer t)))

Jim Blandy's avatar
Jim Blandy committed
403 404 405 406 407 408
(defun Buffer-menu-2-window ()
  "Select this line's buffer, with previous buffer in second window."
  (interactive)
  (let ((buff (Buffer-menu-buffer t))
	(menu (current-buffer))
	(pop-up-windows t))
409
    (delete-other-windows)
Jim Blandy's avatar
Jim Blandy committed
410 411 412
    (switch-to-buffer (other-buffer))
    (pop-to-buffer buff)
    (bury-buffer menu)))
Eric S. Raymond's avatar
Eric S. Raymond committed
413

414
(defun Buffer-menu-toggle-read-only ()
415
  "Toggle read-only status of buffer on this line, perhaps via version control."
416 417 418 419
  (interactive)
  (let (char)
    (save-excursion
      (set-buffer (Buffer-menu-buffer t))
420
      (vc-toggle-read-only)
421 422 423 424 425 426 427 428 429
      (setq char (if buffer-read-only ?% ? )))
    (save-excursion
      (beginning-of-line)
      (forward-char 2)
      (if (/= (following-char) char)
          (let (buffer-read-only)
            (delete-char 1)
            (insert char))))))

430 431 432
(defun Buffer-menu-bury ()
  "Bury the buffer listed on this line."
  (interactive)
433 434 435 436 437 438 439 440 441 442 443 444
  (beginning-of-line)
  (if (looking-at " [-M]")		;header lines
      (ding)
    (save-excursion
      (beginning-of-line)
      (bury-buffer (Buffer-menu-buffer t))
      (let ((line (buffer-substring (point) (progn (forward-line 1) (point))))
            (buffer-read-only nil))
        (delete-region (point) (progn (forward-line -1) (point)))
        (goto-char (point-max))
        (insert line))
      (message "Buried buffer moved to the end"))))
445 446 447 448 449 450 451 452 453 454 455 456


(defun Buffer-menu-view ()
  "View this line's buffer in View mode."
  (interactive)
  (view-buffer (Buffer-menu-buffer t)))


(defun Buffer-menu-view-other-window ()
  "View this line's buffer in View mode in another window."
  (interactive)
  (view-buffer-other-window (Buffer-menu-buffer t)))
457 458 459 460 461 462 463 464 465 466 467 468 469


(define-key ctl-x-map "\C-b" 'list-buffers)

(defun list-buffers (&optional files-only)
  "Display a list of names of existing buffers.
The list is displayed in a buffer named `*Buffer List*'.
Note that buffers with names starting with spaces are omitted.
Non-null optional arg FILES-ONLY means mention only file buffers.

The M column contains a * for buffers that are modified.
The R column contains a % for buffers that are read-only."
  (interactive "P")
470 471 472 473 474 475 476 477 478 479
  (display-buffer (list-buffers-noselect files-only)))

(defun list-buffers-noselect (&optional files-only)
  "Create and return a buffer with a list of names of existing buffers.
The buffer is named `*Buffer List*'.
Note that buffers with names starting with spaces are omitted.
Non-null optional arg FILES-ONLY means mention only file buffers.

The M column contains a * for buffers that are modified.
The R column contains a % for buffers that are read-only."
480
  (let ((old-buffer (current-buffer))
481 482 483 484 485 486 487
	(standard-output standard-output)
	desired-point)
    (save-excursion
      (set-buffer (get-buffer-create "*Buffer List*"))
      (setq buffer-read-only nil)
      (erase-buffer)
      (setq standard-output (current-buffer))
488 489 490 491
      (princ "\
 MR Buffer           Size  Mode         File
 -- ------           ----  ----         ----
")
492 493
      ;; Record the column where buffer names start.
      (setq Buffer-menu-buffer-column 4)
494 495 496 497
      (let ((bl (buffer-list)))
	(while bl
	  (let* ((buffer (car bl))
		 (name (buffer-name buffer))
498
		 (file (buffer-file-name buffer))
499
		 this-buffer-line-start
500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516
		 this-buffer-read-only
		 this-buffer-size
		 this-buffer-mode-name
		 this-buffer-directory)
	    (save-excursion
	      (set-buffer buffer)
	      (setq this-buffer-read-only buffer-read-only)
	      (setq this-buffer-size (buffer-size))
	      (setq this-buffer-mode-name
		    (if (eq buffer standard-output)
			"Buffer Menu" mode-name))
	      (or file
		  ;; No visited file.  Check local value of
		  ;; list-buffers-directory.
		  (if (and (boundp 'list-buffers-directory)
			   list-buffers-directory)
		      (setq this-buffer-directory list-buffers-directory))))
517 518 519 520 521 522 523
	    (cond
	     ;; Don't mention internal buffers.
	     ((string= (substring name 0 1) " "))
	     ;; Maybe don't mention buffers without files.
	     ((and files-only (not file)))
	     ;; Otherwise output info.
	     (t
524
	      (setq this-buffer-line-start (point))
525 526 527 528 529 530 531 532 533
	      ;; Identify current buffer.
	      (if (eq buffer old-buffer)
		  (progn
		    (setq desired-point (point))
		    (princ "."))
		(princ " "))
	      ;; Identify modified buffers.
	      (princ (if (buffer-modified-p buffer) "*" " "))
	      ;; Handle readonly status.  The output buffer is special
534
	      ;; cased to appear readonly; it is actually made so at a later
535
	      ;; date.
536 537
	      (princ (if (or (eq buffer standard-output)
			     this-buffer-read-only)
538 539 540
			 "% "
		       "  "))
	      (princ name)
541 542 543 544 545
	      ;; Put the buffer name into a text property
	      ;; so we don't have to extract it from the text.
	      ;; This way we avoid problems with unusual buffer names.
	      (setq this-buffer-line-start
		    (+ this-buffer-line-start Buffer-menu-buffer-column))
546 547 548 549 550 551
	      (let ((name-end (point)))
		(indent-to 17 2)
		(put-text-property this-buffer-line-start name-end
				   'buffer-name name)
		(put-text-property this-buffer-line-start name-end
				   'mouse-face 'highlight))
552 553 554
	      (let (size
		    mode
		    (excess (- (current-column) 17)))
555 556 557 558 559 560 561 562
		(setq size (format "%8d" this-buffer-size))
		;; Ack -- if looking at the *Buffer List* buffer,
		;; always use "Buffer Menu" mode.  Otherwise the
		;; first time the buffer is created, the mode will be wrong.
		(setq mode this-buffer-mode-name)
		(while (and (> excess 0) (= (aref size 0) ?\ ))
		  (setq size (substring size 1))
		  (setq excess (1- excess)))
563 564 565 566
		(princ size)
		(indent-to 27 1)
		(princ mode))
	      (indent-to 40 1)
567
	      (or file (setq file this-buffer-directory))
568
	      (if file
569
		  (princ (abbreviate-file-name file)))
570
	      (princ "\n"))))
571
	  (setq bl (cdr bl))))
572
      (Buffer-menu-mode)
573 574
      ;; DESIRED-POINT doesn't have to be set; it is not when the
      ;; current buffer is not displayed for some reason.
575
      (and desired-point
576 577
	   (goto-char desired-point))
      (current-buffer))))
578

Eric S. Raymond's avatar
Eric S. Raymond committed
579
;;; buff-menu.el ends here