Commit | Line | Data |
---|---|---|
b9a5a6af RS |
1 | ;;; msb.el --- Customizable buffer-selection with multiple menus. |
2 | ;; Copyright (C) 1993, 1994 Lars Lindberg <Lars.Lindberg@sypro.cap.se> | |
3 | ;; | |
4 | ;; Author: Lars Lindberg <Lars.Lindberg@sypro.cap.se> | |
5 | ;; Created: 8 Oct 1993 | |
dc3247b3 | 6 | ;; Lindberg's last update version: 3.28 |
b9a5a6af RS |
7 | ;; Keywords: mouse buffer menu |
8 | ;; | |
9 | ;; This program is free software; you can redistribute it and/or modify | |
10 | ;; it under the terms of the GNU General Public License as published by | |
11 | ;; the Free Software Foundation; either version 2 of the License, or | |
12 | ;; (at your option) any later version. | |
13 | ;; | |
14 | ;; This program is distributed in the hope that it will be useful, | |
15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 | ;; GNU General Public License for more details. | |
18 | ;; | |
19 | ;; You should have received a copy of the GNU General Public License | |
20 | ;; along with this program; if not, write to the Free Software | |
21 | ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. | |
22 | ||
b9a5a6af RS |
23 | ;;; Commentary: |
24 | ;; | |
25 | ;; Purpose of this package: | |
26 | ;; 1. Offer a function for letting the user choose buffer, | |
27 | ;; not necessarily for switching to it. | |
28 | ;; 2. Make a better mouse-buffer-menu. | |
29 | ;; | |
30 | ;; Installation: | |
31 | ;; (require 'msb) | |
32 | ;; Note! You now use msb instead of mouse-buffer-menu. | |
33 | ;; | |
2e6286be | 34 | ;; Now try the menu bar Buffers menu. |
b9a5a6af RS |
35 | ;; |
36 | ;; Customization: | |
2e6286be RS |
37 | ;; Look at the variable `msb-menu-cond' for deciding what menus you |
38 | ;; want. It's not that hard to customize, despite my not-so-good | |
39 | ;; doc-string. Feel free to send me a better doc-string. | |
b9a5a6af RS |
40 | ;; There are some constants for you to try here: |
41 | ;; msb--few-menus | |
42 | ;; msb--very-many-menus (default) | |
43 | ;; | |
2e6286be RS |
44 | ;; Look at the variable `msb-item-handling-function' for customization |
45 | ;; of the appearance of every menu item. Try for instance setting | |
46 | ;; it to `msb-alon-item-handler'. | |
b9a5a6af | 47 | ;; |
2e6286be RS |
48 | ;; Look at the variable `msb-item-sort-function' for customization |
49 | ;; of sorting the menus. Set it to t for instance, which means no | |
b9a5a6af RS |
50 | ;; sorting - you will get latest used buffer first. |
51 | ;; | |
2e6286be | 52 | ;; Also check out the variable `msb-display-invisible-buffers-p'. |
b9a5a6af RS |
53 | |
54 | ;; Known bugs: | |
4aa4849b RS |
55 | ;; - Files-by-directory |
56 | ;; + No possibility to show client/changed buffers separately | |
b9a5a6af RS |
57 | ;; Future enhancements: |
58 | ;; - [Mattes] had a suggestion about sorting files by extension. | |
59 | ;; I (Lars Lindberg) think this case could be solved if msb.el was | |
60 | ;; rewritten to handle more dynamic splitting. It's now completely | |
61 | ;; static, depending on the menu-cond. If the splitting could also | |
62 | ;; be done by a user-defined function a lot of cases would be | |
63 | ;; solved. | |
64 | ;; - [Jim] suggested that the Frame menu became a part of the buffer menu. | |
65 | ||
b9a5a6af RS |
66 | ;;; Thanks goes to |
67 | ;; [msb] - Mark Brader <msb@sq.com> | |
68 | ;; [Chalupsky] - Hans Chalupsky <hans@cs.Buffalo.EDU> | |
69 | ;; [jim] - Jim Berry <m1jhb00@FRB.GOV> | |
70 | ;; [larry] - Larry Rosenberg <ljr@ictv.com> | |
71 | ;; [will] - Will Henney <will@astroscu.unam.mx> | |
72 | ;; [jaalto] - Jari Aalto <jaalto@tre.tele.nokia.fi> | |
73 | ;; [kifer] - Michael Kifer <kifer@sbkifer.cs.sunysb.edu> | |
74 | ;; [Gael] - Gael Marziou <gael@gnlab030.grenoble.hp.com> | |
75 | ;; [Gillespie] - Dave Gillespie <daveg@thymus.synaptics.com> | |
76 | ;; [Alon] - Alon Albert <alon@milcse.rtsg.mot.com> | |
77 | ;; [KevinB] - Kevin Broadey, <KevinB@bartley.demon.co.uk> | |
78 | ;; [Ake] - Ake Stenhof <ake@cadpoint.se> | |
79 | ;; [RMS] - Richard Stallman <rms@gnu.ai.mit.edu> | |
80 | ;; [Fisk] - Steve Fisk <fisk@medved.bowdoin.edu> | |
81 | ||
82 | ;;; Code: | |
83 | ||
84 | (require 'cl) | |
85 | ||
86 | ;;; | |
2e6286be RS |
87 | ;;; Some example constants to be used for `msb-menu-cond'. See that |
88 | ;;; variable for more information. Please note that if the condition | |
89 | ;;; returns `multi', then the buffer can appear in several menus. | |
b9a5a6af RS |
90 | ;;; |
91 | (defconst msb--few-menus | |
92 | '(((and (boundp 'server-buffer-clients) | |
93 | server-buffer-clients | |
94 | 'multi) | |
95 | 3030 | |
96 | "Clients (%d)") | |
97 | ((and msb-display-invisible-buffers-p | |
98 | (msb-invisible-buffer-p) | |
99 | 'multi) | |
100 | 3090 | |
101 | "Invisible buffers (%d)") | |
102 | ((eq major-mode 'dired-mode) | |
103 | 2010 | |
104 | "Dired (%d)" | |
105 | msb-dired-item-handler | |
106 | msb-sort-by-directory) | |
107 | ((eq major-mode 'Man-mode) | |
108 | 4090 | |
109 | "Manuals (%d)") | |
110 | ((eq major-mode 'w3-mode) | |
111 | 4020 | |
112 | "WWW (%d)") | |
113 | ((or (memq major-mode '(rmail-mode vm-summary-mode vm-mode mail-mode)) | |
114 | (memq major-mode '(mh-letter-mode | |
115 | mh-show-mode | |
116 | mh-folder-mode)) | |
117 | (memq major-mode '(gnus-summary-mode | |
118 | news-reply-mode | |
119 | gnus-group-mode | |
120 | gnus-article-mode | |
121 | gnus-kill-file-mode | |
122 | gnus-browse-killed-mode))) | |
123 | 4010 | |
124 | "Mail (%d)") | |
125 | ((not buffer-file-name) | |
126 | 4099 | |
127 | "Buffers (%d)") | |
128 | ('no-multi | |
129 | 1099 | |
130 | "Files (%d)"))) | |
131 | ||
132 | (defconst msb--very-many-menus | |
133 | '(((and (boundp 'server-buffer-clients) | |
134 | server-buffer-clients | |
135 | 'multi) | |
136 | 1010 | |
137 | "Clients (%d)") | |
138 | ((and (boundp 'vc-mode) vc-mode 'multi) | |
139 | 1020 | |
140 | "Version Control (%d)") | |
141 | ((and buffer-file-name | |
142 | (buffer-modified-p) | |
143 | 'multi) | |
144 | 1030 | |
145 | "Changed files (%d)") | |
146 | ((and (get-buffer-process (current-buffer)) | |
147 | 'multi) | |
148 | 1040 | |
149 | "Processes (%d)") | |
150 | ((and msb-display-invisible-buffers-p | |
151 | (msb-invisible-buffer-p) | |
152 | 'multi) | |
153 | 1090 | |
154 | "Invisible buffers (%d)") | |
155 | ((eq major-mode 'dired-mode) | |
156 | 2010 | |
157 | "Dired (%d)" | |
158 | ;; Note this different menu-handler | |
159 | msb-dired-item-handler | |
160 | ;; Also note this item-sorter | |
161 | msb-sort-by-directory) | |
162 | ((eq major-mode 'Man-mode) | |
163 | 4030 | |
164 | "Manuals (%d)") | |
165 | ((eq major-mode 'w3-mode) | |
166 | 4020 | |
167 | "WWW (%d)") | |
168 | ((or (memq major-mode '(rmail-mode vm-summary-mode vm-mode mail-mode)) | |
169 | (memq major-mode '(mh-letter-mode | |
170 | mh-show-mode | |
171 | mh-folder-mode)) | |
172 | (memq major-mode '(gnus-summary-mode | |
173 | news-reply-mode | |
174 | gnus-group-mode | |
175 | gnus-article-mode | |
176 | gnus-kill-file-mode | |
177 | gnus-browse-killed-mode))) | |
178 | 4010 | |
179 | "Mail (%d)") | |
180 | ;; Catchup for all non-file buffers | |
181 | ((and (not buffer-file-name) | |
182 | 'no-multi) | |
183 | 4099 | |
184 | "Other non-file buffers (%d)") | |
185 | ((and (string-match "/\\.[^/]*$" buffer-file-name) | |
186 | 'multi) | |
187 | 3090 | |
188 | "Hidden Files (%d)") | |
189 | ((memq major-mode '(c-mode c++-mode)) | |
190 | 3010 | |
191 | "C/C++ Files (%d)") | |
192 | ((eq major-mode 'emacs-lisp-mode) | |
193 | 3020 | |
194 | "Elisp Files (%d)") | |
195 | ((eq major-mode 'latex-mode) | |
196 | 3030 | |
197 | "LaTex Files (%d)") | |
198 | ('no-multi | |
199 | 3099 | |
200 | "Other files (%d)"))) | |
201 | ||
202 | ;; msb--many-menus is obsolete | |
203 | (defvar msb--many-menus msb--very-many-menus) | |
204 | ||
205 | ;;; | |
206 | ;;; Customizable variables | |
207 | ;;; | |
208 | ||
209 | (defvar msb-separator-diff 100 | |
210 | "*Non-nil means use separators. | |
211 | The separators will appear between all menus that have a sorting key that differs by this value or more.") | |
212 | ||
213 | (defvar msb-files-by-directory-sort-key 0 | |
214 | "*The sort key for files sorted by directory") | |
215 | ||
4aa4849b | 216 | (defvar msb-max-menu-items 15 |
b9a5a6af | 217 | "*The maximum number of items in a menu. |
4aa4849b | 218 | If this variable is set to 15 for instance, then the submenu will be split up in minor parts, 15 items each. |
b9a5a6af RS |
219 | Nil means no limit.") |
220 | ||
221 | (defvar msb-max-file-menu-items 10 | |
222 | "*The maximum number of items from different directories. | |
223 | ||
2e6286be | 224 | When the menu is of type `file by directory', this is the maximum |
b9a5a6af RS |
225 | number of buffers that are clumped togehter from different |
226 | directories. | |
227 | ||
4aa4849b RS |
228 | Set this to 1 if you want one menu per directory instead of clumping |
229 | them together. | |
230 | ||
b9a5a6af RS |
231 | If the value is not a number, then the value 10 is used.") |
232 | ||
233 | (defvar msb-most-recently-used-sort-key -1010 | |
234 | "*Where should the menu with the most recently used buffers be placed?") | |
235 | ||
4aa4849b | 236 | (defvar msb-display-most-recently-used 15 |
b9a5a6af | 237 | "*How many buffers should be in the most-recently-used menu. |
4aa4849b | 238 | No buffers at all if less than 1 or nil (or any non-number).") |
b9a5a6af RS |
239 | |
240 | (defvar msb-most-recently-used-title "Most recently used (%d)" | |
241 | "*The title for the most-recently-used menu.") | |
242 | ||
243 | (defvar msb-horizontal-shift-function '(lambda () 0) | |
244 | "*Function that specifies a number of pixels by which the top menu should | |
245 | be shifted leftwards.") | |
246 | ||
247 | (defvar msb-display-invisible-buffers-p nil | |
248 | "*Show invisible buffers or not. | |
249 | Non-nil means that the buffer menu should include buffers that have | |
250 | names that starts with a space character.") | |
251 | ||
252 | (defvar msb-item-handling-function 'msb-item-handler | |
253 | "*The appearance of a buffer menu. | |
254 | ||
255 | The default function to call for handling the appearance of a menu | |
2e6286be | 256 | item. It should take to arguments, BUFFER and MAX-BUFFER-NAME-LENGTH, |
b9a5a6af | 257 | where the latter is the max length of all buffer names. |
4aa4849b RS |
258 | |
259 | The function should return the string to use in the menu. | |
260 | ||
b9a5a6af | 261 | When the function is called, BUFFER is the current buffer. |
2e6286be RS |
262 | This function is called for items in the variable `msb-menu-cond' that |
263 | have nil as ITEM-HANDLING-FUNCTION. See `msb-menu-cond' for more | |
b9a5a6af RS |
264 | information.") |
265 | ||
266 | (defvar msb-item-sort-function 'msb-sort-by-name | |
267 | "*The order of items in a buffer menu. | |
268 | The default function to call for handling the order of items in a menu | |
2e6286be | 269 | item. This function is called like a sort function. The items |
b9a5a6af RS |
270 | look like (ITEM-NAME . BUFFER). |
271 | ITEM-NAME is the name of the item that will appear in the menu. | |
272 | BUFFER is the buffer, this is not necessarily the current buffer. | |
273 | ||
274 | Set this to nil or t if you don't want any sorting (faster).") | |
275 | ||
276 | (defvar msb-files-by-directory nil | |
277 | "*Non-nil means that files should be sorted by directory instead of | |
278 | the groups in msb-menu-cond.") | |
279 | ||
280 | (defvar msb-menu-cond msb--very-many-menus | |
281 | "*List of criterias for splitting the mouse buffer menu. | |
282 | The elements in the list should be of this type: | |
283 | (CONDITION MENU-SORT-KEY MENU-TITLE ITEM-HANDLING-FN ITEM-SORT-FN). | |
284 | ||
285 | When making the split, the buffers are tested one by one against the | |
286 | CONDITION, just like a lisp cond: When hitting a true condition, the | |
287 | other criterias are *not* tested and the buffer name will appear in | |
288 | the menu with the menu-title corresponding to the true condition. | |
289 | ||
2e6286be | 290 | If the condition returns the symbol `multi', then the buffer will be |
b9a5a6af | 291 | added to this menu *and* tested for other menus too. If it returns |
2e6286be | 292 | `no-multi', then the buffer will only be added if it hasn't been added |
b9a5a6af RS |
293 | to any other menu. |
294 | ||
295 | During this test, the buffer in question is the current buffer, and | |
296 | the test is surrounded by calls to `save-excursion' and | |
2e6286be | 297 | `save-match-data'. |
b9a5a6af | 298 | |
2e6286be RS |
299 | The categories are sorted by MENU-SORT-KEY. Smaller keys are on |
300 | top. nil means don't display this menu. | |
b9a5a6af | 301 | |
2e6286be | 302 | MENU-TITLE is really a format. If you add %d in it, the %d is replaced |
b9a5a6af RS |
303 | with the number of items in that menu. |
304 | ||
2e6286be | 305 | ITEM-HANDLING-FN, is optional. If it is supplied and is a |
b9a5a6af RS |
306 | function, than it is used for displaying the items in that particular |
307 | buffer menu, otherwise the function pointed out by | |
2e6286be | 308 | `msb-item-handling-function' is used. |
b9a5a6af RS |
309 | |
310 | ITEM-SORT-FN, is also optional. | |
311 | If it is not supplied, the function pointed out by | |
2e6286be | 312 | `msb-item-sort-function' is used. |
b9a5a6af RS |
313 | If it is nil, then no sort takes place and the buffers are presented |
314 | in least-recently-used order. | |
315 | If it is t, then no sort takes place and the buffers are presented in | |
316 | most-recently-used order. | |
317 | If it is supplied and non-nil and not t than it is used for sorting | |
318 | the items in that particular buffer menu. | |
319 | ||
2e6286be RS |
320 | Note1: There should always be a `catch-all' as last element, |
321 | in this list. That is an element like (t TITLE ITEM-HANDLING-FUNCTION). | |
b9a5a6af RS |
322 | Note2: A buffer menu appears only if it has at least one buffer in it. |
323 | Note3: If you have a CONDITION that can't be evaluated you will get an | |
324 | error every time you do \\[msb].") | |
325 | ||
326 | (defvar msb-after-load-hooks nil | |
327 | "Hooks to be run after the msb package has been loaded.") | |
328 | ||
329 | ;;; | |
330 | ;;; Internal variables | |
331 | ;;; | |
332 | ||
333 | ;; The last calculated menu. | |
334 | (defvar msb--last-buffer-menu nil) | |
335 | ||
336 | ;; If this is non-nil, then it is a string that describes the error. | |
337 | (defvar msb--error nil) | |
338 | ||
339 | ;;; | |
4aa4849b | 340 | ;;; Some example function to be used for `msb-item-handling-function'. |
b9a5a6af RS |
341 | ;;; |
342 | (defun msb-item-handler (buffer &optional maxbuf) | |
343 | "Create one string item, concerning BUFFER, for the buffer menu. | |
344 | The item looks like: | |
345 | *% <buffer-name> | |
2e6286be RS |
346 | The `*' appears only if the buffer is marked as modified. |
347 | The `%' appears only if the buffer is read-only. | |
b9a5a6af RS |
348 | Optional second argument MAXBUF is completely ignored." |
349 | (let ((name (buffer-name)) | |
350 | (modified (if (buffer-modified-p) "*" " ")) | |
351 | (read-only (if buffer-read-only "%" " "))) | |
352 | (format "%s%s %s" modified read-only name))) | |
353 | ||
354 | ||
355 | (eval-when-compile (require 'dired)) | |
356 | ||
2e6286be RS |
357 | ;; `dired' can be called with a list of the form (directory file1 file2 ...) |
358 | ;; which causes `dired-directory' to be in the same form. | |
b9a5a6af RS |
359 | (defun msb--dired-directory () |
360 | (cond ((stringp dired-directory) | |
361 | (abbreviate-file-name (expand-file-name dired-directory))) | |
362 | ((consp dired-directory) | |
363 | (abbreviate-file-name (expand-file-name (car dired-directory)))) | |
364 | (t | |
2e6286be | 365 | (error "Unknown type of `dired-directory' in buffer %s" |
b9a5a6af RS |
366 | (buffer-name))))) |
367 | ||
368 | (defun msb-dired-item-handler (buffer &optional maxbuf) | |
369 | "Create one string item, concerning a dired BUFFER, for the buffer menu. | |
370 | The item looks like: | |
371 | *% <buffer-name> | |
2e6286be RS |
372 | The `*' appears only if the buffer is marked as modified. |
373 | The `%' appears only if the buffer is read-only. | |
b9a5a6af RS |
374 | Optional second argument MAXBUF is completely ignored." |
375 | (let ((name (msb--dired-directory)) | |
376 | (modified (if (buffer-modified-p) "*" " ")) | |
377 | (read-only (if buffer-read-only "%" " "))) | |
378 | (format "%s%s %s" modified read-only name))) | |
379 | ||
380 | (defun msb-alon-item-handler (buffer maxbuf) | |
381 | "Create one string item for the buffer menu. | |
382 | The item looks like: | |
383 | <buffer-name> *%# <file-name> | |
2e6286be RS |
384 | The `*' appears only if the buffer is marked as modified. |
385 | The `%' appears only if the buffer is read-only. | |
386 | The `#' appears only version control file (SCCS/RCS)." | |
b9a5a6af RS |
387 | (format (format "%%%ds %%s%%s%%s %%s" maxbuf) |
388 | (buffer-name buffer) | |
389 | (if (buffer-modified-p) "*" " ") | |
390 | (if buffer-read-only "%" " ") | |
391 | (if (and (boundp 'vc-mode) vc-mode) "#" " ") | |
392 | (or buffer-file-name ""))) | |
393 | ||
394 | ;;; | |
4aa4849b | 395 | ;;; Some example function to be used for `msb-item-sort-function'. |
b9a5a6af RS |
396 | ;;; |
397 | (defun msb-sort-by-name (item1 item2) | |
398 | "Sorts the items depending on their buffer-name | |
399 | An item look like (NAME . BUFFER)." | |
400 | (string-lessp (buffer-name (cdr item1)) | |
401 | (buffer-name (cdr item2)))) | |
402 | ||
403 | ||
404 | (defun msb-sort-by-directory (item1 item2) | |
2e6286be | 405 | "Sorts the items depending on their directory. Made for dired. |
b9a5a6af RS |
406 | An item look like (NAME . BUFFER)." |
407 | (string-lessp (save-excursion (set-buffer (cdr item1)) (msb--dired-directory)) | |
408 | (save-excursion (set-buffer (cdr item2)) (msb--dired-directory)))) | |
409 | ||
410 | ;;; | |
411 | ;;; msb | |
412 | ;;; | |
413 | ;;; This function can be used instead of (mouse-buffer-menu EVENT) | |
414 | ;;; function in "mouse.el". | |
415 | ;;; | |
416 | (defun msb (event) | |
417 | "Pop up several menus of buffers for selection with the mouse. | |
418 | This command switches buffers in the window that you clicked on, and | |
419 | selects that window. | |
420 | ||
2e6286be RS |
421 | See the function `mouse-select-buffer' and the variable |
422 | `msb-menu-cond' for more information about how the menus are split." | |
b9a5a6af RS |
423 | (interactive "e") |
424 | (let ((buffer (mouse-select-buffer event)) | |
425 | (window (posn-window (event-start event)))) | |
4aa4849b RS |
426 | (when buffer |
427 | (unless (framep window) (select-window window)) | |
428 | (switch-to-buffer buffer))) | |
b9a5a6af RS |
429 | nil) |
430 | ||
431 | ;;; | |
432 | ;;; Some supportive functions | |
433 | ;;; | |
434 | (defun msb-invisible-buffer-p (&optional buffer) | |
435 | "Return t if optional BUFFER is an \"invisible\" buffer. | |
436 | If the argument is left out or nil, then the current buffer is considered." | |
437 | (and (> (length (buffer-name buffer)) 0) | |
438 | (eq ?\ (aref (buffer-name buffer) 0)))) | |
439 | ||
440 | ;; Strip one hierarcy level from the end of PATH. | |
441 | (defun msb--strip-path (path) | |
442 | (save-match-data | |
443 | (if (string-match "\\(.+\\)/[^/]+$" path) | |
444 | (substring path (match-beginning 1) (match-end 1)) | |
445 | "/"))) | |
446 | ||
447 | ;; Create an alist with all buffers from LIST that lies under the same | |
448 | ;; directory will be in the same item as the directory string as | |
2e6286be | 449 | ;; ((PATH1 . (BUFFER-1 BUFFER-2 ...)) (PATH2 . (BUFFER-K BUFFER-K+1...)) ...) |
b9a5a6af RS |
450 | (defun msb--init-file-alist (list) |
451 | (let ((buffer-alist | |
452 | (sort (mapcan | |
453 | (function | |
454 | (lambda (buffer) | |
455 | (let ((file-name (buffer-file-name buffer))) | |
456 | (when file-name | |
457 | (list (cons (msb--strip-path file-name) buffer)))))) | |
458 | list) | |
459 | (function (lambda (item1 item2) | |
460 | (string< (car item1) (car item2))))))) | |
461 | ;; Make alist that looks like | |
2e6286be | 462 | ;; ((PATH1 . (BUFFER-1 BUFFER-2 ...)) (PATH2 . (BUFFER-K)) ...) |
b9a5a6af RS |
463 | (let ((path nil) |
464 | (buffers nil) | |
465 | (result nil)) | |
466 | (append | |
467 | (mapcan (function | |
468 | (lambda (item) | |
469 | (cond | |
470 | ((and path | |
b9a5a6af RS |
471 | (string= path (car item))) |
472 | (push (cdr item) buffers) | |
473 | nil) | |
474 | (t | |
475 | (when path | |
476 | (setq result (cons path buffers))) | |
477 | (setq path (car item)) | |
478 | (setq buffers (list (cdr item))) | |
479 | (and result (list result)))))) | |
480 | buffer-alist) | |
481 | (list (cons path buffers)))))) | |
482 | ||
483 | ;; Choose file-menu with respect to directory for every buffer in LIST. | |
484 | (defun msb--choose-file-menu (list) | |
485 | (let ((buffer-alist (msb--init-file-alist list)) | |
486 | (final-list nil) | |
487 | (max-clumped-together (if (numberp msb-max-file-menu-items) | |
488 | msb-max-file-menu-items | |
489 | 10)) | |
490 | (top-found-p nil) | |
491 | (last-path nil) | |
492 | first rest path buffers) | |
493 | (setq first (car buffer-alist)) | |
494 | (setq rest (cdr buffer-alist)) | |
495 | (setq path (car first)) | |
496 | (setq buffers (cdr first)) | |
497 | (while rest | |
498 | (let ((found-p nil) | |
499 | (tmp-rest rest) | |
500 | new-path item) | |
501 | (setq item (car tmp-rest)) | |
502 | (while (and tmp-rest | |
503 | (<= (length buffers) max-clumped-together) | |
504 | (>= (length (car item)) (length path)) | |
505 | (string= path (substring (car item) 0 (length path)))) | |
506 | (setq found-p t) | |
507 | (setq buffers (append buffers (cdr item))) | |
508 | (setq tmp-rest (cdr tmp-rest)) | |
509 | (setq item (car tmp-rest))) | |
510 | (cond | |
511 | ((> (length buffers) max-clumped-together) | |
512 | (setq last-path (car first)) | |
4aa4849b RS |
513 | (setq first |
514 | (cons (format (if top-found-p | |
515 | "%s/... (%d)" | |
516 | "%s (%d)") | |
517 | (car first) | |
518 | (length (cdr first))) | |
519 | (cdr first))) | |
520 | (setq top-found-p nil) | |
b9a5a6af RS |
521 | (push first final-list) |
522 | (setq first (car rest) | |
523 | rest (cdr rest)) | |
524 | (setq path (car first) | |
525 | buffers (cdr first))) | |
526 | (t | |
527 | (when found-p | |
528 | (setq top-found-p t) | |
529 | (setq first (cons path buffers) | |
530 | rest tmp-rest)) | |
531 | (setq path (msb--strip-path path) | |
532 | buffers (cdr first)) | |
533 | (when (and last-path | |
534 | (or (and (>= (length path) (length last-path)) | |
535 | (string= last-path | |
536 | (substring path 0 (length last-path)))) | |
537 | (and (< (length path) (length last-path)) | |
538 | (string= path | |
539 | (substring last-path 0 (length path)))))) | |
540 | ||
4aa4849b RS |
541 | (setq first |
542 | (cons (format (if top-found-p | |
543 | "%s/... (%d)" | |
544 | "%s (%d)") | |
545 | (car first) | |
546 | (length (cdr first))) | |
547 | (cdr first))) | |
548 | (setq top-found-p nil) | |
b9a5a6af RS |
549 | (push first final-list) |
550 | (setq first (car rest) | |
551 | rest (cdr rest)) | |
552 | (setq path (car first) | |
553 | buffers (cdr first))))))) | |
4aa4849b RS |
554 | (setq first |
555 | (cons (format (if top-found-p | |
556 | "%s/... (%d)" | |
557 | "%s (%d)") | |
558 | (car first) | |
559 | (length (cdr first))) | |
560 | (cdr first))) | |
561 | (setq top-found-p nil) | |
b9a5a6af RS |
562 | (push first final-list) |
563 | (nreverse final-list))) | |
564 | ||
565 | ;; Create a vector as: | |
566 | ;; [BUFFER-LIST-VARIABLE CONDITION MENU-SORT-KEY MENU-TITLE ITEM-HANDLER SORTER) | |
2e6286be RS |
567 | ;; from an element in `msb-menu-cond'. See that variable for a |
568 | ;; description of its elements. | |
b9a5a6af RS |
569 | (defun msb--create-function-info (menu-cond-elt) |
570 | (let* ((list-symbol (make-symbol "-msb-buffer-list")) | |
571 | (tmp-ih (and (> (length menu-cond-elt) 3) | |
572 | (nth 3 menu-cond-elt))) | |
573 | (item-handler (if (and tmp-ih (fboundp tmp-ih)) | |
574 | tmp-ih | |
575 | msb-item-handling-function)) | |
576 | (tmp-s (if (> (length menu-cond-elt) 4) | |
577 | (nth 4 menu-cond-elt) | |
578 | msb-item-sort-function)) | |
579 | (sorter (if (or (fboundp tmp-s) | |
580 | (null tmp-s) | |
2e6286be | 581 | (eq tmp-s t)) |
b9a5a6af RS |
582 | tmp-s |
583 | msb-item-sort-function))) | |
584 | (when (< (length menu-cond-elt) 3) | |
585 | (error "Wrong format of msb-menu-cond.")) | |
586 | (when (and (> (length menu-cond-elt) 3) | |
587 | (not (fboundp tmp-ih))) | |
588 | (signal 'invalid-function (list tmp-ih))) | |
589 | (when (and (> (length menu-cond-elt) 4) | |
590 | tmp-s | |
591 | (not (fboundp tmp-s)) | |
2e6286be | 592 | (not (eq tmp-s t))) |
b9a5a6af | 593 | (signal 'invalid-function (list tmp-s))) |
2e6286be | 594 | (set list-symbol ()) |
b9a5a6af RS |
595 | (vector list-symbol ;BUFFER-LIST-VARIABLE |
596 | (nth 0 menu-cond-elt) ;CONDITION | |
597 | (nth 1 menu-cond-elt) ;SORT-KEY | |
598 | (nth 2 menu-cond-elt) ;MENU-TITLE | |
599 | item-handler ;ITEM-HANDLER | |
600 | sorter) ;SORTER | |
601 | )) | |
602 | ||
603 | ;; This defsubst is only used in `msb--choose-menu' below. It was | |
2e6286be | 604 | ;; pulled out merely to make the code somewhat clearer. The indention |
b9a5a6af RS |
605 | ;; level was too big. |
606 | (defsubst msb--collect (function-info-vector) | |
607 | (let ((result nil) | |
608 | (multi-flag nil) | |
609 | function-info-list) | |
610 | (setq function-info-list | |
611 | (loop for fi | |
612 | across function-info-vector | |
613 | if (and (setq result | |
614 | (eval (aref fi 1))) ;Test CONDITION | |
615 | (not (and (eq result 'no-multi) | |
616 | multi-flag)) | |
617 | (progn (when (eq result 'multi) | |
618 | (setq multi-flag t)) | |
4aa4849b | 619 | t)) |
b9a5a6af RS |
620 | collect fi |
621 | until (and result | |
622 | (not (eq result 'multi))))) | |
623 | (when (and (not function-info-list) | |
624 | (not result)) | |
625 | (error "No catch-all in msb-menu-cond!")) | |
626 | function-info-list)) | |
627 | ||
628 | ;; Adds BUFFER to the menu depicted by FUNCTION-INFO | |
2e6286be | 629 | ;; All side-effects. Adds an element of form (BUFFER-TITLE . BUFFER) |
b9a5a6af RS |
630 | ;; to the buffer-list variable in function-info. |
631 | (defun msb--add-to-menu (buffer function-info max-buffer-name-length) | |
632 | (let ((list-symbol (aref function-info 0))) ;BUFFER-LIST-VARIABLE | |
633 | ;; Here comes the hairy side-effect! | |
634 | (set list-symbol | |
635 | (cons (cons (funcall (aref function-info 4) ;ITEM-HANDLER | |
636 | buffer | |
637 | max-buffer-name-length) | |
638 | buffer) | |
639 | (eval list-symbol))))) | |
640 | ||
641 | ;; Selects the appropriate menu for BUFFER. | |
642 | ;; This is all side-effects, folks! | |
643 | ;; This should be optimized. | |
644 | (defsubst msb--choose-menu (buffer function-info-vector max-buffer-name-length) | |
645 | (unless (and (not msb-display-invisible-buffers-p) | |
646 | (msb-invisible-buffer-p buffer)) | |
647 | (condition-case nil | |
648 | (save-excursion | |
649 | (set-buffer buffer) | |
2e6286be | 650 | ;; Menu found. Add to this menu |
b9a5a6af RS |
651 | (mapc (function |
652 | (lambda (function-info) | |
653 | (msb--add-to-menu buffer function-info max-buffer-name-length))) | |
654 | (msb--collect function-info-vector))) | |
655 | (error (unless msb--error | |
656 | (setq msb--error | |
657 | (format | |
2e6286be | 658 | "In msb-menu-cond, error for buffer `%s'." |
b9a5a6af RS |
659 | (buffer-name buffer))) |
660 | (error msb--error)))))) | |
661 | ||
662 | ;; Return (SORT-KEY TITLE . BUFFER-LIST) or nil if the | |
663 | ;; buffer-list is empty. | |
664 | (defun msb--create-sort-item (function-info) | |
665 | (let ((buffer-list (eval (aref function-info 0)))) | |
666 | (when buffer-list | |
667 | (let ((sorter (aref function-info 5)) ;SORTER | |
668 | (sort-key (aref function-info 2))) ;MENU-SORT-KEY | |
669 | (when sort-key | |
670 | (cons sort-key | |
671 | (cons (format (aref function-info 3) ;MENU-TITLE | |
672 | (length buffer-list)) | |
673 | (cond | |
674 | ((null sorter) | |
675 | buffer-list) | |
2e6286be | 676 | ((eq sorter t) |
b9a5a6af RS |
677 | (nreverse buffer-list)) |
678 | (t | |
679 | (sort buffer-list sorter)))))))))) | |
680 | ||
681 | ;; Returns a list on the form ((TITLE . BUFFER-LIST)) for | |
682 | ;; the most recently used buffers. | |
683 | (defun msb--most-recently-used-menu (max-buffer-name-length) | |
4aa4849b RS |
684 | (when (and (numberp msb-display-most-recently-used) |
685 | (> msb-display-most-recently-used 0)) | |
686 | (let* ((most-recently-used | |
b9a5a6af RS |
687 | (loop with n = 0 |
688 | for buffer in (cdr (buffer-list)) | |
689 | if (save-excursion | |
690 | (set-buffer buffer) | |
691 | (and (not (msb-invisible-buffer-p)) | |
692 | (not (eq major-mode 'dired-mode)))) | |
693 | collect (save-excursion | |
694 | (set-buffer buffer) | |
695 | (cons (funcall msb-item-handling-function | |
696 | buffer | |
697 | max-buffer-name-length) | |
698 | buffer)) | |
699 | and do (incf n) | |
4aa4849b | 700 | until (>= n msb-display-most-recently-used)))) |
b9a5a6af RS |
701 | (cons (if (stringp msb-most-recently-used-title) |
702 | (format msb-most-recently-used-title | |
703 | (length most-recently-used)) | |
704 | (signal 'wrong-type-argument (list msb-most-recently-used-title))) | |
705 | most-recently-used)))) | |
706 | ||
707 | (defun msb--create-buffer-menu-2 () | |
708 | (let ((max-buffer-name-length 0) | |
709 | file-buffers | |
710 | function-info-vector) | |
711 | ;; Calculate the longest buffer name. | |
712 | (mapc | |
713 | (function | |
714 | (lambda (buffer) | |
715 | (if (or msb-display-invisible-buffers-p | |
716 | (not (msb-invisible-buffer-p))) | |
717 | (setq max-buffer-name-length | |
718 | (max max-buffer-name-length | |
719 | (length (buffer-name buffer))))))) | |
720 | (buffer-list)) | |
721 | ;; Make a list with elements of type | |
722 | ;; (BUFFER-LIST-VARIABLE | |
723 | ;; CONDITION | |
724 | ;; MENU-SORT-KEY | |
725 | ;; MENU-TITLE | |
726 | ;; ITEM-HANDLER | |
727 | ;; SORTER) | |
728 | ;; Uses "function-global" variables: | |
729 | ;; function-info-vector | |
730 | (setq function-info-vector | |
731 | (apply (function vector) | |
732 | (mapcar (function msb--create-function-info) | |
733 | msb-menu-cond))) | |
734 | ;; Split the buffer-list into several lists; one list for each | |
2e6286be | 735 | ;; criteria. This is the most critical part with respect to time. |
b9a5a6af RS |
736 | (mapc (function (lambda (buffer) |
737 | (cond ((and msb-files-by-directory | |
738 | (buffer-file-name buffer)) | |
739 | (push buffer file-buffers)) | |
740 | (t | |
741 | (msb--choose-menu buffer | |
742 | function-info-vector | |
743 | max-buffer-name-length))))) | |
744 | (buffer-list)) | |
745 | (when file-buffers | |
746 | (setq file-buffers | |
747 | (mapcar (function | |
748 | (lambda (buffer-list) | |
749 | (cons msb-files-by-directory-sort-key | |
750 | (cons (car buffer-list) | |
751 | (sort | |
752 | (mapcar (function | |
753 | (lambda (buffer) | |
4aa4849b RS |
754 | (cons (save-excursion |
755 | (set-buffer buffer) | |
756 | (funcall msb-item-handling-function | |
757 | buffer | |
758 | max-buffer-name-length)) | |
b9a5a6af RS |
759 | buffer))) |
760 | (cdr buffer-list)) | |
761 | (function | |
762 | (lambda (item1 item2) | |
763 | (string< (car item1) (car item2))))))))) | |
764 | (msb--choose-file-menu file-buffers)))) | |
765 | ;; Now make the menu - a list of (TITLE . BUFFER-LIST) | |
4aa4849b | 766 | (let* (menu |
b9a5a6af RS |
767 | (most-recently-used |
768 | (msb--most-recently-used-menu max-buffer-name-length)) | |
769 | (others (append file-buffers | |
770 | (loop for elt | |
4aa4849b RS |
771 | across function-info-vector |
772 | for value = (msb--create-sort-item elt) | |
773 | if value collect value)))) | |
b9a5a6af RS |
774 | (setq menu |
775 | (mapcar 'cdr ;Remove the SORT-KEY | |
776 | ;; Sort the menus - not the items. | |
777 | (msb--add-separators | |
778 | (sort | |
779 | ;; Get a list of (SORT-KEY TITLE . BUFFER-LIST) | |
780 | ;; Also sorts the items within the menus. | |
781 | (if (cdr most-recently-used) | |
782 | (cons | |
783 | ;; Add most recent used buffers | |
784 | (cons msb-most-recently-used-sort-key | |
785 | most-recently-used) | |
786 | others) | |
787 | others) | |
788 | (function (lambda (elt1 elt2) | |
789 | (< (car elt1) (car elt2)))))))) | |
790 | ;; Now make it a keymap menu | |
791 | (append | |
792 | '(keymap "Select Buffer") | |
793 | (msb--make-keymap-menu menu) | |
794 | (when msb-separator-diff | |
795 | (list (list 'separator "---"))) | |
796 | (list (cons 'toggle | |
797 | (cons | |
798 | (if msb-files-by-directory | |
799 | "*Files by type*" | |
800 | "*Files by directory*") | |
801 | 'msb--toggle-menu-type))))))) | |
802 | ||
803 | (defun msb--create-buffer-menu () | |
804 | (save-match-data | |
805 | (save-excursion | |
806 | (msb--create-buffer-menu-2)))) | |
807 | ||
808 | ;;; | |
809 | ;;; Multi purpose function for selecting a buffer with the mouse. | |
810 | ;;; | |
811 | (defun msb--toggle-menu-type () | |
812 | (interactive) | |
813 | (setq msb-files-by-directory (not msb-files-by-directory)) | |
814 | (menu-bar-update-buffers t)) | |
815 | ||
816 | (defun mouse-select-buffer (event) | |
817 | "Pop up several menus of buffers, for selection with the mouse. | |
818 | Returns the selected buffer or nil if no buffer is selected. | |
819 | ||
4aa4849b | 820 | The way the buffers are split is conveniently handled with the |
2e6286be | 821 | variable `msb-menu-cond'." |
b9a5a6af RS |
822 | ;; Popup the menu and return the selected buffer. |
823 | (when (or msb--error | |
824 | (not msb--last-buffer-menu) | |
825 | (not (fboundp 'frame-or-buffer-changed-p)) | |
826 | (frame-or-buffer-changed-p)) | |
827 | (setq msb--error nil) | |
828 | (setq msb--last-buffer-menu (msb--create-buffer-menu))) | |
4aa4849b RS |
829 | (let ((position event) |
830 | choice) | |
b9a5a6af RS |
831 | (when (and (fboundp 'posn-x-y) |
832 | (fboundp 'posn-window)) | |
833 | (let ((posX (car (posn-x-y (event-start event)))) | |
834 | (posY (cdr (posn-x-y (event-start event)))) | |
4aa4849b | 835 | (posWind (posn-window (event-start event)))) |
b9a5a6af RS |
836 | ;; adjust position |
837 | (setq posX (- posX (funcall msb-horizontal-shift-function)) | |
838 | position (list (list posX posY) posWind)))) | |
4aa4849b | 839 | (setq choice (x-popup-menu position msb--last-buffer-menu)) |
b9a5a6af | 840 | (cond |
4aa4849b RS |
841 | ((eq (car choice) 'toggle) |
842 | ;; Bring up the menu again with type toggled. | |
843 | (msb--toggle-menu-type) | |
844 | (mouse-select-buffer event)) | |
845 | ((and (numberp (car choice)) | |
846 | (null (cdr choice))) | |
847 | (let ((msb--last-buffer-menu (nthcdr 3 (assq (car choice) msb--last-buffer-menu)))) | |
b9a5a6af | 848 | (mouse-select-buffer event))) |
4aa4849b RS |
849 | ((while (numberp (car choice)) |
850 | (setq choice (cdr choice)))) | |
851 | ((and (stringp (car choice)) | |
852 | (null (cdr choice))) | |
853 | (car choice)) | |
dc3247b3 RS |
854 | ((null choice) |
855 | choice) | |
4aa4849b RS |
856 | (t |
857 | (error "Unknown form for buffer: %s" choice))))) | |
b9a5a6af RS |
858 | |
859 | ;; Add separators | |
860 | (defun msb--add-separators (sorted-list) | |
861 | (cond | |
862 | ((or (not msb-separator-diff) | |
863 | (not (numberp msb-separator-diff))) | |
864 | sorted-list) | |
865 | (t | |
866 | (let ((last-key nil)) | |
867 | (mapcan | |
868 | (function | |
869 | (lambda (item) | |
870 | (cond | |
871 | ((and msb-separator-diff | |
872 | last-key | |
873 | (> (- (car item) last-key) | |
874 | msb-separator-diff)) | |
875 | (setq last-key (car item)) | |
876 | (list (cons last-key 'separator) | |
877 | item)) | |
878 | (t | |
879 | (setq last-key (car item)) | |
880 | (list item))))) | |
881 | sorted-list))))) | |
882 | ||
4aa4849b RS |
883 | (defun msb--split-menus-2 (list mcount result) |
884 | (cond | |
885 | ((> (length list) msb-max-menu-items) | |
886 | (let ((count 0) | |
887 | sub-name | |
888 | (tmp-list nil)) | |
889 | (while (< count msb-max-menu-items) | |
890 | (push (pop list) tmp-list) | |
891 | (incf count)) | |
892 | (setq tmp-list (nreverse tmp-list)) | |
893 | (setq sub-name (concat (car (car tmp-list)) "...")) | |
894 | (push (append (list mcount sub-name | |
895 | 'keymap sub-name) | |
896 | tmp-list) | |
897 | result)) | |
898 | (msb--split-menus-2 list (1+ mcount) result)) | |
899 | ((null result) | |
900 | list) | |
901 | (t | |
902 | (let (sub-name) | |
903 | (setq sub-name (concat (car (car list)) "...")) | |
904 | (push (append (list mcount sub-name | |
905 | 'keymap sub-name) | |
906 | list) | |
907 | result)) | |
908 | (nreverse result)))) | |
909 | ||
910 | (defun msb--split-menus (list) | |
911 | (msb--split-menus-2 list 0 nil)) | |
912 | ||
913 | ||
b9a5a6af RS |
914 | (defun msb--make-keymap-menu (raw-menu) |
915 | (let ((end (cons '(nil) 'menu-bar-select-buffer)) | |
916 | (mcount 0)) | |
917 | (mapcar | |
918 | (function | |
919 | (lambda (sub-menu) | |
920 | (cond | |
921 | ((eq 'separator sub-menu) | |
922 | (list 'separator "---")) | |
923 | (t | |
4aa4849b RS |
924 | (let ((buffers (mapcar (function |
925 | (lambda (item) | |
926 | (let ((string (car item)) | |
927 | (buffer (cdr item))) | |
928 | (cons (buffer-name buffer) | |
929 | (cons string end))))) | |
930 | (cdr sub-menu)))) | |
931 | (append (list (incf mcount) (car sub-menu) | |
932 | 'keymap (car sub-menu)) | |
933 | (msb--split-menus buffers))))))) | |
b9a5a6af RS |
934 | raw-menu))) |
935 | ||
936 | (defun menu-bar-update-buffers (&optional arg) | |
937 | ;; If user discards the Buffers item, play along. | |
938 | (when (and (lookup-key (current-global-map) [menu-bar buffer]) | |
939 | (or (not (fboundp 'frame-or-buffer-changed-p)) | |
940 | (frame-or-buffer-changed-p) | |
941 | arg)) | |
942 | (let ((buffers (buffer-list)) | |
943 | (frames (frame-list)) | |
944 | buffers-menu frames-menu) | |
945 | ;; If requested, list only the N most recently selected buffers. | |
946 | (when (and (integerp buffers-menu-max-size) | |
947 | (> buffers-menu-max-size 1) | |
948 | (> (length buffers) buffers-menu-max-size)) | |
949 | (setcdr (nthcdr buffers-menu-max-size buffers) nil)) | |
950 | ;; Make the menu of buffers proper. | |
951 | (setq msb--last-buffer-menu (msb--create-buffer-menu)) | |
952 | (setq buffers-menu msb--last-buffer-menu) | |
953 | ;; Make a Frames menu if we have more than one frame. | |
954 | (if (cdr frames) | |
955 | (setq frames-menu | |
956 | (cons "Select Frame" | |
957 | (mapcar | |
958 | (function | |
959 | (lambda (frame) | |
960 | (nconc | |
961 | (list frame | |
962 | (cdr (assq 'name | |
963 | (frame-parameters frame))) | |
964 | (cons nil nil)) | |
965 | 'menu-bar-select-frame))) | |
966 | frames)))) | |
967 | (when frames-menu | |
968 | (setq frames-menu (cons 'keymap frames-menu))) | |
969 | (define-key (current-global-map) [menu-bar buffer] | |
970 | (cons "Buffers" | |
971 | (if (and buffers-menu frames-menu) | |
972 | (list 'keymap "Buffers and Frames" | |
973 | (cons 'buffers (cons "Buffers" buffers-menu)) | |
974 | (cons 'frames (cons "Frames" frames-menu))) | |
975 | (or buffers-menu frames-menu 'undefined))))))) | |
976 | ||
977 | (when (and (boundp 'menu-bar-update-hook) | |
978 | (not (fboundp 'frame-or-buffer-changed-p))) | |
979 | (defvar msb--buffer-count 0) | |
980 | (defun frame-or-buffer-changed-p () | |
981 | (let ((count (length (buffer-list)))) | |
982 | (when (/= count msb--buffer-count) | |
983 | (setq msb--buffer-count count) | |
984 | t)))) | |
985 | ||
986 | (unless (or (not (boundp 'menu-bar-update-hook)) | |
987 | (memq 'menu-bar-update-buffers menu-bar-update-hook)) | |
988 | (add-hook 'menu-bar-update-hook 'menu-bar-update-buffers)) | |
989 | ||
990 | (and (fboundp 'mouse-buffer-menu) | |
991 | (substitute-key-definition 'mouse-buffer-menu 'msb (current-global-map))) | |
992 | ||
993 | (provide 'msb) | |
994 | (eval-after-load 'msb (run-hooks 'msb-after-load-hooks)) | |
995 | ;;; msb.el ends here |