;;; msb.el --- Customizable buffer-selection with multiple menus.
-;; Copyright (C) 1993, 1994, 1995, 1997, 1998 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 94, 95, 97, 98, 99 Free Software Foundation, Inc.
;; Author: Lars Lindberg <Lars.G.Lindberg@capgemini.se>
+;; Maintainer: FSF
;; Created: 8 Oct 1993
;; Lindberg's last update version: 3.34
;; Keywords: mouse buffer menu
;; 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:
-
-;; 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.
+;; 2. Make a better mouse-buffer-menu. This is done as a global
+;; minor mode, msb-mode.
;;
;; Customization:
;; Look at the variable `msb-menu-cond' for deciding what menus you
;; 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>
+;; Richard Stallman <rms@gnu.org>
;; Steve Fisk <fisk@medved.bowdoin.edu>
+;; This version turned into a global minor mode and subsequently
+;; hacked on by Dave Love.
;;; Code:
-(require 'cl)
+(eval-when-compile (require 'cl))
;;;
;;; Some example constants to be used for `msb-menu-cond'. See that
((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
((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
:prefix "msb-"
:group 'mouse)
+;;;###autoload
+(defcustom msb-mode nil
+ "Toggle msb-mode.
+Setting this variable directly does not take effect;
+use either \\[customize] or the function `msb-mode'."
+ :set (lambda (symbol value)
+ (msb-mode (or value 0)))
+ :initialize 'custom-initialize-default
+ :version "20.4"
+ :type 'boolean
+ :group 'msb
+ :require 'msb)
+
(defun msb-custom-set (symbol value)
"Set the value of custom variables for msb."
(set symbol value)
- (if (featurep 'msb)
+ (if (and (featurep 'msb) msb-mode)
;; wait until package has been loaded before bothering to update
;; the buffer lists.
- (menu-bar-update-buffers t))
-)
+ (msb-menu-bar-update-buffers t)))
(defcustom msb-menu-cond msb--very-many-menus
"*List of criteria for splitting the mouse buffer menu.
(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
+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.
)
(defcustom msb-files-by-directory nil
- "*Non-nil means that files should be sorted by directory instead of
-the groups in msb-menu-cond."
+ "*Non-nil means that files should be sorted by directory.
+This is instead of the groups in `msb-menu-cond'."
:type 'boolean
: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)
;;; 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
-An item look like (NAME . BUFFER)."
+ "Sort the items ITEM1 and ITEM2 by their `buffer-name'.
+An item looks like (NAME . BUFFER)."
(string-lessp (buffer-name (cdr item1))
(buffer-name (cdr item2))))
(defun msb-sort-by-directory (item1 item2)
- "Sorts the items depending on their directory. Made for dired.
+ "Sort the items ITEM1 and ITEM2 by directory name. Made for dired.
An item look like (NAME . BUFFER)."
(string-lessp (save-excursion (set-buffer (cdr item1))
(msb--dired-directory))
(and (> (length (buffer-name buffer)) 0)
(eq ?\ (aref (buffer-name buffer) 0))))
-;; Strip one hierarchy level from the end of DIR.
(defun msb--strip-dir (dir)
+ "Strip one hierarchy level from the end of DIR."
(file-name-directory (directory-file-name dir)))
;; Create an alist with all buffers from LIST that lies under the same
;; Make alist that looks like
;; ((PATH-1 BUFFER-1) (PATH-2 BUFFER-2) ...)
;; sorted on PATH-x
- (sort (mapcan
+ (sort (mapcar
(lambda (buffer)
(let ((file-name (expand-file-name (buffer-file-name buffer))))
(when file-name
(let ((path nil)
(buffers nil))
(nconc
- (mapcan (lambda (item)
+ (mapcar (lambda (item)
(cond
((and path
(string= path (car item)))
;; 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)))
+ "Format a suitable title for the menu item."
+ (format (if top-found-p "%s... (%d)" "%s (%d)")
+ (abbreviate-file-name 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)
+ "Choose file-menu with respect to directory for every buffer in LIST."
(setq msb--choose-file-menu-arg-list list)
(let ((buffer-alist (msb--init-file-alist list))
(final-list nil)
rest (cdr buffer-alist)
path (car first)
buffers (cdr first))
- (setq msb--choose-file-menu-list (copy-list rest))
+ (setq msb--choose-file-menu-list (apply #'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 (and tmp-rest
(<= (length buffers) max-clumped-together)
(>= (length (car item)) (length path))
- (string= path (substring (car item) 0 (length path))))
+ ;; `completion-ignore-case' seems to default to t
+ ;; on the systems with case-insensitive file names.
+ (eq t (compare-strings path 0 nil
+ (car item) 0 (length path)
+ completion-ignore-case)))
(setq found-p t)
(setq buffers (append buffers (cdr item))) ;nconc is faster than append
(setq tmp-rest (cdr tmp-rest)
(setq last-path path))
(when (and last-path
(or (and (>= (length path) (length last-path))
- (string= last-path
- (substring path 0 (length last-path))))
+ (eq t (compare-strings
+ last-path 0 nil path 0
+ (length last-path)
+ completion-ignore-case)))
(and (< (length path) (length last-path))
- (string= path
- (substring last-path 0 (length path))))))
+ (eq t (compare-strings
+ path 0 nil last-path 0 (length path)
+ completion-ignore-case)))))
;; 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.
(setq top-found-p nil)
(nreverse final-list)))
-;; Create a vector as:
-;; [BUFFER-LIST-VARIABLE CONDITION MENU-SORT-KEY MENU-TITLE ITEM-HANDLER SORTER)
-;; from an element in `msb-menu-cond'. See that variable for a
-;; description of its elements.
(defun msb--create-function-info (menu-cond-elt)
+ "Create a vector from an element MENU-COND-ELT of `msb-menu-cond'.
+This takes the form:
+\]BUFFER-LIST-VARIABLE CONDITION MENU-SORT-KEY MENU-TITLE ITEM-HANDLER SORTER)
+See `msb-menu-cond' for a description of its elements."
(let* ((list-symbol (make-symbol "-msb-buffer-list"))
(tmp-ih (and (> (length menu-cond-elt) 3)
(nth 3 menu-cond-elt)))
tmp-s
msb-item-sort-function)))
(when (< (length menu-cond-elt) 3)
- (error "Wrong format of msb-menu-cond."))
+ (error "Wrong format of msb-menu-cond"))
(when (and (> (length menu-cond-elt) 3)
(not (fboundp tmp-ih)))
(signal 'invalid-function (list tmp-ih)))
(error "No catch-all in msb-menu-cond!"))
function-info-list))
-;; Adds BUFFER to the menu depicted by FUNCTION-INFO
-;; All side-effects. Adds an element of form (BUFFER-TITLE . BUFFER)
-;; to the buffer-list variable in function-info.
(defun msb--add-to-menu (buffer function-info max-buffer-name-length)
+ "Add BUFFER to the menu depicted by FUNCTION-INFO.
+All side-effects. Adds an element of form (BUFFER-TITLE . BUFFER)
+to the buffer-list variable in function-info."
(let ((list-symbol (aref function-info 0))) ;BUFFER-LIST-VARIABLE
;; Here comes the hairy side-effect!
(set list-symbol
buffer)
(eval list-symbol)))))
-;; Selects the appropriate menu for BUFFER.
-;; This is all side-effects, folks!
-;; This should be optimized.
(defsubst msb--choose-menu (buffer function-info-vector max-buffer-name-length)
+ "Select the appropriate menu for BUFFER."
+ ;; This is all side-effects, folks!
+ ;; This should be optimized.
(unless (and (not msb-display-invisible-buffers-p)
(msb-invisible-buffer-p buffer))
(condition-case nil
(save-excursion
(set-buffer buffer)
;; Menu found. Add to this menu
- (mapc (lambda (function-info)
- (msb--add-to-menu buffer function-info max-buffer-name-length))
- (msb--collect function-info-vector)))
+ (dolist (info (msb--collect function-info-vector))
+ (msb--add-to-menu buffer info max-buffer-name-length)))
(error (unless msb--error
(setq msb--error
(format
(buffer-name buffer)))
(error "%s" msb--error))))))
-;; Return (SORT-KEY TITLE . BUFFER-LIST) or nil if the
-;; buffer-list is empty.
(defun msb--create-sort-item (function-info)
+ "Return (SORT-KEY TITLE . BUFFER-LIST) or nil if the buffer-list is empty."
(let ((buffer-list (eval (aref function-info 0))))
(when buffer-list
(let ((sorter (aref function-info 5)) ;SORTER
(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)
+ "Return ALIST as a sorted, aggregated alist.
+
+In the result 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))"
(when (not (null alist))
(let (result
same
(first-time-p t)
old-car)
(nconc
- (mapcan (lambda (item)
+ (mapcar (lambda (item)
(cond
(first-time-p
(push (cdr item) same)
(list `( eq major-mode (quote ,(car item)))
key
(concat (cdr item) " (%d)")))
- (sort
+ (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)))
+ (dolist (buffer (cdr (buffer-list)))
+ (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))))
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)
+ "Return a list for the most recently used buffers.
+It takes the form ((TITLE . BUFFER-LIST)...)."
(when (and (numberp msb-display-most-recently-used)
(> msb-display-most-recently-used 0))
(let* ((buffers (cdr (buffer-list)))
file-buffers
function-info-vector)
;; Calculate the longest buffer name.
- (mapc
- (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))
+ (dolist (buffer (buffer-list))
+ (when (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))))))
;; Make a list with elements of type
;; (BUFFER-LIST-VARIABLE
;; CONDITION
(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 (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))
+ (dolist (buffer (buffer-list))
+ (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))))
(when file-buffers
(setq file-buffers
(mapcar (lambda (buffer-list)
(save-excursion
(msb--create-buffer-menu-2))))
-;;;
-;;; Multi purpose function for selecting a buffer with the mouse.
-;;;
(defun msb--toggle-menu-type ()
+ "Multi purpose function for selecting a buffer with the mouse."
(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))
+ (msb-menu-bar-update-buffers t))
(defun mouse-select-buffer (event)
"Pop up several menus of buffers, for selection with the mouse.
sorted-list)
(t
(let ((last-key nil))
- (mapcan
+ (mapcar
(lambda (item)
(cond
((and msb-separator-diff
- last-key
+ last-key
(> (- (car item) last-key)
msb-separator-diff))
(setq last-key (car item))
(mcount 0))
(mapcar
(lambda (sub-menu)
- (cond
+ (cond
((eq 'separator sub-menu)
(list 'separator "--"))
(t
(msb--split-menus buffers))))))
raw-menu)))
-(defun menu-bar-update-buffers (&optional arg)
+(defun msb-menu-bar-update-buffers (&optional arg)
+ "A re-written version of `menu-bar-update-buffers'."
;; If user discards the Buffers item, play along.
(when (and (lookup-key (current-global-map) [menu-bar buffer])
(or (not (fboundp 'frame-or-buffer-changed-p))
(cddr buffers-menu))
(or buffers-menu 'undefined)))))))
-(when (and (boundp 'menu-bar-update-hook)
- (not (fboundp 'frame-or-buffer-changed-p)))
- (defvar msb--buffer-count 0)
- (defun frame-or-buffer-changed-p ()
- (let ((count (length (buffer-list))))
- (when (/= count msb--buffer-count)
- (setq msb--buffer-count count)
- t))))
-
-(unless (or (not (boundp 'menu-bar-update-hook))
- (memq 'menu-bar-update-buffers menu-bar-update-hook))
+;; Snarf current bindings of `mouse-buffer-menu' (normally
+;; C-down-mouse-1).
+(defvar msb-mode-map
+ (let ((map (make-sparse-keymap)))
+ (mapcar (lambda (key)
+ (define-key map key #'msb))
+ (where-is-internal 'mouse-buffer-menu (make-sparse-keymap)))
+ map))
+
+;;;###autoload
+(defun msb-mode (&optional arg)
+ "Toggle Msb mode.
+With arg, turn Msb mode on if and only if arg is positive.
+This mode overrides the binding(s) of `mouse-buffer-menu' to provide a
+different buffer menu using the function `msb'."
+ (interactive "P")
+ (setq msb-mode (if arg
+ (> (prefix-numeric-value arg) 0)
+ (not msb-mode)))
+ (if msb-mode
+ (progn
+ (add-hook 'menu-bar-update-hook 'msb-menu-bar-update-buffers)
+ (remove-hook 'menu-bar-update-hook 'menu-bar-update-buffers))
+ (remove-hook 'menu-bar-update-hook 'msb-menu-bar-update-buffers)
(add-hook 'menu-bar-update-hook 'menu-bar-update-buffers))
+ (run-hooks 'menu-bar-update-hook))
-(and (fboundp 'mouse-buffer-menu)
- (substitute-key-definition 'mouse-buffer-menu 'msb (current-global-map)))
+(add-to-list 'minor-mode-map-alist (cons 'msb-mode msb-mode-map))
(provide 'msb)
(eval-after-load 'msb (run-hooks 'msb-after-load-hooks))