;;; listbuf.el --- build buffer menu for use in Buff-menu-mode ;; Author: Noah Friedman ;; Created: 1991-10-03, rewritten 2020-10-30 ;; Public domain. ;;; Commentary: ;; Requires Emacs 24.1 or later. ;; Earlier versions should use obsolete/listbuf.el ;;; Code: (require 'tabulated-list) (defgroup listbuf nil "Extension for Buffer List mode." :group 'Buffer-menu :group 'tools :group 'convenience) (defcustom listbuf-ignore-buffer-name-regexp "^ " "Regular expression matching buffer names to ignore. For example, traditional behavior is not to list buffers whose names begin with a space, for which the regexp is \"^ \"." :type 'regexp :group 'listbuf) (defcustom listbuf-ignore-buffer-predicate-list nil "List of predicates to call to decide whether to ignore a buffer. Each predicate is called with one argument, a buffer object. If any predicate returns non-nil, the buffer will not be displayed." :type '(repeat function) :group 'listbuf) (defcustom listbuf-field-table '( [ "C" listbuf-get-C 1 1 t (:pad-right 0) ] [ "R" listbuf-get-R 1 1 t (:pad-right 0) ] [ "M" listbuf-get-M 1 1 t nil ] [ "Buffer" listbuf-get-Buffer 14 nil listbuf-sort-cmp-buffer-name (:pad-right 2) ] [ "Rev" listbuf-get-Rev 1 10 nil (:pad-right 2) ] [ "Size" listbuf-get-Size 1 nil listbuf-sort-cmp-size (:pad-right 2 :right-align t) ] [ "Mode" listbuf-get-Mode 1 20 t (:pad-right 2) ] [ "File" listbuf-get-File 1 nil t nil ] ) "Table used to determine how to fill fields in the buffer menu. Each member of the list should be a vector containing the following elements to define a field: 0. The name of the field, as a string. This name will appear in the header of the list of buffers. 1. A function which returns a string containing the information about that field. This function will always be run with the current buffer set to the buffer for which information is being gathered. For example, for the `Mode' field the function might return the value of the buffer-local variable `mode-name'. 2. The minimum width of the column. If the actual width of the entry in this column doesn't exceed this value and any fields come after it, it will be padded with whitespace. A nil value means there is no minimum length. 3. The maximum tolerated width of a column, or nil for no maximum. If a column exceeds this width, its display will be truncated. 4. A predicate for sorting on this column. If nil, this column cannot be used for sorting. If t, sort by comparing the string value printed in the column. Otherwise, it should be a predicate function suitable for ‘sort’, accepting arguments with the same form as the elements of ‘tabulated-list-entries’. 5. A list of additional column properties. Currently supported properties are: - ‘:right-align’ - If non-nil, column should be right-aligned. - ‘:pad-right’ - Number of additional padding spaces to the right of the column; defaults to 1 if omitted. The fields will be listed in the buffer menu in the same order they appear in this table." :type '(repeat vector) :group 'listbuf) (defun listbuf-field:label (field) (aref field 0)) (defun listbuf-field:collector (field) (aref field 1)) (defun listbuf-field:min-width (field) (aref field 2)) (defun listbuf-field:max-width (field) (aref field 3)) (defun listbuf-field:sort (field) (aref field 4)) (defun listbuf-field:props (field) (aref field 5)) (defconst listbuf-buffer-name "*Buffer List*" "The name of buffer-menu buffer.") (defvar listbuf-state nil) (defun listbuf-state::n (n &optional val) (if val (aset listbuf-state n val) (aref listbuf-state n))) (defun listbuf-state:old-buffer () (aref listbuf-state 0)) (defun listbuf-state:marked-buffers () (aref listbuf-state 1)) (defun listbuf-state:buffer-number () (aref listbuf-state 2)) (defun set-listbuf-state:buffer-number (val) (aset listbuf-state 2 val)) (defun listbuf-get-C () (let* ((buf (current-buffer)) (s (cond ((eq buf (listbuf-state:old-buffer)) ".") ((memq buf (listbuf-state:marked-buffers)) ">") (t " ")))) (propertize s 'buffer-order-number (listbuf-state:buffer-number)))) (defun listbuf-get-R () (if buffer-read-only "%" " ")) (defun listbuf-get-M () (if (buffer-modified-p) "*" " ")) (defun listbuf-get-Buffer () (Buffer-menu--pretty-name (buffer-name))) (defun listbuf-file-version (name) (if (string-match "\\.~\\([0-9.]+\\)~\\'" (or name "")) (match-string 1 name))) (defun listbuf-get-Rev () (cond ((bound-and-true-p vc-mode) (substring-no-properties vc-mode 1)) ((null buffer-file-name) nil) (t (let* ((file buffer-file-name) (ver (listbuf-file-version file))) ;; If we're visiting a numbered backup file, just return that ;; file version number. Otherwise, buffer is the next version ;; after oldest existing one, if any. (cond (ver (format "~%s~" ver)) ((setq ver (listbuf-file-version (file-newest-backup file))) (format "~%d~" (1+ (string-to-number ver))))))))) (defun listbuf-get-Size () (number-to-string (buffer-size))) (defun listbuf-get-Mode () (let* ((buf (current-buffer)) (name (format-mode-line mode-name nil nil buf)) (mlp (when (get-buffer-process buf) (format-mode-line (or mode-line-process ":%s") nil nil buf)))) (concat name mlp))) (defun listbuf-get-File () (Buffer-menu--pretty-file-name buffer-file-name)) ;; Create a list of buffers we will actually want to display. ;; If buffer-list is provided, just filter out dead buffers. (defun listbuf-displayable-buffer-list (&optional buffer-list) (let ((entries nil)) (dolist (buffer (or buffer-list (if Buffer-menu-use-frame-buffer-list (buffer-list (selected-frame)) (buffer-list)))) (when (buffer-live-p buffer) (if buffer-list (push buffer entries) (let ((name (buffer-name buffer)) (file (buffer-file-name buffer))) (cond ((string= name listbuf-buffer-name)) ((and (null file) Buffer-menu-files-only)) ((and listbuf-ignore-buffer-name-regexp (string-match listbuf-ignore-buffer-name-regexp name))) ((run-hook-with-args-until-success 'listbuf-ignore-buffer-predicate-list buffer)) ((push buffer entries))))))) (nreverse entries))) (defun listbuf-collect-values (buffer-list) (set-listbuf-state:buffer-number -1) (mapcar (lambda (buffer) (set-listbuf-state:buffer-number (1+ (listbuf-state:buffer-number))) (with-current-buffer buffer (list buffer (apply 'vector (mapcar (lambda (field) (let ((collector (listbuf-field:collector field))) (or (if collector (funcall collector)) ""))) listbuf-field-table))))) buffer-list)) (defun listbuf-collected-widths (collected) (let ((width (apply 'vector (mapcar (lambda (elt) (length (aref elt 0))) listbuf-field-table))) table) (dolist (elt collected) (setq elt (cadr elt)) (setq table listbuf-field-table) (dotimes (n (length elt)) (let ((minw (or (listbuf-field:min-width (car table)) most-negative-fixnum)) (maxw (or (listbuf-field:max-width (car table)) most-positive-fixnum))) (aset width n (min maxw (max minw (aref width n) (length (aref elt n)))))) (setq table (cdr table)))) width)) ;; Generate tabulated-list-format vector with computed widths (defun listbuf-make-tlf (width) (let ((vec (make-vector (length listbuf-field-table) nil)) (table listbuf-field-table)) (dotimes (n (length vec)) (let ((elt (car table))) (aset vec n (apply 'list (listbuf-field:label elt) (aref width n) (listbuf-field:sort elt) (listbuf-field:props elt))) (setq table (cdr table)))) vec)) (defun listbuf--refresh (&optional buffer-list old-buffer) (let* ((listbuf-state (vector old-buffer (Buffer-menu-marked-buffers) -1)) (buffer-list (listbuf-displayable-buffer-list buffer-list)) (collected (listbuf-collect-values buffer-list)) (width (listbuf-collected-widths collected))) (setq tabulated-list-format (listbuf-make-tlf width)) (setq tabulated-list-use-header-line Buffer-menu-use-header-line) (setq tabulated-list-entries collected) (tabulated-list-init-header))) (defun listbuf-display-all-buffers () "Disable any filter on buffers for the remaining duration of the current Buffer List buffer. This will display all buffers, including those that are normally invisible background buffers for network processes, even with a content refresh. After using this command, the simplest way to restore the normal filtration of buffers is to kill the Buffer List buffer and recreate it." (interactive) (setq-local listbuf-ignore-buffer-name-regexp nil) (setq-local listbuf-ignore-buffer-predicate-list nil) (revert-buffer)) (defun listbuf-sort-cmp-buffer-name (entry1 entry2) (let* ((fieldnum (tabulated-list--column-number "Buffer")) (b1 (aref (cadr entry1) fieldnum)) (b2 (aref (cadr entry2) fieldnum)) (data (mapcar (lambda (bufname) (if (string-match "\\`\\(.*\\)<\\([0-9]+\\)>\\s-*\\'" bufname) (cons (match-string 1 bufname) (string-to-number (match-string 2 bufname))))) (list b1 b2)))) (cond ((and (car data) (cadr data) (string= (caar data) (caar (cdr data)))) (< (cdar data) (cdadr data))) (t (string-lessp b1 b2))))) (defun listbuf-sort-cmp-size (entry1 entry2) (let* ((fieldnum (tabulated-list--column-number "Size")) (b1 (aref (cadr entry1) fieldnum)) (b2 (aref (cadr entry2) fieldnum))) (< (string-to-number b1) (string-to-number b2)))) (defun listbuf-sort-cmp-buffer-order (entry1 entry2) (let* ((n1 (aref (cadr entry1) 0)) (n2 (aref (cadr entry2) 0))) (< (get-text-property 0 'buffer-order-number n1) (get-text-property 0 'buffer-order-number n2)))) (defun listbuf-sort-by-buffer-name () (interactive) (tabulated-list-sort (tabulated-list--column-number "Buffer"))) (defun listbuf-sort-by-visited-file-order () (interactive) (tabulated-list-sort (tabulated-list--column-number "File"))) (defun listbuf-sort-by-buffer-order () (interactive) (setq tabulated-list-sort-key nil) (setq tabulated-list-entries (sort tabulated-list-entries 'listbuf-sort-cmp-buffer-order)) (tabulated-list-init-header) (tabulated-list-print t)) (define-key Buffer-menu-mode-map "A" 'listbuf-display-all-buffers) (define-key Buffer-menu-mode-map "B" 'listbuf-sort-by-buffer-name) (define-key Buffer-menu-mode-map "P" 'listbuf-sort-by-buffer-order) (define-key Buffer-menu-mode-map "F" 'listbuf-sort-by-visited-file-order) (defadvice list-buffers--refresh (around listbuf activate) (apply 'listbuf--refresh (ad-get-args 0))) (provide 'listbuf) ;;; listbuf.el ends here