diff options
author | Stephen Eglen <stephen@gnu.org> | 1998-02-15 16:45:52 +0000 |
---|---|---|
committer | Stephen Eglen <stephen@gnu.org> | 1998-02-15 16:45:52 +0000 |
commit | 3cfa0ee92f8a92958334f79f2dcba4ed35e5cc34 (patch) | |
tree | 298aaebd85026f650d5b3e3e4702e57f8854bd83 /lisp/msb.el | |
parent | 4d7ce99c2f1b855e3ea9f7f828ac1d7ceaaa46b4 (diff) | |
download | emacs-3cfa0ee92f8a92958334f79f2dcba4ed35e5cc34.tar.gz |
File customized.
(msb-modes-key): New variable.
(msb--mode-menu-cond, msb--aggregate-alist): New functions.
(msb--split-menus): Check if msb-max-file-menu-items is nil.
(msb--format-title): Remove extra / after ~.
(msb--choose-file-menu): Prevent looping when examining ange-ftp directory
paths.
Redundant (function ...) forms around lambda functions removed.
Update copyright year.
Diffstat (limited to 'lisp/msb.el')
-rw-r--r-- | lisp/msb.el | 499 |
1 files changed, 311 insertions, 188 deletions
diff --git a/lisp/msb.el b/lisp/msb.el index d70a5f46c8f..6c4e472ec9e 100644 --- a/lisp/msb.el +++ b/lisp/msb.el @@ -1,10 +1,10 @@ ;;; 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. @@ -48,7 +48,7 @@ ;; 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'. @@ -62,7 +62,7 @@ ;; 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: @@ -164,10 +164,10 @@ ;; 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 @@ -179,12 +179,12 @@ 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) @@ -210,20 +210,96 @@ ;;; 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 @@ -233,25 +309,40 @@ 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.") +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. @@ -267,7 +358,7 @@ function is called for items in the variable `msb-menu-cond' that have 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 @@ -277,67 +368,33 @@ like (ITEM-NAME . BUFFER). 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 @@ -467,37 +524,35 @@ If the argument is left out or nil, then the current buffer is considered." ;; ((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)))))) @@ -507,7 +562,7 @@ If the argument is left out or nil, then the current buffer is considered." (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))) @@ -526,7 +581,7 @@ If the argument is left out or nil, then the current buffer is considered." 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) @@ -576,8 +631,13 @@ If the argument is left out or nil, then the current buffer is considered." 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 @@ -599,11 +659,12 @@ If the argument is left out or nil, then the current buffer is considered." 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))) @@ -646,7 +707,7 @@ If the argument is left out or nil, then the current buffer is considered." )) ;; 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) @@ -693,9 +754,8 @@ If the argument is left out or nil, then the current buffer is considered." (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 @@ -723,6 +783,68 @@ If the argument is left out or nil, then the current buffer is considered." (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) @@ -756,13 +878,12 @@ If the argument is left out or nil, then the current buffer is considered." 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 @@ -776,37 +897,40 @@ If the argument is left out or nil, then the current buffer is considered." (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 @@ -831,8 +955,8 @@ If the argument is left out or nil, then the current buffer is considered." 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") @@ -907,7 +1031,7 @@ variable `msb-menu-cond'." choice) (t (error "Unknown form for buffer: %s" choice))))) - + ;; Add separators (defun msb--add-separators (sorted-list) (cond @@ -917,19 +1041,18 @@ variable `msb-menu-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) @@ -958,31 +1081,32 @@ variable `msb-menu-cond'." 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) @@ -1009,14 +1133,13 @@ variable `msb-menu-cond'." (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" |