(msb--few-menus, msb--very-many-menus): Use current Gnus

modes.
(msb--init-file-alist, msb--aggregate-alist, msb--add-separators):
Fix previous change to mapcan.
(msb--init-file-alist, msb--add-separators)
(msb--make-keymap-menu): Simplify.
(msb--choose-file-menu): Use copy-sequence.
(msb-mode-map): Add title to keymap.
(msb-unload-hook): New function.

diff --git a/lisp/msb.el b/lisp/msb.el
index fface2e29b480c9668431f77c097397c62362ada..463d6edbc8fcee0a1ea07df75f175b76da649b2d 100644 (file)
--- a/lisp/msb.el
+++ b/lisp/msb.el
@@ -1,6 +1,6 @@
 ;;; msb.el --- Customizable buffer-selection with multiple menus.
 
-;; Copyright (C) 1993, 94, 95, 97, 98, 99 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 94, 95, 97, 98, 99, 2000 Free Software Foundation, Inc.
 
 ;; Author: Lars Lindberg <Lars.G.Lindberg@capgemini.se>
 ;; Maintainer: FSF
@@ -108,16 +108,12 @@
     ((eq major-mode 'w3-mode)
      4020
      "WWW (%d)")
-    ((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))
-        (memq major-mode '(gnus-summary-mode
-                           news-reply-mode
-                           gnus-group-mode
-                           gnus-article-mode
-                           gnus-kill-file-mode
-                           gnus-browse-killed-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))
+        (memq major-mode
+              '(gnus-summary-mode message-mode gnus-group-mode
+                gnus-article-mode score-mode gnus-browse-killed-mode)))
      4010
      "Mail (%d)")
     ((not buffer-file-name)
@@ -163,15 +159,11 @@
     ((eq major-mode 'w3-mode)
      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
-                           mh-show-mode
-                           mh-folder-mode))
-        (memq major-mode '(gnus-summary-mode
-                           news-reply-mode
-                           gnus-group-mode
-                           gnus-article-mode
-                           gnus-kill-file-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))
+        (memq major-mode '(gnus-summary-mode message-mode gnus-group-mode
+                           gnus-article-mode score-mode
                            gnus-browse-killed-mode)))
      5010
      "Mail (%d)")
@@ -381,8 +373,7 @@ Set this to nil or t if you don't want any sorting (faster)."
                 (const :tag "Newest first" t)
                 (const :tag "Oldest first" nil))
   :set 'msb-custom-set
