comparison lisp/msb.el @ 91073:4bc33ffdda1a

Merge from emacs--devo--0 Patches applied: * emacs--devo--0 (patch 902-908) - Update from CVS - Merge from emacs--rel--22 * emacs--rel--22 (patch 131-137) - Update from CVS - Merge from gnus--rel--5.10 * gnus--rel--5.10 (patch 261-262) - Update from CVS Revision: [e-mail]/emacs--unicode--0--patch-278

91072:74ab3ea909f9

(defun msb-sort-by-directory (item1 item2)
  "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))
		(save-excursion (set-buffer (cdr item2))
				(msb--dired-directory))))

;;;
;;; msb
;;;
;;; This function can be used instead of (mouse-buffer-menu EVENT)

    ;; similar name. Remember that buffer-alist is sorted based on the
    ;; directory name of the buffers' visited files.
    (while rest
      (let ((found-p nil)
	    (tmp-rest rest)
	    result
	    new-dir item)
	(setq item (car tmp-rest))
	;; Clump together the "rest"-buffers that have a dir that is
	;; a subdir of the current one.
	(while (and tmp-rest
		    (<= (length buffers) max-clumped-together)

  ;; 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
	  (dolist (info (msb--collect function-info-vector))
	    (msb--add-to-menu buffer info max-buffer-name-length)))
      (error (unless msb--error
	       (setq msb--error

 (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
	  tmp-old-car
	  tmp-same
	  (first-time-p t)
	  old-car)
      (nconc

			 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))

		    key
		    (concat (cdr item) " (%d)")))
	    (sort
	     (let ((mode-list nil))
	       (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)

 	     (> msb-display-most-recently-used 0))
    (let* ((buffers (cdr (buffer-list)))
	   (most-recently-used
	    (loop with n = 0
		  for buffer in buffers
		  if (save-excursion
		       (set-buffer buffer)
		       (and (not (msb-invisible-buffer-p))
			    (not (eq major-mode 'dired-mode))))
		  collect (save-excursion
			    (set-buffer buffer)
			    (cons (funcall msb-item-handling-function
					   buffer
					   max-buffer-name-length)
				  buffer))
		  and do (incf n)

			       function-info-vector
			       max-buffer-name-length))))
    (when file-buffers
      (setq file-buffers
	    (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
	   (most-recently-used
	    (msb--most-recently-used-menu max-buffer-name-length))
	   (others (nconc file-buffers

		 arg))
    (let ((frames (frame-list))
	  buffers-menu frames-menu)
      ;; Make the menu of buffers proper.
      (setq msb--last-buffer-menu (msb--create-buffer-menu))
      (setq buffers-menu msb--last-buffer-menu)
      ;; Make a Frames menu if we have more than one frame.
      (when (cdr frames)
	(let* ((frame-length (length frames))
	       (f-title  (format "Frames (%d)" frame-length)))
	  ;; List only the N most recently selected frames

		     (list (frame-parameter frame 'name)
			   (frame-parameter frame 'name)
			   (cons nil nil))
		     'menu-bar-select-frame))
		  frames)))))
      (define-key (current-global-map) [menu-bar buffer]
	(cons "Buffers"
	      (if (and buffers-menu frames-menu)
		  ;; Combine Frame and Buffers menus with separator between
		  (nconc (list 'keymap "Buffers and Frames" frames-menu
			       (and msb-separator-diff '(separator "--")))
			 (cddr buffers-menu))
		(or buffers-menu 'undefined)))))))

;; Snarf current bindings of `mouse-buffer-menu' (normally
;; C-down-mouse-1).
(defvar msb-mode-map
  (let ((map (make-sparse-keymap "Msb")))

(add-hook 'msb-unload-hook 'msb-unload-hook)

(provide 'msb)
(eval-after-load "msb" '(run-hooks 'msb-after-load-hook 'msb-after-load-hooks))

;;; arch-tag: 403f9e82-b92e-4e7a-a797-5d6d9b76da36
;;; msb.el ends here

91073:4bc33ffdda1a

(defun msb-sort-by-directory (item1 item2)
  "Sort the items ITEM1 and ITEM2 by directory name.  Made for dired.
An item look like (NAME . BUFFER)."
  (string-lessp (with-current-buffer (cdr item1)
                  (msb--dired-directory))
		(with-current-buffer (cdr item2)
                  (msb--dired-directory))))

;;;
;;; msb
;;;
;;; This function can be used instead of (mouse-buffer-menu EVENT)

    ;; similar name. Remember that buffer-alist is sorted based on the
    ;; directory name of the buffers' visited files.
    (while rest
      (let ((found-p nil)
	    (tmp-rest rest)
            item)
	(setq item (car tmp-rest))
	;; Clump together the "rest"-buffers that have a dir that is
	;; a subdir of the current one.
	(while (and tmp-rest
		    (<= (length buffers) max-clumped-together)

  ;; 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
	(with-current-buffer buffer
	  ;; Menu found.  Add to this menu
	  (dolist (info (msb--collect function-info-vector))
	    (msb--add-to-menu buffer info max-buffer-name-length)))
      (error (unless msb--error
	       (setq msb--error

 (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 (same
	  tmp-old-car
	  tmp-same
	  (first-time-p t)
	  old-car)
      (nconc

			 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))

		    key
		    (concat (cdr item) " (%d)")))
	    (sort
	     (let ((mode-list nil))
	       (dolist (buffer (cdr (buffer-list)))
		 (with-current-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)

 	     (> msb-display-most-recently-used 0))
    (let* ((buffers (cdr (buffer-list)))
	   (most-recently-used
	    (loop with n = 0
		  for buffer in buffers
		  if (with-current-buffer buffer
		       (and (not (msb-invisible-buffer-p))
			    (not (eq major-mode 'dired-mode))))
		  collect (with-current-buffer buffer
			    (cons (funcall msb-item-handling-function
					   buffer
					   max-buffer-name-length)
				  buffer))
		  and do (incf n)

			       function-info-vector
			       max-buffer-name-length))))
    (when file-buffers
      (setq file-buffers
	    (mapcar (lambda (buffer-list)
		      (list* msb-files-by-directory-sort-key
                             (car buffer-list)
                             (sort
                              (mapcar (lambda (buffer)
                                        (cons (with-current-buffer buffer
                                                (funcall
                                                 msb-item-handling-function
                                                 buffer
                                                 max-buffer-name-length))
                                              buffer))
                                      (cdr buffer-list))
                              (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
	   (most-recently-used
	    (msb--most-recently-used-menu max-buffer-name-length))
	   (others (nconc file-buffers

		 arg))
    (let ((frames (frame-list))
	  buffers-menu frames-menu)
      ;; Make the menu of buffers proper.
      (setq msb--last-buffer-menu (msb--create-buffer-menu))
      ;; Skip the `keymap' symbol.
      (setq buffers-menu (cdr msb--last-buffer-menu))
      ;; Make a Frames menu if we have more than one frame.
      (when (cdr frames)
	(let* ((frame-length (length frames))
	       (f-title  (format "Frames (%d)" frame-length)))
	  ;; List only the N most recently selected frames

		     (list (frame-parameter frame 'name)
			   (frame-parameter frame 'name)
			   (cons nil nil))
		     'menu-bar-select-frame))
		  frames)))))
      (setcdr global-buffers-menu-map
	      (if (and buffers-menu frames-menu)
		  ;; Combine Frame and Buffers menus with separator between
		  (nconc (list "Buffers and Frames" frames-menu
			       (and msb-separator-diff '(separator "--")))
			 (cdr buffers-menu))
                buffers-menu)))))

;; Snarf current bindings of `mouse-buffer-menu' (normally
;; C-down-mouse-1).
(defvar msb-mode-map
  (let ((map (make-sparse-keymap "Msb")))

(add-hook 'msb-unload-hook 'msb-unload-hook)

(provide 'msb)
(eval-after-load "msb" '(run-hooks 'msb-after-load-hook 'msb-after-load-hooks))

;; arch-tag: 403f9e82-b92e-4e7a-a797-5d6d9b76da36
;;; msb.el ends here