Commit | Line | Data |
---|---|---|
55535639 | 1 | ;;; msb.el --- customizable buffer-selection with multiple menus |
b578f267 | 2 | |
acaf905b | 3 | ;; Copyright (C) 1993-1995, 1997-2012 Free Software Foundation, Inc. |
b578f267 | 4 | |
17df99ea | 5 | ;; Author: Lars Lindberg <lars.lindberg@home.se> |
eed30659 | 6 | ;; Maintainer: FSF |
b9a5a6af | 7 | ;; Created: 8 Oct 1993 |
3cfa0ee9 | 8 | ;; Lindberg's last update version: 3.34 |
0eb3b336 | 9 | ;; Keywords: mouse buffer menu |
b578f267 EN |
10 | |
11 | ;; This file is part of GNU Emacs. | |
12 | ||
eb3fa2cf | 13 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
b9a5a6af | 14 | ;; it under the terms of the GNU General Public License as published by |
eb3fa2cf GM |
15 | ;; the Free Software Foundation, either version 3 of the License, or |
16 | ;; (at your option) any later version. | |
b578f267 EN |
17 | |
18 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
b9a5a6af RS |
19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
21 | ;; GNU General Public License for more details. | |
b578f267 | 22 | |
b9a5a6af | 23 | ;; You should have received a copy of the GNU General Public License |
eb3fa2cf | 24 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
b9a5a6af | 25 | |
b9a5a6af | 26 | ;;; Commentary: |
b578f267 | 27 | |
b9a5a6af RS |
28 | ;; Purpose of this package: |
29 | ;; 1. Offer a function for letting the user choose buffer, | |
30 | ;; not necessarily for switching to it. | |
aade135d DL |
31 | ;; 2. Make a better mouse-buffer-menu. This is done as a global |
32 | ;; minor mode, msb-mode. | |
b9a5a6af RS |
33 | ;; |
34 | ;; Customization: | |
2e6286be RS |
35 | ;; Look at the variable `msb-menu-cond' for deciding what menus you |
36 | ;; want. It's not that hard to customize, despite my not-so-good | |
37 | ;; doc-string. Feel free to send me a better doc-string. | |
b9a5a6af RS |
38 | ;; There are some constants for you to try here: |
39 | ;; msb--few-menus | |
40 | ;; msb--very-many-menus (default) | |
f1180544 | 41 | ;; |
2e6286be RS |
42 | ;; Look at the variable `msb-item-handling-function' for customization |
43 | ;; of the appearance of every menu item. Try for instance setting | |
44 | ;; it to `msb-alon-item-handler'. | |
f1180544 | 45 | ;; |
2e6286be RS |
46 | ;; Look at the variable `msb-item-sort-function' for customization |
47 | ;; of sorting the menus. Set it to t for instance, which means no | |
b9a5a6af RS |
48 | ;; sorting - you will get latest used buffer first. |
49 | ;; | |
2e6286be | 50 | ;; Also check out the variable `msb-display-invisible-buffers-p'. |
b9a5a6af RS |
51 | |
52 | ;; Known bugs: | |
4aa4849b | 53 | ;; - Files-by-directory |
fd46fd17 | 54 | ;; + No possibility to show client/changed buffers separately. |
3cfa0ee9 | 55 | ;; + All file buffers only appear in a file sub-menu, they will |
fd46fd17 RS |
56 | ;; for instance not appear in the Mail sub-menu. |
57 | ||
b9a5a6af | 58 | ;; Future enhancements: |
b9a5a6af | 59 | |
b9a5a6af | 60 | ;;; Thanks goes to |
fd46fd17 RS |
61 | ;; Mark Brader <msb@sq.com> |
62 | ;; Jim Berry <m1jhb00@FRB.GOV> | |
63 | ;; Hans Chalupsky <hans@cs.Buffalo.EDU> | |
64 | ;; Larry Rosenberg <ljr@ictv.com> | |
65 | ;; Will Henney <will@astroscu.unam.mx> | |
66 | ;; Jari Aalto <jaalto@tre.tele.nokia.fi> | |
67 | ;; Michael Kifer <kifer@sbkifer.cs.sunysb.edu> | |
68 | ;; Gael Marziou <gael@gnlab030.grenoble.hp.com> | |
69 | ;; Dave Gillespie <daveg@thymus.synaptics.com> | |
70 | ;; Alon Albert <alon@milcse.rtsg.mot.com> | |
71 | ;; Kevin Broadey, <KevinB@bartley.demon.co.uk> | |
72 | ;; Ake Stenhof <ake@cadpoint.se> | |
5762abec | 73 | ;; Richard Stallman <rms@gnu.org> |
fd46fd17 | 74 | ;; Steve Fisk <fisk@medved.bowdoin.edu> |
b9a5a6af | 75 | |
492bd758 DL |
76 | ;; This version turned into a global minor mode and subsequently |
77 | ;; hacked on by Dave Love. | |
b9a5a6af RS |
78 | ;;; Code: |
79 | ||
f58e0fd5 | 80 | (eval-when-compile (require 'cl-lib)) |
b9a5a6af | 81 | |
f58e0fd5 SM |
82 | ;; |
83 | ;; Some example constants to be used for `msb-menu-cond'. See that | |
84 | ;; variable for more information. Please note that if the condition | |
85 | ;; returns `multi', then the buffer can appear in several menus. | |
86 | ;; | |
b9a5a6af RS |
87 | (defconst msb--few-menus |
88 | '(((and (boundp 'server-buffer-clients) | |
89 | server-buffer-clients | |
90 | 'multi) | |
91 | 3030 | |
92 | "Clients (%d)") | |
93 | ((and msb-display-invisible-buffers-p | |
94 | (msb-invisible-buffer-p) | |
95 | 'multi) | |
96 | 3090 | |
97 | "Invisible buffers (%d)") | |
98 | ((eq major-mode 'dired-mode) | |
99 | 2010 | |
100 | "Dired (%d)" | |
101 | msb-dired-item-handler | |
102 | msb-sort-by-directory) | |
103 | ((eq major-mode 'Man-mode) | |
104 | 4090 | |
105 | "Manuals (%d)") | |
106 | ((eq major-mode 'w3-mode) | |
107 | 4020 | |
108 | "WWW (%d)") | |
a4a49c21 DL |
109 | ((or (memq major-mode |
110 | '(rmail-mode rmail-edit-mode vm-summary-mode vm-mode mail-mode)) | |
111 | (memq major-mode '(mh-letter-mode mh-show-mode mh-folder-mode)) | |
112 | (memq major-mode | |
113 | '(gnus-summary-mode message-mode gnus-group-mode | |
114 | gnus-article-mode score-mode gnus-browse-killed-mode))) | |
b9a5a6af RS |
115 | 4010 |
116 | "Mail (%d)") | |
117 | ((not buffer-file-name) | |
118 | 4099 | |
119 | "Buffers (%d)") | |
120 | ('no-multi | |
121 | 1099 | |
122 | "Files (%d)"))) | |
123 | ||
124 | (defconst msb--very-many-menus | |
125 | '(((and (boundp 'server-buffer-clients) | |
126 | server-buffer-clients | |
127 | 'multi) | |
128 | 1010 | |
129 | "Clients (%d)") | |
130 | ((and (boundp 'vc-mode) vc-mode 'multi) | |
131 | 1020 | |
132 | "Version Control (%d)") | |
133 | ((and buffer-file-name | |
134 | (buffer-modified-p) | |
135 | 'multi) | |
136 | 1030 | |
137 | "Changed files (%d)") | |
138 | ((and (get-buffer-process (current-buffer)) | |
139 | 'multi) | |
140 | 1040 | |
141 | "Processes (%d)") | |
142 | ((and msb-display-invisible-buffers-p | |
143 | (msb-invisible-buffer-p) | |
144 | 'multi) | |
145 | 1090 | |
0eb3b336 | 146 | "Invisible buffers (%d)") |
b9a5a6af RS |
147 | ((eq major-mode 'dired-mode) |
148 | 2010 | |
149 | "Dired (%d)" | |
150 | ;; Note this different menu-handler | |
151 | msb-dired-item-handler | |
152 | ;; Also note this item-sorter | |
153 | msb-sort-by-directory) | |
154 | ((eq major-mode 'Man-mode) | |
3cfa0ee9 | 155 | 5030 |
b9a5a6af RS |
156 | "Manuals (%d)") |
157 | ((eq major-mode 'w3-mode) | |
3cfa0ee9 | 158 | 5020 |
b9a5a6af | 159 | "WWW (%d)") |
a4a49c21 DL |
160 | ((or (memq major-mode |
161 | '(rmail-mode rmail-edit-mode vm-summary-mode vm-mode mail-mode)) | |
162 | (memq major-mode '(mh-letter-mode mh-show-mode mh-folder-mode)) | |
163 | (memq major-mode '(gnus-summary-mode message-mode gnus-group-mode | |
164 | gnus-article-mode score-mode | |
b9a5a6af | 165 | gnus-browse-killed-mode))) |
3cfa0ee9 | 166 | 5010 |
b9a5a6af RS |
167 | "Mail (%d)") |
168 | ;; Catchup for all non-file buffers | |
169 | ((and (not buffer-file-name) | |
170 | 'no-multi) | |
3cfa0ee9 | 171 | 5099 |
b9a5a6af RS |
172 | "Other non-file buffers (%d)") |
173 | ((and (string-match "/\\.[^/]*$" buffer-file-name) | |
174 | 'multi) | |
175 | 3090 | |
176 | "Hidden Files (%d)") | |
177 | ((memq major-mode '(c-mode c++-mode)) | |
178 | 3010 | |
179 | "C/C++ Files (%d)") | |
180 | ((eq major-mode 'emacs-lisp-mode) | |
181 | 3020 | |
182 | "Elisp Files (%d)") | |
183 | ((eq major-mode 'latex-mode) | |
184 | 3030 | |
8e2c8d3e | 185 | "LaTeX Files (%d)") |
b9a5a6af RS |
186 | ('no-multi |
187 | 3099 | |
188 | "Other files (%d)"))) | |
189 | ||
b9a5a6af RS |
190 | ;;; |
191 | ;;; Customizable variables | |
192 | ;;; | |
193 | ||
3cfa0ee9 SE |
194 | (defgroup msb nil |
195 | "Customizable buffer-selection with multiple menus." | |
196 | :prefix "msb-" | |
197 | :group 'mouse) | |
198 | ||
199 | (defun msb-custom-set (symbol value) | |
200 | "Set the value of custom variables for msb." | |
201 | (set symbol value) | |
eed30659 | 202 | (if (and (featurep 'msb) msb-mode) |
3cfa0ee9 SE |
203 | ;; wait until package has been loaded before bothering to update |
204 | ;; the buffer lists. | |
eed30659 | 205 | (msb-menu-bar-update-buffers t))) |
3cfa0ee9 SE |
206 | |
207 | (defcustom msb-menu-cond msb--very-many-menus | |
9201cc28 | 208 | "List of criteria for splitting the mouse buffer menu. |
3cfa0ee9 SE |
209 | The elements in the list should be of this type: |
210 | (CONDITION MENU-SORT-KEY MENU-TITLE ITEM-HANDLING-FN ITEM-SORT-FN). | |
211 | ||
212 | When making the split, the buffers are tested one by one against the | |
aade135d | 213 | CONDITION, just like a Lisp cond: When hitting a true condition, the |
3cfa0ee9 SE |
214 | other criteria are *not* tested and the buffer name will appear in the |
215 | menu with the menu-title corresponding to the true condition. | |
216 | ||
217 | If the condition returns the symbol `multi', then the buffer will be | |
218 | added to this menu *and* tested for other menus too. If it returns | |
219 | `no-multi', then the buffer will only be added if it hasn't been added | |
220 | to any other menu. | |
221 | ||
222 | During this test, the buffer in question is the current buffer, and | |
223 | the test is surrounded by calls to `save-excursion' and | |
224 | `save-match-data'. | |
225 | ||
226 | The categories are sorted by MENU-SORT-KEY. Smaller keys are on top. | |
c11bf648 | 227 | A value of nil means don't display this menu. |
3cfa0ee9 SE |
228 | |
229 | MENU-TITLE is really a format. If you add %d in it, the %d is | |
230 | replaced with the number of items in that menu. | |
231 | ||
20ba690c JB |
232 | ITEM-HANDLING-FN is optional. If it is supplied and is a function, |
233 | then it is used for displaying the items in that particular buffer | |
3cfa0ee9 SE |
234 | menu, otherwise the function pointed out by |
235 | `msb-item-handling-function' is used. | |
236 | ||
20ba690c | 237 | ITEM-SORT-FN is also optional. |
3cfa0ee9 SE |
238 | If it is not supplied, the function pointed out by |
239 | `msb-item-sort-function' is used. | |
240 | If it is nil, then no sort takes place and the buffers are presented | |
241 | in least-recently-used order. | |
242 | If it is t, then no sort takes place and the buffers are presented in | |
243 | most-recently-used order. | |
244 | If it is supplied and non-nil and not t than it is used for sorting | |
245 | the items in that particular buffer menu. | |
246 | ||
247 | Note1: There should always be a `catch-all' as last element, in this | |
248 | list. That is an element like (t TITLE ITEM-HANDLING-FUNCTION). | |
249 | Note2: A buffer menu appears only if it has at least one buffer in it. | |
250 | Note3: If you have a CONDITION that can't be evaluated you will get an | |
251 | error every time you do \\[msb]." | |
252 | :type `(choice (const :tag "long" :value ,msb--very-many-menus) | |
25bb0401 GM |
253 | (const :tag "short" :value ,msb--few-menus) |
254 | (sexp :tag "user")) | |
3cfa0ee9 SE |
255 | :set 'msb-custom-set |
256 | :group 'msb) | |
257 | ||
258 | (defcustom msb-modes-key 4000 | |
259 | "The sort key for files sorted by mode." | |
260 | :type 'integer | |
261 | :set 'msb-custom-set | |
f9e9ac1d DN |
262 | :group 'msb |
263 | :version "20.3") | |
3cfa0ee9 SE |
264 | |
265 | (defcustom msb-separator-diff 100 | |
9201cc28 | 266 | "Non-nil means use separators. |
0eb3b336 | 267 | The separators will appear between all menus that have a sorting key |
3cfa0ee9 SE |
268 | that differs by this value or more." |
269 | :type '(choice integer (const nil)) | |
270 | :set 'msb-custom-set | |
271 | :group 'msb) | |
b9a5a6af RS |
272 | |
273 | (defvar msb-files-by-directory-sort-key 0 | |
fb7ada5f | 274 | "The sort key for files sorted by directory.") |
b9a5a6af | 275 | |
3cfa0ee9 | 276 | (defcustom msb-max-menu-items 15 |
9201cc28 | 277 | "The maximum number of items in a menu. |
0eb3b336 | 278 | If this variable is set to 15 for instance, then the submenu will be |
20ba690c | 279 | split up in minor parts, 15 items each. A value of nil means no limit." |
3cfa0ee9 SE |
280 | :type '(choice integer (const nil)) |
281 | :set 'msb-custom-set | |
282 | :group 'msb) | |
b9a5a6af | 283 | |
3cfa0ee9 | 284 | (defcustom msb-max-file-menu-items 10 |
9201cc28 | 285 | "The maximum number of items from different directories. |
b9a5a6af | 286 | |
2e6286be | 287 | When the menu is of type `file by directory', this is the maximum |
6331da4b | 288 | number of buffers that are clumped together from different |
b9a5a6af RS |
289 | directories. |
290 | ||
4aa4849b RS |
291 | Set this to 1 if you want one menu per directory instead of clumping |
292 | them together. | |
293 | ||
3cfa0ee9 SE |
294 | If the value is not a number, then the value 10 is used." |
295 | :type 'integer | |
296 | :set 'msb-custom-set | |
297 | :group 'msb) | |
b9a5a6af | 298 | |
3cfa0ee9 | 299 | (defcustom msb-most-recently-used-sort-key -1010 |
9201cc28 | 300 | "Where should the menu with the most recently used buffers be placed?" |
3cfa0ee9 SE |
301 | :type 'integer |
302 | :set 'msb-custom-set | |
303 | :group 'msb) | |
b9a5a6af | 304 | |
3cfa0ee9 | 305 | (defcustom msb-display-most-recently-used 15 |
9201cc28 | 306 | "How many buffers should be in the most-recently-used menu. |
3cfa0ee9 SE |
307 | No buffers at all if less than 1 or nil (or any non-number)." |
308 | :type 'integer | |
309 | :set 'msb-custom-set | |
310 | :group 'msb) | |
311 | ||
312 | (defcustom msb-most-recently-used-title "Most recently used (%d)" | |
9201cc28 | 313 | "The title for the most-recently-used menu." |
3cfa0ee9 SE |
314 | :type 'string |
315 | :set 'msb-custom-set | |
316 | :group 'msb) | |
f1180544 | 317 | |
4f91a816 | 318 | (defvar msb-horizontal-shift-function (lambda () 0) |
fb7ada5f | 319 | "Function that specifies how many pixels to shift the top menu leftwards.") |
b9a5a6af | 320 | |
3cfa0ee9 | 321 | (defcustom msb-display-invisible-buffers-p nil |
9201cc28 | 322 | "Show invisible buffers or not. |
b9a5a6af | 323 | Non-nil means that the buffer menu should include buffers that have |
3cfa0ee9 SE |
324 | names that starts with a space character." |
325 | :type 'boolean | |
326 | :set 'msb-custom-set | |
327 | :group 'msb) | |
b9a5a6af RS |
328 | |
329 | (defvar msb-item-handling-function 'msb-item-handler | |
fb7ada5f | 330 | "The appearance of a buffer menu. |
b9a5a6af RS |
331 | |
332 | The default function to call for handling the appearance of a menu | |
20ba690c | 333 | item. It should take two arguments, BUFFER and MAX-BUFFER-NAME-LENGTH, |
b9a5a6af | 334 | where the latter is the max length of all buffer names. |
4aa4849b RS |
335 | |
336 | The function should return the string to use in the menu. | |
337 | ||
0eb3b336 RS |
338 | When the function is called, BUFFER is the current buffer. This |
339 | function is called for items in the variable `msb-menu-cond' that have | |
340 | nil as ITEM-HANDLING-FUNCTION. See `msb-menu-cond' for more | |
b9a5a6af RS |
341 | information.") |
342 | ||
3cfa0ee9 | 343 | (defcustom msb-item-sort-function 'msb-sort-by-name |
9201cc28 | 344 | "The order of items in a buffer menu. |
0eb3b336 | 345 | |
b9a5a6af | 346 | The default function to call for handling the order of items in a menu |
0eb3b336 RS |
347 | item. This function is called like a sort function. The items look |
348 | like (ITEM-NAME . BUFFER). | |
349 | ||
b9a5a6af RS |
350 | ITEM-NAME is the name of the item that will appear in the menu. |
351 | BUFFER is the buffer, this is not necessarily the current buffer. | |
352 | ||
3cfa0ee9 SE |
353 | Set this to nil or t if you don't want any sorting (faster)." |
354 | :type '(choice (const msb-sort-by-name) | |
355 | (const :tag "Newest first" t) | |
356 | (const :tag "Oldest first" nil)) | |
357 | :set 'msb-custom-set | |
a4a49c21 | 358 | :group 'msb) |
f1180544 | 359 | |
3cfa0ee9 | 360 | (defcustom msb-files-by-directory nil |
9201cc28 | 361 | "Non-nil means that files should be sorted by directory. |
aade135d | 362 | This is instead of the groups in `msb-menu-cond'." |
3cfa0ee9 SE |
363 | :type 'boolean |
364 | :set 'msb-custom-set | |
365 | :group 'msb) | |
b9a5a6af | 366 | |
ed7646d4 GM |
367 | (define-obsolete-variable-alias 'msb-after-load-hooks |
368 | 'msb-after-load-hook "24.1") | |
369 | ||
3392cf05 SM |
370 | (defcustom msb-after-load-hook nil |
371 | "Hook run after the msb package has been loaded." | |
3cfa0ee9 SE |
372 | :type 'hook |
373 | :set 'msb-custom-set | |
374 | :group 'msb) | |
b9a5a6af RS |
375 | |
376 | ;;; | |
377 | ;;; Internal variables | |
378 | ;;; | |
379 | ||
380 | ;; The last calculated menu. | |
381 | (defvar msb--last-buffer-menu nil) | |
382 | ||
383 | ;; If this is non-nil, then it is a string that describes the error. | |
384 | (defvar msb--error nil) | |
385 | ||
386 | ;;; | |
4aa4849b | 387 | ;;; Some example function to be used for `msb-item-handling-function'. |
b9a5a6af RS |
388 | ;;; |
389 | (defun msb-item-handler (buffer &optional maxbuf) | |
390 | "Create one string item, concerning BUFFER, for the buffer menu. | |
391 | The item looks like: | |
392 | *% <buffer-name> | |
2e6286be RS |
393 | The `*' appears only if the buffer is marked as modified. |
394 | The `%' appears only if the buffer is read-only. | |
b9a5a6af RS |
395 | Optional second argument MAXBUF is completely ignored." |
396 | (let ((name (buffer-name)) | |
397 | (modified (if (buffer-modified-p) "*" " ")) | |
398 | (read-only (if buffer-read-only "%" " "))) | |
399 | (format "%s%s %s" modified read-only name))) | |
400 | ||
401 | ||
2e6286be RS |
402 | ;; `dired' can be called with a list of the form (directory file1 file2 ...) |
403 | ;; which causes `dired-directory' to be in the same form. | |
b9a5a6af RS |
404 | (defun msb--dired-directory () |
405 | (cond ((stringp dired-directory) | |
406 | (abbreviate-file-name (expand-file-name dired-directory))) | |
407 | ((consp dired-directory) | |
408 | (abbreviate-file-name (expand-file-name (car dired-directory)))) | |
409 | (t | |
2e6286be | 410 | (error "Unknown type of `dired-directory' in buffer %s" |
b9a5a6af RS |
411 | (buffer-name))))) |
412 | ||
413 | (defun msb-dired-item-handler (buffer &optional maxbuf) | |
414 | "Create one string item, concerning a dired BUFFER, for the buffer menu. | |
415 | The item looks like: | |
416 | *% <buffer-name> | |
2e6286be RS |
417 | The `*' appears only if the buffer is marked as modified. |
418 | The `%' appears only if the buffer is read-only. | |
b9a5a6af RS |
419 | Optional second argument MAXBUF is completely ignored." |
420 | (let ((name (msb--dired-directory)) | |
421 | (modified (if (buffer-modified-p) "*" " ")) | |
422 | (read-only (if buffer-read-only "%" " "))) | |
423 | (format "%s%s %s" modified read-only name))) | |
424 | ||
425 | (defun msb-alon-item-handler (buffer maxbuf) | |
426 | "Create one string item for the buffer menu. | |
427 | The item looks like: | |
428 | <buffer-name> *%# <file-name> | |
2e6286be RS |
429 | The `*' appears only if the buffer is marked as modified. |
430 | The `%' appears only if the buffer is read-only. | |
431 | The `#' appears only version control file (SCCS/RCS)." | |
b9a5a6af RS |
432 | (format (format "%%%ds %%s%%s%%s %%s" maxbuf) |
433 | (buffer-name buffer) | |
434 | (if (buffer-modified-p) "*" " ") | |
435 | (if buffer-read-only "%" " ") | |
436 | (if (and (boundp 'vc-mode) vc-mode) "#" " ") | |
437 | (or buffer-file-name ""))) | |
438 | ||
439 | ;;; | |
4aa4849b | 440 | ;;; Some example function to be used for `msb-item-sort-function'. |
b9a5a6af RS |
441 | ;;; |
442 | (defun msb-sort-by-name (item1 item2) | |
aade135d DL |
443 | "Sort the items ITEM1 and ITEM2 by their `buffer-name'. |
444 | An item looks like (NAME . BUFFER)." | |
b9a5a6af RS |
445 | (string-lessp (buffer-name (cdr item1)) |
446 | (buffer-name (cdr item2)))) | |
447 | ||
448 | ||
449 | (defun msb-sort-by-directory (item1 item2) | |
aade135d | 450 | "Sort the items ITEM1 and ITEM2 by directory name. Made for dired. |
b9a5a6af | 451 | An item look like (NAME . BUFFER)." |
7ccc8f70 SM |
452 | (string-lessp (with-current-buffer (cdr item1) |
453 | (msb--dired-directory)) | |
454 | (with-current-buffer (cdr item2) | |
455 | (msb--dired-directory)))) | |
b9a5a6af RS |
456 | |
457 | ;;; | |
458 | ;;; msb | |
459 | ;;; | |
460 | ;;; This function can be used instead of (mouse-buffer-menu EVENT) | |
461 | ;;; function in "mouse.el". | |
0eb3b336 | 462 | ;;; |
b9a5a6af RS |
463 | (defun msb (event) |
464 | "Pop up several menus of buffers for selection with the mouse. | |
465 | This command switches buffers in the window that you clicked on, and | |
466 | selects that window. | |
467 | ||
2e6286be RS |
468 | See the function `mouse-select-buffer' and the variable |
469 | `msb-menu-cond' for more information about how the menus are split." | |
b9a5a6af | 470 | (interactive "e") |
fd46fd17 | 471 | (let ((old-window (selected-window)) |
809b6e98 CY |
472 | (window (posn-window (event-start event))) |
473 | early-release) | |
fd46fd17 | 474 | (unless (framep window) (select-window window)) |
809b6e98 CY |
475 | ;; This `sit-for' magically makes the menu stay up if the mouse |
476 | ;; button is released within 0.1 second. | |
477 | (setq early-release (not (sit-for 0.1 t))) | |
fd46fd17 RS |
478 | (let ((buffer (mouse-select-buffer event))) |
479 | (if buffer | |
480 | (switch-to-buffer buffer) | |
809b6e98 CY |
481 | (select-window old-window))) |
482 | ;; If the above `sit-for' was interrupted by a mouse-up, avoid | |
483 | ;; generating a drag event. | |
484 | (if (and early-release (memq 'down (event-modifiers last-input-event))) | |
485 | (discard-input))) | |
b9a5a6af RS |
486 | nil) |
487 | ||
488 | ;;; | |
489 | ;;; Some supportive functions | |
490 | ;;; | |
491 | (defun msb-invisible-buffer-p (&optional buffer) | |
492 | "Return t if optional BUFFER is an \"invisible\" buffer. | |
493 | If the argument is left out or nil, then the current buffer is considered." | |
494 | (and (> (length (buffer-name buffer)) 0) | |
e665a469 | 495 | (eq ?\s (aref (buffer-name buffer) 0)))) |
b9a5a6af | 496 | |
7612d61a | 497 | (defun msb--strip-dir (dir) |
eed30659 | 498 | "Strip one hierarchy level from the end of DIR." |
862aacbf | 499 | (file-name-directory (directory-file-name dir))) |
b9a5a6af RS |
500 | |
501 | ;; Create an alist with all buffers from LIST that lies under the same | |
965440e6 KS |
502 | ;; directory will be in the same item as the directory name. |
503 | ;; ((DIR1 . (BUFFER-1 BUFFER-2 ...)) (DIR2 . (BUFFER-K BUFFER-K+1...)) ...) | |
b9a5a6af RS |
504 | (defun msb--init-file-alist (list) |
505 | (let ((buffer-alist | |
0eb3b336 | 506 | ;; Make alist that looks like |
965440e6 KS |
507 | ;; ((DIR-1 BUFFER-1) (DIR-2 BUFFER-2) ...) |
508 | ;; sorted on DIR-x | |
a4a49c21 DL |
509 | (sort |
510 | (apply #'nconc | |
511 | (mapcar | |
512 | (lambda (buffer) | |
513 | (let ((file-name (expand-file-name | |
514 | (buffer-file-name buffer)))) | |
515 | (when file-name | |
516 | (list (cons (msb--strip-dir file-name) buffer))))) | |
517 | list)) | |
518 | (lambda (item1 item2) | |
519 | (string< (car item1) (car item2)))))) | |
965440e6 | 520 | ;; Now clump buffers together that have the same directory name |
b9a5a6af | 521 | ;; Make alist that looks like |
965440e6 KS |
522 | ;; ((DIR1 . (BUFFER-1 BUFFER-2 ...)) (DIR2 . (BUFFER-K)) ...) |
523 | (let ((dir nil) | |
0eb3b336 RS |
524 | (buffers nil)) |
525 | (nconc | |
a4a49c21 DL |
526 | (apply |
527 | #'nconc | |
528 | (mapcar (lambda (item) | |
529 | (cond | |
965440e6 KS |
530 | ((equal dir (car item)) |
531 | ;; The same dir as earlier: | |
532 | ;; Add to current list of buffers. | |
a4a49c21 DL |
533 | (push (cdr item) buffers) |
534 | ;; This item should not be added to list | |
535 | nil) | |
536 | (t | |
965440e6 KS |
537 | ;; New dir |
538 | (let ((result (and dir (cons dir buffers)))) | |
539 | (setq dir (car item)) | |
a4a49c21 DL |
540 | (setq buffers (list (cdr item))) |
541 | ;; Add the last result the list. | |
542 | (and result (list result)))))) | |
543 | buffer-alist)) | |
0eb3b336 | 544 | ;; Add the last result to the list |
965440e6 | 545 | (list (cons dir buffers)))))) |
b9a5a6af | 546 | |
965440e6 | 547 | (defun msb--format-title (top-found-p dir number-of-items) |
eed30659 | 548 | "Format a suitable title for the menu item." |
492bd758 | 549 | (format (if top-found-p "%s... (%d)" "%s (%d)") |
965440e6 | 550 | (abbreviate-file-name dir) number-of-items)) |
0eb3b336 | 551 | |
c549c1bf RS |
552 | ;; Variables for debugging. |
553 | (defvar msb--choose-file-menu-list) | |
554 | (defvar msb--choose-file-menu-arg-list) | |
0eb3b336 | 555 | |
b9a5a6af | 556 | (defun msb--choose-file-menu (list) |
eed30659 | 557 | "Choose file-menu with respect to directory for every buffer in LIST." |
c549c1bf | 558 | (setq msb--choose-file-menu-arg-list list) |
b9a5a6af RS |
559 | (let ((buffer-alist (msb--init-file-alist list)) |
560 | (final-list nil) | |
561 | (max-clumped-together (if (numberp msb-max-file-menu-items) | |
562 | msb-max-file-menu-items | |
563 | 10)) | |
564 | (top-found-p nil) | |
965440e6 KS |
565 | (last-dir nil) |
566 | first rest dir buffers old-dir) | |
0eb3b336 RS |
567 | ;; Prepare for looping over all items in buffer-alist |
568 | (setq first (car buffer-alist) | |
569 | rest (cdr buffer-alist) | |
965440e6 | 570 | dir (car first) |
0eb3b336 | 571 | buffers (cdr first)) |
a4a49c21 | 572 | (setq msb--choose-file-menu-list (copy-sequence rest)) |
0eb3b336 RS |
573 | ;; This big loop tries to clump buffers together that have a |
574 | ;; similar name. Remember that buffer-alist is sorted based on the | |
965440e6 | 575 | ;; directory name of the buffers' visited files. |
b9a5a6af RS |
576 | (while rest |
577 | (let ((found-p nil) | |
578 | (tmp-rest rest) | |
7ccc8f70 | 579 | item) |
b9a5a6af | 580 | (setq item (car tmp-rest)) |
965440e6 KS |
581 | ;; Clump together the "rest"-buffers that have a dir that is |
582 | ;; a subdir of the current one. | |
b9a5a6af RS |
583 | (while (and tmp-rest |
584 | (<= (length buffers) max-clumped-together) | |
965440e6 | 585 | (>= (length (car item)) (length dir)) |
b9b37d2b DL |
586 | ;; `completion-ignore-case' seems to default to t |
587 | ;; on the systems with case-insensitive file names. | |
965440e6 KS |
588 | (eq t (compare-strings dir 0 nil |
589 | (car item) 0 (length dir) | |
b9b37d2b | 590 | completion-ignore-case))) |
b9a5a6af | 591 | (setq found-p t) |
0eb3b336 RS |
592 | (setq buffers (append buffers (cdr item))) ;nconc is faster than append |
593 | (setq tmp-rest (cdr tmp-rest) | |
594 | item (car tmp-rest))) | |
b9a5a6af RS |
595 | (cond |
596 | ((> (length buffers) max-clumped-together) | |
0eb3b336 RS |
597 | ;; Oh, we failed. Too many buffers clumped together. |
598 | ;; Just use the original ones for the result. | |
965440e6 | 599 | (setq last-dir (car first)) |
0eb3b336 RS |
600 | (push (cons (msb--format-title top-found-p |
601 | (car first) | |
602 | (length (cdr first))) | |
603 | (cdr first)) | |
604 | final-list) | |
4aa4849b | 605 | (setq top-found-p nil) |
b9a5a6af | 606 | (setq first (car rest) |
0eb3b336 | 607 | rest (cdr rest) |
965440e6 | 608 | dir (car first) |
b9a5a6af RS |
609 | buffers (cdr first))) |
610 | (t | |
0eb3b336 RS |
611 | ;; The first pass of clumping together worked out, go ahead |
612 | ;; with this result. | |
b9a5a6af RS |
613 | (when found-p |
614 | (setq top-found-p t) | |
965440e6 | 615 | (setq first (cons dir buffers) |
b9a5a6af | 616 | rest tmp-rest)) |
0eb3b336 RS |
617 | ;; Now see if we can clump more buffers together if we go up |
618 | ;; one step in the file hierarchy. | |
965440e6 | 619 | ;; If dir isn't changed by msb--strip-dir, we are looking |
3cfa0ee9 | 620 | ;; at the machine name component of an ange-ftp filename. |
965440e6 KS |
621 | (setq old-dir dir) |
622 | (setq dir (msb--strip-dir dir) | |
b9a5a6af | 623 | buffers (cdr first)) |
965440e6 KS |
624 | (if (equal old-dir dir) |
625 | (setq last-dir dir)) | |
626 | (when (and last-dir | |
627 | (or (and (>= (length dir) (length last-dir)) | |
b9b37d2b | 628 | (eq t (compare-strings |
965440e6 KS |
629 | last-dir 0 nil dir 0 |
630 | (length last-dir) | |
b9b37d2b | 631 | completion-ignore-case))) |
965440e6 | 632 | (and (< (length dir) (length last-dir)) |
b9b37d2b | 633 | (eq t (compare-strings |
965440e6 | 634 | dir 0 nil last-dir 0 (length dir) |
b9b37d2b | 635 | completion-ignore-case))))) |
0eb3b336 RS |
636 | ;; We have reached the same place in the file hierarchy as |
637 | ;; the last result, so we should quit at this point and | |
638 | ;; take what we have as result. | |
639 | (push (cons (msb--format-title top-found-p | |
640 | (car first) | |
641 | (length (cdr first))) | |
642 | (cdr first)) | |
643 | final-list) | |
4aa4849b | 644 | (setq top-found-p nil) |
b9a5a6af | 645 | (setq first (car rest) |
0eb3b336 | 646 | rest (cdr rest) |
965440e6 | 647 | dir (car first) |
0eb3b336 RS |
648 | buffers (cdr first))))))) |
649 | ;; Now take care of the last item. | |
3cfa0ee9 SE |
650 | (when first |
651 | (push (cons (msb--format-title top-found-p | |
652 | (car first) | |
653 | (length (cdr first))) | |
654 | (cdr first)) | |
655 | final-list)) | |
4aa4849b | 656 | (setq top-found-p nil) |
b9a5a6af RS |
657 | (nreverse final-list))) |
658 | ||
b9a5a6af | 659 | (defun msb--create-function-info (menu-cond-elt) |
eed30659 DL |
660 | "Create a vector from an element MENU-COND-ELT of `msb-menu-cond'. |
661 | This takes the form: | |
20ba690c | 662 | \[BUFFER-LIST-VARIABLE CONDITION MENU-SORT-KEY MENU-TITLE ITEM-HANDLER SORTER] |
eed30659 | 663 | See `msb-menu-cond' for a description of its elements." |
b9a5a6af RS |
664 | (let* ((list-symbol (make-symbol "-msb-buffer-list")) |
665 | (tmp-ih (and (> (length menu-cond-elt) 3) | |
666 | (nth 3 menu-cond-elt))) | |
667 | (item-handler (if (and tmp-ih (fboundp tmp-ih)) | |
668 | tmp-ih | |
669 | msb-item-handling-function)) | |
670 | (tmp-s (if (> (length menu-cond-elt) 4) | |
671 | (nth 4 menu-cond-elt) | |
672 | msb-item-sort-function)) | |
673 | (sorter (if (or (fboundp tmp-s) | |
674 | (null tmp-s) | |
2e6286be | 675 | (eq tmp-s t)) |
a4a49c21 | 676 | tmp-s |
b9a5a6af RS |
677 | msb-item-sort-function))) |
678 | (when (< (length menu-cond-elt) 3) | |
aade135d | 679 | (error "Wrong format of msb-menu-cond")) |
b9a5a6af RS |
680 | (when (and (> (length menu-cond-elt) 3) |
681 | (not (fboundp tmp-ih))) | |
682 | (signal 'invalid-function (list tmp-ih))) | |
683 | (when (and (> (length menu-cond-elt) 4) | |
684 | tmp-s | |
685 | (not (fboundp tmp-s)) | |
2e6286be | 686 | (not (eq tmp-s t))) |
b9a5a6af | 687 | (signal 'invalid-function (list tmp-s))) |
2e6286be | 688 | (set list-symbol ()) |
b9a5a6af RS |
689 | (vector list-symbol ;BUFFER-LIST-VARIABLE |
690 | (nth 0 menu-cond-elt) ;CONDITION | |
691 | (nth 1 menu-cond-elt) ;SORT-KEY | |
692 | (nth 2 menu-cond-elt) ;MENU-TITLE | |
693 | item-handler ;ITEM-HANDLER | |
694 | sorter) ;SORTER | |
695 | )) | |
696 | ||
697 | ;; This defsubst is only used in `msb--choose-menu' below. It was | |
3cfa0ee9 | 698 | ;; pulled out merely to make the code somewhat clearer. The indentation |
b9a5a6af RS |
699 | ;; level was too big. |
700 | (defsubst msb--collect (function-info-vector) | |
701 | (let ((result nil) | |
702 | (multi-flag nil) | |
703 | function-info-list) | |
704 | (setq function-info-list | |
f58e0fd5 SM |
705 | (cl-loop for fi |
706 | across function-info-vector | |
707 | if (and (setq result | |
708 | (eval (aref fi 1))) ;Test CONDITION | |
709 | (not (and (eq result 'no-multi) | |
710 | multi-flag)) | |
711 | (progn (when (eq result 'multi) | |
712 | (setq multi-flag t)) | |
713 | t)) | |
714 | collect fi | |
715 | until (and result | |
716 | (not (eq result 'multi))))) | |
b9a5a6af RS |
717 | (when (and (not function-info-list) |
718 | (not result)) | |
719 | (error "No catch-all in msb-menu-cond!")) | |
720 | function-info-list)) | |
721 | ||
b9a5a6af | 722 | (defun msb--add-to-menu (buffer function-info max-buffer-name-length) |
eed30659 DL |
723 | "Add BUFFER to the menu depicted by FUNCTION-INFO. |
724 | All side-effects. Adds an element of form (BUFFER-TITLE . BUFFER) | |
20ba690c | 725 | to the buffer-list variable in FUNCTION-INFO." |
b9a5a6af RS |
726 | (let ((list-symbol (aref function-info 0))) ;BUFFER-LIST-VARIABLE |
727 | ;; Here comes the hairy side-effect! | |
728 | (set list-symbol | |
729 | (cons (cons (funcall (aref function-info 4) ;ITEM-HANDLER | |
730 | buffer | |
731 | max-buffer-name-length) | |
732 | buffer) | |
733 | (eval list-symbol))))) | |
f1180544 | 734 | |
b9a5a6af | 735 | (defsubst msb--choose-menu (buffer function-info-vector max-buffer-name-length) |
eed30659 DL |
736 | "Select the appropriate menu for BUFFER." |
737 | ;; This is all side-effects, folks! | |
738 | ;; This should be optimized. | |
b9a5a6af RS |
739 | (unless (and (not msb-display-invisible-buffers-p) |
740 | (msb-invisible-buffer-p buffer)) | |
741 | (condition-case nil | |
7ccc8f70 | 742 | (with-current-buffer buffer |
2e6286be | 743 | ;; Menu found. Add to this menu |
b2eb3813 GM |
744 | (dolist (info (msb--collect function-info-vector)) |
745 | (msb--add-to-menu buffer info max-buffer-name-length))) | |
b9a5a6af RS |
746 | (error (unless msb--error |
747 | (setq msb--error | |
748 | (format | |
2e6286be | 749 | "In msb-menu-cond, error for buffer `%s'." |
b9a5a6af | 750 | (buffer-name buffer))) |
76e4c0ba | 751 | (error "%s" msb--error)))))) |
b9a5a6af | 752 | |
b9a5a6af | 753 | (defun msb--create-sort-item (function-info) |
eed30659 | 754 | "Return (SORT-KEY TITLE . BUFFER-LIST) or nil if the buffer-list is empty." |
b9a5a6af RS |
755 | (let ((buffer-list (eval (aref function-info 0)))) |
756 | (when buffer-list | |
757 | (let ((sorter (aref function-info 5)) ;SORTER | |
758 | (sort-key (aref function-info 2))) ;MENU-SORT-KEY | |
759 | (when sort-key | |
0eb3b336 | 760 | (cons sort-key |
b9a5a6af RS |
761 | (cons (format (aref function-info 3) ;MENU-TITLE |
762 | (length buffer-list)) | |
763 | (cond | |
764 | ((null sorter) | |
765 | buffer-list) | |
2e6286be | 766 | ((eq sorter t) |
b9a5a6af RS |
767 | (nreverse buffer-list)) |
768 | (t | |
769 | (sort buffer-list sorter)))))))))) | |
770 | ||
3cfa0ee9 | 771 | (defun msb--aggregate-alist (alist same-predicate sort-predicate) |
eed30659 DL |
772 | "Return ALIST as a sorted, aggregated alist. |
773 | ||
774 | In the result all items with the same car element (according to | |
775 | SAME-PREDICATE) are aggregated together. The alist is first sorted by | |
776 | SORT-PREDICATE. | |
777 | ||
778 | Example: | |
b2eb3813 | 779 | \(msb--aggregate-alist |
eed30659 DL |
780 | '((a . a1) (a . a2) (b . b1) (c . c3) (a . a4) (a . a3) (b . b3) (b . b2)) |
781 | (function string=) | |
782 | (lambda (item1 item2) | |
783 | (string< (symbol-name item1) (symbol-name item2)))) | |
784 | results in | |
b2eb3813 | 785 | \((a a1 a2 a4 a3) (b b1 b3 b2) (c c3))" |
3cfa0ee9 | 786 | (when (not (null alist)) |
7ccc8f70 | 787 | (let (same |
3cfa0ee9 SE |
788 | tmp-old-car |
789 | tmp-same | |
790 | (first-time-p t) | |
791 | old-car) | |
792 | (nconc | |
a4a49c21 DL |
793 | (apply #'nconc |
794 | (mapcar | |
795 | (lambda (item) | |
3cfa0ee9 SE |
796 | (cond |
797 | (first-time-p | |
798 | (push (cdr item) same) | |
799 | (setq first-time-p nil) | |
800 | (setq old-car (car item)) | |
801 | nil) | |
802 | ((funcall same-predicate (car item) old-car) | |
803 | (push (cdr item) same) | |
804 | nil) | |
805 | (t | |
806 | (setq tmp-same same | |
807 | tmp-old-car old-car) | |
808 | (setq same (list (cdr item)) | |
809 | old-car (car item)) | |
810 | (list (cons tmp-old-car (nreverse tmp-same)))))) | |
811 | (sort alist (lambda (item1 item2) | |
7ccc8f70 SM |
812 | (funcall sort-predicate |
813 | (car item1) (car item2)))))) | |
3cfa0ee9 SE |
814 | (list (cons old-car (nreverse same))))))) |
815 | ||
816 | ||
817 | (defun msb--mode-menu-cond () | |
818 | (let ((key msb-modes-key)) | |
819 | (mapcar (lambda (item) | |
f58e0fd5 | 820 | (cl-incf key) |
3cfa0ee9 SE |
821 | (list `( eq major-mode (quote ,(car item))) |
822 | key | |
823 | (concat (cdr item) " (%d)"))) | |
aade135d | 824 | (sort |
3cfa0ee9 | 825 | (let ((mode-list nil)) |
b2eb3813 | 826 | (dolist (buffer (cdr (buffer-list))) |
7ccc8f70 | 827 | (with-current-buffer buffer |
b2eb3813 GM |
828 | (when (and (not (msb-invisible-buffer-p)) |
829 | (not (assq major-mode mode-list))) | |
48d33090 SM |
830 | (push (cons major-mode |
831 | (format-mode-line mode-name nil nil buffer)) | |
b2eb3813 | 832 | mode-list)))) |
3cfa0ee9 SE |
833 | mode-list) |
834 | (lambda (item1 item2) | |
835 | (string< (cdr item1) (cdr item2))))))) | |
836 | ||
b9a5a6af | 837 | (defun msb--most-recently-used-menu (max-buffer-name-length) |
eed30659 DL |
838 | "Return a list for the most recently used buffers. |
839 | It takes the form ((TITLE . BUFFER-LIST)...)." | |
4aa4849b RS |
840 | (when (and (numberp msb-display-most-recently-used) |
841 | (> msb-display-most-recently-used 0)) | |
fd46fd17 RS |
842 | (let* ((buffers (cdr (buffer-list))) |
843 | (most-recently-used | |
f58e0fd5 SM |
844 | (cl-loop with n = 0 |
845 | for buffer in buffers | |
846 | if (with-current-buffer buffer | |
847 | (and (not (msb-invisible-buffer-p)) | |
848 | (not (eq major-mode 'dired-mode)))) | |
849 | collect (with-current-buffer buffer | |
850 | (cons (funcall msb-item-handling-function | |
851 | buffer | |
852 | max-buffer-name-length) | |
853 | buffer)) | |
854 | and do (cl-incf n) | |
855 | until (>= n msb-display-most-recently-used)))) | |
b9a5a6af RS |
856 | (cons (if (stringp msb-most-recently-used-title) |
857 | (format msb-most-recently-used-title | |
858 | (length most-recently-used)) | |
859 | (signal 'wrong-type-argument (list msb-most-recently-used-title))) | |
860 | most-recently-used)))) | |
861 | ||
862 | (defun msb--create-buffer-menu-2 () | |
863 | (let ((max-buffer-name-length 0) | |
864 | file-buffers | |
865 | function-info-vector) | |
866 | ;; Calculate the longest buffer name. | |
b2eb3813 GM |
867 | (dolist (buffer (buffer-list)) |
868 | (when (or msb-display-invisible-buffers-p | |
869 | (not (msb-invisible-buffer-p))) | |
870 | (setq max-buffer-name-length | |
871 | (max max-buffer-name-length (length (buffer-name buffer)))))) | |
b9a5a6af RS |
872 | ;; Make a list with elements of type |
873 | ;; (BUFFER-LIST-VARIABLE | |
874 | ;; CONDITION | |
875 | ;; MENU-SORT-KEY | |
876 | ;; MENU-TITLE | |
877 | ;; ITEM-HANDLER | |
878 | ;; SORTER) | |
879 | ;; Uses "function-global" variables: | |
880 | ;; function-info-vector | |
881 | (setq function-info-vector | |
882 | (apply (function vector) | |
883 | (mapcar (function msb--create-function-info) | |
3cfa0ee9 | 884 | (append msb-menu-cond (msb--mode-menu-cond))))) |
b9a5a6af | 885 | ;; Split the buffer-list into several lists; one list for each |
2e6286be | 886 | ;; criteria. This is the most critical part with respect to time. |
b2eb3813 GM |
887 | (dolist (buffer (buffer-list)) |
888 | (cond ((and msb-files-by-directory | |
889 | (buffer-file-name buffer) | |
890 | ;; exclude ange-ftp buffers | |
891 | ;;(not (string-match "\\/[^/:]+:" | |
892 | ;; (buffer-file-name buffer))) | |
893 | ) | |
894 | (push buffer file-buffers)) | |
895 | (t | |
896 | (msb--choose-menu buffer | |
897 | function-info-vector | |
898 | max-buffer-name-length)))) | |
b9a5a6af RS |
899 | (when file-buffers |
900 | (setq file-buffers | |
3cfa0ee9 | 901 | (mapcar (lambda (buffer-list) |
f58e0fd5 SM |
902 | `(,msb-files-by-directory-sort-key |
903 | ,(car buffer-list) | |
904 | ,@(sort | |
905 | (mapcar (lambda (buffer) | |
906 | (cons (with-current-buffer buffer | |
907 | (funcall | |
908 | msb-item-handling-function | |
909 | buffer | |
910 | max-buffer-name-length)) | |
911 | buffer)) | |
912 | (cdr buffer-list)) | |
913 | (lambda (item1 item2) | |
914 | (string< (car item1) (car item2)))))) | |
7ccc8f70 | 915 | (msb--choose-file-menu file-buffers)))) |
b9a5a6af | 916 | ;; Now make the menu - a list of (TITLE . BUFFER-LIST) |
4aa4849b | 917 | (let* (menu |
b9a5a6af RS |
918 | (most-recently-used |
919 | (msb--most-recently-used-menu max-buffer-name-length)) | |
0eb3b336 | 920 | (others (nconc file-buffers |
f58e0fd5 SM |
921 | (cl-loop for elt |
922 | across function-info-vector | |
923 | for value = (msb--create-sort-item elt) | |
924 | if value collect value)))) | |
b9a5a6af RS |
925 | (setq menu |
926 | (mapcar 'cdr ;Remove the SORT-KEY | |
927 | ;; Sort the menus - not the items. | |
928 | (msb--add-separators | |
929 | (sort | |
930 | ;; Get a list of (SORT-KEY TITLE . BUFFER-LIST) | |
931 | ;; Also sorts the items within the menus. | |
932 | (if (cdr most-recently-used) | |
933 | (cons | |
934 | ;; Add most recent used buffers | |
935 | (cons msb-most-recently-used-sort-key | |
936 | most-recently-used) | |
937 | others) | |
938 | others) | |
3cfa0ee9 SE |
939 | (lambda (elt1 elt2) |
940 | (< (car elt1) (car elt2))))))) | |
b9a5a6af RS |
941 | ;; Now make it a keymap menu |
942 | (append | |
943 | '(keymap "Select Buffer") | |
944 | (msb--make-keymap-menu menu) | |
945 | (when msb-separator-diff | |
0eb3b336 RS |
946 | (list (list 'separator "--"))) |
947 | (list (cons 'toggle | |
b9a5a6af RS |
948 | (cons |
949 | (if msb-files-by-directory | |
a4a49c21 DL |
950 | "*Files by type*" |
951 | "*Files by directory*") | |
952 | 'msb--toggle-menu-type))))))) | |
b9a5a6af | 953 | |
0b704e15 | 954 | (defun msb--create-buffer-menu () |
b9a5a6af RS |
955 | (save-match-data |
956 | (save-excursion | |
957 | (msb--create-buffer-menu-2)))) | |
958 | ||
b9a5a6af | 959 | (defun msb--toggle-menu-type () |
20ba690c | 960 | "Multi-purpose function for selecting a buffer with the mouse." |
b9a5a6af RS |
961 | (interactive) |
962 | (setq msb-files-by-directory (not msb-files-by-directory)) | |
c549c1bf RS |
963 | ;; This gets a warning, but it is correct, |
964 | ;; because this file redefines menu-bar-update-buffers. | |
eed30659 | 965 | (msb-menu-bar-update-buffers t)) |
b9a5a6af RS |
966 | |
967 | (defun mouse-select-buffer (event) | |
968 | "Pop up several menus of buffers, for selection with the mouse. | |
969 | Returns the selected buffer or nil if no buffer is selected. | |
970 | ||
4aa4849b | 971 | The way the buffers are split is conveniently handled with the |
2e6286be | 972 | variable `msb-menu-cond'." |
b9a5a6af RS |
973 | ;; Popup the menu and return the selected buffer. |
974 | (when (or msb--error | |
975 | (not msb--last-buffer-menu) | |
976 | (not (fboundp 'frame-or-buffer-changed-p)) | |
977 | (frame-or-buffer-changed-p)) | |
978 | (setq msb--error nil) | |
979 | (setq msb--last-buffer-menu (msb--create-buffer-menu))) | |
4aa4849b RS |
980 | (let ((position event) |
981 | choice) | |
b9a5a6af RS |
982 | (when (and (fboundp 'posn-x-y) |
983 | (fboundp 'posn-window)) | |
984 | (let ((posX (car (posn-x-y (event-start event)))) | |
985 | (posY (cdr (posn-x-y (event-start event)))) | |
4aa4849b | 986 | (posWind (posn-window (event-start event)))) |
b9a5a6af RS |
987 | ;; adjust position |
988 | (setq posX (- posX (funcall msb-horizontal-shift-function)) | |
989 | position (list (list posX posY) posWind)))) | |
1cc9a99e | 990 | ;; Popup the menu |
4aa4849b | 991 | (setq choice (x-popup-menu position msb--last-buffer-menu)) |
b9a5a6af | 992 | (cond |
4aa4849b RS |
993 | ((eq (car choice) 'toggle) |
994 | ;; Bring up the menu again with type toggled. | |
995 | (msb--toggle-menu-type) | |
996 | (mouse-select-buffer event)) | |
997 | ((and (numberp (car choice)) | |
998 | (null (cdr choice))) | |
122e29de | 999 | (let ((msb--last-buffer-menu (nthcdr 2 (assq (car choice) |
a4a49c21 | 1000 | msb--last-buffer-menu)))) |
b9a5a6af | 1001 | (mouse-select-buffer event))) |
4aa4849b RS |
1002 | ((while (numberp (car choice)) |
1003 | (setq choice (cdr choice)))) | |
1004 | ((and (stringp (car choice)) | |
1005 | (null (cdr choice))) | |
1006 | (car choice)) | |
dc3247b3 RS |
1007 | ((null choice) |
1008 | choice) | |
4aa4849b RS |
1009 | (t |
1010 | (error "Unknown form for buffer: %s" choice))))) | |
3cfa0ee9 | 1011 | |
b9a5a6af RS |
1012 | ;; Add separators |
1013 | (defun msb--add-separators (sorted-list) | |
a4a49c21 DL |
1014 | (if (or (not msb-separator-diff) |
1015 | (not (numberp msb-separator-diff))) | |
1016 | sorted-list | |
b9a5a6af | 1017 | (let ((last-key nil)) |
a4a49c21 DL |
1018 | (apply #'nconc |
1019 | (mapcar | |
1020 | (lambda (item) | |
1021 | (cond | |
1022 | ((and msb-separator-diff | |
1023 | last-key | |
1024 | (> (- (car item) last-key) | |
1025 | msb-separator-diff)) | |
1026 | (setq last-key (car item)) | |
1027 | (list (cons last-key 'separator) | |
1028 | item)) | |
1029 | (t | |
1030 | (setq last-key (car item)) | |
1031 | (list item)))) | |
1032 | sorted-list))))) | |
b9a5a6af | 1033 | |
4aa4849b RS |
1034 | (defun msb--split-menus-2 (list mcount result) |
1035 | (cond | |
1036 | ((> (length list) msb-max-menu-items) | |
1037 | (let ((count 0) | |
1038 | sub-name | |
1039 | (tmp-list nil)) | |
1040 | (while (< count msb-max-menu-items) | |
1041 | (push (pop list) tmp-list) | |
f58e0fd5 | 1042 | (cl-incf count)) |
a4a49c21 DL |
1043 | (setq tmp-list (nreverse tmp-list)) |
1044 | (setq sub-name (concat (car (car tmp-list)) "...")) | |
1045 | (push (nconc (list mcount sub-name | |
1046 | 'keymap sub-name) | |
1047 | tmp-list) | |
1048 | result)) | |
4aa4849b RS |
1049 | (msb--split-menus-2 list (1+ mcount) result)) |
1050 | ((null result) | |
1051 | list) | |
1052 | (t | |
1053 | (let (sub-name) | |
1054 | (setq sub-name (concat (car (car list)) "...")) | |
a4a49c21 DL |
1055 | (push (nconc (list mcount sub-name 'keymap sub-name) |
1056 | list) | |
1057 | result)) | |
4aa4849b | 1058 | (nreverse result)))) |
4aa4849b | 1059 | |
3cfa0ee9 SE |
1060 | (defun msb--split-menus (list) |
1061 | (if (and (integerp msb-max-menu-items) | |
1062 | (> msb-max-menu-items 0)) | |
1063 | (msb--split-menus-2 list 0 nil) | |
1064 | list)) | |
4aa4849b | 1065 | |
b9a5a6af RS |
1066 | (defun msb--make-keymap-menu (raw-menu) |
1067 | (let ((end (cons '(nil) 'menu-bar-select-buffer)) | |
1068 | (mcount 0)) | |
1069 | (mapcar | |
3cfa0ee9 | 1070 | (lambda (sub-menu) |
aade135d | 1071 | (cond |
3cfa0ee9 SE |
1072 | ((eq 'separator sub-menu) |
1073 | (list 'separator "--")) | |
1074 | (t | |
a4a49c21 DL |
1075 | (let ((buffers (mapcar (lambda (item) |
1076 | (cons (buffer-name (cdr item)) | |
1077 | (cons (car item) end))) | |
3cfa0ee9 | 1078 | (cdr sub-menu)))) |
f58e0fd5 | 1079 | (nconc (list (cl-incf mcount) (car sub-menu) |
3cfa0ee9 SE |
1080 | 'keymap (car sub-menu)) |
1081 | (msb--split-menus buffers)))))) | |
b9a5a6af RS |
1082 | raw-menu))) |
1083 | ||
eed30659 DL |
1084 | (defun msb-menu-bar-update-buffers (&optional arg) |
1085 | "A re-written version of `menu-bar-update-buffers'." | |
b9a5a6af RS |
1086 | ;; If user discards the Buffers item, play along. |
1087 | (when (and (lookup-key (current-global-map) [menu-bar buffer]) | |
1088 | (or (not (fboundp 'frame-or-buffer-changed-p)) | |
1089 | (frame-or-buffer-changed-p) | |
1090 | arg)) | |
fd46fd17 | 1091 | (let ((frames (frame-list)) |
b9a5a6af | 1092 | buffers-menu frames-menu) |
b9a5a6af RS |
1093 | ;; Make the menu of buffers proper. |
1094 | (setq msb--last-buffer-menu (msb--create-buffer-menu)) | |
7ccc8f70 SM |
1095 | ;; Skip the `keymap' symbol. |
1096 | (setq buffers-menu (cdr msb--last-buffer-menu)) | |
b9a5a6af | 1097 | ;; Make a Frames menu if we have more than one frame. |
fd46fd17 RS |
1098 | (when (cdr frames) |
1099 | (let* ((frame-length (length frames)) | |
1100 | (f-title (format "Frames (%d)" frame-length))) | |
1101 | ;; List only the N most recently selected frames | |
1102 | (when (and (integerp msb-max-menu-items) | |
0b704e15 | 1103 | (> msb-max-menu-items 1) |
fd46fd17 RS |
1104 | (> frame-length msb-max-menu-items)) |
1105 | (setcdr (nthcdr msb-max-menu-items frames) nil)) | |
b9a5a6af | 1106 | (setq frames-menu |
fd46fd17 RS |
1107 | (nconc |
1108 | (list 'frame f-title '(nil) 'keymap f-title) | |
1109 | (mapcar | |
3cfa0ee9 SE |
1110 | (lambda (frame) |
1111 | (nconc | |
10df5051 RS |
1112 | (list (frame-parameter frame 'name) |
1113 | (frame-parameter frame 'name) | |
3cfa0ee9 | 1114 | (cons nil nil)) |
220c2a14 GM |
1115 | `(lambda () |
1116 | (interactive) (menu-bar-select-frame ,frame)))) | |
fd46fd17 | 1117 | frames))))) |
7ccc8f70 | 1118 | (setcdr global-buffers-menu-map |
b9a5a6af | 1119 | (if (and buffers-menu frames-menu) |
fd46fd17 | 1120 | ;; Combine Frame and Buffers menus with separator between |
7ccc8f70 | 1121 | (nconc (list "Buffers and Frames" frames-menu |
0eb3b336 | 1122 | (and msb-separator-diff '(separator "--"))) |
7ccc8f70 SM |
1123 | (cdr buffers-menu)) |
1124 | buffers-menu))))) | |
b9a5a6af | 1125 | |
aade135d DL |
1126 | ;; Snarf current bindings of `mouse-buffer-menu' (normally |
1127 | ;; C-down-mouse-1). | |
1128 | (defvar msb-mode-map | |
a4a49c21 | 1129 | (let ((map (make-sparse-keymap "Msb"))) |
9103eeef | 1130 | (define-key map [remap mouse-buffer-menu] 'msb) |
aade135d DL |
1131 | map)) |
1132 | ||
1133 | ;;;###autoload | |
3bdb5fb8 | 1134 | (define-minor-mode msb-mode |
aade135d | 1135 | "Toggle Msb mode. |
06e21633 CY |
1136 | With a prefix argument ARG, enable Msb mode if ARG is positive, |
1137 | and disable it otherwise. If called from Lisp, enable the mode | |
1138 | if ARG is omitted or nil. | |
1139 | ||
aade135d DL |
1140 | This mode overrides the binding(s) of `mouse-buffer-menu' to provide a |
1141 | different buffer menu using the function `msb'." | |
329ffac0 | 1142 | :global t :group 'msb |
aade135d | 1143 | (if msb-mode |
eed30659 DL |
1144 | (progn |
1145 | (add-hook 'menu-bar-update-hook 'msb-menu-bar-update-buffers) | |
0f6d89c4 GM |
1146 | (remove-hook 'menu-bar-update-hook 'menu-bar-update-buffers) |
1147 | (msb-menu-bar-update-buffers t)) | |
eed30659 | 1148 | (remove-hook 'menu-bar-update-hook 'msb-menu-bar-update-buffers) |
0f6d89c4 GM |
1149 | (add-hook 'menu-bar-update-hook 'menu-bar-update-buffers) |
1150 | (menu-bar-update-buffers t))) | |
aade135d | 1151 | |
0b704e15 JB |
1152 | (defun msb-unload-function () |
1153 | "Unload the Msb library." | |
1154 | (msb-mode -1) | |
1155 | ;; continue standard unloading | |
1156 | nil) | |
a4a49c21 | 1157 | |
b9a5a6af | 1158 | (provide 'msb) |
ed7646d4 | 1159 | (run-hooks 'msb-after-load-hook) |
be17d374 | 1160 | |
b9a5a6af | 1161 | ;;; msb.el ends here |