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

3
;; Copyright (C) 1985, 86, 87, 93, 94, 95, 2000, 2001, 2002, 03, 2004
Gerd Moellmann's avatar
Gerd Moellmann committed
4
;;   Free Software Foundation, Inc.
Jim Blandy's avatar
Jim Blandy committed
5

Eric S. Raymond's avatar
Eric S. Raymond committed
6
;; Maintainer: FSF
Gerd Moellmann's avatar
Gerd Moellmann committed
7
;; Keywords: convenience
Eric S. Raymond's avatar
Eric S. Raymond committed
8

Jim Blandy's avatar
Jim Blandy committed
9 10 11 12
;; 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
13
;; the Free Software Foundation; either version 2, or (at your option)
Jim Blandy's avatar
Jim Blandy committed
14 15 16 17 18 19 20 21
;; 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
22 23 24
;; 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
25

26 27 28
;;; Commentary:

;; 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
Gerd Moellmann's avatar
Gerd Moellmann committed
31
;; them by filename.  The single entry point is `list-buffers',
32 33 34 35
;; normally bound to C-x C-b.

;;; Change Log:

36 37 38
;; Buffer-menu-view: New function
;; Buffer-menu-view-other-window: New function

39 40 41 42 43 44 45 46
;; 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.
47

Eric S. Raymond's avatar
Eric S. Raymond committed
48
;;; Code:
49

50 51 52 53 54 55 56
;;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.
57

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

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

64 65
;; Put buffer *Buffer List* into proper mode right away
;; so that from now on even list-buffers is enough to get a buffer menu.
Jim Blandy's avatar
Jim Blandy committed
66

67 68 69 70 71 72 73 74 75 76 77 78 79 80 81
(defgroup Buffer-menu nil
  "Show a menu of all buffers in a buffer."
  :group 'tools
  :group 'convenience)

(defcustom Buffer-menu-use-header-line t
  "*Non-nil means to use an immovable header-line."
  :type 'boolean
  :group 'Buffer-menu)

(defface Buffer-menu-buffer-face
  '((t (:weight bold)))
  "Face used to highlight buffer name."
  :group 'font-lock-highlighting-faces)

82
(defcustom Buffer-menu-buffer+size-width 26
83 84 85 86
  "*How wide to jointly make the buffer name and size columns."
  :type 'number
  :group 'Buffer-menu)

87
(defcustom Buffer-menu-mode-width 16
88 89 90 91
  "*How wide to make the mode name column."
  :type 'number
  :group 'Buffer-menu)

92
;; This should get updated & resorted when you click on a column heading
93 94 95 96 97
(defvar Buffer-menu-sort-column nil
  "*2 for sorting by buffer names.  5 for sorting by file names.
nil for default sorting by visited order.")

(defconst Buffer-menu-buffer-column 4)
98

99 100
(defvar Buffer-menu-mode-map nil
  "Local keymap for `Buffer-menu-mode' buffers.")
Jim Blandy's avatar
Jim Blandy committed
101

