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