771
+ − 1 ;;; buff-menu.el --- buffer menu/tab main function and support functions.
428
+ − 2
+ − 3 ;; Copyright (C) 1985, 86, 87, 93, 94, 95 Free Software Foundation, Inc.
771
+ − 4 ;; Copyright (C) 1999, 2000 Andy Piper.
+ − 5 ;; Copyright (C) 2000 Ben Wing.
428
+ − 6
771
+ − 7 ;; Maintainer: XEmacs Development Team
+ − 8 ;; Keywords: frames, extensions, internal, dumped
428
+ − 9
+ − 10 ;; This file is part of XEmacs.
+ − 11
+ − 12 ;; XEmacs is free software; you can redistribute it and/or modify it
+ − 13 ;; under the terms of the GNU General Public License as published by
+ − 14 ;; the Free Software Foundation; either version 2, or (at your option)
+ − 15 ;; any later version.
+ − 16
+ − 17 ;; XEmacs is distributed in the hope that it will be useful, but
+ − 18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
+ − 19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ − 20 ;; General Public License for more details.
+ − 21
+ − 22 ;; You should have received a copy of the GNU General Public License
+ − 23 ;; along with XEmacs; see the file COPYING. If not, write to the Free
+ − 24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ − 25 ;; 02111-1307, USA.
+ − 26
+ − 27 ;;; Synched up with: FSF 19.34 except as noted.
+ − 28
+ − 29 ;;; Commentary:
+ − 30
+ − 31 ;; This file is dumped with XEmacs.
+ − 32
+ − 33 ;; Edit, delete, or change attributes of all currently active Emacs
+ − 34 ;; buffers from a list summarizing their state. A good way to browse
+ − 35 ;; any special or scratch buffers you have loaded, since you can't find
+ − 36 ;; them by filename. The single entry point is `Buffer-menu-mode',
+ − 37 ;; normally bound to C-x C-b.
+ − 38
771
+ − 39 ;; Also contains buffers-tab code, because it's used by
+ − 40 ;; switch-to-next-buffer and friends.
+ − 41
428
+ − 42 ;;; Change Log:
+ − 43
+ − 44 ;; Merged by esr with recent mods to Emacs 19 buff-menu, 23 Mar 1993
+ − 45 ;;
+ − 46 ;; Modified by Bob Weiner, Motorola, Inc., 4/14/89
+ − 47 ;;
+ − 48 ;; Added optional backup argument to 'Buffer-menu-unmark' to make it undelete
+ − 49 ;; current entry and then move to previous one.
+ − 50 ;;
+ − 51 ;; Based on FSF code dating back to 1985.
+ − 52
+ − 53 ;;; Code:
444
+ − 54
428
+ − 55 ;;;Trying to preserve the old window configuration works well in
+ − 56 ;;;simple scenarios, when you enter the buffer menu, use it, and exit it.
+ − 57 ;;;But it does strange things when you switch back to the buffer list buffer
+ − 58 ;;;with C-x b, later on, when the window configuration is different.
+ − 59 ;;;The choice seems to be, either restore the window configuration
+ − 60 ;;;in all cases, or in no cases.
+ − 61 ;;;I decided it was better not to restore the window config at all. -- rms.
+ − 62
+ − 63 ;;;But since then, I changed buffer-menu to use the selected window,
+ − 64 ;;;so q now once again goes back to the previous window configuration.
+ − 65
+ − 66 ;;;(defvar Buffer-menu-window-config nil
+ − 67 ;;; "Window configuration saved from entry to `buffer-menu'.")
+ − 68
+ − 69 ; Put buffer *Buffer List* into proper mode right away
+ − 70 ; so that from now on even list-buffers is enough to get a buffer menu.
+ − 71
+ − 72 (defvar Buffer-menu-buffer-column 4)
+ − 73
+ − 74 (defvar Buffer-menu-mode-map nil)
+ − 75
+ − 76 (if Buffer-menu-mode-map
+ − 77 ()
+ − 78 (setq Buffer-menu-mode-map (make-keymap))
+ − 79 (suppress-keymap Buffer-menu-mode-map t)
+ − 80 (set-keymap-name Buffer-menu-mode-map 'Buffer-menu-mode-map) ; XEmacs
+ − 81 (define-key Buffer-menu-mode-map "q" 'Buffer-menu-quit)
+ − 82 (define-key Buffer-menu-mode-map "v" 'Buffer-menu-select)
+ − 83 (define-key Buffer-menu-mode-map "2" 'Buffer-menu-2-window)
+ − 84 (define-key Buffer-menu-mode-map "1" 'Buffer-menu-1-window)
+ − 85 (define-key Buffer-menu-mode-map "f" 'Buffer-menu-this-window)
+ − 86 (define-key Buffer-menu-mode-map "\C-m" 'Buffer-menu-this-window)
+ − 87 (define-key Buffer-menu-mode-map "o" 'Buffer-menu-other-window)
+ − 88 (define-key Buffer-menu-mode-map "\C-o" 'Buffer-menu-switch-other-window)
+ − 89 (define-key Buffer-menu-mode-map "s" 'Buffer-menu-save)
+ − 90 (define-key Buffer-menu-mode-map "d" 'Buffer-menu-delete)
+ − 91 (define-key Buffer-menu-mode-map "k" 'Buffer-menu-delete)
+ − 92 (define-key Buffer-menu-mode-map "\C-d" 'Buffer-menu-delete-backwards)
+ − 93 (define-key Buffer-menu-mode-map "\C-k" 'Buffer-menu-delete)
+ − 94 (define-key Buffer-menu-mode-map "x" 'Buffer-menu-execute)
+ − 95 (define-key Buffer-menu-mode-map " " 'next-line)
+ − 96 (define-key Buffer-menu-mode-map "n" 'next-line)
+ − 97 (define-key Buffer-menu-mode-map "p" 'previous-line)
+ − 98 (define-key Buffer-menu-mode-map 'backspace 'Buffer-menu-backup-unmark)
+ − 99 (define-key Buffer-menu-mode-map 'delete 'Buffer-menu-backup-unmark)
+ − 100 (define-key Buffer-menu-mode-map "~" 'Buffer-menu-not-modified)
+ − 101 (define-key Buffer-menu-mode-map "?" 'describe-mode)
+ − 102 (define-key Buffer-menu-mode-map "u" 'Buffer-menu-unmark)
+ − 103 (define-key Buffer-menu-mode-map "m" 'Buffer-menu-mark)
+ − 104 (define-key Buffer-menu-mode-map "t" 'Buffer-menu-visit-tags-table)
+ − 105 (define-key Buffer-menu-mode-map "%" 'Buffer-menu-toggle-read-only)
+ − 106 (define-key Buffer-menu-mode-map "g" 'revert-buffer)
+ − 107 (define-key Buffer-menu-mode-map 'button2 'Buffer-menu-mouse-select)
+ − 108 (define-key Buffer-menu-mode-map 'button3 'Buffer-menu-popup-menu)
+ − 109 )
+ − 110
+ − 111 ;; Buffer Menu mode is suitable only for specially formatted data.
+ − 112 (put 'Buffer-menu-mode 'mode-class 'special)
+ − 113
+ − 114 (defun Buffer-menu-mode ()
+ − 115 "Major mode for editing a list of buffers.
+ − 116 Each line describes one of the buffers in Emacs.
+ − 117 Letters do not insert themselves; instead, they are commands.
+ − 118 \\<Buffer-menu-mode-map>
+ − 119 \\[Buffer-menu-mouse-select] -- select buffer you click on, in place of the buffer menu.
+ − 120 \\[Buffer-menu-this-window] -- select current line's buffer in place of the buffer menu.
+ − 121 \\[Buffer-menu-other-window] -- select that buffer in another window,
+ − 122 so the buffer menu buffer remains visible in its window.
+ − 123 \\[Buffer-menu-switch-other-window] -- make another window display that buffer.
+ − 124 \\[Buffer-menu-mark] -- mark current line's buffer to be displayed.
+ − 125 \\[Buffer-menu-select] -- select current line's buffer.
+ − 126 Also show buffers marked with m, in other windows.
+ − 127 \\[Buffer-menu-1-window] -- select that buffer in full-frame window.
+ − 128 \\[Buffer-menu-2-window] -- select that buffer in one window,
+ − 129 together with buffer selected before this one in another window.
+ − 130 \\[Buffer-menu-visit-tags-table] -- visit-tags-table this buffer.
+ − 131 \\[Buffer-menu-not-modified] -- clear modified-flag on that buffer.
+ − 132 \\[Buffer-menu-save] -- mark that buffer to be saved, and move down.
+ − 133 \\[Buffer-menu-delete] -- mark that buffer to be deleted, and move down.
+ − 134 \\[Buffer-menu-delete-backwards] -- mark that buffer to be deleted, and move up.
+ − 135 \\[Buffer-menu-execute] -- delete or save marked buffers.
+ − 136 \\[Buffer-menu-unmark] -- remove all kinds of marks from current line.
+ − 137 With prefix argument, also move up one line.
+ − 138 \\[Buffer-menu-backup-unmark] -- back up a line and remove marks.
+ − 139 \\[Buffer-menu-toggle-read-only] -- toggle read-only status of buffer on this line."
+ − 140 (kill-all-local-variables)
+ − 141 (use-local-map Buffer-menu-mode-map)
+ − 142 (setq major-mode 'Buffer-menu-mode)
+ − 143 (setq mode-name "Buffer Menu")
+ − 144 (make-local-variable 'revert-buffer-function)
+ − 145 (setq revert-buffer-function 'Buffer-menu-revert-function)
+ − 146 (setq truncate-lines t)
+ − 147 (setq buffer-read-only t)
548
+ − 148 (make-local-hook 'mouse-track-click-hook) ; XEmacs
+ − 149 (add-hook 'mouse-track-click-hook 'Buffer-menu-maybe-mouse-select t t) ; XEmacs
428
+ − 150 (run-hooks 'buffer-menu-mode-hook))
+ − 151
+ − 152 (defun Buffer-menu-revert-function (ignore1 ignore2)
+ − 153 (list-buffers))
+ − 154
+ − 155 (defun Buffer-menu-buffer (error-if-non-existent-p)
+ − 156 "Return buffer described by this line of buffer menu."
+ − 157 (let* ((where (save-excursion
+ − 158 (beginning-of-line)
+ − 159 (+ (point) Buffer-menu-buffer-column)))
+ − 160 (name (and (not (eobp)) (get-text-property where 'buffer-name))))
+ − 161 (if name
+ − 162 (or (get-buffer name)
+ − 163 (if error-if-non-existent-p
+ − 164 (error "No buffer named `%s'" name)
+ − 165 nil))
+ − 166 (if error-if-non-existent-p
+ − 167 (error "No buffer on this line")
+ − 168 nil))))
+ − 169
+ − 170 (defun buffer-menu (&optional arg)
+ − 171 "Make a menu of buffers so you can save, delete or select them.
+ − 172 With argument, show only buffers that are visiting files.
+ − 173 Type ? after invocation to get help on commands available.
+ − 174 Type q immediately to make the buffer menu go away."
+ − 175 (interactive "P")
+ − 176 ;;; (setq Buffer-menu-window-config (current-window-configuration))
+ − 177 (switch-to-buffer (list-buffers-noselect arg))
+ − 178 (message
+ − 179 "Commands: d, s, x, u; f, o, 1, 2, m, v; ~, %%; q to quit; ? for help."))
+ − 180
+ − 181 (defun buffer-menu-other-window (&optional arg)
+ − 182 "Display a list of buffers in another window.
+ − 183 With the buffer list buffer, you can save, delete or select the buffers.
+ − 184 With argument, show only buffers that are visiting files.
+ − 185 Type ? after invocation to get help on commands available.
+ − 186 Type q immediately to make the buffer menu go away."
+ − 187 (interactive "P")
+ − 188 ;;; (setq Buffer-menu-window-config (current-window-configuration))
+ − 189 (switch-to-buffer-other-window (list-buffers-noselect arg))
+ − 190 (message
+ − 191 "Commands: d, s, x, u; f, o, 1, 2, m, v; ~, %%; q to quit; ? for help."))
+ − 192
+ − 193 (defun Buffer-menu-quit ()
+ − 194 "Quit the buffer menu."
+ − 195 (interactive)
+ − 196 (let ((buffer (current-buffer)))
+ − 197 ;; Switch away from the buffer menu and bury it.
+ − 198 (switch-to-buffer (other-buffer))
+ − 199 (bury-buffer buffer)))
+ − 200
+ − 201 (defun Buffer-menu-mark ()
+ − 202 "Mark buffer on this line for being displayed by \\<Buffer-menu-mode-map>\\[Buffer-menu-select] command."
+ − 203 (interactive)
+ − 204 (beginning-of-line)
+ − 205 (if (looking-at " [-M]")
+ − 206 (ding)
+ − 207 (let ((buffer-read-only nil))
+ − 208 (delete-char 1)
+ − 209 (insert ?>)
+ − 210 (forward-line 1))))
+ − 211
+ − 212 (defun Buffer-menu-unmark (&optional backup)
+ − 213 "Cancel all requested operations on buffer on this line and move down.
+ − 214 Optional ARG means move up."
+ − 215 (interactive "P")
+ − 216 (beginning-of-line)
+ − 217 (if (looking-at " [-M]")
+ − 218 (ding)
+ − 219 (let* ((buf (Buffer-menu-buffer t))
+ − 220 (mod (buffer-modified-p buf))
+ − 221 (readonly (save-excursion (set-buffer buf) buffer-read-only))
+ − 222 (buffer-read-only nil))
+ − 223 (delete-char 3)
+ − 224 (insert (if readonly (if mod " *%" " %") (if mod " * " " ")))))
+ − 225 (forward-line (if backup -1 1)))
+ − 226
+ − 227 (defun Buffer-menu-backup-unmark ()
+ − 228 "Move up and cancel all requested operations on buffer on line above."
+ − 229 (interactive)
+ − 230 (forward-line -1)
+ − 231 (Buffer-menu-unmark)
+ − 232 (forward-line -1))
+ − 233
+ − 234 (defun Buffer-menu-delete (&optional arg)
+ − 235 "Mark buffer on this line to be deleted by \\<Buffer-menu-mode-map>\\[Buffer-menu-execute] command.
+ − 236 Prefix arg is how many buffers to delete.
+ − 237 Negative arg means delete backwards."
+ − 238 (interactive "p")
+ − 239 (beginning-of-line)
+ − 240 (if (looking-at " [-M]") ;header lines
+ − 241 (ding)
+ − 242 (let ((buffer-read-only nil))
+ − 243 (if (or (null arg) (= arg 0))
+ − 244 (setq arg 1))
+ − 245 (while (> arg 0)
+ − 246 (delete-char 1)
+ − 247 (insert ?D)
+ − 248 (forward-line 1)
+ − 249 (setq arg (1- arg)))
+ − 250 (while (< arg 0)
+ − 251 (delete-char 1)
+ − 252 (insert ?D)
+ − 253 (forward-line -1)
+ − 254 (setq arg (1+ arg))))))
+ − 255
+ − 256 (defun Buffer-menu-delete-backwards (&optional arg)
+ − 257 "Mark buffer on this line to be deleted by \\<Buffer-menu-mode-map>\\[Buffer-menu-execute] command
+ − 258 and then move up one line. Prefix arg means move that many lines."
+ − 259 (interactive "p")
+ − 260 (Buffer-menu-delete (- (or arg 1)))
+ − 261 (while (looking-at " [-M]")
+ − 262 (forward-line 1)))
+ − 263
+ − 264 (defun Buffer-menu-save ()
+ − 265 "Mark buffer on this line to be saved by \\<Buffer-menu-mode-map>\\[Buffer-menu-execute] command."
+ − 266 (interactive)
+ − 267 (beginning-of-line)
+ − 268 (if (looking-at " [-M]") ;header lines
+ − 269 (ding)
+ − 270 (let ((buffer-read-only nil))
+ − 271 (forward-char 1)
+ − 272 (delete-char 1)
+ − 273 (insert ?S)
+ − 274 (forward-line 1))))
+ − 275
+ − 276 (defun Buffer-menu-not-modified (&optional arg)
+ − 277 "Mark buffer on this line as unmodified (no changes to save)."
+ − 278 (interactive "P")
+ − 279 (save-excursion
+ − 280 (set-buffer (Buffer-menu-buffer t))
+ − 281 (set-buffer-modified-p arg))
+ − 282 (save-excursion
+ − 283 (beginning-of-line)
+ − 284 (forward-char 1)
+ − 285 (if (= (char-after (point)) (if arg ? ?*))
+ − 286 (let ((buffer-read-only nil))
+ − 287 (delete-char 1)
+ − 288 (insert (if arg ?* ? ))))))
+ − 289
+ − 290 (defun Buffer-menu-execute ()
+ − 291 "Save and/or delete buffers marked with \\<Buffer-menu-mode-map>\\[Buffer-menu-save] or \\<Buffer-menu-mode-map>\\[Buffer-menu-delete] commands."
+ − 292 (interactive)
+ − 293 (save-excursion
+ − 294 (goto-char (point-min))
+ − 295 (forward-line 1)
+ − 296 (while (re-search-forward "^.S" nil t)
+ − 297 (let ((modp nil))
+ − 298 (save-excursion
+ − 299 (set-buffer (Buffer-menu-buffer t))
+ − 300 (save-buffer)
+ − 301 (setq modp (buffer-modified-p)))
+ − 302 (let ((buffer-read-only nil))
+ − 303 (delete-char -1)
+ − 304 (insert (if modp ?* ? ))))))
+ − 305 (save-excursion
+ − 306 (goto-char (point-min))
+ − 307 (forward-line 1)
+ − 308 (let ((buff-menu-buffer (current-buffer))
+ − 309 (buffer-read-only nil))
+ − 310 (while (search-forward "\nD" nil t)
446
+ − 311 (backward-char 1)
428
+ − 312 (let ((buf (Buffer-menu-buffer nil)))
+ − 313 (or (eq buf nil)
+ − 314 (eq buf buff-menu-buffer)
+ − 315 (save-excursion (kill-buffer buf))))
+ − 316 (if (Buffer-menu-buffer nil)
+ − 317 (progn (delete-char 1)
+ − 318 (insert ? ))
+ − 319 (delete-region (point) (progn (forward-line 1) (point)))
446
+ − 320 (backward-char 1))))))
428
+ − 321
+ − 322 (defun Buffer-menu-select ()
+ − 323 "Select this line's buffer; also display buffers marked with `>'.
+ − 324 You can mark buffers with the \\<Buffer-menu-mode-map>\\[Buffer-menu-mark] command.
+ − 325 This command deletes and replaces all the previously existing windows
+ − 326 in the selected frame."
+ − 327 (interactive)
+ − 328 (let ((buff (Buffer-menu-buffer t))
444
+ − 329 (menu (current-buffer))
428
+ − 330 (others ())
+ − 331 tem)
+ − 332 (goto-char (point-min))
+ − 333 (while (search-forward "\n>" nil t)
+ − 334 (setq tem (Buffer-menu-buffer t))
+ − 335 (let ((buffer-read-only nil))
+ − 336 (delete-char -1)
+ − 337 (insert ?\ ))
+ − 338 (or (eq tem buff) (memq tem others) (setq others (cons tem others))))
+ − 339 (setq others (nreverse others)
+ − 340 tem (/ (1- (frame-height)) (1+ (length others))))
+ − 341 (delete-other-windows)
+ − 342 (switch-to-buffer buff)
+ − 343 (or (eq menu buff)
+ − 344 (bury-buffer menu))
+ − 345 (if (equal (length others) 0)
+ − 346 (progn
+ − 347 ;;; ;; Restore previous window configuration before displaying
+ − 348 ;;; ;; selected buffers.
+ − 349 ;;; (if Buffer-menu-window-config
+ − 350 ;;; (progn
+ − 351 ;;; (set-window-configuration Buffer-menu-window-config)
+ − 352 ;;; (setq Buffer-menu-window-config nil)))
+ − 353 (switch-to-buffer buff))
+ − 354 (while others
+ − 355 (split-window nil tem)
+ − 356 (other-window 1)
+ − 357 (switch-to-buffer (car others))
+ − 358 (setq others (cdr others)))
+ − 359 (other-window 1) ;back to the beginning!
+ − 360 )))
+ − 361
+ − 362
+ − 363
442
+ − 364 (eval-when-compile (autoload 'visit-tags-table "etags"))
+ − 365
428
+ − 366 (defun Buffer-menu-visit-tags-table ()
+ − 367 "Visit the tags table in the buffer on this line. See `visit-tags-table'."
+ − 368 (interactive)
+ − 369 (let ((file (buffer-file-name (Buffer-menu-buffer t))))
+ − 370 (if file
+ − 371 (visit-tags-table file)
+ − 372 (error "Specified buffer has no file"))))
+ − 373
+ − 374 (defun Buffer-menu-1-window ()
+ − 375 "Select this line's buffer, alone, in full frame."
+ − 376 (interactive)
+ − 377 (switch-to-buffer (Buffer-menu-buffer t))
+ − 378 (bury-buffer (other-buffer))
+ − 379 (delete-other-windows)
+ − 380 ;; XEmacs:
+ − 381 ;; This is to get w->force_start set to nil. Don't ask me, I only work here.
+ − 382 (set-window-buffer (selected-window) (current-buffer)))
+ − 383
+ − 384 (defun Buffer-menu-mouse-select (event)
+ − 385 "Select the buffer whose line you click on."
+ − 386 (interactive "e")
+ − 387 (let (buffer)
+ − 388 (save-excursion
+ − 389 (set-buffer (event-buffer event)) ; XEmacs
+ − 390 (save-excursion
+ − 391 (goto-char (event-point event)) ; XEmacs
+ − 392 (setq buffer (Buffer-menu-buffer t))))
+ − 393 (select-window (event-window event)) ; XEmacs
+ − 394 (if (and (window-dedicated-p (selected-window))
+ − 395 (eq (selected-window) (frame-root-window)))
+ − 396 (switch-to-buffer-other-frame buffer)
+ − 397 (switch-to-buffer buffer))))
+ − 398
+ − 399 ;; XEmacs
+ − 400 (defun Buffer-menu-maybe-mouse-select (event &optional click-count)
+ − 401 (interactive "e")
+ − 402 (and (>= click-count 2)
+ − 403 (let ((buffer (current-buffer))
+ − 404 (point (point))
+ − 405 (config (current-window-configuration)))
+ − 406 (condition-case nil
+ − 407 (progn
+ − 408 (Buffer-menu-mouse-select event)
+ − 409 t)
+ − 410 (error
+ − 411 (set-window-configuration config)
+ − 412 (set-buffer buffer)
+ − 413 (goto-char point)
+ − 414 nil)))))
+ − 415
+ − 416 (defun Buffer-menu-this-window ()
+ − 417 "Select this line's buffer in this window."
+ − 418 (interactive)
+ − 419 (switch-to-buffer (Buffer-menu-buffer t)))
+ − 420
+ − 421 (defun Buffer-menu-other-window ()
+ − 422 "Select this line's buffer in other window, leaving buffer menu visible."
+ − 423 (interactive)
+ − 424 (switch-to-buffer-other-window (Buffer-menu-buffer t)))
+ − 425
+ − 426 (defun Buffer-menu-switch-other-window ()
+ − 427 "Make the other window select this line's buffer.
+ − 428 The current window remains selected."
+ − 429 (interactive)
+ − 430 (display-buffer (Buffer-menu-buffer t)))
+ − 431
+ − 432 (defun Buffer-menu-2-window ()
+ − 433 "Select this line's buffer, with previous buffer in second window."
+ − 434 (interactive)
+ − 435 (let ((buff (Buffer-menu-buffer t))
+ − 436 (menu (current-buffer))
+ − 437 (pop-up-windows t))
+ − 438 (delete-other-windows)
+ − 439 (switch-to-buffer (other-buffer))
+ − 440 (pop-to-buffer buff)
+ − 441 (bury-buffer menu)))
+ − 442
+ − 443 (defun Buffer-menu-toggle-read-only ()
+ − 444 "Toggle read-only status of buffer on this line, perhaps via version control."
+ − 445 (interactive)
+ − 446 (let (char)
+ − 447 (save-excursion
+ − 448 (set-buffer (Buffer-menu-buffer t))
+ − 449 (modeline-toggle-read-only)
+ − 450 (setq char (if buffer-read-only ?% ? )))
+ − 451 (save-excursion
+ − 452 (beginning-of-line)
+ − 453 (forward-char 2)
+ − 454 (if (/= (following-char) char)
+ − 455 (let (buffer-read-only)
+ − 456 (delete-char 1)
+ − 457 (insert char))))))
+ − 458
+ − 459 ;; XEmacs
+ − 460 (defvar Buffer-menu-popup-menu
+ − 461 '("Buffer Commands"
+ − 462 ["Select Buffer" Buffer-menu-select t]
+ − 463 ["Select buffer Other Window" Buffer-menu-other-window t]
+ − 464 ["Clear Buffer Modification Flag" Buffer-menu-not-modified t]
+ − 465 "----"
+ − 466 ["Mark Buffer for Selection" Buffer-menu-mark t]
+ − 467 ["Mark Buffer for Save" Buffer-menu-save t]
+ − 468 ["Mark Buffer for Deletion" Buffer-menu-delete t]
+ − 469 ["Unmark Buffer" Buffer-menu-unmark t]
+ − 470 "----"
+ − 471 ["Delete/Save Marked Buffers" Buffer-menu-execute t]
+ − 472 ))
+ − 473
+ − 474 ;; XEmacs
+ − 475 (defun Buffer-menu-popup-menu (event)
+ − 476 (interactive "e")
+ − 477 (mouse-set-point event)
+ − 478 (beginning-of-line)
+ − 479 (let ((buffer (Buffer-menu-buffer nil)))
+ − 480 (if buffer
+ − 481 (popup-menu
+ − 482 (nconc (list (car Buffer-menu-popup-menu)
+ − 483 (concat
+ − 484 "Commands on buffer \"" (buffer-name buffer) "\":")
+ − 485 "----")
+ − 486 (cdr Buffer-menu-popup-menu)))
+ − 487 (error "no buffer on this line"))))
+ − 488
+ − 489
+ − 490 ;; XEmacs
+ − 491 (defvar list-buffers-header-line
444
+ − 492 (concat " MR Buffer Size Mode File\n"
+ − 493 " -- ------ ---- ---- ----\n"))
428
+ − 494
+ − 495 ;; XEmacs
+ − 496 (defvar list-buffers-identification 'default-list-buffers-identification
+ − 497 "String used to identify this buffer, or a function of one argument
+ − 498 to generate such a string. This variable is always buffer-local.")
+ − 499 (make-variable-buffer-local 'list-buffers-identification)
+ − 500
+ − 501 ;; XEmacs
+ − 502 ;;;###autoload
+ − 503 (defvar list-buffers-directory nil)
+ − 504
+ − 505 ;;;###autoload
+ − 506 (make-variable-buffer-local 'list-buffers-directory)
+ − 507
+ − 508 ;; #### not synched
+ − 509 (defun default-list-buffers-identification (output)
+ − 510 (save-excursion
+ − 511 (let ((file (or (buffer-file-name (current-buffer))
776
+ − 512 (and-boundp 'list-buffers-directory
+ − 513 list-buffers-directory)))
428
+ − 514 (size (buffer-size))
+ − 515 (mode mode-name)
+ − 516 eob p s col)
+ − 517 (set-buffer output)
+ − 518 (end-of-line)
+ − 519 (setq eob (point))
+ − 520 (prin1 size output)
+ − 521 (setq p (point))
+ − 522 ;; right-justify the size
+ − 523 (move-to-column 19 t)
+ − 524 (setq col (point))
+ − 525 (if (> eob col)
+ − 526 (goto-char eob))
+ − 527 (setq s (- 6 (- p col)))
+ − 528 (while (> s 0) ; speed/consing tradeoff...
+ − 529 (insert ? )
+ − 530 (setq s (1- s)))
+ − 531 (end-of-line)
+ − 532 (indent-to 27 1)
+ − 533 (insert mode)
+ − 534 (if (not file)
+ − 535 nil
+ − 536 ;; if the mode-name is really long, clip it for the filename
+ − 537 (if (> 0 (setq s (- 39 (current-column))))
+ − 538 (delete-char (max s (- eob (point)))))
+ − 539 (indent-to 40 1)
+ − 540 (insert file)))))
+ − 541
+ − 542 ;; #### not synched
+ − 543 (defun list-buffers-internal (output &optional predicate)
+ − 544 (let ((current (current-buffer))
+ − 545 (buffers (buffer-list)))
+ − 546 (save-excursion
+ − 547 (set-buffer output)
+ − 548 (setq buffer-read-only nil)
+ − 549 (erase-buffer)
+ − 550 (buffer-disable-undo output)
+ − 551 (insert list-buffers-header-line)
+ − 552
+ − 553 (while buffers
+ − 554 (let* ((col1 19)
+ − 555 (buffer (car buffers))
+ − 556 (name (buffer-name buffer))
+ − 557 this-buffer-line-start)
+ − 558 (setq buffers (cdr buffers))
+ − 559 (cond ((null name)) ;deleted buffer
+ − 560 ((and predicate
+ − 561 (not (if (stringp predicate)
+ − 562 (string-match predicate name)
+ − 563 (funcall predicate buffer))))
+ − 564 nil)
+ − 565 (t
+ − 566 (set-buffer buffer)
+ − 567 (let ((ro buffer-read-only)
+ − 568 (id list-buffers-identification))
+ − 569 (set-buffer output)
+ − 570 (setq this-buffer-line-start (point))
+ − 571 (insert (if (eq buffer current)
+ − 572 (progn (setq current (point)) ?\.)
+ − 573 ?\ ))
+ − 574 (insert (if (buffer-modified-p buffer)
444
+ − 575 ?\*
428
+ − 576 ?\ ))
+ − 577 (insert (if ro
+ − 578 ?\%
+ − 579 ?\ ))
+ − 580 (if (string-match "[\n\"\\ \t]" name)
+ − 581 (let ((print-escape-newlines t))
+ − 582 (prin1 name output))
+ − 583 (insert ?\ name))
+ − 584 (indent-to col1 1)
+ − 585 (cond ((stringp id)
+ − 586 (insert id))
+ − 587 (id
+ − 588 (set-buffer buffer)
+ − 589 (condition-case e
+ − 590 (funcall id output)
+ − 591 (error
+ − 592 (princ "***" output) (prin1 e output)))
+ − 593 (set-buffer output)
+ − 594 (goto-char (point-max)))))
+ − 595 (put-nonduplicable-text-property this-buffer-line-start
+ − 596 (point)
+ − 597 'buffer-name name)
+ − 598 (put-nonduplicable-text-property this-buffer-line-start
+ − 599 (point)
+ − 600 'highlight t)
+ − 601 (insert ?\n)))))
+ − 602
+ − 603 (Buffer-menu-mode)
+ − 604 (if (not (bufferp current))
+ − 605 (goto-char current)))))
+ − 606 ;(define-key ctl-x-map "\C-b" 'list-buffers)
+ − 607
+ − 608 (defun list-buffers (&optional files-only)
+ − 609 "Display a list of names of existing buffers.
+ − 610 The list is displayed in a buffer named `*Buffer List*'.
+ − 611 Note that buffers with names starting with spaces are omitted.
444
+ − 612 Non-nil optional arg FILES-ONLY means mention only file buffers.
428
+ − 613
+ − 614 The M column contains a * for buffers that are modified.
+ − 615 The R column contains a % for buffers that are read-only."
+ − 616 (interactive (list (if current-prefix-arg t nil))) ; XEmacs
+ − 617 (display-buffer (list-buffers-noselect files-only)))
+ − 618
+ − 619 ;; #### not synched
+ − 620 (defun list-buffers-noselect (&optional files-only)
+ − 621 "Create and return a buffer with a list of names of existing buffers.
+ − 622 The buffer is named `*Buffer List*'.
+ − 623 Note that buffers with names starting with spaces are omitted.
444
+ − 624 Non-nil optional arg FILES-ONLY means mention only file buffers.
428
+ − 625
+ − 626 The M column contains a * for buffers that are modified.
+ − 627 The R column contains a % for buffers that are read-only."
+ − 628 (let ((buffer (get-buffer-create "*Buffer List*")))
+ − 629 (list-buffers-internal buffer
+ − 630 (if (memq files-only '(t nil))
+ − 631 #'(lambda (b)
+ − 632 (let ((n (buffer-name b)))
+ − 633 (cond ((and (/= 0 (length n))
+ − 634 (= (aref n 0) ?\ ))
+ − 635 ;;don't mention if starts with " "
+ − 636 nil)
+ − 637 (files-only
+ − 638 (buffer-file-name b))
+ − 639 (t
+ − 640 t))))
+ − 641 files-only))
+ − 642 buffer))
+ − 643
442
+ − 644 (defun buffers-menu-omit-invisible-buffers (buf)
+ − 645 "For use as a value of `buffers-menu-omit-function'.
+ − 646 Omits normally invisible buffers (those whose name begins with a space)."
+ − 647 (not (null (string-match "\\` " (buffer-name buf)))))
+ − 648
771
+ − 649 ;;; The Buffers tab
+ − 650
+ − 651 ;; Some of this is taken from the buffer-menu stuff in menubar-items.el
+ − 652
+ − 653 (defgroup buffers-tab nil
+ − 654 "Customization of `Buffers' tab."
+ − 655 :group 'gutter)
+ − 656
+ − 657 (defcustom buffers-tab-max-size 6
+ − 658 "*Maximum number of entries which may appear on the \"Buffers\" tab.
+ − 659 If this is 10, then only the ten most-recently-selected buffers will be
+ − 660 shown. If this is nil, then all buffers will be shown. Setting this to
+ − 661 a large number or nil will slow down tab responsiveness."
+ − 662 :type '(choice (const :tag "Show all" nil)
+ − 663 (integer 6))
+ − 664 :group 'buffers-tab)
+ − 665
+ − 666 (defcustom buffers-tab-switch-to-buffer-function 'buffers-tab-switch-to-buffer
+ − 667 "*The function to call to select a buffer from the buffers tab.
+ − 668 `switch-to-buffer' is a good choice, as is `pop-to-buffer'."
+ − 669 :type '(radio (function-item switch-to-buffer)
+ − 670 (function-item pop-to-buffer)
+ − 671 (function :tag "Other"))
+ − 672 :group 'buffers-tab)
+ − 673
+ − 674 (defcustom buffers-tab-omit-function 'buffers-menu-omit-invisible-buffers
+ − 675 "*If non-nil, a function specifying the buffers to omit from the buffers tab.
+ − 676 This is passed a buffer and should return non-nil if the buffer should be
+ − 677 omitted. The default value `buffers-menu-omit-invisible-buffers' omits
+ − 678 buffers that are normally considered \"invisible\" (those whose name
+ − 679 begins with a space)."
+ − 680 :type '(choice (const :tag "None" nil)
+ − 681 function)
+ − 682 :group 'buffers-tab)
+ − 683
+ − 684 (defcustom buffers-tab-selection-function 'select-buffers-tab-buffers-by-mode
+ − 685 "*If non-nil, a function specifying the buffers to select from the
+ − 686 buffers tab. This is passed two buffers and should return non-nil if
+ − 687 the second buffer should be selected. The default value
+ − 688 `select-buffers-tab-buffers-by-mode' groups buffers by major mode and
+ − 689 by `buffers-tab-grouping-regexp'."
+ − 690
+ − 691 :type '(choice (const :tag "None" nil)
+ − 692 function)
+ − 693 :group 'buffers-tab)
+ − 694
+ − 695 (defcustom buffers-tab-filter-functions (list buffers-tab-selection-function)
+ − 696 "*If non-nil, a list of functions specifying the buffers to select
+ − 697 from the buffers tab.
+ − 698 Each function in the list is passed two buffers, the buffer to
+ − 699 potentially select and the context buffer, and should return non-nil
+ − 700 if the first buffer should be selected. The default value groups
+ − 701 buffers by major mode and by `buffers-tab-grouping-regexp'."
+ − 702
+ − 703 :type '(choice (const :tag "None" nil)
+ − 704 sexp)
+ − 705 :group 'buffers-tab)
+ − 706
+ − 707 (defcustom buffers-tab-sort-function nil
+ − 708 "*If non-nil, a function specifying the buffers to select from the
+ − 709 buffers tab. This is passed the buffer list and returns the list in the
+ − 710 order desired for the tab widget. The default value `nil' leaves the
+ − 711 list in `buffer-list' order (usual most-recently-selected-first)."
+ − 712
+ − 713 :type '(choice (const :tag "None" nil)
+ − 714 function)
+ − 715 :group 'buffers-tab)
+ − 716
+ − 717 (make-face 'buffers-tab "Face for displaying the buffers tab.")
+ − 718 (set-face-parent 'buffers-tab 'default)
+ − 719
+ − 720 (defcustom buffers-tab-face 'buffers-tab
+ − 721 "*Face to use for displaying the buffers tab."
+ − 722 :type 'face
+ − 723 :group 'buffers-tab)
+ − 724
+ − 725 (defcustom buffers-tab-grouping-regexp
+ − 726 '("^\\(gnus-\\|message-mode\\|mime/viewer-mode\\)"
+ − 727 "^\\(emacs-lisp-\\|lisp-\\)")
+ − 728 "*If non-nil, a list of regular expressions for buffer grouping.
+ − 729 Each regular expression is applied to the current major-mode symbol
+ − 730 name and mode-name, if it matches then any other buffers that match
+ − 731 the same regular expression be added to the current group."
+ − 732 :type '(choice (const :tag "None" nil)
+ − 733 sexp)
+ − 734 :group 'buffers-tab)
+ − 735
+ − 736 (defcustom buffers-tab-format-buffer-line-function 'format-buffers-tab-line
+ − 737 "*The function to call to return a string to represent a buffer in the
+ − 738 buffers tab. The function is passed a buffer and should return a
+ − 739 string. The default value `format-buffers-tab-line' just returns the
+ − 740 name of the buffer, optionally truncated to
+ − 741 `buffers-tab-max-buffer-line-length'. Also check out
+ − 742 `slow-format-buffers-menu-line' which returns a whole bunch of info
+ − 743 about a buffer."
+ − 744 :type 'function
+ − 745 :group 'buffers-tab)
+ − 746
+ − 747 (defvar buffers-tab-default-buffer-line-length
+ − 748 (make-specifier-and-init 'generic '((global ((default) . 25))) t)
+ − 749 "*Maximum length of text which may appear in a \"Buffers\" tab.
+ − 750 This is a specifier, use set-specifier to modify it.")
+ − 751
+ − 752 (defcustom buffers-tab-max-buffer-line-length
+ − 753 (specifier-instance buffers-tab-default-buffer-line-length)
+ − 754 "*Maximum length of text which may appear in a \"Buffers\" tab.
+ − 755 Buffer names over this length will be truncated with elipses.
+ − 756 If this is 0, then the full buffer name will be shown."
+ − 757 :type '(choice (const :tag "Show all" 0)
+ − 758 (integer 25))
+ − 759 :group 'buffers-tab
+ − 760 :set #'(lambda (var val)
+ − 761 (set-specifier buffers-tab-default-buffer-line-length val)
+ − 762 (setq buffers-tab-max-buffer-line-length val)))
+ − 763
+ − 764 (defun buffers-tab-switch-to-buffer (buffer)
+ − 765 "For use as a value for `buffers-tab-switch-to-buffer-function'."
+ − 766 (unless (eq (window-buffer) buffer)
+ − 767 ;; this used to add the norecord flag to both calls below.
+ − 768 ;; this is bogus because it is a pervasive assumption in XEmacs
+ − 769 ;; that the current buffer is at the front of the buffers list.
+ − 770 ;; for example, select an item and then do M-C-l
+ − 771 ;; (switch-to-other-buffer). Things get way confused.
+ − 772 (if (> (length (windows-of-buffer buffer)) 0)
+ − 773 (select-window (car (windows-of-buffer buffer)))
+ − 774 (switch-to-buffer buffer))))
+ − 775
+ − 776 (defun select-buffers-tab-buffers-by-mode (buffer-to-select buf1)
+ − 777 "For use as a value of `buffers-tab-selection-function'.
+ − 778 This selects buffers by major mode `buffers-tab-grouping-regexp'."
+ − 779 (let ((mode1 (symbol-name (symbol-value-in-buffer 'major-mode buf1)))
+ − 780 (mode2 (symbol-name (symbol-value-in-buffer 'major-mode
+ − 781 buffer-to-select)))
+ − 782 (modenm1 (symbol-value-in-buffer 'mode-name buf1))
+ − 783 (modenm2 (symbol-value-in-buffer 'mode-name buffer-to-select)))
+ − 784 (cond ((or (eq mode1 mode2)
+ − 785 (eq modenm1 modenm2)
+ − 786 (and (string-match "^[^-]+-" mode1)
+ − 787 (string-match
+ − 788 (concat "^" (regexp-quote
+ − 789 (substring mode1 0 (match-end 0))))
+ − 790 mode2))
+ − 791 (and buffers-tab-grouping-regexp
+ − 792 (find-if #'(lambda (x)
+ − 793 (or
+ − 794 (and (string-match x mode1)
+ − 795 (string-match x mode2))
+ − 796 (and (string-match x modenm1)
+ − 797 (string-match x modenm2))))
+ − 798 buffers-tab-grouping-regexp)))
+ − 799 t)
+ − 800 (t nil))))
+ − 801
+ − 802 (defun format-buffers-tab-line (buffer)
+ − 803 "For use as a value of `buffers-tab-format-buffer-line-function'.
+ − 804 This just returns the buffer's name, optionally truncated."
+ − 805 (let ((len (specifier-instance buffers-tab-default-buffer-line-length)))
+ − 806 (if (and (> len 0)
+ − 807 (> (length (buffer-name buffer)) len))
+ − 808 (if (string-match ".*<.>$" (buffer-name buffer))
+ − 809 (concat (substring (buffer-name buffer)
+ − 810 0 (- len 6)) "..."
+ − 811 (substring (buffer-name buffer) -3))
+ − 812 (concat (substring (buffer-name buffer)
+ − 813 0 (- len 3)) "..."))
+ − 814 (buffer-name buffer))))
+ − 815
+ − 816 (defsubst build-buffers-tab-internal (buffers)
+ − 817 (let ((selected t))
+ − 818 (mapcar
+ − 819 #'(lambda (buffer)
+ − 820 (prog1
+ − 821 (vector
+ − 822 (funcall buffers-tab-format-buffer-line-function
+ − 823 buffer)
+ − 824 (list buffers-tab-switch-to-buffer-function
+ − 825 (buffer-name buffer))
+ − 826 :selected selected)
+ − 827 (when selected (setq selected nil))))
+ − 828 buffers)))
+ − 829
+ − 830 ;;; #### SJT would like this function to have a sort function list. I
+ − 831 ;;; don't see how this could work given that sorting is not
+ − 832 ;;; cumulative --andyp.
+ − 833 (defun buffers-tab-items (&optional in-deletion frame force-selection)
+ − 834 "Return a list of tab instantiators based on the current buffers list.
+ − 835 This function is used as the tab filter for the top-level buffers
+ − 836 \"Buffers\" tab. It dynamically creates a list of tab instantiators
+ − 837 to use as the contents of the tab. The contents and order of the list
+ − 838 is controlled by `buffers-tab-filter-functions' which by default
+ − 839 groups buffers according to major mode and removes invisible buffers.
+ − 840 You can control how many buffers will be shown by setting
+ − 841 `buffers-tab-max-size'. You can control the text of the tab items by
+ − 842 redefining the function `format-buffers-menu-line'."
+ − 843 (save-match-data
+ − 844 ;; NB it is too late if we run the omit function as part of the
+ − 845 ;; filter functions because we need to know which buffer is the
+ − 846 ;; context buffer before they get run.
+ − 847 (let* ((buffers (delete-if
+ − 848 buffers-tab-omit-function (buffer-list frame)))
+ − 849 (first-buf (car buffers)))
+ − 850 ;; maybe force the selected window
+ − 851 (when (and force-selection
+ − 852 (not in-deletion)
+ − 853 (not (eq first-buf (window-buffer (selected-window frame)))))
+ − 854 (setq buffers (cons (window-buffer (selected-window frame))
+ − 855 (delq first-buf buffers))))
+ − 856 ;; if we're in deletion ignore the current buffer
+ − 857 (when in-deletion
+ − 858 (setq buffers (delq (current-buffer) buffers))
+ − 859 (setq first-buf (car buffers)))
+ − 860 ;; filter buffers
+ − 861 (when buffers-tab-filter-functions
+ − 862 (setq buffers
+ − 863 (delete-if
+ − 864 #'null
+ − 865 (mapcar #'(lambda (buf)
+ − 866 (let ((tmp-buf buf))
+ − 867 (mapc #'(lambda (fun)
+ − 868 (unless (funcall fun buf first-buf)
+ − 869 (setq tmp-buf nil)))
+ − 870 buffers-tab-filter-functions)
+ − 871 tmp-buf))
+ − 872 buffers))))
+ − 873 ;; maybe shorten list of buffers
+ − 874 (and (integerp buffers-tab-max-size)
+ − 875 (> buffers-tab-max-size 1)
+ − 876 (> (length buffers) buffers-tab-max-size)
+ − 877 (setcdr (nthcdr (1- buffers-tab-max-size) buffers) nil))
+ − 878 ;; sort buffers in group (default is most-recently-selected)
+ − 879 (when buffers-tab-sort-function
+ − 880 (setq buffers (funcall buffers-tab-sort-function buffers)))
+ − 881 ;; convert list of buffers to list of structures used by tab widget
+ − 882 (setq buffers (build-buffers-tab-internal buffers))
+ − 883 buffers)))
+ − 884
428
+ − 885 (provide 'buff-menu)
+ − 886
+ − 887 ;;; buff-menu.el ends here