]> code.delx.au - gnu-emacs/blobdiff - lisp/msb.el
(tar-header-block-tokenize): Decode codes of file
[gnu-emacs] / lisp / msb.el
index 6463db5fbdb838595424d260067e2a388d453a8e..95d0fc1b302052588d63de6a71f646063f8c4711 100644 (file)
@@ -1,37 +1,45 @@
 ;;; msb.el --- Customizable buffer-selection with multiple menus.
-;; Copyright (C) 1993, 1994 Lars Lindberg <Lars.Lindberg@sypro.cap.se>
-;;
-;; Author: Lars Lindberg <Lars.Lindberg@sypro.cap.se>
+
+;; Copyright (C) 1993, 1994, 1995, 1997, 1998 Free Software Foundation, Inc.
+
+;; Author: Lars Lindberg <Lars.G.Lindberg@capgemini.se>
 ;; Created: 8 Oct 1993
-;; Lindberg's last update version: 3.28
-;; Keywords: mouse buffer menu 
-;;
-;; This program is free software; you can redistribute it and/or modify
+;; Lindberg's last update version: 3.34
+;; Keywords: mouse buffer menu
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2 of the License, or
-;; (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
-;;
+
 ;; You should have received a copy of the GNU General Public License
-;; along with this program; if not, write to the Free Software
-;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
 
 ;;; Commentary:
-;;
+
 ;; Purpose of this package:
 ;;   1. Offer a function for letting the user choose buffer,
 ;;      not necessarily for switching to it.
 ;;   2. Make a better mouse-buffer-menu.
 ;;
 ;; Installation:
-;;   (require 'msb)
-;;   Note! You now use msb instead of mouse-buffer-menu.
-;;
-;;   Now try the menu bar Buffers menu.
+
+;;   1. Byte compile msb first.  It uses things in the cl package that
+;;      are slow if not compiled, but blazingly fast when compiled.  I
+;;      have also had one report that said that msb malfunctioned when
+;;      not compiled.
+;;   2. (require 'msb)
+;;      Note! You now use msb instead of mouse-buffer-menu.
+;;   3. Now try the menu bar Buffers menu.
 ;;
 ;; Customization:
 ;;   Look at the variable `msb-menu-cond' for deciding what menus you
@@ -44,7 +52,7 @@
 ;;   Look at the variable `msb-item-handling-function' for customization
 ;;   of the appearance of every menu item.  Try for instance setting
 ;;   it to `msb-alon-item-handler'.
-;;   
+;;  
 ;;   Look at the variable `msb-item-sort-function' for customization
 ;;   of sorting the menus.  Set it to t for instance, which means no
 ;;   sorting - you will get latest used buffer first.
 
 ;; Known bugs:
 ;; - Files-by-directory
-;;   + No possibility to show client/changed buffers separately
+;;   + No possibility to show client/changed buffers separately.
+;;   + All file buffers only appear in a file sub-menu, they will
+;;     for instance not appear in the Mail sub-menu.
+
 ;; Future enhancements:
-;; - [Mattes] had a suggestion about sorting files by extension.
-;;   I (Lars Lindberg) think this case could be solved if msb.el was
-;;   rewritten to handle more dynamic splitting.  It's now completely
-;;   static, depending on the menu-cond.  If the splitting could also
-;;   be done by a user-defined function a lot of cases would be
-;;   solved.
-;; - [Jim] suggested that the Frame menu became a part of the buffer menu.
 
 ;;; Thanks goes to
-;;  [msb] - Mark Brader <msb@sq.com>
-;;  [Chalupsky] - Hans Chalupsky <hans@cs.Buffalo.EDU>
-;;  [jim] - Jim Berry <m1jhb00@FRB.GOV>
-;;  [larry] - Larry Rosenberg <ljr@ictv.com>
-;;  [will] - Will Henney <will@astroscu.unam.mx>
-;;  [jaalto] - Jari Aalto <jaalto@tre.tele.nokia.fi>
-;;  [kifer] - Michael Kifer <kifer@sbkifer.cs.sunysb.edu>
-;;  [Gael] - Gael Marziou <gael@gnlab030.grenoble.hp.com>
-;;  [Gillespie] - Dave Gillespie <daveg@thymus.synaptics.com>
-;;  [Alon] - Alon Albert <alon@milcse.rtsg.mot.com>
-;;  [KevinB] - Kevin Broadey, <KevinB@bartley.demon.co.uk>
-;;  [Ake] - Ake Stenhof <ake@cadpoint.se>
-;;  [RMS] - Richard Stallman <rms@gnu.ai.mit.edu>
-;;  [Fisk] - Steve Fisk <fisk@medved.bowdoin.edu>
+;;  Mark Brader <msb@sq.com>
+;;  Jim Berry <m1jhb00@FRB.GOV>
+;;  Hans Chalupsky <hans@cs.Buffalo.EDU>
+;;  Larry Rosenberg <ljr@ictv.com>
+;;  Will Henney <will@astroscu.unam.mx>
+;;  Jari Aalto <jaalto@tre.tele.nokia.fi>
+;;  Michael Kifer <kifer@sbkifer.cs.sunysb.edu>
+;;  Gael Marziou <gael@gnlab030.grenoble.hp.com>
+;;  Dave Gillespie <daveg@thymus.synaptics.com>
+;;  Alon Albert <alon@milcse.rtsg.mot.com>
+;;  Kevin Broadey, <KevinB@bartley.demon.co.uk>
+;;  Ake Stenhof <ake@cadpoint.se>
+;;  Richard Stallman <rms@gnu.ai.mit.edu>
+;;  Steve Fisk <fisk@medved.bowdoin.edu>
 
 ;;; Code:
 
     ((eq major-mode 'w3-mode)
      4020
      "WWW (%d)")
-    ((or (memq major-mode '(rmail-mode vm-summary-mode vm-mode mail-mode))
+    ((or (memq major-mode '(rmail-mode rmail-edit-mode vm-summary-mode vm-mode mail-mode))
         (memq major-mode '(mh-letter-mode
                            mh-show-mode
-                           mh-folder-mode))     
+                           mh-folder-mode))    
         (memq major-mode '(gnus-summary-mode
                            news-reply-mode
                            gnus-group-mode
          (msb-invisible-buffer-p)
          'multi)
      1090
-     "Invisible buffers (%d)") 
+     "Invisible buffers (%d)")
     ((eq major-mode 'dired-mode)
      2010
      "Dired (%d)"
      ;; Also note this item-sorter
      msb-sort-by-directory)
     ((eq major-mode 'Man-mode)
-     4030
+     5030
      "Manuals (%d)")
     ((eq major-mode 'w3-mode)
-     4020
+     5020
      "WWW (%d)")
-    ((or (memq major-mode '(rmail-mode vm-summary-mode vm-mode mail-mode))
+    ((or (memq major-mode '(rmail-mode rmail-edit-mode vm-summary-mode vm-mode mail-mode))
         (memq major-mode '(mh-letter-mode
                            mh-show-mode
-                           mh-folder-mode))     
+                           mh-folder-mode))    
         (memq major-mode '(gnus-summary-mode
                            news-reply-mode
                            gnus-group-mode
                            gnus-article-mode
                            gnus-kill-file-mode
                            gnus-browse-killed-mode)))
-     4010
+     5010
      "Mail (%d)")
     ;; Catchup for all non-file buffers
     ((and (not buffer-file-name)
          'no-multi)
-     4099
+     5099
      "Other non-file buffers (%d)")
     ((and (string-match "/\\.[^/]*$" buffer-file-name)
          'multi)
 ;;; Customizable variables
 ;;;
 
-(defvar msb-separator-diff 100
+(defgroup msb nil
+  "Customizable buffer-selection with multiple menus."
+  :prefix "msb-"
+  :group 'mouse)
+
+(defun msb-custom-set (symbol value)
+  "Set the value of custom variables for msb."
+  (set symbol value)
+  (if (featurep 'msb)
+      ;; wait until package has been loaded before bothering to update
+      ;; the buffer lists.
+      (menu-bar-update-buffers t))
+)
+
+(defcustom msb-menu-cond msb--very-many-menus
+  "*List of criteria for splitting the mouse buffer menu.
+The elements in the list should be of this type:
+ (CONDITION MENU-SORT-KEY MENU-TITLE ITEM-HANDLING-FN ITEM-SORT-FN).
+
+When making the split, the buffers are tested one by one against the
+CONDITION, just like a lisp cond: When hitting a true condition, the
+other criteria are *not* tested and the buffer name will appear in the
+menu with the menu-title corresponding to the true condition.
+
+If the condition returns the symbol `multi', then the buffer will be
+added to this menu *and* tested for other menus too.  If it returns
+`no-multi', then the buffer will only be added if it hasn't been added
+to any other menu.
+
+During this test, the buffer in question is the current buffer, and
+the test is surrounded by calls to `save-excursion' and
+`save-match-data'.
+
+The categories are sorted by MENU-SORT-KEY.  Smaller keys are on top.
+nil means don't display this menu.
+
+MENU-TITLE is really a format.  If you add %d in it, the %d is
+replaced with the number of items in that menu.
+
+ITEM-HANDLING-FN, is optional.  If it is supplied and is a function,
+than it is used for displaying the items in that particular buffer
+menu, otherwise the function pointed out by
+`msb-item-handling-function' is used.
+
+ITEM-SORT-FN, is also optional.
+If it is not supplied, the function pointed out by
+`msb-item-sort-function' is used.
+If it is nil, then no sort takes place and the buffers are presented
+in least-recently-used order.
+If it is t, then no sort takes place and the buffers are presented in
+most-recently-used order.
+If it is supplied and non-nil and not t than it is used for sorting
+the items in that particular buffer menu.
+
+Note1: There should always be a `catch-all' as last element, in this
+list.  That is an element like (t TITLE ITEM-HANDLING-FUNCTION).
+Note2: A buffer menu appears only if it has at least one buffer in it.
+Note3: If you have a CONDITION that can't be evaluated you will get an
+error every time you do \\[msb]."
+  :type `(choice (const :tag "long" :value ,msb--very-many-menus)
+                (const :tag "short" :value ,msb--few-menus))
+  :set 'msb-custom-set
+  :group 'msb)
+
+(defcustom msb-modes-key 4000
+  "The sort key for files sorted by mode."
+  :type 'integer
+  :set 'msb-custom-set
+  :group 'msb
+  :version "20.3")
+
+(defcustom msb-separator-diff 100
   "*Non-nil means use separators.
-The separators will appear between all menus that have a sorting key that differs by this value or more.")
+The separators will appear between all menus that have a sorting key
+that differs by this value or more."
+  :type '(choice integer (const nil))
+  :set 'msb-custom-set
+  :group 'msb)
 
 (defvar msb-files-by-directory-sort-key 0
-  "*The sort key for files sorted by directory")
+  "*The sort key for files sorted by directory.")
 
-(defvar msb-max-menu-items 15
+(defcustom msb-max-menu-items 15
   "*The maximum number of items in a menu.
-If this variable is set to 15 for instance, then the submenu will be split up in minor parts, 15 items each.
-Nil means no limit.")
+If this variable is set to 15 for instance, then the submenu will be
+split up in minor parts, 15 items each.  Nil means no limit."
+  :type '(choice integer (const nil))
+  :set 'msb-custom-set
+  :group 'msb)
 
-(defvar msb-max-file-menu-items 10
+(defcustom msb-max-file-menu-items 10
   "*The maximum number of items from different directories.
 
 When the menu is of type `file by directory', this is the maximum
-number of buffers that are clumped togehter from different
+number of buffers that are clumped together from different
 directories.
 
 Set this to 1 if you want one menu per directory instead of clumping
 them together.
 
-If the value is not a number, then the value 10 is used.")
+If the value is not a number, then the value 10 is used."
+  :type 'integer
+  :set 'msb-custom-set
+  :group 'msb)
 
-(defvar msb-most-recently-used-sort-key -1010
-  "*Where should the menu with the most recently used buffers be placed?")
+(defcustom msb-most-recently-used-sort-key -1010
+  "*Where should the menu with the most recently used buffers be placed?"
+  :type 'integer
+  :set 'msb-custom-set
+  :group 'msb)
 
-(defvar msb-display-most-recently-used 15
+(defcustom msb-display-most-recently-used 15
   "*How many buffers should be in the most-recently-used menu.
- No buffers at all if less than 1 or nil (or any non-number).")
-
-(defvar msb-most-recently-used-title "Most recently used (%d)"
-  "*The title for the most-recently-used menu.")
-  
+No buffers at all if less than 1 or nil (or any non-number)."
+  :type 'integer
+  :set 'msb-custom-set
+  :group 'msb)
+
+(defcustom msb-most-recently-used-title "Most recently used (%d)"
+  "*The title for the most-recently-used menu."
+  :type 'string
+  :set 'msb-custom-set
+  :group 'msb)
 (defvar msb-horizontal-shift-function '(lambda () 0)
-  "*Function that specifies a number of pixels by which the top menu should
-be shifted leftwards.")
+  "*Function that specifies how many pixels to shift the top menu leftwards.")
 
-(defvar msb-display-invisible-buffers-p nil
+(defcustom msb-display-invisible-buffers-p nil
   "*Show invisible buffers or not.
 Non-nil means that the buffer menu should include buffers that have
-names that starts with a space character.")
+names that starts with a space character."
+  :type 'boolean
+  :set 'msb-custom-set
+  :group 'msb)
 
 (defvar msb-item-handling-function 'msb-item-handler
   "*The appearance of a buffer menu.
@@ -258,78 +354,53 @@ where the latter is the max length of all buffer names.
 
 The function should return the string to use in the menu.
 
-When the function is called, BUFFER is the current buffer.
-This function is called for items in the variable `msb-menu-cond' that
-have nil as ITEM-HANDLING-FUNCTION.  See `msb-menu-cond' for more
+When the function is called, BUFFER is the current buffer.  This
+function is called for items in the variable `msb-menu-cond' that have
+nil as ITEM-HANDLING-FUNCTION.  See `msb-menu-cond' for more
 information.")
 
-(defvar msb-item-sort-function 'msb-sort-by-name
+(defcustom msb-item-sort-function 'msb-sort-by-name
   "*The order of items in a buffer menu.
+
 The default function to call for handling the order of items in a menu
-item.  This function is called like a sort function.  The items
-look like (ITEM-NAME . BUFFER).
+item.  This function is called like a sort function.  The items look
+like (ITEM-NAME . BUFFER).
+
 ITEM-NAME is the name of the item that will appear in the menu.
 BUFFER is the buffer, this is not necessarily the current buffer.
 
-Set this to nil or t if you don't want any sorting (faster).")
-
-(defvar msb-files-by-directory nil
+Set this to nil or t if you don't want any sorting (faster)."
+  :type '(choice (const msb-sort-by-name)
+                (const :tag "Newest first" t)
+                (const :tag "Oldest first" nil))
+  :set 'msb-custom-set
+  :group 'msb
+)
+               
+(defcustom msb-files-by-directory nil
   "*Non-nil means that files should be sorted by directory instead of
-the groups in msb-menu-cond.")
-
-(defvar msb-menu-cond msb--very-many-menus
-  "*List of criterias for splitting the mouse buffer menu.
-The elements in the list should be of this type:
- (CONDITION MENU-SORT-KEY MENU-TITLE ITEM-HANDLING-FN ITEM-SORT-FN).
-
-When making the split, the buffers are tested one by one against the
-CONDITION, just like a lisp cond: When hitting a true condition, the
-other criterias are *not* tested and the buffer name will appear in
-the menu with the menu-title corresponding to the true condition.
+the groups in msb-menu-cond."
+  :type 'boolean
+  :set 'msb-custom-set
+  :group 'msb)
 
-If the condition returns the symbol `multi', then the buffer will be
-added to this menu *and* tested for other menus too.  If it returns
-`no-multi', then the buffer will only be added if it hasn't been added
-to any other menu.
-
-During this test, the buffer in question is the current buffer, and
-the test is surrounded by calls to `save-excursion' and
-`save-match-data'.
-
-The categories are sorted by MENU-SORT-KEY.  Smaller keys are on
-top.  nil means don't display this menu.
-
-MENU-TITLE is really a format.  If you add %d in it, the %d is replaced
-with the number of items in that menu.
-
-ITEM-HANDLING-FN, is optional.  If it is supplied and is a
-function, than it is used for displaying the items in that particular
-buffer menu, otherwise the function pointed out by
-`msb-item-handling-function' is used.
-
-ITEM-SORT-FN, is also optional.
-If it is not supplied, the function pointed out by
-`msb-item-sort-function' is used.
-If it is nil, then no sort takes place and the buffers are presented
-in least-recently-used order.
-If it is t, then no sort takes place and the buffers are presented in
-most-recently-used order.
-If it is supplied and non-nil and not t than it is used for sorting
-the items in that particular buffer menu.
-
-Note1: There should always be a `catch-all' as last element,
-in this list.  That is an element like (t TITLE ITEM-HANDLING-FUNCTION).
-Note2: A buffer menu appears only if it has at least one buffer in it.
-Note3: If you have a CONDITION that can't be evaluated you will get an
-error every time you do \\[msb].")
-
-(defvar msb-after-load-hooks nil
-  "Hooks to be run after the msb package has been loaded.")
+(defcustom msb-after-load-hooks nil
+  "Hooks to be run after the msb package has been loaded."
+  :type 'hook
+  :set 'msb-custom-set
+  :group 'msb)
 
 ;;;
 ;;; Internal variables
 ;;;
 
+;; Home directory for the current user
+(defconst msb--home-dir
+  (condition-case nil
+      (substitute-in-file-name "$HOME")
+    ;; If $HOME isn't defined, use nil
+    (error nil)))
+
 ;; The last calculated menu.
 (defvar msb--last-buffer-menu nil)
 
@@ -404,15 +475,17 @@ An item look like (NAME . BUFFER)."
 (defun msb-sort-by-directory (item1 item2)
   "Sorts the items depending on their directory.  Made for dired.
 An item look like (NAME . BUFFER)."
-  (string-lessp (save-excursion (set-buffer (cdr item1)) (msb--dired-directory))
-               (save-excursion (set-buffer (cdr item2)) (msb--dired-directory))))
+  (string-lessp (save-excursion (set-buffer (cdr item1))
+                               (msb--dired-directory))
+               (save-excursion (set-buffer (cdr item2))
+                               (msb--dired-directory))))
 
 ;;;
 ;;; msb
 ;;;
 ;;; This function can be used instead of (mouse-buffer-menu EVENT)
 ;;; function in "mouse.el".
-;;; 
+;;;
 (defun msb (event)
   "Pop up several menus of buffers for selection with the mouse.
 This command switches buffers in the window that you clicked on, and
@@ -421,11 +494,13 @@ selects that window.
 See the function `mouse-select-buffer' and the variable
 `msb-menu-cond' for more information about how the menus are split."
   (interactive "e")
-  (let ((buffer (mouse-select-buffer event))
+  (let ((old-window (selected-window))
        (window (posn-window (event-start event))))
-    (when buffer
-      (unless (framep window) (select-window window))
-      (switch-to-buffer buffer)))
+    (unless (framep window) (select-window window))
+    (let ((buffer (mouse-select-buffer event)))
+      (if buffer
+         (switch-to-buffer buffer)
+       (select-window old-window))))
   nil)
 
 ;;;
@@ -437,51 +512,69 @@ If the argument is left out or nil, then the current buffer is considered."
   (and (> (length (buffer-name buffer)) 0)
        (eq ?\ (aref (buffer-name buffer) 0))))
 
-;; Strip one hierarcy level from the end of PATH.
-(defun msb--strip-path (path)
-  (save-match-data
-    (if (string-match "\\(.+\\)/[^/]+$" path)
-       (substring path (match-beginning 1) (match-end 1))
-      "/")))
+;; Strip one hierarchy level from the end of DIR.
+(defun msb--strip-dir (dir)
+  (file-name-directory (directory-file-name dir)))
 
 ;; Create an alist with all buffers from LIST that lies under the same
-;; directory will be in the same item as the directory string as
+;; directory will be in the same item as the directory string.
 ;; ((PATH1 . (BUFFER-1 BUFFER-2 ...)) (PATH2 . (BUFFER-K BUFFER-K+1...)) ...)
 (defun msb--init-file-alist (list)
   (let ((buffer-alist
+        ;; Make alist that looks like
+        ;; ((PATH-1 BUFFER-1) (PATH-2 BUFFER-2) ...)
+        ;; sorted on PATH-x
         (sort (mapcan
-               (function
-                (lambda (buffer)
-                  (let ((file-name (buffer-file-name buffer)))
-                    (when file-name
-                      (list (cons (msb--strip-path file-name) buffer))))))
+               (lambda (buffer)
+                 (let ((file-name (expand-file-name (buffer-file-name buffer))))
+                   (when file-name
+                     (list (cons (msb--strip-dir file-name) buffer)))))
                list)
-              (function (lambda (item1 item2)
-                          (string< (car item1) (car item2)))))))
+              (lambda (item1 item2)
+                (string< (car item1) (car item2))))))
+    ;; Now clump buffers together that have the same path
     ;; Make alist that looks like
     ;; ((PATH1 . (BUFFER-1 BUFFER-2 ...)) (PATH2 . (BUFFER-K)) ...)
     (let ((path nil)
-         (buffers nil)
-         (result nil))
-      (append
-       (mapcan (function
-              (lambda (item)
+         (buffers nil))
+      (nconc
+       (mapcan (lambda (item)
                 (cond
                  ((and path
                        (string= path (car item)))
+                  ;; The same path as earlier: Add to current list of
+                  ;; buffers.
                   (push (cdr item) buffers)
+                  ;; This item should not be added to list
                   nil)
                  (t
-                  (when path
-                    (setq result (cons path buffers)))
-                  (setq path (car item))
-                  (setq buffers (list (cdr item)))
-                  (and result (list result))))))
-             buffer-alist)
+                  ;; New path
+                  (let ((result (and path (cons path buffers))))
+                    (setq path (car item))
+                    (setq buffers (list (cdr item)))
+                    ;; Add the last result the list.
+                    (and result (list result))))))
+              buffer-alist)
+       ;; Add the last result to the list
        (list (cons path buffers))))))
 
+;; Format a suitable title for the menu item.
+(defun msb--format-title (top-found-p path number-of-items)
+  (let ((new-path path))
+    (when (and msb--home-dir
+              (string-match (concat "^" msb--home-dir) path))
+      (setq new-path (concat "~"
+                            (substring path (match-end 0)))))
+    (format (if top-found-p "%s... (%d)" "%s (%d)")
+           new-path number-of-items)))
+
+;; Variables for debugging.
+(defvar msb--choose-file-menu-list)
+(defvar msb--choose-file-menu-arg-list)
+
 ;; Choose file-menu with respect to directory for every buffer in LIST.
 (defun msb--choose-file-menu (list)
+  (setq msb--choose-file-menu-arg-list list)
   (let ((buffer-alist (msb--init-file-alist list))
        (final-list nil)
        (max-clumped-together (if (numberp msb-max-file-menu-items)
@@ -489,47 +582,63 @@ If the argument is left out or nil, then the current buffer is considered."
                                10))
        (top-found-p nil)
        (last-path nil)
-       first rest path buffers)
-    (setq first (car buffer-alist))
-    (setq rest (cdr buffer-alist))
-    (setq path (car first))
-    (setq buffers (cdr first))
+       first rest path buffers old-path)
+    ;; Prepare for looping over all items in buffer-alist
+    (setq first (car buffer-alist)
+         rest (cdr buffer-alist)
+         path (car first)
+         buffers (cdr first))
+    (setq msb--choose-file-menu-list (copy-list rest))
+    ;; This big loop tries to clump buffers together that have a
+    ;; similar name. Remember that buffer-alist is sorted based on the
+    ;; path for the buffers.
     (while rest
       (let ((found-p nil)
            (tmp-rest rest)
+           result
            new-path item)
        (setq item (car tmp-rest))
+       ;; Clump together the "rest"-buffers that have a path that is
+       ;; a subpath of the current one.
        (while (and tmp-rest
                    (<= (length buffers) max-clumped-together)
                    (>= (length (car item)) (length path))
                    (string= path (substring (car item) 0 (length path))))
          (setq found-p t)
-         (setq buffers (append buffers (cdr item)))
-         (setq tmp-rest (cdr tmp-rest))
-         (setq item (car tmp-rest)))
+         (setq buffers (append buffers (cdr item))) ;nconc is faster than append
+         (setq tmp-rest (cdr tmp-rest)
+               item (car tmp-rest)))
        (cond
         ((> (length buffers) max-clumped-together)
+         ;; Oh, we failed. Too many buffers clumped together.
+         ;; Just use the original ones for the result.
          (setq last-path (car first))
-         (setq first
-               (cons (format (if top-found-p
-                                 "%s/... (%d)"
-                               "%s (%d)")
-                             (car first)
-                             (length (cdr first)))
-                     (cdr first)))
+         (push (cons (msb--format-title top-found-p
+                                        (car first)
+                                        (length (cdr first)))
+                     (cdr first))
+               final-list)
          (setq top-found-p nil)
-         (push first final-list)
          (setq first (car rest)
-               rest (cdr rest))
-         (setq path (car first)
+               rest (cdr rest)
+               path (car first)
                buffers (cdr first)))
         (t
+         ;; The first pass of clumping together worked out, go ahead
+         ;; with this result.
          (when found-p
            (setq top-found-p t)
            (setq first (cons path buffers)
                  rest tmp-rest))
-         (setq path (msb--strip-path path)
+         ;; Now see if we can clump more buffers together if we go up
+         ;; one step in the file hierarchy.
+         ;; If path isn't changed by msb--strip-dir, we are looking
+         ;; at the machine name component of an ange-ftp filename.
+         (setq old-path path)
+         (setq path (msb--strip-dir path)
                buffers (cdr first))
+         (if (equal old-path path)
+             (setq last-path path))
          (when (and last-path
                     (or (and (>= (length path) (length last-path))
                              (string= last-path
@@ -537,29 +646,27 @@ If the argument is left out or nil, then the current buffer is considered."
                         (and (< (length path) (length last-path))
                              (string= path
                                       (substring last-path 0 (length path))))))
-                        
-           (setq first
-                 (cons (format (if top-found-p
-                                   "%s/... (%d)"
-                                 "%s (%d)")
-                               (car first)
-                               (length (cdr first)))
-                       (cdr first)))
+           ;; We have reached the same place in the file hierarchy as
+           ;; the last result, so we should quit at this point and
+           ;; take what we have as result.
+           (push (cons (msb--format-title top-found-p
+                                          (car first)
+                                          (length (cdr first)))
+                       (cdr first))
+                 final-list)
            (setq top-found-p nil)
-           (push first final-list)
            (setq first (car rest)
-                 rest (cdr rest))
-           (setq path (car first)
-               buffers (cdr first)))))))
-    (setq first
-         (cons (format (if top-found-p
-                           "%s/... (%d)"
-                         "%s (%d)")
-                       (car first)
-                       (length (cdr first)))
-               (cdr first)))
+                 rest (cdr rest)
+                 path (car first)
+                 buffers (cdr first)))))))
+    ;; Now take care of the last item.
+    (when first
+      (push (cons (msb--format-title top-found-p
+                                    (car first)
+                                    (length (cdr first)))
+                 (cdr first))
+           final-list))
     (setq top-found-p nil)
-    (push first final-list)
     (nreverse final-list)))
 
 ;; Create a vector as:
@@ -601,7 +708,7 @@ If the argument is left out or nil, then the current buffer is considered."
     ))
 
 ;; This defsubst is only used in `msb--choose-menu' below.  It was
-;; pulled out merely to make the code somewhat clearer.  The indention
+;; pulled out merely to make the code somewhat clearer.  The indentation
 ;; level was too big.
 (defsubst msb--collect (function-info-vector)
   (let ((result nil)
@@ -637,7 +744,7 @@ If the argument is left out or nil, then the current buffer is considered."
                              max-buffer-name-length)
                     buffer)
               (eval list-symbol)))))
-  
 ;; Selects the appropriate menu for BUFFER.
 ;; This is all side-effects, folks!
 ;; This should be optimized.
@@ -648,16 +755,15 @@ If the argument is left out or nil, then the current buffer is considered."
        (save-excursion
          (set-buffer buffer)
          ;; Menu found.  Add to this menu
-         (mapc (function
-                (lambda (function-info)
-                  (msb--add-to-menu buffer function-info max-buffer-name-length)))
+         (mapc (lambda (function-info)
+                 (msb--add-to-menu buffer function-info max-buffer-name-length))
                (msb--collect function-info-vector)))
       (error (unless msb--error
               (setq msb--error
                     (format
                      "In msb-menu-cond, error for buffer `%s'."
                      (buffer-name buffer)))
-              (error msb--error))))))
+              (error "%s" msb--error))))))
 
 ;; Return (SORT-KEY TITLE . BUFFER-LIST) or nil if the
 ;; buffer-list is empty.
