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