-  :group 'msb
-)
+  :group 'msb)
                
 (defcustom msb-files-by-directory nil
   "*Non-nil means that files should be sorted by directory.
@@ -524,37 +515,41 @@ 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 (mapcar
-               (lambda (buffer)
-                 (let ((file-name (expand-file-name (buffer-file-name buffer))))
-                   (when file-name
-                     (list (cons (msb--strip-dir file-name) buffer)))))
-               list)
-              (lambda (item1 item2)
-                (string< (car item1) (car item2))))))
+        (sort
+         (apply #'nconc
+                (mapcar
+                 (lambda (buffer)
+                   (let ((file-name (expand-file-name
+                                     (buffer-file-name buffer))))
+                     (when file-name
+                       (list (cons (msb--strip-dir file-name) buffer)))))
+                 list))
+         (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
-       (mapcar (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)
+       (apply
+       #'nconc
+       (mapcar (lambda (item)
+                 (cond
+                  ((equal 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))))))
 
@@ -583,7 +578,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 (apply #'list rest))
+    (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.
@@ -688,7 +683,7 @@ See `msb-menu-cond' for a description of its elements."
         (sorter (if (or (fboundp tmp-s)
                         (null tmp-s)
                         (eq tmp-s t))
-                   tmp-s
+                    tmp-s
                   msb-item-sort-function)))
     (when (< (length menu-cond-elt) 3)
       (error "Wrong format of msb-menu-cond"))
@@ -807,7 +802,9 @@ results in
          (first-time-p t)
          old-car)
       (nconc
-       (mapcar (lambda (item)
+       (apply #'nconc
+             (mapcar
+              (lambda (item)
                 (cond
                  (first-time-p
                   (push (cdr item) same)
@@ -824,7 +821,7 @@ results in
                         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)))))))
 
 
@@ -965,9 +962,9 @@ It takes the form ((TITLE . BUFFER-LIST)...)."
        (list (cons 'toggle
                   (cons
                   (if msb-files-by-directory
-                      "*Files by type*"
-                    "*Files by directory*")
-                  'msb--toggle-menu-type)))))))
+                              "*Files by type*"
+                            "*Files by directory*")
+                          'msb--toggle-menu-type)))))))
 
 (defun msb--create-buffer-menu  ()
   (save-match-data
@@ -1017,7 +1014,8 @@ variable `msb-menu-cond'."
       (mouse-select-buffer event))
      ((and (numberp (car choice))
           (null (cdr choice)))
-      (let ((msb--last-buffer-menu (nthcdr 3 (assq (car choice) msb--last-buffer-menu))))
+      (let ((msb--last-buffer-menu (nthcdr 3 (assq (car choice)
+                                                  msb--last-buffer-menu))))
        (mouse-select-buffer event)))
      ((while (numberp (car choice))
        (setq choice (cdr choice))))
@@ -1031,26 +1029,25 @@ variable `msb-menu-cond'."
 
 ;; Add separators
 (defun msb--add-separators (sorted-list)
-  (cond
-   ((or (not msb-separator-diff)
-       (not (numberp msb-separator-diff)))
-    sorted-list)
-   (t
+  (if (or (not msb-separator-diff)
+         (not (numberp msb-separator-diff)))
+      sorted-list
     (let ((last-key nil))
-      (mapcar
-       (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)))))
+      (apply #'nconc
+            (mapcar
+             (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)
   (cond
@@ -1061,22 +1058,21 @@ variable `msb-menu-cond'."
       (while (< count msb-max-menu-items)
        (push (pop list) tmp-list)
        (incf count))
-    (setq tmp-list (nreverse tmp-list))
-    (setq sub-name (concat (car (car tmp-list)) "..."))
-    (push (nconc (list mcount sub-name
-                      'keymap sub-name)
-                 tmp-list)
-         result))
+      (setq tmp-list (nreverse tmp-list))
+      (setq sub-name (concat (car (car tmp-list)) "..."))
+      (push (nconc (list mcount sub-name
+                        'keymap sub-name)
+                  tmp-list)
+           result))
     (msb--split-menus-2 list (1+ mcount) result))
    ((null result)
     list)
    (t
     (let (sub-name)
       (setq sub-name (concat (car (car list)) "..."))
-      (push (nconc (list mcount sub-name
-                        'keymap sub-name)
-                 list)
-         result))
+      (push (nconc (list mcount sub-name 'keymap sub-name)
+                  list)
+           result))
     (nreverse result))))
 
 (defun msb--split-menus (list)
@@ -1094,12 +1090,9 @@ variable `msb-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)))))
+        (let ((buffers (mapcar (lambda (item)
+                                 (cons (buffer-name (cdr item))
+                                       (cons (car item) end)))
                                (cdr sub-menu))))
           (nconc (list (incf mcount) (car sub-menu)
                        'keymap (car sub-menu))
@@ -1151,7 +1144,7 @@ variable `msb-menu-cond'."
 ;; Snarf current bindings of `mouse-buffer-menu' (normally
 ;; C-down-mouse-1).
 (defvar msb-mode-map
-  (let ((map (make-sparse-keymap)))
+  (let ((map (make-sparse-keymap "Msb")))
     (mapcar (lambda (key)
              (define-key map key #'msb))
            (where-is-internal 'mouse-buffer-menu (make-sparse-keymap)))
@@ -1175,6 +1168,9 @@ different buffer menu using the function `msb'."
     (add-hook 'menu-bar-update-hook 'menu-bar-update-buffers))
   (run-hooks 'menu-bar-update-hook))
 
+(defun msb-unload-hook ()
+  (msb-mode 0))
+
 (add-to-list 'minor-mode-map-alist (cons 'msb-mode msb-mode-map))
 
 (provide 'msb)