@@ -667,7 +773,7 @@ If the argument is left out or nil, then the current buffer is considered."
       (let ((sorter (aref function-info 5)) ;SORTER
            (sort-key (aref function-info 2))) ;MENU-SORT-KEY
        (when sort-key
-         (cons sort-key        
+         (cons sort-key
                (cons (format (aref function-info 3) ;MENU-TITLE
                              (length buffer-list))
                      (cond
@@ -678,14 +784,77 @@ If the argument is left out or nil, then the current buffer is considered."
                       (t
                        (sort buffer-list sorter))))))))))
 
+;; Return ALIST as a sorted, aggregated alist, where all items with
+;; the same car element (according to SAME-PREDICATE) are aggregated
+;; together. The alist is first sorted by SORT-PREDICATE.
+;; Example:
+;; (msb--aggregate-alist
+;;  '((a . a1) (a . a2) (b . b1) (c . c3) (a . a4) (a . a3) (b . b3) (b . b2))
+;;  (function string=)
+;;  (lambda (item1 item2)
+;;    (string< (symbol-name item1) (symbol-name item2))))
+;; results in
+;; ((a a1 a2 a4 a3) (b b1 b3 b2) (c c3))
+(defun msb--aggregate-alist (alist same-predicate sort-predicate)
+  (when (not (null alist))
+    (let (result
+         same
+         tmp-old-car
+         tmp-same
+         (first-time-p t)
+         old-car)
+      (nconc
+       (mapcan (lambda (item)
+                (cond
+                 (first-time-p
+                  (push (cdr item) same)
+                  (setq first-time-p nil)
+                  (setq old-car (car item))
+                  nil)
+                 ((funcall same-predicate (car item) old-car)
+                  (push (cdr item) same)
+                  nil)
+                 (t
+                  (setq tmp-same same
+                        tmp-old-car old-car)
+                  (setq same (list (cdr item))
+                        old-car (car item))
+                  (list (cons tmp-old-car (nreverse tmp-same))))))
+              (sort alist (lambda (item1 item2)
+                            (funcall sort-predicate (car item1) (car item2)))))
+       (list (cons old-car (nreverse same)))))))
+
+
+(defun msb--mode-menu-cond ()
+  (let ((key msb-modes-key))
+    (mapcar (lambda (item)
+             (incf key)
+             (list `( eq major-mode (quote ,(car item)))
+                   key
+                   (concat (cdr item) " (%d)")))
+           (sort 
+            (let ((mode-list nil))
+              (mapc (lambda (buffer)
+                      (save-excursion
+                        (set-buffer buffer)
+                        (when (and (not (msb-invisible-buffer-p))
+                                   (not (assq major-mode mode-list))
+                                   (push (cons major-mode mode-name)
+                                         mode-list)))))
+                    (cdr (buffer-list)))
+              mode-list)
+            (lambda (item1 item2)
+              (string< (cdr item1) (cdr item2)))))))
+
 ;; Returns a list on the form ((TITLE . BUFFER-LIST)) for
 ;; the most recently used buffers.
 (defun msb--most-recently-used-menu (max-buffer-name-length)
   (when (and (numberp msb-display-most-recently-used)
             (> msb-display-most-recently-used 0))
-    (let* ((most-recently-used
+    (let* ((buffers (cdr (buffer-list)))
+          (most-recently-used
            (loop with n = 0
-                 for buffer in (cdr (buffer-list))
+                 for buffer in buffers
                  if (save-excursion
                       (set-buffer buffer)
                       (and (not (msb-invisible-buffer-p))
@@ -710,13 +879,12 @@ If the argument is left out or nil, then the current buffer is considered."
        function-info-vector)
     ;; Calculate the longest buffer name.
     (mapc
-     (function
-      (lambda (buffer)
-       (if (or msb-display-invisible-buffers-p
-               (not (msb-invisible-buffer-p)))
-           (setq max-buffer-name-length
-                 (max max-buffer-name-length
-                      (length (buffer-name buffer)))))))
+     (lambda (buffer)
+       (if (or msb-display-invisible-buffers-p
+              (not (msb-invisible-buffer-p)))
+          (setq max-buffer-name-length
+                (max max-buffer-name-length
+                     (length (buffer-name buffer))))))
      (buffer-list))
     ;; Make a list with elements of type
     ;; (BUFFER-LIST-VARIABLE
@@ -730,43 +898,46 @@ If the argument is left out or nil, then the current buffer is considered."
     (setq function-info-vector
          (apply (function vector)
                 (mapcar (function msb--create-function-info)
-                        msb-menu-cond)))
+                        (append msb-menu-cond (msb--mode-menu-cond)))))
     ;; Split the buffer-list into several lists; one list for each
     ;; criteria.  This is the most critical part with respect to time.
-    (mapc (function (lambda (buffer)
-                     (cond ((and msb-files-by-directory
-                                 (buffer-file-name buffer))
-                            (push buffer file-buffers))
-                           (t
-                            (msb--choose-menu buffer
-                                              function-info-vector
-                                              max-buffer-name-length)))))
+    (mapc (lambda (buffer)
+           (cond ((and msb-files-by-directory
+                       (buffer-file-name buffer)
+                       ;; exclude ange-ftp buffers
+                       ;;(not (string-match "\\/[^/:]+:"
+                       ;;                 (buffer-file-name buffer)))
+                       )
+                  (push buffer file-buffers))
+                 (t
+                  (msb--choose-menu buffer
+                                    function-info-vector
+                                    max-buffer-name-length))))
          (buffer-list))
     (when file-buffers
       (setq file-buffers
-           (mapcar (function
-                    (lambda (buffer-list)
-                      (cons msb-files-by-directory-sort-key
-                            (cons (car buffer-list)
-                                  (sort
-                                   (mapcar (function
-                                            (lambda (buffer)
-                                              (cons (save-excursion
-                                                      (set-buffer buffer)
-                                                      (funcall msb-item-handling-function
-                                                             buffer
-                                                             max-buffer-name-length))
-                                                    buffer)))
-                                           (cdr buffer-list))
-                                   (function
-                                    (lambda (item1 item2)
-                                      (string< (car item1) (car item2)))))))))
+           (mapcar (lambda (buffer-list)
+                     (cons msb-files-by-directory-sort-key
+                           (cons (car buffer-list)
+                                 (sort
+                                  (mapcar (function
+                                           (lambda (buffer)
+                                             (cons (save-excursion
+                                                     (set-buffer buffer)
+                                                     (funcall msb-item-handling-function
+                                                              buffer
+                                                              max-buffer-name-length))
+                                                   buffer)))
+                                          (cdr buffer-list))
+                                  (function
+                                   (lambda (item1 item2)
+                                     (string< (car item1) (car item2))))))))
                     (msb--choose-file-menu file-buffers))))
     ;; Now make the menu - a list of (TITLE . BUFFER-LIST)
     (let* (menu
           (most-recently-used
            (msb--most-recently-used-menu max-buffer-name-length))
-          (others (append file-buffers
+          (others (nconc file-buffers
                           (loop for elt
                                 across function-info-vector
                                 for value = (msb--create-sort-item elt)
@@ -785,15 +956,15 @@ If the argument is left out or nil, then the current buffer is considered."
                                most-recently-used)
                          others)
                       others)
-                    (function (lambda (elt1 elt2)
-                                (< (car elt1) (car elt2))))))))
+                    (lambda (elt1 elt2)
+                      (< (car elt1) (car elt2)))))))
       ;; Now make it a keymap menu
       (append
        '(keymap "Select Buffer")
        (msb--make-keymap-menu menu)
        (when msb-separator-diff
-        (list (list 'separator "---")))
-       (list (cons 'toggle 
+        (list (list 'separator "--")))
+       (list (cons 'toggle
                   (cons
                   (if msb-files-by-directory
                       "*Files by type*"
@@ -807,10 +978,12 @@ If the argument is left out or nil, then the current buffer is considered."
 
 ;;;
 ;;; Multi purpose function for selecting a buffer with the mouse.
-;;; 
+;;;
 (defun msb--toggle-menu-type ()
   (interactive)
   (setq msb-files-by-directory (not msb-files-by-directory))
+  ;; This gets a warning, but it is correct,
+  ;; because this file redefines menu-bar-update-buffers.
   (menu-bar-update-buffers t))
 
 (defun mouse-select-buffer (event)
@@ -836,6 +1009,10 @@ variable `msb-menu-cond'."
        ;; adjust position
        (setq posX (- posX (funcall msb-horizontal-shift-function))
              position (list (list posX posY) posWind))))
+    ;; This `sit-for' magically makes the menu stay up if the mouse
+    ;; button is released within 0.1 second.
+    (sit-for 0 100)
+    ;; Popup the menu
     (setq choice (x-popup-menu position msb--last-buffer-menu))
     (cond
      ((eq (car choice) 'toggle)
@@ -855,7 +1032,7 @@ variable `msb-menu-cond'."
       choice)
      (t
       (error "Unknown form for buffer: %s" choice)))))
