annotate lisp/buff-menu.el @ 4792:95b04754ea8c

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