1 ;;; msb.el --- Customizable buffer-selection with multiple menus.
2 ;; Copyright (C) 1993, 1994, 1995 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 ;; 1. Byte compile msb first. It uses things in the cl package that
33 ;; are slow if not compiled, but blazingly fast when compiled. I
34 ;; have also had one report that said that msb malfunctioned when
37 ;; Note! You now use msb instead of mouse-buffer-menu.
38 ;; 3. Now try the menu bar Buffers menu.
41 ;; Look at the variable `msb-menu-cond' for deciding what menus you
42 ;; want. It's not that hard to customize, despite my not-so-good
43 ;; doc-string. Feel free to send me a better doc-string.
44 ;; There are some constants for you to try here:
46 ;; msb--very-many-menus (default)
48 ;; Look at the variable `msb-item-handling-function' for customization
49 ;; of the appearance of every menu item. Try for instance setting
50 ;; it to `msb-alon-item-handler'.
52 ;; Look at the variable `msb-item-sort-function' for customization
53 ;; of sorting the menus. Set it to t for instance, which means no
54 ;; sorting - you will get latest used buffer first.
56 ;; Also check out the variable `msb-display-invisible-buffers-p'.
59 ;; - Files-by-directory
60 ;; + No possibility to show client/changed buffers separately.
61 ;; + All file buffers only appear in in a file sub-menu, they will
62 ;; for instance not appear in the Mail sub-menu.
64 ;; Future enhancements:
67 ;; Mark Brader <msb@sq.com>
68 ;; Jim Berry <m1jhb00@FRB.GOV>
69 ;; Hans Chalupsky <hans@cs.Buffalo.EDU>
70 ;; Larry Rosenberg <ljr@ictv.com>
71 ;; Will Henney <will@astroscu.unam.mx>
72 ;; Jari Aalto <jaalto@tre.tele.nokia.fi>
73 ;; Michael Kifer <kifer@sbkifer.cs.sunysb.edu>
74 ;; Gael Marziou <gael@gnlab030.grenoble.hp.com>
75 ;; Dave Gillespie <daveg@thymus.synaptics.com>
76 ;; Alon Albert <alon@milcse.rtsg.mot.com>
77 ;; Kevin Broadey, <KevinB@bartley.demon.co.uk>
78 ;; Ake Stenhof <ake@cadpoint.se>
79 ;; Richard Stallman <rms@gnu.ai.mit.edu>
80 ;; Steve Fisk <fisk@medved.bowdoin.edu>
87 ;;; Some example constants to be used for `msb-menu-cond'. See that
88 ;;; variable for more information. Please note that if the condition
89 ;;; returns `multi', then the buffer can appear in several menus.
91 (defconst msb--few-menus
92 '(((and (boundp 'server-buffer-clients
)
97 ((and msb-display-invisible-buffers-p
98 (msb-invisible-buffer-p)
101 "Invisible buffers (%d)")
102 ((eq major-mode
'dired-mode
)
105 msb-dired-item-handler
106 msb-sort-by-directory
)
107 ((eq major-mode
'Man-mode
)
110 ((eq major-mode
'w3-mode
)
113 ((or (memq major-mode
'(rmail-mode rmail-edit-mode vm-summary-mode vm-mode mail-mode
))
114 (memq major-mode
'(mh-letter-mode
117 (memq major-mode
'(gnus-summary-mode
122 gnus-browse-killed-mode
)))
125 ((not buffer-file-name
)
132 (defconst msb--very-many-menus
133 '(((and (boundp 'server-buffer-clients
)
134 server-buffer-clients
138 ((and (boundp 'vc-mode
) vc-mode
'multi
)
140 "Version Control (%d)")
141 ((and buffer-file-name
145 "Changed files (%d)")
146 ((and (get-buffer-process (current-buffer))
150 ((and msb-display-invisible-buffers-p
151 (msb-invisible-buffer-p)
154 "Invisible buffers (%d)")
155 ((eq major-mode
'dired-mode
)
158 ;; Note this different menu-handler
159 msb-dired-item-handler
160 ;; Also note this item-sorter
161 msb-sort-by-directory
)
162 ((eq major-mode
'Man-mode
)
165 ((eq major-mode
'w3-mode
)
168 ((or (memq major-mode
'(rmail-mode rmail-edit-mode vm-summary-mode vm-mode mail-mode
))
169 (memq major-mode
'(mh-letter-mode
172 (memq major-mode
'(gnus-summary-mode
177 gnus-browse-killed-mode
)))
180 ;; Catchup for all non-file buffers
181 ((and (not buffer-file-name
)
184 "Other non-file buffers (%d)")
185 ((and (string-match "/\\.[^/]*$" buffer-file-name
)
189 ((memq major-mode
'(c-mode c
++-mode
))
192 ((eq major-mode
'emacs-lisp-mode
)
195 ((eq major-mode
'latex-mode
)
200 "Other files (%d)")))
202 ;; msb--many-menus is obsolete
203 (defvar msb--many-menus msb--very-many-menus
)
206 ;;; Customizable variables
209 (defvar msb-separator-diff
100
210 "*Non-nil means use separators.
211 The separators will appear between all menus that have a sorting key that differs by this value or more.")
213 (defvar msb-files-by-directory-sort-key
0
214 "*The sort key for files sorted by directory")
216 (defvar msb-max-menu-items
15
217 "*The maximum number of items in a menu.
218 If this variable is set to 15 for instance, then the submenu will be split up in minor parts, 15 items each.
219 Nil means no limit.")
221 (defvar msb-max-file-menu-items
10
222 "*The maximum number of items from different directories.
224 When the menu is of type `file by directory', this is the maximum
225 number of buffers that are clumped togehter from different
228 Set this to 1 if you want one menu per directory instead of clumping
231 If the value is not a number, then the value 10 is used.")
233 (defvar msb-most-recently-used-sort-key -
1010
234 "*Where should the menu with the most recently used buffers be placed?")
236 (defvar msb-display-most-recently-used
15
237 "*How many buffers should be in the most-recently-used menu.
238 No buffers at all if less than 1 or nil (or any non-number).")
240 (defvar msb-most-recently-used-title
"Most recently used (%d)"
241 "*The title for the most-recently-used menu.")
243 (defvar msb-horizontal-shift-function
'(lambda () 0)
244 "*Function that specifies a number of pixels by which the top menu should
245 be shifted leftwards.")
247 (defvar msb-display-invisible-buffers-p nil
248 "*Show invisible buffers or not.
249 Non-nil means that the buffer menu should include buffers that have
250 names that starts with a space character.")
252 (defvar msb-item-handling-function
'msb-item-handler
253 "*The appearance of a buffer menu.
255 The default function to call for handling the appearance of a menu
256 item. It should take to arguments, BUFFER and MAX-BUFFER-NAME-LENGTH,
257 where the latter is the max length of all buffer names.
259 The function should return the string to use in the menu.
261 When the function is called, BUFFER is the current buffer.
262 This function is called for items in the variable `msb-menu-cond' that
263 have nil as ITEM-HANDLING-FUNCTION. See `msb-menu-cond' for more
266 (defvar msb-item-sort-function
'msb-sort-by-name
267 "*The order of items in a buffer menu.
268 The default function to call for handling the order of items in a menu
269 item. This function is called like a sort function. The items
270 look like (ITEM-NAME . BUFFER).
271 ITEM-NAME is the name of the item that will appear in the menu.
272 BUFFER is the buffer, this is not necessarily the current buffer.
274 Set this to nil or t if you don't want any sorting (faster).")
276 (defvar msb-files-by-directory nil
277 "*Non-nil means that files should be sorted by directory instead of
278 the groups in msb-menu-cond.")
280 (defvar msb-menu-cond msb--very-many-menus
281 "*List of criterias for splitting the mouse buffer menu.
282 The elements in the list should be of this type:
283 (CONDITION MENU-SORT-KEY MENU-TITLE ITEM-HANDLING-FN ITEM-SORT-FN).
285 When making the split, the buffers are tested one by one against the
286 CONDITION, just like a lisp cond: When hitting a true condition, the
287 other criterias are *not* tested and the buffer name will appear in
288 the menu with the menu-title corresponding to the true condition.
290 If the condition returns the symbol `multi', then the buffer will be
291 added to this menu *and* tested for other menus too. If it returns
292 `no-multi', then the buffer will only be added if it hasn't been added
295 During this test, the buffer in question is the current buffer, and
296 the test is surrounded by calls to `save-excursion' and
299 The categories are sorted by MENU-SORT-KEY. Smaller keys are on
300 top. nil means don't display this menu.
302 MENU-TITLE is really a format. If you add %d in it, the %d is replaced
303 with the number of items in that menu.
305 ITEM-HANDLING-FN, is optional. If it is supplied and is a
306 function, than it is used for displaying the items in that particular
307 buffer menu, otherwise the function pointed out by
308 `msb-item-handling-function' is used.
310 ITEM-SORT-FN, is also optional.
311 If it is not supplied, the function pointed out by
312 `msb-item-sort-function' is used.
313 If it is nil, then no sort takes place and the buffers are presented
314 in least-recently-used order.
315 If it is t, then no sort takes place and the buffers are presented in
316 most-recently-used order.
317 If it is supplied and non-nil and not t than it is used for sorting
318 the items in that particular buffer menu.
320 Note1: There should always be a `catch-all' as last element,
321 in this list. That is an element like (t TITLE ITEM-HANDLING-FUNCTION).
322 Note2: A buffer menu appears only if it has at least one buffer in it.
323 Note3: If you have a CONDITION that can't be evaluated you will get an
324 error every time you do \\[msb].")
326 (defvar msb-after-load-hooks nil
327 "Hooks to be run after the msb package has been loaded.")
330 ;;; Internal variables
333 ;; The last calculated menu.
334 (defvar msb--last-buffer-menu nil
)
336 ;; If this is non-nil, then it is a string that describes the error.
337 (defvar msb--error nil
)
340 ;;; Some example function to be used for `msb-item-handling-function'.
342 (defun msb-item-handler (buffer &optional maxbuf
)
343 "Create one string item, concerning BUFFER, for the buffer menu.
346 The `*' appears only if the buffer is marked as modified.
347 The `%' appears only if the buffer is read-only.
348 Optional second argument MAXBUF is completely ignored."
349 (let ((name (buffer-name))
350 (modified (if (buffer-modified-p) "*" " "))
351 (read-only (if buffer-read-only
"%" " ")))
352 (format "%s%s %s" modified read-only name
)))
355 (eval-when-compile (require 'dired
))
357 ;; `dired' can be called with a list of the form (directory file1 file2 ...)
358 ;; which causes `dired-directory' to be in the same form.
359 (defun msb--dired-directory ()
360 (cond ((stringp dired-directory
)
361 (abbreviate-file-name (expand-file-name dired-directory
)))
362 ((consp dired-directory
)
363 (abbreviate-file-name (expand-file-name (car dired-directory
))))
365 (error "Unknown type of `dired-directory' in buffer %s"
368 (defun msb-dired-item-handler (buffer &optional maxbuf
)
369 "Create one string item, concerning a dired BUFFER, for the buffer menu.
372 The `*' appears only if the buffer is marked as modified.
373 The `%' appears only if the buffer is read-only.
374 Optional second argument MAXBUF is completely ignored."
375 (let ((name (msb--dired-directory))
376 (modified (if (buffer-modified-p) "*" " "))
377 (read-only (if buffer-read-only
"%" " ")))
378 (format "%s%s %s" modified read-only name
)))
380 (defun msb-alon-item-handler (buffer maxbuf
)
381 "Create one string item for the buffer menu.
383 <buffer-name> *%# <file-name>
384 The `*' appears only if the buffer is marked as modified.
385 The `%' appears only if the buffer is read-only.
386 The `#' appears only version control file (SCCS/RCS)."
387 (format (format "%%%ds %%s%%s%%s %%s" maxbuf
)
389 (if (buffer-modified-p) "*" " ")
390 (if buffer-read-only
"%" " ")
391 (if (and (boundp 'vc-mode
) vc-mode
) "#" " ")
392 (or buffer-file-name
"")))
395 ;;; Some example function to be used for `msb-item-sort-function'.
397 (defun msb-sort-by-name (item1 item2
)
398 "Sorts the items depending on their buffer-name
399 An item look like (NAME . BUFFER)."
400 (string-lessp (buffer-name (cdr item1
))
401 (buffer-name (cdr item2
))))
404 (defun msb-sort-by-directory (item1 item2
)
405 "Sorts the items depending on their directory. Made for dired.
406 An item look like (NAME . BUFFER)."
407 (string-lessp (save-excursion (set-buffer (cdr item1
)) (msb--dired-directory))
408 (save-excursion (set-buffer (cdr item2
)) (msb--dired-directory))))
413 ;;; This function can be used instead of (mouse-buffer-menu EVENT)
414 ;;; function in "mouse.el".
417 "Pop up several menus of buffers for selection with the mouse.
418 This command switches buffers in the window that you clicked on, and
421 See the function `mouse-select-buffer' and the variable
422 `msb-menu-cond' for more information about how the menus are split."
424 (let ((old-window (selected-window))
425 (window (posn-window (event-start event
))))
426 (unless (framep window
) (select-window window
))
427 (let ((buffer (mouse-select-buffer event
)))
429 (switch-to-buffer buffer
)
430 (select-window old-window
))))
434 ;;; Some supportive functions
436 (defun msb-invisible-buffer-p (&optional buffer
)
437 "Return t if optional BUFFER is an \"invisible\" buffer.
438 If the argument is left out or nil, then the current buffer is considered."
439 (and (> (length (buffer-name buffer
)) 0)
440 (eq ?\
(aref (buffer-name buffer
) 0))))
442 ;; Strip one hierarcy level from the end of PATH.
443 (defun msb--strip-path (path)
445 (if (string-match "\\(.+\\)/[^/]+$" path
)
446 (substring path
(match-beginning 1) (match-end 1))
449 ;; Create an alist with all buffers from LIST that lies under the same
450 ;; directory will be in the same item as the directory string as
451 ;; ((PATH1 . (BUFFER-1 BUFFER-2 ...)) (PATH2 . (BUFFER-K BUFFER-K+1...)) ...)
452 (defun msb--init-file-alist (list)
457 (let ((file-name (buffer-file-name buffer
)))
459 (list (cons (msb--strip-path file-name
) buffer
))))))
461 (function (lambda (item1 item2
)
462 (string< (car item1
) (car item2
)))))))
463 ;; Make alist that looks like
464 ;; ((PATH1 . (BUFFER-1 BUFFER-2 ...)) (PATH2 . (BUFFER-K)) ...)
473 (string= path
(car item
)))
474 (push (cdr item
) buffers
)
478 (setq result
(cons path buffers
)))
479 (setq path
(car item
))
480 (setq buffers
(list (cdr item
)))
481 (and result
(list result
))))))
483 (list (cons path buffers
))))))
485 ;; Choose file-menu with respect to directory for every buffer in LIST.
486 (defun msb--choose-file-menu (list)
487 (let ((buffer-alist (msb--init-file-alist list
))
489 (max-clumped-together (if (numberp msb-max-file-menu-items
)
490 msb-max-file-menu-items
494 first rest path buffers
)
495 (setq first
(car buffer-alist
))
496 (setq rest
(cdr buffer-alist
))
497 (setq path
(car first
))
498 (setq buffers
(cdr first
))
503 (setq item
(car tmp-rest
))
505 (<= (length buffers
) max-clumped-together
)
506 (>= (length (car item
)) (length path
))
507 (string= path
(substring (car item
) 0 (length path
))))
509 (setq buffers
(append buffers
(cdr item
)))
510 (setq tmp-rest
(cdr tmp-rest
))
511 (setq item
(car tmp-rest
)))
513 ((> (length buffers
) max-clumped-together
)
514 (setq last-path
(car first
))
516 (cons (format (if top-found-p
520 (length (cdr first
)))
522 (setq top-found-p nil
)
523 (push first final-list
)
524 (setq first
(car rest
)
526 (setq path
(car first
)
527 buffers
(cdr first
)))
531 (setq first
(cons path buffers
)
533 (setq path
(msb--strip-path path
)
536 (or (and (>= (length path
) (length last-path
))
538 (substring path
0 (length last-path
))))
539 (and (< (length path
) (length last-path
))
541 (substring last-path
0 (length path
))))))
544 (cons (format (if top-found-p
548 (length (cdr first
)))
550 (setq top-found-p nil
)
551 (push first final-list
)
552 (setq first
(car rest
)
554 (setq path
(car first
)
555 buffers
(cdr first
)))))))
557 (cons (format (if top-found-p
561 (length (cdr first
)))
563 (setq top-found-p nil
)
564 (push first final-list
)
565 (nreverse final-list
)))
567 ;; Create a vector as:
568 ;; [BUFFER-LIST-VARIABLE CONDITION MENU-SORT-KEY MENU-TITLE ITEM-HANDLER SORTER)
569 ;; from an element in `msb-menu-cond'. See that variable for a
570 ;; description of its elements.
571 (defun msb--create-function-info (menu-cond-elt)
572 (let* ((list-symbol (make-symbol "-msb-buffer-list"))
573 (tmp-ih (and (> (length menu-cond-elt
) 3)
574 (nth 3 menu-cond-elt
)))
575 (item-handler (if (and tmp-ih
(fboundp tmp-ih
))
577 msb-item-handling-function
))
578 (tmp-s (if (> (length menu-cond-elt
) 4)
579 (nth 4 menu-cond-elt
)
580 msb-item-sort-function
))
581 (sorter (if (or (fboundp tmp-s
)
585 msb-item-sort-function
)))
586 (when (< (length menu-cond-elt
) 3)
587 (error "Wrong format of msb-menu-cond."))
588 (when (and (> (length menu-cond-elt
) 3)
589 (not (fboundp tmp-ih
)))
590 (signal 'invalid-function
(list tmp-ih
)))
591 (when (and (> (length menu-cond-elt
) 4)
593 (not (fboundp tmp-s
))
595 (signal 'invalid-function
(list tmp-s
)))
597 (vector list-symbol
;BUFFER-LIST-VARIABLE
598 (nth 0 menu-cond-elt
) ;CONDITION
599 (nth 1 menu-cond-elt
) ;SORT-KEY
600 (nth 2 menu-cond-elt
) ;MENU-TITLE
601 item-handler
;ITEM-HANDLER
605 ;; This defsubst is only used in `msb--choose-menu' below. It was
606 ;; pulled out merely to make the code somewhat clearer. The indention
607 ;; level was too big.
608 (defsubst msb--collect
(function-info-vector)
612 (setq function-info-list
614 across function-info-vector
616 (eval (aref fi
1))) ;Test CONDITION
617 (not (and (eq result
'no-multi
)
619 (progn (when (eq result
'multi
)
624 (not (eq result
'multi
)))))
625 (when (and (not function-info-list
)
627 (error "No catch-all in msb-menu-cond!"))
630 ;; Adds BUFFER to the menu depicted by FUNCTION-INFO
631 ;; All side-effects. Adds an element of form (BUFFER-TITLE . BUFFER)
632 ;; to the buffer-list variable in function-info.
633 (defun msb--add-to-menu (buffer function-info max-buffer-name-length
)
634 (let ((list-symbol (aref function-info
0))) ;BUFFER-LIST-VARIABLE
635 ;; Here comes the hairy side-effect!
637 (cons (cons (funcall (aref function-info
4) ;ITEM-HANDLER
639 max-buffer-name-length
)
641 (eval list-symbol
)))))
643 ;; Selects the appropriate menu for BUFFER.
644 ;; This is all side-effects, folks!
645 ;; This should be optimized.
646 (defsubst msb--choose-menu
(buffer function-info-vector max-buffer-name-length
)
647 (unless (and (not msb-display-invisible-buffers-p
)
648 (msb-invisible-buffer-p buffer
))
652 ;; Menu found. Add to this menu
654 (lambda (function-info)
655 (msb--add-to-menu buffer function-info max-buffer-name-length
)))
656 (msb--collect function-info-vector
)))
657 (error (unless msb--error
660 "In msb-menu-cond, error for buffer `%s'."
661 (buffer-name buffer
)))
662 (error msb--error
))))))
664 ;; Return (SORT-KEY TITLE . BUFFER-LIST) or nil if the
665 ;; buffer-list is empty.
666 (defun msb--create-sort-item (function-info)
667 (let ((buffer-list (eval (aref function-info
0))))
669 (let ((sorter (aref function-info
5)) ;SORTER
670 (sort-key (aref function-info
2))) ;MENU-SORT-KEY
673 (cons (format (aref function-info
3) ;MENU-TITLE
674 (length buffer-list
))
679 (nreverse buffer-list
))
681 (sort buffer-list sorter
))))))))))
683 ;; Returns a list on the form ((TITLE . BUFFER-LIST)) for
684 ;; the most recently used buffers.
685 (defun msb--most-recently-used-menu (max-buffer-name-length)
686 (when (and (numberp msb-display-most-recently-used
)
687 (> msb-display-most-recently-used
0))
688 (let* ((buffers (cdr (buffer-list)))
691 for buffer in buffers
694 (and (not (msb-invisible-buffer-p))
695 (not (eq major-mode
'dired-mode
))))
696 collect
(save-excursion
698 (cons (funcall msb-item-handling-function
700 max-buffer-name-length
)
703 until
(>= n msb-display-most-recently-used
))))
704 (cons (if (stringp msb-most-recently-used-title
)
705 (format msb-most-recently-used-title
706 (length most-recently-used
))
707 (signal 'wrong-type-argument
(list msb-most-recently-used-title
)))
708 most-recently-used
))))
710 (defun msb--create-buffer-menu-2 ()
711 (let ((max-buffer-name-length 0)
713 function-info-vector
)
714 ;; Calculate the longest buffer name.
718 (if (or msb-display-invisible-buffers-p
719 (not (msb-invisible-buffer-p)))
720 (setq max-buffer-name-length
721 (max max-buffer-name-length
722 (length (buffer-name buffer
)))))))
724 ;; Make a list with elements of type
725 ;; (BUFFER-LIST-VARIABLE
731 ;; Uses "function-global" variables:
732 ;; function-info-vector
733 (setq function-info-vector
734 (apply (function vector
)
735 (mapcar (function msb--create-function-info
)
737 ;; Split the buffer-list into several lists; one list for each
738 ;; criteria. This is the most critical part with respect to time.
739 (mapc (function (lambda (buffer)
740 (cond ((and msb-files-by-directory
741 (buffer-file-name buffer
))
742 (push buffer file-buffers
))
744 (msb--choose-menu buffer
746 max-buffer-name-length
)))))
751 (lambda (buffer-list)
752 (cons msb-files-by-directory-sort-key
753 (cons (car buffer-list
)
757 (cons (save-excursion
759 (funcall msb-item-handling-function
761 max-buffer-name-length
))
765 (lambda (item1 item2
)
766 (string< (car item1
) (car item2
)))))))))
767 (msb--choose-file-menu file-buffers
))))
768 ;; Now make the menu - a list of (TITLE . BUFFER-LIST)
771 (msb--most-recently-used-menu max-buffer-name-length
))
772 (others (append file-buffers
774 across function-info-vector
775 for value
= (msb--create-sort-item elt
)
776 if value collect value
))))
778 (mapcar 'cdr
;Remove the SORT-KEY
779 ;; Sort the menus - not the items.
782 ;; Get a list of (SORT-KEY TITLE . BUFFER-LIST)
783 ;; Also sorts the items within the menus.
784 (if (cdr most-recently-used
)
786 ;; Add most recent used buffers
787 (cons msb-most-recently-used-sort-key
791 (function (lambda (elt1 elt2
)
792 (< (car elt1
) (car elt2
))))))))
793 ;; Now make it a keymap menu
795 '(keymap "Select Buffer")
796 (msb--make-keymap-menu menu
)
797 (when msb-separator-diff
798 (list (list 'separator
"---")))
801 (if msb-files-by-directory
803 "*Files by directory*")
804 'msb--toggle-menu-type
)))))))
806 (defun msb--create-buffer-menu ()
809 (msb--create-buffer-menu-2))))
812 ;;; Multi purpose function for selecting a buffer with the mouse.
814 (defun msb--toggle-menu-type ()
816 (setq msb-files-by-directory
(not msb-files-by-directory
))
817 (menu-bar-update-buffers t
))
819 (defun mouse-select-buffer (event)
820 "Pop up several menus of buffers, for selection with the mouse.
821 Returns the selected buffer or nil if no buffer is selected.
823 The way the buffers are split is conveniently handled with the
824 variable `msb-menu-cond'."
825 ;; Popup the menu and return the selected buffer.
827 (not msb--last-buffer-menu
)
828 (not (fboundp 'frame-or-buffer-changed-p
))
829 (frame-or-buffer-changed-p))
830 (setq msb--error nil
)
831 (setq msb--last-buffer-menu
(msb--create-buffer-menu)))
832 (let ((position event
)
834 (when (and (fboundp 'posn-x-y
)
835 (fboundp 'posn-window
))
836 (let ((posX (car (posn-x-y (event-start event
))))
837 (posY (cdr (posn-x-y (event-start event
))))
838 (posWind (posn-window (event-start event
))))
840 (setq posX
(- posX
(funcall msb-horizontal-shift-function
))
841 position
(list (list posX posY
) posWind
))))
842 ;; This `sit-for' magically makes the menu stay up if the mouse
843 ;; button is released withing 0.1 second.
846 (setq choice
(x-popup-menu position msb--last-buffer-menu
))
848 ((eq (car choice
) 'toggle
)
849 ;; Bring up the menu again with type toggled.
850 (msb--toggle-menu-type)
851 (mouse-select-buffer event
))
852 ((and (numberp (car choice
))
854 (let ((msb--last-buffer-menu (nthcdr 3 (assq (car choice
) msb--last-buffer-menu
))))
855 (mouse-select-buffer event
)))
856 ((while (numberp (car choice
))
857 (setq choice
(cdr choice
))))
858 ((and (stringp (car choice
))
864 (error "Unknown form for buffer: %s" choice
)))))
867 (defun msb--add-separators (sorted-list)
869 ((or (not msb-separator-diff
)
870 (not (numberp msb-separator-diff
)))
873 (let ((last-key nil
))
878 ((and msb-separator-diff
880 (> (- (car item
) last-key
)
882 (setq last-key
(car item
))
883 (list (cons last-key
'separator
)
886 (setq last-key
(car item
))
890 (defun msb--split-menus-2 (list mcount result
)
892 ((> (length list
) msb-max-menu-items
)
896 (while (< count msb-max-menu-items
)
897 (push (pop list
) tmp-list
)
899 (setq tmp-list
(nreverse tmp-list
))
900 (setq sub-name
(concat (car (car tmp-list
)) "..."))
901 (push (append (list mcount sub-name
905 (msb--split-menus-2 list
(1+ mcount
) result
))
910 (setq sub-name
(concat (car (car list
)) "..."))
911 (push (append (list mcount sub-name
917 (defun msb--split-menus (list)
918 (msb--split-menus-2 list
0 nil
))
921 (defun msb--make-keymap-menu (raw-menu)
922 (let ((end (cons '(nil) 'menu-bar-select-buffer
))
928 ((eq 'separator sub-menu
)
929 (list 'separator
"---"))
931 (let ((buffers (mapcar (function
933 (let ((string (car item
))
935 (cons (buffer-name buffer
)
936 (cons string end
)))))
938 (append (list (incf mcount
) (car sub-menu
)
939 'keymap
(car sub-menu
))
940 (msb--split-menus buffers
)))))))
943 (defun menu-bar-update-buffers (&optional arg
)
944 ;; If user discards the Buffers item, play along.
945 (when (and (lookup-key (current-global-map) [menu-bar buffer
])
946 (or (not (fboundp 'frame-or-buffer-changed-p
))
947 (frame-or-buffer-changed-p)
949 (let ((frames (frame-list))
950 buffers-menu frames-menu
)
951 ;; Make the menu of buffers proper.
952 (setq msb--last-buffer-menu
(msb--create-buffer-menu))
953 (setq buffers-menu msb--last-buffer-menu
)
954 ;; Make a Frames menu if we have more than one frame.
956 (let* ((frame-length (length frames
))
957 (f-title (format "Frames (%d)" frame-length
)))
958 ;; List only the N most recently selected frames
959 (when (and (integerp msb-max-menu-items
)
960 (> msb-max-menu-items
1)
961 (> frame-length msb-max-menu-items
))
962 (setcdr (nthcdr msb-max-menu-items frames
) nil
))
965 (list 'frame f-title
'(nil) 'keymap f-title
)
972 (frame-parameters frame
)))
974 'menu-bar-select-frame
)))
976 (define-key (current-global-map) [menu-bar buffer
]
978 (if (and buffers-menu frames-menu
)
979 ;; Combine Frame and Buffers menus with separator between
980 (nconc (list 'keymap
"Buffers and Frames" frames-menu
981 (and msb-separator-diff
'(separator "---")))
983 (or buffers-menu
'undefined
)))))))
985 (when (and (boundp 'menu-bar-update-hook
)
986 (not (fboundp 'frame-or-buffer-changed-p
)))
987 (defvar msb--buffer-count
0)
988 (defun frame-or-buffer-changed-p ()
989 (let ((count (length (buffer-list))))
990 (when (/= count msb--buffer-count
)
991 (setq msb--buffer-count count
)
994 (unless (or (not (boundp 'menu-bar-update-hook
))
995 (memq 'menu-bar-update-buffers menu-bar-update-hook
))
996 (add-hook 'menu-bar-update-hook
'menu-bar-update-buffers
))
998 (and (fboundp 'mouse-buffer-menu
)
999 (substitute-key-definition 'mouse-buffer-menu
'msb
(current-global-map)))
1002 (eval-after-load 'msb
(run-hooks 'msb-after-load-hooks
))
1003 ;;; msb.el ends here