msb.el 37.3 KB
Newer Older
1
;;; msb.el --- customizable buffer-selection with multiple menus
Erik Naggum's avatar
Erik Naggum committed
2

3
;; Copyright (C) 1993, 1994, 1995, 1997, 1998, 1999, 2000, 2001, 2002,
4
;;   2003, 2004, 2005, 2006 Free Software Foundation, Inc.
Erik Naggum's avatar
Erik Naggum committed
5

Richard M. Stallman's avatar
Richard M. Stallman committed
6
;; Author: Lars Lindberg <lars.lindberg@home.se>
7
;; Maintainer: FSF
Richard M. Stallman's avatar
Richard M. Stallman committed
8
;; Created: 8 Oct 1993
Stephen Eglen's avatar
Stephen Eglen committed
9
;; Lindberg's last update version: 3.34
10
;; Keywords: mouse buffer menu
Erik Naggum's avatar
Erik Naggum committed
11 12 13 14

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
Richard M. Stallman's avatar
Richard M. Stallman committed
15
;; it under the terms of the GNU General Public License as published by
Erik Naggum's avatar
Erik Naggum committed
16 17 18 19
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
Richard M. Stallman's avatar
Richard M. Stallman committed
20 21 22
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
Erik Naggum's avatar
Erik Naggum committed
23

Richard M. Stallman's avatar
Richard M. Stallman committed
24
;; You should have received a copy of the GNU General Public License
Erik Naggum's avatar
Erik Naggum committed
25
;; along with GNU Emacs; see the file COPYING.  If not, write to the
Lute Kamstra's avatar
Lute Kamstra committed
26 27
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
Richard M. Stallman's avatar
Richard M. Stallman committed
28 29

;;; Commentary:
Erik Naggum's avatar
Erik Naggum committed
30

