Mercurial > emacs
comparison lisp/msb.el @ 20504:1b8aec1c12f1
Doc fixes. Changed `append' to `nconc'
in a number of places. Changed the separator in menus
from "---" to "--" to work in Windows 95.
(msb--home-path): New internal variable to cache the value of $HOME.
(msb--strip-path): Now handles MSDOG style of file names.
(msb--init-file-alist): Now expands `buffer-file-name'.
(msb--format-title): New subroutine for `msb--choose-file-menu'.
(msb--choose-file-menu): Use msb--format-title. Minor simplifications.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Mon, 22 Dec 1997 02:26:17 +0000 |
parents | 052a9f2e21e5 |
children | 10abc15f305a |
comparison
equal
deleted
inserted
replaced
20503:29b573be752f | 20504:1b8aec1c12f1 |
---|---|
1 ;;; msb.el --- Customizable buffer-selection with multiple menus. | 1 ;;; msb.el --- Customizable buffer-selection with multiple menus. |
2 | 2 |
3 ;; Copyright (C) 1993, 1994, 1995 Lars Lindberg <Lars.Lindberg@sypro.cap.se> | 3 ;; Copyright (C) 1993, 1994, 1995, 1997 Lars Lindberg |
4 | 4 ;; <Lars.G.Lindberg@capgemini.se> |
5 ;; Author: Lars Lindberg <Lars.Lindberg@sypro.cap.se> | 5 ;; <Lars.G.Lindberg@mailbox.swipnet.se> |
6 | |
7 ;; Author: Lars Lindberg <Lars.G.Lindberg@capgemini.se> | |
6 ;; Created: 8 Oct 1993 | 8 ;; Created: 8 Oct 1993 |
7 ;; Lindberg's last update version: 3.31 | 9 ;; Lindberg's last update version: 3.33 |
8 ;; Keywords: mouse buffer menu | 10 ;; Keywords: mouse buffer menu |
9 | 11 |
10 ;; This file is part of GNU Emacs. | 12 ;; This file is part of GNU Emacs. |
11 | 13 |
12 ;; GNU Emacs is free software; you can redistribute it and/or modify | 14 ;; GNU Emacs is free software; you can redistribute it and/or modify |
13 ;; it under the terms of the GNU General Public License as published by | 15 ;; it under the terms of the GNU General Public License as published by |
46 ;; want. It's not that hard to customize, despite my not-so-good | 48 ;; want. It's not that hard to customize, despite my not-so-good |
47 ;; doc-string. Feel free to send me a better doc-string. | 49 ;; doc-string. Feel free to send me a better doc-string. |
48 ;; There are some constants for you to try here: | 50 ;; There are some constants for you to try here: |
49 ;; msb--few-menus | 51 ;; msb--few-menus |
50 ;; msb--very-many-menus (default) | 52 ;; msb--very-many-menus (default) |
51 ;; | 53 ;; |
52 ;; Look at the variable `msb-item-handling-function' for customization | 54 ;; Look at the variable `msb-item-handling-function' for customization |
53 ;; of the appearance of every menu item. Try for instance setting | 55 ;; of the appearance of every menu item. Try for instance setting |
54 ;; it to `msb-alon-item-handler'. | 56 ;; it to `msb-alon-item-handler'. |
55 ;; | 57 ;; |
56 ;; Look at the variable `msb-item-sort-function' for customization | 58 ;; Look at the variable `msb-item-sort-function' for customization |
57 ;; of sorting the menus. Set it to t for instance, which means no | 59 ;; of sorting the menus. Set it to t for instance, which means no |
58 ;; sorting - you will get latest used buffer first. | 60 ;; sorting - you will get latest used buffer first. |
59 ;; | 61 ;; |
60 ;; Also check out the variable `msb-display-invisible-buffers-p'. | 62 ;; Also check out the variable `msb-display-invisible-buffers-p'. |
115 4020 | 117 4020 |
116 "WWW (%d)") | 118 "WWW (%d)") |
117 ((or (memq major-mode '(rmail-mode rmail-edit-mode vm-summary-mode vm-mode mail-mode)) | 119 ((or (memq major-mode '(rmail-mode rmail-edit-mode vm-summary-mode vm-mode mail-mode)) |
118 (memq major-mode '(mh-letter-mode | 120 (memq major-mode '(mh-letter-mode |
119 mh-show-mode | 121 mh-show-mode |
120 mh-folder-mode)) | 122 mh-folder-mode)) |
121 (memq major-mode '(gnus-summary-mode | 123 (memq major-mode '(gnus-summary-mode |
122 news-reply-mode | 124 news-reply-mode |
123 gnus-group-mode | 125 gnus-group-mode |
124 gnus-article-mode | 126 gnus-article-mode |
125 gnus-kill-file-mode | 127 gnus-kill-file-mode |
153 "Processes (%d)") | 155 "Processes (%d)") |
154 ((and msb-display-invisible-buffers-p | 156 ((and msb-display-invisible-buffers-p |
155 (msb-invisible-buffer-p) | 157 (msb-invisible-buffer-p) |
156 'multi) | 158 'multi) |
157 1090 | 159 1090 |
158 "Invisible buffers (%d)") | 160 "Invisible buffers (%d)") |
159 ((eq major-mode 'dired-mode) | 161 ((eq major-mode 'dired-mode) |
160 2010 | 162 2010 |
161 "Dired (%d)" | 163 "Dired (%d)" |
162 ;; Note this different menu-handler | 164 ;; Note this different menu-handler |
163 msb-dired-item-handler | 165 msb-dired-item-handler |
170 4020 | 172 4020 |
171 "WWW (%d)") | 173 "WWW (%d)") |
172 ((or (memq major-mode '(rmail-mode rmail-edit-mode vm-summary-mode vm-mode mail-mode)) | 174 ((or (memq major-mode '(rmail-mode rmail-edit-mode vm-summary-mode vm-mode mail-mode)) |
173 (memq major-mode '(mh-letter-mode | 175 (memq major-mode '(mh-letter-mode |
174 mh-show-mode | 176 mh-show-mode |
175 mh-folder-mode)) | 177 mh-folder-mode)) |
176 (memq major-mode '(gnus-summary-mode | 178 (memq major-mode '(gnus-summary-mode |
177 news-reply-mode | 179 news-reply-mode |
178 gnus-group-mode | 180 gnus-group-mode |
179 gnus-article-mode | 181 gnus-article-mode |
180 gnus-kill-file-mode | 182 gnus-kill-file-mode |
210 ;;; Customizable variables | 212 ;;; Customizable variables |
211 ;;; | 213 ;;; |
212 | 214 |
213 (defvar msb-separator-diff 100 | 215 (defvar msb-separator-diff 100 |
214 "*Non-nil means use separators. | 216 "*Non-nil means use separators. |
215 The separators will appear between all menus that have a sorting key that differs by this value or more.") | 217 The separators will appear between all menus that have a sorting key |
218 that differs by this value or more.") | |
216 | 219 |
217 (defvar msb-files-by-directory-sort-key 0 | 220 (defvar msb-files-by-directory-sort-key 0 |
218 "*The sort key for files sorted by directory") | 221 "*The sort key for files sorted by directory.") |
219 | 222 |
220 (defvar msb-max-menu-items 15 | 223 (defvar msb-max-menu-items 15 |
221 "*The maximum number of items in a menu. | 224 "*The maximum number of items in a menu. |
222 If this variable is set to 15 for instance, then the submenu will be split up in minor parts, 15 items each. | 225 If this variable is set to 15 for instance, then the submenu will be |
223 Nil means no limit.") | 226 split up in minor parts, 15 items each. If nil, there is no limit.") |
224 | 227 |
225 (defvar msb-max-file-menu-items 10 | 228 (defvar msb-max-file-menu-items 10 |
226 "*The maximum number of items from different directories. | 229 "*The maximum number of items from different directories. |
227 | 230 |
228 When the menu is of type `file by directory', this is the maximum | 231 When the menu is of type `file by directory', this is the maximum |
241 "*How many buffers should be in the most-recently-used menu. | 244 "*How many buffers should be in the most-recently-used menu. |
242 No buffers at all if less than 1 or nil (or any non-number).") | 245 No buffers at all if less than 1 or nil (or any non-number).") |
243 | 246 |
244 (defvar msb-most-recently-used-title "Most recently used (%d)" | 247 (defvar msb-most-recently-used-title "Most recently used (%d)" |
245 "*The title for the most-recently-used menu.") | 248 "*The title for the most-recently-used menu.") |
246 | 249 |
247 (defvar msb-horizontal-shift-function '(lambda () 0) | 250 (defvar msb-horizontal-shift-function '(lambda () 0) |
248 "*Function that specifies a number of pixels by which the top menu should | 251 "*Function that specifies how many pixels to shift the top menu leftwards.") |
249 be shifted leftwards.") | |
250 | 252 |
251 (defvar msb-display-invisible-buffers-p nil | 253 (defvar msb-display-invisible-buffers-p nil |
252 "*Show invisible buffers or not. | 254 "*Show invisible buffers or not. |
253 Non-nil means that the buffer menu should include buffers that have | 255 Non-nil means that the buffer menu should include buffers that have |
254 names that starts with a space character.") | 256 names that starts with a space character.") |
260 item. It should take to arguments, BUFFER and MAX-BUFFER-NAME-LENGTH, | 262 item. It should take to arguments, BUFFER and MAX-BUFFER-NAME-LENGTH, |
261 where the latter is the max length of all buffer names. | 263 where the latter is the max length of all buffer names. |
262 | 264 |
263 The function should return the string to use in the menu. | 265 The function should return the string to use in the menu. |
264 | 266 |
265 When the function is called, BUFFER is the current buffer. | 267 When the function is called, BUFFER is the current buffer. This |
266 This function is called for items in the variable `msb-menu-cond' that | 268 function is called for items in the variable `msb-menu-cond' that have |
267 have nil as ITEM-HANDLING-FUNCTION. See `msb-menu-cond' for more | 269 nil as ITEM-HANDLING-FUNCTION. See `msb-menu-cond' for more |
268 information.") | 270 information.") |
269 | 271 |
270 (defvar msb-item-sort-function 'msb-sort-by-name | 272 (defvar msb-item-sort-function 'msb-sort-by-name |
271 "*The order of items in a buffer menu. | 273 "*The order of items in a buffer menu. |
274 | |
272 The default function to call for handling the order of items in a menu | 275 The default function to call for handling the order of items in a menu |
273 item. This function is called like a sort function. The items | 276 item. This function is called like a sort function. The items look |
274 look like (ITEM-NAME . BUFFER). | 277 like (ITEM-NAME . BUFFER). |
278 | |
275 ITEM-NAME is the name of the item that will appear in the menu. | 279 ITEM-NAME is the name of the item that will appear in the menu. |
276 BUFFER is the buffer, this is not necessarily the current buffer. | 280 BUFFER is the buffer, this is not necessarily the current buffer. |
277 | 281 |
278 Set this to nil or t if you don't want any sorting (faster).") | 282 Set this to nil or t if you don't want any sorting (faster).") |
279 | 283 |
286 The elements in the list should be of this type: | 290 The elements in the list should be of this type: |
287 (CONDITION MENU-SORT-KEY MENU-TITLE ITEM-HANDLING-FN ITEM-SORT-FN). | 291 (CONDITION MENU-SORT-KEY MENU-TITLE ITEM-HANDLING-FN ITEM-SORT-FN). |
288 | 292 |
289 When making the split, the buffers are tested one by one against the | 293 When making the split, the buffers are tested one by one against the |
290 CONDITION, just like a lisp cond: When hitting a true condition, the | 294 CONDITION, just like a lisp cond: When hitting a true condition, the |
291 other criteria are *not* tested and the buffer name will appear in | 295 other criteria are *not* tested and the buffer name will appear in the |
292 the menu with the menu-title corresponding to the true condition. | 296 menu with the menu-title corresponding to the true condition. |
293 | 297 |
294 If the condition returns the symbol `multi', then the buffer will be | 298 If the condition returns the symbol `multi', then the buffer will be |
295 added to this menu *and* tested for other menus too. If it returns | 299 added to this menu *and* tested for other menus too. If it returns |
296 `no-multi', then the buffer will only be added if it hasn't been added | 300 `no-multi', then the buffer will only be added if it hasn't been added |
297 to any other menu. | 301 to any other menu. |
298 | 302 |
299 During this test, the buffer in question is the current buffer, and | 303 During this test, the buffer in question is the current buffer, and |
300 the test is surrounded by calls to `save-excursion' and | 304 the test is surrounded by calls to `save-excursion' and |
301 `save-match-data'. | 305 `save-match-data'. |
302 | 306 |
303 The categories are sorted by MENU-SORT-KEY. Smaller keys are on | 307 The categories are sorted by MENU-SORT-KEY. Smaller keys are on top. |
304 top. nil means don't display this menu. | 308 nil means don't display this menu. |
305 | 309 |
306 MENU-TITLE is really a format. If you add %d in it, the %d is replaced | 310 MENU-TITLE is really a format. If you add %d in it, the %d is |
307 with the number of items in that menu. | 311 replaced with the number of items in that menu. |
308 | 312 |
309 ITEM-HANDLING-FN, is optional. If it is supplied and is a | 313 ITEM-HANDLING-FN, is optional. If it is supplied and is a function, |
310 function, than it is used for displaying the items in that particular | 314 than it is used for displaying the items in that particular buffer |
311 buffer menu, otherwise the function pointed out by | 315 menu, otherwise the function pointed out by |
312 `msb-item-handling-function' is used. | 316 `msb-item-handling-function' is used. |
313 | 317 |
314 ITEM-SORT-FN, is also optional. | 318 ITEM-SORT-FN, is also optional. |
315 If it is not supplied, the function pointed out by | 319 If it is not supplied, the function pointed out by |
316 `msb-item-sort-function' is used. | 320 `msb-item-sort-function' is used. |
319 If it is t, then no sort takes place and the buffers are presented in | 323 If it is t, then no sort takes place and the buffers are presented in |
320 most-recently-used order. | 324 most-recently-used order. |
321 If it is supplied and non-nil and not t than it is used for sorting | 325 If it is supplied and non-nil and not t than it is used for sorting |
322 the items in that particular buffer menu. | 326 the items in that particular buffer menu. |
323 | 327 |
324 Note1: There should always be a `catch-all' as last element, | 328 Note1: There should always be a `catch-all' as last element, in this |
325 in this list. That is an element like (t TITLE ITEM-HANDLING-FUNCTION). | 329 list. That is an element like (t TITLE ITEM-HANDLING-FUNCTION). |
326 Note2: A buffer menu appears only if it has at least one buffer in it. | 330 Note2: A buffer menu appears only if it has at least one buffer in it. |
327 Note3: If you have a CONDITION that can't be evaluated you will get an | 331 Note3: If you have a CONDITION that can't be evaluated you will get an |
328 error every time you do \\[msb].") | 332 error every time you do \\[msb].") |
329 | 333 |
330 (defvar msb-after-load-hooks nil | 334 (defvar msb-after-load-hooks nil |
331 "Hooks to be run after the msb package has been loaded.") | 335 "Hooks to be run after the msb package has been loaded.") |
332 | 336 |
333 ;;; | 337 ;;; |
334 ;;; Internal variables | 338 ;;; Internal variables |
335 ;;; | 339 ;;; |
340 | |
341 ;; Home directory for the current user | |
342 (defvar msb--home-path | |
343 (condition-case nil | |
344 (substitute-in-file-name "$HOME") | |
345 ;; If $HOME isn't defined, use nil | |
346 (error nil))) | |
336 | 347 |
337 ;; The last calculated menu. | 348 ;; The last calculated menu. |
338 (defvar msb--last-buffer-menu nil) | 349 (defvar msb--last-buffer-menu nil) |
339 | 350 |
340 ;; If this is non-nil, then it is a string that describes the error. | 351 ;; If this is non-nil, then it is a string that describes the error. |
406 | 417 |
407 | 418 |
408 (defun msb-sort-by-directory (item1 item2) | 419 (defun msb-sort-by-directory (item1 item2) |
409 "Sorts the items depending on their directory. Made for dired. | 420 "Sorts the items depending on their directory. Made for dired. |
410 An item look like (NAME . BUFFER)." | 421 An item look like (NAME . BUFFER)." |
411 (string-lessp (save-excursion (set-buffer (cdr item1)) (msb--dired-directory)) | 422 (string-lessp (save-excursion (set-buffer (cdr item1)) |
412 (save-excursion (set-buffer (cdr item2)) (msb--dired-directory)))) | 423 (msb--dired-directory)) |
424 (save-excursion (set-buffer (cdr item2)) | |
425 (msb--dired-directory)))) | |
413 | 426 |
414 ;;; | 427 ;;; |
415 ;;; msb | 428 ;;; msb |
416 ;;; | 429 ;;; |
417 ;;; This function can be used instead of (mouse-buffer-menu EVENT) | 430 ;;; This function can be used instead of (mouse-buffer-menu EVENT) |
418 ;;; function in "mouse.el". | 431 ;;; function in "mouse.el". |
419 ;;; | 432 ;;; |
420 (defun msb (event) | 433 (defun msb (event) |
421 "Pop up several menus of buffers for selection with the mouse. | 434 "Pop up several menus of buffers for selection with the mouse. |
422 This command switches buffers in the window that you clicked on, and | 435 This command switches buffers in the window that you clicked on, and |
423 selects that window. | 436 selects that window. |
424 | 437 |
444 (eq ?\ (aref (buffer-name buffer) 0)))) | 457 (eq ?\ (aref (buffer-name buffer) 0)))) |
445 | 458 |
446 ;; Strip one hierarchy level from the end of PATH. | 459 ;; Strip one hierarchy level from the end of PATH. |
447 (defun msb--strip-path (path) | 460 (defun msb--strip-path (path) |
448 (save-match-data | 461 (save-match-data |
449 (if (string-match "\\(.+\\)/[^/]+$" path) | 462 (cond |
450 (substring path (match-beginning 1) (match-end 1)) | 463 ((string-match "^\\([^/]*/.+/\\)[^/]+$" path) |
451 "/"))) | 464 (substring path (match-beginning 1) (match-end 1))) |
465 ((string-match "^\\([^/]*/\\)" path) | |
466 (substring path (match-beginning 1) (match-end 1))) | |
467 (t | |
468 (error "msb: Path '%s' has an unrecognized format" path))))) | |
452 | 469 |
453 ;; Create an alist with all buffers from LIST that lies under the same | 470 ;; Create an alist with all buffers from LIST that lies under the same |
454 ;; directory will be in the same item as the directory string as | 471 ;; directory will be in the same item as the directory string. |
455 ;; ((PATH1 . (BUFFER-1 BUFFER-2 ...)) (PATH2 . (BUFFER-K BUFFER-K+1...)) ...) | 472 ;; ((PATH1 . (BUFFER-1 BUFFER-2 ...)) (PATH2 . (BUFFER-K BUFFER-K+1...)) = |
473 ...) | |
456 (defun msb--init-file-alist (list) | 474 (defun msb--init-file-alist (list) |
457 (let ((buffer-alist | 475 (let ((buffer-alist |
476 ;; Make alist that looks like | |
477 ;; ((PATH-1 BUFFER-1) (PATH-2 BUFFER-2) ...) | |
478 ;; sorted on PATH-x | |
458 (sort (mapcan | 479 (sort (mapcan |
459 (function | 480 (function |
460 (lambda (buffer) | 481 (lambda (buffer) |
461 (let ((file-name (buffer-file-name buffer))) | 482 (let ((file-name (expand-file-name (buffer-file-name buffer)))) = |
483 ;LGL 971218 | |
462 (when file-name | 484 (when file-name |
463 (list (cons (msb--strip-path file-name) buffer)))))) | 485 (list (cons (msb--strip-path file-name) buffer)))))) |
464 list) | 486 list) |
465 (function (lambda (item1 item2) | 487 (function (lambda (item1 item2) |
466 (string< (car item1) (car item2))))))) | 488 (string< (car item1) (car item2))))))) |
489 ;; Now clump buffers togehter that have the same path | |
467 ;; Make alist that looks like | 490 ;; Make alist that looks like |
468 ;; ((PATH1 . (BUFFER-1 BUFFER-2 ...)) (PATH2 . (BUFFER-K)) ...) | 491 ;; ((PATH1 . (BUFFER-1 BUFFER-2 ...)) (PATH2 . (BUFFER-K)) ...) |
469 (let ((path nil) | 492 (let ((path nil) |
470 (buffers nil) | 493 (buffers nil)) |
471 (result nil)) | 494 (nconc |
472 (append | |
473 (mapcan (function | 495 (mapcan (function |
474 (lambda (item) | 496 (lambda (item) |
475 (cond | 497 (cond |
476 ((and path | 498 ((and path |
477 (string= path (car item))) | 499 (string=3D path (car item))) |
478 (push (cdr item) buffers) | 500 ;; The same path as earlier: Add to current list of |
479 nil) | 501 ;; buffers. |
480 (t | 502 (push (cdr item) buffers) |
481 (when path | 503 ;; This item should not be added to list |
482 (setq result (cons path buffers))) | 504 nil) |
483 (setq path (car item)) | 505 (t |
484 (setq buffers (list (cdr item))) | 506 ;; New path |
485 (and result (list result)))))) | 507 (let ((result (and path (cons path buffers)))) |
486 buffer-alist) | 508 (setq path (car item)) |
509 (setq buffers (list (cdr item))) | |
510 ;; Add the last result the list. | |
511 (and result (list result))))))) | |
512 buffer-alist) | |
513 ;; Add the last result to the list | |
487 (list (cons path buffers)))))) | 514 (list (cons path buffers)))))) |
515 | |
516 ;; Format a suitable title for the menu item. | |
517 (defun msb--format-title (top-found-p path number-of-items) | |
518 (let ((new-path path)) | |
519 (when (and msb--home-path | |
520 (string-match (concat "^" msb--home-path) path)) | |
521 (setq new-path (concat "~/" | |
522 (substring path (match-end 0))))) | |
523 (format (if top-found-p "%s... (%d)" "%s (%d)") | |
524 new-path number-of-items))) | |
525 | |
488 | 526 |
489 ;; Choose file-menu with respect to directory for every buffer in LIST. | 527 ;; Choose file-menu with respect to directory for every buffer in LIST. |
490 (defun msb--choose-file-menu (list) | 528 (defun msb--choose-file-menu (list) |
491 (let ((buffer-alist (msb--init-file-alist list)) | 529 (let ((buffer-alist (msb--init-file-alist list)) |
492 (final-list nil) | 530 (final-list nil) |
494 msb-max-file-menu-items | 532 msb-max-file-menu-items |
495 10)) | 533 10)) |
496 (top-found-p nil) | 534 (top-found-p nil) |
497 (last-path nil) | 535 (last-path nil) |
498 first rest path buffers) | 536 first rest path buffers) |
499 (setq first (car buffer-alist)) | 537 ;; Prepare for looping over all items in buffer-alist |
500 (setq rest (cdr buffer-alist)) | 538 (setq first (car buffer-alist) |
501 (setq path (car first)) | 539 rest (cdr buffer-alist) |
502 (setq buffers (cdr first)) | 540 path (car first) |
541 buffers (cdr first)) | |
542 ;; This big loop tries to clump buffers together that have a | |
543 ;; similar name. Remember that buffer-alist is sorted based on the | |
544 ;; path for the buffers. | |
503 (while rest | 545 (while rest |
504 (let ((found-p nil) | 546 (let ((found-p nil) |
505 (tmp-rest rest) | 547 (tmp-rest rest) |
548 result | |
506 new-path item) | 549 new-path item) |
507 (setq item (car tmp-rest)) | 550 (setq item (car tmp-rest)) |
551 ;; Clump together the "rest"-buffers that have a path that is | |
552 ;; a subpath of the current one. | |
508 (while (and tmp-rest | 553 (while (and tmp-rest |
509 (<= (length buffers) max-clumped-together) | 554 (<= (length buffers) max-clumped-together) |
510 (>= (length (car item)) (length path)) | 555 (>= (length (car item)) (length path)) |
511 (string= path (substring (car item) 0 (length path)))) | 556 (string= path (substring (car item) 0 (length path)))) |
512 (setq found-p t) | 557 (setq found-p t) |
513 (setq buffers (append buffers (cdr item))) | 558 (setq buffers (append buffers (cdr item))) ;nconc is faster than append |
514 (setq tmp-rest (cdr tmp-rest)) | 559 (setq tmp-rest (cdr tmp-rest) |
515 (setq item (car tmp-rest))) | 560 item (car tmp-rest))) |
516 (cond | 561 (cond |
517 ((> (length buffers) max-clumped-together) | 562 ((> (length buffers) max-clumped-together) |
563 ;; Oh, we failed. Too many buffers clumped together. | |
564 ;; Just use the original ones for the result. | |
518 (setq last-path (car first)) | 565 (setq last-path (car first)) |
519 (setq first | 566 (push (cons (msb--format-title top-found-p |
520 (cons (format (if top-found-p | 567 (car first) |
521 "%s/... (%d)" | 568 (length (cdr first))) |
522 "%s (%d)") | 569 (cdr first)) |
523 (car first) | 570 final-list) |
524 (length (cdr first))) | |
525 (cdr first))) | |
526 (setq top-found-p nil) | 571 (setq top-found-p nil) |
527 (push first final-list) | |
528 (setq first (car rest) | 572 (setq first (car rest) |
529 rest (cdr rest)) | 573 rest (cdr rest) |
530 (setq path (car first) | 574 path (car first) |
531 buffers (cdr first))) | 575 buffers (cdr first))) |
532 (t | 576 (t |
577 ;; The first pass of clumping together worked out, go ahead | |
578 ;; with this result. | |
533 (when found-p | 579 (when found-p |
534 (setq top-found-p t) | 580 (setq top-found-p t) |
535 (setq first (cons path buffers) | 581 (setq first (cons path buffers) |
536 rest tmp-rest)) | 582 rest tmp-rest)) |
583 ;; Now see if we can clump more buffers together if we go up | |
584 ;; one step in the file hierarchy. | |
537 (setq path (msb--strip-path path) | 585 (setq path (msb--strip-path path) |
538 buffers (cdr first)) | 586 buffers (cdr first)) |
539 (when (and last-path | 587 (when (and last-path |
540 (or (and (>= (length path) (length last-path)) | 588 (or (and (>= (length path) (length last-path)) |
541 (string= last-path | 589 (string= last-path |
542 (substring path 0 (length last-path)))) | 590 (substring path 0 (length last-path)))) |
543 (and (< (length path) (length last-path)) | 591 (and (< (length path) (length last-path)) |
544 (string= path | 592 (string= path |
545 (substring last-path 0 (length path)))))) | 593 (substring last-path 0 (length path)))))) |
546 | 594 ;; We have reached the same place in the file hierarchy as |
547 (setq first | 595 ;; the last result, so we should quit at this point and |
548 (cons (format (if top-found-p | 596 ;; take what we have as result. |
549 "%s/... (%d)" | 597 (push (cons (msb--format-title top-found-p |
550 "%s (%d)") | 598 (car first) |
551 (car first) | 599 (length (cdr first))) |
552 (length (cdr first))) | 600 (cdr first)) |
553 (cdr first))) | 601 final-list) |
554 (setq top-found-p nil) | 602 (setq top-found-p nil) |
555 (push first final-list) | |
556 (setq first (car rest) | 603 (setq first (car rest) |
557 rest (cdr rest)) | 604 rest (cdr rest) |
558 (setq path (car first) | 605 path (car first) |
559 buffers (cdr first))))))) | 606 buffers (cdr first))))))) |
560 (setq first | 607 ;; Now take care of the last item. |
561 (cons (format (if top-found-p | 608 (push (cons (msb--format-title top-found-p |
562 "%s/... (%d)" | 609 (car first) |
563 "%s (%d)") | 610 (length (cdr first))) |
564 (car first) | 611 (cdr first)) |
565 (length (cdr first))) | 612 final-list) |
566 (cdr first))) | |
567 (setq top-found-p nil) | 613 (setq top-found-p nil) |
568 (push first final-list) | |
569 (nreverse final-list))) | 614 (nreverse final-list))) |
570 | 615 |
571 ;; Create a vector as: | 616 ;; Create a vector as: |
572 ;; [BUFFER-LIST-VARIABLE CONDITION MENU-SORT-KEY MENU-TITLE ITEM-HANDLER SORTER) | 617 ;; [BUFFER-LIST-VARIABLE CONDITION MENU-SORT-KEY MENU-TITLE ITEM-HANDLER SORTER) |
573 ;; from an element in `msb-menu-cond'. See that variable for a | 618 ;; from an element in `msb-menu-cond'. See that variable for a |
641 (cons (cons (funcall (aref function-info 4) ;ITEM-HANDLER | 686 (cons (cons (funcall (aref function-info 4) ;ITEM-HANDLER |
642 buffer | 687 buffer |
643 max-buffer-name-length) | 688 max-buffer-name-length) |
644 buffer) | 689 buffer) |
645 (eval list-symbol))))) | 690 (eval list-symbol))))) |
646 | 691 |
647 ;; Selects the appropriate menu for BUFFER. | 692 ;; Selects the appropriate menu for BUFFER. |
648 ;; This is all side-effects, folks! | 693 ;; This is all side-effects, folks! |
649 ;; This should be optimized. | 694 ;; This should be optimized. |
650 (defsubst msb--choose-menu (buffer function-info-vector max-buffer-name-length) | 695 (defsubst msb--choose-menu (buffer function-info-vector max-buffer-name-length) |
651 (unless (and (not msb-display-invisible-buffers-p) | 696 (unless (and (not msb-display-invisible-buffers-p) |
671 (let ((buffer-list (eval (aref function-info 0)))) | 716 (let ((buffer-list (eval (aref function-info 0)))) |
672 (when buffer-list | 717 (when buffer-list |
673 (let ((sorter (aref function-info 5)) ;SORTER | 718 (let ((sorter (aref function-info 5)) ;SORTER |
674 (sort-key (aref function-info 2))) ;MENU-SORT-KEY | 719 (sort-key (aref function-info 2))) ;MENU-SORT-KEY |
675 (when sort-key | 720 (when sort-key |
676 (cons sort-key | 721 (cons sort-key |
677 (cons (format (aref function-info 3) ;MENU-TITLE | 722 (cons (format (aref function-info 3) ;MENU-TITLE |
678 (length buffer-list)) | 723 (length buffer-list)) |
679 (cond | 724 (cond |
680 ((null sorter) | 725 ((null sorter) |
681 buffer-list) | 726 buffer-list) |
771 (msb--choose-file-menu file-buffers)))) | 816 (msb--choose-file-menu file-buffers)))) |
772 ;; Now make the menu - a list of (TITLE . BUFFER-LIST) | 817 ;; Now make the menu - a list of (TITLE . BUFFER-LIST) |
773 (let* (menu | 818 (let* (menu |
774 (most-recently-used | 819 (most-recently-used |
775 (msb--most-recently-used-menu max-buffer-name-length)) | 820 (msb--most-recently-used-menu max-buffer-name-length)) |
776 (others (append file-buffers | 821 (others (nconc file-buffers |
777 (loop for elt | 822 (loop for elt |
778 across function-info-vector | 823 across function-info-vector |
779 for value = (msb--create-sort-item elt) | 824 for value = (msb--create-sort-item elt) |
780 if value collect value)))) | 825 if value collect value)))) |
781 (setq menu | 826 (setq menu |
797 ;; Now make it a keymap menu | 842 ;; Now make it a keymap menu |
798 (append | 843 (append |
799 '(keymap "Select Buffer") | 844 '(keymap "Select Buffer") |
800 (msb--make-keymap-menu menu) | 845 (msb--make-keymap-menu menu) |
801 (when msb-separator-diff | 846 (when msb-separator-diff |
802 (list (list 'separator "---"))) | 847 (list (list 'separator "--"))) |
803 (list (cons 'toggle | 848 (list (cons 'toggle |
804 (cons | 849 (cons |
805 (if msb-files-by-directory | 850 (if msb-files-by-directory |
806 "*Files by type*" | 851 "*Files by type*" |
807 "*Files by directory*") | 852 "*Files by directory*") |
808 'msb--toggle-menu-type))))))) | 853 'msb--toggle-menu-type))))))) |
812 (save-excursion | 857 (save-excursion |
813 (msb--create-buffer-menu-2)))) | 858 (msb--create-buffer-menu-2)))) |
814 | 859 |
815 ;;; | 860 ;;; |
816 ;;; Multi purpose function for selecting a buffer with the mouse. | 861 ;;; Multi purpose function for selecting a buffer with the mouse. |
817 ;;; | 862 ;;; |
818 (defun msb--toggle-menu-type () | 863 (defun msb--toggle-menu-type () |
819 (interactive) | 864 (interactive) |
820 (setq msb-files-by-directory (not msb-files-by-directory)) | 865 (setq msb-files-by-directory (not msb-files-by-directory)) |
821 (menu-bar-update-buffers t)) | 866 (menu-bar-update-buffers t)) |
822 | 867 |
864 (car choice)) | 909 (car choice)) |
865 ((null choice) | 910 ((null choice) |
866 choice) | 911 choice) |
867 (t | 912 (t |
868 (error "Unknown form for buffer: %s" choice))))) | 913 (error "Unknown form for buffer: %s" choice))))) |
869 | 914 |
870 ;; Add separators | 915 ;; Add separators |
871 (defun msb--add-separators (sorted-list) | 916 (defun msb--add-separators (sorted-list) |
872 (cond | 917 (cond |
873 ((or (not msb-separator-diff) | 918 ((or (not msb-separator-diff) |
874 (not (numberp msb-separator-diff))) | 919 (not (numberp msb-separator-diff))) |
878 (mapcan | 923 (mapcan |
879 (function | 924 (function |
880 (lambda (item) | 925 (lambda (item) |
881 (cond | 926 (cond |
882 ((and msb-separator-diff | 927 ((and msb-separator-diff |
883 last-key | 928 last-key |
884 (> (- (car item) last-key) | 929 (> (- (car item) last-key) |
885 msb-separator-diff)) | 930 msb-separator-diff)) |
886 (setq last-key (car item)) | 931 (setq last-key (car item)) |
887 (list (cons last-key 'separator) | 932 (list (cons last-key 'separator) |
888 item)) | 933 item)) |
900 (while (< count msb-max-menu-items) | 945 (while (< count msb-max-menu-items) |
901 (push (pop list) tmp-list) | 946 (push (pop list) tmp-list) |
902 (incf count)) | 947 (incf count)) |
903 (setq tmp-list (nreverse tmp-list)) | 948 (setq tmp-list (nreverse tmp-list)) |
904 (setq sub-name (concat (car (car tmp-list)) "...")) | 949 (setq sub-name (concat (car (car tmp-list)) "...")) |
905 (push (append (list mcount sub-name | 950 (push (nconc (list mcount sub-name |
906 'keymap sub-name) | 951 'keymap sub-name) |
907 tmp-list) | 952 tmp-list) |
908 result)) | 953 result)) |
909 (msb--split-menus-2 list (1+ mcount) result)) | 954 (msb--split-menus-2 list (1+ mcount) result)) |
910 ((null result) | 955 ((null result) |
911 list) | 956 list) |
912 (t | 957 (t |
913 (let (sub-name) | 958 (let (sub-name) |
914 (setq sub-name (concat (car (car list)) "...")) | 959 (setq sub-name (concat (car (car list)) "...")) |
915 (push (append (list mcount sub-name | 960 (push (nconc (list mcount sub-name |
916 'keymap sub-name) | 961 'keymap sub-name) |
917 list) | 962 list) |
918 result)) | 963 result)) |
919 (nreverse result)))) | 964 (nreverse result)))) |
920 | 965 |
921 (defun msb--split-menus (list) | 966 (defun msb--split-menus (list) |
922 (msb--split-menus-2 list 0 nil)) | 967 (msb--split-menus-2 list 0 nil)) |
923 | 968 |
924 | 969 |
925 (defun msb--make-keymap-menu (raw-menu) | 970 (defun msb--make-keymap-menu (raw-menu) |
926 (let ((end (cons '(nil) 'menu-bar-select-buffer)) | 971 (let ((end (cons '(nil) 'menu-bar-select-buffer)) |
927 (mcount 0)) | 972 (mcount 0)) |
928 (mapcar | 973 (mapcar |
929 (function | 974 (function |
930 (lambda (sub-menu) | 975 (lambda (sub-menu) |
931 (cond | 976 (cond |
932 ((eq 'separator sub-menu) | 977 ((eq 'separator sub-menu) |
933 (list 'separator "---")) | 978 (list 'separator "--")) |
934 (t | 979 (t |
935 (let ((buffers (mapcar (function | 980 (let ((buffers (mapcar (function |
936 (lambda (item) | 981 (lambda (item) |
937 (let ((string (car item)) | 982 (let ((string (car item)) |
938 (buffer (cdr item))) | 983 (buffer (cdr item))) |
939 (cons (buffer-name buffer) | 984 (cons (buffer-name buffer) |
940 (cons string end))))) | 985 (cons string end))))) |
941 (cdr sub-menu)))) | 986 (cdr sub-menu)))) |
942 (append (list (incf mcount) (car sub-menu) | 987 (nconc (list (incf mcount) (car sub-menu) |
943 'keymap (car sub-menu)) | 988 'keymap (car sub-menu)) |
944 (msb--split-menus buffers))))))) | 989 (msb--split-menus buffers))))))) |
945 raw-menu))) | 990 raw-menu))) |
946 | 991 |
947 (defun menu-bar-update-buffers (&optional arg) | 992 (defun menu-bar-update-buffers (&optional arg) |
980 (define-key (current-global-map) [menu-bar buffer] | 1025 (define-key (current-global-map) [menu-bar buffer] |
981 (cons "Buffers" | 1026 (cons "Buffers" |
982 (if (and buffers-menu frames-menu) | 1027 (if (and buffers-menu frames-menu) |
983 ;; Combine Frame and Buffers menus with separator between | 1028 ;; Combine Frame and Buffers menus with separator between |
984 (nconc (list 'keymap "Buffers and Frames" frames-menu | 1029 (nconc (list 'keymap "Buffers and Frames" frames-menu |
985 (and msb-separator-diff '(separator "---"))) | 1030 (and msb-separator-diff '(separator "--"))) |
986 (cddr buffers-menu)) | 1031 (cddr buffers-menu)) |
987 (or buffers-menu 'undefined))))))) | 1032 (or buffers-menu 'undefined))))))) |
1033 | |
1034 (when (and (boundp 'menu-bar-update-hook) | |
1035 (not (fboundp 'frame-or-buffer-changed-p))) | |
1036 (defvar msb--buffer-count 0) | |
1037 (defun frame-or-buffer-changed-p () | |
1038 (let ((count (length (buffer-list)))) | |
1039 (when (/= count msb--buffer-count) | |
1040 (setq msb--buffer-count count) | |
1041 t)))) | |
988 | 1042 |
989 (unless (or (not (boundp 'menu-bar-update-hook)) | 1043 (unless (or (not (boundp 'menu-bar-update-hook)) |
990 (memq 'menu-bar-update-buffers menu-bar-update-hook)) | 1044 (memq 'menu-bar-update-buffers menu-bar-update-hook)) |
991 (add-hook 'menu-bar-update-hook 'menu-bar-update-buffers)) | 1045 (add-hook 'menu-bar-update-hook 'menu-bar-update-buffers)) |
992 | 1046 |
994 (substitute-key-definition 'mouse-buffer-menu 'msb (current-global-map))) | 1048 (substitute-key-definition 'mouse-buffer-menu 'msb (current-global-map))) |
995 | 1049 |
996 (provide 'msb) | 1050 (provide 'msb) |
997 (eval-after-load 'msb (run-hooks 'msb-after-load-hooks)) | 1051 (eval-after-load 'msb (run-hooks 'msb-after-load-hooks)) |
998 | 1052 |
999 ;; Load the cl-extra library now, since we will certainly need it later. | |
1000 (mapc 'ignore nil) | |
1001 | |
1002 ;;; msb.el ends here | 1053 ;;; msb.el ends here |