| 1 | ;;; bs.el --- menu for selecting and displaying buffers |
| 2 | |
| 3 | ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
| 4 | ;; 2005, 2006 Free Software Foundation, Inc. |
| 5 | ;; Author: Olaf Sylvester <Olaf.Sylvester@netsurf.de> |
| 6 | ;; Maintainer: Olaf Sylvester <Olaf.Sylvester@netsurf.de> |
| 7 | ;; Keywords: convenience |
| 8 | |
| 9 | ;; This file is part of GNU Emacs. |
| 10 | |
| 11 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
| 12 | ;; it under the terms of the GNU General Public License as published by |
| 13 | ;; the Free Software Foundation; either version 2, or (at your option) |
| 14 | ;; any later version. |
| 15 | |
| 16 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 19 | ;; GNU General Public License for more details. |
| 20 | |
| 21 | ;; You should have received a copy of the GNU General Public License |
| 22 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
| 23 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
| 24 | ;; Boston, MA 02110-1301, USA. |
| 25 | |
| 26 | ;;; Commentary: |
| 27 | |
| 28 | ;; Version: 1.17 |
| 29 | ;; X-URL: http://www.geekware.de/software/emacs |
| 30 | ;; |
| 31 | ;; The bs-package contains a main function bs-show for poping up a |
| 32 | ;; buffer in a way similar to `list-buffers' and `electric-buffer-list': |
| 33 | ;; The new buffer offers a Buffer Selection Menu for manipulating |
| 34 | ;; the buffer list and buffers. |
| 35 | ;; |
| 36 | ;; ----------------------------------------------------------------------- |
| 37 | ;; | MR Buffer Size Mode File | |
| 38 | ;; | -- ------ ---- ---- ---- | |
| 39 | ;; |. bs.el 14690 Emacs-Lisp /home/sun/sylvester/el/bs.e$| |
| 40 | ;; | % executable.el 9429 Emacs-Lisp /usr/share/emacs/19.34/lisp$| |
| 41 | ;; | % vc.el 104893 Emacs-Lisp /usr/share/emacs/19.34/lisp$| |
| 42 | ;; | % test_vc.el 486 Emacs-Lisp /home/sun/sylvester/el/test$| |
| 43 | ;; | % vc-hooks.el 43605 Emacs-Lisp /usr/share/emacs/19.34/lisp$| |
| 44 | ;; ----------------------------------------------------------------------- |
| 45 | |
| 46 | ;;; Quick Installation und Customization: |
| 47 | |
| 48 | ;; Use |
| 49 | ;; M-x bs-show |
| 50 | ;; for buffer selection or optional bind a key to main function `bs-show' |
| 51 | ;; (global-set-key "\C-x\C-b" 'bs-show) ;; or another key |
| 52 | ;; |
| 53 | ;; For customization use |
| 54 | ;; M-x bs-customize |
| 55 | |
| 56 | |
| 57 | ;;; More Commentary: |
| 58 | |
| 59 | ;; bs-show will generate a new buffer named *buffer-selection*, which shows |
| 60 | ;; all buffers or a subset of them, and has possibilities for deleting, |
| 61 | ;; saving and selecting buffers. For more details see docstring of |
| 62 | ;; function `bs-mode'. A current configuration describes which buffers appear |
| 63 | ;; in *buffer-selection*. See docstring of variable `bs-configurations' for |
| 64 | ;; more details. |
| 65 | ;; |
| 66 | ;; The package bs combines the advantages of the Emacs functions |
| 67 | ;; `list-buffers' and `electric-buffer-list'. |
| 68 | ;; |
| 69 | ;; Additional features for Buffer Selection Menu: |
| 70 | ;; - configurable list of buffers (show only files etc.). |
| 71 | ;; - comfortable way to change displayed subset of all buffers. |
| 72 | ;; - show sorted list of buffers. |
| 73 | ;; - cyclic navigation: |
| 74 | ;; - goes to top of buffer list if you are on last line and press down. |
| 75 | ;; - goes to end of buffer list if you are on first line and press up. |
| 76 | ;; - Offer an alternative buffer list by prefix key C-u. |
| 77 | |
| 78 | ;;; Cycling through buffers |
| 79 | |
| 80 | ;; This package offers two functions for buffer cycling. If you want to cycle |
| 81 | ;; through buffer list you can use `bs-cycle-next' or `bs-cycle-previous'. |
| 82 | ;; Bind these function to a key like |
| 83 | ;; (global-set-key [(f9)] 'bs-cycle-previous) |
| 84 | ;; (global-set-key [(f10)] 'bs-cycle-next) |
| 85 | ;; |
| 86 | ;; Both functions use a special subset of all buffers for cycling to avoid |
| 87 | ;; to go through internal buffers like *Messages*. |
| 88 | ;; |
| 89 | ;; Cycling through buffers ignores sorting because sorting destroys |
| 90 | ;; the logical buffer list. If buffer list is sorted by size you |
| 91 | ;; won't be able to cycle to the smallest buffer. |
| 92 | |
| 93 | ;;; Customization: |
| 94 | |
| 95 | ;; There is a customization group called `bs' in group `convenience'. |
| 96 | ;; Start customization by M-x bs-customize |
| 97 | ;; |
| 98 | ;; Buffer list |
| 99 | ;; ----------- |
| 100 | ;; You can define your own configurations by extending variable |
| 101 | ;; `bs-configurations' (see docstring for details). |
| 102 | ;; |
| 103 | ;; `bs-default-configuration' contains the name of default configuration. |
| 104 | ;; The default value is "files" which means to show only files. |
| 105 | ;; |
| 106 | ;; If you always want to see all buffers, customize variable |
| 107 | ;; `bs-default-configuration' in customization group `bs'. |
| 108 | ;; |
| 109 | ;; Configure sorting |
| 110 | ;; ----------------- |
| 111 | ;; You can define functions for sorting the buffer list. |
| 112 | ;; When selecting buffers, you can step through available sorting |
| 113 | ;; methods with key 'S'. |
| 114 | ;; To define a new way of sorting, customize variable `bs-sort-functions'. |
| 115 | ;; |
| 116 | ;; There are four basic functions for sorting: |
| 117 | ;; by buffer name, by mode, by size, or by filename |
| 118 | ;; |
| 119 | ;; Configure buffer cycling |
| 120 | ;; ------------------------ |
| 121 | ;; When cycling through buffer list the functions for cycling will use |
| 122 | ;; the current configuration of bs to calculate the buffer list. |
| 123 | ;; If you want to use a different configuration for cycling you have to set |
| 124 | ;; the variable `bs-cycle-configuration-name'. You can customize this variable. |
| 125 | ;; |
| 126 | ;; For example: If you use the configuration called "files-and-scratch" you |
| 127 | ;; can cycle through all file buffers and *scratch* although your current |
| 128 | ;; configuration perhaps is "files" which ignores buffer *scratch*. |
| 129 | |
| 130 | ;;; History: |
| 131 | |
| 132 | ;;; Code: |
| 133 | |
| 134 | (defvar font-lock-verbose) |
| 135 | |
| 136 | ;; ---------------------------------------------------------------------- |
| 137 | ;; Globals for customization |
| 138 | ;; ---------------------------------------------------------------------- |
| 139 | |
| 140 | (defgroup bs nil |
| 141 | "Buffer Selection: Maintaining buffers by buffer menu." |
| 142 | :version "21.1" |
| 143 | :link '(emacs-commentary-link "bs") |
| 144 | :link '(url-link "http://www.geekware.de/software/emacs") |
| 145 | :group 'convenience) |
| 146 | |
| 147 | (defgroup bs-appearance nil |
| 148 | "Buffer Selection appearance: Appearance of bs buffer menu." |
| 149 | :group 'bs) |
| 150 | |
| 151 | (defcustom bs-attributes-list |
| 152 | '(("" 1 1 left bs--get-marked-string) |
| 153 | ("M" 1 1 left bs--get-modified-string) |
| 154 | ("R" 2 2 left bs--get-readonly-string) |
| 155 | ("Buffer" bs--get-name-length 10 left bs--get-name) |
| 156 | ("" 1 1 left " ") |
| 157 | ("Size" 8 8 right bs--get-size-string) |
| 158 | ("" 1 1 left " ") |
| 159 | ("Mode" 12 12 right bs--get-mode-name) |
| 160 | ("" 2 2 left " ") |
| 161 | ("File" 12 12 left bs--get-file-name) |
| 162 | ("" 2 2 left " ")) |
| 163 | "*List specifying the layout of a Buffer Selection Menu buffer. |
| 164 | Each entry specifies a column and is a list of the form of: |
| 165 | \(HEADER MINIMUM-LENGTH MAXIMUM-LENGTH ALIGNMENT FUN-OR-STRING) |
| 166 | |
| 167 | HEADER : String for header for first line or a function |
| 168 | which calculates column title. |
| 169 | MINIMUM-LENGTH : Minimum width of column (number or name of function). |
| 170 | The function must return a positive integer. |
| 171 | MAXIMUM-LENGTH : Maximum width of column (number or name of function) |
| 172 | (currently ignored). |
| 173 | ALIGNMENT : Alignment of column (`left', `right', `middle'). |
| 174 | FUN-OR-STRING : Name of a function for calculating the value or a |
| 175 | string for a constant value. |
| 176 | |
| 177 | The function gets as parameter the buffer where we have started |
| 178 | buffer selection and the list of all buffers to show. The function must |
| 179 | return a string representing the column's value." |
| 180 | :group 'bs-appearance |
| 181 | :type '(repeat sexp)) |
| 182 | |
| 183 | (defun bs--make-header-match-string () |
| 184 | "Return a regexp matching the first line of a Buffer Selection Menu buffer." |
| 185 | (let ((res "^\\(") |
| 186 | (ele bs-attributes-list)) |
| 187 | (while ele |
| 188 | (setq res (concat res (car (car ele)) " *")) |
| 189 | (setq ele (cdr ele))) |
| 190 | (concat res "$\\)"))) |
| 191 | |
| 192 | ;; Font-Lock-Settings |
| 193 | (defvar bs-mode-font-lock-keywords |
| 194 | (list ;; header in font-lock-type-face |
| 195 | (list (bs--make-header-match-string) |
| 196 | '(1 font-lock-type-face append) '(1 'bold append)) |
| 197 | ;; Buffername embedded by * |
| 198 | (list "^\\(.*\\*.*\\*.*\\)$" |
| 199 | 1 |
| 200 | ;; problem in XEmacs with font-lock-constant-face |
| 201 | (if (facep 'font-lock-constant-face) |
| 202 | 'font-lock-constant-face |
| 203 | 'font-lock-comment-face)) |
| 204 | ;; Dired-Buffers |
| 205 | '("^..\\(.*Dired by .*\\)$" 1 font-lock-function-name-face) |
| 206 | ;; the star for modified buffers |
| 207 | '("^.\\(\\*\\) +[^\\*]" 1 font-lock-comment-face)) |
| 208 | "Default font lock expressions for Buffer Selection Menu.") |
| 209 | |
| 210 | (defcustom bs-max-window-height 20 |
| 211 | "*Maximal window height of Buffer Selection Menu." |
| 212 | :group 'bs-appearance |
| 213 | :type 'integer) |
| 214 | |
| 215 | (defvar bs-dont-show-regexp nil |
| 216 | "Regular expression specifying which buffers not to show. |
| 217 | A buffer whose name matches this regular expression will not be |
| 218 | included in the buffer list.") |
| 219 | |
| 220 | (defvar bs-must-show-regexp nil |
| 221 | "Regular expression for specifying buffers which must be shown. |
| 222 | A buffer whose name matches this regular expression will be |
| 223 | included in the buffer list. |
| 224 | Note that this variable is temporary: if the configuration is changed |
| 225 | it is reset to nil. Use `bs-must-always-show-regexp' to specify buffers |
| 226 | that must always be shown regardless of the configuration.") |
| 227 | |
| 228 | (defcustom bs-must-always-show-regexp nil |
| 229 | "*Regular expression for specifying buffers to show always. |
| 230 | A buffer whose name matches this regular expression will |
| 231 | be shown regardless of current configuration of Buffer Selection Menu." |
| 232 | :group 'bs |
| 233 | :type '(choice (const :tag "Nothing at all" nil) regexp)) |
| 234 | |
| 235 | (defvar bs-dont-show-function nil |
| 236 | "Function for specifying buffers not to show. |
| 237 | The function gets one argument - the buffer to test. The function must |
| 238 | return a value different from nil to ignore the buffer in |
| 239 | Buffer Selection Menu.") |
| 240 | |
| 241 | (defvar bs-must-show-function nil |
| 242 | "Function for specifying buffers which must be shown. |
| 243 | The function gets one argument - the buffer to test.") |
| 244 | |
| 245 | (defvar bs-buffer-sort-function nil |
| 246 | "Sort function to sort the buffers that appear in Buffer Selection Menu. |
| 247 | The function gets two arguments - the buffers to compare.") |
| 248 | |
| 249 | (defcustom bs-maximal-buffer-name-column 45 |
| 250 | "*Maximum column width for buffer names. |
| 251 | The column for buffer names has dynamic width. The width depends on |
| 252 | maximal and minimal length of names of buffers to show. The maximal |
| 253 | width is bounded by `bs-maximal-buffer-name-column'. |
| 254 | See also `bs-minimal-buffer-name-column'." |
| 255 | :group 'bs-appearance |
| 256 | :type 'integer) |
| 257 | |
| 258 | (defcustom bs-minimal-buffer-name-column 15 |
| 259 | "*Minimum column width for buffer names. |
| 260 | The column for buffer names has dynamic width. The width depends on |
| 261 | maximal and minimal length of names of buffers to show. The minimal |
| 262 | width is bounded by `bs-minimal-buffer-name-column'. |
| 263 | See also `bs-maximal-buffer-name-column'." |
| 264 | :group 'bs-appearance |
| 265 | :type 'integer) |
| 266 | |
| 267 | (defconst bs-header-lines-length 2 |
| 268 | "Number of lines for headers in Buffer Selection Menu.") |
| 269 | |
| 270 | (defcustom bs-configurations |
| 271 | '(("all" nil nil nil nil nil) |
| 272 | ("files" nil nil nil bs-visits-non-file bs-sort-buffer-interns-are-last) |
| 273 | ("files-and-scratch" "^\\*scratch\\*$" nil nil bs-visits-non-file |
| 274 | bs-sort-buffer-interns-are-last) |
| 275 | ("all-intern-last" nil nil nil nil bs-sort-buffer-interns-are-last)) |
| 276 | "*List of all configurations you can use in the Buffer Selection Menu. |
| 277 | A configuration describes which buffers appear in Buffer Selection Menu |
| 278 | and also the order of buffers. A configuration is a list with |
| 279 | six elements. The first element is a string and describes the configuration. |
| 280 | The following five elements represent the values for Buffer Selection Menu |
| 281 | configuration variables `bs-must-show-regexp', `bs-must-show-function', |
| 282 | `bs-dont-show-regexp', `bs-dont-show-function' and `bs-buffer-sort-function'. |
| 283 | By setting these variables you define a configuration." |
| 284 | :group 'bs-appearance |
| 285 | :type '(repeat sexp)) |
| 286 | |
| 287 | (defcustom bs-default-configuration "files" |
| 288 | "*Name of default configuration used by the Buffer Selection Menu. |
| 289 | \\<bs-mode-map> |
| 290 | Will be changed using key \\[bs-select-next-configuration]. |
| 291 | Must be a string used in `bs-configurations' for naming a configuration." |
| 292 | :group 'bs |
| 293 | :type 'string) |
| 294 | |
| 295 | (defcustom bs-alternative-configuration "all" |
| 296 | "*Name of configuration used when calling `bs-show' with \ |
| 297 | \\[universal-argument] as prefix key. |
| 298 | Must be a string used in `bs-configurations' for naming a configuration." |
| 299 | :group 'bs |
| 300 | :type 'string) |
| 301 | |
| 302 | (defvar bs-current-configuration bs-default-configuration |
| 303 | "Name of current configuration. |
| 304 | Must be a string used in `bs-configurations' for naming a configuration.") |
| 305 | |
| 306 | (defcustom bs-cycle-configuration-name nil |
| 307 | "*Name of configuration used when cycling through the buffer list. |
| 308 | A value of nil means to use current configuration `bs-default-configuration'. |
| 309 | Must be a string used in `bs-configurations' for naming a configuration." |
| 310 | :group 'bs |
| 311 | :type '(choice (const :tag "like current configuration" nil) |
| 312 | string)) |
| 313 | |
| 314 | (defcustom bs-string-show-always "+" |
| 315 | "*String added in column 1 indicating a buffer will always be shown." |
| 316 | :group 'bs-appearance |
| 317 | :type 'string) |
| 318 | |
| 319 | (defcustom bs-string-show-never "-" |
| 320 | "*String added in column 1 indicating a buffer will never be shown." |
| 321 | :group 'bs-appearance |
| 322 | :type 'string) |
| 323 | |
| 324 | (defcustom bs-string-current "." |
| 325 | "*String added in column 1 indicating the current buffer." |
| 326 | :group 'bs-appearance |
| 327 | :type 'string) |
| 328 | |
| 329 | (defcustom bs-string-current-marked "#" |
| 330 | "*String added in column 1 indicating the current buffer when it is marked." |
| 331 | :group 'bs-appearance |
| 332 | :type 'string) |
| 333 | |
| 334 | (defcustom bs-string-marked ">" |
| 335 | "*String added in column 1 indicating a marked buffer." |
| 336 | :group 'bs-appearance |
| 337 | :type 'string) |
| 338 | |
| 339 | (defcustom bs-string-show-normally " " |
| 340 | "*String added in column 1 indicating a unmarked buffer." |
| 341 | :group 'bs-appearance |
| 342 | :type 'string) |
| 343 | |
| 344 | (defvar bs--name-entry-length 20 |
| 345 | "Maximum length of all displayed buffer names. |
| 346 | Used internally, only.") |
| 347 | |
| 348 | ;; ---------------------------------------------------------------------- |
| 349 | ;; Internal globals |
| 350 | ;; ---------------------------------------------------------------------- |
| 351 | |
| 352 | (defvar bs-buffer-show-mark nil |
| 353 | "Flag for the current mode for showing this buffer. |
| 354 | A value of nil means buffer will be shown depending on the current |
| 355 | configuration. |
| 356 | A value of `never' means to never show the buffer. |
| 357 | A value of `always' means to show buffer regardless of the configuration.") |
| 358 | |
| 359 | (make-variable-buffer-local 'bs-buffer-show-mark) |
| 360 | |
| 361 | ;; Make face named region (for XEmacs) |
| 362 | (unless (facep 'region) |
| 363 | (make-face 'region) |
| 364 | (set-face-background 'region "gray75")) |
| 365 | |
| 366 | (defun bs--sort-by-name (b1 b2) |
| 367 | "Compare buffers B1 and B2 by buffer name." |
| 368 | (string< (buffer-name b1) |
| 369 | (buffer-name b2))) |
| 370 | |
| 371 | (defun bs--sort-by-filename (b1 b2) |
| 372 | "Compare buffers B1 and B2 by file name." |
| 373 | (string< (or (buffer-file-name b1) "") |
| 374 | (or (buffer-file-name b2) ""))) |
| 375 | |
| 376 | (defun bs--sort-by-mode (b1 b2) |
| 377 | "Compare buffers B1 and B2 by mode name." |
| 378 | (save-excursion |
| 379 | (string< (progn (set-buffer b1) (format "%s" mode-name)) |
| 380 | (progn (set-buffer b2) (format "%s" mode-name))))) |
| 381 | |
| 382 | (defun bs--sort-by-size (b1 b2) |
| 383 | "Compare buffers B1 and B2 by buffer size." |
| 384 | (save-excursion |
| 385 | (< (progn (set-buffer b1) (buffer-size)) |
| 386 | (progn (set-buffer b2) (buffer-size))))) |
| 387 | |
| 388 | (defcustom bs-sort-functions |
| 389 | '(("by name" bs--sort-by-name "Buffer" region) |
| 390 | ("by size" bs--sort-by-size "Size" region) |
| 391 | ("by mode" bs--sort-by-mode "Mode" region) |
| 392 | ("by filename" bs--sort-by-filename "File" region) |
| 393 | ("by nothing" nil nil nil)) |
| 394 | "*List of all possible sorting aspects for Buffer Selection Menu. |
| 395 | You can add a new entry with a call to `bs-define-sort-function'. |
| 396 | Each element is a list of four elements (NAME FUNCTION REGEXP-FOR-SORTING FACE) |
| 397 | NAME specifies the sort order defined by function FUNCTION. |
| 398 | FUNCTION nil means don't sort the buffer list. Otherwise the functions |
| 399 | must have two parameters - the buffers to compare. |
| 400 | REGEXP-FOR-SORTING is a regular expression which describes the |
| 401 | column title to highlight. |
| 402 | FACE is a face used to fontify the sorted column title. A value of nil means |
| 403 | don't highlight." |
| 404 | :group 'bs |
| 405 | :type '(repeat sexp)) |
| 406 | |
| 407 | (defun bs-define-sort-function (name fun &optional regexp-for-sorting face) |
| 408 | "Define a new function for buffer sorting in Buffer Selection Menu. |
| 409 | NAME specifies the sort order defined by function FUN. |
| 410 | A value of nil for FUN means don't sort the buffer list. Otherwise the |
| 411 | functions must have two parameters - the buffers to compare. |
| 412 | REGEXP-FOR-SORTING is a regular expression which describes the |
| 413 | column title to highlight. |
| 414 | FACE is a face used to fontify the sorted column title. A value of nil means |
| 415 | don't highlight. |
| 416 | The new sort aspect will be inserted into list `bs-sort-functions'." |
| 417 | (let ((tupel (assoc name bs-sort-functions))) |
| 418 | (if tupel |
| 419 | (setcdr tupel (list fun regexp-for-sorting face)) |
| 420 | (setq bs-sort-functions |
| 421 | (cons (list name fun regexp-for-sorting face) |
| 422 | bs-sort-functions))))) |
| 423 | |
| 424 | (defvar bs--current-sort-function nil |
| 425 | "Description of the current function for sorting the buffer list. |
| 426 | This is an element of `bs-sort-functions'.") |
| 427 | |
| 428 | (defcustom bs-default-sort-name "by nothing" |
| 429 | "*Name of default sort behavior. |
| 430 | Must be \"by nothing\" or a string used in `bs-sort-functions' for |
| 431 | naming a sort behavior. Default is \"by nothing\" which means no sorting." |
| 432 | :group 'bs |
| 433 | :type 'string |
| 434 | :set (lambda (var-name value) |
| 435 | (set var-name value) |
| 436 | (setq bs--current-sort-function |
| 437 | (assoc value bs-sort-functions)))) |
| 438 | |
| 439 | (defvar bs--buffer-coming-from nil |
| 440 | "The buffer in which the user started the current Buffer Selection Menu.") |
| 441 | |
| 442 | (defvar bs--show-all nil |
| 443 | "Flag whether showing all buffers regardless of current configuration. |
| 444 | Non nil means to show all buffers. Otherwise show buffers |
| 445 | defined by current configuration `bs-current-configuration'.") |
| 446 | |
| 447 | (defvar bs--window-config-coming-from nil |
| 448 | "Window configuration before starting Buffer Selection Menu.") |
| 449 | |
| 450 | (defvar bs--intern-show-never "^ \\|\\*buffer-selection\\*" |
| 451 | "Regular expression specifying which buffers never to show. |
| 452 | A buffer whose name matches this regular expression will never be |
| 453 | included in the buffer list.") |
| 454 | |
| 455 | (defvar bs-current-list nil |
| 456 | "List of buffers shown in Buffer Selection Menu. |
| 457 | Used internally, only.") |
| 458 | |
| 459 | (defvar bs--marked-buffers nil |
| 460 | "Currently marked buffers in Buffer Selection Menu.") |
| 461 | |
| 462 | (defvar bs-mode-map |
| 463 | (let ((map (make-sparse-keymap))) |
| 464 | (define-key map " " 'bs-select) |
| 465 | (define-key map "f" 'bs-select) |
| 466 | (define-key map "v" 'bs-view) |
| 467 | (define-key map "!" 'bs-select-in-one-window) |
| 468 | (define-key map [mouse-2] 'bs-mouse-select) ;; for GNU EMACS |
| 469 | (define-key map [button2] 'bs-mouse-select) ;; for XEmacs |
| 470 | (define-key map "F" 'bs-select-other-frame) |
| 471 | (let ((key ?1)) |
| 472 | (while (<= key ?9) |
| 473 | (define-key map (char-to-string key) 'digit-argument) |
| 474 | (setq key (1+ key)))) |
| 475 | (define-key map "-" 'negative-argument) |
| 476 | (define-key map "\e-" 'negative-argument) |
| 477 | (define-key map "o" 'bs-select-other-window) |
| 478 | (define-key map "\C-o" 'bs-tmp-select-other-window) |
| 479 | ;; for GNU EMACS |
| 480 | (define-key map [mouse-3] 'bs-mouse-select-other-frame) |
| 481 | ;; for XEmacs |
| 482 | (define-key map [button3] 'bs-mouse-select-other-frame) |
| 483 | (define-key map [up] 'bs-up) |
| 484 | (define-key map "n" 'bs-down) |
| 485 | (define-key map "p" 'bs-up) |
| 486 | (define-key map [down] 'bs-down) |
| 487 | (define-key map "\C-m" 'bs-select) |
| 488 | (define-key map "b" 'bs-bury-buffer) |
| 489 | (define-key map "s" 'bs-save) |
| 490 | (define-key map "S" 'bs-show-sorted) |
| 491 | (define-key map "a" 'bs-toggle-show-all) |
| 492 | (define-key map "d" 'bs-delete) |
| 493 | (define-key map "\C-d" 'bs-delete-backward) |
| 494 | (define-key map "k" 'bs-delete) |
| 495 | (define-key map "g" 'bs-refresh) |
| 496 | (define-key map "C" 'bs-set-configuration-and-refresh) |
| 497 | (define-key map "c" 'bs-select-next-configuration) |
| 498 | (define-key map "q" 'bs-kill) |
| 499 | ;; (define-key map "z" 'bs-kill) |
| 500 | (define-key map "\C-c\C-c" 'bs-kill) |
| 501 | (define-key map "\C-g" 'bs-abort) |
| 502 | (define-key map "\C-]" 'bs-abort) |
| 503 | (define-key map "%" 'bs-toggle-readonly) |
| 504 | (define-key map "~" 'bs-clear-modified) |
| 505 | (define-key map "M" 'bs-toggle-current-to-show) |
| 506 | (define-key map "+" 'bs-set-current-buffer-to-show-always) |
| 507 | ;;(define-key map "-" 'bs-set-current-buffer-to-show-never) |
| 508 | (define-key map "t" 'bs-visit-tags-table) |
| 509 | (define-key map "m" 'bs-mark-current) |
| 510 | (define-key map "u" 'bs-unmark-current) |
| 511 | (define-key map ">" 'scroll-right) |
| 512 | (define-key map "<" 'scroll-left) |
| 513 | (define-key map "?" 'bs-help) |
| 514 | map) |
| 515 | "Keymap of `bs-mode'.") |
| 516 | |
| 517 | ;; ---------------------------------------------------------------------- |
| 518 | ;; Functions |
| 519 | ;; ---------------------------------------------------------------------- |
| 520 | |
| 521 | (defun bs-buffer-list (&optional list sort-description) |
| 522 | "Return a list of buffers to be shown. |
| 523 | LIST is a list of buffers to test for appearance in Buffer Selection Menu. |
| 524 | The result list depends on the global variables `bs-dont-show-regexp', |
| 525 | `bs-must-show-regexp', `bs-dont-show-function', `bs-must-show-function' |
| 526 | and `bs-buffer-sort-function'. |
| 527 | If SORT-DESCRIPTION isn't nil the list will be sorted by |
| 528 | a special function. SORT-DESCRIPTION is an element of `bs-sort-functions'." |
| 529 | (setq sort-description (or sort-description bs--current-sort-function) |
| 530 | list (or list (buffer-list))) |
| 531 | (let ((result nil)) |
| 532 | (while list |
| 533 | (let* ((buffername (buffer-name (car list))) |
| 534 | (int-show-never (string-match bs--intern-show-never buffername)) |
| 535 | (ext-show-never (and bs-dont-show-regexp |
| 536 | (string-match bs-dont-show-regexp |
| 537 | buffername))) |
| 538 | (extern-must-show (or (and bs-must-always-show-regexp |
| 539 | (string-match |
| 540 | bs-must-always-show-regexp |
| 541 | buffername)) |
| 542 | (and bs-must-show-regexp |
| 543 | (string-match bs-must-show-regexp |
| 544 | buffername)))) |
| 545 | (extern-show-never-from-fun (and bs-dont-show-function |
| 546 | (funcall bs-dont-show-function |
| 547 | (car list)))) |
| 548 | (extern-must-show-from-fun (and bs-must-show-function |
| 549 | (funcall bs-must-show-function |
| 550 | (car list)))) |
| 551 | (show-flag (buffer-local-value 'bs-buffer-show-mark (car list)))) |
| 552 | (if (or (eq show-flag 'always) |
| 553 | (and (or bs--show-all (not (eq show-flag 'never))) |
| 554 | (not int-show-never) |
| 555 | (or bs--show-all |
| 556 | extern-must-show |
| 557 | extern-must-show-from-fun |
| 558 | (and (not ext-show-never) |
| 559 | (not extern-show-never-from-fun))))) |
| 560 | (setq result (cons (car list) |
| 561 | result))) |
| 562 | (setq list (cdr list)))) |
| 563 | (setq result (reverse result)) |
| 564 | ;; The current buffer which was the start point of bs should be an element |
| 565 | ;; of result list, so that we can leave with space and be back in the |
| 566 | ;; buffer we started bs-show. |
| 567 | (if (and bs--buffer-coming-from |
| 568 | (buffer-live-p bs--buffer-coming-from) |
| 569 | (not (memq bs--buffer-coming-from result))) |
| 570 | (setq result (cons bs--buffer-coming-from result))) |
| 571 | ;; sorting |
| 572 | (if (and sort-description |
| 573 | (nth 1 sort-description)) |
| 574 | (setq result (sort result (nth 1 sort-description))) |
| 575 | ;; else standard sorting |
| 576 | (bs-buffer-sort result)))) |
| 577 | |
| 578 | (defun bs-buffer-sort (buffer-list) |
| 579 | "Sort buffers in BUFFER-LIST according to `bs-buffer-sort-function'." |
| 580 | (if bs-buffer-sort-function |
| 581 | (sort buffer-list bs-buffer-sort-function) |
| 582 | buffer-list)) |
| 583 | |
| 584 | (defun bs--redisplay (&optional keep-line-p sort-description) |
| 585 | "Redisplay whole Buffer Selection Menu. |
| 586 | If KEEP-LINE-P is non nil the point will stay on current line. |
| 587 | SORT-DESCRIPTION is an element of `bs-sort-functions'" |
| 588 | (let ((line (1+ (count-lines 1 (point))))) |
| 589 | (bs-show-in-buffer (bs-buffer-list nil sort-description)) |
| 590 | (if keep-line-p |
| 591 | (goto-line line)) |
| 592 | (beginning-of-line))) |
| 593 | |
| 594 | (defun bs--goto-current-buffer () |
| 595 | "Goto line which represents the current buffer; |
| 596 | actually the line which begins with character in `bs-string-current' or |
| 597 | `bs-string-current-marked'." |
| 598 | (let ((regexp (concat "^" |
| 599 | (regexp-quote bs-string-current) |
| 600 | "\\|^" |
| 601 | (regexp-quote bs-string-current-marked))) |
| 602 | point) |
| 603 | (save-excursion |
| 604 | (goto-char (point-min)) |
| 605 | (if (search-forward-regexp regexp nil t) |
| 606 | (setq point (- (point) 1)))) |
| 607 | (if point |
| 608 | (goto-char point)))) |
| 609 | |
| 610 | (defun bs--current-config-message () |
| 611 | "Return a string describing the current `bs-mode' configuration." |
| 612 | (if bs--show-all |
| 613 | "Show all buffers." |
| 614 | (format "Show buffer by configuration %S" |
| 615 | bs-current-configuration))) |
| 616 | |
| 617 | (defun bs-mode () |
| 618 | "Major mode for editing a subset of Emacs' buffers. |
| 619 | \\<bs-mode-map> |
| 620 | Aside from two header lines each line describes one buffer. |
| 621 | Move to a line representing the buffer you want to edit and select |
| 622 | buffer by \\[bs-select] or SPC. Abort buffer list with \\[bs-kill]. |
| 623 | There are many key commands similar to `Buffer-menu-mode' for |
| 624 | manipulating the buffer list and buffers. |
| 625 | For faster navigation each digit key is a digit argument. |
| 626 | |
| 627 | \\[bs-select] or SPACE -- select current line's buffer and other marked buffers. |
| 628 | \\[bs-toggle-show-all] -- toggle between all buffers and a special subset. |
| 629 | \\[bs-select-other-window] -- select current line's buffer in other window. |
| 630 | \\[bs-tmp-select-other-window] -- make another window display that buffer and |
| 631 | remain in Buffer Selection Menu. |
| 632 | \\[bs-mouse-select] -- select current line's buffer and other marked buffers. |
| 633 | \\[bs-save] -- save current line's buffer immediately. |
| 634 | \\[bs-delete] -- kill current line's buffer immediately. |
| 635 | \\[bs-toggle-readonly] -- toggle read-only status of current line's buffer. |
| 636 | \\[bs-clear-modified] -- clear modified-flag on that buffer. |
| 637 | \\[bs-mark-current] -- mark current line's buffer to be displayed. |
| 638 | \\[bs-unmark-current] -- unmark current line's buffer to be displayed. |
| 639 | \\[bs-show-sorted] -- display buffer list sorted by next sort aspect. |
| 640 | \\[bs-set-configuration-and-refresh] -- ask user for a configuration and \ |
| 641 | apply selected configuration. |
| 642 | \\[bs-select-next-configuration] -- select and apply next \ |
| 643 | available Buffer Selection Menu configuration. |
| 644 | \\[bs-kill] -- leave Buffer Selection Menu without a selection. |
| 645 | \\[bs-toggle-current-to-show] -- toggle status of appearance. |
| 646 | \\[bs-set-current-buffer-to-show-always] -- mark current line's buffer \ |
| 647 | to show always. |
| 648 | \\[bs-visit-tags-table] -- call `visit-tags-table' on current line's buffer. |
| 649 | \\[bs-help] -- display this help text." |
| 650 | (interactive) |
| 651 | (kill-all-local-variables) |
| 652 | (use-local-map bs-mode-map) |
| 653 | (make-local-variable 'font-lock-defaults) |
| 654 | (make-local-variable 'font-lock-verbose) |
| 655 | (buffer-disable-undo) |
| 656 | (setq major-mode 'bs-mode |
| 657 | mode-name "Buffer-Selection-Menu" |
| 658 | buffer-read-only t |
| 659 | truncate-lines t |
| 660 | font-lock-defaults '(bs-mode-font-lock-keywords t) |
| 661 | font-lock-verbose nil) |
| 662 | (run-mode-hooks 'bs-mode-hook)) |
| 663 | |
| 664 | (defun bs-kill () |
| 665 | "Let buffer disappear and reset window-configuration." |
| 666 | (interactive) |
| 667 | (bury-buffer (current-buffer)) |
| 668 | (set-window-configuration bs--window-config-coming-from)) |
| 669 | |
| 670 | (defun bs-abort () |
| 671 | "Ding and leave Buffer Selection Menu without a selection." |
| 672 | (interactive) |
| 673 | (ding) |
| 674 | (bs-kill)) |
| 675 | |
| 676 | (defun bs-set-configuration-and-refresh () |
| 677 | "Ask user for a configuration and apply selected configuration. |
| 678 | Refresh whole Buffer Selection Menu." |
| 679 | (interactive) |
| 680 | (call-interactively 'bs-set-configuration) |
| 681 | (bs--redisplay t)) |
| 682 | |
| 683 | (defun bs-refresh () |
| 684 | "Refresh whole Buffer Selection Menu." |
| 685 | (interactive) |
| 686 | (bs--redisplay t)) |
| 687 | |
| 688 | (defun bs--window-for-buffer (buffer-name) |
| 689 | "Return a window showing a buffer with name BUFFER-NAME. |
| 690 | Take only windows of current frame into account. |
| 691 | Return nil if there is no such buffer." |
| 692 | (let ((window nil)) |
| 693 | (walk-windows (lambda (wind) |
| 694 | (if (string= (buffer-name (window-buffer wind)) |
| 695 | buffer-name) |
| 696 | (setq window wind)))) |
| 697 | window)) |
| 698 | |
| 699 | (defun bs--set-window-height () |
| 700 | "Change the height of the selected window to suit the current buffer list." |
| 701 | (unless (one-window-p t) |
| 702 | (fit-window-to-buffer (selected-window) bs-max-window-height))) |
| 703 | |
| 704 | (defun bs--current-buffer () |
| 705 | "Return buffer on current line. |
| 706 | Raise an error if not on a buffer line." |
| 707 | (beginning-of-line) |
| 708 | (let ((line (+ (- bs-header-lines-length) |
| 709 | (count-lines 1 (point))))) |
| 710 | (if (< line 0) |
| 711 | (error "You are on a header row")) |
| 712 | (nth line bs-current-list))) |
| 713 | |
| 714 | (defun bs--update-current-line () |
| 715 | "Update the entry on current line for Buffer Selection Menu." |
| 716 | (let ((buffer (bs--current-buffer)) |
| 717 | (inhibit-read-only t)) |
| 718 | (beginning-of-line) |
| 719 | (delete-region (point) (line-end-position)) |
| 720 | (bs--insert-one-entry buffer) |
| 721 | (beginning-of-line))) |
| 722 | |
| 723 | (defun bs-view () |
| 724 | "View current line's buffer in View mode. |
| 725 | Leave Buffer Selection Menu." |
| 726 | (interactive) |
| 727 | (view-buffer (bs--current-buffer))) |
| 728 | |
| 729 | (defun bs-select () |
| 730 | "Select current line's buffer and other marked buffers. |
| 731 | If there are no marked buffers the window configuration before starting |
| 732 | Buffer Selectin Menu will be restored. |
| 733 | If there are marked buffers each marked buffer and the current line's buffer |
| 734 | will be selected in a window. |
| 735 | Leave Buffer Selection Menu." |
| 736 | (interactive) |
| 737 | (let ((buffer (bs--current-buffer))) |
| 738 | (bury-buffer (current-buffer)) |
| 739 | (set-window-configuration bs--window-config-coming-from) |
| 740 | (switch-to-buffer buffer) |
| 741 | (if bs--marked-buffers |
| 742 | ;; Some marked buffers for selection |
| 743 | (let* ((all (delq buffer bs--marked-buffers)) |
| 744 | (height (/ (1- (frame-height)) (1+ (length all))))) |
| 745 | (delete-other-windows) |
| 746 | (switch-to-buffer buffer) |
| 747 | (while all |
| 748 | (split-window nil height) |
| 749 | (other-window 1) |
| 750 | (switch-to-buffer (car all)) |
| 751 | (setq all (cdr all))) |
| 752 | ;; goto window we have started bs. |
| 753 | (other-window 1))))) |
| 754 | |
| 755 | (defun bs-select-other-window () |
| 756 | "Select current line's buffer by `switch-to-buffer-other-window'. |
| 757 | The window configuration before starting Buffer Selectin Menu will be restored |
| 758 | unless there is no other window. In this case a new window will be created. |
| 759 | Leave Buffer Selection Menu." |
| 760 | (interactive) |
| 761 | (let ((buffer (bs--current-buffer))) |
| 762 | (bury-buffer (current-buffer)) |
| 763 | (set-window-configuration bs--window-config-coming-from) |
| 764 | (switch-to-buffer-other-window buffer))) |
| 765 | |
| 766 | (defun bs-tmp-select-other-window () |
| 767 | "Make the other window select this line's buffer. |
| 768 | The current window remains selected." |
| 769 | (interactive) |
| 770 | (let ((buffer (bs--current-buffer))) |
| 771 | (display-buffer buffer t))) |
| 772 | |
| 773 | (defun bs-select-other-frame () |
| 774 | "Select current line's buffer in new created frame. |
| 775 | Leave Buffer Selection Menu." |
| 776 | (interactive) |
| 777 | (let ((buffer (bs--current-buffer))) |
| 778 | (bury-buffer (current-buffer)) |
| 779 | (set-window-configuration bs--window-config-coming-from) |
| 780 | (switch-to-buffer-other-frame buffer))) |
| 781 | |
| 782 | (defun bs-mouse-select-other-frame (event) |
| 783 | "Select selected line's buffer in new created frame. |
| 784 | Leave Buffer Selection Menu. |
| 785 | EVENT: a mouse click EVENT." |
| 786 | (interactive "e") |
| 787 | (mouse-set-point event) |
| 788 | (bs-select-other-frame)) |
| 789 | |
| 790 | (defun bs-mouse-select (event) |
| 791 | "Select buffer on mouse click EVENT. |
| 792 | Select buffer by `bs-select'." |
| 793 | (interactive "e") |
| 794 | (mouse-set-point event) |
| 795 | (bs-select)) |
| 796 | |
| 797 | (defun bs-select-in-one-window () |
| 798 | "Select current line's buffer in one window and delete other windows. |
| 799 | Leave Buffer Selection Menu." |
| 800 | (interactive) |
| 801 | (bs-select) |
| 802 | (delete-other-windows)) |
| 803 | |
| 804 | (defun bs-bury-buffer () |
| 805 | "Bury buffer on current line." |
| 806 | (interactive) |
| 807 | (bury-buffer (bs--current-buffer)) |
| 808 | (bs--redisplay t)) |
| 809 | |
| 810 | (defun bs-save () |
| 811 | "Save buffer on current line." |
| 812 | (interactive) |
| 813 | (let ((buffer (bs--current-buffer))) |
| 814 | (save-excursion |
| 815 | (set-buffer buffer) |
| 816 | (save-buffer)) |
| 817 | (bs--update-current-line))) |
| 818 | |
| 819 | (defun bs-visit-tags-table () |
| 820 | "Visit the tags table in the buffer on this line. |
| 821 | See `visit-tags-table'." |
| 822 | (interactive) |
| 823 | (let ((file (buffer-file-name (bs--current-buffer)))) |
| 824 | (if file |
| 825 | (visit-tags-table file) |
| 826 | (error "Specified buffer has no file")))) |
| 827 | |
| 828 | (defun bs-toggle-current-to-show () |
| 829 | "Toggle status of showing flag for buffer in current line." |
| 830 | (interactive) |
| 831 | (let ((buffer (bs--current-buffer)) |
| 832 | res) |
| 833 | (save-excursion |
| 834 | (set-buffer buffer) |
| 835 | (setq res (cond ((null bs-buffer-show-mark) |
| 836 | 'never) |
| 837 | ((eq bs-buffer-show-mark 'never) |
| 838 | 'always) |
| 839 | (t nil))) |
| 840 | (setq bs-buffer-show-mark res)) |
| 841 | (bs--update-current-line) |
| 842 | (bs--set-window-height) |
| 843 | (bs--show-config-message res))) |
| 844 | |
| 845 | (defun bs-set-current-buffer-to-show-always (&optional not-to-show-p) |
| 846 | "Toggle status of buffer on line to `always shown'. |
| 847 | NOT-TO-SHOW-P: prefix argument. |
| 848 | With no prefix argument the buffer on current line is marked to show |
| 849 | always. Otherwise it is marked to show never." |
| 850 | (interactive "P") |
| 851 | (if not-to-show-p |
| 852 | (bs-set-current-buffer-to-show-never) |
| 853 | (bs--set-toggle-to-show (bs--current-buffer) 'always))) |
| 854 | |
| 855 | (defun bs-set-current-buffer-to-show-never () |
| 856 | "Toggle status of buffer on line to `never shown'." |
| 857 | (interactive) |
| 858 | (bs--set-toggle-to-show (bs--current-buffer) 'never)) |
| 859 | |
| 860 | (defun bs--set-toggle-to-show (buffer what) |
| 861 | "Set value `bs-buffer-show-mark' of buffer BUFFER to WHAT. |
| 862 | Redisplay current line and display a message describing |
| 863 | the status of buffer on current line." |
| 864 | (with-current-buffer buffer (setq bs-buffer-show-mark what)) |
| 865 | (bs--update-current-line) |
| 866 | (bs--set-window-height) |
| 867 | (bs--show-config-message what)) |
| 868 | |
| 869 | (defun bs-mark-current (count) |
| 870 | "Mark buffers. |
| 871 | COUNT is the number of buffers to mark. |
| 872 | Move cursor vertically down COUNT lines." |
| 873 | (interactive "p") |
| 874 | (let ((dir (if (> count 0) 1 -1)) |
| 875 | (count (abs count))) |
| 876 | (while (> count 0) |
| 877 | (let ((buffer (bs--current-buffer))) |
| 878 | (if buffer |
| 879 | (setq bs--marked-buffers (cons buffer bs--marked-buffers))) |
| 880 | (bs--update-current-line) |
| 881 | (bs-down dir)) |
| 882 | (setq count (1- count))))) |
| 883 | |
| 884 | (defun bs-unmark-current (count) |
| 885 | "Unmark buffers. |
| 886 | COUNT is the number of buffers to unmark. |
| 887 | Move cursor vertically down COUNT lines." |
| 888 | (interactive "p") |
| 889 | (let ((dir (if (> count 0) 1 -1)) |
| 890 | (count (abs count))) |
| 891 | (while (> count 0) |
| 892 | (let ((buffer (bs--current-buffer))) |
| 893 | (if buffer |
| 894 | (setq bs--marked-buffers (delq buffer bs--marked-buffers))) |
| 895 | (bs--update-current-line) |
| 896 | (bs-down dir)) |
| 897 | (setq count (1- count))))) |
| 898 | |
| 899 | (defun bs--show-config-message (what) |
| 900 | "Show message indicating the new showing status WHAT. |
| 901 | WHAT is a value of nil, `never', or `always'." |
| 902 | (bs-message-without-log (cond ((null what) |
| 903 | "Buffer will be shown normally.") |
| 904 | ((eq what 'never) |
| 905 | "Mark buffer to never be shown.") |
| 906 | (t "Mark buffer to show always.")))) |
| 907 | |
| 908 | (defun bs-delete () |
| 909 | "Kill buffer on current line." |
| 910 | (interactive) |
| 911 | (let ((current (bs--current-buffer)) |
| 912 | (inhibit-read-only t)) |
| 913 | (unless (kill-buffer current) |
| 914 | (error "Buffer was not deleted")) |
| 915 | (setq bs-current-list (delq current bs-current-list)) |
| 916 | (beginning-of-line) |
| 917 | (delete-region (point) (save-excursion |
| 918 | (end-of-line) |
| 919 | (if (eobp) (point) (1+ (point))))) |
| 920 | (if (eobp) |
| 921 | (progn |
| 922 | (backward-delete-char 1) |
| 923 | (beginning-of-line) |
| 924 | (recenter -1))) |
| 925 | (bs--set-window-height))) |
| 926 | |
| 927 | (defun bs-delete-backward () |
| 928 | "Like `bs-delete' but go to buffer in front of current." |
| 929 | (interactive) |
| 930 | (let ((on-last-line-p (save-excursion (end-of-line) (eobp)))) |
| 931 | (bs-delete) |
| 932 | (unless on-last-line-p |
| 933 | (bs-up 1)))) |
| 934 | |
| 935 | (defun bs-show-sorted () |
| 936 | "Show buffer list sorted by buffer name." |
| 937 | (interactive) |
| 938 | (setq bs--current-sort-function |
| 939 | (bs-next-config-aux (car bs--current-sort-function) |
| 940 | bs-sort-functions)) |
| 941 | (bs--redisplay) |
| 942 | (bs--goto-current-buffer) |
| 943 | (bs-message-without-log "Sorted %s" (car bs--current-sort-function))) |
| 944 | |
| 945 | (defun bs-apply-sort-faces (&optional sort-description) |
| 946 | "Set text properties for the sort described by SORT-DESCRIPTION. |
| 947 | SORT-DESCRIPTION is an element of `bs-sort-functions'. |
| 948 | Default is `bs--current-sort-function'." |
| 949 | (let ((sort-description (or sort-description |
| 950 | bs--current-sort-function))) |
| 951 | (save-excursion |
| 952 | (goto-char (point-min)) |
| 953 | (if (and (nth 2 sort-description) |
| 954 | (search-forward-regexp (nth 2 sort-description) nil t)) |
| 955 | (let ((inhibit-read-only t)) |
| 956 | (put-text-property (match-beginning 0) |
| 957 | (match-end 0) |
| 958 | 'face |
| 959 | (or (nth 3 sort-description) |
| 960 | 'region))))))) |
| 961 | |
| 962 | (defun bs-toggle-show-all () |
| 963 | "Toggle show all buffers / show buffers with current configuration." |
| 964 | (interactive) |
| 965 | (setq bs--show-all (not bs--show-all)) |
| 966 | (bs--redisplay) |
| 967 | (bs--goto-current-buffer) |
| 968 | (bs-message-without-log "%s" (bs--current-config-message))) |
| 969 | |
| 970 | (defun bs-toggle-readonly () |
| 971 | "Toggle read-only status for buffer on current line. |
| 972 | Uses function `vc-toggle-read-only'." |
| 973 | (interactive) |
| 974 | (let ((buffer (bs--current-buffer))) |
| 975 | (save-excursion |
| 976 | (set-buffer buffer) |
| 977 | (vc-toggle-read-only)) |
| 978 | (bs--update-current-line))) |
| 979 | |
| 980 | (defun bs-clear-modified () |
| 981 | "Set modified flag for buffer on current line to nil." |
| 982 | (interactive) |
| 983 | (let ((buffer (bs--current-buffer))) |
| 984 | (save-excursion |
| 985 | (set-buffer buffer) |
| 986 | (set-buffer-modified-p nil))) |
| 987 | (bs--update-current-line)) |
| 988 | |
| 989 | (defun bs--nth-wrapper (count fun &rest args) |
| 990 | "Call COUNT times function FUN with arguments ARGS." |
| 991 | (setq count (or count 1)) |
| 992 | (while (> count 0) |
| 993 | (apply fun args) |
| 994 | (setq count (1- count)))) |
| 995 | |
| 996 | (defun bs-up (arg) |
| 997 | "Move cursor vertically up ARG lines in Buffer Selection Menu." |
| 998 | (interactive "p") |
| 999 | (if (and arg (numberp arg) (< arg 0)) |
| 1000 | (bs--nth-wrapper (- arg) 'bs--down) |
| 1001 | (bs--nth-wrapper arg 'bs--up))) |
| 1002 | |
| 1003 | (defun bs--up () |
| 1004 | "Move cursor vertically up one line. |
| 1005 | If on top of buffer list go to last line." |
| 1006 | (interactive "p") |
| 1007 | (if (> (count-lines 1 (point)) bs-header-lines-length) |
| 1008 | (forward-line -1) |
| 1009 | (goto-char (point-max)) |
| 1010 | (beginning-of-line) |
| 1011 | (recenter -1))) |
| 1012 | |
| 1013 | (defun bs-down (arg) |
| 1014 | "Move cursor vertically down ARG lines in Buffer Selection Menu." |
| 1015 | (interactive "p") |
| 1016 | (if (and arg (numberp arg) (< arg 0)) |
| 1017 | (bs--nth-wrapper (- arg) 'bs--up) |
| 1018 | (bs--nth-wrapper arg 'bs--down))) |
| 1019 | |
| 1020 | (defun bs--down () |
| 1021 | "Move cursor vertically down one line. |
| 1022 | If at end of buffer list go to first line." |
| 1023 | (if (eq (line-end-position) (point-max)) |
| 1024 | (goto-line (1+ bs-header-lines-length)) |
| 1025 | (forward-line 1))) |
| 1026 | |
| 1027 | (defun bs-visits-non-file (buffer) |
| 1028 | "Return t or nil whether BUFFER visits no file. |
| 1029 | A value of t means BUFFER belongs to no file. |
| 1030 | A value of nil means BUFFER belongs to a file." |
| 1031 | (not (buffer-file-name buffer))) |
| 1032 | |
| 1033 | (defun bs-sort-buffer-interns-are-last (b1 b2) |
| 1034 | "Function for sorting internal buffers B1 and B2 at the end of all buffers." |
| 1035 | (string-match "^\\*" (buffer-name b2))) |
| 1036 | |
| 1037 | ;; ---------------------------------------------------------------------- |
| 1038 | ;; Configurations: |
| 1039 | ;; ---------------------------------------------------------------------- |
| 1040 | |
| 1041 | (defun bs-config-clear () |
| 1042 | "*Reset all variables which specify a configuration. |
| 1043 | These variables are `bs-dont-show-regexp', `bs-must-show-regexp', |
| 1044 | `bs-dont-show-function', `bs-must-show-function' and |
| 1045 | `bs-buffer-sort-function'." |
| 1046 | (setq bs-dont-show-regexp nil |
| 1047 | bs-must-show-regexp nil |
| 1048 | bs-dont-show-function nil |
| 1049 | bs-must-show-function nil |
| 1050 | bs-buffer-sort-function nil)) |
| 1051 | |
| 1052 | (defun bs-config--only-files () |
| 1053 | "Define a configuration for showing only buffers visiting a file." |
| 1054 | (bs-config-clear) |
| 1055 | (setq ;; I want to see *-buffers at the end |
| 1056 | bs-buffer-sort-function 'bs-sort-buffer-interns-are-last |
| 1057 | ;; Don't show files who don't belong to a file |
| 1058 | bs-dont-show-function 'bs-visits-non-file)) |
| 1059 | |
| 1060 | (defun bs-config--files-and-scratch () |
| 1061 | "Define a configuration for showing buffer *scratch* and file buffers." |
| 1062 | (bs-config-clear) |
| 1063 | (setq ;; I want to see *-buffers at the end |
| 1064 | bs-buffer-sort-function 'bs-sort-buffer-interns-are-last |
| 1065 | ;; Don't show files who don't belong to a file |
| 1066 | bs-dont-show-function 'bs-visits-non-file |
| 1067 | ;; Show *scratch* buffer. |
| 1068 | bs-must-show-regexp "^\\*scratch\\*$")) |
| 1069 | |
| 1070 | (defun bs-config--all () |
| 1071 | "Define a configuration for showing all buffers. |
| 1072 | Reset all according variables by `bs-config-clear'." |
| 1073 | (bs-config-clear)) |
| 1074 | |
| 1075 | (defun bs-config--all-intern-last () |
| 1076 | "Define a configuration for showing all buffers. |
| 1077 | Internal buffers appear at end of all buffers." |
| 1078 | (bs-config-clear) |
| 1079 | ;; I want to see *-buffers at the end |
| 1080 | (setq bs-buffer-sort-function 'bs-sort-buffer-interns-are-last)) |
| 1081 | |
| 1082 | (defun bs-set-configuration (name) |
| 1083 | "Set configuration to the one saved under string NAME in `bs-configurations'. |
| 1084 | When called interactively ask user for a configuration and apply selected |
| 1085 | configuration." |
| 1086 | (interactive (list (completing-read "Use configuration: " |
| 1087 | bs-configurations |
| 1088 | nil |
| 1089 | t))) |
| 1090 | (let ((list (assoc name bs-configurations))) |
| 1091 | (if list |
| 1092 | (if (listp list) |
| 1093 | (setq bs-current-configuration name |
| 1094 | bs-must-show-regexp (nth 1 list) |
| 1095 | bs-must-show-function (nth 2 list) |
| 1096 | bs-dont-show-regexp (nth 3 list) |
| 1097 | bs-dont-show-function (nth 4 list) |
| 1098 | bs-buffer-sort-function (nth 5 list)) |
| 1099 | ;; for backward compability |
| 1100 | (funcall (cdr list))) |
| 1101 | ;; else |
| 1102 | (ding) |
| 1103 | (bs-message-without-log "No bs-configuration named %S." name)))) |
| 1104 | |
| 1105 | (defun bs-help () |
| 1106 | "Help for `bs-show'." |
| 1107 | (interactive) |
| 1108 | (describe-function 'bs-mode)) |
| 1109 | |
| 1110 | (defun bs-next-config-aux (start-name list) |
| 1111 | "Get the next assoc after START-NAME in list LIST. |
| 1112 | Will return the first if START-NAME is at end." |
| 1113 | (let ((assocs list) |
| 1114 | (length (length list)) |
| 1115 | pos) |
| 1116 | (while (and assocs (not pos)) |
| 1117 | (if (string= (car (car assocs)) start-name) |
| 1118 | (setq pos (- length (length assocs)))) |
| 1119 | (setq assocs (cdr assocs))) |
| 1120 | (setq pos (1+ pos)) |
| 1121 | (if (eq pos length) |
| 1122 | (car list) |
| 1123 | (nth pos list)))) |
| 1124 | |
| 1125 | (defun bs-next-config (name) |
| 1126 | "Return next configuration with respect to configuration with name NAME." |
| 1127 | (bs-next-config-aux name bs-configurations)) |
| 1128 | |
| 1129 | (defun bs-select-next-configuration (&optional start-name) |
| 1130 | "Apply next configuration START-NAME and refresh buffer list. |
| 1131 | If START-NAME is nil the current configuration `bs-current-configuration' |
| 1132 | will be used." |
| 1133 | (interactive) |
| 1134 | (let ((config (bs-next-config (or start-name bs-current-configuration)))) |
| 1135 | (bs-set-configuration (car config)) |
| 1136 | (setq bs-default-configuration bs-current-configuration) |
| 1137 | (bs--redisplay t) |
| 1138 | (bs--set-window-height) |
| 1139 | (bs-message-without-log "Selected configuration: %s" (car config)))) |
| 1140 | |
| 1141 | (defun bs-show-in-buffer (list) |
| 1142 | "Display buffer list LIST in buffer *buffer-selection*. |
| 1143 | Select buffer *buffer-selection* and display buffers according to current |
| 1144 | configuration `bs-current-configuration'. Set window height, fontify buffer |
| 1145 | and move point to current buffer." |
| 1146 | (setq bs-current-list list) |
| 1147 | (switch-to-buffer (get-buffer-create "*buffer-selection*")) |
| 1148 | (bs-mode) |
| 1149 | (let* ((inhibit-read-only t) |
| 1150 | (map-fun (lambda (entry) |
| 1151 | (length (buffer-name entry)))) |
| 1152 | (max-length-of-names (apply 'max |
| 1153 | (cons 0 (mapcar map-fun list)))) |
| 1154 | (name-entry-length (min bs-maximal-buffer-name-column |
| 1155 | (max bs-minimal-buffer-name-column |
| 1156 | max-length-of-names)))) |
| 1157 | (erase-buffer) |
| 1158 | (setq bs--name-entry-length name-entry-length) |
| 1159 | (bs--show-header) |
| 1160 | (while list |
| 1161 | (bs--insert-one-entry (car list)) |
| 1162 | (insert "\n") |
| 1163 | (setq list (cdr list))) |
| 1164 | (delete-backward-char 1) |
| 1165 | (bs--set-window-height) |
| 1166 | (bs--goto-current-buffer) |
| 1167 | (font-lock-fontify-buffer) |
| 1168 | (bs-apply-sort-faces) |
| 1169 | (set-buffer-modified-p nil))) |
| 1170 | |
| 1171 | (defun bs-next-buffer (&optional buffer-list sorting-p) |
| 1172 | "Return next buffer and buffer list for buffer cycling in BUFFER-LIST. |
| 1173 | Ignore sorting when SORTING-P is nil. |
| 1174 | If BUFFER-LIST is nil the result of `bs-buffer-list' will be used as |
| 1175 | buffer list. The result is a cons of normally the second element of |
| 1176 | BUFFER-LIST and the buffer list used for buffer cycling." |
| 1177 | (let* ((bs--current-sort-function (if sorting-p |
| 1178 | bs--current-sort-function)) |
| 1179 | (bs-buffer-list (or buffer-list (bs-buffer-list)))) |
| 1180 | (cons (or (car (cdr bs-buffer-list)) |
| 1181 | (car bs-buffer-list) |
| 1182 | (current-buffer)) |
| 1183 | bs-buffer-list))) |
| 1184 | |
| 1185 | (defun bs-previous-buffer (&optional buffer-list sorting-p) |
| 1186 | "Return previous buffer and buffer list for buffer cycling in BUFFER-LIST. |
| 1187 | Ignore sorting when SORTING-P is nil. |
| 1188 | If BUFFER-LIST is nil the result of `bs-buffer-list' will be used as |
| 1189 | buffer list. The result is a cons of last element of BUFFER-LIST and the |
| 1190 | buffer list used for buffer cycling." |
| 1191 | (let* ((bs--current-sort-function (if sorting-p |
| 1192 | bs--current-sort-function)) |
| 1193 | (bs-buffer-list (or buffer-list (bs-buffer-list)))) |
| 1194 | (cons (or (car (last bs-buffer-list)) |
| 1195 | (current-buffer)) |
| 1196 | bs-buffer-list))) |
| 1197 | |
| 1198 | (defun bs-message-without-log (&rest args) |
| 1199 | "Like `message' but don't log it on the message log. |
| 1200 | All arguments ARGS are transferred to function `message'." |
| 1201 | (let ((message-log-max nil)) |
| 1202 | (apply 'message args))) |
| 1203 | |
| 1204 | (defvar bs--cycle-list nil |
| 1205 | "Current buffer list used for cycling.") |
| 1206 | |
| 1207 | ;;;###autoload |
| 1208 | (defun bs-cycle-next () |
| 1209 | "Select next buffer defined by buffer cycling. |
| 1210 | The buffers taking part in buffer cycling are defined |
| 1211 | by buffer configuration `bs-cycle-configuration-name'." |
| 1212 | (interactive) |
| 1213 | (let ((bs--buffer-coming-from (current-buffer)) |
| 1214 | (bs-dont-show-regexp bs-dont-show-regexp) |
| 1215 | (bs-must-show-regexp bs-must-show-regexp) |
| 1216 | (bs-dont-show-function bs-dont-show-function) |
| 1217 | (bs-must-show-function bs-must-show-function) |
| 1218 | (bs--show-all nil)) |
| 1219 | (bs-set-configuration (or bs-cycle-configuration-name bs-default-configuration)) |
| 1220 | (let ((bs-buffer-sort-function nil) |
| 1221 | (bs--current-sort-function nil)) |
| 1222 | (let* ((tupel (bs-next-buffer (if (or (eq last-command |
| 1223 | 'bs-cycle-next) |
| 1224 | (eq last-command |
| 1225 | 'bs-cycle-previous)) |
| 1226 | bs--cycle-list))) |
| 1227 | (next (car tupel)) |
| 1228 | (cycle-list (cdr tupel))) |
| 1229 | (setq bs--cycle-list (append (cdr cycle-list) |
| 1230 | (list (car cycle-list)))) |
| 1231 | (bury-buffer) |
| 1232 | (switch-to-buffer next) |
| 1233 | (bs-message-without-log "Next buffers: %s" |
| 1234 | (or (cdr bs--cycle-list) |
| 1235 | "this buffer")))))) |
| 1236 | |
| 1237 | |
| 1238 | ;;;###autoload |
| 1239 | (defun bs-cycle-previous () |
| 1240 | "Select previous buffer defined by buffer cycling. |
| 1241 | The buffers taking part in buffer cycling are defined |
| 1242 | by buffer configuration `bs-cycle-configuration-name'." |
| 1243 | (interactive) |
| 1244 | (let ((bs--buffer-coming-from (current-buffer)) |
| 1245 | (bs-dont-show-regexp bs-dont-show-regexp) |
| 1246 | (bs-must-show-regexp bs-must-show-regexp) |
| 1247 | (bs-dont-show-function bs-dont-show-function) |
| 1248 | (bs-must-show-function bs-must-show-function) |
| 1249 | (bs--show-all nil)) |
| 1250 | (bs-set-configuration (or bs-cycle-configuration-name bs-default-configuration)) |
| 1251 | (let ((bs-buffer-sort-function nil) |
| 1252 | (bs--current-sort-function nil)) |
| 1253 | (let* ((tupel (bs-previous-buffer (if (or (eq last-command |
| 1254 | 'bs-cycle-next) |
| 1255 | (eq last-command |
| 1256 | 'bs-cycle-previous)) |
| 1257 | bs--cycle-list))) |
| 1258 | (prev-buffer (car tupel)) |
| 1259 | (cycle-list (cdr tupel))) |
| 1260 | (setq bs--cycle-list (append (last cycle-list) |
| 1261 | (reverse (cdr (reverse cycle-list))))) |
| 1262 | (switch-to-buffer prev-buffer) |
| 1263 | (bs-message-without-log "Previous buffers: %s" |
| 1264 | (or (reverse (cdr bs--cycle-list)) |
| 1265 | "this buffer")))))) |
| 1266 | |
| 1267 | (defun bs--get-value (fun &optional args) |
| 1268 | "Apply function FUN with arguments ARGS. |
| 1269 | Return result of evaluation. Will return FUN if FUN is a number |
| 1270 | or a string." |
| 1271 | (cond ((numberp fun) |
| 1272 | fun) |
| 1273 | ((stringp fun) |
| 1274 | fun) |
| 1275 | (t (apply fun args)))) |
| 1276 | |
| 1277 | (defun bs--get-marked-string (start-buffer all-buffers) |
| 1278 | "Return a string which describes whether current buffer is marked. |
| 1279 | START-BUFFER is the buffer where we started buffer selection. |
| 1280 | ALL-BUFFERS is the list of buffer appearing in Buffer Selection Menu. |
| 1281 | The result string is one of `bs-string-current', `bs-string-current-marked', |
| 1282 | `bs-string-marked', `bs-string-show-normally', `bs-string-show-never', or |
| 1283 | `bs-string-show-always'." |
| 1284 | (cond ;; current buffer is the buffer we started buffer selection. |
| 1285 | ((eq (current-buffer) start-buffer) |
| 1286 | (if (memq (current-buffer) bs--marked-buffers) |
| 1287 | bs-string-current-marked ; buffer is marked |
| 1288 | bs-string-current)) |
| 1289 | ;; current buffer is marked |
| 1290 | ((memq (current-buffer) bs--marked-buffers) |
| 1291 | bs-string-marked) |
| 1292 | ;; current buffer hasn't a special mark. |
| 1293 | ((null bs-buffer-show-mark) |
| 1294 | bs-string-show-normally) |
| 1295 | ;; current buffer has a mark not to show itself. |
| 1296 | ((eq bs-buffer-show-mark 'never) |
| 1297 | bs-string-show-never) |
| 1298 | ;; otherwise current buffer is marked to show always. |
| 1299 | (t |
| 1300 | bs-string-show-always))) |
| 1301 | |
| 1302 | (defun bs--get-modified-string (start-buffer all-buffers) |
| 1303 | "Return a string which describes whether current buffer is modified. |
| 1304 | START-BUFFER is the buffer where we started buffer selection. |
| 1305 | ALL-BUFFERS is the list of buffer appearing in Buffer Selection Menu." |
| 1306 | (if (buffer-modified-p) "*" " ")) |
| 1307 | |
| 1308 | (defun bs--get-readonly-string (start-buffer all-buffers) |
| 1309 | "Return a string which describes whether current buffer is read only. |
| 1310 | START-BUFFER is the buffer where we started buffer selection. |
| 1311 | ALL-BUFFERS is the list of buffer appearing in Buffer Selection Menu." |
| 1312 | (if buffer-read-only "%" " ")) |
| 1313 | |
| 1314 | (defun bs--get-size-string (start-buffer all-buffers) |
| 1315 | "Return a string which describes the size of current buffer. |
| 1316 | START-BUFFER is the buffer where we started buffer selection. |
| 1317 | ALL-BUFFERS is the list of buffer appearing in Buffer Selection Menu." |
| 1318 | (int-to-string (buffer-size))) |
| 1319 | |
| 1320 | (defun bs--get-name (start-buffer all-buffers) |
| 1321 | "Return name of current buffer for Buffer Selection Menu. |
| 1322 | The name of current buffer gets additional text properties |
| 1323 | for mouse highlighting. |
| 1324 | START-BUFFER is the buffer where we started buffer selection. |
| 1325 | ALL-BUFFERS is the list of buffer appearing in Buffer Selection Menu." |
| 1326 | (propertize (buffer-name) |
| 1327 | 'help-echo "mouse-2: select this buffer, mouse-3: select in other frame" |
| 1328 | 'mouse-face 'highlight)) |
| 1329 | |
| 1330 | (defun bs--get-mode-name (start-buffer all-buffers) |
| 1331 | "Return the name of mode of current buffer for Buffer Selection Menu. |
| 1332 | START-BUFFER is the buffer where we started buffer selection. |
| 1333 | ALL-BUFFERS is the list of buffer appearing in Buffer Selection Menu." |
| 1334 | mode-name) |
| 1335 | |
| 1336 | (defun bs--get-file-name (start-buffer all-buffers) |
| 1337 | "Return string for column 'File' in Buffer Selection Menu. |
| 1338 | This is the variable `buffer-file-name' of current buffer. |
| 1339 | If current mode is `dired-mode' or `shell-mode' it returns the |
| 1340 | default directory. |
| 1341 | START-BUFFER is the buffer where we started buffer selection. |
| 1342 | ALL-BUFFERS is the list of buffer appearing in Buffer Selection Menu." |
| 1343 | (propertize (if (member major-mode '(shell-mode dired-mode)) |
| 1344 | default-directory |
| 1345 | (or buffer-file-name "")) |
| 1346 | 'mouse-face 'highlight |
| 1347 | 'help-echo "mouse-2: select this buffer, mouse-3: select in other frame")) |
| 1348 | |
| 1349 | (defun bs--insert-one-entry (buffer) |
| 1350 | "Generate one entry for buffer BUFFER in Buffer Selection Menu. |
| 1351 | It goes over all columns described in `bs-attributes-list' |
| 1352 | and evaluates corresponding string. Inserts string in current buffer; |
| 1353 | normally *buffer-selection*." |
| 1354 | (let ((string "") |
| 1355 | (columns bs-attributes-list) |
| 1356 | (to-much 0) |
| 1357 | (apply-args (append (list bs--buffer-coming-from bs-current-list)))) |
| 1358 | (save-excursion |
| 1359 | (while columns |
| 1360 | (set-buffer buffer) |
| 1361 | (let ((min (bs--get-value (nth 1 (car columns)))) |
| 1362 | ;;(max (bs--get-value (nth 2 (car columns)))) refered no more |
| 1363 | (align (nth 3 (car columns))) |
| 1364 | (fun (nth 4 (car columns))) |
| 1365 | (val nil) |
| 1366 | new-string) |
| 1367 | (setq val (bs--get-value fun apply-args)) |
| 1368 | (setq new-string (bs--format-aux val align (- min to-much))) |
| 1369 | (setq string (concat string new-string)) |
| 1370 | (if (> (length new-string) min) |
| 1371 | (setq to-much (- (length new-string) min))) |
| 1372 | ) ; let |
| 1373 | (setq columns (cdr columns)))) |
| 1374 | (insert string) |
| 1375 | string)) |
| 1376 | |
| 1377 | (defun bs--format-aux (string align len) |
| 1378 | "Generate a string with STRING with alignment ALIGN and length LEN. |
| 1379 | ALIGN is one of the symbols `left', `middle', or `right'." |
| 1380 | (let* ((width (length string)) |
| 1381 | (len (max len width))) |
| 1382 | (format (format "%%%s%ds" (if (eq align 'right) "" "-") len) |
| 1383 | (if (eq align 'middle) |
| 1384 | (concat (make-string (/ (- len width) 2) ?\s) string) |
| 1385 | string)))) |
| 1386 | |
| 1387 | (defun bs--show-header () |
| 1388 | "Insert header for Buffer Selection Menu in current buffer." |
| 1389 | (mapcar '(lambda (string) |
| 1390 | (insert string "\n")) |
| 1391 | (bs--create-header))) |
| 1392 | |
| 1393 | (defun bs--get-name-length () |
| 1394 | "Return value of `bs--name-entry-length'." |
| 1395 | bs--name-entry-length) |
| 1396 | |
| 1397 | (defun bs--create-header () |
| 1398 | "Return all header lines used in Buffer Selection Menu as a list of strings." |
| 1399 | (list (mapconcat (lambda (column) |
| 1400 | (bs--format-aux (bs--get-value (car column)) |
| 1401 | (nth 3 column) ; align |
| 1402 | (bs--get-value (nth 1 column)))) |
| 1403 | bs-attributes-list |
| 1404 | "") |
| 1405 | (mapconcat (lambda (column) |
| 1406 | (let ((length (length (bs--get-value (car column))))) |
| 1407 | (bs--format-aux (make-string length ?-) |
| 1408 | (nth 3 column) ; align |
| 1409 | (bs--get-value (nth 1 column))))) |
| 1410 | bs-attributes-list |
| 1411 | ""))) |
| 1412 | |
| 1413 | (defun bs--show-with-configuration (name &optional arg) |
| 1414 | "Display buffer list of configuration with name NAME. |
| 1415 | Set configuration NAME and determine window for Buffer Selection Menu. |
| 1416 | Unless current buffer is buffer *buffer-selection* we have to save |
| 1417 | the buffer we started Buffer Selection Menu and the current window |
| 1418 | configuration to restore buffer and window configuration after a |
| 1419 | selection. If there is already a window displaying *buffer-selection* |
| 1420 | select this window for Buffer Selection Menu. Otherwise open a new |
| 1421 | window. |
| 1422 | The optional argument ARG is the prefix argument when calling a function |
| 1423 | for buffer selection." |
| 1424 | (bs-set-configuration name) |
| 1425 | (let ((bs--show-all (or bs--show-all arg))) |
| 1426 | (unless (string= "*buffer-selection*" (buffer-name)) |
| 1427 | ;; Only when not in buffer *buffer-selection* |
| 1428 | ;; we have to set the buffer we started the command |
| 1429 | (progn |
| 1430 | (setq bs--buffer-coming-from (current-buffer)) |
| 1431 | (setq bs--window-config-coming-from (current-window-configuration)))) |
| 1432 | (let ((liste (bs-buffer-list)) |
| 1433 | (active-window (bs--window-for-buffer "*buffer-selection*"))) |
| 1434 | (if active-window |
| 1435 | (select-window active-window) |
| 1436 | (if (> (window-height (selected-window)) 7) |
| 1437 | (progn |
| 1438 | (split-window-vertically) |
| 1439 | (other-window 1)))) |
| 1440 | (bs-show-in-buffer liste) |
| 1441 | (bs-message-without-log "%s" (bs--current-config-message))))) |
| 1442 | |
| 1443 | (defun bs--configuration-name-for-prefix-arg (prefix-arg) |
| 1444 | "Convert prefix argument PREFIX-ARG to a name of a buffer configuration. |
| 1445 | If PREFIX-ARG is nil return `bs-default-configuration'. |
| 1446 | If PREFIX-ARG is an integer return PREFIX-ARG element of `bs-configurations'. |
| 1447 | Otherwise return `bs-alternative-configuration'." |
| 1448 | (cond ;; usually activation |
| 1449 | ((null prefix-arg) |
| 1450 | bs-default-configuration) |
| 1451 | ;; call with integer as prefix argument |
| 1452 | ((integerp prefix-arg) |
| 1453 | (if (and (< 0 prefix-arg) (<= prefix-arg (length bs-configurations))) |
| 1454 | (car (nth (1- prefix-arg) bs-configurations)) |
| 1455 | bs-default-configuration)) |
| 1456 | ;; call by prefix argument C-u |
| 1457 | (t bs-alternative-configuration))) |
| 1458 | |
| 1459 | ;; ---------------------------------------------------------------------- |
| 1460 | ;; Main function bs-customize and bs-show |
| 1461 | ;; ---------------------------------------------------------------------- |
| 1462 | |
| 1463 | ;;;###autoload |
| 1464 | (defun bs-customize () |
| 1465 | "Customization of group bs for Buffer Selection Menu." |
| 1466 | (interactive) |
| 1467 | (customize-group "bs")) |
| 1468 | |
| 1469 | ;;;###autoload |
| 1470 | (defun bs-show (arg) |
| 1471 | "Make a menu of buffers so you can manipulate buffers or the buffer list. |
| 1472 | \\<bs-mode-map> |
| 1473 | There are many key commands similar to `Buffer-menu-mode' for |
| 1474 | manipulating buffer list and buffers itself. |
| 1475 | User can move with [up] or [down], select a buffer |
| 1476 | by \\[bs-select] or [SPC]\n |
| 1477 | Type \\[bs-kill] to leave Buffer Selection Menu without a selection. |
| 1478 | Type \\[bs-help] after invocation to get help on commands available. |
| 1479 | With prefix argument ARG show a different buffer list. Function |
| 1480 | `bs--configuration-name-for-prefix-arg' determine accordingly |
| 1481 | name of buffer configuration." |
| 1482 | (interactive "P") |
| 1483 | (setq bs--marked-buffers nil) |
| 1484 | (bs--show-with-configuration (bs--configuration-name-for-prefix-arg arg))) |
| 1485 | |
| 1486 | ;; Now provide feature bs |
| 1487 | (provide 'bs) |
| 1488 | |
| 1489 | ;;; arch-tag: c0d9ab34-bf06-4368-ae9d-af88878e6802 |
| 1490 | ;;; bs.el ends here |