: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
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")
'("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)
(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
(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
projects / emacs.git / commitdiff