Allow multi-level outlines in tabulated-list-groups used by list-buffers

* lisp/emacs-lisp/tabulated-list.el (tabulated-list-groups)
(tabulated-list-groups-categorize, tabulated-list-groups-sort)
(tabulated-list-groups-flatten): New functions (bug#70150).

* lisp/buff-menu.el (Buffer-menu-group-by): Change type from a function
to a list of functions.
(list-buffers--refresh): Use the function 'tabulated-list-groups' where
:path-function uses a list of functions from 'Buffer-menu-group-by', and
:sort-function is hard-coded to sort groups by name.
(Buffer-menu-group-by-mode, Buffer-menu-group-by-root): Remove prefix "*".

lisp/buff-menu.el

@@ -96,8 +96,10 @@ as it is by default."
   :version "22.1")
 
 (defcustom Buffer-menu-group-by nil
-  "If non-nil, a function to call to divide buffer-menu buffers into groups.
-This function is called with one argument: a list of entries in the same
+  "If non-nil, functions to call to divide buffer-menu buffers into groups.
+When customized to a list of functions, then each function defines
+the group name at each nested level of multiple levels.
+Each function is called with 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, `outline-minor-mode' is enabled in the Buffer Menu and you
@@ -107,11 +109,13 @@ The default options can group by a mode, and by a root directory of
 a project or just `default-directory'.
 If this is nil, buffers are not divided into groups."
   :type '(choice (const :tag "No grouping" nil)
-                 (const :tag "Group by mode"
-                        Buffer-menu-group-by-mode)
-                 (const :tag "Group by project root or directory"
-                        Buffer-menu-group-by-root)
-                 (function :tag "Custom function"))
+                 (repeat :tag "Group by"
+                  (choice
+                   (const :tag "Group by project root or directory"
+                          Buffer-menu-group-by-root)
+                   (const :tag "Group by mode"
+                          Buffer-menu-group-by-mode)
+                   (function :tag "Custom function"))))
   :group 'Buffer-menu
   :version "30.1")
 
@@ -775,10 +779,17 @@ See more at `Buffer-menu-filter-predicate'."
 		  '("File" 1 t)))
     (setq tabulated-list-use-header-line Buffer-menu-use-header-line)
     (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))))
+    (setq tabulated-list-groups
+          (tabulated-list-groups
+           tabulated-list-entries
+           `(:path-function
+             ,(lambda (entry)
+                (list (mapcar (lambda (f) (funcall f entry))
+                              Buffer-menu-group-by)))
+             :sort-function
+             ,(lambda (groups)
+                ;; Sort groups by name
+                (sort groups :key #'car :in-place t))))))
   (tabulated-list-init-header))
 
 (defun tabulated-list-entry-size-> (entry1 entry2)
@@ -799,16 +810,16 @@ See more at `Buffer-menu-filter-predicate'."
 
 (defun Buffer-menu-group-by-mode (entry)
   (let ((mode (aref (cadr entry) 5)))
-    (concat "* " (or (cdr (seq-find (lambda (group)
-                                      (string-match-p (car group) mode))
-                                    mouse-buffer-menu-mode-groups))
-                     mode))))
+    (or (cdr (seq-find (lambda (group)
+                         (string-match-p (car group) mode))
+                       mouse-buffer-menu-mode-groups))
+        mode)))
 
 (declare-function project-root "project" (project))
 (defun Buffer-menu-group-by-root (entry)
-  (concat "* " (with-current-buffer (car entry)
-                 (if-let ((project (project-current)))
-                     (project-root project)
-                   default-directory))))
+  (with-current-buffer (car entry)
+    (if-let ((project (project-current)))
+        (project-root project)
+      default-directory)))
 
 ;;; buff-menu.el ends here

lisp/emacs-lisp/tabulated-list.el

@@ -880,6 +880,84 @@ as the ewoc pretty-printer."
 
 (put 'tabulated-list-mode 'mode-class 'special)
 
+;;; Tabulated list groups
+
+(defun tabulated-list-groups (entries metadata)
+  "Make a flat list of groups from list of ENTRIES.
+Return the data structure suitable to be set to the variable
+`tabulated-list-groups'.  METADATA is a property list with two keys:
+PATH-FUNCTION is a function to put an entry from ENTRIES to the tree
+\(see `tabulated-list-groups-categorize' for more information);
+SORT-FUNCTION is a function to sort groups in the tree
+\(see `tabulated-list-groups-sort' for more information)."
+  (let* ((path-function (plist-get metadata :path-function))
+         (sort-function (plist-get metadata :sort-function))
+         (tree (tabulated-list-groups-categorize entries path-function)))
+    (when sort-function
+      (setq tree (tabulated-list-groups-sort tree sort-function)))
+    (tabulated-list-groups-flatten tree)))
+
+(defun tabulated-list-groups-categorize (entries path-function)
+  "Make a tree of groups from list of ENTRIES.
+On each entry from ENTRIES apply PATH-FUNCTION that should return a list of
+paths that the entry has on the group tree that means that every entry
+can belong to multiple categories.  Every path is a list of strings
+where every string is an outline heading at increasing level of deepness."
+  (let ((tree nil)
+        (hash (make-hash-table :test #'equal)))
+    (cl-labels
+        ((trie-add (list tree)
+           (when list
+             (setf (alist-get (car list) tree nil nil #'equal)
+                   (trie-add (cdr list)
+                             (alist-get (car list) tree nil nil #'equal)))
+             tree))
+         (trie-get (tree path)
+           (mapcar (lambda (elt)
+                     (cons (car elt)
+                           (if (cdr elt)
+                               (trie-get (cdr elt) (cons (car elt) path))
+                             (apply #'vector (nreverse
+                                              (gethash (reverse
+                                                        (cons (car elt) path))
+                                                       hash))))))
+                   (reverse tree))))
+      (dolist (entry entries)
+        (dolist (path (funcall path-function entry))
+          (unless (gethash path hash)
+            (setq tree (trie-add path tree)))
+          (cl-pushnew entry (gethash path hash))))
+      (trie-get tree nil))))
+
+(defun tabulated-list-groups-sort (tree sort-function)
+  "Sort TREE using the sort function SORT-FUN."
+  (mapcar (lambda (elt)
+            (if (vectorp (cdr elt))
+                elt
+              (cons (car elt) (tabulated-list-groups-sort
+                               (cdr elt) sort-function))))
+          (funcall sort-function tree)))
+
+(defun tabulated-list-groups-flatten (tree)
+  "Flatten multi-level TREE to single level."
+  (let ((header "") acc)
+    (cl-labels
+        ((flatten (tree level)
+           (mapcar (lambda (elt)
+                     (setq header (format "%s%s %s\n" header
+                                          (make-string level ?*)
+                                          (car elt)))
+                     (cond
+                      ((vectorp (cdr elt))
+                       (setq acc (cons (cons (string-trim-right header)
+                                             (append (cdr elt) nil))
+                                       acc))
+                       (setq header ""))
+                      (t (flatten (cdr elt) (1+ level)))))
+                   tree)))
+      (flatten tree 1)
+      (nreverse acc))))
+
 (provide 'tabulated-list)
 
 ;;; tabulated-list.el ends here