;;; msb.el --- customizable buffer-selection with multiple menus
-;; Copyright (C) 1993, 94, 95, 97, 98, 99, 2000, 2001
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1994, 1995, 1997, 1998, 1999, 2000, 2001, 2002,
+;; 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Lars Lindberg <lars.lindberg@home.se>
;; Maintainer: FSF
;; 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, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; You should have received a copy of the GNU General Public License
;; 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.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; 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'.
-;;
+;;
;; 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.
"Elisp Files (%d)")
((eq major-mode 'latex-mode)
3030
- "LaTex Files (%d)")
+ "LaTeX Files (%d)")
('no-multi
3099
"Other files (%d)")))
-;; msb--many-menus is obsolete
-(defvar msb--many-menus msb--very-many-menus)
-
;;;
;;; Customizable variables
;;;
`save-match-data'.
The categories are sorted by MENU-SORT-KEY. Smaller keys are on top.
-nil means don't display this menu.
+A value of 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
+ITEM-HANDLING-FN is optional. If it is supplied and is a function,
+then 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.
+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
(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."
+split up in minor parts, 15 items each. A value of nil means no limit."
:type '(choice integer (const nil))
:set 'msb-custom-set
:group 'msb)
: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.")
"*The appearance of a buffer 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,
+item. It should take two 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.
(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.
This is instead of the groups in `msb-menu-cond'."
(defun msb-sort-by-directory (item1 item2)
"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))
- (save-excursion (set-buffer (cdr item2))
- (msb--dired-directory))))
+ (string-lessp (with-current-buffer (cdr item1)
+ (msb--dired-directory))
+ (with-current-buffer (cdr item2)
+ (msb--dired-directory))))
;;;
;;; msb
`msb-menu-cond' for more information about how the menus are split."
(interactive "e")
(let ((old-window (selected-window))
- (window (posn-window (event-start event))))
+ (window (posn-window (event-start event)))
+ early-release)
(unless (framep window) (select-window window))
+ ;; This `sit-for' magically makes the menu stay up if the mouse
+ ;; button is released within 0.1 second.
+ (setq early-release (not (sit-for 0.1 t)))
(let ((buffer (mouse-select-buffer event)))
(if buffer
(switch-to-buffer buffer)
- (select-window old-window))))
+ (select-window old-window)))
+ ;; If the above `sit-for' was interrupted by a mouse-up, avoid
+ ;; generating a drag event.
+ (if (and early-release (memq 'down (event-modifiers last-input-event)))
+ (discard-input)))
nil)
;;;
"Return t if optional BUFFER is an \"invisible\" buffer.
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))))
+ (eq ?\s (aref (buffer-name buffer) 0))))
(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
-;; directory will be in the same item as the directory string.
-;; ((PATH1 . (BUFFER-1 BUFFER-2 ...)) (PATH2 . (BUFFER-K BUFFER-K+1...)) ...)
+;; directory will be in the same item as the directory name.
+;; ((DIR1 . (BUFFER-1 BUFFER-2 ...)) (DIR2 . (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
+ ;; ((DIR-1 BUFFER-1) (DIR-2 BUFFER-2) ...)
+ ;; sorted on DIR-x
(sort
(apply #'nconc
(mapcar
list))
(lambda (item1 item2)
(string< (car item1) (car item2))))))
- ;; Now clump buffers together that have the same path
+ ;; Now clump buffers together that have the same directory name
;; Make alist that looks like
- ;; ((PATH1 . (BUFFER-1 BUFFER-2 ...)) (PATH2 . (BUFFER-K)) ...)
- (let ((path nil)
+ ;; ((DIR1 . (BUFFER-1 BUFFER-2 ...)) (DIR2 . (BUFFER-K)) ...)
+ (let ((dir nil)
(buffers nil))
(nconc
(apply
#'nconc
(mapcar (lambda (item)
(cond
- ((equal path (car item))
- ;; The same path as earlier: Add to current list of
- ;; buffers.
+ ((equal dir (car item))
+ ;; The same dir 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))
+ ;; New dir
+ (let ((result (and dir (cons dir buffers))))
+ (setq dir (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))))))
+ (list (cons dir buffers))))))
-(defun msb--format-title (top-found-p path number-of-items)
+(defun msb--format-title (top-found-p dir 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))
+ (abbreviate-file-name dir) number-of-items))
;; Variables for debugging.
(defvar msb--choose-file-menu-list)
msb-max-file-menu-items
10))
(top-found-p nil)
- (last-path nil)
- first rest path buffers old-path)
+ (last-dir nil)
+ first rest dir buffers old-dir)
;; Prepare for looping over all items in buffer-alist
(setq first (car buffer-alist)
rest (cdr buffer-alist)
- path (car first)
+ dir (car first)
buffers (cdr first))
(setq msb--choose-file-menu-list (copy-sequence 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.
+ ;; directory name of the buffers' visited files.
(while rest
(let ((found-p nil)
(tmp-rest rest)
- result
- new-path item)
+ item)
(setq item (car tmp-rest))
- ;; Clump together the "rest"-buffers that have a path that is
- ;; a subpath of the current one.
+ ;; Clump together the "rest"-buffers that have a dir that is
+ ;; a subdir of the current one.
(while (and tmp-rest
(<= (length buffers) max-clumped-together)
- (>= (length (car item)) (length path))
+ (>= (length (car item)) (length dir))
;; `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)
+ (eq t (compare-strings dir 0 nil
+ (car item) 0 (length dir)
completion-ignore-case)))
(setq found-p t)
(setq buffers (append buffers (cdr item))) ;nconc is faster than append
((> (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 last-dir (car first))
(push (cons (msb--format-title top-found-p
(car first)
(length (cdr first)))
(setq top-found-p nil)
(setq first (car rest)
rest (cdr rest)
- path (car first)
+ dir (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)
+ (setq first (cons dir buffers)
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
+ ;; If dir 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)
+ (setq old-dir dir)
+ (setq dir (msb--strip-dir dir)
buffers (cdr first))
- (if (equal old-path path)
- (setq last-path path))
- (when (and last-path
- (or (and (>= (length path) (length last-path))
+ (if (equal old-dir dir)
+ (setq last-dir dir))
+ (when (and last-dir
+ (or (and (>= (length dir) (length last-dir))
(eq t (compare-strings
- last-path 0 nil path 0
- (length last-path)
+ last-dir 0 nil dir 0
+ (length last-dir)
completion-ignore-case)))
- (and (< (length path) (length last-path))
+ (and (< (length dir) (length last-dir))
(eq t (compare-strings
- path 0 nil last-path 0 (length path)
+ dir 0 nil last-dir 0 (length dir)
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
(setq top-found-p nil)
(setq first (car rest)
rest (cdr rest)
- path (car first)
+ dir (car first)
buffers (cdr first)))))))
;; Now take care of the last item.
(when first
(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)
+\[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)
(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."
+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
max-buffer-name-length)
buffer)
(eval list-symbol)))))
-
+
(defsubst msb--choose-menu (buffer function-info-vector max-buffer-name-length)
"Select the appropriate menu for BUFFER."
;; This is all side-effects, folks!
(unless (and (not msb-display-invisible-buffers-p)
(msb-invisible-buffer-p buffer))
(condition-case nil
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
;; Menu found. Add to this menu
(dolist (info (msb--collect function-info-vector))
(msb--add-to-menu buffer info max-buffer-name-length)))
results in
\((a a1 a2 a4 a3) (b b1 b3 b2) (c c3))"
(when (not (null alist))
- (let (result
- same
+ (let (same
tmp-old-car
tmp-same
(first-time-p t)
old-car (car item))
(list (cons tmp-old-car (nreverse tmp-same))))))
(sort alist (lambda (item1 item2)
- (funcall sort-predicate (car item1) (car item2))))))
+ (funcall sort-predicate
+ (car item1) (car item2))))))
(list (cons old-car (nreverse same)))))))
(sort
(let ((mode-list nil))
(dolist (buffer (cdr (buffer-list)))
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(when (and (not (msb-invisible-buffer-p))
(not (assq major-mode mode-list)))
(push (cons major-mode mode-name)
(most-recently-used
(loop with n = 0
for buffer in buffers
- if (save-excursion
- (set-buffer buffer)
+ if (with-current-buffer buffer
(and (not (msb-invisible-buffer-p))
(not (eq major-mode 'dired-mode))))
- collect (save-excursion
- (set-buffer buffer)
+ collect (with-current-buffer buffer
(cons (funcall msb-item-handling-function
buffer
max-buffer-name-length)
(when file-buffers
(setq file-buffers
(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))))
+ (list* msb-files-by-directory-sort-key
+ (car buffer-list)
+ (sort
+ (mapcar (lambda (buffer)
+ (cons (with-current-buffer buffer
+ (funcall
+ msb-item-handling-function
+ buffer
+ max-buffer-name-length))
+ buffer))
+ (cdr buffer-list))
+ (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--create-buffer-menu-2))))
(defun msb--toggle-menu-type ()
- "Multi purpose function for selecting a buffer with the mouse."
+ "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,
;; 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
(mouse-select-buffer event))
((and (numberp (car choice))
(null (cdr choice)))
- (let ((msb--last-buffer-menu (nthcdr 3 (assq (car choice)
+ (let ((msb--last-buffer-menu (nthcdr 2 (assq (car choice)
msb--last-buffer-menu))))
(mouse-select-buffer event)))
((while (numberp (car choice))
buffers-menu frames-menu)
;; Make the menu of buffers proper.
(setq msb--last-buffer-menu (msb--create-buffer-menu))
- (setq buffers-menu msb--last-buffer-menu)
+ ;; Skip the `keymap' symbol.
+ (setq buffers-menu (cdr msb--last-buffer-menu))
;; Make a Frames menu if we have more than one frame.
(when (cdr frames)
(let* ((frame-length (length frames))
(mapcar
(lambda (frame)
(nconc
- (list frame
- (cdr (assq 'name
- (frame-parameters frame)))
+ (list (frame-parameter frame 'name)
+ (frame-parameter frame 'name)
(cons nil nil))
'menu-bar-select-frame))
frames)))))
- (define-key (current-global-map) [menu-bar buffer]
- (cons "Buffers"
+ (setcdr global-buffers-menu-map
(if (and buffers-menu frames-menu)
;; Combine Frame and Buffers menus with separator between
- (nconc (list 'keymap "Buffers and Frames" frames-menu
+ (nconc (list "Buffers and Frames" frames-menu
(and msb-separator-diff '(separator "--")))
- (cddr buffers-menu))
- (or buffers-menu 'undefined)))))))
+ (cdr buffers-menu))
+ buffers-menu)))))
;; Snarf current bindings of `mouse-buffer-menu' (normally
;; C-down-mouse-1).
(defvar msb-mode-map
(let ((map (make-sparse-keymap "Msb")))
- (substitute-key-definition 'mouse-buffer-menu 'msb map global-map)
+ (define-key map [remap mouse-buffer-menu] 'msb)
map))
;;;###autoload
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'."
- :global t
+ :global t :group 'msb
(if msb-mode
(progn
(add-hook 'menu-bar-update-hook 'msb-menu-bar-update-buffers)
(defun msb-unload-hook ()
(msb-mode 0))
+(add-hook 'msb-unload-hook 'msb-unload-hook)
(provide 'msb)
(eval-after-load "msb" '(run-hooks 'msb-after-load-hook 'msb-after-load-hooks))
+;; arch-tag: 403f9e82-b92e-4e7a-a797-5d6d9b76da36
;;; msb.el ends here