aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2025-03-25 14:06:32 -0400
committerStefan Monnier2025-03-25 14:06:32 -0400
commitbb62e435637c7422741189384fa89e2272caec5b (patch)
tree9227d7357b0395510b7f574e5a2639d01ceb462d
parentbc2b815f098751be700243cd0c47806a0d08dc68 (diff)
downloademacs-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.el80
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."
420Non-nil means to show all buffers. Otherwise show buffers 419Non-nil means to show all buffers. Otherwise show buffers
421defined by current configuration `bs-current-configuration'.") 420defined 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.
425A buffer whose name matches this regular expression will never be 424A buffer whose name matches this regular expression will never be
426included in the buffer list.") 425included 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.
575If KEEP-LINE-P is non-nil the point will stay on current line. 562If KEEP-LINE-P is non-nil the point will stay on current line.
576SORT-DESCRIPTION is an element of `bs-sort-functions'." 563SORT-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.
586Actually, it goes to the line which begins with the character 573Actually, it goes to the line which begins with the character
587in `bs-string-current' or `bs-string-current-marked'." 574in `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>
612Aside from two header lines each line describes one buffer. 596Aside 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')."
701Raise an error if not on a buffer line." 684Raise 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.
1013If on top of buffer list go to last line." 996If 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'."
1086Internal buffers appear at end of all buffers." 1069Internal 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.
1220All arguments ARGS are transferred to function `message'." 1203All 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.