lisp/buff-menu.el

   1 ;;; buff-menu.el --- Interface for viewing and manipulating buffers
   2
   3 ;; Copyright (C) 1985-1987, 1993-1995, 2000-2017 Free Software
   4 ;; Foundation, Inc.
   5
   6 ;; Maintainer: emacs-devel@gnu.org
   7 ;; Keywords: convenience
   8 ;; Package: emacs
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  24
  25 ;;; Commentary:
  26
  27 ;; The Buffer Menu is used to view, edit, delete, or change attributes
  28 ;; of buffers.  The entry points are C-x C-b (`list-buffers') and
  29 ;; M-x buffer-menu.
  30
  31 ;;; Code:
  32
  33 (require 'tabulated-list)
  34
  35 (defgroup Buffer-menu nil
  36   "Show a menu of all buffers in a buffer."
  37   :group 'tools
  38   :group 'convenience)
  39
  40 (defvar Buffer-menu-marker-char ?>
  41   "The mark character for marked buffers.")
  42
  43 (defvar Buffer-menu-del-char ?D
  44   "Character used to flag buffers for deletion.")
  45
  46 (defcustom Buffer-menu-use-header-line t
  47   "If non-nil, use the header line to display Buffer Menu column titles."
  48   :type 'boolean
  49   :group 'Buffer-menu)
  50
  51 (defface buffer-menu-buffer
  52   '((t (:weight bold)))
  53   "Face for buffer names in the Buffer Menu."
  54   :group 'Buffer-menu)
  55 (put 'Buffer-menu-buffer 'face-alias 'buffer-menu-buffer)
  56
  57 (defcustom Buffer-menu-buffer+size-width nil
  58   "Combined width of buffer name and size columns in Buffer Menu.
  59 If nil, use `Buffer-menu-name-width' and `Buffer-menu-size-width'.
  60
  61 If non-nil, the value of `Buffer-menu-name-width' is overridden;
  62 the name column is assigned width `Buffer-menu-buffer+size-width'
  63 minus `Buffer-menu-size-width'.  This use is deprecated."
  64   :type '(choice (const nil) number)
  65   :group 'Buffer-menu
  66   :version "24.3")
  67
  68 (make-obsolete-variable 'Buffer-menu-buffer+size-width
  69                         "use `Buffer-menu-name-width' and `Buffer-menu-size-width' instead."
  70                         "24.3")
  71
  72 (defcustom Buffer-menu-name-width 19
  73   "Width of buffer name column in the Buffer Menu."
  74   :type 'number
  75   :group 'Buffer-menu
  76   :version "24.3")
  77
  78 (defcustom Buffer-menu-size-width 7
  79   "Width of buffer size column in the Buffer Menu."
  80   :type 'number
  81   :group 'Buffer-menu
  82   :version "24.3")
  83
  84 (defcustom Buffer-menu-mode-width 16
  85   "Width of mode name column in the Buffer Menu."
  86   :type 'number
  87   :group 'Buffer-menu)
  88
  89 (defcustom Buffer-menu-use-frame-buffer-list t
  90   "If non-nil, the Buffer Menu uses the selected frame's buffer list.
  91 Buffers that were never selected in that frame are listed at the end.
  92 If the value is nil, the Buffer Menu uses the global buffer list.
  93 This variable matters if the Buffer Menu is sorted by visited order,
  94 as it is by default."
  95   :type 'boolean
  96   :group 'Buffer-menu
  97   :version "22.1")
  98
  99 (defvar Buffer-menu-files-only nil
 100   "Non-nil if the current Buffer Menu lists only file buffers.
 101 This is set by the prefix argument to `buffer-menu' and related
 102 commands.")
 103 (make-variable-buffer-local 'Buffer-menu-files-only)
 104
 105 (defvar Info-current-file) ; from info.el
 106 (defvar Info-current-node) ; from info.el
 107
 108 (defvar Buffer-menu-mode-map
 109   (let ((map (make-sparse-keymap))
 110         (menu-map (make-sparse-keymap)))
 111     (set-keymap-parent map tabulated-list-mode-map)
 112     (define-key map "v" 'Buffer-menu-select)
 113     (define-key map "2" 'Buffer-menu-2-window)
 114     (define-key map "1" 'Buffer-menu-1-window)
 115     (define-key map "f" 'Buffer-menu-this-window)
 116     (define-key map "e" 'Buffer-menu-this-window)
 117     (define-key map "\C-m" 'Buffer-menu-this-window)
 118     (define-key map "o" 'Buffer-menu-other-window)
 119     (define-key map "\C-o" 'Buffer-menu-switch-other-window)
 120     (define-key map "s" 'Buffer-menu-save)
 121     (define-key map "d" 'Buffer-menu-delete)
 122     (define-key map "k" 'Buffer-menu-delete)
 123     (define-key map "\C-k" 'Buffer-menu-delete)
 124     (define-key map "\C-d" 'Buffer-menu-delete-backwards)
 125     (define-key map "x" 'Buffer-menu-execute)
 126     (define-key map " " 'next-line)
 127     (define-key map "\177" 'Buffer-menu-backup-unmark)
 128     (define-key map "~" 'Buffer-menu-not-modified)
 129     (define-key map "u" 'Buffer-menu-unmark)
 130     (define-key map "\M-\177" 'Buffer-menu-unmark-all-buffers)
 131     (define-key map "U" 'Buffer-menu-unmark-all)
 132     (define-key map "m" 'Buffer-menu-mark)
 133     (define-key map "t" 'Buffer-menu-visit-tags-table)
 134     (define-key map "%" 'Buffer-menu-toggle-read-only)
 135     (define-key map "b" 'Buffer-menu-bury)
 136     (define-key map "V" 'Buffer-menu-view)
 137     (define-key map "T" 'Buffer-menu-toggle-files-only)
 138     (define-key map (kbd "M-s a C-s")   'Buffer-menu-isearch-buffers)
 139     (define-key map (kbd "M-s a M-C-s") 'Buffer-menu-isearch-buffers-regexp)
 140     (define-key map (kbd "M-s a C-o") 'Buffer-menu-multi-occur)
 141
 142     (define-key map [mouse-2] 'Buffer-menu-mouse-select)
 143     (define-key map [follow-link] 'mouse-face)
 144
 145     (define-key map [menu-bar Buffer-menu-mode] (cons (purecopy "Buffer-Menu") menu-map))
 146     (bindings--define-key menu-map [quit]
 147       '(menu-item "Quit" quit-window
 148                  :help "Remove the buffer menu from the display"))
 149     (bindings--define-key menu-map [rev]
 150       '(menu-item "Refresh" revert-buffer
 151                  :help "Refresh the *Buffer List* buffer contents"))
 152     (bindings--define-key menu-map [s0] menu-bar-separator)
 153     (bindings--define-key menu-map [tf]
 154       '(menu-item "Show Only File Buffers" Buffer-menu-toggle-files-only
 155                   :button (:toggle . Buffer-menu-files-only)
 156                   :help "Toggle whether the current buffer-menu displays only file buffers"))
 157     (bindings--define-key menu-map [s1] menu-bar-separator)
 158     ;; FIXME: The "Select" entries could use better names...
 159     (bindings--define-key menu-map [sel]
 160       '(menu-item "Select Marked" Buffer-menu-select
 161                  :help "Select this line's buffer; also display buffers marked with `>'"))
 162     (bindings--define-key menu-map [bm2]
 163       '(menu-item "Select Two" Buffer-menu-2-window
 164                  :help "Select this line's buffer, with previous buffer in second window"))
 165     (bindings--define-key menu-map [bm1]
 166       '(menu-item "Select Current" Buffer-menu-1-window
 167                  :help "Select this line's buffer, alone, in full frame"))
 168     (bindings--define-key menu-map [ow]
 169       '(menu-item "Select in Other Window" Buffer-menu-other-window
 170                  :help "Select this line's buffer in other window, leaving buffer menu visible"))
 171     (bindings--define-key menu-map [tw]
 172       '(menu-item "Select in Current Window" Buffer-menu-this-window
 173                  :help "Select this line's buffer in this window"))
 174     (bindings--define-key menu-map [s2] menu-bar-separator)
 175     (bindings--define-key menu-map [is]
 176       '(menu-item "Regexp Isearch Marked Buffers..." Buffer-menu-isearch-buffers-regexp
 177                  :help "Search for a regexp through all marked buffers using Isearch"))
 178     (bindings--define-key menu-map [ir]
 179       '(menu-item "Isearch Marked Buffers..." Buffer-menu-isearch-buffers
 180                  :help "Search for a string through all marked buffers using Isearch"))
 181     (bindings--define-key menu-map [mo]
 182       '(menu-item "Multi Occur Marked Buffers..." Buffer-menu-multi-occur
 183                  :help "Show lines matching a regexp in marked buffers using Occur"))
 184     (bindings--define-key menu-map [s3] menu-bar-separator)
 185     (bindings--define-key menu-map [by]
 186       '(menu-item "Bury" Buffer-menu-bury
 187                  :help "Bury the buffer listed on this line"))
 188     (bindings--define-key menu-map [vt]
 189       '(menu-item "Set Unmodified" Buffer-menu-not-modified
 190                  :help "Mark buffer on this line as unmodified (no changes to save)"))
 191     (bindings--define-key menu-map [ex]
 192       '(menu-item "Execute" Buffer-menu-execute
 193                  :help "Save and/or delete buffers marked with s or k commands"))
 194     (bindings--define-key menu-map [s4] menu-bar-separator)
 195     (bindings--define-key menu-map [delb]
 196       '(menu-item "Mark for Delete and Move Backwards" Buffer-menu-delete-backwards
 197                  :help "Mark buffer on this line to be deleted by x command and move up one line"))
 198     (bindings--define-key menu-map [del]
 199       '(menu-item "Mark for Delete" Buffer-menu-delete
 200                  :help "Mark buffer on this line to be deleted by x command"))
 201
 202     (bindings--define-key menu-map [sv]
 203       '(menu-item "Mark for Save" Buffer-menu-save
 204                  :help "Mark buffer on this line to be saved by x command"))
 205     (bindings--define-key menu-map [umk]
 206       '(menu-item "Unmark" Buffer-menu-unmark
 207                  :help "Cancel all requested operations on buffer on this line and move down"))
 208     (bindings--define-key menu-map [umkab]
 209       '(menu-item "Remove marks..." Buffer-menu-unmark-all-buffers
 210                   :help "Cancel a requested operation on all buffers"))
 211     (bindings--define-key menu-map [umka]
 212       '(menu-item "Unmark all" Buffer-menu-unmark-all
 213                   :help "Cancel all requested operations on buffers"))
 214     (bindings--define-key menu-map [mk]
 215       '(menu-item "Mark" Buffer-menu-mark
 216                  :help "Mark buffer on this line for being displayed by v command"))
 217     map)
 218   "Local keymap for `Buffer-menu-mode' buffers.")
 219
 220 (define-obsolete-variable-alias 'buffer-menu-mode-hook
 221   'Buffer-menu-mode-hook "23.1")
 222
 223 (define-derived-mode Buffer-menu-mode tabulated-list-mode "Buffer Menu"
 224   "Major mode for Buffer Menu buffers.
 225 The Buffer Menu is invoked by the commands \\[list-buffers],
 226 \\[buffer-menu], and \\[buffer-menu-other-window].
 227 See `buffer-menu' for a description of its contents.
 228
 229 In Buffer Menu mode, the following commands are defined:
 230 \\<Buffer-menu-mode-map>
 231 \\[quit-window]    Remove the Buffer Menu from the display.
 232 \\[Buffer-menu-this-window]  Select current line's buffer in place of the buffer menu.
 233 \\[Buffer-menu-other-window]    Select that buffer in another window,
 234      so the Buffer Menu remains visible in its window.
 235 \\[Buffer-menu-view]    Select current line's buffer, in View mode.
 236 \\[Buffer-menu-view-other-window]  Select that buffer in
 237      another window, in view-mode.
 238 \\[Buffer-menu-switch-other-window]  Make another window display that buffer.
 239 \\[Buffer-menu-mark]    Mark current line's buffer to be displayed.
 240 \\[Buffer-menu-select]    Select current line's buffer.
 241      Also show buffers marked with m, in other windows.
 242 \\[Buffer-menu-1-window]    Select that buffer in full-frame window.
 243 \\[Buffer-menu-2-window]    Select that buffer in one window, together with the
 244      buffer selected before this one in another window.
 245 \\[Buffer-menu-isearch-buffers]    Incremental search in the marked buffers.
 246 \\[Buffer-menu-isearch-buffers-regexp]  Isearch for regexp in the marked buffers.
 247 \\[Buffer-menu-multi-occur] Show lines matching regexp in the marked buffers.
 248 \\[Buffer-menu-visit-tags-table]    visit-tags-table this buffer.
 249 \\[Buffer-menu-not-modified]    Clear modified-flag on that buffer.
 250 \\[Buffer-menu-save]    Mark that buffer to be saved, and move down.
 251 \\[Buffer-menu-delete]  Mark that buffer to be deleted, and move down.
 252 \\[Buffer-menu-delete-backwards]  Mark that buffer to be deleted, and move up.
 253 \\[Buffer-menu-execute]    Delete or save marked buffers.
 254 \\[Buffer-menu-unmark]    Remove all marks from current line.
 255      With prefix argument, also move up one line.
 256 \\[Buffer-menu-unmark-all-buffers]    Remove a particular mark from all lines.
 257 \\[Buffer-menu-unmark-all]    Remove all marks from all lines.
 258 \\[Buffer-menu-backup-unmark]  Back up a line and remove marks.
 259 \\[Buffer-menu-toggle-read-only]    Toggle read-only status of buffer on this line.
 260 \\[revert-buffer]    Update the list of buffers.
 261 \\[Buffer-menu-toggle-files-only]    Toggle whether the menu displays only file buffers.
 262 \\[Buffer-menu-bury]    Bury the buffer listed on this line."
 263   (set (make-local-variable 'buffer-stale-function)
 264        (lambda (&optional _noconfirm) 'fast))
 265   (add-hook 'tabulated-list-revert-hook 'list-buffers--refresh nil t))
 266
 267 (defun buffer-menu (&optional arg)
 268   "Switch to the Buffer Menu.
 269 By default, the Buffer Menu lists all buffers except those whose
 270 names start with a space (which are for internal use).  With
 271 prefix argument ARG, show only buffers that are visiting files.
 272
 273 In the Buffer Menu, the first column (denoted \"C\") shows \".\"
 274 for the buffer from which you came, \">\" for buffers you mark to
 275 be displayed, and \"D\" for those you mark for deletion.
 276
 277 The \"R\" column has a \"%\" if the buffer is read-only.
 278 The \"M\" column has a \"*\" if it is modified, or \"S\" if you
 279 have marked it for saving.
 280
 281 The remaining columns show the buffer name, the buffer size in
 282 characters, its major mode, and the visited file name (if any).
 283
 284 See `Buffer-menu-mode' for the keybindings available the Buffer
 285 Menu."
 286   (interactive "P")
 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."))
 290
 291 (defun buffer-menu-other-window (&optional arg)
 292   "Display the Buffer Menu in another window.
 293 See `buffer-menu' for a description of the Buffer Menu.
 294
 295 By default, all buffers are listed except those whose names start
 296 with a space (which are for internal use).  With prefix argument
 297 ARG, show only buffers that are visiting files."
 298   (interactive "P")
 299   (switch-to-buffer-other-window (list-buffers-noselect arg))
 300   (message
 301    "Commands: d, s, x, u; f, o, 1, 2, m, v; ~, %%; q to quit; ? for help."))
 302
 303 ;;;###autoload
 304 (defun list-buffers (&optional arg)
 305   "Display a list of existing buffers.
 306 The list is displayed in a buffer named \"*Buffer List*\".
 307 See `buffer-menu' for a description of the Buffer Menu.
 308
 309 By default, all buffers are listed except those whose names start
 310 with a space (which are for internal use).  With prefix argument
 311 ARG, show only buffers that are visiting files."
 312   (interactive "P")
 313   (display-buffer (list-buffers-noselect arg)))
 314
 315 (defun Buffer-menu-toggle-files-only (arg)
 316   "Toggle whether the current buffer-menu displays only file buffers.
 317 With a positive ARG, display only file buffers.  With zero or
 318 negative ARG, display other buffers as well."
 319   (interactive "P")
 320   (setq Buffer-menu-files-only
 321         (cond ((not arg) (not Buffer-menu-files-only))
 322               ((> (prefix-numeric-value arg) 0) t)))
 323   (message (if Buffer-menu-files-only
 324                "Showing only file-visiting buffers."
 325              "Showing all non-internal buffers."))
 326   (revert-buffer))
 327
 328 (defalias 'Buffer-menu-sort 'tabulated-list-sort)
 329 \f
 330
 331 (defun Buffer-menu-buffer (&optional error-if-non-existent-p)
 332   "Return the buffer described by the current Buffer Menu line.
 333 If there is no buffer here, return nil if ERROR-IF-NON-EXISTENT-P
 334 is nil or omitted, and signal an error otherwise."
 335   (let ((buffer (tabulated-list-get-id)))
 336     (cond ((null buffer)
 337            (if error-if-non-existent-p
 338                (error "No buffer on this line")))
 339           ((not (buffer-live-p buffer))
 340            (if error-if-non-existent-p
 341                (error "This buffer has been killed")))
 342           (t buffer))))
 343
 344 (defun Buffer-menu-no-header ()
 345   (beginning-of-line)
 346   (if (or Buffer-menu-use-header-line
 347           (not (tabulated-list-header-overlay-p (point))))
 348       t
 349     (ding)
 350     (forward-line 1)
 351     nil))
 352
 353 (defun Buffer-menu-beginning ()
 354   (goto-char (point-min))
 355   (unless Buffer-menu-use-header-line
 356     (forward-line)))
 357
 358 \f
 359 ;;; Commands for modifying Buffer Menu entries.
 360
 361 (defun Buffer-menu-mark ()
 362   "Mark the Buffer menu entry at point for later display.
 363 It will be displayed by the \\<Buffer-menu-mode-map>\\[Buffer-menu-select] command."
 364   (interactive)
 365   (tabulated-list-set-col 0 (char-to-string Buffer-menu-marker-char) t)
 366   (forward-line))
 367
 368 (defun Buffer-menu-unmark (&optional backup)
 369   "Cancel all requested operations on buffer on this line and move down.
 370 Optional prefix arg means move up."
 371   (interactive "P")
 372   (Buffer-menu--unmark)
 373   (forward-line (if backup -1 1)))
 374
 375 (defun Buffer-menu-unmark-all-buffers (mark)
 376   "Cancel a requested operation on all buffers.
 377 MARK is the character to flag the operation on the buffers.
 378 When called interactively prompt for MARK;  RET remove all marks."
 379   (interactive "cRemove marks (RET means all):")
 380   (save-excursion
 381     (goto-char (point-min))
 382     (when (tabulated-list-header-overlay-p)
 383       (forward-line))
 384     (while (not (eobp))
 385       (let ((xmarks (list (aref (tabulated-list-get-entry) 0)
 386                           (aref (tabulated-list-get-entry) 2))))
 387         (when (or (char-equal mark ?\r)
 388                   (member (char-to-string mark) xmarks))
 389           (Buffer-menu--unmark)))
 390       (forward-line))))
 391
 392 (defun Buffer-menu-unmark-all ()
 393   "Cancel all requested operations on buffers."
 394   (interactive)
 395   (Buffer-menu-unmark-all-buffers ?\r))
 396
 397 (defun Buffer-menu-backup-unmark ()
 398   "Move up and cancel all requested operations on buffer on line above."
 399   (interactive)
 400   (forward-line -1)
 401   (Buffer-menu--unmark))
 402
 403 (defun Buffer-menu--unmark ()
 404   (tabulated-list-set-col 0 " " t)
 405   (let ((buf (Buffer-menu-buffer)))
 406     (when buf
 407       (if (buffer-modified-p buf)
 408           (tabulated-list-set-col 2 "*" t)
 409         (tabulated-list-set-col 2 " " t)))))
 410
 411 (defun Buffer-menu-delete (&optional arg)
 412   "Mark the buffer on this Buffer Menu buffer line for deletion.
 413 A subsequent \\<Buffer-menu-mode-map>`\\[Buffer-menu-execute]' command
 414 will delete it.
 415
 416 If prefix argument ARG is non-nil, it specifies the number of
 417 buffers to delete; a negative ARG means to delete backwards."
 418   (interactive "p")
 419   (if (or (null arg) (= arg 0))
 420       (setq arg 1))
 421   (while (> arg 0)
 422     (when (Buffer-menu-buffer)
 423       (tabulated-list-set-col 0 (char-to-string Buffer-menu-del-char) t))
 424     (forward-line 1)
 425     (setq arg (1- arg)))
 426   (while (< arg 0)
 427     (when (Buffer-menu-buffer)
 428       (tabulated-list-set-col 0 (char-to-string Buffer-menu-del-char) t))
 429     (forward-line -1)
 430     (setq arg (1+ arg))))
 431
 432 (defun Buffer-menu-delete-backwards (&optional arg)
 433   "Mark the buffer on this Buffer Menu line for deletion, and move up.
 434 A subsequent \\<Buffer-menu-mode-map>`\\[Buffer-menu-execute]'
 435 command will delete the marked buffer.  Prefix ARG means move
 436 that many lines."
 437   (interactive "p")
 438   (Buffer-menu-delete (- (or arg 1))))
 439
 440 (defun Buffer-menu-save ()
 441   "Mark the buffer on this Buffer Menu line for saving.
 442 A subsequent \\<Buffer-menu-mode-map>`\\[Buffer-menu-execute]' command
 443 will save it."
 444   (interactive)
 445   (when (Buffer-menu-buffer)
 446     (tabulated-list-set-col 2 "S" t)
 447     (forward-line 1)))
 448
 449 (defun Buffer-menu-not-modified (&optional arg)
 450   "Mark the buffer on this line as unmodified (no changes to save).
 451 If ARG is non-nil (interactively, with a prefix argument), mark
 452 it as modified."
 453   (interactive "P")
 454   (with-current-buffer (Buffer-menu-buffer t)
 455     (set-buffer-modified-p arg))
 456   (tabulated-list-set-col 2 (if arg "*" " ") t))
 457
 458 (defun Buffer-menu-execute ()
 459   "Save and/or delete marked buffers in the Buffer Menu.
 460 Buffers marked with \\<Buffer-menu-mode-map>`\\[Buffer-menu-save]' are saved.
 461 Buffers marked with \\<Buffer-menu-mode-map>`\\[Buffer-menu-delete]' are deleted."
 462   (interactive)
 463   (save-excursion
 464     (Buffer-menu-beginning)
 465     (while (not (eobp))
 466       (let ((buffer (tabulated-list-get-id))
 467             (entry  (tabulated-list-get-entry)))
 468         (cond ((null entry)
 469                (forward-line 1))
 470               ((not (buffer-live-p buffer))
 471                (tabulated-list-delete-entry))
 472               (t
 473                (let ((delete (eq (char-after) ?D)))
 474                  (when (equal (aref entry 2) "S")
 475                    (condition-case nil
 476                        (progn
 477                          (with-current-buffer buffer
 478                            (save-buffer))
 479                          (tabulated-list-set-col 2 " " t))
 480                      (error (warn "Error saving %s" buffer))))
 481                  (if delete
 482                      (unless (eq buffer (current-buffer))
 483                        (kill-buffer buffer)
 484                        (tabulated-list-delete-entry))
 485                    (forward-line 1)))))))))
 486
 487 (defun Buffer-menu-select ()
 488   "Select this line's buffer; also, display buffers marked with `>'.
 489 You can mark buffers with the \\<Buffer-menu-mode-map>`\\[Buffer-menu-mark]' command.
 490 This command deletes and replaces all the previously existing windows
 491 in the selected frame."
 492   (interactive)
 493   (let* ((this-buffer (Buffer-menu-buffer t))
 494          (menu-buffer (current-buffer))
 495          (others (delq this-buffer (Buffer-menu-marked-buffers t)))
 496          (height (/ (1- (frame-height)) (1+ (length others)))))
 497     (delete-other-windows)
 498     (switch-to-buffer this-buffer)
 499     (unless (eq menu-buffer this-buffer)
 500       (bury-buffer menu-buffer))
 501     (dolist (buffer others)
 502       (split-window nil height)
 503       (other-window 1)
 504       (switch-to-buffer buffer))
 505     ;; Back to the beginning!
 506     (other-window 1)))
 507
 508 (defun Buffer-menu-marked-buffers (&optional unmark)
 509   "Return the list of buffers marked with `Buffer-menu-mark'.
 510 If UNMARK is non-nil, unmark them."
 511   (let (buffers)
 512     (Buffer-menu-beginning)
 513     (while (re-search-forward "^>" nil t)
 514       (let ((buffer (Buffer-menu-buffer)))
 515         (if (and buffer unmark)
 516             (tabulated-list-set-col 0 " " t))
 517         (if (buffer-live-p buffer)
 518             (push buffer buffers))))
 519     (nreverse buffers)))
 520
 521 (defun Buffer-menu-isearch-buffers ()
 522   "Search for a string through all marked buffers using Isearch."
 523   (interactive)
 524   (multi-isearch-buffers (Buffer-menu-marked-buffers)))
 525
 526 (defun Buffer-menu-isearch-buffers-regexp ()
 527   "Search for a regexp through all marked buffers using Isearch."
 528   (interactive)
 529   (multi-isearch-buffers-regexp (Buffer-menu-marked-buffers)))
 530
 531 (defun Buffer-menu-multi-occur (regexp &optional nlines)
 532   "Show all lines in marked buffers containing a match for a regexp."
 533   (interactive (occur-read-primary-args))
 534   (multi-occur (Buffer-menu-marked-buffers) regexp nlines))
 535
 536 \f
 537 (defun Buffer-menu-visit-tags-table ()
 538   "Visit the tags table in the buffer on this line.  See `visit-tags-table'."
 539   (interactive)
 540   (let ((file (buffer-file-name (Buffer-menu-buffer t))))
 541     (if file
 542         (visit-tags-table file)
 543       (error "Specified buffer has no file"))))
 544
 545 (defun Buffer-menu-1-window ()
 546   "Select this line's buffer, alone, in full frame."
 547   (interactive)
 548   (switch-to-buffer (Buffer-menu-buffer t))
 549   (bury-buffer (other-buffer))
 550   (delete-other-windows))
 551
 552 (defun Buffer-menu-this-window ()
 553   "Select this line's buffer in this window."
 554   (interactive)
 555   (switch-to-buffer (Buffer-menu-buffer t)))
 556
 557 (defun Buffer-menu-other-window ()
 558   "Select this line's buffer in other window, leaving buffer menu visible."
 559   (interactive)
 560   (switch-to-buffer-other-window (Buffer-menu-buffer t)))
 561
 562 (defun Buffer-menu-switch-other-window ()
 563   "Make the other window select this line's buffer.
 564 The current window remains selected."
 565   (interactive)
 566   (display-buffer (Buffer-menu-buffer t) t))
 567
 568 (defun Buffer-menu-2-window ()
 569   "Select this line's buffer, with previous buffer in second window."
 570   (interactive)
 571   (let ((buff (Buffer-menu-buffer t))
 572         (menu (current-buffer)))
 573     (delete-other-windows)
 574     (switch-to-buffer (other-buffer))
 575     (switch-to-buffer-other-window buff)
 576     (bury-buffer menu)))
 577
 578 (defun Buffer-menu-toggle-read-only ()
 579   "Toggle read-only status of buffer on this line.
 580 This behaves like invoking \\[read-only-mode] in that buffer."
 581   (interactive)
 582   (let ((read-only
 583          (with-current-buffer (Buffer-menu-buffer t)
 584            (read-only-mode 'toggle)
 585            buffer-read-only)))
 586     (tabulated-list-set-col 1 (if read-only "%" " ") t)))
 587
 588 (defun Buffer-menu-bury ()
 589   "Bury the buffer listed on this line."
 590   (interactive)
 591   (let ((buffer (tabulated-list-get-id)))
 592     (cond ((null buffer))
 593           ((buffer-live-p buffer)
 594            (bury-buffer buffer)
 595            (save-excursion
 596              (let ((elt (tabulated-list-delete-entry)))
 597                (goto-char (point-max))
 598                (apply 'tabulated-list-print-entry elt)))
 599            (message "Buffer buried."))
 600           (t
 601            (tabulated-list-delete-entry)
 602            (message "Buffer is dead; removing from list.")))))
 603
 604 (defun Buffer-menu-view ()
 605   "View this line's buffer in View mode."
 606   (interactive)
 607   (view-buffer (Buffer-menu-buffer t)))
 608
 609 (defun Buffer-menu-view-other-window ()
 610   "View this line's buffer in View mode in another window."
 611   (interactive)
 612   (view-buffer-other-window (Buffer-menu-buffer t)))
 613 \f
 614 ;;; Functions for populating the Buffer Menu.
 615
 616 ;;;###autoload
 617 (defun list-buffers-noselect (&optional files-only buffer-list)
 618   "Create and return a Buffer Menu buffer.
 619 This is called by `buffer-menu' and others as a subroutine.
 620
 621 If FILES-ONLY is non-nil, show only file-visiting buffers.
 622 If BUFFER-LIST is non-nil, it should be a list of buffers; it
 623 means list those buffers and no others."
 624   (let ((old-buffer (current-buffer))
 625         (buffer (get-buffer-create "*Buffer List*")))
 626     (with-current-buffer buffer
 627       (Buffer-menu-mode)
 628       (setq Buffer-menu-files-only
 629             (and files-only (>= (prefix-numeric-value files-only) 0)))
 630       (list-buffers--refresh buffer-list old-buffer)
 631       (tabulated-list-print))
 632     buffer))
 633
 634 (defun Buffer-menu-mouse-select (event)
 635   "Select the buffer whose line you click on."
 636   (interactive "e")
 637   (select-window (posn-window (event-end event)))
 638   (let ((buffer (tabulated-list-get-id (posn-point (event-end event)))))
 639     (when (buffer-live-p buffer)
 640       (if (and (window-dedicated-p)
 641                (eq (selected-window) (frame-root-window)))
 642           (switch-to-buffer-other-frame buffer)
 643         (switch-to-buffer buffer)))))
 644
 645 (defun list-buffers--refresh (&optional buffer-list old-buffer)
 646   ;; Set up `tabulated-list-format'.
 647   (let ((name-width Buffer-menu-name-width)
 648         (size-width Buffer-menu-size-width))
 649     ;; Handle obsolete variable:
 650     (if Buffer-menu-buffer+size-width
 651         (setq name-width (- Buffer-menu-buffer+size-width size-width)))
 652     (setq tabulated-list-format
 653           (vector '("C" 1 t :pad-right 0)
 654                   '("R" 1 t :pad-right 0)
 655                   '("M" 1 t)
 656                   `("Buffer" ,name-width t)
 657                   `("Size" ,size-width tabulated-list-entry-size->
 658                            :right-align t)
 659                   `("Mode" ,Buffer-menu-mode-width t)
 660                   '("File" 1 t))))
 661   (setq tabulated-list-use-header-line Buffer-menu-use-header-line)
 662   ;; Collect info for each buffer we're interested in.
 663   (let ((buffer-menu-buffer (current-buffer))
 664         (show-non-file (not Buffer-menu-files-only))
 665         entries)
 666     (dolist (buffer (or buffer-list
 667                         (buffer-list (if Buffer-menu-use-frame-buffer-list
 668                                          (selected-frame)))))
 669       (with-current-buffer buffer
 670         (let* ((name (buffer-name))
 671                (file buffer-file-name))
 672           (when (and (buffer-live-p buffer)
 673                      (or buffer-list
 674                          (and (or (not (string= (substring name 0 1) " "))
 675                                   file)
 676                               (not (eq buffer buffer-menu-buffer))
 677                               (or file show-non-file))))
 678             (push (list buffer
 679                         (vector (if (eq buffer old-buffer) "." " ")
 680                                 (if buffer-read-only "%" " ")
 681                                 (if (buffer-modified-p) "*" " ")
 682                                 (Buffer-menu--pretty-name name)
 683                                 (number-to-string (buffer-size))
 684                                 (concat (format-mode-line mode-name nil nil buffer)
 685                                         (if mode-line-process
 686                                             (format-mode-line mode-line-process
 687                                                               nil nil buffer)))
 688                                 (Buffer-menu--pretty-file-name file)))
 689                   entries)))))
 690     (setq tabulated-list-entries (nreverse entries)))
 691   (tabulated-list-init-header))
 692
 693 (defun tabulated-list-entry-size-> (entry1 entry2)
 694   (> (string-to-number (aref (cadr entry1) 4))
 695      (string-to-number (aref (cadr entry2) 4))))
 696
 697 (defun Buffer-menu--pretty-name (name)
 698   (propertize name
 699               'font-lock-face 'buffer-menu-buffer
 700               'mouse-face 'highlight))
 701
 702 (defun Buffer-menu--pretty-file-name (file)
 703   (cond (file
 704          (abbreviate-file-name file))
 705         ((and (boundp 'list-buffers-directory)
 706               list-buffers-directory)
 707          list-buffers-directory)
 708         ((eq major-mode 'Info-mode)
 709          (Buffer-menu-info-node-description Info-current-file))
 710         (t "")))
 711
 712 (defun Buffer-menu-info-node-description (file)
 713   (cond
 714    ((equal file "dir") "*Info Directory*")
 715    ((eq file 'apropos) "*Info Apropos*")
 716    ((eq file 'history) "*Info History*")
 717    ((eq file 'toc)     "*Info TOC*")
 718    ((not (stringp file)) "") ; Avoid errors
 719    (t
 720     (concat "(" (file-name-nondirectory file) ") " Info-current-node))))
 721
 722 ;;; buff-menu.el ends here