Subject: Re: bug#69305: outline-minor-mode for tabulated-list-mode

From: Juri Linkov <[email-masked]>
Date: Thu, 22 Feb 2024 09:44:40 +0200

>> >> +(defcustom Buffer-menu-group-by nil
>> >> +  "If non-nil, buffers are grouped by function."
>> >> +  :type 'function
>> >> +  :group 'Buffer-menu
>> >> +  :version "30.1")
>> >
>> > Please consider letting users choose a symbol, not a function.  Each
>> > symbol can be mapped to a function, but having a user option whose
>> > values are functions makes it harder for users to customize the
>> > option.
>>
>> Ok, now the type is changed to 'symbol'.  Here is the complete patch:
>
> Thanks, but I wonder if we can be a tad more user-friendly?  The user
> option exists, and it can accept simple enough data structures for
> customizations, but the default is nil, and there's no example or
> pre-cooked list of ready-to-use values anywhere in sight, not even in
> the doc string.  Users will have to work hard to produce a grouping of
> their liking.  E.g., suppose I want to group buffers by mode -- how
> would I go about it?  Or what about grouping buffers by their leading
> directories -- how can that be done?  Etc. etc. -- this could be a
> very powerful feature, but we should make its use easier.  And, after
> reading the documentation of tabulated-list-groups and that of
> tabulated-list-entries several times, I have no idea how to specify
> simple groupings such as those described above.  Which makes examples
> or pre-cooked values even more important, IMO.

Ok, then this patch adds two pre-cooked functions as a starting point
for users to understand the principle.  Then users will propose
more functions and we will choose the most useful candidates
for including to the set of default functions later.

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..53bf66fdab1 100644
--- a/lisp/buff-menu.el
+++ b/lisp/buff-menu.el
@@ -95,6 +95,25 @@ 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.
+The default options can group by a mode, and by a root directory of
+a project or just `default-directory'."
+  :type '(choice (const :tag "No grouping" nil)
+                 (function-item :tag "Group by mode"
+                                Buffer-menu-group-by-mode)
+                 (function-item :tag "Group by root"
+                                Buffer-menu-group-by-root)
+                 (function :tag "Custom function"))
+  :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 +691,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 +772,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)
@@ -769,4 +795,13 @@ Buffer-menu--pretty-file-name
          (abbreviate-file-name list-buffers-directory))
 	(t "")))
 
+(defun Buffer-menu-group-by-mode (entry)
+  (concat "* " (aref (cadr entry) 5)))
+
+(defun Buffer-menu-group-by-root (entry)
+  (with-current-buffer (car entry)
+    (if-let ((project (project-current)))
+        (concat "* " (project-root project))
+      (concat "* " default-directory))))
+
 ;;; buff-menu.el ends here
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