1 ;;; msb.el --- Customizable buffer-selection with multiple menus.
2 ;; Copyright (C) 1993, 1994 Lars Lindberg <Lars.Lindberg@sypro.cap.se>
4 ;; Author: Lars Lindberg <Lars.Lindberg@sypro.cap.se>
6 ;; Lindberg's last update version: 3.31
7 ;; Keywords: mouse buffer menu
9 ;; This program is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2 of the License, or
12 ;; (at your option) any later version.
14 ;; This program is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with this program; if not, write to the Free Software
21 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
25 ;; Purpose of this package:
26 ;; 1. Offer a function for letting the user choose buffer,
27 ;; not necessarily for switching to it.
28 ;; 2. Make a better mouse-buffer-menu.
32 ;; Note! You now use msb instead of mouse-buffer-menu.
34 ;; Now try the menu bar Buffers menu.
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 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.ai.mit.edu>
76 ;; Steve Fisk <fisk@medved.bowdoin.edu>
83 ;;; Some example constants to be used for `msb-menu-cond'. See that
84 ;;; variable for more information. Please note that if the condition
85 ;;; returns `multi', then the buffer can appear in several menus.
87 (defconst msb--few-menus
88 '(((and (boundp 'server-buffer-clients
)
93 ((and msb-display-invisible-buffers-p
94 (msb-invisible-buffer-p)
97 "Invisible buffers (%d)")
98 ((eq major-mode
'dired-mode
)
101 msb-dired-item-handler
102 msb-sort-by-directory
)
103 ((eq major-mode
'Man-mode
)
106 ((eq major-mode
'w3-mode
)
109 ((or (memq major-mode
'(rmail-mode rmail-edit-mode vm-summary-mode vm-mode mail-mode
))
110 (memq major-mode
'(mh-letter-mode
113 (memq major-mode
'(gnus-summary-mode
118 gnus-browse-killed-mode
)))
121 ((not buffer-file-name
)
128 (defconst msb--very-many-menus
129 '(((and (boundp 'server-buffer-clients
)
130 server-buffer-clients
134 ((and (boundp 'vc-mode
) vc-mode
'multi
)
136 "Version Control (%d)")
137 ((and buffer-file-name
141 "Changed files (%d)")
142 ((and (get-buffer-process (current-buffer))
146 ((and msb-display-invisible-buffers-p
147 (msb-invisible-buffer-p)
150 "Invisible buffers (%d)")
151 ((eq major-mode
'dired-mode
)
154 ;; Note this different menu-handler
155 msb-dired-item-handler
156 ;; Also note this item-sorter
157 msb-sort-by-directory
)
158 ((eq major-mode
'Man-mode
)
161 ((eq major-mode
'w3-mode
)
164 ((or (memq major-mode
'(rmail-mode rmail-edit-mode vm-summary-mode vm-mode mail-mode
))
165 (memq major-mode
'(mh-letter-mode
168 (memq major-mode
'(gnus-summary-mode
173 gnus-browse-killed-mode
)))
176 ;; Catchup for all non-file buffers
177 ((and (not buffer-file-name
)
180 "Other non-file buffers (%d)")
181 ((and (string-match "/\\.[^/]*$" buffer-file-name
)
185 ((memq major-mode
'(c-mode c
++-mode
))
188 ((eq major-mode
'emacs-lisp-mode
)
191 ((eq major-mode
'latex-mode
)
196 "Other files (%d)")))
198 ;; msb--many-menus is obsolete
199 (defvar msb--many-menus msb--very-many-menus
)
202 ;;; Customizable variables
205 (defvar msb-separator-diff
100
206 "*Non-nil means use separators.
207 The separators will appear between all menus that have a sorting key that differs by this value or more.")
209 (defvar msb-files-by-directory-sort-key
0
210 "*The sort key for files sorted by directory")
212 (defvar msb-max-menu-items
15
213 "*The maximum number of items in a menu.
214 If this variable is set to 15 for instance, then the submenu will be split up in minor parts, 15 items each.
215 Nil means no limit.")
217 (defvar msb-max-file-menu-items
10
218 "*The maximum number of items from different directories.
220 When the menu is of type `file by directory', this is the maximum
221 number of buffers that are clumped togehter from different
224 Set this to 1 if you want one menu per directory instead of clumping
227 If the value is not a number, then the value 10 is used.")
229 (defvar msb-most-recently-used-sort-key -
1010
230 "*Where should the menu with the most recently used buffers be placed?")
232 (defvar msb-display-most-recently-used
15
233 "*How many buffers should be in the most-recently-used menu.
234 No buffers at all if less than 1 or nil (or any non-number).")
236 (defvar msb-most-recently-used-title
"Most recently used (%d)"
237 "*The title for the most-recently-used menu.")
239 (defvar msb-horizontal-shift-function
'(lambda () 0)
240 "*Function that specifies a number of pixels by which the top menu should
241 be shifted leftwards.")
243 (defvar msb-display-invisible-buffers-p nil
244 "*Show invisible buffers or not.
245 Non-nil means that the buffer menu should include buffers that have
246 names that starts with a space character.")
248 (defvar msb-item-handling-function
'msb-item-handler
249 "*The appearance of a buffer menu.
251 The default function to call for handling the appearance of a menu
252 item. It should take to arguments, BUFFER and MAX-BUFFER-NAME-LENGTH,
253 where the latter is the max length of all buffer names.
255 The function should return the string to use in the menu.
257 When the function is called, BUFFER is the current buffer.
258 This function is called for items in the variable `msb-menu-cond' that
259 have nil as ITEM-HANDLING-FUNCTION. See `msb-menu-cond' for more
262 (defvar msb-item-sort-function
'msb-sort-by-name
263 "*The order of items in a buffer menu.
264 The default function to call for handling the order of items in a menu
265 item. This function is called like a sort function. The items
266 look like (ITEM-NAME . BUFFER).
267 ITEM-NAME is the name of the item that will appear in the menu.
268 BUFFER is the buffer, this is not necessarily the current buffer.
270 Set this to nil or t if you don't want any sorting (faster).")
272 (defvar msb-files-by-directory nil
273 "*Non-nil means that files should be sorted by directory instead of
274 the groups in msb-menu-cond.")
276 (defvar msb-menu-cond msb--very-many-menus
277 "*List of criterias for splitting the mouse buffer menu.
278 The elements in the list should be of this type:
279 (CONDITION MENU-SORT-KEY MENU-TITLE ITEM-HANDLING-FN ITEM-SORT-FN).
281 When making the split, the buffers are tested one by one against the
282 CONDITION, just like a lisp cond: When hitting a true condition, the
283 other criterias are *not* tested and the buffer name will appear in
284 the menu with the menu-title corresponding to the true condition.
286 If the condition returns the symbol `multi', then the buffer will be
287 added to this menu *and* tested for other menus too. If it returns
288 `no-multi', then the buffer will only be added if it hasn't been added
291 During this test, the buffer in question is the current buffer, and
292 the test is surrounded by calls to `save-excursion' and
295 The categories are sorted by MENU-SORT-KEY. Smaller keys are on
296 top. nil means don't display this menu.
298 MENU-TITLE is really a format. If you add %d in it, the %d is replaced
299 with the number of items in that menu.
301 ITEM-HANDLING-FN, is optional. If it is supplied and is a
302 function, than it is used for displaying the items in that particular
303 buffer menu, otherwise the function pointed out by
304 `msb-item-handling-function' is used.
306 ITEM-SORT-FN, is also optional.
307 If it is not supplied, the function pointed out by
308 `msb-item-sort-function' is used.
309 If it is nil, then no sort takes place and the buffers are presented
310 in least-recently-used order.
311 If it is t, then no sort takes place and the buffers are presented in
312 most-recently-used order.
313 If it is supplied and non-nil and not t than it is used for sorting
314 the items in that particular buffer menu.
316 Note1: There should always be a `catch-all' as last element,
317 in this list. That is an element like (t TITLE ITEM-HANDLING-FUNCTION).
318 Note2: A buffer menu appears only if it has at least one buffer in it.
319 Note3: If you have a CONDITION that can't be evaluated you will get an
320 error every time you do \\[msb].")
322 (defvar msb-after-load-hooks nil
323 "Hooks to be run after the msb package has been loaded.")
326 ;;; Internal variables
329 ;; The last calculated menu.
330 (defvar msb--last-buffer-menu nil
)
332 ;; If this is non-nil, then it is a string that describes the error.
333 (defvar msb--error nil
)
336 ;;; Some example function to be used for `msb-item-handling-function'.
338 (defun msb-item-handler (buffer &optional maxbuf
)
339 "Create one string item, concerning BUFFER, for the buffer menu.
342 The `*' appears only if the buffer is marked as modified.
343 The `%' appears only if the buffer is read-only.
344 Optional second argument MAXBUF is completely ignored."
345 (let ((name (buffer-name))
346 (modified (if (buffer-modified-p) "*" " "))
347 (read-only (if buffer-read-only
"%" " ")))
348 (format "%s%s %s" modified read-only name
)))
351 (eval-when-compile (require 'dired
))
353 ;; `dired' can be called with a list of the form (directory file1 file2 ...)
354 ;; which causes `dired-directory' to be in the same form.
355 (defun msb--dired-directory ()
356 (cond ((stringp dired-directory
)
357 (abbreviate-file-name (expand-file-name dired-directory
)))
358 ((consp dired-directory
)
359 (abbreviate-file-name (expand-file-name (car dired-directory
))))
361 (error "Unknown type of `dired-directory' in buffer %s"
364 (defun msb-dired-item-handler (buffer &optional maxbuf
)
365 "Create one string item, concerning a dired BUFFER, for the buffer menu.
368 The `*' appears only if the buffer is marked as modified.
369 The `%' appears only if the buffer is read-only.
370 Optional second argument MAXBUF is completely ignored."
371 (let ((name (msb--dired-directory))
372 (modified (if (buffer-modified-p) "*" " "))
373 (read-only (if buffer-read-only
"%" " ")))
374 (format "%s%s %s" modified read-only name
)))
376 (defun msb-alon-item-handler (buffer maxbuf
)
377 "Create one string item for the buffer menu.
379 <buffer-name> *%# <file-name>
380 The `*' appears only if the buffer is marked as modified.
381 The `%' appears only if the buffer is read-only.
382 The `#' appears only version control file (SCCS/RCS)."
383 (format (format "%%%ds %%s%%s%%s %%s" maxbuf
)
385 (if (buffer-modified-p) "*" " ")
386 (if buffer-read-only
"%" " ")
387 (if (and (boundp 'vc-mode
) vc-mode
) "#" " ")
388 (or buffer-file-name
"")))
391 ;;; Some example function to be used for `msb-item-sort-function'.
393 (defun msb-sort-by-name (item1 item2
)
394 "Sorts the items depending on their buffer-name
395 An item look like (NAME . BUFFER)."
396 (string-lessp (buffer-name (cdr item1
))
397 (buffer-name (cdr item2
))))
400 (defun msb-sort-by-directory (item1 item2
)
401 "Sorts the items depending on their directory. Made for dired.
402 An item look like (NAME . BUFFER)."
403 (string-lessp (save-excursion (set-buffer (cdr item1
)) (msb--dired-directory))
404 (save-excursion (set-buffer (cdr item2
)) (msb--dired-directory))))
409 ;;; This function can be used instead of (mouse-buffer-menu EVENT)
410 ;;; function in "mouse.el".
413 "Pop up several menus of buffers for selection with the mouse.
414 This command switches buffers in the window that you clicked on, and
417 See the function `mouse-select-buffer' and the variable
418 `msb-menu-cond' for more information about how the menus are split."
420 (let ((old-window (selected-window))
421 (window (posn-window (event-start event
))))
422 (unless (framep window
) (select-window window
))
423 (let ((buffer (mouse-select-buffer event
)))
425 (switch-to-buffer buffer
)
426 (select-window old-window
))))
430 ;;; Some supportive functions
432 (defun msb-invisible-buffer-p (&optional buffer
)
433 "Return t if optional BUFFER is an \"invisible\" buffer.
434 If the argument is left out or nil, then the current buffer is considered."
435 (and (> (length (buffer-name buffer
)) 0)
436 (eq ?\
(aref (buffer-name buffer
) 0))))
438 ;; Strip one hierarcy level from the end of PATH.
439 (defun msb--strip-path (path)
441 (if (string-match "\\(.+\\)/[^/]+$" path
)
442 (substring path
(match-beginning 1) (match-end 1))
445 ;; Create an alist with all buffers from LIST that lies under the same
446 ;; directory will be in the same item as the directory string as
447 ;; ((PATH1 . (BUFFER-1 BUFFER-2 ...)) (PATH2 . (BUFFER-K BUFFER-K+1...)) ...)
448 (defun msb--init-file-alist (list)
453 (let ((file-name (buffer-file-name buffer
)))
455 (list (cons (msb--strip-path file-name
) buffer
))))))
457 (function (lambda (item1 item2
)
458 (string< (car item1
) (car item2
)))))))
459 ;; Make alist that looks like
460 ;; ((PATH1 . (BUFFER-1 BUFFER-2 ...)) (PATH2 . (BUFFER-K)) ...)
469 (string= path
(car item
)))
470 (push (cdr item
) buffers
)
474 (setq result
(cons path buffers
)))
475 (setq path
(car item
))
476 (setq buffers
(list (cdr item
)))
477 (and result
(list result
))))))
479 (list (cons path buffers
))))))
481 ;; Choose file-menu with respect to directory for every buffer in LIST.
482 (defun msb--choose-file-menu (list)
483 (let ((buffer-alist (msb--init-file-alist list
))
485 (max-clumped-together (if (numberp msb-max-file-menu-items
)
486 msb-max-file-menu-items
490 first rest path buffers
)
491 (setq first
(car buffer-alist
))
492 (setq rest
(cdr buffer-alist
))
493 (setq path
(car first
))
494 (setq buffers
(cdr first
))
499 (setq item
(car tmp-rest
))
501 (<= (length buffers
) max-clumped-together
)
502 (>= (length (car item
)) (length path
))
503 (string= path
(substring (car item
) 0 (length path
))))
505 (setq buffers
(append buffers
(cdr item
)))
506 (setq tmp-rest
(cdr tmp-rest
))
507 (setq item
(car tmp-rest
)))
509 ((> (length buffers
) max-clumped-together
)
510 (setq last-path
(car first
))
512 (cons (format (if top-found-p
516 (length (cdr first
)))
518 (setq top-found-p nil
)
519 (push first final-list
)
520 (setq first
(car rest
)
522 (setq path
(car first
)
523 buffers
(cdr first
)))
527 (setq first
(cons path buffers
)
529 (setq path
(msb--strip-path path
)
532 (or (and (>= (length path
) (length last-path
))
534 (substring path
0 (length last-path
))))
535 (and (< (length path
) (length last-path
))
537 (substring last-path
0 (length path
))))))
540 (cons (format (if top-found-p
544 (length (cdr first
)))
546 (setq top-found-p nil
)
547 (push first final-list
)
548 (setq first
(car rest
)
550 (setq path
(car first
)
551 buffers
(cdr first
)))))))
553 (cons (format (if top-found-p
557 (length (cdr first
)))
559 (setq top-found-p nil
)
560 (push first final-list
)
561 (nreverse final-list
)))
563 ;; Create a vector as:
564 ;; [BUFFER-LIST-VARIABLE CONDITION MENU-SORT-KEY MENU-TITLE ITEM-HANDLER SORTER)
565 ;; from an element in `msb-menu-cond'. See that variable for a
566 ;; description of its elements.
567 (defun msb--create-function-info (menu-cond-elt)
568 (let* ((list-symbol (make-symbol "-msb-buffer-list"))
569 (tmp-ih (and (> (length menu-cond-elt
) 3)
570 (nth 3 menu-cond-elt
)))
571 (item-handler (if (and tmp-ih
(fboundp tmp-ih
))
573 msb-item-handling-function
))
574 (tmp-s (if (> (length menu-cond-elt
) 4)
575 (nth 4 menu-cond-elt
)
576 msb-item-sort-function
))
577 (sorter (if (or (fboundp tmp-s
)
581 msb-item-sort-function
)))
582 (when (< (length menu-cond-elt
) 3)
583 (error "Wrong format of msb-menu-cond."))
584 (when (and (> (length menu-cond-elt
) 3)
585 (not (fboundp tmp-ih
)))
586 (signal 'invalid-function
(list tmp-ih
)))
587 (when (and (> (length menu-cond-elt
) 4)
589 (not (fboundp tmp-s
))
591 (signal 'invalid-function
(list tmp-s
)))
593 (vector list-symbol
;BUFFER-LIST-VARIABLE
594 (nth 0 menu-cond-elt
) ;CONDITION
595 (nth 1 menu-cond-elt
) ;SORT-KEY
596 (nth 2 menu-cond-elt
) ;MENU-TITLE
597 item-handler
;ITEM-HANDLER
601 ;; This defsubst is only used in `msb--choose-menu' below. It was
602 ;; pulled out merely to make the code somewhat clearer. The indention
603 ;; level was too big.
604 (defsubst msb--collect
(function-info-vector)
608 (setq function-info-list
610 across function-info-vector
612 (eval (aref fi
1))) ;Test CONDITION
613 (not (and (eq result
'no-multi
)
615 (progn (when (eq result
'multi
)
620 (not (eq result
'multi
)))))
621 (when (and (not function-info-list
)
623 (error "No catch-all in msb-menu-cond!"))
626 ;; Adds BUFFER to the menu depicted by FUNCTION-INFO
627 ;; All side-effects. Adds an element of form (BUFFER-TITLE . BUFFER)
628 ;; to the buffer-list variable in function-info.
629 (defun msb--add-to-menu (buffer function-info max-buffer-name-length
)
630 (let ((list-symbol (aref function-info
0))) ;BUFFER-LIST-VARIABLE
631 ;; Here comes the hairy side-effect!
633 (cons (cons (funcall (aref function-info
4) ;ITEM-HANDLER
635 max-buffer-name-length
)
637 (eval list-symbol
)))))
639 ;; Selects the appropriate menu for BUFFER.
640 ;; This is all side-effects, folks!
641 ;; This should be optimized.
642 (defsubst msb--choose-menu
(buffer function-info-vector max-buffer-name-length
)
643 (unless (and (not msb-display-invisible-buffers-p
)
644 (msb-invisible-buffer-p buffer
))
648 ;; Menu found. Add to this menu
650 (lambda (function-info)
651 (msb--add-to-menu buffer function-info max-buffer-name-length
)))
652 (msb--collect function-info-vector
)))
653 (error (unless msb--error
656 "In msb-menu-cond, error for buffer `%s'."
657 (buffer-name buffer
)))
658 (error msb--error
))))))
660 ;; Return (SORT-KEY TITLE . BUFFER-LIST) or nil if the
661 ;; buffer-list is empty.
662 (defun msb--create-sort-item (function-info)
663 (let ((buffer-list (eval (aref function-info
0))))
665 (let ((sorter (aref function-info
5)) ;SORTER
666 (sort-key (aref function-info
2))) ;MENU-SORT-KEY
669 (cons (format (aref function-info
3) ;MENU-TITLE
670 (length buffer-list
))
675 (nreverse buffer-list
))
677 (sort buffer-list sorter
))))))))))
679 ;; Returns a list on the form ((TITLE . BUFFER-LIST)) for
680 ;; the most recently used buffers.
681 (defun msb--most-recently-used-menu (max-buffer-name-length)
682 (when (and (numberp msb-display-most-recently-used
)
683 (> msb-display-most-recently-used
0))
684 (let* ((buffers (cdr (buffer-list)))
687 for buffer in buffers
690 (and (not (msb-invisible-buffer-p))
691 (not (eq major-mode
'dired-mode
))))
692 collect
(save-excursion
694 (cons (funcall msb-item-handling-function
696 max-buffer-name-length
)
699 until
(>= n msb-display-most-recently-used
))))
700 (cons (if (stringp msb-most-recently-used-title
)
701 (format msb-most-recently-used-title
702 (length most-recently-used
))
703 (signal 'wrong-type-argument
(list msb-most-recently-used-title
)))
704 most-recently-used
))))
706 (defun msb--create-buffer-menu-2 ()
707 (let ((max-buffer-name-length 0)
709 function-info-vector
)
710 ;; Calculate the longest buffer name.
714 (if (or msb-display-invisible-buffers-p
715 (not (msb-invisible-buffer-p)))
716 (setq max-buffer-name-length
717 (max max-buffer-name-length
718 (length (buffer-name buffer
)))))))
720 ;; Make a list with elements of type
721 ;; (BUFFER-LIST-VARIABLE
727 ;; Uses "function-global" variables:
728 ;; function-info-vector
729 (setq function-info-vector
730 (apply (function vector
)
731 (mapcar (function msb--create-function-info
)
733 ;; Split the buffer-list into several lists; one list for each
734 ;; criteria. This is the most critical part with respect to time.
735 (mapc (function (lambda (buffer)
736 (cond ((and msb-files-by-directory
737 (buffer-file-name buffer
))
738 (push buffer file-buffers
))
740 (msb--choose-menu buffer
742 max-buffer-name-length
)))))
747 (lambda (buffer-list)
748 (cons msb-files-by-directory-sort-key
749 (cons (car buffer-list
)
753 (cons (save-excursion
755 (funcall msb-item-handling-function
757 max-buffer-name-length
))
761 (lambda (item1 item2
)
762 (string< (car item1
) (car item2
)))))))))
763 (msb--choose-file-menu file-buffers
))))
764 ;; Now make the menu - a list of (TITLE . BUFFER-LIST)
767 (msb--most-recently-used-menu max-buffer-name-length
))
768 (others (append file-buffers
770 across function-info-vector
771 for value
= (msb--create-sort-item elt
)
772 if value collect value
))))
774 (mapcar 'cdr
;Remove the SORT-KEY
775 ;; Sort the menus - not the items.
778 ;; Get a list of (SORT-KEY TITLE . BUFFER-LIST)
779 ;; Also sorts the items within the menus.
780 (if (cdr most-recently-used
)
782 ;; Add most recent used buffers
783 (cons msb-most-recently-used-sort-key
787 (function (lambda (elt1 elt2
)
788 (< (car elt1
) (car elt2
))))))))
789 ;; Now make it a keymap menu
791 '(keymap "Select Buffer")
792 (msb--make-keymap-menu menu
)
793 (when msb-separator-diff
794 (list (list 'separator
"---")))
797 (if msb-files-by-directory
799 "*Files by directory*")
800 'msb--toggle-menu-type
)))))))
802 (defun msb--create-buffer-menu ()
805 (msb--create-buffer-menu-2))))
808 ;;; Multi purpose function for selecting a buffer with the mouse.
810 (defun msb--toggle-menu-type ()
812 (setq msb-files-by-directory
(not msb-files-by-directory
))
813 (menu-bar-update-buffers t
))
815 (defun mouse-select-buffer (event)
816 "Pop up several menus of buffers, for selection with the mouse.
817 Returns the selected buffer or nil if no buffer is selected.
819 The way the buffers are split is conveniently handled with the
820 variable `msb-menu-cond'."
821 ;; Popup the menu and return the selected buffer.
823 (not msb--last-buffer-menu
)
824 (not (fboundp 'frame-or-buffer-changed-p
))
825 (frame-or-buffer-changed-p))
826 (setq msb--error nil
)
827 (setq msb--last-buffer-menu
(msb--create-buffer-menu)))
828 (let ((position event
)
830 (when (and (fboundp 'posn-x-y
)
831 (fboundp 'posn-window
))
832 (let ((posX (car (posn-x-y (event-start event
))))
833 (posY (cdr (posn-x-y (event-start event
))))
834 (posWind (posn-window (event-start event
))))
836 (setq posX
(- posX
(funcall msb-horizontal-shift-function
))
837 position
(list (list posX posY
) posWind
))))
838 (setq choice
(x-popup-menu position msb--last-buffer-menu
))
840 ((eq (car choice
) 'toggle
)
841 ;; Bring up the menu again with type toggled.
842 (msb--toggle-menu-type)
843 (mouse-select-buffer event
))
844 ((and (numberp (car choice
))
846 (let ((msb--last-buffer-menu (nthcdr 3 (assq (car choice
) msb--last-buffer-menu
))))
847 (mouse-select-buffer event
)))
848 ((while (numberp (car choice
))
849 (setq choice
(cdr choice
))))
850 ((and (stringp (car choice
))
856 (error "Unknown form for buffer: %s" choice
)))))
859 (defun msb--add-separators (sorted-list)
861 ((or (not msb-separator-diff
)
862 (not (numberp msb-separator-diff
)))
865 (let ((last-key nil
))
870 ((and msb-separator-diff
872 (> (- (car item
) last-key
)
874 (setq last-key
(car item
))
875 (list (cons last-key
'separator
)
878 (setq last-key
(car item
))
882 (defun msb--split-menus-2 (list mcount result
)
884 ((> (length list
) msb-max-menu-items
)
888 (while (< count msb-max-menu-items
)
889 (push (pop list
) tmp-list
)
891 (setq tmp-list
(nreverse tmp-list
))
892 (setq sub-name
(concat (car (car tmp-list
)) "..."))
893 (push (append (list mcount sub-name
897 (msb--split-menus-2 list
(1+ mcount
) result
))
902 (setq sub-name
(concat (car (car list
)) "..."))
903 (push (append (list mcount sub-name
909 (defun msb--split-menus (list)
910 (msb--split-menus-2 list
0 nil
))
913 (defun msb--make-keymap-menu (raw-menu)
914 (let ((end (cons '(nil) 'menu-bar-select-buffer
))
920 ((eq 'separator sub-menu
)
921 (list 'separator
"---"))
923 (let ((buffers (mapcar (function
925 (let ((string (car item
))
927 (cons (buffer-name buffer
)
928 (cons string end
)))))
930 (append (list (incf mcount
) (car sub-menu
)
931 'keymap
(car sub-menu
))
932 (msb--split-menus buffers
)))))))
935 (defun menu-bar-update-buffers (&optional arg
)
936 ;; If user discards the Buffers item, play along.
937 (when (and (lookup-key (current-global-map) [menu-bar buffer
])
938 (or (not (fboundp 'frame-or-buffer-changed-p
))
939 (frame-or-buffer-changed-p)
941 (let ((frames (frame-list))
942 buffers-menu frames-menu
)
943 ;; Make the menu of buffers proper.
944 (setq msb--last-buffer-menu
(msb--create-buffer-menu))
945 (setq buffers-menu msb--last-buffer-menu
)
946 ;; Make a Frames menu if we have more than one frame.
948 (let* ((frame-length (length frames
))
949 (f-title (format "Frames (%d)" frame-length
)))
950 ;; List only the N most recently selected frames
951 (when (and (integerp msb-max-menu-items
)
952 (> msb-max-menu-items
1)
953 (> frame-length msb-max-menu-items
))
954 (setcdr (nthcdr msb-max-menu-items frames
) nil
))
957 (list 'frame f-title
'(nil) 'keymap f-title
)
964 (frame-parameters frame
)))
966 'menu-bar-select-frame
)))
968 (define-key (current-global-map) [menu-bar buffer
]
970 (if (and buffers-menu frames-menu
)
971 ;; Combine Frame and Buffers menus with separator between
972 (nconc (list 'keymap
"Buffers and Frames" frames-menu
973 (and msb-separator-diff
'(separator "---")))
975 (or buffers-menu
'undefined
)))))))
977 (when (and (boundp 'menu-bar-update-hook
)
978 (not (fboundp 'frame-or-buffer-changed-p
)))
979 (defvar msb--buffer-count
0)
980 (defun frame-or-buffer-changed-p ()
981 (let ((count (length (buffer-list))))
982 (when (/= count msb--buffer-count
)
983 (setq msb--buffer-count count
)
986 (unless (or (not (boundp 'menu-bar-update-hook
))
987 (memq 'menu-bar-update-buffers menu-bar-update-hook
))
988 (add-hook 'menu-bar-update-hook
'menu-bar-update-buffers
))
990 (and (fboundp 'mouse-buffer-menu
)
991 (substitute-key-definition 'mouse-buffer-menu
'msb
(current-global-map)))
994 (eval-after-load 'msb
(run-hooks 'msb-after-load-hooks
))