Richard M. Stallman's avatar
Richard M. Stallman committed
31 32 33
;; Purpose of this package:
;;   1. Offer a function for letting the user choose buffer,
;;      not necessarily for switching to it.
34 35
;;   2. Make a better mouse-buffer-menu.  This is done as a global
;;      minor mode, msb-mode.
Richard M. Stallman's avatar
Richard M. Stallman committed
36 37
;;
;; Customization:
38 39 40
;;   Look at the variable `msb-menu-cond' for deciding what menus you
;;   want.  It's not that hard to customize, despite my not-so-good
;;   doc-string.  Feel free to send me a better doc-string.
Richard M. Stallman's avatar
Richard M. Stallman committed
41 42 43
;;   There are some constants for you to try here:
;;   msb--few-menus
;;   msb--very-many-menus (default)
44
;;
45 46 47
;;   Look at the variable `msb-item-handling-function' for customization
;;   of the appearance of every menu item.  Try for instance setting
;;   it to `msb-alon-item-handler'.
48
;;
49 50
;;   Look at the variable `msb-item-sort-function' for customization
;;   of sorting the menus.  Set it to t for instance, which means no
Richard M. Stallman's avatar
Richard M. Stallman committed
51 52
;;   sorting - you will get latest used buffer first.
;;
53
;;   Also check out the variable `msb-display-invisible-buffers-p'.
Richard M. Stallman's avatar
Richard M. Stallman committed
54 55

;; Known bugs:
56
;; - Files-by-directory
57
;;   + No possibility to show client/changed buffers separately.
Stephen Eglen's avatar
Stephen Eglen committed
58
;;   + All file buffers only appear in a file sub-menu, they will
59 60
;;     for instance not appear in the Mail sub-menu.

Richard M. Stallman's avatar
Richard M. Stallman committed
61 62 63
;; Future enhancements:

;;; Thanks goes to
64 65 66 67 68 69 70 71 72 73 74 75
;;  Mark Brader <msb@sq.com>
;;  Jim Berry <m1jhb00@FRB.GOV>
;;  Hans Chalupsky <hans@cs.Buffalo.EDU>
;;  Larry Rosenberg <ljr@ictv.com>
;;  Will Henney <will@astroscu.unam.mx>
;;  Jari Aalto <jaalto@tre.tele.nokia.fi>
;;  Michael Kifer <kifer@sbkifer.cs.sunysb.edu>
;;  Gael Marziou <gael@gnlab030.grenoble.hp.com>
;;  Dave Gillespie <daveg@thymus.synaptics.com>
;;  Alon Albert <alon@milcse.rtsg.mot.com>
;;  Kevin Broadey, <KevinB@bartley.demon.co.uk>
;;  Ake Stenhof <ake@cadpoint.se>
Karl Heuer's avatar
Karl Heuer committed
76
;;  Richard Stallman <rms@gnu.org>
77
;;  Steve Fisk <fisk@medved.bowdoin.edu>
Richard M. Stallman's avatar
Richard M. Stallman committed
78

Dave Love's avatar
Dave Love committed
79 80
;; This version turned into a global minor mode and subsequently
;; hacked on by Dave Love.
Richard M. Stallman's avatar
Richard M. Stallman committed
81 82
;;; Code:

Dave Love's avatar
Dave Love committed
83
(eval-when-compile (require 'cl))
Richard M. Stallman's avatar
Richard M. Stallman committed
84 85

;;;
86 87 88
;;; Some example constants to be used for `msb-menu-cond'.  See that
;;; variable for more information.  Please note that if the condition
;;; returns `multi', then the buffer can appear in several menus.
Richard M. Stallman's avatar
Richard M. Stallman committed
89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111
;;;
(defconst msb--few-menus
  '(((and (boundp 'server-buffer-clients)
	  server-buffer-clients
	  'multi)
     3030
     "Clients (%d)")
    ((and msb-display-invisible-buffers-p
	  (msb-invisible-buffer-p)
	  'multi)
     3090
     "Invisible buffers (%d)")
    ((eq major-mode 'dired-mode)
     2010
     "Dired (%d)"
     msb-dired-item-handler
     msb-sort-by-directory)
    ((eq major-mode 'Man-mode)
     4090
     "Manuals (%d)")
    ((eq major-mode 'w3-mode)
     4020
     "WWW (%d)")
112 113 114 115 116 117
    ((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)))
Richard M. Stallman's avatar
Richard M. Stallman committed
118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148
     4010
     "Mail (%d)")
    ((not buffer-file-name)
     4099
     "Buffers (%d)")
    ('no-multi
     1099
     "Files (%d)")))

(defconst msb--very-many-menus
  '(((and (boundp 'server-buffer-clients)
	  server-buffer-clients
	  'multi)
     1010
     "Clients (%d)")
    ((and (boundp 'vc-mode) vc-mode 'multi)
     1020
     "Version Control (%d)")
    ((and buffer-file-name
	  (buffer-modified-p)
	  'multi)
     1030
     "Changed files (%d)")
    ((and (get-buffer-process (current-buffer))
	  'multi)
     1040
     "Processes (%d)")
    ((and msb-display-invisible-buffers-p
	  (msb-invisible-buffer-p)
	  'multi)
     1090
149
     "Invisible buffers (%d)")
Richard M. Stallman's avatar
Richard M. Stallman committed
150 151 152 153 154 155 156 157
    ((eq major-mode 'dired-mode)
     2010
     "Dired (%d)"
     ;; Note this different menu-handler
     msb-dired-item-handler
     ;; Also note this item-sorter
     msb-sort-by-directory)
    ((eq major-mode 'Man-mode)
Stephen Eglen's avatar
Stephen Eglen committed
158
     5030
Richard M. Stallman's avatar
Richard M. Stallman committed
159 160
     "Manuals (%d)")
    ((eq major-mode 'w3-mode)
Stephen Eglen's avatar
Stephen Eglen committed
161
     5020
Richard M. Stallman's avatar
Richard M. Stallman committed
162
     "WWW (%d)")
163 164 165 166 167
    ((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
Richard M. Stallman's avatar
Richard M. Stallman committed
168
			    gnus-browse-killed-mode)))
Stephen Eglen's avatar
Stephen Eglen committed
169
     5010
Richard M. Stallman's avatar
Richard M. Stallman committed
170 171 172 173
     "Mail (%d)")
    ;; Catchup for all non-file buffers
    ((and (not buffer-file-name)
	  'no-multi)
Stephen Eglen's avatar
Stephen Eglen committed
174
     5099
Richard M. Stallman's avatar
Richard M. Stallman committed
175 176 177 178 179 180 181 182 183 184 185 186 187
     "Other non-file buffers (%d)")
    ((and (string-match "/\\.[^/]*$" buffer-file-name)
	  'multi)
     3090
     "Hidden Files (%d)")
    ((memq major-mode '(c-mode c++-mode))
     3010
     "C/C++ Files (%d)")
    ((eq major-mode 'emacs-lisp-mode)
     3020
     "Elisp Files (%d)")
    ((eq major-mode 'latex-mode)
     3030
188
     "LaTeX Files (%d)")
Richard M. Stallman's avatar
Richard M. Stallman committed
189 190 191 192 193 194 195 196 197 198 199
    ('no-multi
     3099
     "Other files (%d)")))

;; msb--many-menus is obsolete
(defvar msb--many-menus msb--very-many-menus)

;;;
;;; Customizable variables
;;;

Stephen Eglen's avatar
Stephen Eglen committed
200 201 202 203 204 205 206 207
(defgroup msb nil
  "Customizable buffer-selection with multiple menus."
  :prefix "msb-"
  :group 'mouse)

(defun msb-custom-set (symbol value)
  "Set the value of custom variables for msb."
  (set symbol value)
208
  (if (and (featurep 'msb) msb-mode)
Stephen Eglen's avatar
Stephen Eglen committed
209 210
      ;; wait until package has been loaded before bothering to update
      ;; the buffer lists.
211
      (msb-menu-bar-update-buffers t)))
Stephen Eglen's avatar
Stephen Eglen committed
212 213 214 215 216 217 218

(defcustom msb-menu-cond msb--very-many-menus
  "*List of criteria for splitting the mouse buffer menu.
The elements in the list should be of this type:
 (CONDITION MENU-SORT-KEY MENU-TITLE ITEM-HANDLING-FN ITEM-SORT-FN).

When making the split, the buffers are tested one by one against the
219
CONDITION, just like a Lisp cond: When hitting a true condition, the
Stephen Eglen's avatar
Stephen Eglen committed
220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258
other criteria are *not* tested and the buffer name will appear in the
menu with the menu-title corresponding to the true condition.

If the condition returns the symbol `multi', then the buffer will be
added to this menu *and* tested for other menus too.  If it returns
`no-multi', then the buffer will only be added if it hasn't been added
to any other menu.

During this test, the buffer in question is the current buffer, and
the test is surrounded by calls to `save-excursion' and
`save-match-data'.

The categories are sorted by MENU-SORT-KEY.  Smaller keys are on top.
nil means don't display this menu.

MENU-TITLE is really a format.  If you add %d in it, the %d is
replaced with the number of items in that menu.

ITEM-HANDLING-FN, is optional.  If it is supplied and is a function,
than it is used for displaying the items in that particular buffer
menu, otherwise the function pointed out by
`msb-item-handling-function' is used.