102 103 104 105 106 107 108 109
(defvar Buffer-menu-files-only nil
  "Non-nil if the current buffer-menu lists only file buffers.
This variable determines whether reverting the buffer lists only
file buffers.  It affects both manual reverting and reverting by
Auto Revert Mode.")

(make-variable-buffer-local 'Buffer-menu-files-only)

Jim Blandy's avatar
Jim Blandy committed
110 111 112 113
(if Buffer-menu-mode-map
    ()
  (setq Buffer-menu-mode-map (make-keymap))
  (suppress-keymap Buffer-menu-mode-map t)
114
  (define-key Buffer-menu-mode-map "q" 'quit-window)
115
  (define-key Buffer-menu-mode-map "v" 'Buffer-menu-select)
Jim Blandy's avatar
Jim Blandy committed
116 117 118
  (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)
119
  (define-key Buffer-menu-mode-map "e" 'Buffer-menu-this-window)
120
  (define-key Buffer-menu-mode-map "\C-m" 'Buffer-menu-this-window)
Jim Blandy's avatar
Jim Blandy committed
121
  (define-key Buffer-menu-mode-map "o" 'Buffer-menu-other-window)
Roland McGrath's avatar
Roland McGrath committed
122
  (define-key Buffer-menu-mode-map "\C-o" 'Buffer-menu-switch-other-window)
Jim Blandy's avatar
Jim Blandy committed
123 124 125 126 127 128 129 130 131 132 133 134 135 136
  (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)
137 138
  (define-key Buffer-menu-mode-map "t" 'Buffer-menu-visit-tags-table)
  (define-key Buffer-menu-mode-map "%" 'Buffer-menu-toggle-read-only)
139
  (define-key Buffer-menu-mode-map "b" 'Buffer-menu-bury)
140
  (define-key Buffer-menu-mode-map "g" 'Buffer-menu-revert)
141
  (define-key Buffer-menu-mode-map "V" 'Buffer-menu-view)
142
  (define-key Buffer-menu-mode-map "T" 'Buffer-menu-toggle-files-only)
143
  (define-key Buffer-menu-mode-map [mouse-2] 'Buffer-menu-mouse-select)
144
)
Jim Blandy's avatar
Jim Blandy committed
145 146 147 148 149 150 151 152 153

;; 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>
154 155 156 157
\\[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.
158 159 160
\\[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.
161 162 163 164
\\[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
165
\\[Buffer-menu-1-window] -- select that buffer in full-frame window.
Jim Blandy's avatar
Jim Blandy committed
166 167 168 169 170 171 172 173 174
\\[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.
175
  With prefix argument, also move up one line.
176
\\[Buffer-menu-backup-unmark] -- back up a line and remove marks.
177
\\[Buffer-menu-toggle-read-only] -- toggle read-only status of buffer on this line.
178
\\[Buffer-menu-revert] -- update the list of buffers.
179
\\[Buffer-menu-toggle-files-only] -- toggle whether the menu displays only file buffers.
180
\\[Buffer-menu-bury] -- bury the buffer listed on this line."
Jim Blandy's avatar
Jim Blandy committed
181 182 183 184
  (kill-all-local-variables)
  (use-local-map Buffer-menu-mode-map)
  (setq major-mode 'Buffer-menu-mode)
  (setq mode-name "Buffer Menu")
185 186 187
  (set (make-local-variable 'revert-buffer-function)
       'Buffer-menu-revert-function)
  (set (make-local-variable 'buffer-stale-function)
188
       #'(lambda (&optional noconfirm) 'fast))
189 190
  (setq truncate-lines t)
  (setq buffer-read-only t)
Jim Blandy's avatar
Jim Blandy committed
191
  (run-hooks 'buffer-menu-mode-hook))
192

193 194 195 196 197
(defun Buffer-menu-revert ()
  "Update the list of buffers."
  (interactive)
  (revert-buffer))

198
(defun Buffer-menu-revert-function (ignore1 ignore2)
199
  ;; We can not use save-excursion here.  The buffer gets erased.
200 201 202 203
  (let ((ocol (current-column))
	(oline (progn (move-to-column 4)
		      (get-text-property (point) 'buffer)))
	(prop (point-min)))
204
    (list-buffers-noselect Buffer-menu-files-only)
205 206 207 208
    (while (setq prop (next-single-property-change prop 'buffer))
      (when (eq (get-text-property prop 'buffer) oline)
	(goto-char prop)
	(move-to-column ocol)))))
209 210 211 212 213 214 215 216 217 218 219

(defun Buffer-menu-toggle-files-only (arg)
  "Toggle whether the current buffer-menu displays only file buffers.
With a positive ARG display only file buffers.  With zero or
negative ARG, display other buffers as well."
  (interactive "P")
  (setq Buffer-menu-files-only
	(cond ((not arg) (not Buffer-menu-files-only))
	      ((> (prefix-numeric-value arg) 0) t)))
  (revert-buffer))

Jim Blandy's avatar
Jim Blandy committed
220 221 222

(defun Buffer-menu-buffer (error-if-non-existent-p)
  "Return buffer described by this line of buffer menu."
223 224 225
  (let* ((where (save-excursion
		  (beginning-of-line)
		  (+ (point) Buffer-menu-buffer-column)))
226 227
	 (name (and (not (eobp)) (get-text-property where 'buffer-name)))
	 (buf (and (not (eobp)) (get-text-property where 'buffer))))
228 229
    (if name
	(or (get-buffer name)
230
	    (and buf (buffer-name buf) buf)
231 232 233
	    (if error-if-non-existent-p
		(error "No buffer named `%s'" name)
	      nil))
234
      (or (and buf (buffer-name buf) buf)
235 236
	  (if error-if-non-existent-p
	      (error "No buffer on this line")
237
	    nil)))))
Jim Blandy's avatar
Jim Blandy committed
238

Jim Blandy's avatar
Jim Blandy committed
239
(defun buffer-menu (&optional arg)
Jim Blandy's avatar
Jim Blandy committed
240 241 242
  "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.
Richard M. Stallman's avatar
Richard M. Stallman committed
243 244 245 246 247 248
Type q to remove the buffer menu from the display.

The first column shows `>' for a buffer you have
marked to be displayed, `D' for one you have marked for
deletion, and `.' for the current buffer.

249 250
The C column has a `.' for the buffer from which you came.
The R column has a `%' if the buffer is read-only.
Richard M. Stallman's avatar
Richard M. Stallman committed
251 252 253 254
The M column has a `*' if it is modified,
or `S' if you have marked it for saving.
After this come the buffer name, its size in characters,
its major mode, and the visited file name (if any)."
255 256 257 258 259 260 261 262 263 264 265
  (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.
Richard M. Stallman's avatar
Richard M. Stallman committed
266 267
Type q to remove the buffer menu from the display.
For more information, see the function `buffer-menu'."
Jim Blandy's avatar
Jim Blandy committed
268
  (interactive "P")
269
;;;  (setq Buffer-menu-window-config (current-window-configuration))
270
  (switch-to-buffer-other-window (list-buffers-noselect arg))
Jim Blandy's avatar
Jim Blandy committed
271
  (message
272 273
   "Commands: d, s, x, u; f, o, 1, 2, m, v; ~, %%; q to quit; ? for help."))

274 275 276 277 278 279 280 281 282
(defun Buffer-menu-no-header ()
  (beginning-of-line)
  (if (or Buffer-menu-use-header-line
	  (not (eq (char-after) ?C)))
      t
    (ding)
    (forward-line 1)
    nil))

Jim Blandy's avatar
Jim Blandy committed
283 284 285
(defun Buffer-menu-mark ()
  "Mark buffer on this line for being displayed by \\<Buffer-menu-mode-map>\\[Buffer-menu-select] command."
  (interactive)
286
  (when (Buffer-menu-no-header)
Jim Blandy's avatar
Jim Blandy committed
287 288 289 290 291
    (let ((buffer-read-only nil))
      (delete-char 1)
      (insert ?>)
      (forward-line 1))))

292 293 294 295
(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")
296
  (when (Buffer-menu-no-header)
Jim Blandy's avatar
Jim Blandy committed
297 298 299 300 301
    (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)
302
      (insert (if readonly (if mod " %*" " % ") (if mod "  *" "   ")))))
303
  (forward-line (if backup -1 1)))
Jim Blandy's avatar
Jim Blandy committed
304 305 306 307 308 309 310 311

(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))

312 313 314 315 316
(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")
317
  (when (Buffer-menu-no-header)
Jim Blandy's avatar
Jim Blandy committed
318
    (let ((buffer-read-only nil))
319 320 321 322 323 324 325
      (if (or (null arg) (= arg 0))
	  (setq arg 1))
      (while (> arg 0)
	(delete-char 1)
	(insert ?D)
	(forward-line 1)
	(setq arg (1- arg)))
326 327
      (while (and (< arg 0)
		  (Buffer-menu-no-header))
328 329 330 331 332 333
	(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
334
  "Mark buffer on this line to be deleted by \\<Buffer-menu-mode-map>\\[Buffer-menu-execute] command
335 336
and then move up one line.  Prefix arg means move that many lines."
  (interactive "p")
337
  (Buffer-menu-delete (- (or arg 1))))
Jim Blandy's avatar
Jim Blandy committed
338 339 340 341

(defun Buffer-menu-save ()
  "Mark buffer on this line to be saved by \\<Buffer-menu-mode-map>\\[Buffer-menu-execute] command."
  (interactive)
342
  (when (Buffer-menu-no-header)
Jim Blandy's avatar
Jim Blandy committed
343
    (let ((buffer-read-only nil))
344
      (forward-char 2)
Jim Blandy's avatar
Jim Blandy committed
345 346 347 348
      (delete-char 1)
      (insert ?S)
      (forward-line 1))))

349
(defun Buffer-menu-not-modified (&optional arg)
Jim Blandy's avatar
Jim Blandy committed
350
  "Mark buffer on this line as unmodified (no changes to save)."
351
  (interactive "P")
Jim Blandy's avatar
Jim Blandy committed
352 353
  (save-excursion
    (set-buffer (Buffer-menu-buffer t))
354
    (set-buffer-modified-p arg))
Jim Blandy's avatar
Jim Blandy committed
355 356
  (save-excursion
   (beginning-of-line)
357 358
   (forward-char 2)
   (if (= (char-after) (if arg ?  ?*))
Jim Blandy's avatar
Jim Blandy committed
359 360
       (let ((buffer-read-only nil))
	 (delete-char 1)
361
	 (insert (if arg ?* ? ))))))
Jim Blandy's avatar
Jim Blandy committed
362

363 364 365 366 367
(defun Buffer-menu-beginning ()
  (goto-char (point-min))
  (unless Buffer-menu-use-header-line
    (forward-line)))

Jim Blandy's avatar
Jim Blandy committed
368 369 370 371
(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
372
    (Buffer-menu-beginning)
373
    (while (re-search-forward "^..S" nil t)
Jim Blandy's avatar
Jim Blandy committed
374 375 376 377 378 379 380 381 382
      (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
383
    (Buffer-menu-beginning)
Jim Blandy's avatar
Jim Blandy committed
384 385
    (let ((buff-menu-buffer (current-buffer))
	  (buffer-read-only nil))
386
      (while (re-search-forward "^D" nil t)
Jim Blandy's avatar
Jim Blandy committed
387 388 389 390
	(forward-char -1)
	(let ((buf (Buffer-menu-buffer nil)))
	  (or (eq buf nil)
	      (eq buf buff-menu-buffer)
391 392
	      (save-excursion (kill-buffer buf)))
	  (if (and buf (buffer-name buf))
Jim Blandy's avatar
Jim Blandy committed
393 394 395
	    (progn (delete-char 1)
		   (insert ? ))
	  (delete-region (point) (progn (forward-line 1) (point)))
396 397
	    (unless (bobp)
	      (forward-char -1))))))))
Jim Blandy's avatar
Jim Blandy committed
398 399 400

(defun Buffer-menu-select ()
  "Select this line's buffer; also display buffers marked with `>'.
401 402 403
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
404 405
  (interactive)
  (let ((buff (Buffer-menu-buffer t))
406
	(menu (current-buffer))
Jim Blandy's avatar
Jim Blandy committed
407 408
	(others ())
	tem)
409
    (Buffer-menu-beginning)
410
    (while (re-search-forward "^>" nil t)
Jim Blandy's avatar
Jim Blandy committed
411 412 413 414 415 416
      (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
417
	  tem (/ (1- (frame-height)) (1+ (length others))))
Jim Blandy's avatar
Jim Blandy committed
418 419 420 421
    (delete-other-windows)
    (switch-to-buffer buff)
    (or (eq menu buff)
	(bury-buffer menu))
422 423
    (if (equal (length others) 0)
	(progn
424 425 426 427 428 429
;;;	  ;; 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)))
430 431 432 433 434 435 436 437 438
	  (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!
)))

439

Jim Blandy's avatar
Jim Blandy committed
440 441 442 443 444 445 446 447 448 449

(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
450
  "Select this line's buffer, alone, in full frame."
Jim Blandy's avatar
Jim Blandy committed
451 452 453 454 455
  (interactive)
  (switch-to-buffer (Buffer-menu-buffer t))
  (bury-buffer (other-buffer))
  (delete-other-windows))

456 457 458 459 460 461 462 463 464 465
(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)))
466 467 468 469
    (if (and (window-dedicated-p (selected-window))
	     (eq (selected-window) (frame-root-window)))
	(switch-to-buffer-other-frame buffer)
      (switch-to-buffer buffer))))
470

Jim Blandy's avatar
Jim Blandy committed
471 472 473 474 475 476 477 478 479 480
(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
481 482 483 484 485 486
(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
487 488 489 490 491 492
(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))
493
    (delete-other-windows)
Jim Blandy's avatar
Jim Blandy committed
494 495 496
    (switch-to-buffer (other-buffer))
    (pop-to-buffer buff)
    (bury-buffer menu)))
Eric S. Raymond's avatar
Eric S. Raymond committed
497

498
(defun Buffer-menu-toggle-read-only ()
499
  "Toggle read-only status of buffer on this line, perhaps via version control."
500 501 502 503
  (interactive)
  (let (char)
    (save-excursion
      (set-buffer (Buffer-menu-buffer t))
504
      (vc-toggle-read-only)
505 506 507
      (setq char (if buffer-read-only ?% ? )))
    (save-excursion
      (beginning-of-line)
508
      (forward-char 1)
509 510 511 512 513
      (if (/= (following-char) char)
          (let (buffer-read-only)
            (delete-char 1)
            (insert char))))))

514 515 516
(defun Buffer-menu-bury ()
  "Bury the buffer listed on this line."
  (interactive)
517
  (when (Buffer-menu-no-header)
518 519 520 521 522 523 524 525 526
    (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"))))
527 528 529 530 531 532 533 534 535 536 537 538


(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)))
539 540 541 542 543 544 545 546 547 548


(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.

Richard M. Stallman's avatar
Richard M. Stallman committed
549
For more information, see the function `buffer-menu'."
550
  (interactive "P")
551 552
  (display-buffer (list-buffers-noselect files-only)))

553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568
(defun Buffer-menu-buffer+size (name size &optional name-props size-props)
  (if (> (+ (length name) (length size) 2) Buffer-menu-buffer+size-width)
      (setq name
	    (if (string-match "<[0-9]+>$" name)
		(concat (substring name 0
				   (- Buffer-menu-buffer+size-width
				      (max (length size) 3)
				      (match-end 0)
				      (- (match-beginning 0))
				      2))
			":"		; narrow ellipsis
			(match-string 0 name))
	      (concat (substring name 0
				 (- Buffer-menu-buffer+size-width
				    (max (length size) 3)
				    2))
569 570 571
		      ":")))		; narrow ellipsis
    ;; Don't put properties on (buffer-name).
    (setq name (copy-sequence name)))
572 573 574 575 576 577 578 579 580
  (add-text-properties 0 (length name) name-props name)
  (add-text-properties 0 (length size) size-props size)
  (concat name
	  (make-string (- Buffer-menu-buffer+size-width
			  (length name)
			  (length size))
		       ? )
	  size))

581 582 583 584 585 586 587 588
(defun Buffer-menu-sort (column)
  "Sort the buffer menu by COLUMN."
  (interactive "P")
  (when column
    (setq column (prefix-numeric-value column))
    (if (< column 2) (setq column 2))
    (if (> column 5) (setq column 5)))
  (setq Buffer-menu-sort-column column)
589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617
  (let (buffer-read-only l buf m1 m2)
    (save-excursion
      (Buffer-menu-beginning)
      (while (not (eobp))
	(when (buffer-live-p (setq buf (get-text-property (+ (point) 4) 'buffer)))
	  (setq m1 (char-after)
		m1 (if (memq m1 '(?> ?D)) m1)
		m2 (char-after (+ (point) 2))
		m2 (if (eq m2 ?S) m2))
	  (if (or m1 m2)
	      (push (list buf m1 m2) l)))
	(forward-line)))
    (Buffer-menu-revert)
    (setq buffer-read-only)
    (save-excursion
      (Buffer-menu-beginning)
      (while (not (eobp))
	(when (setq buf (assq (get-text-property (+ (point) 4) 'buffer) l))
	  (setq m1 (cadr buf)
		m2 (cadr (cdr buf)))
	  (when m1
	    (delete-char 1)
	    (insert m1)
	    (backward-char 1))
	  (when m2
	    (forward-char 2)
	    (delete-char 1)
	    (insert m2)))
	(forward-line)))))
618 619 620 621 622 623 624 625 626 627 628 629 630 631

(defun Buffer-menu-make-sort-button (name column)
  (if (equal column Buffer-menu-sort-column) (setq column nil))
  (propertize name
	      'help-echo (if column
			     (concat "mouse-2: sort by " (downcase name))
			   "mouse-2: sort by visited order")
	      'mouse-face 'highlight
	      'keymap (let ((map (make-sparse-keymap)))
			(define-key map [header-line mouse-2]
			  `(lambda () (interactive)
			     (Buffer-menu-sort ,column)))
			map)))

632 633 634 635 636 637
(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.

Richard M. Stallman's avatar
Richard M. Stallman committed
638
For more information, see the function `buffer-menu'."
639 640 641
  (let* ((old-buffer (current-buffer))
	 (standard-output standard-output)
	 (mode-end (make-string (- Buffer-menu-mode-width 2) ? ))
642 643 644 645 646 647 648
	 (header (concat " " (propertize "CRM " 'face 'fixed-pitch)
			 (Buffer-menu-buffer+size
			  (Buffer-menu-make-sort-button "Buffer" 2)
			  (Buffer-menu-make-sort-button "Size" 3))
			 "  "
			 (Buffer-menu-make-sort-button "Mode" 4) mode-end
			 (Buffer-menu-make-sort-button "File" 5) "\n"))
649
	 list desired-point name mode file)
650
    (when Buffer-menu-use-header-line
651
      (let ((pos 0))
652 653 654 655 656 657
	;; Turn spaces in the header into stretch specs so they work
	;; regardless of the header-line face.
	(while (string-match "[ \t]+" header pos)
	  (setq pos (match-end 0))
	  (put-text-property (match-beginning 0) pos 'display
			     ;; Assume fixed-size chars
658
			     (list 'space :align-to (1- pos))
659
			     header))))
660
    (with-current-buffer (get-buffer-create "*Buffer List*")
661 662 663
      (setq buffer-read-only nil)
      (erase-buffer)
      (setq standard-output (current-buffer))
664
      (unless Buffer-menu-use-header-line
665 666 667
	(insert header (propertize "---" 'face 'fixed-pitch) " ")
	(insert (Buffer-menu-buffer+size "------" "----"))
	(insert "  ----" mode-end "----\n")
668 669 670 671 672 673
	(put-text-property 1 (point) 'intangible t))
      (setq list
	    (delq t
		  (mapcar
		   (lambda (buffer)
		     (with-current-buffer buffer
674 675 676 677 678
		       (setq name (buffer-name)
			     mode (concat (format-mode-line mode-name nil nil buffer)
					  (if mode-line-process
					      (format-mode-line mode-line-process nil nil buffer)))
			     file (buffer-file-name))
679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703
		       (cond
			;; Don't mention internal buffers.
			((and (string= (substring name 0 1) " ") (null file)))
			;; Maybe don't mention buffers without files.
			((and files-only (not file)))
			((string= name "*Buffer List*"))
			;; Otherwise output info.
			(t
			 (unless file
			   ;; No visited file.  Check local value of
			   ;; list-buffers-directory.
			   (when (and (boundp 'list-buffers-directory)
				      list-buffers-directory)
			     (setq file list-buffers-directory)))
			 (list buffer
			       (format "%c%c%c "
				       (if (eq buffer old-buffer) ?. ? )
				       ;; Handle readonly status.  The output buffer is special
				       ;; cased to appear readonly; it is actually made so at a
				       ;; later date.
				       (if (or (eq buffer standard-output)
					       buffer-read-only)
					   ?% ? )
				       ;; Identify modified buffers.
				       (if (buffer-modified-p) ?* ? ))
704
			       name (buffer-size) mode file)))))
705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738
		   (buffer-list))))
      (dolist (buffer
	       (if Buffer-menu-sort-column
		   (sort list
			 (if (eq Buffer-menu-sort-column 3)
			     (lambda (a b)
			       (< (nth Buffer-menu-sort-column a)
				  (nth Buffer-menu-sort-column b)))
			   (lambda (a b)
			     (string< (nth Buffer-menu-sort-column a)
				      (nth Buffer-menu-sort-column b)))))
		 list))
	(if (eq (car buffer) old-buffer)
	    (setq desired-point (point)))
	(insert (cadr buffer)
		;; 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.
		(Buffer-menu-buffer+size (nth 2 buffer)
					 (int-to-string (nth 3 buffer))
					 `(buffer-name ,(nth 2 buffer)
					   buffer ,(car buffer)
					   face Buffer-menu-buffer-face
					   mouse-face highlight
					   help-echo "mouse-2: select this buffer"))
		"  "
		(if (> (length (nth 4 buffer)) Buffer-menu-mode-width)
		    (substring (nth 4 buffer) 0 Buffer-menu-mode-width)
		  (nth 4 buffer)))
	(when (nth 5 buffer)
	  (indent-to (+ Buffer-menu-buffer-column Buffer-menu-buffer+size-width
			Buffer-menu-mode-width 4) 1)
	  (princ (abbreviate-file-name (nth 5 buffer))))
	(princ "\n"))
739
      (Buffer-menu-mode)
740
      (when Buffer-menu-use-header-line
741
	(setq header-line-format header))
742 743
      ;; DESIRED-POINT doesn't have to be set; it is not when the
      ;; current buffer is not displayed for some reason.
744
      (and desired-point
745
	   (goto-char desired-point))
746 747
      (setq Buffer-menu-files-only files-only)
      (set-buffer-modified-p nil)
748
      (current-buffer))))
749

Miles Bader's avatar
Miles Bader committed
750
;;; arch-tag: e7dfcfc9-6cb2-46e4-bf55-8ef1936d83c6
Eric S. Raymond's avatar
Eric S. Raymond committed
751
;;; buff-menu.el ends here