]> code.delx.au - gnu-emacs/blobdiff - lisp/msb.el
(command_loop_1): No direct display if Column Number mode.
[gnu-emacs] / lisp / msb.el
index c4f0c900204af932b7b369dbd78eb7fc6738ab81..83ca200dff9f75bb72c0ddc9720d7d17a30227a9 100644 (file)
@@ -1,8 +1,9 @@
 ;;; msb.el --- Customizable buffer-selection with multiple menus.
-;; Copyright (C) 1993, 1994 Lars Lindberg <Lars.Lindberg@sypro.cap.se>
+;; Copyright (C) 1993, 1994, 1995 Lars Lindberg <Lars.Lindberg@sypro.cap.se>
 ;;
 ;; Author: Lars Lindberg <Lars.Lindberg@sypro.cap.se>
 ;; Created: 8 Oct 1993
+;; Lindberg's last update version: 3.31
 ;; Keywords: mouse buffer menu 
 ;;
 ;; This program is free software; you can redistribute it and/or modify
 ;;   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
 ;;   Also check out the variable `msb-display-invisible-buffers-p'.
 
 ;; Known bugs:
-;; - `msb' does not work on a non-X-toolkit Emacs.
+;; - Files-by-directory
+;;   + No possibility to show client/changed buffers separately.
+;;   + All file buffers only appear in 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))     
     ((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))     
@@ -211,10 +213,9 @@ The separators will appear between all menus that have a sorting key that differ
 (defvar msb-files-by-directory-sort-key 0
   "*The sort key for files sorted by directory")
 