ITEM-SORT-FN, is also optional.
If it is not supplied, the function pointed out by
`msb-item-sort-function' is used.
If it is nil, then no sort takes place and the buffers are presented
in least-recently-used order.
If it is t, then no sort takes place and the buffers are presented in
most-recently-used order.
If it is supplied and non-nil and not t than it is used for sorting
the items in that particular buffer menu.

Note1: There should always be a `catch-all' as last element, in this
list.  That is an element like (t TITLE ITEM-HANDLING-FUNCTION).
Note2: A buffer menu appears only if it has at least one buffer in it.
Note3: If you have a CONDITION that can't be evaluated you will get an
error every time you do \\[msb]."
  :type `(choice (const :tag "long" :value ,msb--very-many-menus)
259 260
		 (const :tag "short" :value ,msb--few-menus)
		 (sexp :tag "user"))
Stephen Eglen's avatar
Stephen Eglen committed
261 262 263 264 265 266 267
  :set 'msb-custom-set
  :group 'msb)

(defcustom msb-modes-key 4000
  "The sort key for files sorted by mode."
  :type 'integer
  :set 'msb-custom-set
Dan Nicolaescu's avatar
Dan Nicolaescu committed
268 269
  :group 'msb
  :version "20.3")
Stephen Eglen's avatar
Stephen Eglen committed
270 271

(defcustom msb-separator-diff 100
Richard M. Stallman's avatar
Richard M. Stallman committed
272
  "*Non-nil means use separators.
273
The separators will appear between all menus that have a sorting key
Stephen Eglen's avatar
Stephen Eglen committed
274 275 276 277
that differs by this value or more."
  :type '(choice integer (const nil))
  :set 'msb-custom-set
  :group 'msb)
Richard M. Stallman's avatar
Richard M. Stallman committed
278 279

(defvar msb-files-by-directory-sort-key 0
280
  "*The sort key for files sorted by directory.")
Richard M. Stallman's avatar
Richard M. Stallman committed
281

Stephen Eglen's avatar
Stephen Eglen committed
282
(defcustom msb-max-menu-items 15
Richard M. Stallman's avatar
Richard M. Stallman committed
283
  "*The maximum number of items in a menu.
284
If this variable is set to 15 for instance, then the submenu will be
Pavel Janík's avatar
Pavel Janík committed
285
split up in minor parts, 15 items each.  nil means no limit."
Stephen Eglen's avatar
Stephen Eglen committed
286 287 288
  :type '(choice integer (const nil))
  :set 'msb-custom-set
  :group 'msb)
Richard M. Stallman's avatar
Richard M. Stallman committed
289

Stephen Eglen's avatar
Stephen Eglen committed
290
(defcustom msb-max-file-menu-items 10
Richard M. Stallman's avatar
Richard M. Stallman committed
291 292
  "*The maximum number of items from different directories.

293
When the menu is of type `file by directory', this is the maximum
294
number of buffers that are clumped together from different
Richard M. Stallman's avatar
Richard M. Stallman committed
295 296
directories.

297 298 299
Set this to 1 if you want one menu per directory instead of clumping
them together.

Stephen Eglen's avatar
Stephen Eglen committed
300 301 302 303
If the value is not a number, then the value 10 is used."
  :type 'integer
  :set 'msb-custom-set
  :group 'msb)
Richard M. Stallman's avatar
Richard M. Stallman committed
304

