diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 70d1a40f836..bb2100dbb4d 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -1239,6 +1239,21 @@ Tabulated List Mode above form when called with no arguments. @end defvar +@defvar tabulated-list-groups +This buffer-local variable specifies the groups of entries displayed in +the Tabulated List buffer. Its value should be either a list, or a +function. + +If the value is a list, each list element corresponds to one group, and +should have the form @w{@code{(@var{group-name} @var{entries})}}, where +@var{group-name} is a string inserted before all group entries, and +@var{entries} have the same format as @code{tabulated-list-entries} +(see above). + +Otherwise, the value should be a function which returns a list of the +above form when called with no arguments. +@end defvar + @defvar tabulated-list-revert-hook This normal hook is run prior to reverting a Tabulated List buffer. A derived mode can add a function to this hook to recompute diff --git a/etc/NEWS b/etc/NEWS index 7b248c3fe78..b549eab9f0b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1332,6 +1332,11 @@ will return the URL for that bug. This allows for rcirc logs to use a custom timestamp format, than the chat buffers use by default. +--- +*** New user option 'Buffer-menu-group-by'. +It splits buffers by groups that are displayed with headings in +Outline minor mode. + --- *** New command 'Buffer-menu-toggle-internal'. This command toggles the display of internal buffers in Buffer Menu mode; @@ -1997,6 +2002,10 @@ inside 'treesit-language-source-alist', so that calling It may be useful, for example, for the purposes of bisecting a treesitter grammar. ++++ +** New buffer-local variable 'tabulated-list-groups'. +It prints and sorts the groups of entries separately. + * Changes in Emacs 30.1 on Non-Free Operating Systems diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index e13c3b56b4e..62717c4625b 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -95,6 +95,18 @@ Buffer-menu-use-frame-buffer-list :group 'Buffer-menu :version "22.1") +(defcustom Buffer-menu-group-by nil + "If non-nil, buffers are grouped by function. +This function takes one argument: a list of entries in the same format +as in `tabulated-list-entries', and should return a list in the format +suitable for `tabulated-list-groups'. Also when this variable is non-nil, +then `outline-minor-mode' is enabled in the Buffer Menu. Then with the +default value of `outline-regexp' you can use Outline minor mode commands +to show/hide groups of buffers." + :type 'symbol + :group 'Buffer-menu + :version "30.1") + (defvar-local Buffer-menu-files-only nil "Non-nil if the current Buffer Menu lists only file buffers. This is set by the prefix argument to `buffer-menu' and related @@ -674,7 +684,12 @@ list-buffers-noselect (setq Buffer-menu-buffer-list buffer-list) (setq Buffer-menu-filter-predicate filter-predicate) (list-buffers--refresh buffer-list old-buffer) - (tabulated-list-print)) + (tabulated-list-print) + (when tabulated-list-groups + (setq-local outline-minor-mode-cycle t + outline-minor-mode-highlight t + outline-minor-mode-use-buttons 'in-margins) + (outline-minor-mode 1))) buffer)) (defun Buffer-menu-mouse-select (event) @@ -750,7 +765,11 @@ list-buffers--refresh `("Mode" ,Buffer-menu-mode-width t) '("File" 1 t))) (setq tabulated-list-use-header-line Buffer-menu-use-header-line) - (setq tabulated-list-entries (nreverse entries))) + (setq tabulated-list-entries (nreverse entries)) + (when Buffer-menu-group-by + (setq tabulated-list-groups + (seq-group-by Buffer-menu-group-by + tabulated-list-entries)))) (tabulated-list-init-header)) (defun tabulated-list-entry-size-> (entry1 entry2) diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index 9884a2fc24b..a78e1726c26 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -139,6 +139,21 @@ tabulated-list-entries arguments and must return a list of the above form.") (put 'tabulated-list-entries 'permanent-local t) +(defvar-local tabulated-list-groups nil + "Groups displayed in the current Tabulated List buffer. +This should be either a function, or a list. +If a list, each element has the form (GROUP-NAME ENTRIES), +where: + + - GROUP-NAME is a group name as a string, which is displayed + at the top line of each group. + + - ENTRIES is a list described in `tabulated-list-entries'. + +If `tabulated-list-groups' is a function, it is called with no +arguments and must return a list of the above form.") +(put 'tabulated-list-groups 'permanent-local t) + (defvar-local tabulated-list-padding 0 "Number of characters preceding each Tabulated List mode entry. By default, lines are padded with spaces, but you can use the @@ -427,6 +444,9 @@ tabulated-list-print specified by `tabulated-list-sort-key'. It then erases the buffer and inserts the entries with `tabulated-list-printer'. +If `tabulated-list-groups' is non-nil, each group of entries +is sorted separately after printing the group header line. + Optional argument REMEMBER-POS, if non-nil, means to move point to the entry with the same ID element as the current line. @@ -437,6 +457,9 @@ tabulated-list-print `tabulated-list-put-tag'). Don't use this immediately after changing `tabulated-list-sort-key'." (let ((inhibit-read-only t) + (groups (if (functionp tabulated-list-groups) + (funcall tabulated-list-groups) + tabulated-list-groups)) (entries (if (functionp tabulated-list-entries) (funcall tabulated-list-entries) tabulated-list-entries)) @@ -447,7 +470,14 @@ tabulated-list-print (setq saved-col (current-column))) ;; Sort the entries, if necessary. (when sorter - (setq entries (sort entries sorter))) + (if groups + (setq groups + (mapcar (lambda (group) + (cons (car group) (sort (cdr group) sorter))) + groups)) + (setq entries (sort entries sorter)))) + (unless (functionp tabulated-list-groups) + (setq tabulated-list-groups groups)) (unless (functionp tabulated-list-entries) (setq tabulated-list-entries entries)) ;; Without a sorter, we have no way to just update. @@ -459,6 +489,25 @@ tabulated-list-print (unless tabulated-list-use-header-line (tabulated-list-print-fake-header))) ;; Finally, print the resulting list. + (if groups + (dolist (group groups) + (insert (car group) ?\n) + (when-let ((saved-pt-new (tabulated-list-print-entries + (cdr group) sorter update entry-id))) + (setq saved-pt saved-pt-new))) + (setq saved-pt (tabulated-list-print-entries + entries sorter update entry-id))) + (when update + (delete-region (point) (point-max))) + (set-buffer-modified-p nil) + ;; If REMEMBER-POS was specified, move to the "old" location. + (if saved-pt + (progn (goto-char saved-pt) + (move-to-column saved-col)) + (goto-char (point-min))))) + +(defun tabulated-list-print-entries (entries sorter update entry-id) + (let (saved-pt) (while entries (let* ((elt (car entries)) (tabulated-list--near-rows @@ -495,14 +544,7 @@ tabulated-list-print (forward-line 1) (delete-region old (point)))))) (setq entries (cdr entries))) - (when update - (delete-region (point) (point-max))) - (set-buffer-modified-p nil) - ;; If REMEMBER-POS was specified, move to the "old" location. - (if saved-pt - (progn (goto-char saved-pt) - (move-to-column saved-col)) - (goto-char (point-min))))) + saved-pt)) (defun tabulated-list-print-entry (id cols) "Insert a Tabulated List entry at point. diff --git a/test/lisp/emacs-lisp/tabulated-list-tests.el b/test/lisp/emacs-lisp/tabulated-list-tests.el index 8be2be3139e..e53268b3f14 100644 --- a/test/lisp/emacs-lisp/tabulated-list-tests.el +++ b/test/lisp/emacs-lisp/tabulated-list-tests.el @@ -130,4 +130,45 @@ tabulated-list-sort (should-error (tabulated-list-sort) :type 'user-error) (should-error (tabulated-list-sort 4) :type 'user-error))) +(ert-deftest tabulated-list-groups () + (with-temp-buffer + (tabulated-list-mode) + (setq tabulated-list-groups + (reverse + (seq-group-by (lambda (b) (concat "* " (aref (cadr b) 3))) + tabulated-list--test-entries))) + (setq tabulated-list-format tabulated-list--test-format) + (setq tabulated-list-padding 7) + (tabulated-list-init-header) + (tabulated-list-print) + ;; Basic printing. + (should (string-equal + (buffer-substring-no-properties (point-min) (point-max)) + "\ +* installed + zzzz-game zzzz-game 2113 installed play zzzz in Emacs + mode mode 1128 installed A simple mode for editing Actionscript 3 files +* available + abc-mode abc-mode 944 available Major mode for editing abc music files +* obsolete + 4clojure 4clojure 1507 obsolete Open and evaluate 4clojure.com questions +")) + ;; Sort and preserve position. + (forward-line 2) + (let ((pos (thing-at-point 'line))) + (tabulated-list-next-column 2) + (tabulated-list-sort) + (should (equal (thing-at-point 'line) pos)) + (should (string-equal + (buffer-substring-no-properties (point-min) (point-max)) + "\ +* installed + mode mode 1128 installed A simple mode for editing Actionscript 3 files + zzzz-game zzzz-game 2113 installed play zzzz in Emacs +* available + abc-mode abc-mode 944 available Major mode for editing abc music files +* obsolete + 4clojure 4clojure 1507 obsolete Open and evaluate 4clojure.com questions +"))))) + ;;; tabulated-list-tests.el ends here