Mercurial > emacs

changeset 30800:aa5afea93d8a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(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.
author Dave Love <fx@gnu.org>
date Tue, 15 Aug 2000 11:19:13 +0000
parents eef673503486
children 03dc1bdbddec
files lisp/msb.el
diffstat 1 files changed, 87 insertions(+), 91 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/msb.el	Tue Aug 15 11:18:38 2000 +0000
+++ b/lisp/msb.el	Tue Aug 15 11:19:13 2000 +0000
@@ -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 @@
 		 (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 @@
 	 ;; 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 @@
 	  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 @@
 	 (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 @@
 	  (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 @@
 			 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 @@
        (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 @@
       (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 @@
 
 ;; 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 @@
       (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 @@
 	((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 @@
 ;; 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 @@
     (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)