Stephen Eglen's avatar
Stephen Eglen committed
305 306 307 308 309
(defcustom msb-most-recently-used-sort-key -1010
  "*Where should the menu with the most recently used buffers be placed?"
  :type 'integer
  :set 'msb-custom-set
  :group 'msb)
Richard M. Stallman's avatar
Richard M. Stallman committed
310

Stephen Eglen's avatar
Stephen Eglen committed
311
(defcustom msb-display-most-recently-used 15
Richard M. Stallman's avatar
Richard M. Stallman committed
312
  "*How many buffers should be in the most-recently-used menu.
Stephen Eglen's avatar
Stephen Eglen committed
313 314 315 316 317 318 319 320 321 322
No buffers at all if less than 1 or nil (or any non-number)."
  :type 'integer
  :set 'msb-custom-set
  :group 'msb)

(defcustom msb-most-recently-used-title "Most recently used (%d)"
  "*The title for the most-recently-used menu."
  :type 'string
  :set 'msb-custom-set
  :group 'msb)
323

Richard M. Stallman's avatar
Richard M. Stallman committed
324
(defvar msb-horizontal-shift-function '(lambda () 0)
325
  "*Function that specifies how many pixels to shift the top menu leftwards.")
Richard M. Stallman's avatar
Richard M. Stallman committed
326

Stephen Eglen's avatar
Stephen Eglen committed
327
(defcustom msb-display-invisible-buffers-p nil
Richard M. Stallman's avatar
Richard M. Stallman committed
328 329
  "*Show invisible buffers or not.
Non-nil means that the buffer menu should include buffers that have
Stephen Eglen's avatar
Stephen Eglen committed
330 331 332 333
names that starts with a space character."
  :type 'boolean
  :set 'msb-custom-set
  :group 'msb)
Richard M. Stallman's avatar
Richard M. Stallman committed
334 335 336 337 338

(defvar msb-item-handling-function 'msb-item-handler
  "*The appearance of a buffer menu.

The default function to call for handling the appearance of a menu
339
item.  It should take to arguments, BUFFER and MAX-BUFFER-NAME-LENGTH,
Richard M. Stallman's avatar
Richard M. Stallman committed
340
where the latter is the max length of all buffer names.
341 342 343

The function should return the string to use in the menu.

344 345 346
When the function is called, BUFFER is the current buffer.  This
function is called for items in the variable `msb-menu-cond' that have
nil as ITEM-HANDLING-FUNCTION.  See `msb-menu-cond' for more
Richard M. Stallman's avatar
Richard M. Stallman committed
347 348
information.")

Stephen Eglen's avatar
Stephen Eglen committed
349
(defcustom msb-item-sort-function 'msb-sort-by-name
Richard M. Stallman's avatar
Richard M. Stallman committed
350
  "*The order of items in a buffer menu.
351

Richard M. Stallman's avatar
Richard M. Stallman committed
352
The default function to call for handling the order of items in a menu
353 354 355
item.  This function is called like a sort function.  The items look
like (ITEM-NAME . BUFFER).

Richard M. Stallman's avatar
Richard M. Stallman committed
356 357 358
ITEM-NAME is the name of the item that will appear in the menu.
BUFFER is the buffer, this is not necessarily the current buffer.

Stephen Eglen's avatar
Stephen Eglen committed
359 360 361 362 363
Set this to nil or t if you don't want any sorting (faster)."
  :type '(choice (const msb-sort-by-name)
		 (const :tag "Newest first" t)
		 (const :tag "Oldest first" nil))
  :set 'msb-custom-set
364
  :group 'msb)
365

Stephen Eglen's avatar
Stephen Eglen committed
366
(defcustom msb-files-by-directory nil
367 368
  "*Non-nil means that files should be sorted by directory.
This is instead of the groups in `msb-menu-cond'."
Stephen Eglen's avatar
Stephen Eglen committed
369 370 371
  :type 'boolean
  :set 'msb-custom-set
  :group 'msb)
Richard M. Stallman's avatar
Richard M. Stallman committed
372

373 374
(defcustom msb-after-load-hook nil
  "Hook run after the msb package has been loaded."
Stephen Eglen's avatar
Stephen Eglen committed
375 376 377
  :type 'hook
  :set 'msb-custom-set
  :group 'msb)
Richard M. Stallman's avatar
Richard M. Stallman committed
378 379 380 381 382 383 384 385 386 387 388 389

;;;
;;; Internal variables
;;;

;; The last calculated menu.
(defvar msb--last-buffer-menu nil)

;; If this is non-nil, then it is a string that describes the error.
(defvar msb--error nil)

;;;
390
;;; Some example function to be used for `msb-item-handling-function'.
Richard M. Stallman's avatar
Richard M. Stallman committed
391 392 393 394 395
;;;
(defun msb-item-handler (buffer &optional maxbuf)
  "Create one string item, concerning BUFFER, for the buffer menu.
The item looks like:
*% <buffer-name>
396 397
The `*' appears only if the buffer is marked as modified.
The `%' appears only if the buffer is read-only.
Richard M. Stallman's avatar
Richard M. Stallman committed
398 399 400 401 402 403 404 405 406
Optional second argument MAXBUF is completely ignored."
  (let ((name (buffer-name))
	(modified (if (buffer-modified-p) "*" " "))
	(read-only (if buffer-read-only "%" " ")))
    (format "%s%s %s" modified read-only name)))


(eval-when-compile (require 'dired))

407 408
;; `dired' can be called with a list of the form (directory file1 file2 ...)
;; which causes `dired-directory' to be in the same form.
Richard M. Stallman's avatar
Richard M. Stallman committed
409 410 411 412 413 414
(defun msb--dired-directory ()
  (cond ((stringp dired-directory)
	 (abbreviate-file-name (expand-file-name dired-directory)))
	((consp dired-directory)
	 (abbreviate-file-name (expand-file-name (car dired-directory))))
	(t
415
	 (error "Unknown type of `dired-directory' in buffer %s"
Richard M. Stallman's avatar
Richard M. Stallman committed
416 417 418 419 420 421
		(buffer-name)))))

(defun msb-dired-item-handler (buffer &optional maxbuf)
  "Create one string item, concerning a dired BUFFER, for the buffer menu.
The item looks like:
*% <buffer-name>
422 423
The `*' appears only if the buffer is marked as modified.
The `%' appears only if the buffer is read-only.
Richard M. Stallman's avatar
Richard M. Stallman committed
424 425 426 427 428 429 430 431 432 433
Optional second argument MAXBUF is completely ignored."
  (let ((name (msb--dired-directory))
	(modified (if (buffer-modified-p) "*" " "))
	(read-only (if buffer-read-only "%" " ")))
    (format "%s%s %s" modified read-only name)))

(defun msb-alon-item-handler (buffer maxbuf)
  "Create one string item for the buffer menu.
The item looks like:
<buffer-name> *%# <file-name>
434 435 436
The `*' appears only if the buffer is marked as modified.
The `%' appears only if the buffer is read-only.
The `#' appears only version control file (SCCS/RCS)."
Richard M. Stallman's avatar
Richard M. Stallman committed
437 438 439 440 441 442 443 444
  (format (format "%%%ds  %%s%%s%%s  %%s" maxbuf)
          (buffer-name buffer)
          (if (buffer-modified-p) "*" " ")
          (if buffer-read-only "%" " ")
          (if (and (boundp 'vc-mode) vc-mode) "#" " ")
          (or buffer-file-name "")))

;;;
445
;;; Some example function to be used for `msb-item-sort-function'.
Richard M. Stallman's avatar
Richard M. Stallman committed
446 447
;;;
(defun msb-sort-by-name (item1 item2)
448 449
  "Sort the items ITEM1 and ITEM2 by their `buffer-name'.
An item looks like (NAME . BUFFER)."
Richard M. Stallman's avatar
Richard M. Stallman committed
450 451 452 453 454
  (string-lessp (buffer-name (cdr item1))
		(buffer-name (cdr item2))))


(defun msb-sort-by-directory (item1 item2)
455
  "Sort the items ITEM1 and ITEM2 by directory name.  Made for dired.
Richard M. Stallman's avatar
Richard M. Stallman committed
456
An item look like (NAME . BUFFER)."
457 458 459 460
  (string-lessp (save-excursion (set-buffer (cdr item1))
				(msb--dired-directory))
		(save-excursion (set-buffer (cdr item2))
				(msb--dired-directory))))
Richard M. Stallman's avatar
Richard M. Stallman committed
461 462 463 464 465 466

;;;
;;; msb
;;;
;;; This function can be used instead of (mouse-buffer-menu EVENT)
;;; function in "mouse.el".
467
;;;
Richard M. Stallman's avatar
Richard M. Stallman committed
468 469 470 471 472
(defun msb (event)
  "Pop up several menus of buffers for selection with the mouse.
This command switches buffers in the window that you clicked on, and
selects that window.

473 474
See the function `mouse-select-buffer' and the variable
`msb-menu-cond' for more information about how the menus are split."
Richard M. Stallman's avatar
Richard M. Stallman committed
475
  (interactive "e")
476
  (let ((old-window (selected-window))
477 478
	(window (posn-window (event-start event)))
	early-release)
479
    (unless (framep window) (select-window window))
480 481 482
    ;; This `sit-for' magically makes the menu stay up if the mouse
    ;; button is released within 0.1 second.
    (setq early-release (not (sit-for 0.1 t)))
483 484 485
    (let ((buffer (mouse-select-buffer event)))
      (if buffer
	  (switch-to-buffer buffer)
486 487 488 489 490
	(select-window old-window)))
    ;; If the above `sit-for' was interrupted by a mouse-up, avoid
    ;; generating a drag event.
    (if (and early-release (memq 'down (event-modifiers last-input-event)))
	(discard-input)))
Richard M. Stallman's avatar
Richard M. Stallman committed
491 492 493 494 495 496 497 498 499
  nil)

;;;
;;; Some supportive functions
;;;
(defun msb-invisible-buffer-p (&optional buffer)
  "Return t if optional BUFFER is an \"invisible\" buffer.
If the argument is left out or nil, then the current buffer is considered."
  (and (> (length (buffer-name buffer)) 0)
500
       (eq ?\s (aref (buffer-name buffer) 0))))
Richard M. Stallman's avatar
Richard M. Stallman committed
501

Richard M. Stallman's avatar
Richard M. Stallman committed
502
(defun msb--strip-dir (dir)
503
  "Strip one hierarchy level from the end of DIR."
504
  (file-name-directory (directory-file-name dir)))
Richard M. Stallman's avatar
Richard M. Stallman committed
505 506

;; Create an alist with all buffers from LIST that lies under the same
507 508
;; directory will be in the same item as the directory name.
;; ((DIR1 . (BUFFER-1 BUFFER-2 ...)) (DIR2 . (BUFFER-K BUFFER-K+1...)) ...)
Richard M. Stallman's avatar
Richard M. Stallman committed
509 510
(defun msb--init-file-alist (list)
  (let ((buffer-alist
511
	 ;; Make alist that looks like
512 513
	 ;; ((DIR-1 BUFFER-1) (DIR-2 BUFFER-2) ...)
	 ;; sorted on DIR-x
514 515 516 517 518 519 520 521 522 523 524
	 (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))))))
525
    ;; Now clump buffers together that have the same directory name
Richard M. Stallman's avatar
Richard M. Stallman committed
526
    ;; Make alist that looks like
527 528
    ;; ((DIR1 . (BUFFER-1 BUFFER-2 ...)) (DIR2 . (BUFFER-K)) ...)
    (let ((dir nil)
529 530
	  (buffers nil))
      (nconc
531 532 533 534
       (apply
	#'nconc
	(mapcar (lambda (item)
		  (cond
535 536 537
		   ((equal dir (car item))
		    ;; The same dir as earlier:
		    ;; Add to current list of buffers.
538 539 540 541
		    (push (cdr item) buffers)
		    ;; This item should not be added to list
		    nil)
		   (t
542 543 544
		    ;; New dir
		    (let ((result (and dir (cons dir buffers))))
		      (setq dir (car item))
545 546 547 548
		      (setq buffers (list (cdr item)))
		      ;; Add the last result the list.
		      (and result (list result))))))
		buffer-alist))
549
       ;; Add the last result to the list
550
       (list (cons dir buffers))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
551

552
(defun msb--format-title (top-found-p dir number-of-items)
553
  "Format a suitable title for the menu item."
Dave Love's avatar
Dave Love committed
554
  (format (if top-found-p "%s... (%d)" "%s (%d)")
555
	  (abbreviate-file-name dir) number-of-items))
556

557 558 559
;; Variables for debugging.
(defvar msb--choose-file-menu-list)
(defvar msb--choose-file-menu-arg-list)
560

Richard M. Stallman's avatar
Richard M. Stallman committed
561
(defun msb--choose-file-menu (list)
562
  "Choose file-menu with respect to directory for every buffer in LIST."
563
  (setq msb--choose-file-menu-arg-list list)
Richard M. Stallman's avatar
Richard M. Stallman committed
564 565 566 567 568 569
  (let ((buffer-alist (msb--init-file-alist list))
	(final-list nil)
	(max-clumped-together (if (numberp msb-max-file-menu-items)
				  msb-max-file-menu-items
				10))
	(top-found-p nil)
570 571
	(last-dir nil)
	first rest dir buffers old-dir)
572 573 574
    ;; Prepare for looping over all items in buffer-alist
    (setq first (car buffer-alist)
	  rest (cdr buffer-alist)
575
	  dir (car first)
576
	  buffers (cdr first))
577
    (setq msb--choose-file-menu-list (copy-sequence rest))
578 579
    ;; This big loop tries to clump buffers together that have a
    ;; similar name. Remember that buffer-alist is sorted based on the
580
    ;; directory name of the buffers' visited files.
Richard M. Stallman's avatar
Richard M. Stallman committed
581 582 583
    (while rest
      (let ((found-p nil)
	    (tmp-rest rest)
584
	    result
585
	    new-dir item)
Richard M. Stallman's avatar
Richard M. Stallman committed
586
	(setq item (car tmp-rest))
587 588
	;; Clump together the "rest"-buffers that have a dir that is
	;; a subdir of the current one.
Richard M. Stallman's avatar
Richard M. Stallman committed
589 590
	(while (and tmp-rest
		    (<= (length buffers) max-clumped-together)
591
		    (>= (length (car item)) (length dir))
592 593
		    ;; `completion-ignore-case' seems to default to t
		    ;; on the systems with case-insensitive file names.
594 595
		    (eq t (compare-strings dir 0 nil
					   (car item) 0 (length dir)
596
					   completion-ignore-case)))
Richard M. Stallman's avatar
Richard M. Stallman committed
597
	  (setq found-p t)
598 599 600
	  (setq buffers (append buffers (cdr item))) ;nconc is faster than append
	  (setq tmp-rest (cdr tmp-rest)
		item (car tmp-rest)))
Richard M. Stallman's avatar
Richard M. Stallman committed
601 602
	(cond
	 ((> (length buffers) max-clumped-together)
603 604
	  ;; Oh, we failed. Too many buffers clumped together.
	  ;; Just use the original ones for the result.
605
	  (setq last-dir (car first))
606 607 608 609 610
	  (push (cons (msb--format-title top-found-p
					 (car first)
					 (length (cdr first)))
		      (cdr first))
		final-list)
611
	  (setq top-found-p nil)
Richard M. Stallman's avatar
Richard M. Stallman committed
612
	  (setq first (car rest)
613
		rest (cdr rest)
614
		dir (car first)
Richard M. Stallman's avatar
Richard M. Stallman committed
615 616
		buffers (cdr first)))
	 (t
617 618
	  ;; The first pass of clumping together worked out, go ahead
	  ;; with this result.
Richard M. Stallman's avatar
Richard M. Stallman committed
619 620
	  (when found-p
	    (setq top-found-p t)
621
	    (setq first (cons dir buffers)
Richard M. Stallman's avatar
Richard M. Stallman committed
622
		  rest tmp-rest))
623 624
	  ;; Now see if we can clump more buffers together if we go up
	  ;; one step in the file hierarchy.
625
	  ;; If dir isn't changed by msb--strip-dir, we are looking
Stephen Eglen's avatar
Stephen Eglen committed
626
	  ;; at the machine name component of an ange-ftp filename.
627 628
	  (setq old-dir dir)
	  (setq dir (msb--strip-dir dir)
Richard M. Stallman's avatar
Richard M. Stallman committed
629
		buffers (cdr first))
630 631 632 633
	  (if (equal old-dir dir)
	      (setq last-dir dir))
	  (when (and last-dir
		     (or (and (>= (length dir) (length last-dir))
634
			      (eq t (compare-strings
635 636
				     last-dir 0 nil dir 0
				     (length last-dir)
637
				     completion-ignore-case)))
638
			 (and (< (length dir) (length last-dir))
639
			      (eq t (compare-strings
640
				     dir 0 nil last-dir 0 (length dir)
641
				     completion-ignore-case)))))
642 643 644 645 646 647 648 649
	    ;; We have reached the same place in the file hierarchy as
	    ;; the last result, so we should quit at this point and
	    ;; take what we have as result.
	    (push (cons (msb--format-title top-found-p
					   (car first)
					   (length (cdr first)))
			(cdr first))
		  final-list)
650
	    (setq top-found-p nil)
Richard M. Stallman's avatar
Richard M. Stallman committed
651
	    (setq first (car rest)
652
		  rest (cdr rest)
653
		  dir (car first)
654 655
		  buffers (cdr first)))))))
    ;; Now take care of the last item.
Stephen Eglen's avatar
Stephen Eglen committed
656 657 658 659 660 661
    (when first
      (push (cons (msb--format-title top-found-p
				     (car first)
				     (length (cdr first)))
		  (cdr first))
	    final-list))
662
    (setq top-found-p nil)
Richard M. Stallman's avatar
Richard M. Stallman committed
663 664 665
    (nreverse final-list)))

(defun msb--create-function-info (menu-cond-elt)
666 667 668 669
  "Create a vector from an element MENU-COND-ELT of `msb-menu-cond'.
This takes the form:
\]BUFFER-LIST-VARIABLE CONDITION MENU-SORT-KEY MENU-TITLE ITEM-HANDLER SORTER)
See `msb-menu-cond' for a description of its elements."
Richard M. Stallman's avatar
Richard M. Stallman committed
670 671 672 673 674 675 676 677 678 679 680
  (let* ((list-symbol (make-symbol "-msb-buffer-list"))
	 (tmp-ih (and (> (length menu-cond-elt) 3)
		      (nth 3 menu-cond-elt)))
	 (item-handler (if (and tmp-ih (fboundp tmp-ih))
			   tmp-ih
			 msb-item-handling-function))
	 (tmp-s (if (> (length menu-cond-elt) 4)
		    (nth 4 menu-cond-elt)
		  msb-item-sort-function))
	 (sorter (if (or (fboundp tmp-s)
			 (null tmp-s)
681
			 (eq tmp-s t))
682
		     tmp-s
Richard M. Stallman's avatar
Richard M. Stallman committed
683 684
		   msb-item-sort-function)))
    (when (< (length menu-cond-elt) 3)
685
      (error "Wrong format of msb-menu-cond"))
Richard M. Stallman's avatar
Richard M. Stallman committed
686 687 688 689 690 691
    (when (and (> (length menu-cond-elt) 3)
	       (not (fboundp tmp-ih)))
      (signal 'invalid-function (list tmp-ih)))
    (when (and (> (length menu-cond-elt) 4)
	       tmp-s
	       (not (fboundp tmp-s))
692
	       (not (eq tmp-s t)))
Richard M. Stallman's avatar
Richard M. Stallman committed
693
      (signal 'invalid-function (list tmp-s)))
694
    (set list-symbol ())
Richard M. Stallman's avatar
Richard M. Stallman committed
695 696 697 698 699 700 701 702 703
    (vector list-symbol			;BUFFER-LIST-VARIABLE
	    (nth 0 menu-cond-elt)	;CONDITION
	    (nth 1 menu-cond-elt)	;SORT-KEY
	    (nth 2 menu-cond-elt)	;MENU-TITLE
	    item-handler		;ITEM-HANDLER
	    sorter)			;SORTER
    ))

;; This defsubst is only used in `msb--choose-menu' below.  It was
Stephen Eglen's avatar
Stephen Eglen committed
704
;; pulled out merely to make the code somewhat clearer.  The indentation
Richard M. Stallman's avatar
Richard M. Stallman committed
705 706 707 708 709 710 711 712 713 714 715 716 717 718
;; level was too big.
(defsubst msb--collect (function-info-vector)
  (let ((result nil)
	(multi-flag nil)
	function-info-list)
    (setq function-info-list
	  (loop for fi
		across function-info-vector
		if (and (setq result
			      (eval (aref fi 1))) ;Test CONDITION
			(not (and (eq result 'no-multi)
				  multi-flag))
			(progn (when (eq result 'multi)
				 (setq multi-flag t))
719
			       t))
Richard M. Stallman's avatar
Richard M. Stallman committed
720 721 722 723 724 725 726 727 728
		collect fi
		until (and result
			   (not (eq result 'multi)))))
    (when (and (not function-info-list)
	       (not result))
      (error "No catch-all in msb-menu-cond!"))
    function-info-list))

(defun msb--add-to-menu (buffer function-info max-buffer-name-length)
729 730 731
  "Add BUFFER to the menu depicted by FUNCTION-INFO.
All side-effects.  Adds an element of form (BUFFER-TITLE . BUFFER)
to the buffer-list variable in function-info."
Richard M. Stallman's avatar
Richard M. Stallman committed
732 733 734 735 736 737 738 739
  (let ((list-symbol (aref function-info 0))) ;BUFFER-LIST-VARIABLE
    ;; Here comes the hairy side-effect!
    (set list-symbol
	 (cons (cons (funcall (aref function-info 4) ;ITEM-HANDLER
			      buffer
			      max-buffer-name-length)
		     buffer)
	       (eval list-symbol)))))
740

Richard M. Stallman's avatar
Richard M. Stallman committed
741
(defsubst msb--choose-menu (buffer function-info-vector max-buffer-name-length)
742 743 744
  "Select the appropriate menu for BUFFER."
  ;; This is all side-effects, folks!
  ;; This should be optimized.
Richard M. Stallman's avatar
Richard M. Stallman committed
745 746 747 748 749
  (unless (and (not msb-display-invisible-buffers-p)
	       (msb-invisible-buffer-p buffer))
    (condition-case nil
	(save-excursion
	  (set-buffer buffer)
750
	  ;; Menu found.  Add to this menu
751 752
	  (dolist (info (msb--collect function-info-vector))
	    (msb--add-to-menu buffer info max-buffer-name-length)))
Richard M. Stallman's avatar
Richard M. Stallman committed
753 754 755
      (error (unless msb--error
	       (setq msb--error
		     (format
756
		      "In msb-menu-cond, error for buffer `%s'."
Richard M. Stallman's avatar
Richard M. Stallman committed
757
		      (buffer-name buffer)))
758
	       (error "%s" msb--error))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
759 760

(defun msb--create-sort-item (function-info)
761
  "Return (SORT-KEY TITLE . BUFFER-LIST) or nil if the buffer-list is empty."
Richard M. Stallman's avatar
Richard M. Stallman committed
762 763 764 765 766
  (let ((buffer-list (eval (aref function-info 0))))
    (when buffer-list
      (let ((sorter (aref function-info 5)) ;SORTER
	    (sort-key (aref function-info 2))) ;MENU-SORT-KEY
	(when sort-key
767
	  (cons sort-key
Richard M. Stallman's avatar
Richard M. Stallman committed
768 769 770 771 772
		(cons (format (aref function-info 3) ;MENU-TITLE
			      (length buffer-list))
		      (cond
		       ((null sorter)
			buffer-list)
773
		       ((eq sorter t)
Richard M. Stallman's avatar
Richard M. Stallman committed
774 775 776 777
			(nreverse buffer-list))
		       (t
			(sort buffer-list sorter))))))))))

Stephen Eglen's avatar
Stephen Eglen committed
778
(defun msb--aggregate-alist (alist same-predicate sort-predicate)
779 780 781 782 783 784 785
  "Return ALIST as a sorted, aggregated alist.

In the result all items with the same car element (according to
SAME-PREDICATE) are aggregated together.  The alist is first sorted by
SORT-PREDICATE.

Example:
786
\(msb--aggregate-alist
787 788 789 790 791
 '((a . a1) (a . a2) (b . b1) (c . c3) (a . a4) (a . a3) (b . b3) (b . b2))
 (function string=)
 (lambda (item1 item2)
   (string< (symbol-name item1) (symbol-name item2))))
results in
792
\((a a1 a2 a4 a3) (b b1 b3 b2) (c c3))"
Stephen Eglen's avatar
Stephen Eglen committed
793 794 795 796 797 798 799 800
  (when (not (null alist))
    (let (result
	  same
	  tmp-old-car
	  tmp-same
	  (first-time-p t)
	  old-car)
      (nconc
801 802 803
       (apply #'nconc
	      (mapcar
	       (lambda (item)
Stephen Eglen's avatar
Stephen Eglen committed
804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819
		 (cond
		  (first-time-p
		   (push (cdr item) same)
		   (setq first-time-p nil)
		   (setq old-car (car item))
		   nil)
		  ((funcall same-predicate (car item) old-car)
		   (push (cdr item) same)
		   nil)
		  (t
		   (setq tmp-same same
			 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)
820
			     (funcall sort-predicate (car item1) (car item2))))))
Stephen Eglen's avatar
Stephen Eglen committed
821 822 823 824 825 826 827 828 829 830
       (list (cons old-car (nreverse same)))))))


(defun msb--mode-menu-cond ()
  (let ((key msb-modes-key))
    (mapcar (lambda (item)
	      (incf key)
	      (list `( eq major-mode (quote ,(car item)))
		    key
		    (concat (cdr item) " (%d)")))
831
	    (sort
Stephen Eglen's avatar
Stephen Eglen committed
832
	     (let ((mode-list nil))
833 834 835 836 837 838 839
	       (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))))
Stephen Eglen's avatar
Stephen Eglen committed
840 841 842 843
	       mode-list)
	     (lambda (item1 item2)
	       (string< (cdr item1) (cdr item2)))))))

Richard M. Stallman's avatar
Richard M. Stallman committed
844
(defun msb--most-recently-used-menu (max-buffer-name-length)
845 846
  "Return a list for the most recently used buffers.
It takes the form ((TITLE . BUFFER-LIST)...)."
847 848
  (when (and (numberp msb-display-most-recently-used)
 	     (> msb-display-most-recently-used 0))
849 850
    (let* ((buffers (cdr (buffer-list)))
	   (most-recently-used
Richard M. Stallman's avatar
Richard M. Stallman committed
851
	    (loop with n = 0
852
		  for buffer in buffers
Richard M. Stallman's avatar
Richard M. Stallman committed
853 854 855 856 857 858 859 860 861 862 863
		  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)
864
		  until (>= n msb-display-most-recently-used))))
Richard M. Stallman's avatar
Richard M. Stallman committed
865 866 867 868 869 870 871 872 873 874 875
      (cons (if (stringp msb-most-recently-used-title)
		(format msb-most-recently-used-title
			(length most-recently-used))
	      (signal 'wrong-type-argument (list msb-most-recently-used-title)))
	    most-recently-used))))

(defun msb--create-buffer-menu-2 ()
  (let ((max-buffer-name-length 0)
	file-buffers
	function-info-vector)
    ;; Calculate the longest buffer name.
876 877 878 879 880
    (dolist (buffer (buffer-list))
      (when (or msb-display-invisible-buffers-p
		(not (msb-invisible-buffer-p)))
	(setq max-buffer-name-length
	      (max max-buffer-name-length (length (buffer-name buffer))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
881 882 883 884 885 886 887 888 889 890 891 892
    ;; Make a list with elements of type
    ;; (BUFFER-LIST-VARIABLE
    ;;  CONDITION
    ;;  MENU-SORT-KEY
    ;;  MENU-TITLE
    ;;  ITEM-HANDLER
    ;;  SORTER)
    ;; Uses "function-global" variables:
    ;; function-info-vector
    (setq function-info-vector
	  (apply (function vector)
		 (mapcar (function msb--create-function-info)
Stephen Eglen's avatar
Stephen Eglen committed
893
			 (append msb-menu-cond (msb--mode-menu-cond)))))
Richard M. Stallman's avatar
Richard M. Stallman committed
894
    ;; Split the buffer-list into several lists; one list for each
895
    ;; criteria.  This is the most critical part with respect to time.
896 897 898 899 900 901 902 903 904 905 906 907
    (dolist (buffer (buffer-list))
      (cond ((and msb-files-by-directory
		  (buffer-file-name buffer)
		  ;; exclude ange-ftp buffers
		  ;;(not (string-match "\\/[^/:]+:"
		  ;;		   (buffer-file-name buffer)))
		  )
	     (push buffer file-buffers))
	    (t
	     (msb--choose-menu buffer
			       function-info-vector
			       max-buffer-name-length))))
Richard M. Stallman's avatar
Richard M. Stallman committed
908 909
    (when file-buffers
      (setq file-buffers
Stephen Eglen's avatar
Stephen Eglen committed
910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925
	    (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))))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
926 927
		     (msb--choose-file-menu file-buffers))))
    ;; Now make the menu - a list of (TITLE . BUFFER-LIST)
928
    (let* (menu
Richard M. Stallman's avatar
Richard M. Stallman committed
929 930
	   (most-recently-used
	    (msb--most-recently-used-menu max-buffer-name-length))
931
	   (others (nconc file-buffers
Richard M. Stallman's avatar
Richard M. Stallman committed
932
			   (loop for elt
933 934 935
				 across function-info-vector
				 for value = (msb--create-sort-item elt)
				 if value collect value))))
Richard M. Stallman's avatar
Richard M. Stallman committed
936 937 938 939 940 941 942 943 944 945 946 947 948 949
      (setq menu
	    (mapcar 'cdr		;Remove the SORT-KEY
		    ;; Sort the menus - not the items.
		    (msb--add-separators
		    (sort
		     ;; Get a list of (SORT-KEY TITLE . BUFFER-LIST)
		     ;; Also sorts the items within the menus.
		     (if (cdr most-recently-used)
			 (cons
			  ;; Add most recent used buffers
			  (cons msb-most-recently-used-sort-key
				most-recently-used)
			  others)
		       others)
Stephen Eglen's avatar
Stephen Eglen committed
950 951
		     (lambda (elt1 elt2)
		       (< (car elt1) (car elt2)))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
952 953 954 955 956
      ;; Now make it a keymap menu
      (append
       '(keymap "Select Buffer")
       (msb--make-keymap-menu menu)
       (when msb-separator-diff
957 958
	 (list (list 'separator "--")))
       (list (cons 'toggle
Richard M. Stallman's avatar
Richard M. Stallman committed
959 960
		   (cons
		   (if msb-files-by-directory
961 962 963
			       "*Files by type*"
			     "*Files by directory*")
			   'msb--toggle-menu-type)))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
964 965 966 967 968 969 970

(defun msb--create-buffer-menu  ()
  (save-match-data
    (save-excursion
      (msb--create-buffer-menu-2))))

(defun msb--toggle-menu-type ()
971
  "Multi purpose function for selecting a buffer with the mouse."
Richard M. Stallman's avatar
Richard M. Stallman committed
972 973
  (interactive)
  (setq msb-files-by-directory (not msb-files-by-directory))
974 975
  ;; This gets a warning, but it is correct,
  ;; because this file redefines menu-bar-update-buffers.
976
  (msb-menu-bar-update-buffers t))
Richard M. Stallman's avatar
Richard M. Stallman committed
977 978 979 980 981

(defun mouse-select-buffer (event)
  "Pop up several menus of buffers, for selection with the mouse.
Returns the selected buffer or nil if no buffer is selected.

982
The way the buffers are split is conveniently handled with the
983
variable `msb-menu-cond'."
Richard M. Stallman's avatar
Richard M. Stallman committed
984 985 986 987 988 989 990
  ;; Popup the menu and return the selected buffer.
  (when (or msb--error
	    (not msb--last-buffer-menu)
	    (not (fboundp 'frame-or-buffer-changed-p))
	    (frame-or-buffer-changed-p))
    (setq msb--error nil)
    (setq msb--last-buffer-menu (msb--create-buffer-menu)))
991 992
  (let ((position event)
	choice)
Richard M. Stallman's avatar
Richard M. Stallman committed
993 994 995 996
    (when (and (fboundp 'posn-x-y)
	       (fboundp 'posn-window))
      (let ((posX (car (posn-x-y (event-start event))))
	    (posY (cdr (posn-x-y (event-start event))))
997
	    (posWind (posn-window (event-start event))))
Richard M. Stallman's avatar
Richard M. Stallman committed
998 999 1000
	;; adjust position
	(setq posX (- posX (funcall msb-horizontal-shift-function))
	      position (list (list posX posY) posWind))))
1001
    ;; Popup the menu
1002
    (setq choice (x-popup-menu position msb--last-buffer-menu))
Richard M. Stallman's avatar
Richard M. Stallman committed
1003
    (cond
1004 1005 1006 1007 1008 1009
     ((eq (car choice) 'toggle)
      ;; Bring up the menu again with type toggled.
      (msb--toggle-menu-type)
      (mouse-select-buffer event))
     ((and (numberp (car choice))
	   (null (cdr choice)))
1010
      (let ((msb--last-buffer-menu (nthcdr 2 (assq (car choice)
1011
						   msb--last-buffer-menu))))
Richard M. Stallman's avatar
Richard M. Stallman committed
1012
	(mouse-select-buffer event)))
1013 1014 1015 1016 1017
     ((while (numberp (car choice))
	(setq choice (cdr choice))))
     ((and (stringp (car choice))
	   (null (cdr choice)))
      (car choice))
1018 1019
     ((null choice)
      choice)
1020 1021
     (t
      (error "Unknown form for buffer: %s" choice)))))
Stephen Eglen's avatar
Stephen Eglen committed
1022

Richard M. Stallman's avatar
Richard M. Stallman committed
1023 1024
;; Add separators
(defun msb--add-separators (sorted-list)
1025 1026 1027
  (if (or (not msb-separator-diff)
	  (not (numberp msb-separator-diff)))
      sorted-list
Richard M. Stallman's avatar
Richard M. Stallman committed
1028
    (let ((last-key nil))
1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043
      (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)))))
Richard M. Stallman's avatar
Richard M. Stallman committed
1044

1045 1046 1047