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