;;; msb.el --- Customizable buffer-selection with multiple menus.
-;; Copyright (C) 1993, 1994, 1995, 1997 Free Software Foundation, Inc.
+;; 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.33
+;; Lindberg's last update version: 3.34
;; Keywords: mouse buffer menu
;; This file is part of GNU Emacs.
;; There are some constants for you to try here:
;; msb--few-menus
;; msb--very-many-menus (default)
-;;
+;;
;; 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'.
;; Known bugs:
;; - Files-by-directory
;; + No possibility to show client/changed buffers separately.
-;; + All file buffers only appear in in a file sub-menu, they will
+;; + All file buffers only appear in a file sub-menu, they will
;; for instance not appear in the Mail sub-menu.
;; Future enhancements:
;; 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 rmail-edit-mode vm-summary-mode vm-mode mail-mode))
(memq major-mode '(mh-letter-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)
+
+(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.")
+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.")
-(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. If nil, there is no limit.")
+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
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 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.
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-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.")
+the groups in msb-menu-cond."
+ :type 'boolean
+ :set 'msb-custom-set
+ :group 'msb)
-(defvar 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].")
-
-(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
-(defvar msb--home-dir
+(defconst msb--home-dir
(condition-case nil
(substitute-in-file-name "$HOME")
;; If $HOME isn't defined, use nil
;; ((PATH-1 BUFFER-1) (PATH-2 BUFFER-2) ...)
;; sorted on PATH-x
(sort (mapcan
- (function
- (lambda (buffer)
- (let ((file-name (expand-file-name (buffer-file-name buffer))))
- (when file-name
- (list (cons (msb--strip-dir 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))
(nconc
- (mapcan (function
- (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
- ;; 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)))))))
+ (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
+ ;; 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))))))
(let ((new-path path))
(when (and msb--home-dir
(string-match (concat "^" msb--home-dir) path))
- (setq new-path (concat "~/"
+ (setq new-path (concat "~"
(substring path (match-end 0)))))
(format (if top-found-p "%s... (%d)" "%s (%d)")
new-path number-of-items)))
10))
(top-found-p nil)
(last-path nil)
- first rest path buffers)
+ first rest path buffers old-path)
;; Prepare for looping over all items in buffer-alist
(setq first (car buffer-alist)
rest (cdr buffer-alist)
rest tmp-rest))
;; 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
path (car first)
buffers (cdr first)))))))
;; Now take care of the last item.
- (push (cons (msb--format-title top-found-p
- (car first)
- (length (cdr first)))
- (cdr first))
- final-list)
+ (when first
+ (push (cons (msb--format-title top-found-p
+ (car first)
+ (length (cdr first)))
+ (cdr first))
+ final-list))
(setq top-found-p nil)
(nreverse final-list)))
))
;; 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)
(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
(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)
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
(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)
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")
choice)
(t
(error "Unknown form for buffer: %s" choice)))))
-
+
;; Add separators
(defun msb--add-separators (sorted-list)
(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)
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))))
- (nconc (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)
(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)))
+ (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"
projects / emacs.git / commitdiff