diff options
| author | Stefan Monnier | 2025-03-25 14:06:32 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2025-03-25 14:06:32 -0400 |
| commit | bb62e435637c7422741189384fa89e2272caec5b (patch) | |
| tree | 9227d7357b0395510b7f574e5a2639d01ceb462d | |
| parent | bc2b815f098751be700243cd0c47806a0d08dc68 (diff) | |
| download | emacs-bb62e435637c7422741189384fa89e2272caec5b.tar.gz emacs-bb62e435637c7422741189384fa89e2272caec5b.zip | |
bs.el: Janitorial work; most importantly use `special-mode`
* lisp/bs.el: Prefer # to quote function arguments.
(bs-mode-font-lock-keywords): Use backquote; quote face names; and use
a list of faces instead of two applications at the same spot.
(bs-sort-buffer-interns-are-last, bs-config--files-and-scratch)
(bs-configurations, bs--intern-show-never): Fix ^$-vs-\`\' confusion.
(bs-mode-map): Remove bindings made redundant by inheritance.
(bs--redisplay): Use `line-number-at-pos`.
(bs--goto-current-buffer): Use `regexp-opt`.
(bs-mode): Inherit from `special-mode`.
(bs--current-buffer, bs--up): Use `point-min`.
(bs--create-header-line): Remove redundant arg.
| -rw-r--r-- | lisp/bs.el | 80 |
1 files changed, 31 insertions, 49 deletions
diff --git a/lisp/bs.el b/lisp/bs.el index 29af72f762b..ac4da0b5c05 100644 --- a/lisp/bs.el +++ b/lisp/bs.el | |||
| @@ -180,15 +180,14 @@ must return a string representing the column's value." | |||
| 180 | 180 | ||
| 181 | ;; Font-Lock-Settings | 181 | ;; Font-Lock-Settings |
| 182 | (defvar bs-mode-font-lock-keywords | 182 | (defvar bs-mode-font-lock-keywords |
| 183 | (list ;; header in font-lock-type-face | 183 | `(;; header in bold font-lock-type-face |
| 184 | (list (bs--make-header-match-string) | 184 | (,(bs--make-header-match-string) (1 '(font-lock-type-face bold))) |
| 185 | '(1 font-lock-type-face append) '(1 'bold append)) | 185 | ;; Buffername embedded by * |
| 186 | ;; Buffername embedded by * | 186 | ("^\\(.*\\*.*\\*.*\\)$" (1 'font-lock-constant-face)) |
| 187 | (list "^\\(.*\\*.*\\*.*\\)$" 1 'font-lock-constant-face) | 187 | ;; Dired-Buffers |
| 188 | ;; Dired-Buffers | 188 | ("^..\\(.*Dired .*\\)$" (1 'font-lock-function-name-face)) |
| 189 | '("^..\\(.*Dired .*\\)$" 1 font-lock-function-name-face) | 189 | ;; the star for modified buffers |
| 190 | ;; the star for modified buffers | 190 | ("^.\\(\\*\\) +[^\\*]" (1 'font-lock-comment-face))) |
| 191 | '("^.\\(\\*\\) +[^\\*]" 1 font-lock-comment-face)) | ||
| 192 | "Default font lock expressions for Buffer Selection Menu.") | 191 | "Default font lock expressions for Buffer Selection Menu.") |
| 193 | 192 | ||
| 194 | (defcustom bs-max-window-height 20 | 193 | (defcustom bs-max-window-height 20 |
| @@ -255,7 +254,7 @@ See also `bs-maximal-buffer-name-column'." | |||
| 255 | (defcustom bs-configurations | 254 | (defcustom bs-configurations |
| 256 | '(("all" nil nil nil nil nil) | 255 | '(("all" nil nil nil nil nil) |
| 257 | ("files" nil nil nil bs-visits-non-file bs-sort-buffer-interns-are-last) | 256 | ("files" nil nil nil bs-visits-non-file bs-sort-buffer-interns-are-last) |
| 258 | ("files-and-scratch" "^\\*scratch\\*$" nil nil bs-visits-non-file | 257 | ("files-and-scratch" "\\`\\*scratch\\*\\'" nil nil bs-visits-non-file |
| 259 | bs-sort-buffer-interns-are-last) | 258 | bs-sort-buffer-interns-are-last) |
| 260 | ("all-intern-last" nil nil nil nil bs-sort-buffer-interns-are-last)) | 259 | ("all-intern-last" nil nil nil nil bs-sort-buffer-interns-are-last)) |
| 261 | "List of all configurations you can use in the Buffer Selection Menu. | 260 | "List of all configurations you can use in the Buffer Selection Menu. |
| @@ -420,7 +419,7 @@ naming a sort behavior. Default is \"by nothing\" which means no sorting." | |||
| 420 | Non-nil means to show all buffers. Otherwise show buffers | 419 | Non-nil means to show all buffers. Otherwise show buffers |
| 421 | defined by current configuration `bs-current-configuration'.") | 420 | defined by current configuration `bs-current-configuration'.") |
| 422 | 421 | ||
| 423 | (defvar bs--intern-show-never "^ \\|\\*buffer-selection\\*" | 422 | (defvar bs--intern-show-never "\\` \\|\\*buffer-selection\\*" |
| 424 | "Regular expression specifying which buffers never to show. | 423 | "Regular expression specifying which buffers never to show. |
| 425 | A buffer whose name matches this regular expression will never be | 424 | A buffer whose name matches this regular expression will never be |
| 426 | included in the buffer list.") | 425 | included in the buffer list.") |
| @@ -439,17 +438,6 @@ Used internally, only.") | |||
| 439 | "v" #'bs-view | 438 | "v" #'bs-view |
| 440 | "!" #'bs-select-in-one-window | 439 | "!" #'bs-select-in-one-window |
| 441 | "F" #'bs-select-other-frame | 440 | "F" #'bs-select-other-frame |
| 442 | "1" #'digit-argument | ||
| 443 | "2" #'digit-argument | ||
| 444 | "3" #'digit-argument | ||
| 445 | "4" #'digit-argument | ||
| 446 | "5" #'digit-argument | ||
| 447 | "6" #'digit-argument | ||
| 448 | "7" #'digit-argument | ||
| 449 | "8" #'digit-argument | ||
| 450 | "9" #'digit-argument | ||
| 451 | "-" #'negative-argument | ||
| 452 | "ESC -" #'negative-argument | ||
| 453 | "o" #'bs-select-other-window | 441 | "o" #'bs-select-other-window |
| 454 | "C-o" #'bs-tmp-select-other-window | 442 | "C-o" #'bs-tmp-select-other-window |
| 455 | "<up>" #'bs-up | 443 | "<up>" #'bs-up |
| @@ -464,7 +452,6 @@ Used internally, only.") | |||
| 464 | "d" #'bs-delete | 452 | "d" #'bs-delete |
| 465 | "C-d" #'bs-delete-backward | 453 | "C-d" #'bs-delete-backward |
| 466 | "k" #'bs-delete | 454 | "k" #'bs-delete |
| 467 | "g" #'bs-refresh | ||
| 468 | "C" #'bs-set-configuration-and-refresh | 455 | "C" #'bs-set-configuration-and-refresh |
| 469 | "c" #'bs-select-next-configuration | 456 | "c" #'bs-select-next-configuration |
| 470 | "q" #'bs-kill | 457 | "q" #'bs-kill |
| @@ -574,21 +561,20 @@ function. SORT-DESCRIPTION is an element of `bs-sort-functions'." | |||
| 574 | "Redisplay whole Buffer Selection Menu. | 561 | "Redisplay whole Buffer Selection Menu. |
| 575 | If KEEP-LINE-P is non-nil the point will stay on current line. | 562 | If KEEP-LINE-P is non-nil the point will stay on current line. |
| 576 | SORT-DESCRIPTION is an element of `bs-sort-functions'." | 563 | SORT-DESCRIPTION is an element of `bs-sort-functions'." |
| 577 | (let ((line (count-lines 1 (point)))) | 564 | (let ((line (line-number-at-pos))) |
| 578 | (bs-show-in-buffer (bs-buffer-list nil sort-description)) | 565 | (bs-show-in-buffer (bs-buffer-list nil sort-description)) |
| 579 | (when keep-line-p | 566 | (when keep-line-p |
| 580 | (goto-char (point-min)) | 567 | (goto-char (point-min)) |
| 581 | (forward-line line)) | 568 | (forward-line (1- line))) |
| 582 | (beginning-of-line))) | 569 | (beginning-of-line))) |
| 583 | 570 | ||
| 584 | (defun bs--goto-current-buffer () | 571 | (defun bs--goto-current-buffer () |
| 585 | "Go to line which represents the current buffer. | 572 | "Go to line which represents the current buffer. |
| 586 | Actually, it goes to the line which begins with the character | 573 | Actually, it goes to the line which begins with the character |
| 587 | in `bs-string-current' or `bs-string-current-marked'." | 574 | in `bs-string-current' or `bs-string-current-marked'." |
| 588 | (let ((regexp (concat "^" | 575 | (let ((regexp (concat "\\`" |
| 589 | (regexp-quote bs-string-current) | 576 | (regexp-opt (list bs-string-current |
| 590 | "\\|^" | 577 | bs-string-current-marked)))) |
| 591 | (regexp-quote bs-string-current-marked))) | ||
| 592 | point) | 578 | point) |
| 593 | (save-excursion | 579 | (save-excursion |
| 594 | (goto-char (point-min)) | 580 | (goto-char (point-min)) |
| @@ -604,9 +590,7 @@ in `bs-string-current' or `bs-string-current-marked'." | |||
| 604 | (format "Show buffer by configuration %S" | 590 | (format "Show buffer by configuration %S" |
| 605 | bs-current-configuration))) | 591 | bs-current-configuration))) |
| 606 | 592 | ||
| 607 | (put 'bs-mode 'mode-class 'special) | 593 | (define-derived-mode bs-mode special-mode "Buffer-Selection-Menu" |
| 608 | |||
| 609 | (define-derived-mode bs-mode nil "Buffer-Selection-Menu" | ||
| 610 | "Major mode for editing a subset of Emacs's buffers. | 594 | "Major mode for editing a subset of Emacs's buffers. |
| 611 | \\<bs-mode-map> | 595 | \\<bs-mode-map> |
| 612 | Aside from two header lines each line describes one buffer. | 596 | Aside from two header lines each line describes one buffer. |
| @@ -653,16 +637,15 @@ apply it. | |||
| 653 | \\[bs-show-sorted] -- display buffer list sorted by next sort aspect. | 637 | \\[bs-show-sorted] -- display buffer list sorted by next sort aspect. |
| 654 | 638 | ||
| 655 | \\[bs-kill] -- leave Buffer Selection Menu without a selection. | 639 | \\[bs-kill] -- leave Buffer Selection Menu without a selection. |
| 656 | \\[bs-refresh] -- refresh Buffer Selection Menu. | 640 | \\[revert-buffer] -- refresh Buffer Selection Menu. |
| 657 | \\[describe-mode] -- display this help text." | 641 | \\[describe-mode] -- display this help text." |
| 658 | (buffer-disable-undo) | 642 | (buffer-disable-undo) |
| 659 | (setq buffer-read-only t | 643 | (setq truncate-lines t |
| 660 | truncate-lines t | ||
| 661 | show-trailing-whitespace nil) | 644 | show-trailing-whitespace nil) |
| 662 | (setq-local font-lock-defaults '(bs-mode-font-lock-keywords t)) | 645 | (setq-local font-lock-defaults '(bs-mode-font-lock-keywords t)) |
| 663 | (setq-local font-lock-verbose nil) | 646 | (setq-local font-lock-verbose nil) |
| 664 | (setq-local font-lock-global-modes '(not bs-mode)) | 647 | (setq-local font-lock-global-modes '(not bs-mode)) |
| 665 | (setq-local revert-buffer-function 'bs-refresh)) | 648 | (setq-local revert-buffer-function #'bs-refresh)) |
| 666 | 649 | ||
| 667 | (defun bs-kill () | 650 | (defun bs-kill () |
| 668 | "Let buffer disappear and reset window configuration." | 651 | "Let buffer disappear and reset window configuration." |
| @@ -701,7 +684,7 @@ Arguments are IGNORED (for `revert-buffer')." | |||
| 701 | Raise an error if not on a buffer line." | 684 | Raise an error if not on a buffer line." |
| 702 | (beginning-of-line) | 685 | (beginning-of-line) |
| 703 | (let ((line (+ (- bs-header-lines-length) | 686 | (let ((line (+ (- bs-header-lines-length) |
| 704 | (count-lines 1 (point))))) | 687 | (count-lines (point-min) (point))))) |
| 705 | (when (< line 0) | 688 | (when (< line 0) |
| 706 | (error "You are on a header row")) | 689 | (error "You are on a header row")) |
| 707 | (nth line bs-current-list))) | 690 | (nth line bs-current-list))) |
| @@ -1011,7 +994,7 @@ Uses function `read-only-mode'." | |||
| 1011 | (defun bs--up () | 994 | (defun bs--up () |
| 1012 | "Move point vertically up one line. | 995 | "Move point vertically up one line. |
| 1013 | If on top of buffer list go to last line." | 996 | If on top of buffer list go to last line." |
| 1014 | (if (> (count-lines 1 (point)) bs-header-lines-length) | 997 | (if (> (count-lines (point-min) (point)) bs-header-lines-length) |
| 1015 | (forward-line -1) | 998 | (forward-line -1) |
| 1016 | (goto-char (point-max)) | 999 | (goto-char (point-max)) |
| 1017 | (beginning-of-line) | 1000 | (beginning-of-line) |
| @@ -1041,7 +1024,7 @@ A value of nil means BUFFER belongs to a file." | |||
| 1041 | 1024 | ||
| 1042 | (defun bs-sort-buffer-interns-are-last (_b1 b2) | 1025 | (defun bs-sort-buffer-interns-are-last (_b1 b2) |
| 1043 | "Function for sorting internal buffers at the end of all buffers." | 1026 | "Function for sorting internal buffers at the end of all buffers." |
| 1044 | (string-match-p "^\\*" (buffer-name b2))) | 1027 | (string-match-p "\\`\\*" (buffer-name b2))) |
| 1045 | 1028 | ||
| 1046 | ;; ---------------------------------------------------------------------- | 1029 | ;; ---------------------------------------------------------------------- |
| 1047 | ;; Configurations: | 1030 | ;; Configurations: |
| @@ -1062,19 +1045,19 @@ These variables are `bs-dont-show-regexp', `bs-must-show-regexp', | |||
| 1062 | "Define a configuration for showing only buffers visiting a file." | 1045 | "Define a configuration for showing only buffers visiting a file." |
| 1063 | (bs-config-clear) | 1046 | (bs-config-clear) |
| 1064 | (setq ;; I want to see *-buffers at the end | 1047 | (setq ;; I want to see *-buffers at the end |
| 1065 | bs-buffer-sort-function 'bs-sort-buffer-interns-are-last | 1048 | bs-buffer-sort-function #'bs-sort-buffer-interns-are-last |
| 1066 | ;; Don't show files who don't belong to a file | 1049 | ;; Don't show files who don't belong to a file |
| 1067 | bs-dont-show-function 'bs-visits-non-file)) | 1050 | bs-dont-show-function #'bs-visits-non-file)) |
| 1068 | 1051 | ||
| 1069 | (defun bs-config--files-and-scratch () | 1052 | (defun bs-config--files-and-scratch () |
| 1070 | "Define a configuration for showing buffer *scratch* and file buffers." | 1053 | "Define a configuration for showing buffer *scratch* and file buffers." |
| 1071 | (bs-config-clear) | 1054 | (bs-config-clear) |
| 1072 | (setq ;; I want to see *-buffers at the end | 1055 | (setq ;; I want to see *-buffers at the end |
| 1073 | bs-buffer-sort-function 'bs-sort-buffer-interns-are-last | 1056 | bs-buffer-sort-function #'bs-sort-buffer-interns-are-last |
| 1074 | ;; Don't show files who don't belong to a file | 1057 | ;; Don't show files who don't belong to a file |
| 1075 | bs-dont-show-function 'bs-visits-non-file | 1058 | bs-dont-show-function #'bs-visits-non-file |
| 1076 | ;; Show *scratch* buffer. | 1059 | ;; Show *scratch* buffer. |
| 1077 | bs-must-show-regexp "^\\*scratch\\*$")) | 1060 | bs-must-show-regexp "\\`\\*scratch\\*\\'")) |
| 1078 | 1061 | ||
| 1079 | (defun bs-config--all () | 1062 | (defun bs-config--all () |
| 1080 | "Define a configuration for showing all buffers. | 1063 | "Define a configuration for showing all buffers. |
| @@ -1086,7 +1069,7 @@ Reset all according variables by `bs-config-clear'." | |||
| 1086 | Internal buffers appear at end of all buffers." | 1069 | Internal buffers appear at end of all buffers." |
| 1087 | (bs-config-clear) | 1070 | (bs-config-clear) |
| 1088 | ;; I want to see *-buffers at the end | 1071 | ;; I want to see *-buffers at the end |
| 1089 | (setq bs-buffer-sort-function 'bs-sort-buffer-interns-are-last)) | 1072 | (setq bs-buffer-sort-function #'bs-sort-buffer-interns-are-last)) |
| 1090 | 1073 | ||
| 1091 | (defun bs-set-configuration (name) | 1074 | (defun bs-set-configuration (name) |
| 1092 | "Set configuration to the one saved under string NAME in `bs-configurations'. | 1075 | "Set configuration to the one saved under string NAME in `bs-configurations'. |
| @@ -1170,7 +1153,7 @@ and move point to current buffer." | |||
| 1170 | (let* ((inhibit-read-only t) | 1153 | (let* ((inhibit-read-only t) |
| 1171 | (map-fun (lambda (entry) | 1154 | (map-fun (lambda (entry) |
| 1172 | (string-width (buffer-name entry)))) | 1155 | (string-width (buffer-name entry)))) |
| 1173 | (max-length-of-names (apply 'max | 1156 | (max-length-of-names (apply #'max |
| 1174 | (cons 0 (mapcar map-fun list)))) | 1157 | (cons 0 (mapcar map-fun list)))) |
| 1175 | (name-entry-length (min bs-maximal-buffer-name-column | 1158 | (name-entry-length (min bs-maximal-buffer-name-column |
| 1176 | (max bs-minimal-buffer-name-column | 1159 | (max bs-minimal-buffer-name-column |
| @@ -1219,7 +1202,7 @@ buffer list used for buffer cycling." | |||
| 1219 | "Like `message' but don't log it on the message log. | 1202 | "Like `message' but don't log it on the message log. |
| 1220 | All arguments ARGS are transferred to function `message'." | 1203 | All arguments ARGS are transferred to function `message'." |
| 1221 | (let ((message-log-max nil)) | 1204 | (let ((message-log-max nil)) |
| 1222 | (apply 'message args))) | 1205 | (apply #'message args))) |
| 1223 | 1206 | ||
| 1224 | (defvar bs--cycle-list nil | 1207 | (defvar bs--cycle-list nil |
| 1225 | "Current buffer list used for cycling.") | 1208 | "Current buffer list used for cycling.") |
| @@ -1415,8 +1398,7 @@ function of one argument, the string heading for the column." | |||
| 1415 | (bs--format-aux (funcall col (bs--get-value (car column))) | 1398 | (bs--format-aux (funcall col (bs--get-value (car column))) |
| 1416 | (nth 3 column) ; align | 1399 | (nth 3 column) ; align |
| 1417 | (bs--get-value (nth 1 column)))) | 1400 | (bs--get-value (nth 1 column)))) |
| 1418 | bs-attributes-list | 1401 | bs-attributes-list)) |
| 1419 | "")) | ||
| 1420 | 1402 | ||
| 1421 | (defun bs--show-with-configuration (name &optional arg) | 1403 | (defun bs--show-with-configuration (name &optional arg) |
| 1422 | "Display buffer list of configuration with name NAME. | 1404 | "Display buffer list of configuration with name NAME. |