X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/f9e9ac1ddebce30fd644f9c854edfbc40a93d4d5..f52154007f41abe6857acab91e31ab4a7d18210d:/lisp/msb.el diff --git a/lisp/msb.el b/lisp/msb.el index 95d0fc1b30..ebdee96515 100644 --- a/lisp/msb.el +++ b/lisp/msb.el @@ -1,8 +1,9 @@ ;;; 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 +;; Maintainer: FSF ;; Created: 8 Oct 1993 ;; Lindberg's last update version: 3.34 ;; Keywords: mouse buffer menu @@ -29,17 +30,8 @@ ;; 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 @@ -80,12 +72,14 @@ ;; Alon Albert ;; Kevin Broadey, ;; Ake Stenhof -;; Richard Stallman +;; Richard Stallman ;; Steve Fisk +;; 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 @@ -117,7 +111,7 @@ ((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 @@ -172,7 +166,7 @@ ((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 @@ -215,14 +209,26 @@ :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. @@ -230,7 +236,7 @@ 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 +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. @@ -378,8 +384,8 @@ Set this to nil or t if you don't want any sorting (faster)." ) (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) @@ -394,13 +400,6 @@ the groups in msb-menu-cond." ;;; 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) @@ -466,14 +465,14 @@ The `#' appears only version control file (SCCS/RCS)." ;;; 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)) @@ -512,8 +511,8 @@ 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)))) -;; 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 @@ -524,7 +523,7 @@ If the argument is left out or nil, then the current buffer is considered." ;; 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 @@ -538,7 +537,7 @@ If the argument is left out or nil, then the current buffer is considered." (let ((path nil) (buffers nil)) (nconc - (mapcan (lambda (item) + (mapcar (lambda (item) (cond ((and path (string= path (car item))) @@ -558,22 +557,17 @@ If the argument is left out or nil, then the current buffer is considered." ;; 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) @@ -588,7 +582,7 @@ If the argument is left out or nil, then the current buffer is considered." 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. @@ -603,7 +597,11 @@ If the argument is left out or nil, then the current buffer is considered." (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) @@ -641,11 +639,14 @@ If the argument is left out or nil, then the current buffer is considered." (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. @@ -669,11 +670,11 @@ If the argument is left out or nil, then the current buffer is considered." (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))) @@ -689,7 +690,7 @@ If the argument is left out or nil, then the current buffer is considered." 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))) @@ -732,10 +733,10 @@ If the argument is left out or nil, then the current buffer is considered." (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 @@ -745,19 +746,18 @@ If the argument is left out or nil, then the current buffer is considered." 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 @@ -765,9 +765,8 @@ If the argument is left out or nil, then the current buffer is considered." (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 @@ -784,18 +783,21 @@ 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) + "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 @@ -804,7 +806,7 @@ If the argument is left out or nil, then the current buffer is considered." (first-time-p t) old-car) (nconc - (mapcan (lambda (item) + (mapcar (lambda (item) (cond (first-time-p (push (cdr item) same) @@ -832,23 +834,22 @@ If the argument is left out or nil, then the current buffer is considered." (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))) @@ -878,14 +879,11 @@ If the argument is left out or nil, then the current buffer is considered." 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 @@ -901,19 +899,18 @@ If the argument is left out or nil, then the current buffer is considered." (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) @@ -976,15 +973,13 @@ If the argument is left out or nil, then the current buffer is considered." (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. @@ -1041,11 +1036,11 @@ variable `msb-menu-cond'." 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)) @@ -1094,7 +1089,7 @@ variable `msb-menu-cond'." (mcount 0)) (mapcar (lambda (sub-menu) - (cond + (cond ((eq 'separator sub-menu) (list 'separator "--")) (t @@ -1110,7 +1105,8 @@ variable `msb-menu-cond'." (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)) @@ -1151,21 +1147,34 @@ variable `msb-menu-cond'." (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))