diff options
| author | Juanma Barranquero | 2007-10-16 10:40:02 +0000 |
|---|---|---|
| committer | Juanma Barranquero | 2007-10-16 10:40:02 +0000 |
| commit | e749f5762b6c8a7e531918a3c0e771609d1ba016 (patch) | |
| tree | 555faeeb089b1e26e8ab9d925639c2063b260173 /lisp | |
| parent | 11fb4bdbbdab3e17e020d9ed4a6c754cdfb89167 (diff) | |
| download | emacs-e749f5762b6c8a7e531918a3c0e771609d1ba016.tar.gz emacs-e749f5762b6c8a7e531918a3c0e771609d1ba016.zip | |
(bs--make-header-match-string, bs-show-in-buffer, bs--nth-wrapper): Simplify.
(bs-select, bs--insert-one-entry): Simplify. Use `when'.
(bs-buffer-list): Simplify. Use `when'. Use `string-match-p'.
(bs-sort-buffer-interns-are-last): Use `string-match-p'.
(bs-attributes-list, bs-max-window-height, bs-must-always-show-regexp,
bs-maximal-buffer-name-column, bs-minimal-buffer-name-column, bs-configurations,
bs-default-configuration, bs-alternative-configuration,
bs-cycle-configuration-name, bs-string-show-always, bs-string-show-never,
bs-string-current, bs-string-current-marked, bs-string-marked,
bs-string-show-normally, bs-sort-functions, bs-default-sort-name):
Remove * in docstrings.
(bs--redisplay, bs--goto-current-buffer, bs--current-buffer, bs-delete,
bs-apply-sort-faces, bs-next-config-aux): Use `when'.
(bs--window-config-coming-from): Revert 2006-11-09 change.
(bs--restore-window-config): Keep the selected frame.
(bs--track-window-changes, bs--remove-hooks): New functions.
(bs-mode): Use `define-derived-mode'. Set hook to track window changes.
(bs--create-header): Remove.
(bs--create-header-line): New function, based on `bs--create-header'.
(bs--show-header): Use `bs--create-header-line'.
(bs--show-with-configuration): Revert 2006-11-09 change.
Don't reuse window unless it is visible on the selected frame.
Restore window configuration (possibly in a different frame)
before creating any window.
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/ChangeLog | 28 | ||||
| -rw-r--r-- | lisp/bs.el | 283 |
2 files changed, 167 insertions, 144 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 17135a37a33..69919bdec0f 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,31 @@ | |||
| 1 | 2007-10-16 Juanma Barranquero <lekktu@gmail.com> | ||
| 2 | |||
| 3 | * bs.el (bs--make-header-match-string, bs-show-in-buffer) | ||
| 4 | (bs--nth-wrapper): Simplify. | ||
| 5 | (bs-select, bs--insert-one-entry): Simplify. Use `when'. | ||
| 6 | (bs-buffer-list): Simplify. Use `when'. Use `string-match-p'. | ||
| 7 | (bs-sort-buffer-interns-are-last): Use `string-match-p'. | ||
| 8 | (bs-attributes-list, bs-max-window-height, bs-must-always-show-regexp) | ||
| 9 | (bs-maximal-buffer-name-column, bs-minimal-buffer-name-column) | ||
| 10 | (bs-configurations, bs-default-configuration) | ||
| 11 | (bs-alternative-configuration, bs-cycle-configuration-name) | ||
| 12 | (bs-string-show-always, bs-string-show-never, bs-string-current) | ||
| 13 | (bs-string-current-marked, bs-string-marked, bs-string-show-normally) | ||
| 14 | (bs-sort-functions, bs-default-sort-name): Remove * in docstrings. | ||
| 15 | (bs--redisplay, bs--goto-current-buffer, bs--current-buffer, bs-delete) | ||
| 16 | (bs-apply-sort-faces, bs-next-config-aux): Use `when'. | ||
| 17 | (bs--window-config-coming-from): Revert 2006-11-09 change. | ||
| 18 | (bs--restore-window-config): Keep the selected frame. | ||
| 19 | (bs--track-window-changes, bs--remove-hooks): New functions. | ||
| 20 | (bs-mode): Use `define-derived-mode'. Set hook to track window changes. | ||
| 21 | (bs--create-header): Remove. | ||
| 22 | (bs--create-header-line): New function, based on `bs--create-header'. | ||
| 23 | (bs--show-header): Use `bs--create-header-line'. | ||
| 24 | (bs--show-with-configuration): Revert 2006-11-09 change. | ||
| 25 | Don't reuse window unless it is visible on the selected frame. | ||
| 26 | Restore window configuration (possibly in a different frame) | ||
| 27 | before creating any window. | ||
| 28 | |||
| 1 | 2007-10-16 Glenn Morris <rgm@gnu.org> | 29 | 2007-10-16 Glenn Morris <rgm@gnu.org> |
| 2 | 30 | ||
| 3 | * simple.el (blink-matching-open): Don't report false errors with | 31 | * simple.el (blink-matching-open): Don't report false errors with |
diff --git a/lisp/bs.el b/lisp/bs.el index 6390bd2dd81..bb2dbae83c0 100644 --- a/lisp/bs.el +++ b/lisp/bs.el | |||
| @@ -158,7 +158,7 @@ | |||
| 158 | ("" 2 2 left " ") | 158 | ("" 2 2 left " ") |
| 159 | ("File" 12 12 left bs--get-file-name) | 159 | ("File" 12 12 left bs--get-file-name) |
| 160 | ("" 2 2 left " ")) | 160 | ("" 2 2 left " ")) |
| 161 | "*List specifying the layout of a Buffer Selection Menu buffer. | 161 | "List specifying the layout of a Buffer Selection Menu buffer. |
| 162 | Each entry specifies a column and is a list of the form of: | 162 | Each entry specifies a column and is a list of the form of: |
| 163 | \(HEADER MINIMUM-LENGTH MAXIMUM-LENGTH ALIGNMENT FUN-OR-STRING) | 163 | \(HEADER MINIMUM-LENGTH MAXIMUM-LENGTH ALIGNMENT FUN-OR-STRING) |
| 164 | 164 | ||
| @@ -180,12 +180,7 @@ return a string representing the column's value." | |||
| 180 | 180 | ||
| 181 | (defun bs--make-header-match-string () | 181 | (defun bs--make-header-match-string () |
| 182 | "Return a regexp matching the first line of a Buffer Selection Menu buffer." | 182 | "Return a regexp matching the first line of a Buffer Selection Menu buffer." |
| 183 | (let ((res "^\\(") | 183 | (concat "^\\(" (mapconcat #'car bs-attributes-list " *") " *$\\)")) |
| 184 | (ele bs-attributes-list)) | ||
| 185 | (while ele | ||
| 186 | (setq res (concat res (car (car ele)) " *")) | ||
| 187 | (setq ele (cdr ele))) | ||
| 188 | (concat res "$\\)"))) | ||
| 189 | 184 | ||
| 190 | ;; Font-Lock-Settings | 185 | ;; Font-Lock-Settings |
| 191 | (defvar bs-mode-font-lock-keywords | 186 | (defvar bs-mode-font-lock-keywords |
| @@ -206,7 +201,7 @@ return a string representing the column's value." | |||
| 206 | "Default font lock expressions for Buffer Selection Menu.") | 201 | "Default font lock expressions for Buffer Selection Menu.") |
| 207 | 202 | ||
| 208 | (defcustom bs-max-window-height 20 | 203 | (defcustom bs-max-window-height 20 |
| 209 | "*Maximal window height of Buffer Selection Menu." | 204 | "Maximal window height of Buffer Selection Menu." |
| 210 | :group 'bs-appearance | 205 | :group 'bs-appearance |
| 211 | :type 'integer) | 206 | :type 'integer) |
| 212 | 207 | ||
| @@ -224,7 +219,7 @@ it is reset to nil. Use `bs-must-always-show-regexp' to specify buffers | |||
| 224 | that must always be shown regardless of the configuration.") | 219 | that must always be shown regardless of the configuration.") |
| 225 | 220 | ||
| 226 | (defcustom bs-must-always-show-regexp nil | 221 | (defcustom bs-must-always-show-regexp nil |
| 227 | "*Regular expression for specifying buffers to show always. | 222 | "Regular expression for specifying buffers to show always. |
| 228 | A buffer whose name matches this regular expression will | 223 | A buffer whose name matches this regular expression will |
| 229 | be shown regardless of current configuration of Buffer Selection Menu." | 224 | be shown regardless of current configuration of Buffer Selection Menu." |
| 230 | :group 'bs | 225 | :group 'bs |
| @@ -246,7 +241,7 @@ The function gets two arguments - the buffers to compare. | |||
| 246 | It must return non-nil if the first buffer should sort before the second.") | 241 | It must return non-nil if the first buffer should sort before the second.") |
| 247 | 242 | ||
| 248 | (defcustom bs-maximal-buffer-name-column 45 | 243 | (defcustom bs-maximal-buffer-name-column 45 |
| 249 | "*Maximum column width for buffer names. | 244 | "Maximum column width for buffer names. |
| 250 | The column for buffer names has dynamic width. The width depends on | 245 | 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 | 246 | maximal and minimal length of names of buffers to show. The maximal |
| 252 | width is bounded by `bs-maximal-buffer-name-column'. | 247 | width is bounded by `bs-maximal-buffer-name-column'. |
| @@ -255,7 +250,7 @@ See also `bs-minimal-buffer-name-column'." | |||
| 255 | :type 'integer) | 250 | :type 'integer) |
| 256 | 251 | ||
| 257 | (defcustom bs-minimal-buffer-name-column 15 | 252 | (defcustom bs-minimal-buffer-name-column 15 |
| 258 | "*Minimum column width for buffer names. | 253 | "Minimum column width for buffer names. |
| 259 | The column for buffer names has dynamic width. The width depends on | 254 | 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 | 255 | maximal and minimal length of names of buffers to show. The minimal |
| 261 | width is bounded by `bs-minimal-buffer-name-column'. | 256 | width is bounded by `bs-minimal-buffer-name-column'. |
| @@ -272,7 +267,7 @@ See also `bs-maximal-buffer-name-column'." | |||
| 272 | ("files-and-scratch" "^\\*scratch\\*$" nil nil bs-visits-non-file | 267 | ("files-and-scratch" "^\\*scratch\\*$" nil nil bs-visits-non-file |
| 273 | bs-sort-buffer-interns-are-last) | 268 | bs-sort-buffer-interns-are-last) |
| 274 | ("all-intern-last" nil nil nil nil bs-sort-buffer-interns-are-last)) | 269 | ("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. | 270 | "List of all configurations you can use in the Buffer Selection Menu. |
| 276 | A configuration describes which buffers appear in Buffer Selection Menu | 271 | A configuration describes which buffers appear in Buffer Selection Menu |
| 277 | and also the order of buffers. A configuration is a list with | 272 | and also the order of buffers. A configuration is a list with |
| 278 | six elements. The first element is a string and describes the configuration. | 273 | six elements. The first element is a string and describes the configuration. |
| @@ -284,7 +279,7 @@ By setting these variables you define a configuration." | |||
| 284 | :type '(repeat sexp)) | 279 | :type '(repeat sexp)) |
| 285 | 280 | ||
| 286 | (defcustom bs-default-configuration "files" | 281 | (defcustom bs-default-configuration "files" |
| 287 | "*Name of default configuration used by the Buffer Selection Menu. | 282 | "Name of default configuration used by the Buffer Selection Menu. |
| 288 | \\<bs-mode-map> | 283 | \\<bs-mode-map> |
| 289 | Will be changed using key \\[bs-select-next-configuration]. | 284 | Will be changed using key \\[bs-select-next-configuration]. |
| 290 | Must be a string used in `bs-configurations' for naming a configuration." | 285 | Must be a string used in `bs-configurations' for naming a configuration." |
| @@ -292,7 +287,7 @@ Must be a string used in `bs-configurations' for naming a configuration." | |||
| 292 | :type 'string) | 287 | :type 'string) |
| 293 | 288 | ||
| 294 | (defcustom bs-alternative-configuration "all" | 289 | (defcustom bs-alternative-configuration "all" |
| 295 | "*Name of configuration used when calling `bs-show' with \ | 290 | "Name of configuration used when calling `bs-show' with \ |
| 296 | \\[universal-argument] as prefix key. | 291 | \\[universal-argument] as prefix key. |
| 297 | Must be a string used in `bs-configurations' for naming a configuration." | 292 | Must be a string used in `bs-configurations' for naming a configuration." |
| 298 | :group 'bs | 293 | :group 'bs |
| @@ -303,7 +298,7 @@ Must be a string used in `bs-configurations' for naming a configuration." | |||
| 303 | Must be a string used in `bs-configurations' for naming a configuration.") | 298 | Must be a string used in `bs-configurations' for naming a configuration.") |
| 304 | 299 | ||
| 305 | (defcustom bs-cycle-configuration-name nil | 300 | (defcustom bs-cycle-configuration-name nil |
| 306 | "*Name of configuration used when cycling through the buffer list. | 301 | "Name of configuration used when cycling through the buffer list. |
| 307 | A value of nil means to use current configuration `bs-default-configuration'. | 302 | 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." | 303 | Must be a string used in `bs-configurations' for naming a configuration." |
| 309 | :group 'bs | 304 | :group 'bs |
| @@ -311,32 +306,32 @@ Must be a string used in `bs-configurations' for naming a configuration." | |||
| 311 | string)) | 306 | string)) |
| 312 | 307 | ||
| 313 | (defcustom bs-string-show-always "+" | 308 | (defcustom bs-string-show-always "+" |
| 314 | "*String added in column 1 indicating a buffer will always be shown." | 309 | "String added in column 1 indicating a buffer will always be shown." |
| 315 | :group 'bs-appearance | 310 | :group 'bs-appearance |
| 316 | :type 'string) | 311 | :type 'string) |
| 317 | 312 | ||
| 318 | (defcustom bs-string-show-never "-" | 313 | (defcustom bs-string-show-never "-" |
| 319 | "*String added in column 1 indicating a buffer will never be shown." | 314 | "String added in column 1 indicating a buffer will never be shown." |
| 320 | :group 'bs-appearance | 315 | :group 'bs-appearance |
| 321 | :type 'string) | 316 | :type 'string) |
| 322 | 317 | ||
| 323 | (defcustom bs-string-current "." | 318 | (defcustom bs-string-current "." |
| 324 | "*String added in column 1 indicating the current buffer." | 319 | "String added in column 1 indicating the current buffer." |
| 325 | :group 'bs-appearance | 320 | :group 'bs-appearance |
| 326 | :type 'string) | 321 | :type 'string) |
| 327 | 322 | ||
| 328 | (defcustom bs-string-current-marked "#" | 323 | (defcustom bs-string-current-marked "#" |
| 329 | "*String added in column 1 indicating the current buffer when it is marked." | 324 | "String added in column 1 indicating the current buffer when it is marked." |
| 330 | :group 'bs-appearance | 325 | :group 'bs-appearance |
| 331 | :type 'string) | 326 | :type 'string) |
| 332 | 327 | ||
| 333 | (defcustom bs-string-marked ">" | 328 | (defcustom bs-string-marked ">" |
| 334 | "*String added in column 1 indicating a marked buffer." | 329 | "String added in column 1 indicating a marked buffer." |
| 335 | :group 'bs-appearance | 330 | :group 'bs-appearance |
| 336 | :type 'string) | 331 | :type 'string) |
| 337 | 332 | ||
| 338 | (defcustom bs-string-show-normally " " | 333 | (defcustom bs-string-show-normally " " |
| 339 | "*String added in column 1 indicating an unmarked buffer." | 334 | "String added in column 1 indicating an unmarked buffer." |
| 340 | :group 'bs-appearance | 335 | :group 'bs-appearance |
| 341 | :type 'string) | 336 | :type 'string) |
| 342 | 337 | ||
| @@ -390,7 +385,7 @@ A value of `always' means to show buffer regardless of the configuration.") | |||
| 390 | ("by mode" bs--sort-by-mode "Mode" region) | 385 | ("by mode" bs--sort-by-mode "Mode" region) |
| 391 | ("by filename" bs--sort-by-filename "File" region) | 386 | ("by filename" bs--sort-by-filename "File" region) |
| 392 | ("by nothing" nil nil nil)) | 387 | ("by nothing" nil nil nil)) |
| 393 | "*List of all possible sorting aspects for Buffer Selection Menu. | 388 | "List of all possible sorting aspects for Buffer Selection Menu. |
| 394 | You can add a new entry with a call to `bs-define-sort-function'. | 389 | You can add a new entry with a call to `bs-define-sort-function'. |
| 395 | Each element is a list of four elements (NAME FUNCTION REGEXP-FOR-SORTING FACE). | 390 | Each element is a list of four elements (NAME FUNCTION REGEXP-FOR-SORTING FACE). |
| 396 | NAME specifies the sort order defined by function FUNCTION. | 391 | NAME specifies the sort order defined by function FUNCTION. |
| @@ -425,7 +420,7 @@ The new sort aspect will be inserted into list `bs-sort-functions'." | |||
| 425 | This is an element of `bs-sort-functions'.") | 420 | This is an element of `bs-sort-functions'.") |
| 426 | 421 | ||
| 427 | (defcustom bs-default-sort-name "by nothing" | 422 | (defcustom bs-default-sort-name "by nothing" |
| 428 | "*Name of default sort behavior. | 423 | "Name of default sort behavior. |
| 429 | Must be \"by nothing\" or a string used in `bs-sort-functions' for | 424 | Must be \"by nothing\" or a string used in `bs-sort-functions' for |
| 430 | naming a sort behavior. Default is \"by nothing\" which means no sorting." | 425 | naming a sort behavior. Default is \"by nothing\" which means no sorting." |
| 431 | :group 'bs | 426 | :group 'bs |
| @@ -445,7 +440,6 @@ defined by current configuration `bs-current-configuration'.") | |||
| 445 | 440 | ||
| 446 | (defvar bs--window-config-coming-from nil | 441 | (defvar bs--window-config-coming-from nil |
| 447 | "Window configuration before starting Buffer Selection Menu.") | 442 | "Window configuration before starting Buffer Selection Menu.") |
| 448 | (make-variable-frame-local 'bs--window-config-coming-from) | ||
| 449 | 443 | ||
| 450 | (defvar bs--intern-show-never "^ \\|\\*buffer-selection\\*" | 444 | (defvar bs--intern-show-never "^ \\|\\*buffer-selection\\*" |
| 451 | "Regular expression specifying which buffers never to show. | 445 | "Regular expression specifying which buffers never to show. |
| @@ -529,45 +523,43 @@ a special function. SORT-DESCRIPTION is an element of `bs-sort-functions'." | |||
| 529 | (setq sort-description (or sort-description bs--current-sort-function) | 523 | (setq sort-description (or sort-description bs--current-sort-function) |
| 530 | list (or list (buffer-list))) | 524 | list (or list (buffer-list))) |
| 531 | (let ((result nil)) | 525 | (let ((result nil)) |
| 532 | (while list | 526 | (dolist (buf list) |
| 533 | (let* ((buffername (buffer-name (car list))) | 527 | (let* ((buffername (buffer-name buf)) |
| 534 | (int-show-never (string-match bs--intern-show-never buffername)) | 528 | (int-show-never (string-match-p bs--intern-show-never buffername)) |
| 535 | (ext-show-never (and bs-dont-show-regexp | 529 | (ext-show-never (and bs-dont-show-regexp |
| 536 | (string-match bs-dont-show-regexp | 530 | (string-match-p bs-dont-show-regexp |
| 537 | buffername))) | 531 | buffername))) |
| 538 | (extern-must-show (or (and bs-must-always-show-regexp | 532 | (extern-must-show (or (and bs-must-always-show-regexp |
| 539 | (string-match | 533 | (string-match-p |
| 540 | bs-must-always-show-regexp | 534 | bs-must-always-show-regexp |
| 541 | buffername)) | 535 | buffername)) |
| 542 | (and bs-must-show-regexp | 536 | (and bs-must-show-regexp |
| 543 | (string-match bs-must-show-regexp | 537 | (string-match-p bs-must-show-regexp |
| 544 | buffername)))) | 538 | buffername)))) |
| 545 | (extern-show-never-from-fun (and bs-dont-show-function | 539 | (extern-show-never-from-fun (and bs-dont-show-function |
| 546 | (funcall bs-dont-show-function | 540 | (funcall bs-dont-show-function |
| 547 | (car list)))) | 541 | buf))) |
| 548 | (extern-must-show-from-fun (and bs-must-show-function | 542 | (extern-must-show-from-fun (and bs-must-show-function |
| 549 | (funcall bs-must-show-function | 543 | (funcall bs-must-show-function |
| 550 | (car list)))) | 544 | buf))) |
| 551 | (show-flag (buffer-local-value 'bs-buffer-show-mark (car list)))) | 545 | (show-flag (buffer-local-value 'bs-buffer-show-mark buf))) |
| 552 | (if (or (eq show-flag 'always) | 546 | (when (or (eq show-flag 'always) |
| 553 | (and (or bs--show-all (not (eq show-flag 'never))) | 547 | (and (or bs--show-all (not (eq show-flag 'never))) |
| 554 | (not int-show-never) | 548 | (not int-show-never) |
| 555 | (or bs--show-all | 549 | (or bs--show-all |
| 556 | extern-must-show | 550 | extern-must-show |
| 557 | extern-must-show-from-fun | 551 | extern-must-show-from-fun |
| 558 | (and (not ext-show-never) | 552 | (and (not ext-show-never) |
| 559 | (not extern-show-never-from-fun))))) | 553 | (not extern-show-never-from-fun))))) |
| 560 | (setq result (cons (car list) | 554 | (setq result (cons buf result))))) |
| 561 | result))) | ||
| 562 | (setq list (cdr list)))) | ||
| 563 | (setq result (reverse result)) | 555 | (setq result (reverse result)) |
| 564 | ;; The current buffer which was the start point of bs should be an element | 556 | ;; 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 | 557 | ;; of result list, so that we can leave with space and be back in the |
| 566 | ;; buffer we started bs-show. | 558 | ;; buffer we started bs-show. |
| 567 | (if (and bs--buffer-coming-from | 559 | (when (and bs--buffer-coming-from |
| 568 | (buffer-live-p bs--buffer-coming-from) | 560 | (buffer-live-p bs--buffer-coming-from) |
| 569 | (not (memq bs--buffer-coming-from result))) | 561 | (not (memq bs--buffer-coming-from result))) |
| 570 | (setq result (cons bs--buffer-coming-from result))) | 562 | (setq result (cons bs--buffer-coming-from result))) |
| 571 | ;; sorting | 563 | ;; sorting |
| 572 | (if (and sort-description | 564 | (if (and sort-description |
| 573 | (nth 1 sort-description)) | 565 | (nth 1 sort-description)) |
| @@ -587,8 +579,8 @@ If KEEP-LINE-P is non-nil the point will stay on current line. | |||
| 587 | SORT-DESCRIPTION is an element of `bs-sort-functions'." | 579 | SORT-DESCRIPTION is an element of `bs-sort-functions'." |
| 588 | (let ((line (1+ (count-lines 1 (point))))) | 580 | (let ((line (1+ (count-lines 1 (point))))) |
| 589 | (bs-show-in-buffer (bs-buffer-list nil sort-description)) | 581 | (bs-show-in-buffer (bs-buffer-list nil sort-description)) |
| 590 | (if keep-line-p | 582 | (when keep-line-p |
| 591 | (goto-line line)) | 583 | (goto-line line)) |
| 592 | (beginning-of-line))) | 584 | (beginning-of-line))) |
| 593 | 585 | ||
| 594 | (defun bs--goto-current-buffer () | 586 | (defun bs--goto-current-buffer () |
| @@ -602,10 +594,10 @@ actually the line which begins with character in `bs-string-current' or | |||
| 602 | point) | 594 | point) |
| 603 | (save-excursion | 595 | (save-excursion |
| 604 | (goto-char (point-min)) | 596 | (goto-char (point-min)) |
| 605 | (if (search-forward-regexp regexp nil t) | 597 | (when (search-forward-regexp regexp nil t) |
| 606 | (setq point (- (point) 1)))) | 598 | (setq point (1- (point))))) |
| 607 | (if point | 599 | (when point |
| 608 | (goto-char point)))) | 600 | (goto-char point)))) |
| 609 | 601 | ||
| 610 | (defun bs--current-config-message () | 602 | (defun bs--current-config-message () |
| 611 | "Return a string describing the current `bs-mode' configuration." | 603 | "Return a string describing the current `bs-mode' configuration." |
| @@ -614,7 +606,23 @@ actually the line which begins with character in `bs-string-current' or | |||
| 614 | (format "Show buffer by configuration %S" | 606 | (format "Show buffer by configuration %S" |
| 615 | bs-current-configuration))) | 607 | bs-current-configuration))) |
| 616 | 608 | ||
| 617 | (defun bs-mode () | 609 | (defun bs--track-window-changes (frame) |
| 610 | "Track window changes to refresh the buffer list. | ||
| 611 | Used from `window-size-change-functions'." | ||
| 612 | (let ((win (get-buffer-window "*buffer-selection*" frame))) | ||
| 613 | (when win | ||
| 614 | (with-selected-window win | ||
| 615 | (bs-refresh) | ||
| 616 | (bs--set-window-height))))) | ||
| 617 | |||
| 618 | (defun bs--remove-hooks () | ||
| 619 | "Remove `bs--track-window-changes' and auxiliary hooks." | ||
| 620 | (remove-hook 'window-size-change-functions 'bs--track-window-changes) | ||
| 621 | ;; Remove itself | ||
| 622 | (remove-hook 'kill-buffer-hook 'bs--remove-hooks t) | ||
| 623 | (remove-hook 'change-major-mode-hook 'bs--remove-hooks t)) | ||
| 624 | |||
| 625 | (define-derived-mode bs-mode nil "Buffer-Selection-Menu" | ||
| 618 | "Major mode for editing a subset of Emacs' buffers. | 626 | "Major mode for editing a subset of Emacs' buffers. |
| 619 | \\<bs-mode-map> | 627 | \\<bs-mode-map> |
| 620 | Aside from two header lines each line describes one buffer. | 628 | Aside from two header lines each line describes one buffer. |
| @@ -647,27 +655,27 @@ available Buffer Selection Menu configuration. | |||
| 647 | to show always. | 655 | to show always. |
| 648 | \\[bs-visit-tags-table] -- call `visit-tags-table' on current line's buffer. | 656 | \\[bs-visit-tags-table] -- call `visit-tags-table' on current line's buffer. |
| 649 | \\[bs-help] -- display this help text." | 657 | \\[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) | 658 | (make-local-variable 'font-lock-defaults) |
| 654 | (make-local-variable 'font-lock-verbose) | 659 | (make-local-variable 'font-lock-verbose) |
| 655 | (make-local-variable 'font-lock-global-modes) | 660 | (make-local-variable 'font-lock-global-modes) |
| 656 | (buffer-disable-undo) | 661 | (buffer-disable-undo) |
| 657 | (setq major-mode 'bs-mode | 662 | (setq buffer-read-only t |
| 658 | mode-name "Buffer-Selection-Menu" | ||
| 659 | buffer-read-only t | ||
| 660 | truncate-lines t | 663 | truncate-lines t |
| 661 | show-trailing-whitespace nil | 664 | show-trailing-whitespace nil |
| 662 | font-lock-global-modes '(not bs-mode) | 665 | font-lock-global-modes '(not bs-mode) |
| 663 | font-lock-defaults '(bs-mode-font-lock-keywords t) | 666 | font-lock-defaults '(bs-mode-font-lock-keywords t) |
| 664 | font-lock-verbose nil) | 667 | font-lock-verbose nil) |
| 665 | (run-mode-hooks 'bs-mode-hook)) | 668 | (add-hook 'window-size-change-functions 'bs--track-window-changes) |
| 669 | (add-hook 'kill-buffer-hook 'bs--remove-hooks nil t) | ||
| 670 | (add-hook 'change-major-mode-hook 'bs--remove-hooks nil t)) | ||
| 666 | 671 | ||
| 667 | (defun bs--restore-window-config () | 672 | (defun bs--restore-window-config () |
| 668 | "Restore window configuration on the current frame." | 673 | "Restore window configuration on the current frame." |
| 669 | (when bs--window-config-coming-from | 674 | (when bs--window-config-coming-from |
| 670 | (set-window-configuration bs--window-config-coming-from) | 675 | (let ((frame (selected-frame))) |
| 676 | (unwind-protect | ||
| 677 | (set-window-configuration bs--window-config-coming-from) | ||
| 678 | (select-frame frame))) | ||
| 671 | (setq bs--window-config-coming-from nil))) | 679 | (setq bs--window-config-coming-from nil))) |
| 672 | 680 | ||
| 673 | (defun bs-kill () | 681 | (defun bs-kill () |
| @@ -705,8 +713,8 @@ Raise an error if not on a buffer line." | |||
| 705 | (beginning-of-line) | 713 | (beginning-of-line) |
| 706 | (let ((line (+ (- bs-header-lines-length) | 714 | (let ((line (+ (- bs-header-lines-length) |
| 707 | (count-lines 1 (point))))) | 715 | (count-lines 1 (point))))) |
| 708 | (if (< line 0) | 716 | (when (< line 0) |
| 709 | (error "You are on a header row")) | 717 | (error "You are on a header row")) |
| 710 | (nth line bs-current-list))) | 718 | (nth line bs-current-list))) |
| 711 | 719 | ||
| 712 | (defun bs--update-current-line () | 720 | (defun bs--update-current-line () |
| @@ -736,19 +744,18 @@ Leave Buffer Selection Menu." | |||
| 736 | (bury-buffer (current-buffer)) | 744 | (bury-buffer (current-buffer)) |
| 737 | (bs--restore-window-config) | 745 | (bs--restore-window-config) |
| 738 | (switch-to-buffer buffer) | 746 | (switch-to-buffer buffer) |
| 739 | (if bs--marked-buffers | 747 | (when bs--marked-buffers |
| 740 | ;; Some marked buffers for selection | 748 | ;; Some marked buffers for selection |
| 741 | (let* ((all (delq buffer bs--marked-buffers)) | 749 | (let* ((all (delq buffer bs--marked-buffers)) |
| 742 | (height (/ (1- (frame-height)) (1+ (length all))))) | 750 | (height (/ (1- (frame-height)) (1+ (length all))))) |
| 743 | (delete-other-windows) | 751 | (delete-other-windows) |
| 744 | (switch-to-buffer buffer) | 752 | (switch-to-buffer buffer) |
| 745 | (while all | 753 | (dolist (buf all) |
| 746 | (split-window nil height) | 754 | (split-window nil height) |
| 747 | (other-window 1) | 755 | (other-window 1) |
| 748 | (switch-to-buffer (car all)) | 756 | (switch-to-buffer buf)) |
| 749 | (setq all (cdr all))) | 757 | ;; goto window we have started bs. |
| 750 | ;; goto window we have started bs. | 758 | (other-window 1))))) |
| 751 | (other-window 1))))) | ||
| 752 | 759 | ||
| 753 | (defun bs-select-other-window () | 760 | (defun bs-select-other-window () |
| 754 | "Select current line's buffer by `switch-to-buffer-other-window'. | 761 | "Select current line's buffer by `switch-to-buffer-other-window'. |
| @@ -912,11 +919,10 @@ WHAT is a value of nil, `never', or `always'." | |||
| 912 | (delete-region (point) (save-excursion | 919 | (delete-region (point) (save-excursion |
| 913 | (end-of-line) | 920 | (end-of-line) |
| 914 | (if (eobp) (point) (1+ (point))))) | 921 | (if (eobp) (point) (1+ (point))))) |
| 915 | (if (eobp) | 922 | (when (eobp) |
| 916 | (progn | 923 | (backward-delete-char 1) |
| 917 | (backward-delete-char 1) | 924 | (beginning-of-line) |
| 918 | (beginning-of-line) | 925 | (recenter -1)) |
| 919 | (recenter -1))) | ||
| 920 | (bs--set-window-height))) | 926 | (bs--set-window-height))) |
| 921 | 927 | ||
| 922 | (defun bs-delete-backward () | 928 | (defun bs-delete-backward () |
| @@ -945,14 +951,14 @@ Default is `bs--current-sort-function'." | |||
| 945 | bs--current-sort-function))) | 951 | bs--current-sort-function))) |
| 946 | (save-excursion | 952 | (save-excursion |
| 947 | (goto-char (point-min)) | 953 | (goto-char (point-min)) |
| 948 | (if (and (nth 2 sort-description) | 954 | (when (and (nth 2 sort-description) |
| 949 | (search-forward-regexp (nth 2 sort-description) nil t)) | 955 | (search-forward-regexp (nth 2 sort-description) nil t)) |
| 950 | (let ((inhibit-read-only t)) | 956 | (let ((inhibit-read-only t)) |
| 951 | (put-text-property (match-beginning 0) | 957 | (put-text-property (match-beginning 0) |
| 952 | (match-end 0) | 958 | (match-end 0) |
| 953 | 'face | 959 | 'face |
| 954 | (or (nth 3 sort-description) | 960 | (or (nth 3 sort-description) |
| 955 | 'region))))))) | 961 | 'region))))))) |
| 956 | 962 | ||
| 957 | (defun bs-toggle-show-all () | 963 | (defun bs-toggle-show-all () |
| 958 | "Toggle show all buffers / show buffers with current configuration." | 964 | "Toggle show all buffers / show buffers with current configuration." |
| @@ -983,10 +989,8 @@ Uses function `vc-toggle-read-only'." | |||
| 983 | 989 | ||
| 984 | (defun bs--nth-wrapper (count fun &rest args) | 990 | (defun bs--nth-wrapper (count fun &rest args) |
| 985 | "Call COUNT times function FUN with arguments ARGS." | 991 | "Call COUNT times function FUN with arguments ARGS." |
| 986 | (setq count (or count 1)) | 992 | (dotimes (i (or count 1)) |
| 987 | (while (> count 0) | 993 | (apply fun args))) |
| 988 | (apply fun args) | ||
| 989 | (setq count (1- count)))) | ||
| 990 | 994 | ||
| 991 | (defun bs-up (arg) | 995 | (defun bs-up (arg) |
| 992 | "Move cursor vertically up ARG lines in Buffer Selection Menu." | 996 | "Move cursor vertically up ARG lines in Buffer Selection Menu." |
| @@ -1026,7 +1030,7 @@ A value of nil means BUFFER belongs to a file." | |||
| 1026 | 1030 | ||
| 1027 | (defun bs-sort-buffer-interns-are-last (b1 b2) | 1031 | (defun bs-sort-buffer-interns-are-last (b1 b2) |
| 1028 | "Function for sorting internal buffers at the end of all buffers." | 1032 | "Function for sorting internal buffers at the end of all buffers." |
| 1029 | (string-match "^\\*" (buffer-name b2))) | 1033 | (string-match-p "^\\*" (buffer-name b2))) |
| 1030 | 1034 | ||
| 1031 | ;; ---------------------------------------------------------------------- | 1035 | ;; ---------------------------------------------------------------------- |
| 1032 | ;; Configurations: | 1036 | ;; Configurations: |
| @@ -1108,8 +1112,8 @@ Will return the first if START-NAME is at end." | |||
| 1108 | (length (length list)) | 1112 | (length (length list)) |
| 1109 | pos) | 1113 | pos) |
| 1110 | (while (and assocs (not pos)) | 1114 | (while (and assocs (not pos)) |
| 1111 | (if (string= (car (car assocs)) start-name) | 1115 | (when (string= (car (car assocs)) start-name) |
| 1112 | (setq pos (- length (length assocs)))) | 1116 | (setq pos (- length (length assocs)))) |
| 1113 | (setq assocs (cdr assocs))) | 1117 | (setq assocs (cdr assocs))) |
| 1114 | (setq pos (1+ pos)) | 1118 | (setq pos (1+ pos)) |
| 1115 | (if (eq pos length) | 1119 | (if (eq pos length) |
| @@ -1151,10 +1155,9 @@ and move point to current buffer." | |||
| 1151 | (erase-buffer) | 1155 | (erase-buffer) |
| 1152 | (setq bs--name-entry-length name-entry-length) | 1156 | (setq bs--name-entry-length name-entry-length) |
| 1153 | (bs--show-header) | 1157 | (bs--show-header) |
| 1154 | (while list | 1158 | (dolist (buffer list) |
| 1155 | (bs--insert-one-entry (car list)) | 1159 | (bs--insert-one-entry buffer) |
| 1156 | (insert "\n") | 1160 | (insert "\n")) |
| 1157 | (setq list (cdr list))) | ||
| 1158 | (delete-backward-char 1) | 1161 | (delete-backward-char 1) |
| 1159 | (bs--set-window-height) | 1162 | (bs--set-window-height) |
| 1160 | (bs--goto-current-buffer) | 1163 | (bs--goto-current-buffer) |
| @@ -1348,27 +1351,21 @@ It goes over all columns described in `bs-attributes-list' | |||
| 1348 | and evaluates corresponding string. Inserts string in current buffer; | 1351 | and evaluates corresponding string. Inserts string in current buffer; |
| 1349 | normally *buffer-selection*." | 1352 | normally *buffer-selection*." |
| 1350 | (let ((string "") | 1353 | (let ((string "") |
| 1351 | (columns bs-attributes-list) | ||
| 1352 | (to-much 0) | 1354 | (to-much 0) |
| 1353 | (apply-args (append (list bs--buffer-coming-from bs-current-list)))) | 1355 | (apply-args (append (list bs--buffer-coming-from bs-current-list)))) |
| 1354 | (save-excursion | 1356 | (save-excursion |
| 1355 | (while columns | 1357 | (set-buffer buffer) |
| 1356 | (set-buffer buffer) | 1358 | (dolist (column bs-attributes-list) |
| 1357 | (let ((min (bs--get-value (nth 1 (car columns)))) | 1359 | (let* ((min (bs--get-value (nth 1 column))) |
| 1358 | ;;(max (bs--get-value (nth 2 (car columns)))) refered no more | 1360 | (new-string (bs--format-aux (bs--get-value (nth 4 column) ; fun |
| 1359 | (align (nth 3 (car columns))) | 1361 | apply-args) |
| 1360 | (fun (nth 4 (car columns))) | 1362 | (nth 3 column) ; align |
| 1361 | (val nil) | 1363 | (- min to-much))) |
| 1362 | new-string) | 1364 | (len (length new-string))) |
| 1363 | (setq val (bs--get-value fun apply-args)) | ||
| 1364 | (setq new-string (bs--format-aux val align (- min to-much))) | ||
| 1365 | (setq string (concat string new-string)) | 1365 | (setq string (concat string new-string)) |
| 1366 | (if (> (length new-string) min) | 1366 | (when (> len min) |
| 1367 | (setq to-much (- (length new-string) min))) | 1367 | (setq to-much (- len min)))))) |
| 1368 | ) ; let | 1368 | (insert string))) |
| 1369 | (setq columns (cdr columns)))) | ||
| 1370 | (insert string) | ||
| 1371 | string)) | ||
| 1372 | 1369 | ||
| 1373 | (defun bs--format-aux (string align len) | 1370 | (defun bs--format-aux (string align len) |
| 1374 | "Pad STRING to length LEN with alignment ALIGN. | 1371 | "Pad STRING to length LEN with alignment ALIGN. |
| @@ -1382,28 +1379,26 @@ ALIGN is one of the symbols `left', `middle', or `right'." | |||
| 1382 | 1379 | ||
| 1383 | (defun bs--show-header () | 1380 | (defun bs--show-header () |
| 1384 | "Insert header for Buffer Selection Menu in current buffer." | 1381 | "Insert header for Buffer Selection Menu in current buffer." |
| 1385 | (dolist (string (bs--create-header)) | 1382 | (insert (bs--create-header-line #'identity) |
| 1386 | (insert string "\n"))) | 1383 | "\n" |
| 1384 | (bs--create-header-line (lambda (title) | ||
| 1385 | (make-string (length title) ?-))) | ||
| 1386 | "\n")) | ||
| 1387 | 1387 | ||
| 1388 | (defun bs--get-name-length () | 1388 | (defun bs--get-name-length () |
| 1389 | "Return value of `bs--name-entry-length'." | 1389 | "Return value of `bs--name-entry-length'." |
| 1390 | bs--name-entry-length) | 1390 | bs--name-entry-length) |
| 1391 | 1391 | ||
| 1392 | (defun bs--create-header () | 1392 | (defun bs--create-header-line (col) |
| 1393 | "Return all header lines used in Buffer Selection Menu as a list of strings." | 1393 | "Generate a line for the header. |
| 1394 | (list (mapconcat (lambda (column) | 1394 | COL is called for each column in `bs-attributes-list' as a |
| 1395 | (bs--format-aux (bs--get-value (car column)) | 1395 | function of one argument, the string heading for the column." |
| 1396 | (nth 3 column) ; align | 1396 | (mapconcat (lambda (column) |
| 1397 | (bs--get-value (nth 1 column)))) | 1397 | (bs--format-aux (funcall col (bs--get-value (car column))) |
| 1398 | bs-attributes-list | 1398 | (nth 3 column) ; align |
| 1399 | "") | 1399 | (bs--get-value (nth 1 column)))) |
| 1400 | (mapconcat (lambda (column) | 1400 | bs-attributes-list |
| 1401 | (let ((length (length (bs--get-value (car column))))) | 1401 | "")) |
| 1402 | (bs--format-aux (make-string length ?-) | ||
| 1403 | (nth 3 column) ; align | ||
| 1404 | (bs--get-value (nth 1 column))))) | ||
| 1405 | bs-attributes-list | ||
| 1406 | ""))) | ||
| 1407 | 1402 | ||
| 1408 | (defun bs--show-with-configuration (name &optional arg) | 1403 | (defun bs--show-with-configuration (name &optional arg) |
| 1409 | "Display buffer list of configuration with name NAME. | 1404 | "Display buffer list of configuration with name NAME. |
| @@ -1424,14 +1419,14 @@ for buffer selection." | |||
| 1424 | (setq bs--buffer-coming-from (current-buffer))) | 1419 | (setq bs--buffer-coming-from (current-buffer))) |
| 1425 | (let ((liste (bs-buffer-list)) | 1420 | (let ((liste (bs-buffer-list)) |
| 1426 | (active-window (get-window-with-predicate | 1421 | (active-window (get-window-with-predicate |
| 1427 | (lambda (w) | 1422 | (lambda (w) |
| 1428 | (string= (buffer-name (window-buffer w)) | 1423 | (string= (buffer-name (window-buffer w)) |
| 1429 | "*buffer-selection*"))))) | 1424 | "*buffer-selection*")) |
| 1425 | nil (selected-frame)))) | ||
| 1430 | (if active-window | 1426 | (if active-window |
| 1431 | (select-window active-window) | 1427 | (select-window active-window) |
| 1432 | (modify-frame-parameters nil | 1428 | (bs--restore-window-config) |
| 1433 | (list (cons 'bs--window-config-coming-from | 1429 | (setq bs--window-config-coming-from (current-window-configuration)) |
| 1434 | (current-window-configuration)))) | ||
| 1435 | (when (> (window-height (selected-window)) 7) | 1430 | (when (> (window-height (selected-window)) 7) |
| 1436 | (split-window-vertically) | 1431 | (split-window-vertically) |
| 1437 | (other-window 1))) | 1432 | (other-window 1))) |