10228
|
1 ;;; msb.el --- Customizable buffer-selection with multiple menus.
|
|
2 ;; Copyright (C) 1993, 1994 Lars Lindberg <Lars.Lindberg@sypro.cap.se>
|
|
3 ;;
|
|
4 ;; Author: Lars Lindberg <Lars.Lindberg@sypro.cap.se>
|
|
5 ;; Created: 8 Oct 1993
|
|
6 ;; $Revision: 3.21 $
|
|
7 ;; $Date: 1994/12/22 07:58:27 $
|
|
8 ;; Keywords: mouse buffer menu
|
|
9 ;;
|
|
10 ;; This program is free software; you can redistribute it and/or modify
|
|
11 ;; it under the terms of the GNU General Public License as published by
|
|
12 ;; the Free Software Foundation; either version 2 of the License, or
|
|
13 ;; (at your option) any later version.
|
|
14 ;;
|
|
15 ;; This program is distributed in the hope that it will be useful,
|
|
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
18 ;; GNU General Public License for more details.
|
|
19 ;;
|
|
20 ;; You should have received a copy of the GNU General Public License
|
|
21 ;; along with this program; if not, write to the Free Software
|
|
22 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
23
|
|
24 ;; LCD Archive Entry:
|
|
25 ;; msb|Lars Lindberg|Lars.Lindberg@sypro.cap.se|
|
|
26 ;; Choose buffer with the mouse.
|
|
27 ;; $Date: 1994/12/22 07:58:27 $|$Revision: 3.21 $|~/packages/msb.el.Z|
|
|
28
|
|
29 ;;; Commentary:
|
|
30 ;;
|
|
31 ;; Purpose of this package:
|
|
32 ;; 1. Offer a function for letting the user choose buffer,
|
|
33 ;; not necessarily for switching to it.
|
|
34 ;; 2. Make a better mouse-buffer-menu.
|
|
35 ;;
|
|
36 ;; Installation:
|
|
37 ;; (require 'msb)
|
|
38 ;; Note! You now use msb instead of mouse-buffer-menu.
|
|
39 ;;
|
|
40 ;; Now try c-mouse-down-1 (Press <CTRL> and mouse button 1 at the
|
|
41 ;; same time).
|
|
42 ;;
|
|
43 ;; Customization:
|
|
44 ;; Look at the variable 'msb-menu-cond' for deciding what menus you
|
|
45 ;; want. It's not that hard to customize, despite my not-so-good
|
|
46 ;; doc-string. Feel free to send me a better doc-string.
|
|
47 ;; There are some constants for you to try here:
|
|
48 ;; msb--few-menus
|
|
49 ;; msb--very-many-menus (default)
|
|
50 ;;
|
|
51 ;; Look at the variable 'msb-item-handling-function' for customization
|
|
52 ;; of the appearance of every menu item. Try for instance setting
|
|
53 ;; it to 'msb-alon-item-handler.
|
|
54 ;;
|
|
55 ;; Look at the variable 'msb-item-sort-function' for customization
|
|
56 ;; of sorting the menus. Set it to t for instance, which means no
|
|
57 ;; sorting - you will get latest used buffer first.
|
|
58 ;;
|
|
59 ;; Also check out the variable 'msb-display-invisible-buffers-p'
|
|
60
|
|
61 ;; Known bugs:
|
|
62 ;; - `msb' does not work on a non-X-toolkit Emacs.
|
|
63 ;; Future enhancements:
|
|
64 ;; - [Mattes] had a suggestion about sorting files by extension.
|
|
65 ;; I (Lars Lindberg) think this case could be solved if msb.el was
|
|
66 ;; rewritten to handle more dynamic splitting. It's now completely
|
|
67 ;; static, depending on the menu-cond. If the splitting could also
|
|
68 ;; be done by a user-defined function a lot of cases would be
|
|
69 ;; solved.
|
|
70 ;; - [Jim] suggested that the Frame menu became a part of the buffer menu.
|
|
71
|
|
72 ;;; Change Log
|
|
73 ;; 3.21 22/12-94
|
|
74 ;; Fixed bug that occured in non X-toolkit versions of Emacs.
|
|
75 ;; [Chalupsky] pointed out that a global `save-match-data' is
|
|
76 ;; necessary.
|
|
77 ;; Bug found. Thanks [kifer].
|
|
78 ;; 3.16 20/12-94
|
|
79 ;; Added separators to the menu. New variable `msb-separator-diff'.
|
|
80 ;; New variable `msb-files-by-directory-sort-key'.
|
|
81 ;; Removed `msb--many-menus.'
|
|
82 ;; Fixed bugs.
|
|
83 ;; 3.13 20/12-94
|
|
84 ;; Menu fix for non-X-toolkit Emacsen and new "process"
|
|
85 ;; menu. Thanks [jim].
|
|
86 ;; Bug for 'files-by-type'.
|
|
87 ;; Restored the call to `msb-after-load-hooks'. Thanks [larry].
|
|
88 ;; Major fixes by [Ake].
|
|
89 ;; Menu-bar buffer-menu now has menu-toggle at top level.
|
|
90 ;; 3.6 16/12-94
|
|
91 ;; Added variable `msb-max-file-menu-items'.
|
|
92 ;; Removed a large part of the change log.
|
|
93 ;; Found bug.
|
|
94 ;; 3.3 16/12-94
|
|
95 ;; Found bugs.
|
|
96 ;; 3.1 16/12-94
|
|
97 ;; Now has two types of menus - "files by directory" and "files
|
|
98 ;; by type".
|
|
99 ;; Added variable `msb-files-by-directory'.
|
|
100 ;; Fixed a number of bugs for older versions.
|
|
101 ;; 2.11 16/12-94
|
|
102 ;; Added 'no-multi to msb-menu-cond.
|
|
103 ;; Added possibility to shift the menu leftwards. Thanks [kifer].
|
|
104 ;; 2.8 15/12-94
|
|
105 ;; Now aware of earlier versions of Emacs that doesn't have the
|
|
106 ;; function `frame-or-buffer-changed-p' or the variable
|
|
107 ;; `menu-bar-update-hook'. Thanks [will].
|
|
108 ;; 2.7 14/12-94
|
|
109 ;; Better installation.
|
|
110 ;; 2.6 14/12-94
|
|
111 ;; Now only makes up the menu when necessary.
|
|
112 ;; Added menu-bar support.
|
|
113 ;; Now handles errors in msb-menu-cond better. Thanks [jaalto].
|
|
114 ;; Added MH-awareness. Thanks [kifer].
|
|
115 ;; Added autoload statements.
|
|
116 ;; 2.3 8/12-94
|
|
117 ;; Now uses RCS version numbering for msb.el version number.
|
|
118 ;; Submitted this to LCD.
|
|
119
|
|
120 ;;; Thanks goes to
|
|
121 ;; [msb] - Mark Brader <msb@sq.com>
|
|
122 ;; [Chalupsky] - Hans Chalupsky <hans@cs.Buffalo.EDU>
|
|
123 ;; [jim] - Jim Berry <m1jhb00@FRB.GOV>
|
|
124 ;; [larry] - Larry Rosenberg <ljr@ictv.com>
|
|
125 ;; [will] - Will Henney <will@astroscu.unam.mx>
|
|
126 ;; [jaalto] - Jari Aalto <jaalto@tre.tele.nokia.fi>
|
|
127 ;; [kifer] - Michael Kifer <kifer@sbkifer.cs.sunysb.edu>
|
|
128 ;; [Gael] - Gael Marziou <gael@gnlab030.grenoble.hp.com>
|
|
129 ;; [Gillespie] - Dave Gillespie <daveg@thymus.synaptics.com>
|
|
130 ;; [Alon] - Alon Albert <alon@milcse.rtsg.mot.com>
|
|
131 ;; [KevinB] - Kevin Broadey, <KevinB@bartley.demon.co.uk>
|
|
132 ;; [Ake] - Ake Stenhof <ake@cadpoint.se>
|
|
133 ;; [RMS] - Richard Stallman <rms@gnu.ai.mit.edu>
|
|
134 ;; [Fisk] - Steve Fisk <fisk@medved.bowdoin.edu>
|
|
135
|
|
136 ;;; Code:
|
|
137
|
|
138 (require 'cl)
|
|
139
|
|
140 ;;;
|
|
141 ;;; Some example constants to be used for 'msb-menu-cond'. See that
|
|
142 ;;; variable for more information. Please note that if the condition
|
|
143 ;;; returns 'multi, then the buffer can appear in several menus.
|
|
144 ;;;
|
|
145 (defconst msb--few-menus
|
|
146 '(((and (boundp 'server-buffer-clients)
|
|
147 server-buffer-clients
|
|
148 'multi)
|
|
149 3030
|
|
150 "Clients (%d)")
|
|
151 ((and msb-display-invisible-buffers-p
|
|
152 (msb-invisible-buffer-p)
|
|
153 'multi)
|
|
154 3090
|
|
155 "Invisible buffers (%d)")
|
|
156 ((eq major-mode 'dired-mode)
|
|
157 2010
|
|
158 "Dired (%d)"
|
|
159 msb-dired-item-handler
|
|
160 msb-sort-by-directory)
|
|
161 ((eq major-mode 'Man-mode)
|
|
162 4090
|
|
163 "Manuals (%d)")
|
|
164 ((eq major-mode 'w3-mode)
|
|
165 4020
|
|
166 "WWW (%d)")
|
|
167 ((or (memq major-mode '(rmail-mode vm-summary-mode vm-mode mail-mode))
|
|
168 (memq major-mode '(mh-letter-mode
|
|
169 mh-show-mode
|
|
170 mh-folder-mode))
|
|
171 (memq major-mode '(gnus-summary-mode
|
|
172 news-reply-mode
|
|
173 gnus-group-mode
|
|
174 gnus-article-mode
|
|
175 gnus-kill-file-mode
|
|
176 gnus-browse-killed-mode)))
|
|
177 4010
|
|
178 "Mail (%d)")
|
|
179 ((not buffer-file-name)
|
|
180 4099
|
|
181 "Buffers (%d)")
|
|
182 ('no-multi
|
|
183 1099
|
|
184 "Files (%d)")))
|
|
185
|
|
186 (defconst msb--very-many-menus
|
|
187 '(((and (boundp 'server-buffer-clients)
|
|
188 server-buffer-clients
|
|
189 'multi)
|
|
190 1010
|
|
191 "Clients (%d)")
|
|
192 ((and (boundp 'vc-mode) vc-mode 'multi)
|
|
193 1020
|
|
194 "Version Control (%d)")
|
|
195 ((and buffer-file-name
|
|
196 (buffer-modified-p)
|
|
197 'multi)
|
|
198 1030
|
|
199 "Changed files (%d)")
|
|
200 ((and (get-buffer-process (current-buffer))
|
|
201 'multi)
|
|
202 1040
|
|
203 "Processes (%d)")
|
|
204 ((and msb-display-invisible-buffers-p
|
|
205 (msb-invisible-buffer-p)
|
|
206 'multi)
|
|
207 1090
|
|
208 "Invisible buffers (%d)")
|
|
209 ((eq major-mode 'dired-mode)
|
|
210 2010
|
|
211 "Dired (%d)"
|
|
212 ;; Note this different menu-handler
|
|
213 msb-dired-item-handler
|
|
214 ;; Also note this item-sorter
|
|
215 msb-sort-by-directory)
|
|
216 ((eq major-mode 'Man-mode)
|
|
217 4030
|
|
218 "Manuals (%d)")
|
|
219 ((eq major-mode 'w3-mode)
|
|
220 4020
|
|
221 "WWW (%d)")
|
|
222 ((or (memq major-mode '(rmail-mode vm-summary-mode vm-mode mail-mode))
|
|
223 (memq major-mode '(mh-letter-mode
|
|
224 mh-show-mode
|
|
225 mh-folder-mode))
|
|
226 (memq major-mode '(gnus-summary-mode
|
|
227 news-reply-mode
|
|
228 gnus-group-mode
|
|
229 gnus-article-mode
|
|
230 gnus-kill-file-mode
|
|
231 gnus-browse-killed-mode)))
|
|
232 4010
|
|
233 "Mail (%d)")
|
|
234 ;; Catchup for all non-file buffers
|
|
235 ((and (not buffer-file-name)
|
|
236 'no-multi)
|
|
237 4099
|
|
238 "Other non-file buffers (%d)")
|
|
239 ((and (string-match "/\\.[^/]*$" buffer-file-name)
|
|
240 'multi)
|
|
241 3090
|
|
242 "Hidden Files (%d)")
|
|
243 ((memq major-mode '(c-mode c++-mode))
|
|
244 3010
|
|
245 "C/C++ Files (%d)")
|
|
246 ((eq major-mode 'emacs-lisp-mode)
|
|
247 3020
|
|
248 "Elisp Files (%d)")
|
|
249 ((eq major-mode 'latex-mode)
|
|
250 3030
|
|
251 "LaTex Files (%d)")
|
|
252 ('no-multi
|
|
253 3099
|
|
254 "Other files (%d)")))
|
|
255
|
|
256 ;; msb--many-menus is obsolete
|
|
257 (defvar msb--many-menus msb--very-many-menus)
|
|
258
|
|
259 ;;;
|
|
260 ;;; Customizable variables
|
|
261 ;;;
|
|
262
|
|
263 (defvar msb-separator-diff 100
|
|
264 "*Non-nil means use separators.
|
|
265 The separators will appear between all menus that have a sorting key that differs by this value or more.")
|
|
266
|
|
267 (defvar msb-files-by-directory-sort-key 0
|
|
268 "*The sort key for files sorted by directory")
|
|
269
|
|
270 (defvar msb-max-menu-items 25
|
|
271 "*The maximum number of items in a menu.
|
|
272 If this variable is set to 15 for instance, then the 15 latest used
|
|
273 buffer that fits in a certain submenu will appear in that submenu.
|
|
274 Nil means no limit.")
|
|
275
|
|
276 (defvar msb-max-file-menu-items 10
|
|
277 "*The maximum number of items from different directories.
|
|
278
|
|
279 When the menu is of type 'file by directory', this is the maximum
|
|
280 number of buffers that are clumped togehter from different
|
|
281 directories.
|
|
282
|
|
283 If the value is not a number, then the value 10 is used.")
|
|
284
|
|
285 (defvar msb-most-recently-used-sort-key -1010
|
|
286 "*Where should the menu with the most recently used buffers be placed?")
|
|
287
|
|
288 (defvar msb-display-most-recently-used t
|
|
289 "*How many buffers should be in the most-recently-used menu.
|
|
290 No buffers at all if less than 1 or nil.
|
|
291 T means use the value of `msb-max-menu-items' in the way it is defined.")
|
|
292
|
|
293 (defvar msb-most-recently-used-title "Most recently used (%d)"
|
|
294 "*The title for the most-recently-used menu.")
|
|
295
|
|
296 (defvar msb-horizontal-shift-function '(lambda () 0)
|
|
297 "*Function that specifies a number of pixels by which the top menu should
|
|
298 be shifted leftwards.")
|
|
299
|
|
300 (defvar msb-display-invisible-buffers-p nil
|
|
301 "*Show invisible buffers or not.
|
|
302 Non-nil means that the buffer menu should include buffers that have
|
|
303 names that starts with a space character.")
|
|
304
|
|
305 (defvar msb-item-handling-function 'msb-item-handler
|
|
306 "*The appearance of a buffer menu.
|
|
307
|
|
308 The default function to call for handling the appearance of a menu
|
|
309 item. It should take to arguments, BUFFER and MAX-BUFFER-NAME-LENGTH,
|
|
310 where the latter is the max length of all buffer names.
|
|
311 When the function is called, BUFFER is the current buffer.
|
|
312 This function is called for items in the variable 'msb-menu-cond' that
|
|
313 have nil as ITEM-HANDLING-FUNCTION. See 'msb-menu-cond' for more
|
|
314 information.")
|
|
315
|
|
316 (defvar msb-item-sort-function 'msb-sort-by-name
|
|
317 "*The order of items in a buffer menu.
|
|
318 The default function to call for handling the order of items in a menu
|
|
319 item. This function is called like a sort function. The items
|
|
320 look like (ITEM-NAME . BUFFER).
|
|
321 ITEM-NAME is the name of the item that will appear in the menu.
|
|
322 BUFFER is the buffer, this is not necessarily the current buffer.
|
|
323
|
|
324 Set this to nil or t if you don't want any sorting (faster).")
|
|
325
|
|
326 (defvar msb-files-by-directory nil
|
|
327 "*Non-nil means that files should be sorted by directory instead of
|
|
328 the groups in msb-menu-cond.")
|
|
329
|
|
330 (defvar msb-menu-cond msb--very-many-menus
|
|
331 "*List of criterias for splitting the mouse buffer menu.
|
|
332 The elements in the list should be of this type:
|
|
333 (CONDITION MENU-SORT-KEY MENU-TITLE ITEM-HANDLING-FN ITEM-SORT-FN).
|
|
334
|
|
335 When making the split, the buffers are tested one by one against the
|
|
336 CONDITION, just like a lisp cond: When hitting a true condition, the
|
|
337 other criterias are *not* tested and the buffer name will appear in
|
|
338 the menu with the menu-title corresponding to the true condition.
|
|
339
|
|
340 If the condition returns the symbol 'multi, then the buffer will be
|
|
341 added to this menu *and* tested for other menus too. If it returns
|
|
342 'no-multi, then the buffer will only be added if it hasn't been added
|
|
343 to any other menu.
|
|
344
|
|
345 During this test, the buffer in question is the current buffer, and
|
|
346 the test is surrounded by calls to `save-excursion' and
|
|
347 `save-match-data'
|
|
348
|
|
349 The categories are sorted by MENU-SORT-KEY. Smaller keys are on
|
|
350 top. nil means don't display this menu.
|
|
351
|
|
352 MENU-TITLE is really a format. If you add %d in it, the %d is replaced
|
|
353 with the number of items in that menu.
|
|
354
|
|
355 ITEM-HANDLING-FN, is optional. If it is supplied and is a
|
|
356 function, than it is used for displaying the items in that particular
|
|
357 buffer menu, otherwise the function pointed out by
|
|
358 'msb-item-handling-function' is used.
|
|
359
|
|
360 ITEM-SORT-FN, is also optional.
|
|
361 If it is not supplied, the function pointed out by
|
|
362 'msb-item-sort-function' is used.
|
|
363 If it is nil, then no sort takes place and the buffers are presented
|
|
364 in least-recently-used order.
|
|
365 If it is t, then no sort takes place and the buffers are presented in
|
|
366 most-recently-used order.
|
|
367 If it is supplied and non-nil and not t than it is used for sorting
|
|
368 the items in that particular buffer menu.
|
|
369
|
|
370 Note1: There should always be a 'catch-all' as last element,
|
|
371 in this list. That is an element like (t TITLE ITEM-HANDLING-FUNCTION).
|
|
372 Note2: A buffer menu appears only if it has at least one buffer in it.
|
|
373 Note3: If you have a CONDITION that can't be evaluated you will get an
|
|
374 error every time you do \\[msb].")
|
|
375
|
|
376 (defvar msb-after-load-hooks nil
|
|
377 "Hooks to be run after the msb package has been loaded.")
|
|
378
|
|
379 ;;;
|
|
380 ;;; Internal variables
|
|
381 ;;;
|
|
382
|
|
383 ;; The last calculated menu.
|
|
384 (defvar msb--last-buffer-menu nil)
|
|
385
|
|
386 ;; If this is non-nil, then it is a string that describes the error.
|
|
387 (defvar msb--error nil)
|
|
388
|
|
389 ;;;
|
|
390 ;;; Some example function to be used for 'msb-item-sort-function'.
|
|
391 ;;;
|
|
392 (defun msb-item-handler (buffer &optional maxbuf)
|
|
393 "Create one string item, concerning BUFFER, for the buffer menu.
|
|
394 The item looks like:
|
|
395 *% <buffer-name>
|
|
396 The '*' appears only if the buffer is marked as modified.
|
|
397 The '%' appears only if the buffer is read-only.
|
|
398 Optional second argument MAXBUF is completely ignored."
|
|
399 (let ((name (buffer-name))
|
|
400 (modified (if (buffer-modified-p) "*" " "))
|
|
401 (read-only (if buffer-read-only "%" " ")))
|
|
402 (format "%s%s %s" modified read-only name)))
|
|
403
|
|
404
|
|
405 (eval-when-compile (require 'dired))
|
|
406
|
|
407 ;; 'dired' can be called with a list of the form (directory file1 file2 ...)
|
|
408 ;; which causes 'dired-directory' to be in the same form.
|
|
409 (defun msb--dired-directory ()
|
|
410 (cond ((stringp dired-directory)
|
|
411 (abbreviate-file-name (expand-file-name dired-directory)))
|
|
412 ((consp dired-directory)
|
|
413 (abbreviate-file-name (expand-file-name (car dired-directory))))
|
|
414 (t
|
|
415 (error "Unknown type of 'dired-directory' in buffer %s"
|
|
416 (buffer-name)))))
|
|
417
|
|
418 (defun msb-dired-item-handler (buffer &optional maxbuf)
|
|
419 "Create one string item, concerning a dired BUFFER, for the buffer menu.
|
|
420 The item looks like:
|
|
421 *% <buffer-name>
|
|
422 The '*' appears only if the buffer is marked as modified.
|
|
423 The '%' appears only if the buffer is read-only.
|
|
424 Optional second argument MAXBUF is completely ignored."
|
|
425 (let ((name (msb--dired-directory))
|
|
426 (modified (if (buffer-modified-p) "*" " "))
|
|
427 (read-only (if buffer-read-only "%" " ")))
|
|
428 (format "%s%s %s" modified read-only name)))
|
|
429
|
|
430 (defun msb-alon-item-handler (buffer maxbuf)
|
|
431 "Create one string item for the buffer menu.
|
|
432 The item looks like:
|
|
433 <buffer-name> *%# <file-name>
|
|
434 The '*' appears only if the buffer is marked as modified.
|
|
435 The '%' appears only if the buffer is read-only.
|
|
436 The '#' appears only version control file (SCCS/RCS)."
|
|
437 (format (format "%%%ds %%s%%s%%s %%s" maxbuf)
|
|
438 (buffer-name buffer)
|
|
439 (if (buffer-modified-p) "*" " ")
|
|
440 (if buffer-read-only "%" " ")
|
|
441 (if (and (boundp 'vc-mode) vc-mode) "#" " ")
|
|
442 (or buffer-file-name "")))
|
|
443
|
|
444 ;;;
|
|
445 ;;; Some example function to be used for 'msb-item-handling-function'.
|
|
446 ;;;
|
|
447 (defun msb-sort-by-name (item1 item2)
|
|
448 "Sorts the items depending on their buffer-name
|
|
449 An item look like (NAME . BUFFER)."
|
|
450 (string-lessp (buffer-name (cdr item1))
|
|
451 (buffer-name (cdr item2))))
|
|
452
|
|
453
|
|
454 (defun msb-sort-by-directory (item1 item2)
|
|
455 "Sorts the items depending on their directory. Made for dired.
|
|
456 An item look like (NAME . BUFFER)."
|
|
457 (string-lessp (save-excursion (set-buffer (cdr item1)) (msb--dired-directory))
|
|
458 (save-excursion (set-buffer (cdr item2)) (msb--dired-directory))))
|
|
459
|
|
460 ;;;
|
|
461 ;;; msb
|
|
462 ;;;
|
|
463 ;;; This function can be used instead of (mouse-buffer-menu EVENT)
|
|
464 ;;; function in "mouse.el".
|
|
465 ;;;
|
|
466 (defun msb (event)
|
|
467 "Pop up several menus of buffers for selection with the mouse.
|
|
468 This command switches buffers in the window that you clicked on, and
|
|
469 selects that window.
|
|
470
|
|
471 See the function 'mouse-select-buffer' and the variable
|
|
472 'msb-menu-cond' for more information about how the menus are split."
|
|
473 (interactive "e")
|
|
474 (let ((buffer (mouse-select-buffer event))
|
|
475 (window (posn-window (event-start event))))
|
|
476 (cond
|
|
477 (buffer
|
|
478 (or (framep window) (select-window window))
|
|
479 (switch-to-buffer (car (cdr buffer))))))
|
|
480 nil)
|
|
481
|
|
482 ;;;
|
|
483 ;;; Some supportive functions
|
|
484 ;;;
|
|
485 (defun msb-invisible-buffer-p (&optional buffer)
|
|
486 "Return t if optional BUFFER is an \"invisible\" buffer.
|
|
487 If the argument is left out or nil, then the current buffer is considered."
|
|
488 (and (> (length (buffer-name buffer)) 0)
|
|
489 (eq ?\ (aref (buffer-name buffer) 0))))
|
|
490
|
|
491 ;; Strip one hierarcy level from the end of PATH.
|
|
492 (defun msb--strip-path (path)
|
|
493 (save-match-data
|
|
494 (if (string-match "\\(.+\\)/[^/]+$" path)
|
|
495 (substring path (match-beginning 1) (match-end 1))
|
|
496 "/")))
|
|
497
|
|
498 ;; Create an alist with all buffers from LIST that lies under the same
|
|
499 ;; directory will be in the same item as the directory string as
|
|
500 ;;'((PATH1 . (BUFFER-1 BUFFER-2 ...)) (PATH2 . (BUFFER-K BUFFER-K+1...)) ...)
|
|
501 (defun msb--init-file-alist (list)
|
|
502 (let ((buffer-alist
|
|
503 (sort (mapcan
|
|
504 (function
|
|
505 (lambda (buffer)
|
|
506 (let ((file-name (buffer-file-name buffer)))
|
|
507 (when file-name
|
|
508 (list (cons (msb--strip-path file-name) buffer))))))
|
|
509 list)
|
|
510 (function (lambda (item1 item2)
|
|
511 (string< (car item1) (car item2)))))))
|
|
512 ;; Make alist that looks like
|
|
513 ;;'((PATH1 . (BUFFER-1 BUFFER-2 ...)) (PATH2 . (BUFFER-K)) ...)
|
|
514 (let ((path nil)
|
|
515 (buffers nil)
|
|
516 (result nil))
|
|
517 (append
|
|
518 (mapcan (function
|
|
519 (lambda (item)
|
|
520 (cond
|
|
521 ((and path
|
|
522 msb-max-menu-items
|
|
523 (< (length buffers) msb-max-menu-items)
|
|
524 (string= path (car item)))
|
|
525 (push (cdr item) buffers)
|
|
526 nil)
|
|
527 (t
|
|
528 (when path
|
|
529 (setq result (cons path buffers)))
|
|
530 (setq path (car item))
|
|
531 (setq buffers (list (cdr item)))
|
|
532 (and result (list result))))))
|
|
533 buffer-alist)
|
|
534 (list (cons path buffers))))))
|
|
535
|
|
536 ;; Choose file-menu with respect to directory for every buffer in LIST.
|
|
537 (defun msb--choose-file-menu (list)
|
|
538 (let ((buffer-alist (msb--init-file-alist list))
|
|
539 (final-list nil)
|
|
540 (max-clumped-together (if (numberp msb-max-file-menu-items)
|
|
541 msb-max-file-menu-items
|
|
542 10))
|
|
543 (top-found-p nil)
|
|
544 (last-path nil)
|
|
545 first rest path buffers)
|
|
546 (setq first (car buffer-alist))
|
|
547 (setq rest (cdr buffer-alist))
|
|
548 (setq path (car first))
|
|
549 (setq buffers (cdr first))
|
|
550 (while rest
|
|
551 (let ((found-p nil)
|
|
552 (tmp-rest rest)
|
|
553 new-path item)
|
|
554 (setq item (car tmp-rest))
|
|
555 (while (and tmp-rest
|
|
556 (<= (length buffers) max-clumped-together)
|
|
557 (>= (length (car item)) (length path))
|
|
558 (string= path (substring (car item) 0 (length path))))
|
|
559 (setq found-p t)
|
|
560 (setq buffers (append buffers (cdr item)))
|
|
561 (setq tmp-rest (cdr tmp-rest))
|
|
562 (setq item (car tmp-rest)))
|
|
563 (cond
|
|
564 ((> (length buffers) max-clumped-together)
|
|
565 (setq last-path (car first))
|
|
566 (when top-found-p
|
|
567 (setq first (cons (concat (car first) "/...")
|
|
568 (cdr first)))
|
|
569 (setq top-found-p nil))
|
|
570 (push first final-list)
|
|
571 (setq first (car rest)
|
|
572 rest (cdr rest))
|
|
573 (setq path (car first)
|
|
574 buffers (cdr first)))
|
|
575 (t
|
|
576 (when found-p
|
|
577 (setq top-found-p t)
|
|
578 (setq first (cons path buffers)
|
|
579 rest tmp-rest))
|
|
580 (setq path (msb--strip-path path)
|
|
581 buffers (cdr first))
|
|
582 (when (and last-path
|
|
583 (or (and (>= (length path) (length last-path))
|
|
584 (string= last-path
|
|
585 (substring path 0 (length last-path))))
|
|
586 (and (< (length path) (length last-path))
|
|
587 (string= path
|
|
588 (substring last-path 0 (length path))))))
|
|
589
|
|
590 (when top-found-p
|
|
591 (setq first (cons (concat (car first) "/...")
|
|
592 (cdr first)))
|
|
593 (setq top-found-p nil))
|
|
594 (push first final-list)
|
|
595 (setq first (car rest)
|
|
596 rest (cdr rest))
|
|
597 (setq path (car first)
|
|
598 buffers (cdr first)))))))
|
|
599 (when top-found-p
|
|
600 (setq first (cons (concat (car first)
|
|
601 (if (string-match "/$" (car first))
|
|
602 "..."
|
|
603 "/..."))
|
|
604 (cdr first)))
|
|
605 (setq top-found-p nil))
|
|
606 (push first final-list)
|
|
607 (nreverse final-list)))
|
|
608
|
|
609 ;; Create a vector as:
|
|
610 ;; [BUFFER-LIST-VARIABLE CONDITION MENU-SORT-KEY MENU-TITLE ITEM-HANDLER SORTER)
|
|
611 ;; from an element in 'msb-menu-cond'. See that variable for a
|
|
612 ;; description of it's elements.
|
|
613 (defun msb--create-function-info (menu-cond-elt)
|
|
614 (let* ((list-symbol (make-symbol "-msb-buffer-list"))
|
|
615 (tmp-ih (and (> (length menu-cond-elt) 3)
|
|
616 (nth 3 menu-cond-elt)))
|
|
617 (item-handler (if (and tmp-ih (fboundp tmp-ih))
|
|
618 tmp-ih
|
|
619 msb-item-handling-function))
|
|
620 (tmp-s (if (> (length menu-cond-elt) 4)
|
|
621 (nth 4 menu-cond-elt)
|
|
622 msb-item-sort-function))
|
|
623 (sorter (if (or (fboundp tmp-s)
|
|
624 (null tmp-s)
|
|
625 (eq tmp-s 't))
|
|
626 tmp-s
|
|
627 msb-item-sort-function)))
|
|
628 (when (< (length menu-cond-elt) 3)
|
|
629 (error "Wrong format of msb-menu-cond."))
|
|
630 (when (and (> (length menu-cond-elt) 3)
|
|
631 (not (fboundp tmp-ih)))
|
|
632 (signal 'invalid-function (list tmp-ih)))
|
|
633 (when (and (> (length menu-cond-elt) 4)
|
|
634 tmp-s
|
|
635 (not (fboundp tmp-s))
|
|
636 (not (eq tmp-s 't)))
|
|
637 (signal 'invalid-function (list tmp-s)))
|
|
638 (set list-symbol '())
|
|
639 (vector list-symbol ;BUFFER-LIST-VARIABLE
|
|
640 (nth 0 menu-cond-elt) ;CONDITION
|
|
641 (nth 1 menu-cond-elt) ;SORT-KEY
|
|
642 (nth 2 menu-cond-elt) ;MENU-TITLE
|
|
643 item-handler ;ITEM-HANDLER
|
|
644 sorter) ;SORTER
|
|
645 ))
|
|
646
|
|
647 ;; This defsubst is only used in `msb--choose-menu' below. It was
|
|
648 ;; pulled out merely to make the code somewhat clearer. The indention
|
|
649 ;; level was too big.
|
|
650 (defsubst msb--collect (function-info-vector)
|
|
651 (let ((result nil)
|
|
652 (multi-flag nil)
|
|
653 function-info-list)
|
|
654 (setq function-info-list
|
|
655 (loop for fi
|
|
656 across function-info-vector
|
|
657 if (and (setq result
|
|
658 (eval (aref fi 1))) ;Test CONDITION
|
|
659 (not (and (eq result 'no-multi)
|
|
660 multi-flag))
|
|
661 (progn (when (eq result 'multi)
|
|
662 (setq multi-flag t))
|
|
663 t)
|
|
664 (or (not msb-max-menu-items)
|
|
665 (< (length (eval (aref fi 0)))
|
|
666 msb-max-menu-items)))
|
|
667 collect fi
|
|
668 until (and result
|
|
669 (not (eq result 'multi)))))
|
|
670 (when (and (not function-info-list)
|
|
671 (not result))
|
|
672 (error "No catch-all in msb-menu-cond!"))
|
|
673 function-info-list))
|
|
674
|
|
675 ;; Adds BUFFER to the menu depicted by FUNCTION-INFO
|
|
676 ;; All side-effects. Adds an element of type '(BUFFER-TITLE . BUFFER)
|
|
677 ;; to the buffer-list variable in function-info.
|
|
678 (defun msb--add-to-menu (buffer function-info max-buffer-name-length)
|
|
679 (let ((list-symbol (aref function-info 0))) ;BUFFER-LIST-VARIABLE
|
|
680 ;; Here comes the hairy side-effect!
|
|
681 (set list-symbol
|
|
682 (cons (cons (funcall (aref function-info 4) ;ITEM-HANDLER
|
|
683 buffer
|
|
684 max-buffer-name-length)
|
|
685 buffer)
|
|
686 (eval list-symbol)))))
|
|
687
|
|
688 ;; Selects the appropriate menu for BUFFER.
|
|
689 ;; This is all side-effects, folks!
|
|
690 ;; This should be optimized.
|
|
691 (defsubst msb--choose-menu (buffer function-info-vector max-buffer-name-length)
|
|
692 (unless (and (not msb-display-invisible-buffers-p)
|
|
693 (msb-invisible-buffer-p buffer))
|
|
694 (condition-case nil
|
|
695 (save-excursion
|
|
696 (set-buffer buffer)
|
|
697 ;; Menu found. Add to this menu
|
|
698 (mapc (function
|
|
699 (lambda (function-info)
|
|
700 (msb--add-to-menu buffer function-info max-buffer-name-length)))
|
|
701 (msb--collect function-info-vector)))
|
|
702 (error (unless msb--error
|
|
703 (setq msb--error
|
|
704 (format
|
|
705 "Variable `msb-menu-cond': Error for buffer \"%s\"."
|
|
706 (buffer-name buffer)))
|
|
707 (error msb--error))))))
|
|
708
|
|
709 ;; Return (SORT-KEY TITLE . BUFFER-LIST) or nil if the
|
|
710 ;; buffer-list is empty.
|
|
711 (defun msb--create-sort-item (function-info)
|
|
712 (let ((buffer-list (eval (aref function-info 0))))
|
|
713 (when buffer-list
|
|
714 (let ((sorter (aref function-info 5)) ;SORTER
|
|
715 (sort-key (aref function-info 2))) ;MENU-SORT-KEY
|
|
716 (when sort-key
|
|
717 (cons sort-key
|
|
718 (cons (format (aref function-info 3) ;MENU-TITLE
|
|
719 (length buffer-list))
|
|
720 (cond
|
|
721 ((null sorter)
|
|
722 buffer-list)
|
|
723 ((eq sorter 't)
|
|
724 (nreverse buffer-list))
|
|
725 (t
|
|
726 (sort buffer-list sorter))))))))))
|
|
727
|
|
728 ;; Returns a list on the form ((TITLE . BUFFER-LIST)) for
|
|
729 ;; the most recently used buffers.
|
|
730 (defun msb--most-recently-used-menu (max-buffer-name-length)
|
|
731 (when (and msb-display-most-recently-used
|
|
732 (or (not (numberp msb-display-most-recently-used))
|
|
733 (> msb-display-most-recently-used 0)))
|
|
734 (let* ((max-in-menu
|
|
735 (if (numberp msb-display-most-recently-used)
|
|
736 msb-display-most-recently-used
|
|
737 msb-max-menu-items))
|
|
738
|
|
739 (most-recently-used
|
|
740 (loop with n = 0
|
|
741 for buffer in (cdr (buffer-list))
|
|
742 if (save-excursion
|
|
743 (set-buffer buffer)
|
|
744 (and (not (msb-invisible-buffer-p))
|
|
745 (not (eq major-mode 'dired-mode))))
|
|
746 collect (save-excursion
|
|
747 (set-buffer buffer)
|
|
748 (cons (funcall msb-item-handling-function
|
|
749 buffer
|
|
750 max-buffer-name-length)
|
|
751 buffer))
|
|
752 and do (incf n)
|
|
753 until (and max-in-menu (>= n max-in-menu)))))
|
|
754 (cons (if (stringp msb-most-recently-used-title)
|
|
755 (format msb-most-recently-used-title
|
|
756 (length most-recently-used))
|
|
757 (signal 'wrong-type-argument (list msb-most-recently-used-title)))
|
|
758 most-recently-used))))
|
|
759
|
|
760 (defun msb--create-buffer-menu-2 ()
|
|
761 (let ((max-buffer-name-length 0)
|
|
762 file-buffers
|
|
763 function-info-vector)
|
|
764 ;; Calculate the longest buffer name.
|
|
765 (mapc
|
|
766 (function
|
|
767 (lambda (buffer)
|
|
768 (if (or msb-display-invisible-buffers-p
|
|
769 (not (msb-invisible-buffer-p)))
|
|
770 (setq max-buffer-name-length
|
|
771 (max max-buffer-name-length
|
|
772 (length (buffer-name buffer)))))))
|
|
773 (buffer-list))
|
|
774 ;; Make a list with elements of type
|
|
775 ;; (BUFFER-LIST-VARIABLE
|
|
776 ;; CONDITION
|
|
777 ;; MENU-SORT-KEY
|
|
778 ;; MENU-TITLE
|
|
779 ;; ITEM-HANDLER
|
|
780 ;; SORTER)
|
|
781 ;; Uses "function-global" variables:
|
|
782 ;; function-info-vector
|
|
783 (setq function-info-vector
|
|
784 (apply (function vector)
|
|
785 (mapcar (function msb--create-function-info)
|
|
786 msb-menu-cond)))
|
|
787 ;; Split the buffer-list into several lists; one list for each
|
|
788 ;; criteria. This is the most critical part with respect to time.
|
|
789 (mapc (function (lambda (buffer)
|
|
790 (cond ((and msb-files-by-directory
|
|
791 (buffer-file-name buffer))
|
|
792 (push buffer file-buffers))
|
|
793 (t
|
|
794 (msb--choose-menu buffer
|
|
795 function-info-vector
|
|
796 max-buffer-name-length)))))
|
|
797 (buffer-list))
|
|
798 (when file-buffers
|
|
799 (setq file-buffers
|
|
800 (mapcar (function
|
|
801 (lambda (buffer-list)
|
|
802 (cons msb-files-by-directory-sort-key
|
|
803 (cons (car buffer-list)
|
|
804 (sort
|
|
805 (mapcar (function
|
|
806 (lambda (buffer)
|
|
807 (cons (buffer-name buffer)
|
|
808 buffer)))
|
|
809 (cdr buffer-list))
|
|
810 (function
|
|
811 (lambda (item1 item2)
|
|
812 (string< (car item1) (car item2)))))))))
|
|
813 (msb--choose-file-menu file-buffers))))
|
|
814 ;; Now make the menu - a list of (TITLE . BUFFER-LIST)
|
|
815 (let* ((buffers (buffer-list))
|
|
816 menu
|
|
817 (most-recently-used
|
|
818 (msb--most-recently-used-menu max-buffer-name-length))
|
|
819 (others (append file-buffers
|
|
820 (loop for elt
|
|
821 across function-info-vector
|
|
822 for value = (msb--create-sort-item elt)
|
|
823 if value collect value))))
|
|
824 (setq menu
|
|
825 (mapcar 'cdr ;Remove the SORT-KEY
|
|
826 ;; Sort the menus - not the items.
|
|
827 (msb--add-separators
|
|
828 (sort
|
|
829 ;; Get a list of (SORT-KEY TITLE . BUFFER-LIST)
|
|
830 ;; Also sorts the items within the menus.
|
|
831 (if (cdr most-recently-used)
|
|
832 (cons
|
|
833 ;; Add most recent used buffers
|
|
834 (cons msb-most-recently-used-sort-key
|
|
835 most-recently-used)
|
|
836 others)
|
|
837 others)
|
|
838 (function (lambda (elt1 elt2)
|
|
839 (< (car elt1) (car elt2))))))))
|
|
840 ;; Now make it a keymap menu
|
|
841 (append
|
|
842 '(keymap "Select Buffer")
|
|
843 (msb--make-keymap-menu menu)
|
|
844 (when msb-separator-diff
|
|
845 (list (list 'separator "---")))
|
|
846 (list (cons 'toggle
|
|
847 (cons
|
|
848 (if msb-files-by-directory
|
|
849 "*Files by type*"
|
|
850 "*Files by directory*")
|
|
851 'msb--toggle-menu-type)))))))
|
|
852
|
|
853 (defun msb--create-buffer-menu ()
|
|
854 (save-match-data
|
|
855 (save-excursion
|
|
856 (msb--create-buffer-menu-2))))
|
|
857
|
|
858 ;;;
|
|
859 ;;; Multi purpose function for selecting a buffer with the mouse.
|
|
860 ;;;
|
|
861 (defun msb--toggle-menu-type ()
|
|
862 (interactive)
|
|
863 (setq msb-files-by-directory (not msb-files-by-directory))
|
|
864 (menu-bar-update-buffers t))
|
|
865
|
|
866 (defun mouse-select-buffer (event)
|
|
867 "Pop up several menus of buffers, for selection with the mouse.
|
|
868 Returns the selected buffer or nil if no buffer is selected.
|
|
869
|
|
870 The way the buffers are splitted is conveniently handled with the
|
|
871 variable 'msb-menu-cond'."
|
|
872 ;; Popup the menu and return the selected buffer.
|
|
873 (when (or msb--error
|
|
874 (not msb--last-buffer-menu)
|
|
875 (not (fboundp 'frame-or-buffer-changed-p))
|
|
876 (frame-or-buffer-changed-p))
|
|
877 (setq msb--error nil)
|
|
878 (setq msb--last-buffer-menu (msb--create-buffer-menu)))
|
|
879 (let ((position event))
|
|
880 (when (and (fboundp 'posn-x-y)
|
|
881 (fboundp 'posn-window))
|
|
882 (let ((posX (car (posn-x-y (event-start event))))
|
|
883 (posY (cdr (posn-x-y (event-start event))))
|
|
884 (posWind (posn-window (event-start event)))
|
|
885 name)
|
|
886 ;; adjust position
|
|
887 (setq posX (- posX (funcall msb-horizontal-shift-function))
|
|
888 position (list (list posX posY) posWind))))
|
|
889 (setq name (x-popup-menu position msb--last-buffer-menu))
|
|
890 ;; If toggle bring up the
|
|
891 (cond
|
|
892 ((eq (car name) 'toggle)
|
|
893 (msb--toggle-menu-type)
|
|
894 (mouse-select-buffer event))
|
|
895 ((and (numberp (car name))
|
|
896 (null (cdr name)))
|
|
897 (let ((msb--last-buffer-menu (nthcdr 3 (assq (car name) msb--last-buffer-menu))))
|
|
898 (mouse-select-buffer event)))
|
|
899 ((and (stringp (car name))
|
|
900 (null (cdr name)))
|
|
901 (cons nil name))
|
|
902 (t
|
|
903 name))))
|
|
904
|
|
905 ;; Add separators
|
|
906 (defun msb--add-separators (sorted-list)
|
|
907 (cond
|
|
908 ((or (not msb-separator-diff)
|
|
909 (not (numberp msb-separator-diff)))
|
|
910 sorted-list)
|
|
911 (t
|
|
912 (let ((last-key nil))
|
|
913 (mapcan
|
|
914 (function
|
|
915 (lambda (item)
|
|
916 (cond
|
|
917 ((and msb-separator-diff
|
|
918 last-key
|
|
919 (> (- (car item) last-key)
|
|
920 msb-separator-diff))
|
|
921 (setq last-key (car item))
|
|
922 (list (cons last-key 'separator)
|
|
923 item))
|
|
924 (t
|
|
925 (setq last-key (car item))
|
|
926 (list item)))))
|
|
927 sorted-list)))))
|
|
928
|
|
929 (defun msb--make-keymap-menu (raw-menu)
|
|
930 (let ((end (cons '(nil) 'menu-bar-select-buffer))
|
|
931 (mcount 0))
|
|
932 (mapcar
|
|
933 (function
|
|
934 (lambda (sub-menu)
|
|
935 (cond
|
|
936 ((eq 'separator sub-menu)
|
|
937 (list 'separator "---"))
|
|
938 (t
|
|
939 (append (list (incf mcount) (car sub-menu)
|
|
940 'keymap (car sub-menu))
|
|
941 (mapcar (function
|
|
942 (lambda (item)
|
|
943 (let ((string (car item))
|
|
944 (buffer (cdr item)))
|
|
945 (cons (buffer-name buffer)
|
|
946 (cons string end)))))
|
|
947 (cdr sub-menu)))))))
|
|
948 raw-menu)))
|
|
949
|
|
950 (defun menu-bar-update-buffers (&optional arg)
|
|
951 ;; If user discards the Buffers item, play along.
|
|
952 (when (and (lookup-key (current-global-map) [menu-bar buffer])
|
|
953 (or (not (fboundp 'frame-or-buffer-changed-p))
|
|
954 (frame-or-buffer-changed-p)
|
|
955 arg))
|
|
956 (let ((buffers (buffer-list))
|
|
957 (frames (frame-list))
|
|
958 buffers-menu frames-menu)
|
|
959 ;; If requested, list only the N most recently selected buffers.
|
|
960 (when (and (integerp buffers-menu-max-size)
|
|
961 (> buffers-menu-max-size 1)
|
|
962 (> (length buffers) buffers-menu-max-size))
|
|
963 (setcdr (nthcdr buffers-menu-max-size buffers) nil))
|
|
964 ;; Make the menu of buffers proper.
|
|
965 (setq msb--last-buffer-menu (msb--create-buffer-menu))
|
|
966 (setq buffers-menu msb--last-buffer-menu)
|
|
967 ;; Make a Frames menu if we have more than one frame.
|
|
968 (if (cdr frames)
|
|
969 (setq frames-menu
|
|
970 (cons "Select Frame"
|
|
971 (mapcar
|
|
972 (function
|
|
973 (lambda (frame)
|
|
974 (nconc
|
|
975 (list frame
|
|
976 (cdr (assq 'name
|
|
977 (frame-parameters frame)))
|
|
978 (cons nil nil))
|
|
979 'menu-bar-select-frame)))
|
|
980 frames))))
|
|
981 (when frames-menu
|
|
982 (setq frames-menu (cons 'keymap frames-menu)))
|
|
983 (define-key (current-global-map) [menu-bar buffer]
|
|
984 (cons "Buffers"
|
|
985 (if (and buffers-menu frames-menu)
|
|
986 (list 'keymap "Buffers and Frames"
|
|
987 (cons 'buffers (cons "Buffers" buffers-menu))
|
|
988 (cons 'frames (cons "Frames" frames-menu)))
|
|
989 (or buffers-menu frames-menu 'undefined)))))))
|
|
990
|
|
991 (when (and (boundp 'menu-bar-update-hook)
|
|
992 (not (fboundp 'frame-or-buffer-changed-p)))
|
|
993 (defvar msb--buffer-count 0)
|
|
994 (defun frame-or-buffer-changed-p ()
|
|
995 (let ((count (length (buffer-list))))
|
|
996 (when (/= count msb--buffer-count)
|
|
997 (setq msb--buffer-count count)
|
|
998 t))))
|
|
999
|
|
1000 (unless (or (not (boundp 'menu-bar-update-hook))
|
|
1001 (memq 'menu-bar-update-buffers menu-bar-update-hook))
|
|
1002 (add-hook 'menu-bar-update-hook 'menu-bar-update-buffers))
|
|
1003
|
|
1004 (and (fboundp 'mouse-buffer-menu)
|
|
1005 (substitute-key-definition 'mouse-buffer-menu 'msb (current-global-map)))
|
|
1006
|
|
1007 (provide 'msb)
|
|
1008 (eval-after-load 'msb (run-hooks 'msb-after-load-hooks))
|
|
1009 ;;; msb.el ends here
|