-                   
+
 ;; Add separators
 (defun msb--add-separators (sorted-list)
   (cond
@@ -865,19 +1042,18 @@ variable `msb-menu-cond'."
    (t
     (let ((last-key nil))
       (mapcan
-       (function
-       (lambda (item)
-         (cond
-          ((and msb-separator-diff
-                last-key 
-                (> (- (car item) last-key)
-                   msb-separator-diff))
-           (setq last-key (car item))
-           (list (cons last-key 'separator)
-                 item))
-          (t
-           (setq last-key (car item))
-           (list item)))))
+       (lambda (item)
+        (cond
+         ((and msb-separator-diff
+               last-key 
+               (> (- (car item) last-key)
+                  msb-separator-diff))
+          (setq last-key (car item))
+          (list (cons last-key 'separator)
+                item))
+         (t
+          (setq last-key (car item))
+          (list item))))
        sorted-list)))))
 
 (defun msb--split-menus-2 (list mcount result)
@@ -891,8 +1067,8 @@ variable `msb-menu-cond'."
        (incf count))
     (setq tmp-list (nreverse tmp-list))
     (setq sub-name (concat (car (car tmp-list)) "..."))
-    (push (append (list mcount sub-name
-                       'keymap sub-name)
+    (push (nconc (list mcount sub-name
+                      'keymap sub-name)
                  tmp-list)
          result))
     (msb--split-menus-2 list (1+ mcount) result))
@@ -901,36 +1077,37 @@ variable `msb-menu-cond'."
    (t
     (let (sub-name)
       (setq sub-name (concat (car (car list)) "..."))
-      (push (append (list mcount sub-name
-                       'keymap sub-name)
+      (push (nconc (list mcount sub-name
+                        'keymap sub-name)
                  list)
          result))
     (nreverse result))))
-    
-(defun msb--split-menus (list)
- (msb--split-menus-2 list 0 nil))
 
+(defun msb--split-menus (list)
+  (if (and (integerp msb-max-menu-items)
+          (> msb-max-menu-items 0))
+      (msb--split-menus-2 list 0 nil)
+    list))
 
 (defun msb--make-keymap-menu (raw-menu)
   (let ((end (cons '(nil) 'menu-bar-select-buffer))
        (mcount 0))
     (mapcar
-     (function
-      (lambda (sub-menu)
-       (cond 
-        ((eq 'separator sub-menu)
-         (list 'separator "---"))
-        (t
-         (let ((buffers (mapcar (function
-                                 (lambda (item)
-                                   (let ((string (car item))
-                                         (buffer (cdr item)))
-                                     (cons (buffer-name buffer)
-                                           (cons string end)))))
-                                (cdr sub-menu))))
-           (append (list (incf mcount) (car sub-menu)
-                         'keymap (car sub-menu))
-                   (msb--split-menus buffers)))))))
+     (lambda (sub-menu)
+       (cond 
+       ((eq 'separator sub-menu)
+        (list 'separator "--"))
+       (t
+        (let ((buffers (mapcar (function
+                                (lambda (item)
+                                  (let ((string (car item))
+                                        (buffer (cdr item)))
+                                    (cons (buffer-name buffer)
+                                          (cons string end)))))
+                               (cdr sub-menu))))
+          (nconc (list (incf mcount) (car sub-menu)
+                       'keymap (car sub-menu))
+                 (msb--split-menus buffers))))))
      raw-menu)))
 
 (defun menu-bar-update-buffers (&optional arg)
@@ -939,40 +1116,40 @@ variable `msb-menu-cond'."
             (or (not (fboundp 'frame-or-buffer-changed-p))
                 (frame-or-buffer-changed-p)
                 arg))
-    (let ((buffers (buffer-list))
-         (frames (frame-list))
+    (let ((frames (frame-list))
          buffers-menu frames-menu)
-      ;; If requested, list only the N most recently selected buffers.
-      (when (and (integerp buffers-menu-max-size)
-                (> buffers-menu-max-size 1)
-                (> (length buffers) buffers-menu-max-size))
-       (setcdr (nthcdr buffers-menu-max-size buffers) nil))
       ;; Make the menu of buffers proper.
       (setq msb--last-buffer-menu (msb--create-buffer-menu))
       (setq buffers-menu msb--last-buffer-menu)
       ;; Make a Frames menu if we have more than one frame.
-      (if (cdr frames)
+      (when (cdr frames)
+       (let* ((frame-length (length frames))
+              (f-title  (format "Frames (%d)" frame-length)))
+         ;; List only the N most recently selected frames
+         (when (and (integerp msb-max-menu-items)
+                    (>  msb-max-menu-items 1)
+                    (> frame-length msb-max-menu-items))
+           (setcdr (nthcdr msb-max-menu-items frames) nil))
          (setq frames-menu
-               (cons "Select Frame"
-                     (mapcar
-                      (function
-                       (lambda (frame)
-                         (nconc
-                          (list frame
-                                (cdr (assq 'name
-                                           (frame-parameters frame)))
-                                (cons nil nil))
-                          'menu-bar-select-frame)))
-                      frames))))
-      (when frames-menu
-       (setq frames-menu (cons 'keymap frames-menu)))
+               (nconc
+                (list 'frame f-title '(nil) 'keymap f-title)
+                (mapcar
+                 (lambda (frame)
+                   (nconc
+                    (list frame
+                          (cdr (assq 'name
+                                     (frame-parameters frame)))
+                          (cons nil nil))
+                    'menu-bar-select-frame))
+                 frames)))))
       (define-key (current-global-map) [menu-bar buffer]
        (cons "Buffers"
              (if (and buffers-menu frames-menu)
-                 (list 'keymap "Buffers and Frames"
-                       (cons 'buffers (cons "Buffers" buffers-menu))
-                       (cons 'frames (cons "Frames" frames-menu)))
-               (or buffers-menu frames-menu 'undefined)))))))
+                 ;; Combine Frame and Buffers menus with separator between
+                 (nconc (list 'keymap "Buffers and Frames" frames-menu
+                              (and msb-separator-diff '(separator "--")))
+                        (cddr buffers-menu))
+               (or buffers-menu 'undefined)))))))
 
 (when (and (boundp 'menu-bar-update-hook)
           (not (fboundp 'frame-or-buffer-changed-p)))
@@ -992,4 +1169,5 @@ variable `msb-menu-cond'."
 
 (provide 'msb)
 (eval-after-load 'msb (run-hooks 'msb-after-load-hooks))
+
 ;;; msb.el ends here