-(defvar msb-max-menu-items 25
+(defvar msb-max-menu-items 15
   "*The maximum number of items in a menu.
-If this variable is set to 15 for instance, then the 15 latest used
-buffer that fits in a certain submenu will appear in that submenu.
+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.")
 
 (defvar msb-max-file-menu-items 10
@@ -224,15 +225,17 @@ When the menu is of type `file by directory', this is the maximum
 number of buffers that are clumped togehter 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.")
 
 (defvar msb-most-recently-used-sort-key -1010
   "*Where should the menu with the most recently used buffers be placed?")
 
-(defvar msb-display-most-recently-used t
+(defvar 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.
-T means use the value of `msb-max-menu-items' in the way it is defined.")
+ 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.")
@@ -252,6 +255,9 @@ names that starts with a space character.")
 The default function to call for handling the appearance of a menu
 item.  It should take to arguments, BUFFER and MAX-BUFFER-NAME-LENGTH,
 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
@@ -331,7 +337,7 @@ error every time you do \\[msb].")
 (defvar msb--error nil)
 
 ;;;
-;;; Some example function to be used for `msb-item-sort-function'.
+;;; Some example function to be used for `msb-item-handling-function'.
 ;;;
 (defun msb-item-handler (buffer &optional maxbuf)
   "Create one string item, concerning BUFFER, for the buffer menu.
@@ -386,7 +392,7 @@ The `#' appears only version control file (SCCS/RCS)."
           (or buffer-file-name "")))
 
 ;;;
-;;; Some example function to be used for `msb-item-handling-function'.
+;;; Some example function to be used for `msb-item-sort-function'.
 ;;;
 (defun msb-sort-by-name (item1 item2)
   "Sorts the items depending on their buffer-name
@@ -415,12 +421,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))))
-    (cond
-     (buffer
-      (or (framep window) (select-window window))
-      (switch-to-buffer (car (cdr buffer))))))
+    (unless (framep window) (select-window window))
+    (let ((buffer (mouse-select-buffer event)))
+      (if buffer
+         (switch-to-buffer buffer)
+       (select-window old-window))))
   nil)
 
 ;;;
@@ -463,8 +470,6 @@ If the argument is left out or nil, then the current buffer is considered."
               (lambda (item)
                 (cond
                  ((and path
-                       msb-max-menu-items
-                       (< (length buffers) msb-max-menu-items)
                        (string= path (car item)))
                   (push (cdr item) buffers)
                   nil)
@@ -507,10 +512,14 @@ If the argument is left out or nil, then the current buffer is considered."
        (cond
         ((> (length buffers) max-clumped-together)
          (setq last-path (car first))
-         (when top-found-p
-           (setq first (cons (concat (car first) "/...")
-                             (cdr first)))
-           (setq top-found-p nil))
+         (setq first
+               (cons (format (if top-found-p
+                                 "%s/... (%d)"
+                               "%s (%d)")
+                             (car first)
+                             (length (cdr first)))
+                     (cdr first)))
+         (setq top-found-p nil)
          (push first final-list)
          (setq first (car rest)
                rest (cdr rest))
@@ -531,22 +540,27 @@ If the argument is left out or nil, then the current buffer is considered."
                              (string= path
                                       (substring last-path 0 (length path))))))
                         
-           (when top-found-p
-             (setq first (cons (concat (car first) "/...")
-                               (cdr first)))
-             (setq top-found-p nil))
+           (setq first
+                 (cons (format (if top-found-p
+                                   "%s/... (%d)"
+                                 "%s (%d)")
+                               (car first)
+                               (length (cdr first)))
+                       (cdr first)))
+           (setq top-found-p nil)
            (push first final-list)
            (setq first (car rest)
                  rest (cdr rest))
            (setq path (car first)
                buffers (cdr first)))))))
-    (when top-found-p
-      (setq first (cons (concat (car first)
-                               (if (string-match "/$" (car first))
-                                   "..."
-                                 "/..."))
-                       (cdr first)))
-      (setq top-found-p nil))
+    (setq first
+         (cons (format (if top-found-p
+                           "%s/... (%d)"
+                         "%s (%d)")
+                       (car first)
+                       (length (cdr first)))
+               (cdr first)))
+    (setq top-found-p nil)
     (push first final-list)
     (nreverse final-list)))
 
@@ -604,10 +618,7 @@ If the argument is left out or nil, then the current buffer is considered."
                                  multi-flag))
                        (progn (when (eq result 'multi)
                                 (setq multi-flag t))
-                              t)
-                       (or (not msb-max-menu-items)
-                           (< (length (eval (aref fi 0)))
-                              msb-max-menu-items)))
+                              t))
                collect fi
                until (and result
                           (not (eq result 'multi)))))
@@ -672,17 +683,12 @@ If the argument is left out or nil, then the current buffer is considered."
 ;; 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 msb-display-most-recently-used
-            (or (not (numberp msb-display-most-recently-used))
-                (> msb-display-most-recently-used 0)))
-    (let* ((max-in-menu
-           (if (numberp msb-display-most-recently-used)
-               msb-display-most-recently-used
-             msb-max-menu-items))
-
+  (when (and (numberp msb-display-most-recently-used)
+            (> msb-display-most-recently-used 0))
+    (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))
@@ -694,7 +700,7 @@ If the argument is left out or nil, then the current buffer is considered."
                                           max-buffer-name-length)
                                  buffer))
                  and do (incf n)
-                 until (and max-in-menu (>= n max-in-menu)))))
+                 until (>= n msb-display-most-recently-used))))
       (cons (if (stringp msb-most-recently-used-title)
                (format msb-most-recently-used-title
                        (length most-recently-used))
@@ -748,7 +754,11 @@ If the argument is left out or nil, then the current buffer is considered."
                                   (sort
                                    (mapcar (function
                                             (lambda (buffer)
-                                              (cons (buffer-name buffer)
+                                              (cons (save-excursion
+                                                      (set-buffer buffer)
+                                                      (funcall msb-item-handling-function
+                                                             buffer
+                                                             max-buffer-name-length))
                                                     buffer)))
                                            (cdr buffer-list))
                                    (function
@@ -756,15 +766,14 @@ If the argument is left out or nil, then the current buffer is considered."
                                       (string< (car item1) (car item2)))))))))
                     (msb--choose-file-menu file-buffers))))
     ;; Now make the menu - a list of (TITLE . BUFFER-LIST)
-    (let* ((buffers (buffer-list))
-          menu
+    (let* (menu
           (most-recently-used
            (msb--most-recently-used-menu max-buffer-name-length))
           (others (append file-buffers
                           (loop for elt
-                        across function-info-vector
-                        for value = (msb--create-sort-item elt)
-                        if value collect value))))
+                                across function-info-vector
+                                for value = (msb--create-sort-item elt)
+                                if value collect value))))
       (setq menu
            (mapcar 'cdr                ;Remove the SORT-KEY
                    ;; Sort the menus - not the items.
@@ -805,13 +814,13 @@ If the argument is left out or nil, then the current buffer is considered."
 (defun msb--toggle-menu-type ()
   (interactive)
   (setq msb-files-by-directory (not msb-files-by-directory))
-  (menu-bar-update-buffers t))
+  (menu-bar-update-buffers))
 
 (defun mouse-select-buffer (event)
   "Pop up several menus of buffers, for selection with the mouse.
 Returns the selected buffer or nil if no buffer is selected.
 
-The way the buffers are splitted is conveniently handled with the
+The way the buffers are split is conveniently handled with the
 variable `msb-menu-cond'."
   ;; Popup the menu and return the selected buffer.
   (when (or msb--error
@@ -820,31 +829,39 @@ variable `msb-menu-cond'."
            (frame-or-buffer-changed-p))
     (setq msb--error nil)
     (setq msb--last-buffer-menu (msb--create-buffer-menu)))
-  (let ((position event))
+  (let ((position event)
+       choice)
     (when (and (fboundp 'posn-x-y)
               (fboundp 'posn-window))
       (let ((posX (car (posn-x-y (event-start event))))
            (posY (cdr (posn-x-y (event-start event))))
-           (posWind (posn-window (event-start event)))
-           name)
+           (posWind (posn-window (event-start event))))
        ;; adjust position
        (setq posX (- posX (funcall msb-horizontal-shift-function))
              position (list (list posX posY) posWind))))
-    (setq name (x-popup-menu position msb--last-buffer-menu))
-    ;; If toggle bring up the
+    ;; This `sit-for' magically makes the menu stay up if the mouse
+    ;; button is released withing 0.1 second.
+    (sit-for 0 100)
+    ;; Popup the menu
+    (setq choice (x-popup-menu position msb--last-buffer-menu))
     (cond
-     ((eq (car name) 'toggle)
-       (msb--toggle-menu-type)
-       (mouse-select-buffer event))
-     ((and (numberp (car name))
-          (null (cdr name)))
-      (let ((msb--last-buffer-menu (nthcdr 3 (assq (car name) msb--last-buffer-menu))))
+     ((eq (car choice) 'toggle)
+      ;; Bring up the menu again with type toggled.
+      (msb--toggle-menu-type)
+      (mouse-select-buffer event))
+     ((and (numberp (car choice))
+          (null (cdr choice)))
+      (let ((msb--last-buffer-menu (nthcdr 3 (assq (car choice) msb--last-buffer-menu))))
        (mouse-select-buffer event)))
-      ((and (stringp (car name))
-          (null (cdr name)))
-      (cons nil name))
-      (t
-       name))))
+     ((while (numberp (car choice))
+       (setq choice (cdr choice))))
+     ((and (stringp (car choice))
+          (null (cdr choice)))
+      (car choice))
+     ((null choice)
+      choice)
+     (t
+      (error "Unknown form for buffer: %s" choice)))))
                    
 ;; Add separators
 (defun msb--add-separators (sorted-list)
@@ -870,6 +887,37 @@ variable `msb-menu-cond'."
            (list item)))))
        sorted-list)))))
 
+(defun msb--split-menus-2 (list mcount result)
+  (cond
+   ((> (length list) msb-max-menu-items)
+    (let ((count 0)
+         sub-name
+         (tmp-list nil))
+      (while (< count msb-max-menu-items)
+       (push (pop list) tmp-list)
+       (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)
+                 tmp-list)
+         result))
+    (msb--split-menus-2 list (1+ mcount) result))
+   ((null result)
+    list)
+   (t
+    (let (sub-name)
+      (setq sub-name (concat (car (car list)) "..."))
+      (push (append (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--make-keymap-menu (raw-menu)
   (let ((end (cons '(nil) 'menu-bar-select-buffer))
        (mcount 0))
@@ -880,15 +928,16 @@ variable `msb-menu-cond'."
         ((eq 'separator sub-menu)
          (list 'separator "---"))
         (t
-         (append (list (incf mcount) (car sub-menu)
-                       'keymap (car sub-menu))
-                 (mapcar (function
-                          (lambda (item)
-                            (let ((string (car item))
-                                  (buffer (cdr item)))
-                              (cons (buffer-name buffer)
-                                    (cons string end)))))
-                  (cdr sub-menu)))))))
+         (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)))))))
      raw-menu)))
 
 (defun menu-bar-update-buffers (&optional arg)
@@ -897,40 +946,41 @@ 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
+                 (function
+                  (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)))
@@ -951,4 +1001,3 @@ variable `msb-menu-cond'."
 (provide 'msb)
 (eval-after-load 'msb (run-hooks 'msb-after-load-hooks))
 ;;; msb.el ends here
-