1 ;;; msb.el --- Customizable buffer-selection with multiple menus.
3 ;; Copyright (C) 1993, 94, 95, 97, 98, 99, 2000 Free Software Foundation, Inc.
5 ;; Author: Lars Lindberg <Lars.G.Lindberg@capgemini.se>
8 ;; Lindberg's last update version: 3.34
9 ;; Keywords: mouse buffer menu
11 ;; This file is part of GNU Emacs.
13 ;; GNU Emacs is free software; you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation; either version 2, or (at your option)
18 ;; GNU Emacs is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs; see the file COPYING. If not, write to the
25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
26 ;; Boston, MA 02111-1307, USA.
30 ;; Purpose of this package:
31 ;; 1. Offer a function for letting the user choose buffer,
32 ;; not necessarily for switching to it.
33 ;; 2. Make a better mouse-buffer-menu. This is done as a global
34 ;; minor mode, msb-mode.
37 ;; Look at the variable `msb-menu-cond' for deciding what menus you
38 ;; want. It's not that hard to customize, despite my not-so-good
39 ;; doc-string. Feel free to send me a better doc-string.
40 ;; There are some constants for you to try here:
42 ;; msb--very-many-menus (default)
44 ;; Look at the variable `msb-item-handling-function' for customization
45 ;; of the appearance of every menu item. Try for instance setting
46 ;; it to `msb-alon-item-handler'.
48 ;; Look at the variable `msb-item-sort-function' for customization
49 ;; of sorting the menus. Set it to t for instance, which means no
50 ;; sorting - you will get latest used buffer first.
52 ;; Also check out the variable `msb-display-invisible-buffers-p'.
55 ;; - Files-by-directory
56 ;; + No possibility to show client/changed buffers separately.
57 ;; + All file buffers only appear in a file sub-menu, they will
58 ;; for instance not appear in the Mail sub-menu.
60 ;; Future enhancements:
63 ;; Mark Brader <msb@sq.com>
64 ;; Jim Berry <m1jhb00@FRB.GOV>
65 ;; Hans Chalupsky <hans@cs.Buffalo.EDU>
66 ;; Larry Rosenberg <ljr@ictv.com>
67 ;; Will Henney <will@astroscu.unam.mx>
68 ;; Jari Aalto <jaalto@tre.tele.nokia.fi>
69 ;; Michael Kifer <kifer@sbkifer.cs.sunysb.edu>
70 ;; Gael Marziou <gael@gnlab030.grenoble.hp.com>
71 ;; Dave Gillespie <daveg@thymus.synaptics.com>
72 ;; Alon Albert <alon@milcse.rtsg.mot.com>
73 ;; Kevin Broadey, <KevinB@bartley.demon.co.uk>
74 ;; Ake Stenhof <ake@cadpoint.se>
75 ;; Richard Stallman <rms@gnu.org>
76 ;; Steve Fisk <fisk@medved.bowdoin.edu>
78 ;; This version turned into a global minor mode and subsequently
79 ;; hacked on by Dave Love.
82 (eval-when-compile (require 'cl
))
85 ;;; Some example constants to be used for `msb-menu-cond'. See that
86 ;;; variable for more information. Please note that if the condition
87 ;;; returns `multi', then the buffer can appear in several menus.
89 (defconst msb--few-menus
90 '(((and (boundp 'server-buffer-clients
)
95 ((and msb-display-invisible-buffers-p
96 (msb-invisible-buffer-p)
99 "Invisible buffers (%d)")
100 ((eq major-mode
'dired-mode
)
103 msb-dired-item-handler
104 msb-sort-by-directory
)
105 ((eq major-mode
'Man-mode
)
108 ((eq major-mode
'w3-mode
)
111 ((or (memq major-mode
112 '(rmail-mode rmail-edit-mode vm-summary-mode vm-mode mail-mode
))
113 (memq major-mode
'(mh-letter-mode mh-show-mode mh-folder-mode
))
115 '(gnus-summary-mode message-mode gnus-group-mode
116 gnus-article-mode score-mode gnus-browse-killed-mode
)))
119 ((not buffer-file-name
)
126 (defconst msb--very-many-menus
127 '(((and (boundp 'server-buffer-clients
)
128 server-buffer-clients
132 ((and (boundp 'vc-mode
) vc-mode
'multi
)
134 "Version Control (%d)")
135 ((and buffer-file-name
139 "Changed files (%d)")
140 ((and (get-buffer-process (current-buffer))
144 ((and msb-display-invisible-buffers-p
145 (msb-invisible-buffer-p)
148 "Invisible buffers (%d)")
149 ((eq major-mode
'dired-mode
)
152 ;; Note this different menu-handler
153 msb-dired-item-handler
154 ;; Also note this item-sorter
155 msb-sort-by-directory
)
156 ((eq major-mode
'Man-mode
)
159 ((eq major-mode
'w3-mode
)
162 ((or (memq major-mode
163 '(rmail-mode rmail-edit-mode vm-summary-mode vm-mode mail-mode
))
164 (memq major-mode
'(mh-letter-mode mh-show-mode mh-folder-mode
))
165 (memq major-mode
'(gnus-summary-mode message-mode gnus-group-mode
166 gnus-article-mode score-mode
167 gnus-browse-killed-mode
)))
170 ;; Catchup for all non-file buffers
171 ((and (not buffer-file-name
)
174 "Other non-file buffers (%d)")
175 ((and (string-match "/\\.[^/]*$" buffer-file-name
)
179 ((memq major-mode
'(c-mode c
++-mode
))
182 ((eq major-mode
'emacs-lisp-mode
)
185 ((eq major-mode
'latex-mode
)
190 "Other files (%d)")))
192 ;; msb--many-menus is obsolete
193 (defvar msb--many-menus msb--very-many-menus
)
196 ;;; Customizable variables
200 "Customizable buffer-selection with multiple menus."
205 (defcustom msb-mode nil
207 Setting this variable directly does not take effect;
208 use either \\[customize] or the function `msb-mode'."
209 :set
(lambda (symbol value
)
210 (msb-mode (or value
0)))
211 :initialize
'custom-initialize-default
217 (defun msb-custom-set (symbol value
)
218 "Set the value of custom variables for msb."
220 (if (and (featurep 'msb
) msb-mode
)
221 ;; wait until package has been loaded before bothering to update
223 (msb-menu-bar-update-buffers t
)))
225 (defcustom msb-menu-cond msb--very-many-menus
226 "*List of criteria for splitting the mouse buffer menu.
227 The elements in the list should be of this type:
228 (CONDITION MENU-SORT-KEY MENU-TITLE ITEM-HANDLING-FN ITEM-SORT-FN).
230 When making the split, the buffers are tested one by one against the
231 CONDITION, just like a Lisp cond: When hitting a true condition, the
232 other criteria are *not* tested and the buffer name will appear in the
233 menu with the menu-title corresponding to the true condition.
235 If the condition returns the symbol `multi', then the buffer will be
236 added to this menu *and* tested for other menus too. If it returns
237 `no-multi', then the buffer will only be added if it hasn't been added
240 During this test, the buffer in question is the current buffer, and
241 the test is surrounded by calls to `save-excursion' and
244 The categories are sorted by MENU-SORT-KEY. Smaller keys are on top.
245 nil means don't display this menu.
247 MENU-TITLE is really a format. If you add %d in it, the %d is
248 replaced with the number of items in that menu.
250 ITEM-HANDLING-FN, is optional. If it is supplied and is a function,
251 than it is used for displaying the items in that particular buffer
252 menu, otherwise the function pointed out by
253 `msb-item-handling-function' is used.
255 ITEM-SORT-FN, is also optional.
256 If it is not supplied, the function pointed out by
257 `msb-item-sort-function' is used.
258 If it is nil, then no sort takes place and the buffers are presented
259 in least-recently-used order.
260 If it is t, then no sort takes place and the buffers are presented in
261 most-recently-used order.
262 If it is supplied and non-nil and not t than it is used for sorting
263 the items in that particular buffer menu.
265 Note1: There should always be a `catch-all' as last element, in this
266 list. That is an element like (t TITLE ITEM-HANDLING-FUNCTION).
267 Note2: A buffer menu appears only if it has at least one buffer in it.
268 Note3: If you have a CONDITION that can't be evaluated you will get an
269 error every time you do \\[msb]."
270 :type
`(choice (const :tag
"long" :value
,msb--very-many-menus
)
271 (const :tag
"short" :value
,msb--few-menus
)
276 (defcustom msb-modes-key
4000
277 "The sort key for files sorted by mode."
283 (defcustom msb-separator-diff
100
284 "*Non-nil means use separators.
285 The separators will appear between all menus that have a sorting key
286 that differs by this value or more."
287 :type
'(choice integer
(const nil
))
291 (defvar msb-files-by-directory-sort-key
0
292 "*The sort key for files sorted by directory.")
294 (defcustom msb-max-menu-items
15
295 "*The maximum number of items in a menu.
296 If this variable is set to 15 for instance, then the submenu will be
297 split up in minor parts, 15 items each. Nil means no limit."
298 :type
'(choice integer
(const nil
))
302 (defcustom msb-max-file-menu-items
10
303 "*The maximum number of items from different directories.
305 When the menu is of type `file by directory', this is the maximum
306 number of buffers that are clumped together from different
309 Set this to 1 if you want one menu per directory instead of clumping
312 If the value is not a number, then the value 10 is used."
317 (defcustom msb-most-recently-used-sort-key -
1010
318 "*Where should the menu with the most recently used buffers be placed?"
323 (defcustom msb-display-most-recently-used
15
324 "*How many buffers should be in the most-recently-used menu.
325 No buffers at all if less than 1 or nil (or any non-number)."
330 (defcustom msb-most-recently-used-title
"Most recently used (%d)"
331 "*The title for the most-recently-used menu."
336 (defvar msb-horizontal-shift-function
'(lambda () 0)
337 "*Function that specifies how many pixels to shift the top menu leftwards.")
339 (defcustom msb-display-invisible-buffers-p nil
340 "*Show invisible buffers or not.
341 Non-nil means that the buffer menu should include buffers that have
342 names that starts with a space character."
347 (defvar msb-item-handling-function
'msb-item-handler
348 "*The appearance of a buffer menu.
350 The default function to call for handling the appearance of a menu
351 item. It should take to arguments, BUFFER and MAX-BUFFER-NAME-LENGTH,
352 where the latter is the max length of all buffer names.
354 The function should return the string to use in the menu.
356 When the function is called, BUFFER is the current buffer. This
357 function is called for items in the variable `msb-menu-cond' that have
358 nil as ITEM-HANDLING-FUNCTION. See `msb-menu-cond' for more
361 (defcustom msb-item-sort-function
'msb-sort-by-name
362 "*The order of items in a buffer menu.
364 The default function to call for handling the order of items in a menu
365 item. This function is called like a sort function. The items look
366 like (ITEM-NAME . BUFFER).
368 ITEM-NAME is the name of the item that will appear in the menu.
369 BUFFER is the buffer, this is not necessarily the current buffer.
371 Set this to nil or t if you don't want any sorting (faster)."
372 :type
'(choice (const msb-sort-by-name
)
373 (const :tag
"Newest first" t
)
374 (const :tag
"Oldest first" nil
))
378 (defcustom msb-files-by-directory nil
379 "*Non-nil means that files should be sorted by directory.
380 This is instead of the groups in `msb-menu-cond'."
385 (defcustom msb-after-load-hooks nil
386 "Hooks to be run after the msb package has been loaded."
392 ;;; Internal variables
395 ;; The last calculated menu.
396 (defvar msb--last-buffer-menu nil
)
398 ;; If this is non-nil, then it is a string that describes the error.
399 (defvar msb--error nil
)
402 ;;; Some example function to be used for `msb-item-handling-function'.
404 (defun msb-item-handler (buffer &optional maxbuf
)
405 "Create one string item, concerning BUFFER, for the buffer menu.
408 The `*' appears only if the buffer is marked as modified.
409 The `%' appears only if the buffer is read-only.
410 Optional second argument MAXBUF is completely ignored."
411 (let ((name (buffer-name))
412 (modified (if (buffer-modified-p) "*" " "))
413 (read-only (if buffer-read-only
"%" " ")))
414 (format "%s%s %s" modified read-only name
)))
417 (eval-when-compile (require 'dired
))
419 ;; `dired' can be called with a list of the form (directory file1 file2 ...)
420 ;; which causes `dired-directory' to be in the same form.
421 (defun msb--dired-directory ()
422 (cond ((stringp dired-directory
)
423 (abbreviate-file-name (expand-file-name dired-directory
)))
424 ((consp dired-directory
)
425 (abbreviate-file-name (expand-file-name (car dired-directory
))))
427 (error "Unknown type of `dired-directory' in buffer %s"
430 (defun msb-dired-item-handler (buffer &optional maxbuf
)
431 "Create one string item, concerning a dired BUFFER, for the buffer menu.
434 The `*' appears only if the buffer is marked as modified.
435 The `%' appears only if the buffer is read-only.
436 Optional second argument MAXBUF is completely ignored."
437 (let ((name (msb--dired-directory))
438 (modified (if (buffer-modified-p) "*" " "))
439 (read-only (if buffer-read-only
"%" " ")))
440 (format "%s%s %s" modified read-only name
)))
442 (defun msb-alon-item-handler (buffer maxbuf
)
443 "Create one string item for the buffer menu.
445 <buffer-name> *%# <file-name>
446 The `*' appears only if the buffer is marked as modified.
447 The `%' appears only if the buffer is read-only.
448 The `#' appears only version control file (SCCS/RCS)."
449 (format (format "%%%ds %%s%%s%%s %%s" maxbuf
)
451 (if (buffer-modified-p) "*" " ")
452 (if buffer-read-only
"%" " ")
453 (if (and (boundp 'vc-mode
) vc-mode
) "#" " ")
454 (or buffer-file-name
"")))
457 ;;; Some example function to be used for `msb-item-sort-function'.
459 (defun msb-sort-by-name (item1 item2
)
460 "Sort the items ITEM1 and ITEM2 by their `buffer-name'.
461 An item looks like (NAME . BUFFER)."
462 (string-lessp (buffer-name (cdr item1
))
463 (buffer-name (cdr item2
))))
466 (defun msb-sort-by-directory (item1 item2
)
467 "Sort the items ITEM1 and ITEM2 by directory name. Made for dired.
468 An item look like (NAME . BUFFER)."
469 (string-lessp (save-excursion (set-buffer (cdr item1
))
470 (msb--dired-directory))
471 (save-excursion (set-buffer (cdr item2
))
472 (msb--dired-directory))))
477 ;;; This function can be used instead of (mouse-buffer-menu EVENT)
478 ;;; function in "mouse.el".
481 "Pop up several menus of buffers for selection with the mouse.
482 This command switches buffers in the window that you clicked on, and
485 See the function `mouse-select-buffer' and the variable
486 `msb-menu-cond' for more information about how the menus are split."
488 (let ((old-window (selected-window))
489 (window (posn-window (event-start event
))))
490 (unless (framep window
) (select-window window
))
491 (let ((buffer (mouse-select-buffer event
)))
493 (switch-to-buffer buffer
)
494 (select-window old-window
))))
498 ;;; Some supportive functions
500 (defun msb-invisible-buffer-p (&optional buffer
)
501 "Return t if optional BUFFER is an \"invisible\" buffer.
502 If the argument is left out or nil, then the current buffer is considered."
503 (and (> (length (buffer-name buffer
)) 0)
504 (eq ?\
(aref (buffer-name buffer
) 0))))
506 (defun msb--strip-dir (dir)
507 "Strip one hierarchy level from the end of DIR."
508 (file-name-directory (directory-file-name dir
)))
510 ;; Create an alist with all buffers from LIST that lies under the same
511 ;; directory will be in the same item as the directory string.
512 ;; ((PATH1 . (BUFFER-1 BUFFER-2 ...)) (PATH2 . (BUFFER-K BUFFER-K+1...)) ...)
513 (defun msb--init-file-alist (list)
515 ;; Make alist that looks like
516 ;; ((PATH-1 BUFFER-1) (PATH-2 BUFFER-2) ...)
522 (let ((file-name (expand-file-name
523 (buffer-file-name buffer
))))
525 (list (cons (msb--strip-dir file-name
) buffer
)))))
527 (lambda (item1 item2
)
528 (string< (car item1
) (car item2
))))))
529 ;; Now clump buffers together that have the same path
530 ;; Make alist that looks like
531 ;; ((PATH1 . (BUFFER-1 BUFFER-2 ...)) (PATH2 . (BUFFER-K)) ...)
537 (mapcar (lambda (item)
539 ((equal path
(car item
))
540 ;; The same path as earlier: Add to current list of
542 (push (cdr item
) buffers
)
543 ;; This item should not be added to list
547 (let ((result (and path
(cons path buffers
))))
548 (setq path
(car item
))
549 (setq buffers
(list (cdr item
)))
550 ;; Add the last result the list.
551 (and result
(list result
))))))
553 ;; Add the last result to the list
554 (list (cons path buffers
))))))
556 (defun msb--format-title (top-found-p path number-of-items
)
557 "Format a suitable title for the menu item."
558 (format (if top-found-p
"%s... (%d)" "%s (%d)")
559 (abbreviate-file-name path
) number-of-items
))
561 ;; Variables for debugging.
562 (defvar msb--choose-file-menu-list
)
563 (defvar msb--choose-file-menu-arg-list
)
565 (defun msb--choose-file-menu (list)
566 "Choose file-menu with respect to directory for every buffer in LIST."
567 (setq msb--choose-file-menu-arg-list list
)
568 (let ((buffer-alist (msb--init-file-alist list
))
570 (max-clumped-together (if (numberp msb-max-file-menu-items
)
571 msb-max-file-menu-items
575 first rest path buffers old-path
)
576 ;; Prepare for looping over all items in buffer-alist
577 (setq first
(car buffer-alist
)
578 rest
(cdr buffer-alist
)
581 (setq msb--choose-file-menu-list
(copy-sequence rest
))
582 ;; This big loop tries to clump buffers together that have a
583 ;; similar name. Remember that buffer-alist is sorted based on the
584 ;; path for the buffers.
590 (setq item
(car tmp-rest
))
591 ;; Clump together the "rest"-buffers that have a path that is
592 ;; a subpath of the current one.
594 (<= (length buffers
) max-clumped-together
)
595 (>= (length (car item
)) (length path
))
596 ;; `completion-ignore-case' seems to default to t
597 ;; on the systems with case-insensitive file names.
598 (eq t
(compare-strings path
0 nil
599 (car item
) 0 (length path
)
600 completion-ignore-case
)))
602 (setq buffers
(append buffers
(cdr item
))) ;nconc is faster than append
603 (setq tmp-rest
(cdr tmp-rest
)
604 item
(car tmp-rest
)))
606 ((> (length buffers
) max-clumped-together
)
607 ;; Oh, we failed. Too many buffers clumped together.
608 ;; Just use the original ones for the result.
609 (setq last-path
(car first
))
610 (push (cons (msb--format-title top-found-p
612 (length (cdr first
)))
615 (setq top-found-p nil
)
616 (setq first
(car rest
)
619 buffers
(cdr first
)))
621 ;; The first pass of clumping together worked out, go ahead
625 (setq first
(cons path buffers
)
627 ;; Now see if we can clump more buffers together if we go up
628 ;; one step in the file hierarchy.
629 ;; If path isn't changed by msb--strip-dir, we are looking
630 ;; at the machine name component of an ange-ftp filename.
632 (setq path
(msb--strip-dir path
)
634 (if (equal old-path path
)
635 (setq last-path path
))
637 (or (and (>= (length path
) (length last-path
))
638 (eq t
(compare-strings
639 last-path
0 nil path
0
641 completion-ignore-case
)))
642 (and (< (length path
) (length last-path
))
643 (eq t
(compare-strings
644 path
0 nil last-path
0 (length path
)
645 completion-ignore-case
)))))
646 ;; We have reached the same place in the file hierarchy as
647 ;; the last result, so we should quit at this point and
648 ;; take what we have as result.
649 (push (cons (msb--format-title top-found-p
651 (length (cdr first
)))
654 (setq top-found-p nil
)
655 (setq first
(car rest
)
658 buffers
(cdr first
)))))))
659 ;; Now take care of the last item.
661 (push (cons (msb--format-title top-found-p
663 (length (cdr first
)))
666 (setq top-found-p nil
)
667 (nreverse final-list
)))
669 (defun msb--create-function-info (menu-cond-elt)
670 "Create a vector from an element MENU-COND-ELT of `msb-menu-cond'.
672 \]BUFFER-LIST-VARIABLE CONDITION MENU-SORT-KEY MENU-TITLE ITEM-HANDLER SORTER)
673 See `msb-menu-cond' for a description of its elements."
674 (let* ((list-symbol (make-symbol "-msb-buffer-list"))
675 (tmp-ih (and (> (length menu-cond-elt
) 3)
676 (nth 3 menu-cond-elt
)))
677 (item-handler (if (and tmp-ih
(fboundp tmp-ih
))
679 msb-item-handling-function
))
680 (tmp-s (if (> (length menu-cond-elt
) 4)
681 (nth 4 menu-cond-elt
)
682 msb-item-sort-function
))
683 (sorter (if (or (fboundp tmp-s
)
687 msb-item-sort-function
)))
688 (when (< (length menu-cond-elt
) 3)
689 (error "Wrong format of msb-menu-cond"))
690 (when (and (> (length menu-cond-elt
) 3)
691 (not (fboundp tmp-ih
)))
692 (signal 'invalid-function
(list tmp-ih
)))
693 (when (and (> (length menu-cond-elt
) 4)
695 (not (fboundp tmp-s
))
697 (signal 'invalid-function
(list tmp-s
)))
699 (vector list-symbol
;BUFFER-LIST-VARIABLE
700 (nth 0 menu-cond-elt
) ;CONDITION
701 (nth 1 menu-cond-elt
) ;SORT-KEY
702 (nth 2 menu-cond-elt
) ;MENU-TITLE
703 item-handler
;ITEM-HANDLER
707 ;; This defsubst is only used in `msb--choose-menu' below. It was
708 ;; pulled out merely to make the code somewhat clearer. The indentation
709 ;; level was too big.
710 (defsubst msb--collect
(function-info-vector)
714 (setq function-info-list
716 across function-info-vector
718 (eval (aref fi
1))) ;Test CONDITION
719 (not (and (eq result
'no-multi
)
721 (progn (when (eq result
'multi
)
726 (not (eq result
'multi
)))))
727 (when (and (not function-info-list
)
729 (error "No catch-all in msb-menu-cond!"))
732 (defun msb--add-to-menu (buffer function-info max-buffer-name-length
)
733 "Add BUFFER to the menu depicted by FUNCTION-INFO.
734 All side-effects. Adds an element of form (BUFFER-TITLE . BUFFER)
735 to the buffer-list variable in function-info."
736 (let ((list-symbol (aref function-info
0))) ;BUFFER-LIST-VARIABLE
737 ;; Here comes the hairy side-effect!
739 (cons (cons (funcall (aref function-info
4) ;ITEM-HANDLER
741 max-buffer-name-length
)
743 (eval list-symbol
)))))
745 (defsubst msb--choose-menu
(buffer function-info-vector max-buffer-name-length
)
746 "Select the appropriate menu for BUFFER."
747 ;; This is all side-effects, folks!
748 ;; This should be optimized.
749 (unless (and (not msb-display-invisible-buffers-p
)
750 (msb-invisible-buffer-p buffer
))
754 ;; Menu found. Add to this menu
755 (dolist (info (msb--collect function-info-vector
))
756 (msb--add-to-menu buffer info max-buffer-name-length
)))
757 (error (unless msb--error
760 "In msb-menu-cond, error for buffer `%s'."
761 (buffer-name buffer
)))
762 (error "%s" msb--error
))))))
764 (defun msb--create-sort-item (function-info)
765 "Return (SORT-KEY TITLE . BUFFER-LIST) or nil if the buffer-list is empty."
766 (let ((buffer-list (eval (aref function-info
0))))
768 (let ((sorter (aref function-info
5)) ;SORTER
769 (sort-key (aref function-info
2))) ;MENU-SORT-KEY
772 (cons (format (aref function-info
3) ;MENU-TITLE
773 (length buffer-list
))
778 (nreverse buffer-list
))
780 (sort buffer-list sorter
))))))))))
782 (defun msb--aggregate-alist (alist same-predicate sort-predicate
)
783 "Return ALIST as a sorted, aggregated alist.
785 In the result all items with the same car element (according to
786 SAME-PREDICATE) are aggregated together. The alist is first sorted by
790 \(msb--aggregate-alist
791 '((a . a1) (a . a2) (b . b1) (c . c3) (a . a4) (a . a3) (b . b3) (b . b2))
793 (lambda (item1 item2)
794 (string< (symbol-name item1) (symbol-name item2))))
796 \((a a1 a2 a4 a3) (b b1 b3 b2) (c c3))"
797 (when (not (null alist
))
810 (push (cdr item
) same
)
811 (setq first-time-p nil
)
812 (setq old-car
(car item
))
814 ((funcall same-predicate
(car item
) old-car
)
815 (push (cdr item
) same
)
820 (setq same
(list (cdr item
))
822 (list (cons tmp-old-car
(nreverse tmp-same
))))))
823 (sort alist
(lambda (item1 item2
)
824 (funcall sort-predicate
(car item1
) (car item2
))))))
825 (list (cons old-car
(nreverse same
)))))))
828 (defun msb--mode-menu-cond ()
829 (let ((key msb-modes-key
))
830 (mapcar (lambda (item)
832 (list `( eq major-mode
(quote ,(car item
)))
834 (concat (cdr item
) " (%d)")))
836 (let ((mode-list nil
))
837 (dolist (buffer (cdr (buffer-list)))
840 (when (and (not (msb-invisible-buffer-p))
841 (not (assq major-mode mode-list
)))
842 (push (cons major-mode mode-name
)
845 (lambda (item1 item2
)
846 (string< (cdr item1
) (cdr item2
)))))))
848 (defun msb--most-recently-used-menu (max-buffer-name-length)
849 "Return a list for the most recently used buffers.
850 It takes the form ((TITLE . BUFFER-LIST)...)."
851 (when (and (numberp msb-display-most-recently-used
)
852 (> msb-display-most-recently-used
0))
853 (let* ((buffers (cdr (buffer-list)))
856 for buffer in buffers
859 (and (not (msb-invisible-buffer-p))
860 (not (eq major-mode
'dired-mode
))))
861 collect
(save-excursion
863 (cons (funcall msb-item-handling-function
865 max-buffer-name-length
)
868 until
(>= n msb-display-most-recently-used
))))
869 (cons (if (stringp msb-most-recently-used-title
)
870 (format msb-most-recently-used-title
871 (length most-recently-used
))
872 (signal 'wrong-type-argument
(list msb-most-recently-used-title
)))
873 most-recently-used
))))
875 (defun msb--create-buffer-menu-2 ()
876 (let ((max-buffer-name-length 0)
878 function-info-vector
)
879 ;; Calculate the longest buffer name.
880 (dolist (buffer (buffer-list))
881 (when (or msb-display-invisible-buffers-p
882 (not (msb-invisible-buffer-p)))
883 (setq max-buffer-name-length
884 (max max-buffer-name-length
(length (buffer-name buffer
))))))
885 ;; Make a list with elements of type
886 ;; (BUFFER-LIST-VARIABLE
892 ;; Uses "function-global" variables:
893 ;; function-info-vector
894 (setq function-info-vector
895 (apply (function vector
)
896 (mapcar (function msb--create-function-info
)
897 (append msb-menu-cond
(msb--mode-menu-cond)))))
898 ;; Split the buffer-list into several lists; one list for each
899 ;; criteria. This is the most critical part with respect to time.
900 (dolist (buffer (buffer-list))
901 (cond ((and msb-files-by-directory
902 (buffer-file-name buffer
)
903 ;; exclude ange-ftp buffers
904 ;;(not (string-match "\\/[^/:]+:"
905 ;; (buffer-file-name buffer)))
907 (push buffer file-buffers
))
909 (msb--choose-menu buffer
911 max-buffer-name-length
))))
914 (mapcar (lambda (buffer-list)
915 (cons msb-files-by-directory-sort-key
916 (cons (car buffer-list
)
920 (cons (save-excursion
922 (funcall msb-item-handling-function
924 max-buffer-name-length
))
928 (lambda (item1 item2
)
929 (string< (car item1
) (car item2
))))))))
930 (msb--choose-file-menu file-buffers
))))
931 ;; Now make the menu - a list of (TITLE . BUFFER-LIST)
934 (msb--most-recently-used-menu max-buffer-name-length
))
935 (others (nconc file-buffers
937 across function-info-vector
938 for value
= (msb--create-sort-item elt
)
939 if value collect value
))))
941 (mapcar 'cdr
;Remove the SORT-KEY
942 ;; Sort the menus - not the items.
945 ;; Get a list of (SORT-KEY TITLE . BUFFER-LIST)
946 ;; Also sorts the items within the menus.
947 (if (cdr most-recently-used
)
949 ;; Add most recent used buffers
950 (cons msb-most-recently-used-sort-key
955 (< (car elt1
) (car elt2
)))))))
956 ;; Now make it a keymap menu
958 '(keymap "Select Buffer")
959 (msb--make-keymap-menu menu
)
960 (when msb-separator-diff
961 (list (list 'separator
"--")))
964 (if msb-files-by-directory
966 "*Files by directory*")
967 'msb--toggle-menu-type
)))))))
969 (defun msb--create-buffer-menu ()
972 (msb--create-buffer-menu-2))))
974 (defun msb--toggle-menu-type ()
975 "Multi purpose function for selecting a buffer with the mouse."
977 (setq msb-files-by-directory
(not msb-files-by-directory
))
978 ;; This gets a warning, but it is correct,
979 ;; because this file redefines menu-bar-update-buffers.
980 (msb-menu-bar-update-buffers t
))
982 (defun mouse-select-buffer (event)
983 "Pop up several menus of buffers, for selection with the mouse.
984 Returns the selected buffer or nil if no buffer is selected.
986 The way the buffers are split is conveniently handled with the
987 variable `msb-menu-cond'."
988 ;; Popup the menu and return the selected buffer.
990 (not msb--last-buffer-menu
)
991 (not (fboundp 'frame-or-buffer-changed-p
))
992 (frame-or-buffer-changed-p))
993 (setq msb--error nil
)
994 (setq msb--last-buffer-menu
(msb--create-buffer-menu)))
995 (let ((position event
)
997 (when (and (fboundp 'posn-x-y
)
998 (fboundp 'posn-window
))
999 (let ((posX (car (posn-x-y (event-start event
))))
1000 (posY (cdr (posn-x-y (event-start event
))))
1001 (posWind (posn-window (event-start event
))))
1003 (setq posX
(- posX
(funcall msb-horizontal-shift-function
))
1004 position
(list (list posX posY
) posWind
))))
1005 ;; This `sit-for' magically makes the menu stay up if the mouse
1006 ;; button is released within 0.1 second.
1009 (setq choice
(x-popup-menu position msb--last-buffer-menu
))
1011 ((eq (car choice
) 'toggle
)
1012 ;; Bring up the menu again with type toggled.
1013 (msb--toggle-menu-type)
1014 (mouse-select-buffer event
))
1015 ((and (numberp (car choice
))
1016 (null (cdr choice
)))
1017 (let ((msb--last-buffer-menu (nthcdr 3 (assq (car choice
)
1018 msb--last-buffer-menu
))))
1019 (mouse-select-buffer event
)))
1020 ((while (numberp (car choice
))
1021 (setq choice
(cdr choice
))))
1022 ((and (stringp (car choice
))
1023 (null (cdr choice
)))
1028 (error "Unknown form for buffer: %s" choice
)))))
1031 (defun msb--add-separators (sorted-list)
1032 (if (or (not msb-separator-diff
)
1033 (not (numberp msb-separator-diff
)))
1035 (let ((last-key nil
))
1040 ((and msb-separator-diff
1042 (> (- (car item
) last-key
)
1043 msb-separator-diff
))
1044 (setq last-key
(car item
))
1045 (list (cons last-key
'separator
)
1048 (setq last-key
(car item
))
1052 (defun msb--split-menus-2 (list mcount result
)
1054 ((> (length list
) msb-max-menu-items
)
1058 (while (< count msb-max-menu-items
)
1059 (push (pop list
) tmp-list
)
1061 (setq tmp-list
(nreverse tmp-list
))
1062 (setq sub-name
(concat (car (car tmp-list
)) "..."))
1063 (push (nconc (list mcount sub-name
1067 (msb--split-menus-2 list
(1+ mcount
) result
))
1072 (setq sub-name
(concat (car (car list
)) "..."))
1073 (push (nconc (list mcount sub-name
'keymap sub-name
)
1076 (nreverse result
))))
1078 (defun msb--split-menus (list)
1079 (if (and (integerp msb-max-menu-items
)
1080 (> msb-max-menu-items
0))
1081 (msb--split-menus-2 list
0 nil
)
1084 (defun msb--make-keymap-menu (raw-menu)
1085 (let ((end (cons '(nil) 'menu-bar-select-buffer
))
1090 ((eq 'separator sub-menu
)
1091 (list 'separator
"--"))
1093 (let ((buffers (mapcar (lambda (item)
1094 (cons (buffer-name (cdr item
))
1095 (cons (car item
) end
)))
1097 (nconc (list (incf mcount
) (car sub-menu
)
1098 'keymap
(car sub-menu
))
1099 (msb--split-menus buffers
))))))
1102 (defun msb-menu-bar-update-buffers (&optional arg
)
1103 "A re-written version of `menu-bar-update-buffers'."
1104 ;; If user discards the Buffers item, play along.
1105 (when (and (lookup-key (current-global-map) [menu-bar buffer
])
1106 (or (not (fboundp 'frame-or-buffer-changed-p
))
1107 (frame-or-buffer-changed-p)
1109 (let ((frames (frame-list))
1110 buffers-menu frames-menu
)
1111 ;; Make the menu of buffers proper.
1112 (setq msb--last-buffer-menu
(msb--create-buffer-menu))
1113 (setq buffers-menu msb--last-buffer-menu
)
1114 ;; Make a Frames menu if we have more than one frame.
1116 (let* ((frame-length (length frames
))
1117 (f-title (format "Frames (%d)" frame-length
)))
1118 ;; List only the N most recently selected frames
1119 (when (and (integerp msb-max-menu-items
)
1120 (> msb-max-menu-items
1)
1121 (> frame-length msb-max-menu-items
))
1122 (setcdr (nthcdr msb-max-menu-items frames
) nil
))
1125 (list 'frame f-title
'(nil) 'keymap f-title
)
1131 (frame-parameters frame
)))
1133 'menu-bar-select-frame
))
1135 (define-key (current-global-map) [menu-bar buffer
]
1137 (if (and buffers-menu frames-menu
)
1138 ;; Combine Frame and Buffers menus with separator between
1139 (nconc (list 'keymap
"Buffers and Frames" frames-menu
1140 (and msb-separator-diff
'(separator "--")))
1141 (cddr buffers-menu
))
1142 (or buffers-menu
'undefined
)))))))
1144 ;; Snarf current bindings of `mouse-buffer-menu' (normally
1146 (defvar msb-mode-map
1147 (let ((map (make-sparse-keymap "Msb")))
1148 (mapcar (lambda (key)
1149 (define-key map key
#'msb
))
1150 (where-is-internal 'mouse-buffer-menu
(make-sparse-keymap)))
1154 (defun msb-mode (&optional arg
)
1156 With arg, turn Msb mode on if and only if arg is positive.
1157 This mode overrides the binding(s) of `mouse-buffer-menu' to provide a
1158 different buffer menu using the function `msb'."
1160 (setq msb-mode
(if arg
1161 (> (prefix-numeric-value arg
) 0)
1165 (add-hook 'menu-bar-update-hook
'msb-menu-bar-update-buffers
)
1166 (remove-hook 'menu-bar-update-hook
'menu-bar-update-buffers
))
1167 (remove-hook 'menu-bar-update-hook
'msb-menu-bar-update-buffers
)
1168 (add-hook 'menu-bar-update-hook
'menu-bar-update-buffers
))
1169 (run-hooks 'menu-bar-update-hook
))
1171 (defun msb-unload-hook ()
1174 (add-to-list 'minor-mode-map-alist
(cons 'msb-mode msb-mode-map
))
1177 (eval-after-load 'msb
(run-hooks 'msb-after-load-hooks
))
1179 ;;; msb.el ends here