| 1 | ;;; msb.el --- customizable buffer-selection with multiple menus |
| 2 | |
| 3 | ;; Copyright (C) 1993-1995, 1997-2014 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Author: Lars Lindberg <lars.lindberg@home.se> |
| 6 | ;; Maintainer: emacs-devel@gnu.org |
| 7 | ;; Created: 8 Oct 1993 |
| 8 | ;; Lindberg's last update version: 3.34 |
| 9 | ;; Keywords: mouse buffer menu |
| 10 | |
| 11 | ;; This file is part of GNU Emacs. |
| 12 | |
| 13 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
| 14 | ;; it under the terms of the GNU General Public License as published by |
| 15 | ;; the Free Software Foundation, either version 3 of the License, or |
| 16 | ;; (at your option) any later version. |
| 17 | |
| 18 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 21 | ;; GNU General Public License for more details. |
| 22 | |
| 23 | ;; You should have received a copy of the GNU General Public License |
| 24 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
| 25 | |
| 26 | ;;; Commentary: |
| 27 | |
| 28 | ;; Purpose of this package: |
| 29 | ;; 1. Offer a function for letting the user choose buffer, |
| 30 | ;; not necessarily for switching to it. |
| 31 | ;; 2. Make a better mouse-buffer-menu. This is done as a global |
| 32 | ;; minor mode, msb-mode. |
| 33 | ;; |
| 34 | ;; Customization: |
| 35 | ;; Look at the variable `msb-menu-cond' for deciding what menus you |
| 36 | ;; want. It's not that hard to customize, despite my not-so-good |
| 37 | ;; doc-string. Feel free to send me a better doc-string. |
| 38 | ;; There are some constants for you to try here: |
| 39 | ;; msb--few-menus |
| 40 | ;; msb--very-many-menus (default) |
| 41 | ;; |
| 42 | ;; Look at the variable `msb-item-handling-function' for customization |
| 43 | ;; of the appearance of every menu item. Try for instance setting |
| 44 | ;; it to `msb-alon-item-handler'. |
| 45 | ;; |
| 46 | ;; Look at the variable `msb-item-sort-function' for customization |
| 47 | ;; of sorting the menus. Set it to t for instance, which means no |
| 48 | ;; sorting - you will get latest used buffer first. |
| 49 | ;; |
| 50 | ;; Also check out the variable `msb-display-invisible-buffers-p'. |
| 51 | |
| 52 | ;; Known bugs: |
| 53 | ;; - Files-by-directory |
| 54 | ;; + No possibility to show client/changed buffers separately. |
| 55 | ;; + All file buffers only appear in a file sub-menu, they will |
| 56 | ;; for instance not appear in the Mail sub-menu. |
| 57 | |
| 58 | ;; Future enhancements: |
| 59 | |
| 60 | ;;; Thanks goes to |
| 61 | ;; Mark Brader <msb@sq.com> |
| 62 | ;; Jim Berry <m1jhb00@FRB.GOV> |
| 63 | ;; Hans Chalupsky <hans@cs.Buffalo.EDU> |
| 64 | ;; Larry Rosenberg <ljr@ictv.com> |
| 65 | ;; Will Henney <will@astroscu.unam.mx> |
| 66 | ;; Jari Aalto <jaalto@tre.tele.nokia.fi> |
| 67 | ;; Michael Kifer <kifer@sbkifer.cs.sunysb.edu> |
| 68 | ;; Gael Marziou <gael@gnlab030.grenoble.hp.com> |
| 69 | ;; Dave Gillespie <daveg@thymus.synaptics.com> |
| 70 | ;; Alon Albert <alon@milcse.rtsg.mot.com> |
| 71 | ;; Kevin Broadey, <KevinB@bartley.demon.co.uk> |
| 72 | ;; Ake Stenhof <ake@cadpoint.se> |
| 73 | ;; Richard Stallman <rms@gnu.org> |
| 74 | ;; Steve Fisk <fisk@medved.bowdoin.edu> |
| 75 | |
| 76 | ;; This version turned into a global minor mode and subsequently |
| 77 | ;; hacked on by Dave Love. |
| 78 | ;;; Code: |
| 79 | |
| 80 | (eval-when-compile (require 'cl-lib)) |
| 81 | |
| 82 | ;; |
| 83 | ;; Some example constants to be used for `msb-menu-cond'. See that |
| 84 | ;; variable for more information. Please note that if the condition |
| 85 | ;; returns `multi', then the buffer can appear in several menus. |
| 86 | ;; |
| 87 | (defconst msb--few-menus |
| 88 | '(((and (boundp 'server-buffer-clients) |
| 89 | server-buffer-clients |
| 90 | 'multi) |
| 91 | 3030 |
| 92 | "Clients (%d)") |
| 93 | ((and msb-display-invisible-buffers-p |
| 94 | (msb-invisible-buffer-p) |
| 95 | 'multi) |
| 96 | 3090 |
| 97 | "Invisible buffers (%d)") |
| 98 | ((eq major-mode 'dired-mode) |
| 99 | 2010 |
| 100 | "Dired (%d)" |
| 101 | msb-dired-item-handler |
| 102 | msb-sort-by-directory) |
| 103 | ((eq major-mode 'Man-mode) |
| 104 | 4090 |
| 105 | "Manuals (%d)") |
| 106 | ((eq major-mode 'w3-mode) |
| 107 | 4020 |
| 108 | "WWW (%d)") |
| 109 | ((or (memq major-mode |
| 110 | '(rmail-mode rmail-edit-mode vm-summary-mode vm-mode mail-mode)) |
| 111 | (memq major-mode '(mh-letter-mode mh-show-mode mh-folder-mode)) |
| 112 | (memq major-mode |
| 113 | '(gnus-summary-mode message-mode gnus-group-mode |
| 114 | gnus-article-mode score-mode gnus-browse-killed-mode))) |
| 115 | 4010 |
| 116 | "Mail (%d)") |
| 117 | ((not buffer-file-name) |
| 118 | 4099 |
| 119 | "Buffers (%d)") |
| 120 | ('no-multi |
| 121 | 1099 |
| 122 | "Files (%d)"))) |
| 123 | |
| 124 | (defconst msb--very-many-menus |
| 125 | '(((and (boundp 'server-buffer-clients) |
| 126 | server-buffer-clients |
| 127 | 'multi) |
| 128 | 1010 |
| 129 | "Clients (%d)") |
| 130 | ((and (boundp 'vc-mode) vc-mode 'multi) |
| 131 | 1020 |
| 132 | "Version Control (%d)") |
| 133 | ((and buffer-file-name |
| 134 | (buffer-modified-p) |
| 135 | 'multi) |
| 136 | 1030 |
| 137 | "Changed files (%d)") |
| 138 | ((and (get-buffer-process (current-buffer)) |
| 139 | 'multi) |
| 140 | 1040 |
| 141 | "Processes (%d)") |
| 142 | ((and msb-display-invisible-buffers-p |
| 143 | (msb-invisible-buffer-p) |
| 144 | 'multi) |
| 145 | 1090 |
| 146 | "Invisible buffers (%d)") |
| 147 | ((eq major-mode 'dired-mode) |
| 148 | 2010 |
| 149 | "Dired (%d)" |
| 150 | ;; Note this different menu-handler |
| 151 | msb-dired-item-handler |
| 152 | ;; Also note this item-sorter |
| 153 | msb-sort-by-directory) |
| 154 | ((eq major-mode 'Man-mode) |
| 155 | 5030 |
| 156 | "Manuals (%d)") |
| 157 | ((eq major-mode 'w3-mode) |
| 158 | 5020 |
| 159 | "WWW (%d)") |
| 160 | ((or (memq major-mode |
| 161 | '(rmail-mode rmail-edit-mode vm-summary-mode vm-mode mail-mode)) |
| 162 | (memq major-mode '(mh-letter-mode mh-show-mode mh-folder-mode)) |
| 163 | (memq major-mode '(gnus-summary-mode message-mode gnus-group-mode |
| 164 | gnus-article-mode score-mode |
| 165 | gnus-browse-killed-mode))) |
| 166 | 5010 |
| 167 | "Mail (%d)") |
| 168 | ;; Catchup for all non-file buffers |
| 169 | ((and (not buffer-file-name) |
| 170 | 'no-multi) |
| 171 | 5099 |
| 172 | "Other non-file buffers (%d)") |
| 173 | ((and (string-match "/\\.[^/]*$" buffer-file-name) |
| 174 | 'multi) |
| 175 | 3090 |
| 176 | "Hidden Files (%d)") |
| 177 | ((memq major-mode '(c-mode c++-mode)) |
| 178 | 3010 |
| 179 | "C/C++ Files (%d)") |
| 180 | ((eq major-mode 'emacs-lisp-mode) |
| 181 | 3020 |
| 182 | "Elisp Files (%d)") |
| 183 | ((eq major-mode 'latex-mode) |
| 184 | 3030 |
| 185 | "LaTeX Files (%d)") |
| 186 | ('no-multi |
| 187 | 3099 |
| 188 | "Other files (%d)"))) |
| 189 | |
| 190 | ;;; |
| 191 | ;;; Customizable variables |
| 192 | ;;; |
| 193 | |
| 194 | (defgroup msb nil |
| 195 | "Customizable buffer-selection with multiple menus." |
| 196 | :prefix "msb-" |
| 197 | :group 'mouse) |
| 198 | |
| 199 | (defun msb-custom-set (symbol value) |
| 200 | "Set the value of custom variables for msb." |
| 201 | (set symbol value) |
| 202 | (if (and (featurep 'msb) msb-mode) |
| 203 | ;; wait until package has been loaded before bothering to update |
| 204 | ;; the buffer lists. |
| 205 | (msb-menu-bar-update-buffers t))) |
| 206 | |
| 207 | (defcustom msb-menu-cond msb--very-many-menus |
| 208 | "List of criteria for splitting the mouse buffer menu. |
| 209 | The elements in the list should be of this type: |
| 210 | (CONDITION MENU-SORT-KEY MENU-TITLE ITEM-HANDLING-FN ITEM-SORT-FN). |
| 211 | |
| 212 | When making the split, the buffers are tested one by one against the |
| 213 | CONDITION, just like a Lisp cond: When hitting a true condition, the |
| 214 | other criteria are *not* tested and the buffer name will appear in the |
| 215 | menu with the menu-title corresponding to the true condition. |
| 216 | |
| 217 | If the condition returns the symbol `multi', then the buffer will be |
| 218 | added to this menu *and* tested for other menus too. If it returns |
| 219 | `no-multi', then the buffer will only be added if it hasn't been added |
| 220 | to any other menu. |
| 221 | |
| 222 | During this test, the buffer in question is the current buffer, and |
| 223 | the test is surrounded by calls to `save-excursion' and |
| 224 | `save-match-data'. |
| 225 | |
| 226 | The categories are sorted by MENU-SORT-KEY. Smaller keys are on top. |
| 227 | A value of nil means don't display this menu. |
| 228 | |
| 229 | MENU-TITLE is really a format. If you add %d in it, the %d is |
| 230 | replaced with the number of items in that menu. |
| 231 | |
| 232 | ITEM-HANDLING-FN is optional. If it is supplied and is a function, |
| 233 | then it is used for displaying the items in that particular buffer |
| 234 | menu, otherwise the function pointed out by |
| 235 | `msb-item-handling-function' is used. |
| 236 | |
| 237 | ITEM-SORT-FN is also optional. |
| 238 | If it is not supplied, the function pointed out by |
| 239 | `msb-item-sort-function' is used. |
| 240 | If it is nil, then no sort takes place and the buffers are presented |
| 241 | in least-recently-used order. |
| 242 | If it is t, then no sort takes place and the buffers are presented in |
| 243 | most-recently-used order. |
| 244 | If it is supplied and non-nil and not t than it is used for sorting |
| 245 | the items in that particular buffer menu. |
| 246 | |
| 247 | Note1: There should always be a `catch-all' as last element, in this |
| 248 | list. That is an element like (t TITLE ITEM-HANDLING-FUNCTION). |
| 249 | Note2: A buffer menu appears only if it has at least one buffer in it. |
| 250 | Note3: If you have a CONDITION that can't be evaluated you will get an |
| 251 | error every time you do \\[msb]." |
| 252 | :type `(choice (const :tag "long" :value ,msb--very-many-menus) |
| 253 | (const :tag "short" :value ,msb--few-menus) |
| 254 | (sexp :tag "user")) |
| 255 | :set 'msb-custom-set |
| 256 | :group 'msb) |
| 257 | |
| 258 | (defcustom msb-modes-key 4000 |
| 259 | "The sort key for files sorted by mode." |
| 260 | :type 'integer |
| 261 | :set 'msb-custom-set |
| 262 | :group 'msb |
| 263 | :version "20.3") |
| 264 | |
| 265 | (defcustom msb-separator-diff 100 |
| 266 | "Non-nil means use separators. |
| 267 | The separators will appear between all menus that have a sorting key |
| 268 | that differs by this value or more." |
| 269 | :type '(choice integer (const nil)) |
| 270 | :set 'msb-custom-set |
| 271 | :group 'msb) |
| 272 | |
| 273 | (defvar msb-files-by-directory-sort-key 0 |
| 274 | "The sort key for files sorted by directory.") |
| 275 | |
| 276 | (defcustom msb-max-menu-items 15 |
| 277 | "The maximum number of items in a menu. |
| 278 | If this variable is set to 15 for instance, then the submenu will be |
| 279 | split up in minor parts, 15 items each. A value of nil means no limit." |
| 280 | :type '(choice integer (const nil)) |
| 281 | :set 'msb-custom-set |
| 282 | :group 'msb) |
| 283 | |
| 284 | (defcustom msb-max-file-menu-items 10 |
| 285 | "The maximum number of items from different directories. |
| 286 | |
| 287 | When the menu is of type `file by directory', this is the maximum |
| 288 | number of buffers that are clumped together from different |
| 289 | directories. |
| 290 | |
| 291 | Set this to 1 if you want one menu per directory instead of clumping |
| 292 | them together. |
| 293 | |
| 294 | If the value is not a number, then the value 10 is used." |
| 295 | :type 'integer |
| 296 | :set 'msb-custom-set |
| 297 | :group 'msb) |
| 298 | |
| 299 | (defcustom msb-most-recently-used-sort-key -1010 |
| 300 | "Where should the menu with the most recently used buffers be placed?" |
| 301 | :type 'integer |
| 302 | :set 'msb-custom-set |
| 303 | :group 'msb) |
| 304 | |
| 305 | (defcustom msb-display-most-recently-used 15 |
| 306 | "How many buffers should be in the most-recently-used menu. |
| 307 | No buffers at all if less than 1 or nil (or any non-number)." |
| 308 | :type 'integer |
| 309 | :set 'msb-custom-set |
| 310 | :group 'msb) |
| 311 | |
| 312 | (defcustom msb-most-recently-used-title "Most recently used (%d)" |
| 313 | "The title for the most-recently-used menu." |
| 314 | :type 'string |
| 315 | :set 'msb-custom-set |
| 316 | :group 'msb) |
| 317 | |
| 318 | (defvar msb-horizontal-shift-function (lambda () 0) |
| 319 | "Function that specifies how many pixels to shift the top menu leftwards.") |
| 320 | |
| 321 | (defcustom msb-display-invisible-buffers-p nil |
| 322 | "Show invisible buffers or not. |
| 323 | Non-nil means that the buffer menu should include buffers that have |
| 324 | names that starts with a space character." |
| 325 | :type 'boolean |
| 326 | :set 'msb-custom-set |
| 327 | :group 'msb) |
| 328 | |
| 329 | (defvar msb-item-handling-function 'msb-item-handler |
| 330 | "The appearance of a buffer menu. |
| 331 | |
| 332 | The default function to call for handling the appearance of a menu |
| 333 | item. It should take two arguments, BUFFER and MAX-BUFFER-NAME-LENGTH, |
| 334 | where the latter is the max length of all buffer names. |
| 335 | |
| 336 | The function should return the string to use in the menu. |
| 337 | |
| 338 | When the function is called, BUFFER is the current buffer. This |
| 339 | function is called for items in the variable `msb-menu-cond' that have |
| 340 | nil as ITEM-HANDLING-FUNCTION. See `msb-menu-cond' for more |
| 341 | information.") |
| 342 | |
| 343 | (defcustom msb-item-sort-function 'msb-sort-by-name |
| 344 | "The order of items in a buffer menu. |
| 345 | |
| 346 | The default function to call for handling the order of items in a menu |
| 347 | item. This function is called like a sort function. The items look |
| 348 | like (ITEM-NAME . BUFFER). |
| 349 | |
| 350 | ITEM-NAME is the name of the item that will appear in the menu. |
| 351 | BUFFER is the buffer, this is not necessarily the current buffer. |
| 352 | |
| 353 | Set this to nil or t if you don't want any sorting (faster)." |
| 354 | :type '(choice (const msb-sort-by-name) |
| 355 | (const :tag "Newest first" t) |
| 356 | (const :tag "Oldest first" nil)) |
| 357 | :set 'msb-custom-set |
| 358 | :group 'msb) |
| 359 | |
| 360 | (defcustom msb-files-by-directory nil |
| 361 | "Non-nil means that files should be sorted by directory. |
| 362 | This is instead of the groups in `msb-menu-cond'." |
| 363 | :type 'boolean |
| 364 | :set 'msb-custom-set |
| 365 | :group 'msb) |
| 366 | |
| 367 | (define-obsolete-variable-alias 'msb-after-load-hooks |
| 368 | 'msb-after-load-hook "24.1") |
| 369 | |
| 370 | (defcustom msb-after-load-hook nil |
| 371 | "Hook run after the msb package has been loaded." |
| 372 | :type 'hook |
| 373 | :set 'msb-custom-set |
| 374 | :group 'msb) |
| 375 | |
| 376 | ;;; |
| 377 | ;;; Internal variables |
| 378 | ;;; |
| 379 | |
| 380 | ;; The last calculated menu. |
| 381 | (defvar msb--last-buffer-menu nil) |
| 382 | |
| 383 | ;; If this is non-nil, then it is a string that describes the error. |
| 384 | (defvar msb--error nil) |
| 385 | |
| 386 | ;;; |
| 387 | ;;; Some example function to be used for `msb-item-handling-function'. |
| 388 | ;;; |
| 389 | (defun msb-item-handler (_buffer &optional _maxbuf) |
| 390 | "Create one string item, concerning BUFFER, for the buffer menu. |
| 391 | The item looks like: |
| 392 | *% <buffer-name> |
| 393 | The `*' appears only if the buffer is marked as modified. |
| 394 | The `%' appears only if the buffer is read-only. |
| 395 | Optional second argument MAXBUF is completely ignored." |
| 396 | (let ((name (buffer-name)) |
| 397 | (modified (if (buffer-modified-p) "*" " ")) |
| 398 | (read-only (if buffer-read-only "%" " "))) |
| 399 | (format "%s%s %s" modified read-only name))) |
| 400 | |
| 401 | |
| 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. |
| 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 |
| 410 | (error "Unknown type of `dired-directory' in buffer %s" |
| 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> |
| 417 | The `*' appears only if the buffer is marked as modified. |
| 418 | The `%' appears only if the buffer is read-only. |
| 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> |
| 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)." |
| 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 | ;;; |
| 440 | ;;; Some example function to be used for `msb-item-sort-function'. |
| 441 | ;;; |
| 442 | (defun msb-sort-by-name (item1 item2) |
| 443 | "Sort the items ITEM1 and ITEM2 by their `buffer-name'. |
| 444 | An item looks like (NAME . BUFFER)." |
| 445 | (string-lessp (buffer-name (cdr item1)) |
| 446 | (buffer-name (cdr item2)))) |
| 447 | |
| 448 | |
| 449 | (defun msb-sort-by-directory (item1 item2) |
| 450 | "Sort the items ITEM1 and ITEM2 by directory name. Made for dired. |
| 451 | An item look like (NAME . BUFFER)." |
| 452 | (string-lessp (with-current-buffer (cdr item1) |
| 453 | (msb--dired-directory)) |
| 454 | (with-current-buffer (cdr item2) |
| 455 | (msb--dired-directory)))) |
| 456 | |
| 457 | ;;; |
| 458 | ;;; msb |
| 459 | ;;; |
| 460 | ;;; This function can be used instead of (mouse-buffer-menu EVENT) |
| 461 | ;;; function in "mouse.el". |
| 462 | ;;; |
| 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 | |
| 468 | See the function `mouse-select-buffer' and the variable |
| 469 | `msb-menu-cond' for more information about how the menus are split." |
| 470 | (interactive "e") |
| 471 | (let ((old-window (selected-window)) |
| 472 | (window (posn-window (event-start event))) |
| 473 | early-release) |
| 474 | (unless (framep window) (select-window window)) |
| 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))) |
| 478 | (let ((buffer (mouse-select-buffer event))) |
| 479 | (if buffer |
| 480 | (switch-to-buffer buffer) |
| 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))) |
| 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) |
| 495 | (eq ?\s (aref (buffer-name buffer) 0)))) |
| 496 | |
| 497 | (defun msb--strip-dir (dir) |
| 498 | "Strip one hierarchy level from the end of DIR." |
| 499 | (file-name-directory (directory-file-name dir))) |
| 500 | |
| 501 | ;; Create an alist with all buffers from LIST that lies under the same |
| 502 | ;; directory will be in the same item as the directory name. |
| 503 | ;; ((DIR1 . (BUFFER-1 BUFFER-2 ...)) (DIR2 . (BUFFER-K BUFFER-K+1...)) ...) |
| 504 | (defun msb--init-file-alist (list) |
| 505 | (let ((buffer-alist |
| 506 | ;; Make alist that looks like |
| 507 | ;; ((DIR-1 BUFFER-1) (DIR-2 BUFFER-2) ...) |
| 508 | ;; sorted on DIR-x |
| 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)))))) |
| 520 | ;; Now clump buffers together that have the same directory name |
| 521 | ;; Make alist that looks like |
| 522 | ;; ((DIR1 . (BUFFER-1 BUFFER-2 ...)) (DIR2 . (BUFFER-K)) ...) |
| 523 | (let ((dir nil) |
| 524 | (buffers nil)) |
| 525 | (nconc |
| 526 | (apply |
| 527 | #'nconc |
| 528 | (mapcar (lambda (item) |
| 529 | (cond |
| 530 | ((equal dir (car item)) |
| 531 | ;; The same dir as earlier: |
| 532 | ;; Add to current list of buffers. |
| 533 | (push (cdr item) buffers) |
| 534 | ;; This item should not be added to list |
| 535 | nil) |
| 536 | (t |
| 537 | ;; New dir |
| 538 | (let ((result (and dir (cons dir buffers)))) |
| 539 | (setq dir (car item)) |
| 540 | (setq buffers (list (cdr item))) |
| 541 | ;; Add the last result the list. |
| 542 | (and result (list result)))))) |
| 543 | buffer-alist)) |
| 544 | ;; Add the last result to the list |
| 545 | (list (cons dir buffers)))))) |
| 546 | |
| 547 | (defun msb--format-title (top-found-p dir number-of-items) |
| 548 | "Format a suitable title for the menu item." |
| 549 | (format (if top-found-p "%s... (%d)" "%s (%d)") |
| 550 | (abbreviate-file-name dir) number-of-items)) |
| 551 | |
| 552 | ;; Variables for debugging. |
| 553 | (defvar msb--choose-file-menu-list) |
| 554 | (defvar msb--choose-file-menu-arg-list) |
| 555 | |
| 556 | (defun msb--choose-file-menu (list) |
| 557 | "Choose file-menu with respect to directory for every buffer in LIST." |
| 558 | (setq msb--choose-file-menu-arg-list list) |
| 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) |
| 565 | (last-dir nil) |
| 566 | first rest dir buffers old-dir) |
| 567 | ;; Prepare for looping over all items in buffer-alist |
| 568 | (setq first (car buffer-alist) |
| 569 | rest (cdr buffer-alist) |
| 570 | dir (car first) |
| 571 | buffers (cdr first)) |
| 572 | (setq msb--choose-file-menu-list (copy-sequence rest)) |
| 573 | ;; This big loop tries to clump buffers together that have a |
| 574 | ;; similar name. Remember that buffer-alist is sorted based on the |
| 575 | ;; directory name of the buffers' visited files. |
| 576 | (while rest |
| 577 | (let ((found-p nil) |
| 578 | (tmp-rest rest) |
| 579 | item) |
| 580 | (setq item (car tmp-rest)) |
| 581 | ;; Clump together the "rest"-buffers that have a dir that is |
| 582 | ;; a subdir of the current one. |
| 583 | (while (and tmp-rest |
| 584 | (<= (length buffers) max-clumped-together) |
| 585 | (>= (length (car item)) (length dir)) |
| 586 | ;; `completion-ignore-case' seems to default to t |
| 587 | ;; on the systems with case-insensitive file names. |
| 588 | (eq t (compare-strings dir 0 nil |
| 589 | (car item) 0 (length dir) |
| 590 | completion-ignore-case))) |
| 591 | (setq found-p t) |
| 592 | (setq buffers (append buffers (cdr item))) ;nconc is faster than append |
| 593 | (setq tmp-rest (cdr tmp-rest) |
| 594 | item (car tmp-rest))) |
| 595 | (cond |
| 596 | ((> (length buffers) max-clumped-together) |
| 597 | ;; Oh, we failed. Too many buffers clumped together. |
| 598 | ;; Just use the original ones for the result. |
| 599 | (setq last-dir (car first)) |
| 600 | (push (cons (msb--format-title top-found-p |
| 601 | (car first) |
| 602 | (length (cdr first))) |
| 603 | (cdr first)) |
| 604 | final-list) |
| 605 | (setq top-found-p nil) |
| 606 | (setq first (car rest) |
| 607 | rest (cdr rest) |
| 608 | dir (car first) |
| 609 | buffers (cdr first))) |
| 610 | (t |
| 611 | ;; The first pass of clumping together worked out, go ahead |
| 612 | ;; with this result. |
| 613 | (when found-p |
| 614 | (setq top-found-p t) |
| 615 | (setq first (cons dir buffers) |
| 616 | rest tmp-rest)) |
| 617 | ;; Now see if we can clump more buffers together if we go up |
| 618 | ;; one step in the file hierarchy. |
| 619 | ;; If dir isn't changed by msb--strip-dir, we are looking |
| 620 | ;; at the machine name component of an ange-ftp filename. |
| 621 | (setq old-dir dir) |
| 622 | (setq dir (msb--strip-dir dir) |
| 623 | buffers (cdr first)) |
| 624 | (if (equal old-dir dir) |
| 625 | (setq last-dir dir)) |
| 626 | (when (and last-dir |
| 627 | (or (and (>= (length dir) (length last-dir)) |
| 628 | (eq t (compare-strings |
| 629 | last-dir 0 nil dir 0 |
| 630 | (length last-dir) |
| 631 | completion-ignore-case))) |
| 632 | (and (< (length dir) (length last-dir)) |
| 633 | (eq t (compare-strings |
| 634 | dir 0 nil last-dir 0 (length dir) |
| 635 | completion-ignore-case))))) |
| 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) |
| 644 | (setq top-found-p nil) |
| 645 | (setq first (car rest) |
| 646 | rest (cdr rest) |
| 647 | dir (car first) |
| 648 | buffers (cdr first))))))) |
| 649 | ;; Now take care of the last item. |
| 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)) |
| 656 | (setq top-found-p nil) |
| 657 | (nreverse final-list))) |
| 658 | |
| 659 | (defun msb--create-function-info (menu-cond-elt) |
| 660 | "Create a vector from an element MENU-COND-ELT of `msb-menu-cond'. |
| 661 | This takes the form: |
| 662 | \[BUFFER-LIST-VARIABLE CONDITION MENU-SORT-KEY MENU-TITLE ITEM-HANDLER SORTER] |
| 663 | See `msb-menu-cond' for a description of its elements." |
| 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) |
| 675 | (eq tmp-s t)) |
| 676 | tmp-s |
| 677 | msb-item-sort-function))) |
| 678 | (when (< (length menu-cond-elt) 3) |
| 679 | (error "Wrong format of msb-menu-cond")) |
| 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)) |
| 686 | (not (eq tmp-s t))) |
| 687 | (signal 'invalid-function (list tmp-s))) |
| 688 | (set list-symbol ()) |
| 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 |
| 698 | ;; pulled out merely to make the code somewhat clearer. The indentation |
| 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 | (cl-loop for fi |
| 706 | across function-info-vector |
| 707 | if (and (setq result |
| 708 | (eval (aref fi 1))) ;Test CONDITION |
| 709 | (not (and (eq result 'no-multi) |
| 710 | multi-flag)) |
| 711 | (progn (when (eq result 'multi) |
| 712 | (setq multi-flag t)) |
| 713 | t)) |
| 714 | collect fi |
| 715 | until (and result |
| 716 | (not (eq result 'multi))))) |
| 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) |
| 723 | "Add BUFFER to the menu depicted by FUNCTION-INFO. |
| 724 | All side-effects. Adds an element of form (BUFFER-TITLE . BUFFER) |
| 725 | to the buffer-list variable in FUNCTION-INFO." |
| 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))))) |
| 734 | |
| 735 | (defsubst msb--choose-menu (buffer function-info-vector max-buffer-name-length) |
| 736 | "Select the appropriate menu for BUFFER." |
| 737 | ;; This is all side-effects, folks! |
| 738 | ;; This should be optimized. |
| 739 | (unless (and (not msb-display-invisible-buffers-p) |
| 740 | (msb-invisible-buffer-p buffer)) |
| 741 | (condition-case nil |
| 742 | (with-current-buffer buffer |
| 743 | ;; Menu found. Add to this menu |
| 744 | (dolist (info (msb--collect function-info-vector)) |
| 745 | (msb--add-to-menu buffer info max-buffer-name-length))) |
| 746 | (error (unless msb--error |
| 747 | (setq msb--error |
| 748 | (format |
| 749 | "In msb-menu-cond, error for buffer `%s'." |
| 750 | (buffer-name buffer))) |
| 751 | (error "%s" msb--error)))))) |
| 752 | |
| 753 | (defun msb--create-sort-item (function-info) |
| 754 | "Return (SORT-KEY TITLE . BUFFER-LIST) or nil if the buffer-list is empty." |
| 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 |
| 760 | (cons sort-key |
| 761 | (cons (format (aref function-info 3) ;MENU-TITLE |
| 762 | (length buffer-list)) |
| 763 | (cond |
| 764 | ((null sorter) |
| 765 | buffer-list) |
| 766 | ((eq sorter t) |
| 767 | (nreverse buffer-list)) |
| 768 | (t |
| 769 | (sort buffer-list sorter)))))))))) |
| 770 | |
| 771 | (defun msb--aggregate-alist (alist same-predicate sort-predicate) |
| 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: |
| 779 | \(msb--aggregate-alist |
| 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 |
| 785 | \((a a1 a2 a4 a3) (b b1 b3 b2) (c c3))" |
| 786 | (when (not (null alist)) |
| 787 | (let (same |
| 788 | tmp-old-car |
| 789 | tmp-same |
| 790 | (first-time-p t) |
| 791 | old-car) |
| 792 | (nconc |
| 793 | (apply #'nconc |
| 794 | (mapcar |
| 795 | (lambda (item) |
| 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) |
| 812 | (funcall sort-predicate |
| 813 | (car item1) (car item2)))))) |
| 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 | (cl-incf key) |
| 821 | (list `( eq major-mode (quote ,(car item))) |
| 822 | key |
| 823 | (concat (cdr item) " (%d)"))) |
| 824 | (sort |
| 825 | (let ((mode-list nil)) |
| 826 | (dolist (buffer (cdr (buffer-list))) |
| 827 | (with-current-buffer buffer |
| 828 | (when (and (not (msb-invisible-buffer-p)) |
| 829 | (not (assq major-mode mode-list))) |
| 830 | (push (cons major-mode |
| 831 | (format-mode-line mode-name nil nil buffer)) |
| 832 | mode-list)))) |
| 833 | mode-list) |
| 834 | (lambda (item1 item2) |
| 835 | (string< (cdr item1) (cdr item2))))))) |
| 836 | |
| 837 | (defun msb--most-recently-used-menu (max-buffer-name-length) |
| 838 | "Return a list for the most recently used buffers. |
| 839 | It takes the form ((TITLE . BUFFER-LIST)...)." |
| 840 | (when (and (numberp msb-display-most-recently-used) |
| 841 | (> msb-display-most-recently-used 0)) |
| 842 | (let* ((buffers (cdr (buffer-list))) |
| 843 | (most-recently-used |
| 844 | (cl-loop with n = 0 |
| 845 | for buffer in buffers |
| 846 | if (with-current-buffer buffer |
| 847 | (and (not (msb-invisible-buffer-p)) |
| 848 | (not (eq major-mode 'dired-mode)))) |
| 849 | collect (with-current-buffer buffer |
| 850 | (cons (funcall msb-item-handling-function |
| 851 | buffer |
| 852 | max-buffer-name-length) |
| 853 | buffer)) |
| 854 | and do (cl-incf n) |
| 855 | until (>= n msb-display-most-recently-used)))) |
| 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. |
| 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)))))) |
| 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) |
| 884 | (append msb-menu-cond (msb--mode-menu-cond))))) |
| 885 | ;; Split the buffer-list into several lists; one list for each |
| 886 | ;; criteria. This is the most critical part with respect to time. |
| 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)))) |
| 899 | (when file-buffers |
| 900 | (setq file-buffers |
| 901 | (mapcar (lambda (buffer-list) |
| 902 | `(,msb-files-by-directory-sort-key |
| 903 | ,(car buffer-list) |
| 904 | ,@(sort |
| 905 | (mapcar (lambda (buffer) |
| 906 | (cons (with-current-buffer buffer |
| 907 | (funcall |
| 908 | msb-item-handling-function |
| 909 | buffer |
| 910 | max-buffer-name-length)) |
| 911 | buffer)) |
| 912 | (cdr buffer-list)) |
| 913 | (lambda (item1 item2) |
| 914 | (string< (car item1) (car item2)))))) |
| 915 | (msb--choose-file-menu file-buffers)))) |
| 916 | ;; Now make the menu - a list of (TITLE . BUFFER-LIST) |
| 917 | (let* (menu |
| 918 | (most-recently-used |
| 919 | (msb--most-recently-used-menu max-buffer-name-length)) |
| 920 | (others (nconc file-buffers |
| 921 | (cl-loop for elt |
| 922 | across function-info-vector |
| 923 | for value = (msb--create-sort-item elt) |
| 924 | if value collect value)))) |
| 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) |
| 939 | (lambda (elt1 elt2) |
| 940 | (< (car elt1) (car elt2))))))) |
| 941 | ;; Now make it a keymap menu |
| 942 | (append |
| 943 | '(keymap "Select Buffer") |
| 944 | (msb--make-keymap-menu menu) |
| 945 | (when msb-separator-diff |
| 946 | (list (list 'separator "--"))) |
| 947 | (list (cons 'toggle |
| 948 | (cons |
| 949 | (if msb-files-by-directory |
| 950 | "*Files by type*" |
| 951 | "*Files by directory*") |
| 952 | 'msb--toggle-menu-type))))))) |
| 953 | |
| 954 | (defun msb--create-buffer-menu () |
| 955 | (save-match-data |
| 956 | (save-excursion |
| 957 | (msb--create-buffer-menu-2)))) |
| 958 | |
| 959 | (defun msb--toggle-menu-type () |
| 960 | "Multi-purpose function for selecting a buffer with the mouse." |
| 961 | (interactive) |
| 962 | (setq msb-files-by-directory (not msb-files-by-directory)) |
| 963 | ;; This gets a warning, but it is correct, |
| 964 | ;; because this file redefines menu-bar-update-buffers. |
| 965 | (msb-menu-bar-update-buffers t)) |
| 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 | |
| 971 | The way the buffers are split is conveniently handled with the |
| 972 | variable `msb-menu-cond'." |
| 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))) |
| 980 | (let ((position event) |
| 981 | choice) |
| 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)))) |
| 986 | (posWind (posn-window (event-start event)))) |
| 987 | ;; adjust position |
| 988 | (setq posX (- posX (funcall msb-horizontal-shift-function)) |
| 989 | position (list (list posX posY) posWind)))) |
| 990 | ;; Popup the menu |
| 991 | (setq choice (x-popup-menu position msb--last-buffer-menu)) |
| 992 | (cond |
| 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))) |
| 999 | (let ((msb--last-buffer-menu (nthcdr 2 (assq (car choice) |
| 1000 | msb--last-buffer-menu)))) |
| 1001 | (mouse-select-buffer event))) |
| 1002 | ((while (numberp (car choice)) |
| 1003 | (setq choice (cdr choice)))) |
| 1004 | ((and (stringp (car choice)) |
| 1005 | (null (cdr choice))) |
| 1006 | (car choice)) |
| 1007 | ((null choice) |
| 1008 | choice) |
| 1009 | (t |
| 1010 | (error "Unknown form for buffer: %s" choice))))) |
| 1011 | |
| 1012 | ;; Add separators |
| 1013 | (defun msb--add-separators (sorted-list) |
| 1014 | (if (or (not msb-separator-diff) |
| 1015 | (not (numberp msb-separator-diff))) |
| 1016 | sorted-list |
| 1017 | (let ((last-key nil)) |
| 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))))) |
| 1033 | |
| 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 | (cl-incf count)) |
| 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)) |
| 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)) "...")) |
| 1055 | (push (nconc (list mcount sub-name 'keymap sub-name) |
| 1056 | list) |
| 1057 | result)) |
| 1058 | (nreverse result)))) |
| 1059 | |
| 1060 | (defun msb--split-menus (list) |
| 1061 | (if (and (integerp msb-max-menu-items) |
| 1062 | (> msb-max-menu-items 0)) |
| 1063 | (msb--split-menus-2 list 0 nil) |
| 1064 | list)) |
| 1065 | |
| 1066 | (defun msb--make-keymap-menu (raw-menu) |
| 1067 | (let ((end (cons '(nil) 'menu-bar-select-buffer)) |
| 1068 | (mcount 0)) |
| 1069 | (mapcar |
| 1070 | (lambda (sub-menu) |
| 1071 | (cond |
| 1072 | ((eq 'separator sub-menu) |
| 1073 | (list 'separator "--")) |
| 1074 | (t |
| 1075 | (let ((buffers (mapcar (lambda (item) |
| 1076 | (cons (buffer-name (cdr item)) |
| 1077 | (cons (car item) end))) |
| 1078 | (cdr sub-menu)))) |
| 1079 | (nconc (list (cl-incf mcount) (car sub-menu) |
| 1080 | 'keymap (car sub-menu)) |
| 1081 | (msb--split-menus buffers)))))) |
| 1082 | raw-menu))) |
| 1083 | |
| 1084 | (defun msb-menu-bar-update-buffers (&optional arg) |
| 1085 | "A re-written version of `menu-bar-update-buffers'." |
| 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)) |
| 1091 | (let ((frames (frame-list)) |
| 1092 | buffers-menu frames-menu) |
| 1093 | ;; Make the menu of buffers proper. |
| 1094 | (setq msb--last-buffer-menu (msb--create-buffer-menu)) |
| 1095 | ;; Skip the `keymap' symbol. |
| 1096 | (setq buffers-menu (cdr msb--last-buffer-menu)) |
| 1097 | ;; Make a Frames menu if we have more than one frame. |
| 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) |
| 1103 | (> msb-max-menu-items 1) |
| 1104 | (> frame-length msb-max-menu-items)) |
| 1105 | (setcdr (nthcdr msb-max-menu-items frames) nil)) |
| 1106 | (setq frames-menu |
| 1107 | (nconc |
| 1108 | (list 'frame f-title '(nil) 'keymap f-title) |
| 1109 | (mapcar |
| 1110 | (lambda (frame) |
| 1111 | (nconc |
| 1112 | (list (frame-parameter frame 'name) |
| 1113 | (frame-parameter frame 'name) |
| 1114 | (cons nil nil)) |
| 1115 | `(lambda () |
| 1116 | (interactive) (menu-bar-select-frame ,frame)))) |
| 1117 | frames))))) |
| 1118 | (setcdr global-buffers-menu-map |
| 1119 | (if (and buffers-menu frames-menu) |
| 1120 | ;; Combine Frame and Buffers menus with separator between |
| 1121 | (nconc (list "Buffers and Frames" frames-menu |
| 1122 | (and msb-separator-diff '(separator "--"))) |
| 1123 | (cdr buffers-menu)) |
| 1124 | buffers-menu))))) |
| 1125 | |
| 1126 | ;; Snarf current bindings of `mouse-buffer-menu' (normally |
| 1127 | ;; C-down-mouse-1). |
| 1128 | (defvar msb-mode-map |
| 1129 | (let ((map (make-sparse-keymap "Msb"))) |
| 1130 | (define-key map [remap mouse-buffer-menu] 'msb) |
| 1131 | map)) |
| 1132 | |
| 1133 | ;;;###autoload |
| 1134 | (define-minor-mode msb-mode |
| 1135 | "Toggle Msb mode. |
| 1136 | With a prefix argument ARG, enable Msb mode if ARG is positive, |
| 1137 | and disable it otherwise. If called from Lisp, enable the mode |
| 1138 | if ARG is omitted or nil. |
| 1139 | |
| 1140 | This mode overrides the binding(s) of `mouse-buffer-menu' to provide a |
| 1141 | different buffer menu using the function `msb'." |
| 1142 | :global t :group 'msb |
| 1143 | (if msb-mode |
| 1144 | (progn |
| 1145 | (add-hook 'menu-bar-update-hook 'msb-menu-bar-update-buffers) |
| 1146 | (remove-hook 'menu-bar-update-hook 'menu-bar-update-buffers) |
| 1147 | (msb-menu-bar-update-buffers t)) |
| 1148 | (remove-hook 'menu-bar-update-hook 'msb-menu-bar-update-buffers) |
| 1149 | (add-hook 'menu-bar-update-hook 'menu-bar-update-buffers) |
| 1150 | (menu-bar-update-buffers t))) |
| 1151 | |
| 1152 | (defun msb-unload-function () |
| 1153 | "Unload the Msb library." |
| 1154 | (msb-mode -1) |
| 1155 | ;; continue standard unloading |
| 1156 | nil) |
| 1157 | |
| 1158 | (provide 'msb) |
| 1159 | (run-hooks 'msb-after-load-hook) |
| 1160 | |
| 1161 | ;;; msb.el ends here |