1 ;;; msb.el --- customizable buffer-selection with multiple menus
3 ;; Copyright (C) 1993, 1994, 1995, 1997, 1998, 1999, 2000, 2001, 2002,
4 ;; 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
6 ;; Author: Lars Lindberg <lars.lindberg@home.se>
9 ;; Lindberg's last update version: 3.34
10 ;; Keywords: mouse buffer menu
12 ;; This file is part of GNU Emacs.
14 ;; GNU Emacs is free software; you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation; either version 2, or (at your option)
19 ;; GNU Emacs is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs; see the file COPYING. If not, write to the
26 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
27 ;; Boston, MA 02110-1301, USA.
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. This is done as a global
35 ;; minor mode, msb-mode.
38 ;; Look at the variable `msb-menu-cond' for deciding what menus you
39 ;; want. It's not that hard to customize, despite my not-so-good
40 ;; doc-string. Feel free to send me a better doc-string.
41 ;; There are some constants for you to try here:
43 ;; msb--very-many-menus (default)
45 ;; Look at the variable `msb-item-handling-function' for customization
46 ;; of the appearance of every menu item. Try for instance setting
47 ;; it to `msb-alon-item-handler'.
49 ;; Look at the variable `msb-item-sort-function' for customization
50 ;; of sorting the menus. Set it to t for instance, which means no
51 ;; sorting - you will get latest used buffer first.
53 ;; Also check out the variable `msb-display-invisible-buffers-p'.
56 ;; - Files-by-directory
57 ;; + No possibility to show client/changed buffers separately.
58 ;; + All file buffers only appear in a file sub-menu, they will
59 ;; for instance not appear in the Mail sub-menu.
61 ;; Future enhancements:
64 ;; Mark Brader <msb@sq.com>
65 ;; Jim Berry <m1jhb00@FRB.GOV>
66 ;; Hans Chalupsky <hans@cs.Buffalo.EDU>
67 ;; Larry Rosenberg <ljr@ictv.com>
68 ;; Will Henney <will@astroscu.unam.mx>
69 ;; Jari Aalto <jaalto@tre.tele.nokia.fi>
70 ;; Michael Kifer <kifer@sbkifer.cs.sunysb.edu>
71 ;; Gael Marziou <gael@gnlab030.grenoble.hp.com>
72 ;; Dave Gillespie <daveg@thymus.synaptics.com>
73 ;; Alon Albert <alon@milcse.rtsg.mot.com>
74 ;; Kevin Broadey, <KevinB@bartley.demon.co.uk>
75 ;; Ake Stenhof <ake@cadpoint.se>
76 ;; Richard Stallman <rms@gnu.org>
77 ;; Steve Fisk <fisk@medved.bowdoin.edu>
79 ;; This version turned into a global minor mode and subsequently
80 ;; hacked on by Dave Love.
83 (eval-when-compile (require 'cl
))
86 ;;; Some example constants to be used for `msb-menu-cond'. See that
87 ;;; variable for more information. Please note that if the condition
88 ;;; returns `multi', then the buffer can appear in several menus.
90 (defconst msb--few-menus
91 '(((and (boundp 'server-buffer-clients
)
96 ((and msb-display-invisible-buffers-p
97 (msb-invisible-buffer-p)
100 "Invisible buffers (%d)")
101 ((eq major-mode
'dired-mode
)
104 msb-dired-item-handler
105 msb-sort-by-directory
)
106 ((eq major-mode
'Man-mode
)
109 ((eq major-mode
'w3-mode
)
112 ((or (memq major-mode
113 '(rmail-mode rmail-edit-mode vm-summary-mode vm-mode mail-mode
))
114 (memq major-mode
'(mh-letter-mode mh-show-mode mh-folder-mode
))
116 '(gnus-summary-mode message-mode gnus-group-mode
117 gnus-article-mode score-mode gnus-browse-killed-mode
)))
120 ((not buffer-file-name
)
127 (defconst msb--very-many-menus
128 '(((and (boundp 'server-buffer-clients
)
129 server-buffer-clients
133 ((and (boundp 'vc-mode
) vc-mode
'multi
)
135 "Version Control (%d)")
136 ((and buffer-file-name
140 "Changed files (%d)")
141 ((and (get-buffer-process (current-buffer))
145 ((and msb-display-invisible-buffers-p
146 (msb-invisible-buffer-p)
149 "Invisible buffers (%d)")
150 ((eq major-mode
'dired-mode
)
153 ;; Note this different menu-handler
154 msb-dired-item-handler
155 ;; Also note this item-sorter
156 msb-sort-by-directory
)
157 ((eq major-mode
'Man-mode
)
160 ((eq major-mode
'w3-mode
)
163 ((or (memq major-mode
164 '(rmail-mode rmail-edit-mode vm-summary-mode vm-mode mail-mode
))
165 (memq major-mode
'(mh-letter-mode mh-show-mode mh-folder-mode
))
166 (memq major-mode
'(gnus-summary-mode message-mode gnus-group-mode
167 gnus-article-mode score-mode
168 gnus-browse-killed-mode
)))
171 ;; Catchup for all non-file buffers
172 ((and (not buffer-file-name
)
175 "Other non-file buffers (%d)")
176 ((and (string-match "/\\.[^/]*$" buffer-file-name
)
180 ((memq major-mode
'(c-mode c
++-mode
))
183 ((eq major-mode
'emacs-lisp-mode
)
186 ((eq major-mode
'latex-mode
)
191 "Other files (%d)")))
193 ;; msb--many-menus is obsolete
194 (defvar msb--many-menus msb--very-many-menus
)
197 ;;; Customizable variables
201 "Customizable buffer-selection with multiple menus."
205 (defun msb-custom-set (symbol value
)
206 "Set the value of custom variables for msb."
208 (if (and (featurep 'msb
) msb-mode
)
209 ;; wait until package has been loaded before bothering to update
211 (msb-menu-bar-update-buffers t
)))
213 (defcustom msb-menu-cond msb--very-many-menus
214 "*List of criteria for splitting the mouse buffer menu.
215 The elements in the list should be of this type:
216 (CONDITION MENU-SORT-KEY MENU-TITLE ITEM-HANDLING-FN ITEM-SORT-FN).
218 When making the split, the buffers are tested one by one against the
219 CONDITION, just like a Lisp cond: When hitting a true condition, the
220 other criteria are *not* tested and the buffer name will appear in the
221 menu with the menu-title corresponding to the true condition.
223 If the condition returns the symbol `multi', then the buffer will be
224 added to this menu *and* tested for other menus too. If it returns
225 `no-multi', then the buffer will only be added if it hasn't been added
228 During this test, the buffer in question is the current buffer, and
229 the test is surrounded by calls to `save-excursion' and
232 The categories are sorted by MENU-SORT-KEY. Smaller keys are on top.
233 nil means don't display this menu.
235 MENU-TITLE is really a format. If you add %d in it, the %d is
236 replaced with the number of items in that menu.
238 ITEM-HANDLING-FN, is optional. If it is supplied and is a function,
239 than it is used for displaying the items in that particular buffer
240 menu, otherwise the function pointed out by
241 `msb-item-handling-function' is used.
243 ITEM-SORT-FN, is also optional.
244 If it is not supplied, the function pointed out by
245 `msb-item-sort-function' is used.
246 If it is nil, then no sort takes place and the buffers are presented
247 in least-recently-used order.
248 If it is t, then no sort takes place and the buffers are presented in
249 most-recently-used order.
250 If it is supplied and non-nil and not t than it is used for sorting
251 the items in that particular buffer menu.
253 Note1: There should always be a `catch-all' as last element, in this
254 list. That is an element like (t TITLE ITEM-HANDLING-FUNCTION).
255 Note2: A buffer menu appears only if it has at least one buffer in it.
256 Note3: If you have a CONDITION that can't be evaluated you will get an
257 error every time you do \\[msb]."
258 :type
`(choice (const :tag
"long" :value
,msb--very-many-menus
)
259 (const :tag
"short" :value
,msb--few-menus
)
264 (defcustom msb-modes-key
4000
265 "The sort key for files sorted by mode."
271 (defcustom msb-separator-diff
100
272 "*Non-nil means use separators.
273 The separators will appear between all menus that have a sorting key
274 that differs by this value or more."
275 :type
'(choice integer
(const nil
))
279 (defvar msb-files-by-directory-sort-key
0
280 "*The sort key for files sorted by directory.")
282 (defcustom msb-max-menu-items
15
283 "*The maximum number of items in a menu.
284 If this variable is set to 15 for instance, then the submenu will be
285 split up in minor parts, 15 items each. nil means no limit."
286 :type
'(choice integer
(const nil
))
290 (defcustom msb-max-file-menu-items
10
291 "*The maximum number of items from different directories.
293 When the menu is of type `file by directory', this is the maximum
294 number of buffers that are clumped together from different
297 Set this to 1 if you want one menu per directory instead of clumping
300 If the value is not a number, then the value 10 is used."
305 (defcustom msb-most-recently-used-sort-key -
1010
306 "*Where should the menu with the most recently used buffers be placed?"
311 (defcustom msb-display-most-recently-used
15
312 "*How many buffers should be in the most-recently-used menu.
313 No buffers at all if less than 1 or nil (or any non-number)."
318 (defcustom msb-most-recently-used-title
"Most recently used (%d)"
319 "*The title for the most-recently-used menu."
324 (defvar msb-horizontal-shift-function
'(lambda () 0)
325 "*Function that specifies how many pixels to shift the top menu leftwards.")
327 (defcustom msb-display-invisible-buffers-p nil
328 "*Show invisible buffers or not.
329 Non-nil means that the buffer menu should include buffers that have
330 names that starts with a space character."
335 (defvar msb-item-handling-function
'msb-item-handler
336 "*The appearance of a buffer menu.
338 The default function to call for handling the appearance of a menu
339 item. It should take to arguments, BUFFER and MAX-BUFFER-NAME-LENGTH,
340 where the latter is the max length of all buffer names.
342 The function should return the string to use in the menu.
344 When the function is called, BUFFER is the current buffer. This
345 function is called for items in the variable `msb-menu-cond' that have
346 nil as ITEM-HANDLING-FUNCTION. See `msb-menu-cond' for more
349 (defcustom msb-item-sort-function
'msb-sort-by-name
350 "*The order of items in a buffer menu.
352 The default function to call for handling the order of items in a menu
353 item. This function is called like a sort function. The items look
354 like (ITEM-NAME . BUFFER).
356 ITEM-NAME is the name of the item that will appear in the menu.
357 BUFFER is the buffer, this is not necessarily the current buffer.
359 Set this to nil or t if you don't want any sorting (faster)."
360 :type
'(choice (const msb-sort-by-name
)
361 (const :tag
"Newest first" t
)
362 (const :tag
"Oldest first" nil
))
366 (defcustom msb-files-by-directory nil
367 "*Non-nil means that files should be sorted by directory.
368 This is instead of the groups in `msb-menu-cond'."
373 (defcustom msb-after-load-hook nil
374 "Hook run after the msb package has been loaded."
380 ;;; Internal variables
383 ;; The last calculated menu.
384 (defvar msb--last-buffer-menu nil
)
386 ;; If this is non-nil, then it is a string that describes the error.
387 (defvar msb--error nil
)
390 ;;; Some example function to be used for `msb-item-handling-function'.
392 (defun msb-item-handler (buffer &optional maxbuf
)
393 "Create one string item, concerning BUFFER, for the buffer menu.
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
)))
405 (eval-when-compile (require 'dired
))
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
))))
415 (error "Unknown type of `dired-directory' in buffer %s"
418 (defun msb-dired-item-handler (buffer &optional maxbuf
)
419 "Create one string item, concerning a dired BUFFER, for the buffer menu.
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
)))
430 (defun msb-alon-item-handler (buffer maxbuf
)
431 "Create one string item for the buffer menu.
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
)
439 (if (buffer-modified-p) "*" " ")
440 (if buffer-read-only
"%" " ")
441 (if (and (boundp 'vc-mode
) vc-mode
) "#" " ")
442 (or buffer-file-name
"")))
445 ;;; Some example function to be used for `msb-item-sort-function'.
447 (defun msb-sort-by-name (item1 item2
)
448 "Sort the items ITEM1 and ITEM2 by their `buffer-name'.
449 An item looks like (NAME . BUFFER)."
450 (string-lessp (buffer-name (cdr item1
))
451 (buffer-name (cdr item2
))))
454 (defun msb-sort-by-directory (item1 item2
)
455 "Sort the items ITEM1 and ITEM2 by directory name. Made for dired.
456 An item look like (NAME . BUFFER)."
457 (string-lessp (save-excursion (set-buffer (cdr item1
))
458 (msb--dired-directory))
459 (save-excursion (set-buffer (cdr item2
))
460 (msb--dired-directory))))
465 ;;; This function can be used instead of (mouse-buffer-menu EVENT)
466 ;;; function in "mouse.el".
469 "Pop up several menus of buffers for selection with the mouse.
470 This command switches buffers in the window that you clicked on, and
473 See the function `mouse-select-buffer' and the variable
474 `msb-menu-cond' for more information about how the menus are split."
476 ;; If EVENT is a down-event, read and discard the
477 ;; corresponding up-event.
479 (memq 'down
(event-modifiers event
))
481 (let ((old-window (selected-window))
482 (window (posn-window (event-start event
))))
483 (unless (framep window
) (select-window window
))
484 (let ((buffer (mouse-select-buffer event
)))
486 (switch-to-buffer buffer
)
487 (select-window old-window
))))
491 ;;; Some supportive functions
493 (defun msb-invisible-buffer-p (&optional buffer
)
494 "Return t if optional BUFFER is an \"invisible\" buffer.
495 If the argument is left out or nil, then the current buffer is considered."
496 (and (> (length (buffer-name buffer
)) 0)
497 (eq ?\s
(aref (buffer-name buffer
) 0))))
499 (defun msb--strip-dir (dir)
500 "Strip one hierarchy level from the end of DIR."
501 (file-name-directory (directory-file-name dir
)))
503 ;; Create an alist with all buffers from LIST that lies under the same
504 ;; directory will be in the same item as the directory name.
505 ;; ((DIR1 . (BUFFER-1 BUFFER-2 ...)) (DIR2 . (BUFFER-K BUFFER-K+1...)) ...)
506 (defun msb--init-file-alist (list)
508 ;; Make alist that looks like
509 ;; ((DIR-1 BUFFER-1) (DIR-2 BUFFER-2) ...)
515 (let ((file-name (expand-file-name
516 (buffer-file-name buffer
))))
518 (list (cons (msb--strip-dir file-name
) buffer
)))))
520 (lambda (item1 item2
)
521 (string< (car item1
) (car item2
))))))
522 ;; Now clump buffers together that have the same directory name
523 ;; Make alist that looks like
524 ;; ((DIR1 . (BUFFER-1 BUFFER-2 ...)) (DIR2 . (BUFFER-K)) ...)
530 (mapcar (lambda (item)
532 ((equal dir
(car item
))
533 ;; The same dir as earlier:
534 ;; Add to current list of buffers.
535 (push (cdr item
) buffers
)
536 ;; This item should not be added to list
540 (let ((result (and dir
(cons dir buffers
))))
541 (setq dir
(car item
))
542 (setq buffers
(list (cdr item
)))
543 ;; Add the last result the list.
544 (and result
(list result
))))))
546 ;; Add the last result to the list
547 (list (cons dir buffers
))))))
549 (defun msb--format-title (top-found-p dir number-of-items
)
550 "Format a suitable title for the menu item."
551 (format (if top-found-p
"%s... (%d)" "%s (%d)")
552 (abbreviate-file-name dir
) number-of-items
))
554 ;; Variables for debugging.
555 (defvar msb--choose-file-menu-list
)
556 (defvar msb--choose-file-menu-arg-list
)
558 (defun msb--choose-file-menu (list)
559 "Choose file-menu with respect to directory for every buffer in LIST."
560 (setq msb--choose-file-menu-arg-list list
)
561 (let ((buffer-alist (msb--init-file-alist list
))
563 (max-clumped-together (if (numberp msb-max-file-menu-items
)
564 msb-max-file-menu-items
568 first rest dir buffers old-dir
)
569 ;; Prepare for looping over all items in buffer-alist
570 (setq first
(car buffer-alist
)
571 rest
(cdr buffer-alist
)
574 (setq msb--choose-file-menu-list
(copy-sequence rest
))
575 ;; This big loop tries to clump buffers together that have a
576 ;; similar name. Remember that buffer-alist is sorted based on the
577 ;; directory name of the buffers' visited files.
583 (setq item
(car tmp-rest
))
584 ;; Clump together the "rest"-buffers that have a dir that is
585 ;; a subdir of the current one.
587 (<= (length buffers
) max-clumped-together
)
588 (>= (length (car item
)) (length dir
))
589 ;; `completion-ignore-case' seems to default to t
590 ;; on the systems with case-insensitive file names.
591 (eq t
(compare-strings dir
0 nil
592 (car item
) 0 (length dir
)
593 completion-ignore-case
)))
595 (setq buffers
(append buffers
(cdr item
))) ;nconc is faster than append
596 (setq tmp-rest
(cdr tmp-rest
)
597 item
(car tmp-rest
)))
599 ((> (length buffers
) max-clumped-together
)
600 ;; Oh, we failed. Too many buffers clumped together.
601 ;; Just use the original ones for the result.
602 (setq last-dir
(car first
))
603 (push (cons (msb--format-title top-found-p
605 (length (cdr first
)))
608 (setq top-found-p nil
)
609 (setq first
(car rest
)
612 buffers
(cdr first
)))
614 ;; The first pass of clumping together worked out, go ahead
618 (setq first
(cons dir buffers
)
620 ;; Now see if we can clump more buffers together if we go up
621 ;; one step in the file hierarchy.
622 ;; If dir isn't changed by msb--strip-dir, we are looking
623 ;; at the machine name component of an ange-ftp filename.
625 (setq dir
(msb--strip-dir dir
)
627 (if (equal old-dir dir
)
630 (or (and (>= (length dir
) (length last-dir
))
631 (eq t
(compare-strings
634 completion-ignore-case
)))
635 (and (< (length dir
) (length last-dir
))
636 (eq t
(compare-strings
637 dir
0 nil last-dir
0 (length dir
)
638 completion-ignore-case
)))))
639 ;; We have reached the same place in the file hierarchy as
640 ;; the last result, so we should quit at this point and
641 ;; take what we have as result.
642 (push (cons (msb--format-title top-found-p
644 (length (cdr first
)))
647 (setq top-found-p nil
)
648 (setq first
(car rest
)
651 buffers
(cdr first
)))))))
652 ;; Now take care of the last item.
654 (push (cons (msb--format-title top-found-p
656 (length (cdr first
)))
659 (setq top-found-p nil
)
660 (nreverse final-list
)))
662 (defun msb--create-function-info (menu-cond-elt)
663 "Create a vector from an element MENU-COND-ELT of `msb-menu-cond'.
665 \]BUFFER-LIST-VARIABLE CONDITION MENU-SORT-KEY MENU-TITLE ITEM-HANDLER SORTER)
666 See `msb-menu-cond' for a description of its elements."
667 (let* ((list-symbol (make-symbol "-msb-buffer-list"))
668 (tmp-ih (and (> (length menu-cond-elt
) 3)
669 (nth 3 menu-cond-elt
)))
670 (item-handler (if (and tmp-ih
(fboundp tmp-ih
))
672 msb-item-handling-function
))
673 (tmp-s (if (> (length menu-cond-elt
) 4)
674 (nth 4 menu-cond-elt
)
675 msb-item-sort-function
))
676 (sorter (if (or (fboundp tmp-s
)
680 msb-item-sort-function
)))
681 (when (< (length menu-cond-elt
) 3)
682 (error "Wrong format of msb-menu-cond"))
683 (when (and (> (length menu-cond-elt
) 3)
684 (not (fboundp tmp-ih
)))
685 (signal 'invalid-function
(list tmp-ih
)))
686 (when (and (> (length menu-cond-elt
) 4)
688 (not (fboundp tmp-s
))
690 (signal 'invalid-function
(list tmp-s
)))
692 (vector list-symbol
;BUFFER-LIST-VARIABLE
693 (nth 0 menu-cond-elt
) ;CONDITION
694 (nth 1 menu-cond-elt
) ;SORT-KEY
695 (nth 2 menu-cond-elt
) ;MENU-TITLE
696 item-handler
;ITEM-HANDLER
700 ;; This defsubst is only used in `msb--choose-menu' below. It was
701 ;; pulled out merely to make the code somewhat clearer. The indentation
702 ;; level was too big.
703 (defsubst msb--collect
(function-info-vector)
707 (setq function-info-list
709 across function-info-vector
711 (eval (aref fi
1))) ;Test CONDITION
712 (not (and (eq result
'no-multi
)
714 (progn (when (eq result
'multi
)
719 (not (eq result
'multi
)))))
720 (when (and (not function-info-list
)
722 (error "No catch-all in msb-menu-cond!"))
725 (defun msb--add-to-menu (buffer function-info max-buffer-name-length
)
726 "Add BUFFER to the menu depicted by FUNCTION-INFO.
727 All side-effects. Adds an element of form (BUFFER-TITLE . BUFFER)
728 to the buffer-list variable in function-info."
729 (let ((list-symbol (aref function-info
0))) ;BUFFER-LIST-VARIABLE
730 ;; Here comes the hairy side-effect!
732 (cons (cons (funcall (aref function-info
4) ;ITEM-HANDLER
734 max-buffer-name-length
)
736 (eval list-symbol
)))))
738 (defsubst msb--choose-menu
(buffer function-info-vector max-buffer-name-length
)
739 "Select the appropriate menu for BUFFER."
740 ;; This is all side-effects, folks!
741 ;; This should be optimized.
742 (unless (and (not msb-display-invisible-buffers-p
)
743 (msb-invisible-buffer-p buffer
))
747 ;; Menu found. Add to this menu
748 (dolist (info (msb--collect function-info-vector
))
749 (msb--add-to-menu buffer info max-buffer-name-length
)))
750 (error (unless msb--error
753 "In msb-menu-cond, error for buffer `%s'."
754 (buffer-name buffer
)))
755 (error "%s" msb--error
))))))
757 (defun msb--create-sort-item (function-info)
758 "Return (SORT-KEY TITLE . BUFFER-LIST) or nil if the buffer-list is empty."
759 (let ((buffer-list (eval (aref function-info
0))))
761 (let ((sorter (aref function-info
5)) ;SORTER
762 (sort-key (aref function-info
2))) ;MENU-SORT-KEY
765 (cons (format (aref function-info
3) ;MENU-TITLE
766 (length buffer-list
))
771 (nreverse buffer-list
))
773 (sort buffer-list sorter
))))))))))
775 (defun msb--aggregate-alist (alist same-predicate sort-predicate
)
776 "Return ALIST as a sorted, aggregated alist.
778 In the result all items with the same car element (according to
779 SAME-PREDICATE) are aggregated together. The alist is first sorted by
783 \(msb--aggregate-alist
784 '((a . a1) (a . a2) (b . b1) (c . c3) (a . a4) (a . a3) (b . b3) (b . b2))
786 (lambda (item1 item2)
787 (string< (symbol-name item1) (symbol-name item2))))
789 \((a a1 a2 a4 a3) (b b1 b3 b2) (c c3))"
790 (when (not (null alist
))
803 (push (cdr item
) same
)
804 (setq first-time-p nil
)
805 (setq old-car
(car item
))
807 ((funcall same-predicate
(car item
) old-car
)
808 (push (cdr item
) same
)
813 (setq same
(list (cdr item
))
815 (list (cons tmp-old-car
(nreverse tmp-same
))))))
816 (sort alist
(lambda (item1 item2
)
817 (funcall sort-predicate
(car item1
) (car item2
))))))
818 (list (cons old-car
(nreverse same
)))))))
821 (defun msb--mode-menu-cond ()
822 (let ((key msb-modes-key
))
823 (mapcar (lambda (item)
825 (list `( eq major-mode
(quote ,(car item
)))
827 (concat (cdr item
) " (%d)")))
829 (let ((mode-list nil
))
830 (dolist (buffer (cdr (buffer-list)))
833 (when (and (not (msb-invisible-buffer-p))
834 (not (assq major-mode mode-list
)))
835 (push (cons major-mode mode-name
)
838 (lambda (item1 item2
)
839 (string< (cdr item1
) (cdr item2
)))))))
841 (defun msb--most-recently-used-menu (max-buffer-name-length)
842 "Return a list for the most recently used buffers.
843 It takes the form ((TITLE . BUFFER-LIST)...)."
844 (when (and (numberp msb-display-most-recently-used
)
845 (> msb-display-most-recently-used
0))
846 (let* ((buffers (cdr (buffer-list)))
849 for buffer in buffers
852 (and (not (msb-invisible-buffer-p))
853 (not (eq major-mode
'dired-mode
))))
854 collect
(save-excursion
856 (cons (funcall msb-item-handling-function
858 max-buffer-name-length
)
861 until
(>= n msb-display-most-recently-used
))))
862 (cons (if (stringp msb-most-recently-used-title
)
863 (format msb-most-recently-used-title
864 (length most-recently-used
))
865 (signal 'wrong-type-argument
(list msb-most-recently-used-title
)))
866 most-recently-used
))))
868 (defun msb--create-buffer-menu-2 ()
869 (let ((max-buffer-name-length 0)
871 function-info-vector
)
872 ;; Calculate the longest buffer name.
873 (dolist (buffer (buffer-list))
874 (when (or msb-display-invisible-buffers-p
875 (not (msb-invisible-buffer-p)))
876 (setq max-buffer-name-length
877 (max max-buffer-name-length
(length (buffer-name buffer
))))))
878 ;; Make a list with elements of type
879 ;; (BUFFER-LIST-VARIABLE
885 ;; Uses "function-global" variables:
886 ;; function-info-vector
887 (setq function-info-vector
888 (apply (function vector
)
889 (mapcar (function msb--create-function-info
)
890 (append msb-menu-cond
(msb--mode-menu-cond)))))
891 ;; Split the buffer-list into several lists; one list for each
892 ;; criteria. This is the most critical part with respect to time.
893 (dolist (buffer (buffer-list))
894 (cond ((and msb-files-by-directory
895 (buffer-file-name buffer
)
896 ;; exclude ange-ftp buffers
897 ;;(not (string-match "\\/[^/:]+:"
898 ;; (buffer-file-name buffer)))
900 (push buffer file-buffers
))
902 (msb--choose-menu buffer
904 max-buffer-name-length
))))
907 (mapcar (lambda (buffer-list)
908 (cons msb-files-by-directory-sort-key
909 (cons (car buffer-list
)
913 (cons (save-excursion
915 (funcall msb-item-handling-function
917 max-buffer-name-length
))
921 (lambda (item1 item2
)
922 (string< (car item1
) (car item2
))))))))
923 (msb--choose-file-menu file-buffers
))))
924 ;; Now make the menu - a list of (TITLE . BUFFER-LIST)
927 (msb--most-recently-used-menu max-buffer-name-length
))
928 (others (nconc file-buffers
930 across function-info-vector
931 for value
= (msb--create-sort-item elt
)
932 if value collect value
))))
934 (mapcar 'cdr
;Remove the SORT-KEY
935 ;; Sort the menus - not the items.
938 ;; Get a list of (SORT-KEY TITLE . BUFFER-LIST)
939 ;; Also sorts the items within the menus.
940 (if (cdr most-recently-used
)
942 ;; Add most recent used buffers
943 (cons msb-most-recently-used-sort-key
948 (< (car elt1
) (car elt2
)))))))
949 ;; Now make it a keymap menu
951 '(keymap "Select Buffer")
952 (msb--make-keymap-menu menu
)
953 (when msb-separator-diff
954 (list (list 'separator
"--")))
957 (if msb-files-by-directory
959 "*Files by directory*")
960 'msb--toggle-menu-type
)))))))
962 (defun msb--create-buffer-menu ()
965 (msb--create-buffer-menu-2))))
967 (defun msb--toggle-menu-type ()
968 "Multi purpose function for selecting a buffer with the mouse."
970 (setq msb-files-by-directory
(not msb-files-by-directory
))
971 ;; This gets a warning, but it is correct,
972 ;; because this file redefines menu-bar-update-buffers.
973 (msb-menu-bar-update-buffers t
))
975 (defun mouse-select-buffer (event)
976 "Pop up several menus of buffers, for selection with the mouse.
977 Returns the selected buffer or nil if no buffer is selected.
979 The way the buffers are split is conveniently handled with the
980 variable `msb-menu-cond'."
981 ;; Popup the menu and return the selected buffer.
983 (not msb--last-buffer-menu
)
984 (not (fboundp 'frame-or-buffer-changed-p
))
985 (frame-or-buffer-changed-p))
986 (setq msb--error nil
)
987 (setq msb--last-buffer-menu
(msb--create-buffer-menu)))
988 (let ((position event
)
990 (when (and (fboundp 'posn-x-y
)
991 (fboundp 'posn-window
))
992 (let ((posX (car (posn-x-y (event-start event
))))
993 (posY (cdr (posn-x-y (event-start event
))))
994 (posWind (posn-window (event-start event
))))
996 (setq posX
(- posX
(funcall msb-horizontal-shift-function
))
997 position
(list (list posX posY
) posWind
))))
998 ;; This `sit-for' magically makes the menu stay up if the mouse
999 ;; button is released within 0.1 second.
1002 (setq choice
(x-popup-menu position msb--last-buffer-menu
))
1004 ((eq (car choice
) 'toggle
)
1005 ;; Bring up the menu again with type toggled.
1006 (msb--toggle-menu-type)
1007 (mouse-select-buffer event
))
1008 ((and (numberp (car choice
))
1009 (null (cdr choice
)))
1010 (let ((msb--last-buffer-menu (nthcdr 3 (assq (car choice
)
1011 msb--last-buffer-menu
))))
1012 (mouse-select-buffer event
)))
1013 ((while (numberp (car choice
))
1014 (setq choice
(cdr choice
))))
1015 ((and (stringp (car choice
))
1016 (null (cdr choice
)))
1021 (error "Unknown form for buffer: %s" choice
)))))
1024 (defun msb--add-separators (sorted-list)
1025 (if (or (not msb-separator-diff
)
1026 (not (numberp msb-separator-diff
)))
1028 (let ((last-key nil
))
1033 ((and msb-separator-diff
1035 (> (- (car item
) last-key
)
1036 msb-separator-diff
))
1037 (setq last-key
(car item
))
1038 (list (cons last-key
'separator
)
1041 (setq last-key
(car item
))
1045 (defun msb--split-menus-2 (list mcount result
)
1047 ((> (length list
) msb-max-menu-items
)
1051 (while (< count msb-max-menu-items
)
1052 (push (pop list
) tmp-list
)
1054 (setq tmp-list
(nreverse tmp-list
))
1055 (setq sub-name
(concat (car (car tmp-list
)) "..."))
1056 (push (nconc (list mcount sub-name
1060 (msb--split-menus-2 list
(1+ mcount
) result
))
1065 (setq sub-name
(concat (car (car list
)) "..."))
1066 (push (nconc (list mcount sub-name
'keymap sub-name
)
1069 (nreverse result
))))
1071 (defun msb--split-menus (list)
1072 (if (and (integerp msb-max-menu-items
)
1073 (> msb-max-menu-items
0))
1074 (msb--split-menus-2 list
0 nil
)
1077 (defun msb--make-keymap-menu (raw-menu)
1078 (let ((end (cons '(nil) 'menu-bar-select-buffer
))
1083 ((eq 'separator sub-menu
)
1084 (list 'separator
"--"))
1086 (let ((buffers (mapcar (lambda (item)
1087 (cons (buffer-name (cdr item
))
1088 (cons (car item
) end
)))
1090 (nconc (list (incf mcount
) (car sub-menu
)
1091 'keymap
(car sub-menu
))
1092 (msb--split-menus buffers
))))))
1095 (defun msb-menu-bar-update-buffers (&optional arg
)
1096 "A re-written version of `menu-bar-update-buffers'."
1097 ;; If user discards the Buffers item, play along.
1098 (when (and (lookup-key (current-global-map) [menu-bar buffer
])
1099 (or (not (fboundp 'frame-or-buffer-changed-p
))
1100 (frame-or-buffer-changed-p)
1102 (let ((frames (frame-list))
1103 buffers-menu frames-menu
)
1104 ;; Make the menu of buffers proper.
1105 (setq msb--last-buffer-menu
(msb--create-buffer-menu))
1106 (setq buffers-menu msb--last-buffer-menu
)
1107 ;; Make a Frames menu if we have more than one frame.
1109 (let* ((frame-length (length frames
))
1110 (f-title (format "Frames (%d)" frame-length
)))
1111 ;; List only the N most recently selected frames
1112 (when (and (integerp msb-max-menu-items
)
1113 (> msb-max-menu-items
1)
1114 (> frame-length msb-max-menu-items
))
1115 (setcdr (nthcdr msb-max-menu-items frames
) nil
))
1118 (list 'frame f-title
'(nil) 'keymap f-title
)
1122 (list (frame-parameter frame
'name
)
1123 (frame-parameter frame
'name
)
1125 'menu-bar-select-frame
))
1127 (define-key (current-global-map) [menu-bar buffer
]
1129 (if (and buffers-menu frames-menu
)
1130 ;; Combine Frame and Buffers menus with separator between
1131 (nconc (list 'keymap
"Buffers and Frames" frames-menu
1132 (and msb-separator-diff
'(separator "--")))
1133 (cddr buffers-menu
))
1134 (or buffers-menu
'undefined
)))))))
1136 ;; Snarf current bindings of `mouse-buffer-menu' (normally
1138 (defvar msb-mode-map
1139 (let ((map (make-sparse-keymap "Msb")))
1140 (define-key map
[remap mouse-buffer-menu
] 'msb
)
1144 (define-minor-mode msb-mode
1146 With arg, turn Msb mode on if and only if arg is positive.
1147 This mode overrides the binding(s) of `mouse-buffer-menu' to provide a
1148 different buffer menu using the function `msb'."
1149 :global t
:group
'msb
1152 (add-hook 'menu-bar-update-hook
'msb-menu-bar-update-buffers
)
1153 (remove-hook 'menu-bar-update-hook
'menu-bar-update-buffers
)
1154 (msb-menu-bar-update-buffers t
))
1155 (remove-hook 'menu-bar-update-hook
'msb-menu-bar-update-buffers
)
1156 (add-hook 'menu-bar-update-hook
'menu-bar-update-buffers
)
1157 (menu-bar-update-buffers t
)))
1159 (defun msb-unload-hook ()
1161 (add-hook 'msb-unload-hook
'msb-unload-hook
)
1164 (eval-after-load "msb" '(run-hooks 'msb-after-load-hook
'msb-after-load-hooks
))
1166 ;;; arch-tag: 403f9e82-b92e-4e7a-a797-5d6d9b76da36
1167 ;;; msb.el ends here