- (let* ((buffers
- ;; Make an alist of (MENU-ITEM . BUFFER).
- (let ((tail (buffer-list))
- (maxlen 0)
- head)
- (while tail
- (or (eq ?\ (aref (buffer-name (car tail)) 0))
- (setq maxlen
- (max maxlen
- (length (buffer-name (car tail))))))
- (setq tail (cdr tail)))
- (setq tail (buffer-list))
- (while tail
- (let ((elt (car tail)))
- (if (/= (aref (buffer-name elt) 0) ?\ )
- (setq head
- (cons
- (cons
- (format
- (format "%%%ds %%s%%s %%s" maxlen)
- (buffer-name elt)
- (if (buffer-modified-p elt) "*" " ")
- (save-excursion
- (set-buffer elt)
- (if buffer-read-only "%" " "))
- (or (buffer-file-name elt)
- (save-excursion
- (set-buffer elt)
- (if list-buffers-directory
- (expand-file-name
- list-buffers-directory)))
- ""))
- elt)
- head))))
- (setq tail (cdr tail)))
- ;; Compensate for the reversal that the above loop does.
- (nreverse head)))
- (menu
- ;; If we have lots of buffers, divide them into groups of 20
- ;; and make a pane (or submenu) for each one.
- (if (> (length buffers) (/ (* mouse-menu-buffer-maxlen 3) 2))
- (let ((buffers buffers) sublists next
- (i 1))
- (while buffers
- ;; Pull off the next mouse-menu-buffer-maxlen buffers
- ;; and make them the next element of sublist.
- (setq next (nthcdr mouse-menu-buffer-maxlen buffers))
- (if next
- (setcdr (nthcdr (1- mouse-menu-buffer-maxlen) buffers)
- nil))
- (setq sublists (cons (cons (format "Buffers %d" i) buffers)
- sublists))
- (setq i (1+ i))
- (setq buffers next))
- (cons "Buffer Menu" (nreverse sublists)))
- ;; Few buffers--put them all in one pane.
- (list "Buffer Menu" (cons "Select Buffer" buffers)))))
+ (let ((buffers (buffer-list)) alist menu split-by-major-mode sum-of-squares)
+ ;; Make an alist of elements that look like (MENU-ITEM . BUFFER).
+ (let ((tail buffers))
+ (while tail
+ ;; Divide all buffers into buckets for various major modes.
+ ;; Each bucket looks like (MODE NAMESTRING BUFFERS...).
+ (with-current-buffer (car tail)
+ (let* ((adjusted-major-mode major-mode) elt)
+ (let ((tail mouse-buffer-menu-mode-groups))
+ (while tail
+ (if (string-match (car (car tail)) mode-name)
+ (setq adjusted-major-mode (cdr (car tail))))
+ (setq tail (cdr tail))))
+ (setq elt (assoc adjusted-major-mode split-by-major-mode))
+ (if (null elt)
+ (setq elt (list adjusted-major-mode
+ (if (stringp adjusted-major-mode)
+ adjusted-major-mode
+ mode-name))
+ split-by-major-mode (cons elt split-by-major-mode)))
+ (or (memq (car tail) (cdr (cdr elt)))
+ (setcdr (cdr elt) (cons (car tail) (cdr (cdr elt)))))))
+ (setq tail (cdr tail))))
+ ;; Compute the sum of squares of sizes of the major-mode buckets.
+ (let ((tail split-by-major-mode))
+ (setq sum-of-squares 0)
+ (while tail
+ (setq sum-of-squares
+ (+ sum-of-squares
+ (let ((len (length (cdr (cdr (car tail)))))) (* len len))))
+ (setq tail (cdr tail))))
+ (if (< (* sum-of-squares mouse-buffer-menu-mode-mult)
+ (* (length buffers) (length buffers)))
+ ;; Subdividing by major modes really helps, so let's do it.
+ (let (subdivided-menus (buffers-left (length buffers)))
+ ;; Sort the list to put the most popular major modes first.
+ (setq split-by-major-mode
+ (sort split-by-major-mode
+ (function (lambda (elt1 elt2)
+ (> (length elt1) (length elt2))))))
+ ;; Make a separate submenu for each major mode
+ ;; that has more than one buffer,
+ ;; unless all the remaining buffers are less than 1/10 of them.
+ (while (and split-by-major-mode
+ (and (> (length (car split-by-major-mode)) 3)
+ (> (* buffers-left 10) (length buffers))))
+ (let ((this-mode-list (mouse-buffer-menu-alist
+ (cdr (cdr (car split-by-major-mode))))))
+ (and this-mode-list
+ (setq subdivided-menus
+ (cons (cons
+ (nth 1 (car split-by-major-mode))
+ this-mode-list)
+ subdivided-menus))))
+ (setq buffers-left
+ (- buffers-left (length (cdr (car split-by-major-mode)))))
+ (setq split-by-major-mode (cdr split-by-major-mode)))
+ ;; If any major modes are left over,
+ ;; make a single submenu for them.
+ (if split-by-major-mode
+ (let ((others-list
+ (mouse-buffer-menu-alist
+ ;; we don't need split-by-major-mode any more,
+ ;; so we can ditch it with nconc.
+ (apply 'nconc (mapcar 'cddr split-by-major-mode)))))
+ (and others-list
+ (setq subdivided-menus
+ (cons (cons "Others" others-list)
+ subdivided-menus)))))
+ (setq menu (cons "Buffer Menu" (nreverse subdivided-menus))))
+ (progn
+ (setq alist (mouse-buffer-menu-alist buffers))
+ (setq menu (cons "Buffer Menu"
+ (mouse-buffer-menu-split "Select Buffer" alist)))))