comparison lisp/msb.el @ 10239:52a1e5ef144c

Fix quoting conventions and spaces at end of sentence.
author Richard M. Stallman <rms@gnu.org>
date Sat, 24 Dec 1994 16:47:58 +0000
parents 4181e3182312
children 629821e2b42e
comparison
equal deleted inserted replaced
10238:0fcafe7e34cc 10239:52a1e5ef144c
1 ;;; msb.el --- Customizable buffer-selection with multiple menus. 1 ;;; msb.el --- Customizable buffer-selection with multiple menus.
2 ;; Copyright (C) 1993, 1994 Lars Lindberg <Lars.Lindberg@sypro.cap.se> 2 ;; Copyright (C) 1993, 1994 Lars Lindberg <Lars.Lindberg@sypro.cap.se>
3 ;; 3 ;;
4 ;; Author: Lars Lindberg <Lars.Lindberg@sypro.cap.se> 4 ;; Author: Lars Lindberg <Lars.Lindberg@sypro.cap.se>
5 ;; Created: 8 Oct 1993 5 ;; Created: 8 Oct 1993
6 ;; $Revision: 3.21 $
7 ;; $Date: 1994/12/22 07:58:27 $
8 ;; Keywords: mouse buffer menu 6 ;; Keywords: mouse buffer menu
9 ;; 7 ;;
10 ;; This program is free software; you can redistribute it and/or modify 8 ;; This program is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by 9 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2 of the License, or 10 ;; the Free Software Foundation; either version 2 of the License, or
19 ;; 17 ;;
20 ;; You should have received a copy of the GNU General Public License 18 ;; You should have received a copy of the GNU General Public License
21 ;; along with this program; if not, write to the Free Software 19 ;; along with this program; if not, write to the Free Software
22 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 20 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
23 21
24 ;; LCD Archive Entry:
25 ;; msb|Lars Lindberg|Lars.Lindberg@sypro.cap.se|
26 ;; Choose buffer with the mouse.
27 ;; $Date: 1994/12/22 07:58:27 $|$Revision: 3.21 $|~/packages/msb.el.Z|
28
29 ;;; Commentary: 22 ;;; Commentary:
30 ;; 23 ;;
31 ;; Purpose of this package: 24 ;; Purpose of this package:
32 ;; 1. Offer a function for letting the user choose buffer, 25 ;; 1. Offer a function for letting the user choose buffer,
33 ;; not necessarily for switching to it. 26 ;; not necessarily for switching to it.
35 ;; 28 ;;
36 ;; Installation: 29 ;; Installation:
37 ;; (require 'msb) 30 ;; (require 'msb)
38 ;; Note! You now use msb instead of mouse-buffer-menu. 31 ;; Note! You now use msb instead of mouse-buffer-menu.
39 ;; 32 ;;
40 ;; Now try c-mouse-down-1 (Press <CTRL> and mouse button 1 at the 33 ;; Now try the menu bar Buffers menu.
41 ;; same time).
42 ;; 34 ;;
43 ;; Customization: 35 ;; Customization:
44 ;; Look at the variable 'msb-menu-cond' for deciding what menus you 36 ;; Look at the variable `msb-menu-cond' for deciding what menus you
45 ;; want. It's not that hard to customize, despite my not-so-good 37 ;; want. It's not that hard to customize, despite my not-so-good
46 ;; doc-string. Feel free to send me a better doc-string. 38 ;; doc-string. Feel free to send me a better doc-string.
47 ;; There are some constants for you to try here: 39 ;; There are some constants for you to try here:
48 ;; msb--few-menus 40 ;; msb--few-menus
49 ;; msb--very-many-menus (default) 41 ;; msb--very-many-menus (default)
50 ;; 42 ;;
51 ;; Look at the variable 'msb-item-handling-function' for customization 43 ;; Look at the variable `msb-item-handling-function' for customization
52 ;; of the appearance of every menu item. Try for instance setting 44 ;; of the appearance of every menu item. Try for instance setting
53 ;; it to 'msb-alon-item-handler. 45 ;; it to `msb-alon-item-handler'.
54 ;; 46 ;;
55 ;; Look at the variable 'msb-item-sort-function' for customization 47 ;; Look at the variable `msb-item-sort-function' for customization
56 ;; of sorting the menus. Set it to t for instance, which means no 48 ;; of sorting the menus. Set it to t for instance, which means no
57 ;; sorting - you will get latest used buffer first. 49 ;; sorting - you will get latest used buffer first.
58 ;; 50 ;;
59 ;; Also check out the variable 'msb-display-invisible-buffers-p' 51 ;; Also check out the variable `msb-display-invisible-buffers-p'.
60 52
61 ;; Known bugs: 53 ;; Known bugs:
62 ;; - `msb' does not work on a non-X-toolkit Emacs. 54 ;; - `msb' does not work on a non-X-toolkit Emacs.
63 ;; Future enhancements: 55 ;; Future enhancements:
64 ;; - [Mattes] had a suggestion about sorting files by extension. 56 ;; - [Mattes] had a suggestion about sorting files by extension.
66 ;; rewritten to handle more dynamic splitting. It's now completely 58 ;; rewritten to handle more dynamic splitting. It's now completely
67 ;; static, depending on the menu-cond. If the splitting could also 59 ;; static, depending on the menu-cond. If the splitting could also
68 ;; be done by a user-defined function a lot of cases would be 60 ;; be done by a user-defined function a lot of cases would be
69 ;; solved. 61 ;; solved.
70 ;; - [Jim] suggested that the Frame menu became a part of the buffer menu. 62 ;; - [Jim] suggested that the Frame menu became a part of the buffer menu.
71
72 ;;; Change Log
73 ;; 3.21 22/12-94
74 ;; Fixed bug that occured in non X-toolkit versions of Emacs.
75 ;; [Chalupsky] pointed out that a global `save-match-data' is
76 ;; necessary.
77 ;; Bug found. Thanks [kifer].
78 ;; 3.16 20/12-94
79 ;; Added separators to the menu. New variable `msb-separator-diff'.
80 ;; New variable `msb-files-by-directory-sort-key'.
81 ;; Removed `msb--many-menus.'
82 ;; Fixed bugs.
83 ;; 3.13 20/12-94
84 ;; Menu fix for non-X-toolkit Emacsen and new "process"
85 ;; menu. Thanks [jim].
86 ;; Bug for 'files-by-type'.
87 ;; Restored the call to `msb-after-load-hooks'. Thanks [larry].
88 ;; Major fixes by [Ake].
89 ;; Menu-bar buffer-menu now has menu-toggle at top level.
90 ;; 3.6 16/12-94
91 ;; Added variable `msb-max-file-menu-items'.
92 ;; Removed a large part of the change log.
93 ;; Found bug.
94 ;; 3.3 16/12-94
95 ;; Found bugs.
96 ;; 3.1 16/12-94
97 ;; Now has two types of menus - "files by directory" and "files
98 ;; by type".
99 ;; Added variable `msb-files-by-directory'.
100 ;; Fixed a number of bugs for older versions.
101 ;; 2.11 16/12-94
102 ;; Added 'no-multi to msb-menu-cond.
103 ;; Added possibility to shift the menu leftwards. Thanks [kifer].
104 ;; 2.8 15/12-94
105 ;; Now aware of earlier versions of Emacs that doesn't have the
106 ;; function `frame-or-buffer-changed-p' or the variable
107 ;; `menu-bar-update-hook'. Thanks [will].
108 ;; 2.7 14/12-94
109 ;; Better installation.
110 ;; 2.6 14/12-94
111 ;; Now only makes up the menu when necessary.
112 ;; Added menu-bar support.
113 ;; Now handles errors in msb-menu-cond better. Thanks [jaalto].
114 ;; Added MH-awareness. Thanks [kifer].
115 ;; Added autoload statements.
116 ;; 2.3 8/12-94
117 ;; Now uses RCS version numbering for msb.el version number.
118 ;; Submitted this to LCD.
119 63
120 ;;; Thanks goes to 64 ;;; Thanks goes to
121 ;; [msb] - Mark Brader <msb@sq.com> 65 ;; [msb] - Mark Brader <msb@sq.com>
122 ;; [Chalupsky] - Hans Chalupsky <hans@cs.Buffalo.EDU> 66 ;; [Chalupsky] - Hans Chalupsky <hans@cs.Buffalo.EDU>
123 ;; [jim] - Jim Berry <m1jhb00@FRB.GOV> 67 ;; [jim] - Jim Berry <m1jhb00@FRB.GOV>
136 ;;; Code: 80 ;;; Code:
137 81
138 (require 'cl) 82 (require 'cl)
139 83
140 ;;; 84 ;;;
141 ;;; Some example constants to be used for 'msb-menu-cond'. See that 85 ;;; Some example constants to be used for `msb-menu-cond'. See that
142 ;;; variable for more information. Please note that if the condition 86 ;;; variable for more information. Please note that if the condition
143 ;;; returns 'multi, then the buffer can appear in several menus. 87 ;;; returns `multi', then the buffer can appear in several menus.
144 ;;; 88 ;;;
145 (defconst msb--few-menus 89 (defconst msb--few-menus
146 '(((and (boundp 'server-buffer-clients) 90 '(((and (boundp 'server-buffer-clients)
147 server-buffer-clients 91 server-buffer-clients
148 'multi) 92 'multi)
274 Nil means no limit.") 218 Nil means no limit.")
275 219
276 (defvar msb-max-file-menu-items 10 220 (defvar msb-max-file-menu-items 10
277 "*The maximum number of items from different directories. 221 "*The maximum number of items from different directories.
278 222
279 When the menu is of type 'file by directory', this is the maximum 223 When the menu is of type `file by directory', this is the maximum
280 number of buffers that are clumped togehter from different 224 number of buffers that are clumped togehter from different
281 directories. 225 directories.
282 226
283 If the value is not a number, then the value 10 is used.") 227 If the value is not a number, then the value 10 is used.")
284 228
304 248
305 (defvar msb-item-handling-function 'msb-item-handler 249 (defvar msb-item-handling-function 'msb-item-handler
306 "*The appearance of a buffer menu. 250 "*The appearance of a buffer menu.
307 251
308 The default function to call for handling the appearance of a menu 252 The default function to call for handling the appearance of a menu
309 item. It should take to arguments, BUFFER and MAX-BUFFER-NAME-LENGTH, 253 item. It should take to arguments, BUFFER and MAX-BUFFER-NAME-LENGTH,
310 where the latter is the max length of all buffer names. 254 where the latter is the max length of all buffer names.
311 When the function is called, BUFFER is the current buffer. 255 When the function is called, BUFFER is the current buffer.
312 This function is called for items in the variable 'msb-menu-cond' that 256 This function is called for items in the variable `msb-menu-cond' that
313 have nil as ITEM-HANDLING-FUNCTION. See 'msb-menu-cond' for more 257 have nil as ITEM-HANDLING-FUNCTION. See `msb-menu-cond' for more
314 information.") 258 information.")
315 259
316 (defvar msb-item-sort-function 'msb-sort-by-name 260 (defvar msb-item-sort-function 'msb-sort-by-name
317 "*The order of items in a buffer menu. 261 "*The order of items in a buffer menu.
318 The default function to call for handling the order of items in a menu 262 The default function to call for handling the order of items in a menu
319 item. This function is called like a sort function. The items 263 item. This function is called like a sort function. The items
320 look like (ITEM-NAME . BUFFER). 264 look like (ITEM-NAME . BUFFER).
321 ITEM-NAME is the name of the item that will appear in the menu. 265 ITEM-NAME is the name of the item that will appear in the menu.
322 BUFFER is the buffer, this is not necessarily the current buffer. 266 BUFFER is the buffer, this is not necessarily the current buffer.
323 267
324 Set this to nil or t if you don't want any sorting (faster).") 268 Set this to nil or t if you don't want any sorting (faster).")
335 When making the split, the buffers are tested one by one against the 279 When making the split, the buffers are tested one by one against the
336 CONDITION, just like a lisp cond: When hitting a true condition, the 280 CONDITION, just like a lisp cond: When hitting a true condition, the
337 other criterias are *not* tested and the buffer name will appear in 281 other criterias are *not* tested and the buffer name will appear in
338 the menu with the menu-title corresponding to the true condition. 282 the menu with the menu-title corresponding to the true condition.
339 283
340 If the condition returns the symbol 'multi, then the buffer will be 284 If the condition returns the symbol `multi', then the buffer will be
341 added to this menu *and* tested for other menus too. If it returns 285 added to this menu *and* tested for other menus too. If it returns
342 'no-multi, then the buffer will only be added if it hasn't been added 286 `no-multi', then the buffer will only be added if it hasn't been added
343 to any other menu. 287 to any other menu.
344 288
345 During this test, the buffer in question is the current buffer, and 289 During this test, the buffer in question is the current buffer, and
346 the test is surrounded by calls to `save-excursion' and 290 the test is surrounded by calls to `save-excursion' and
347 `save-match-data' 291 `save-match-data'.
348 292
349 The categories are sorted by MENU-SORT-KEY. Smaller keys are on 293 The categories are sorted by MENU-SORT-KEY. Smaller keys are on
350 top. nil means don't display this menu. 294 top. nil means don't display this menu.
351 295
352 MENU-TITLE is really a format. If you add %d in it, the %d is replaced 296 MENU-TITLE is really a format. If you add %d in it, the %d is replaced
353 with the number of items in that menu. 297 with the number of items in that menu.
354 298
355 ITEM-HANDLING-FN, is optional. If it is supplied and is a 299 ITEM-HANDLING-FN, is optional. If it is supplied and is a
356 function, than it is used for displaying the items in that particular 300 function, than it is used for displaying the items in that particular
357 buffer menu, otherwise the function pointed out by 301 buffer menu, otherwise the function pointed out by
358 'msb-item-handling-function' is used. 302 `msb-item-handling-function' is used.
359 303
360 ITEM-SORT-FN, is also optional. 304 ITEM-SORT-FN, is also optional.
361 If it is not supplied, the function pointed out by 305 If it is not supplied, the function pointed out by
362 'msb-item-sort-function' is used. 306 `msb-item-sort-function' is used.
363 If it is nil, then no sort takes place and the buffers are presented 307 If it is nil, then no sort takes place and the buffers are presented
364 in least-recently-used order. 308 in least-recently-used order.
365 If it is t, then no sort takes place and the buffers are presented in 309 If it is t, then no sort takes place and the buffers are presented in
366 most-recently-used order. 310 most-recently-used order.
367 If it is supplied and non-nil and not t than it is used for sorting 311 If it is supplied and non-nil and not t than it is used for sorting
368 the items in that particular buffer menu. 312 the items in that particular buffer menu.
369 313
370 Note1: There should always be a 'catch-all' as last element, 314 Note1: There should always be a `catch-all' as last element,
371 in this list. That is an element like (t TITLE ITEM-HANDLING-FUNCTION). 315 in this list. That is an element like (t TITLE ITEM-HANDLING-FUNCTION).
372 Note2: A buffer menu appears only if it has at least one buffer in it. 316 Note2: A buffer menu appears only if it has at least one buffer in it.
373 Note3: If you have a CONDITION that can't be evaluated you will get an 317 Note3: If you have a CONDITION that can't be evaluated you will get an
374 error every time you do \\[msb].") 318 error every time you do \\[msb].")
375 319
376 (defvar msb-after-load-hooks nil 320 (defvar msb-after-load-hooks nil
385 329
386 ;; If this is non-nil, then it is a string that describes the error. 330 ;; If this is non-nil, then it is a string that describes the error.
387 (defvar msb--error nil) 331 (defvar msb--error nil)
388 332
389 ;;; 333 ;;;
390 ;;; Some example function to be used for 'msb-item-sort-function'. 334 ;;; Some example function to be used for `msb-item-sort-function'.
391 ;;; 335 ;;;
392 (defun msb-item-handler (buffer &optional maxbuf) 336 (defun msb-item-handler (buffer &optional maxbuf)
393 "Create one string item, concerning BUFFER, for the buffer menu. 337 "Create one string item, concerning BUFFER, for the buffer menu.
394 The item looks like: 338 The item looks like:
395 *% <buffer-name> 339 *% <buffer-name>
396 The '*' appears only if the buffer is marked as modified. 340 The `*' appears only if the buffer is marked as modified.
397 The '%' appears only if the buffer is read-only. 341 The `%' appears only if the buffer is read-only.
398 Optional second argument MAXBUF is completely ignored." 342 Optional second argument MAXBUF is completely ignored."
399 (let ((name (buffer-name)) 343 (let ((name (buffer-name))
400 (modified (if (buffer-modified-p) "*" " ")) 344 (modified (if (buffer-modified-p) "*" " "))
401 (read-only (if buffer-read-only "%" " "))) 345 (read-only (if buffer-read-only "%" " ")))
402 (format "%s%s %s" modified read-only name))) 346 (format "%s%s %s" modified read-only name)))
403 347
404 348
405 (eval-when-compile (require 'dired)) 349 (eval-when-compile (require 'dired))
406 350
407 ;; 'dired' can be called with a list of the form (directory file1 file2 ...) 351 ;; `dired' can be called with a list of the form (directory file1 file2 ...)
408 ;; which causes 'dired-directory' to be in the same form. 352 ;; which causes `dired-directory' to be in the same form.
409 (defun msb--dired-directory () 353 (defun msb--dired-directory ()
410 (cond ((stringp dired-directory) 354 (cond ((stringp dired-directory)
411 (abbreviate-file-name (expand-file-name dired-directory))) 355 (abbreviate-file-name (expand-file-name dired-directory)))
412 ((consp dired-directory) 356 ((consp dired-directory)
413 (abbreviate-file-name (expand-file-name (car dired-directory)))) 357 (abbreviate-file-name (expand-file-name (car dired-directory))))
414 (t 358 (t
415 (error "Unknown type of 'dired-directory' in buffer %s" 359 (error "Unknown type of `dired-directory' in buffer %s"
416 (buffer-name))))) 360 (buffer-name)))))
417 361
418 (defun msb-dired-item-handler (buffer &optional maxbuf) 362 (defun msb-dired-item-handler (buffer &optional maxbuf)
419 "Create one string item, concerning a dired BUFFER, for the buffer menu. 363 "Create one string item, concerning a dired BUFFER, for the buffer menu.
420 The item looks like: 364 The item looks like:
421 *% <buffer-name> 365 *% <buffer-name>
422 The '*' appears only if the buffer is marked as modified. 366 The `*' appears only if the buffer is marked as modified.
423 The '%' appears only if the buffer is read-only. 367 The `%' appears only if the buffer is read-only.
424 Optional second argument MAXBUF is completely ignored." 368 Optional second argument MAXBUF is completely ignored."
425 (let ((name (msb--dired-directory)) 369 (let ((name (msb--dired-directory))
426 (modified (if (buffer-modified-p) "*" " ")) 370 (modified (if (buffer-modified-p) "*" " "))
427 (read-only (if buffer-read-only "%" " "))) 371 (read-only (if buffer-read-only "%" " ")))
428 (format "%s%s %s" modified read-only name))) 372 (format "%s%s %s" modified read-only name)))
429 373
430 (defun msb-alon-item-handler (buffer maxbuf) 374 (defun msb-alon-item-handler (buffer maxbuf)
431 "Create one string item for the buffer menu. 375 "Create one string item for the buffer menu.
432 The item looks like: 376 The item looks like:
433 <buffer-name> *%# <file-name> 377 <buffer-name> *%# <file-name>
434 The '*' appears only if the buffer is marked as modified. 378 The `*' appears only if the buffer is marked as modified.
435 The '%' appears only if the buffer is read-only. 379 The `%' appears only if the buffer is read-only.
436 The '#' appears only version control file (SCCS/RCS)." 380 The `#' appears only version control file (SCCS/RCS)."
437 (format (format "%%%ds %%s%%s%%s %%s" maxbuf) 381 (format (format "%%%ds %%s%%s%%s %%s" maxbuf)
438 (buffer-name buffer) 382 (buffer-name buffer)
439 (if (buffer-modified-p) "*" " ") 383 (if (buffer-modified-p) "*" " ")
440 (if buffer-read-only "%" " ") 384 (if buffer-read-only "%" " ")
441 (if (and (boundp 'vc-mode) vc-mode) "#" " ") 385 (if (and (boundp 'vc-mode) vc-mode) "#" " ")
442 (or buffer-file-name ""))) 386 (or buffer-file-name "")))
443 387
444 ;;; 388 ;;;
445 ;;; Some example function to be used for 'msb-item-handling-function'. 389 ;;; Some example function to be used for `msb-item-handling-function'.
446 ;;; 390 ;;;
447 (defun msb-sort-by-name (item1 item2) 391 (defun msb-sort-by-name (item1 item2)
448 "Sorts the items depending on their buffer-name 392 "Sorts the items depending on their buffer-name
449 An item look like (NAME . BUFFER)." 393 An item look like (NAME . BUFFER)."
450 (string-lessp (buffer-name (cdr item1)) 394 (string-lessp (buffer-name (cdr item1))
451 (buffer-name (cdr item2)))) 395 (buffer-name (cdr item2))))
452 396
453 397
454 (defun msb-sort-by-directory (item1 item2) 398 (defun msb-sort-by-directory (item1 item2)
455 "Sorts the items depending on their directory. Made for dired. 399 "Sorts the items depending on their directory. Made for dired.
456 An item look like (NAME . BUFFER)." 400 An item look like (NAME . BUFFER)."
457 (string-lessp (save-excursion (set-buffer (cdr item1)) (msb--dired-directory)) 401 (string-lessp (save-excursion (set-buffer (cdr item1)) (msb--dired-directory))
458 (save-excursion (set-buffer (cdr item2)) (msb--dired-directory)))) 402 (save-excursion (set-buffer (cdr item2)) (msb--dired-directory))))
459 403
460 ;;; 404 ;;;
466 (defun msb (event) 410 (defun msb (event)
467 "Pop up several menus of buffers for selection with the mouse. 411 "Pop up several menus of buffers for selection with the mouse.
468 This command switches buffers in the window that you clicked on, and 412 This command switches buffers in the window that you clicked on, and
469 selects that window. 413 selects that window.
470 414
471 See the function 'mouse-select-buffer' and the variable 415 See the function `mouse-select-buffer' and the variable
472 'msb-menu-cond' for more information about how the menus are split." 416 `msb-menu-cond' for more information about how the menus are split."
473 (interactive "e") 417 (interactive "e")
474 (let ((buffer (mouse-select-buffer event)) 418 (let ((buffer (mouse-select-buffer event))
475 (window (posn-window (event-start event)))) 419 (window (posn-window (event-start event))))
476 (cond 420 (cond
477 (buffer 421 (buffer
495 (substring path (match-beginning 1) (match-end 1)) 439 (substring path (match-beginning 1) (match-end 1))
496 "/"))) 440 "/")))
497 441
498 ;; Create an alist with all buffers from LIST that lies under the same 442 ;; Create an alist with all buffers from LIST that lies under the same
499 ;; directory will be in the same item as the directory string as 443 ;; directory will be in the same item as the directory string as
500 ;;'((PATH1 . (BUFFER-1 BUFFER-2 ...)) (PATH2 . (BUFFER-K BUFFER-K+1...)) ...) 444 ;; ((PATH1 . (BUFFER-1 BUFFER-2 ...)) (PATH2 . (BUFFER-K BUFFER-K+1...)) ...)
501 (defun msb--init-file-alist (list) 445 (defun msb--init-file-alist (list)
502 (let ((buffer-alist 446 (let ((buffer-alist
503 (sort (mapcan 447 (sort (mapcan
504 (function 448 (function
505 (lambda (buffer) 449 (lambda (buffer)
508 (list (cons (msb--strip-path file-name) buffer)))))) 452 (list (cons (msb--strip-path file-name) buffer))))))
509 list) 453 list)
510 (function (lambda (item1 item2) 454 (function (lambda (item1 item2)
511 (string< (car item1) (car item2))))))) 455 (string< (car item1) (car item2)))))))
512 ;; Make alist that looks like 456 ;; Make alist that looks like
513 ;;'((PATH1 . (BUFFER-1 BUFFER-2 ...)) (PATH2 . (BUFFER-K)) ...) 457 ;; ((PATH1 . (BUFFER-1 BUFFER-2 ...)) (PATH2 . (BUFFER-K)) ...)
514 (let ((path nil) 458 (let ((path nil)
515 (buffers nil) 459 (buffers nil)
516 (result nil)) 460 (result nil))
517 (append 461 (append
518 (mapcan (function 462 (mapcan (function
606 (push first final-list) 550 (push first final-list)
607 (nreverse final-list))) 551 (nreverse final-list)))
608 552
609 ;; Create a vector as: 553 ;; Create a vector as:
610 ;; [BUFFER-LIST-VARIABLE CONDITION MENU-SORT-KEY MENU-TITLE ITEM-HANDLER SORTER) 554 ;; [BUFFER-LIST-VARIABLE CONDITION MENU-SORT-KEY MENU-TITLE ITEM-HANDLER SORTER)
611 ;; from an element in 'msb-menu-cond'. See that variable for a 555 ;; from an element in `msb-menu-cond'. See that variable for a
612 ;; description of it's elements. 556 ;; description of its elements.
613 (defun msb--create-function-info (menu-cond-elt) 557 (defun msb--create-function-info (menu-cond-elt)
614 (let* ((list-symbol (make-symbol "-msb-buffer-list")) 558 (let* ((list-symbol (make-symbol "-msb-buffer-list"))
615 (tmp-ih (and (> (length menu-cond-elt) 3) 559 (tmp-ih (and (> (length menu-cond-elt) 3)
616 (nth 3 menu-cond-elt))) 560 (nth 3 menu-cond-elt)))
617 (item-handler (if (and tmp-ih (fboundp tmp-ih)) 561 (item-handler (if (and tmp-ih (fboundp tmp-ih))
620 (tmp-s (if (> (length menu-cond-elt) 4) 564 (tmp-s (if (> (length menu-cond-elt) 4)
621 (nth 4 menu-cond-elt) 565 (nth 4 menu-cond-elt)
622 msb-item-sort-function)) 566 msb-item-sort-function))
623 (sorter (if (or (fboundp tmp-s) 567 (sorter (if (or (fboundp tmp-s)
624 (null tmp-s) 568 (null tmp-s)
625 (eq tmp-s 't)) 569 (eq tmp-s t))
626 tmp-s 570 tmp-s
627 msb-item-sort-function))) 571 msb-item-sort-function)))
628 (when (< (length menu-cond-elt) 3) 572 (when (< (length menu-cond-elt) 3)
629 (error "Wrong format of msb-menu-cond.")) 573 (error "Wrong format of msb-menu-cond."))
630 (when (and (> (length menu-cond-elt) 3) 574 (when (and (> (length menu-cond-elt) 3)
631 (not (fboundp tmp-ih))) 575 (not (fboundp tmp-ih)))
632 (signal 'invalid-function (list tmp-ih))) 576 (signal 'invalid-function (list tmp-ih)))
633 (when (and (> (length menu-cond-elt) 4) 577 (when (and (> (length menu-cond-elt) 4)
634 tmp-s 578 tmp-s
635 (not (fboundp tmp-s)) 579 (not (fboundp tmp-s))
636 (not (eq tmp-s 't))) 580 (not (eq tmp-s t)))
637 (signal 'invalid-function (list tmp-s))) 581 (signal 'invalid-function (list tmp-s)))
638 (set list-symbol '()) 582 (set list-symbol ())
639 (vector list-symbol ;BUFFER-LIST-VARIABLE 583 (vector list-symbol ;BUFFER-LIST-VARIABLE
640 (nth 0 menu-cond-elt) ;CONDITION 584 (nth 0 menu-cond-elt) ;CONDITION
641 (nth 1 menu-cond-elt) ;SORT-KEY 585 (nth 1 menu-cond-elt) ;SORT-KEY
642 (nth 2 menu-cond-elt) ;MENU-TITLE 586 (nth 2 menu-cond-elt) ;MENU-TITLE
643 item-handler ;ITEM-HANDLER 587 item-handler ;ITEM-HANDLER
644 sorter) ;SORTER 588 sorter) ;SORTER
645 )) 589 ))
646 590
647 ;; This defsubst is only used in `msb--choose-menu' below. It was 591 ;; This defsubst is only used in `msb--choose-menu' below. It was
648 ;; pulled out merely to make the code somewhat clearer. The indention 592 ;; pulled out merely to make the code somewhat clearer. The indention
649 ;; level was too big. 593 ;; level was too big.
650 (defsubst msb--collect (function-info-vector) 594 (defsubst msb--collect (function-info-vector)
651 (let ((result nil) 595 (let ((result nil)
652 (multi-flag nil) 596 (multi-flag nil)
653 function-info-list) 597 function-info-list)
671 (not result)) 615 (not result))
672 (error "No catch-all in msb-menu-cond!")) 616 (error "No catch-all in msb-menu-cond!"))
673 function-info-list)) 617 function-info-list))
674 618
675 ;; Adds BUFFER to the menu depicted by FUNCTION-INFO 619 ;; Adds BUFFER to the menu depicted by FUNCTION-INFO
676 ;; All side-effects. Adds an element of type '(BUFFER-TITLE . BUFFER) 620 ;; All side-effects. Adds an element of form (BUFFER-TITLE . BUFFER)
677 ;; to the buffer-list variable in function-info. 621 ;; to the buffer-list variable in function-info.
678 (defun msb--add-to-menu (buffer function-info max-buffer-name-length) 622 (defun msb--add-to-menu (buffer function-info max-buffer-name-length)
679 (let ((list-symbol (aref function-info 0))) ;BUFFER-LIST-VARIABLE 623 (let ((list-symbol (aref function-info 0))) ;BUFFER-LIST-VARIABLE
680 ;; Here comes the hairy side-effect! 624 ;; Here comes the hairy side-effect!
681 (set list-symbol 625 (set list-symbol
692 (unless (and (not msb-display-invisible-buffers-p) 636 (unless (and (not msb-display-invisible-buffers-p)
693 (msb-invisible-buffer-p buffer)) 637 (msb-invisible-buffer-p buffer))
694 (condition-case nil 638 (condition-case nil
695 (save-excursion 639 (save-excursion
696 (set-buffer buffer) 640 (set-buffer buffer)
697 ;; Menu found. Add to this menu 641 ;; Menu found. Add to this menu
698 (mapc (function 642 (mapc (function
699 (lambda (function-info) 643 (lambda (function-info)
700 (msb--add-to-menu buffer function-info max-buffer-name-length))) 644 (msb--add-to-menu buffer function-info max-buffer-name-length)))
701 (msb--collect function-info-vector))) 645 (msb--collect function-info-vector)))
702 (error (unless msb--error 646 (error (unless msb--error
703 (setq msb--error 647 (setq msb--error
704 (format 648 (format
705 "Variable `msb-menu-cond': Error for buffer \"%s\"." 649 "In msb-menu-cond, error for buffer `%s'."
706 (buffer-name buffer))) 650 (buffer-name buffer)))
707 (error msb--error)))))) 651 (error msb--error))))))
708 652
709 ;; Return (SORT-KEY TITLE . BUFFER-LIST) or nil if the 653 ;; Return (SORT-KEY TITLE . BUFFER-LIST) or nil if the
710 ;; buffer-list is empty. 654 ;; buffer-list is empty.
718 (cons (format (aref function-info 3) ;MENU-TITLE 662 (cons (format (aref function-info 3) ;MENU-TITLE
719 (length buffer-list)) 663 (length buffer-list))
720 (cond 664 (cond
721 ((null sorter) 665 ((null sorter)
722 buffer-list) 666 buffer-list)
723 ((eq sorter 't) 667 ((eq sorter t)
724 (nreverse buffer-list)) 668 (nreverse buffer-list))
725 (t 669 (t
726 (sort buffer-list sorter)))))))))) 670 (sort buffer-list sorter))))))))))
727 671
728 ;; Returns a list on the form ((TITLE . BUFFER-LIST)) for 672 ;; Returns a list on the form ((TITLE . BUFFER-LIST)) for
783 (setq function-info-vector 727 (setq function-info-vector
784 (apply (function vector) 728 (apply (function vector)
785 (mapcar (function msb--create-function-info) 729 (mapcar (function msb--create-function-info)
786 msb-menu-cond))) 730 msb-menu-cond)))
787 ;; Split the buffer-list into several lists; one list for each 731 ;; Split the buffer-list into several lists; one list for each
788 ;; criteria. This is the most critical part with respect to time. 732 ;; criteria. This is the most critical part with respect to time.
789 (mapc (function (lambda (buffer) 733 (mapc (function (lambda (buffer)
790 (cond ((and msb-files-by-directory 734 (cond ((and msb-files-by-directory
791 (buffer-file-name buffer)) 735 (buffer-file-name buffer))
792 (push buffer file-buffers)) 736 (push buffer file-buffers))
793 (t 737 (t
866 (defun mouse-select-buffer (event) 810 (defun mouse-select-buffer (event)
867 "Pop up several menus of buffers, for selection with the mouse. 811 "Pop up several menus of buffers, for selection with the mouse.
868 Returns the selected buffer or nil if no buffer is selected. 812 Returns the selected buffer or nil if no buffer is selected.
869 813
870 The way the buffers are splitted is conveniently handled with the 814 The way the buffers are splitted is conveniently handled with the
871 variable 'msb-menu-cond'." 815 variable `msb-menu-cond'."
872 ;; Popup the menu and return the selected buffer. 816 ;; Popup the menu and return the selected buffer.
873 (when (or msb--error 817 (when (or msb--error
874 (not msb--last-buffer-menu) 818 (not msb--last-buffer-menu)
875 (not (fboundp 'frame-or-buffer-changed-p)) 819 (not (fboundp 'frame-or-buffer-changed-p))
876 (frame-or-buffer-changed-p)) 820 (frame-or-buffer-changed-p))
1005 (substitute-key-definition 'mouse-buffer-menu 'msb (current-global-map))) 949 (substitute-key-definition 'mouse-buffer-menu 'msb (current-global-map)))
1006 950
1007 (provide 'msb) 951 (provide 'msb)
1008 (eval-after-load 'msb (run-hooks 'msb-after-load-hooks)) 952 (eval-after-load 'msb (run-hooks 'msb-after-load-hooks))
1009 ;;; msb.el ends here 953 ;;; msb.el ends here
954