X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/25bb0401ab464bc0c2e68268f50d365aa3187aec..3c53a3cf83c218772d9bcfde4cd60c1face33e93:/lisp/msb.el

diff --git a/lisp/msb.el b/lisp/msb.el
index fface2e29b..822b1e4042 100644
--- a/lisp/msb.el
+++ b/lisp/msb.el
@@ -1,6 +1,7 @@
-;;; msb.el --- Customizable buffer-selection with multiple menus.
+;;; 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, 2001
+;;  Free Software Foundation, Inc.
 
 ;; Author: Lars Lindberg <Lars.G.Lindberg@capgemini.se>
 ;; Maintainer: FSF
@@ -108,16 +109,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 +160,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)")
@@ -209,19 +202,6 @@
   :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)
@@ -302,7 +282,7 @@ that differs by this value or more."
 (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.  nil means no limit."
   :type '(choice integer (const nil))
   :set 'msb-custom-set
   :group 'msb)
@@ -381,8 +361,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.
@@ -391,8 +370,8 @@ This is instead of the groups in `msb-menu-cond'."
   :set 'msb-custom-set
   :group 'msb)
 
-(defcustom msb-after-load-hooks nil
-  "Hooks to be run after the msb package has been loaded."
+(defcustom msb-after-load-hook nil
+  "Hook run after the msb package has been loaded."
   :type 'hook
   :set 'msb-custom-set
   :group 'msb)
@@ -524,37 +503,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 +566,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 +671,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 +790,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 +809,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 +950,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 +1002,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 +1017,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 +1046,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 +1078,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,33 +1132,30 @@ 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)))
-    (mapcar (lambda (key)
-	      (define-key map key #'msb))
-	    (where-is-internal 'mouse-buffer-menu (make-sparse-keymap)))
+  (let ((map (make-sparse-keymap "Msb")))
+    (substitute-key-definition 'mouse-buffer-menu 'msb map global-map)
     map))
 
 ;;;###autoload
-(defun msb-mode (&optional arg)
+(define-minor-mode msb-mode
   "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)))
+  :global t
   (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 'menu-bar-update-buffers)
+	(msb-menu-bar-update-buffers t))
     (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))
+    (add-hook 'menu-bar-update-hook 'menu-bar-update-buffers)
+    (menu-bar-update-buffers t)))
 
-(add-to-list 'minor-mode-map-alist (cons 'msb-mode msb-mode-map))
+(defun msb-unload-hook ()
+  (msb-mode 0))
 
 (provide 'msb)
-(eval-after-load 'msb (run-hooks 'msb-after-load-hooks))
+(eval-after-load "msb" '(run-hooks 'msb-after-load-hook 'msb-after-load-hooks))
 
 ;;; msb.el ends here