;;; 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))
(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
"*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.")
(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.")
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
the groups in msb-menu-cond.")
(defvar msb-menu-cond msb--very-many-menus
- "*List of criterias for splitting the mouse buffer menu.
+ "*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 criterias are *not* tested and the buffer name will appear in
+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
(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.
(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
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)
;;;
(and (> (length (buffer-name buffer)) 0)
(eq ?\ (aref (buffer-name buffer) 0))))
-;; Strip one hierarcy level from the end of PATH.
+;; Strip one hierarchy level from the end of PATH.
(defun msb--strip-path (path)
(save-match-data
(if (string-match "\\(.+\\)/[^/]+$" path)
(lambda (item)
(cond
((and path
- msb-max-menu-items
- (< (length buffers) msb-max-menu-items)
(string= path (car item)))
(push (cdr item) buffers)
nil)
(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))
(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)))
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)))))
;; 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))
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))
(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
(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.
"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
(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 within 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)
(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))
((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)
(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)))
(provide 'msb)
(eval-after-load 'msb (run-hooks 'msb-after-load-hooks))
;;; msb.el ends here
-
HCoop / bpt / emacs.git / blobdiff