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.
-
-You can use @code{seq-group-by} to create @code{tabulated-list-groups}
-from @code{tabulated-list-entries}. For example:
-
-@smallexample
-@group
-(setq tabulated-list-groups
- (seq-group-by 'Buffer-menu-group-by-mode
- tabulated-list-entries))
-@end group
-@end smallexample
-
-@noindent
-where you can define @code{Buffer-menu-group-by-mode} like this:
-
-@smallexample
-@group
-(defun Buffer-menu-group-by-mode (entry)
- (concat "* " (aref (cadr entry) 5)))
-@end group
-@end smallexample
-@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
:group 'Buffer-menu
:version "22.1")
-(defcustom Buffer-menu-group-by nil
- "If non-nil, functions to call to divide buffer-menu buffers into groups.
-When customized to a function, this function should return names
-of all levels for each entry.
-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
-can use Outline minor mode commands to show/hide groups of buffers,
-according to the value of `outline-regexp'.
-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)
- (function :tag "Custom function")
- (repeat :tag "Use levels"
- (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 level function"))))
- :group 'Buffer-menu
- :version "30.1")
-
-(defcustom Buffer-menu-group-sort-by nil
- "If non-nil, function to sort buffer-menu groups by name.
-Each function is called with two arguments: an alist of groups
-where an alist key is a group name and also the level as a number,
-and should return the same alist where groups are sorted.
-If this is nil, group names are unsorted."
- :type '(choice (const :tag "No group sorting" nil)
- (const :tag "Sort groups alphabetically"
- Buffer-menu-group-sort-alphabetically)
- (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
(setq Buffer-menu-buffer-list buffer-list)
(setq Buffer-menu-filter-predicate filter-predicate)
(list-buffers--refresh buffer-list old-buffer)
- (tabulated-list-print)
- (when tabulated-list-groups
- (setq-local outline-minor-mode-cycle t
- outline-minor-mode-highlight t)
- (outline-minor-mode 1)))
+ (tabulated-list-print))
buffer))
(defun Buffer-menu-mouse-select (event)
`("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-groups
- (tabulated-list-groups
- tabulated-list-entries
- `(:path-function
- ,(if (functionp Buffer-menu-group-by)
- Buffer-menu-group-by
- (lambda (entry)
- (list (mapcar (lambda (f) (funcall f entry))
- Buffer-menu-group-by))))
- :sort-function ,Buffer-menu-group-sort-by))))
+ (setq tabulated-list-entries (nreverse entries)))
(tabulated-list-init-header))
(defun tabulated-list-entry-size-> (entry1 entry2)
(abbreviate-file-name list-buffers-directory))
(t "")))
-(defun Buffer-menu-group-by-mode (entry)
- (let ((mode (aref (cadr entry) 5)))
- (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)
- (with-current-buffer (car entry)
- (if-let ((project (project-current)))
- (project-root project)
- default-directory)))
-
-(defun Buffer-menu-group-sort-alphabetically (groups _level)
- (sort groups :in-place t :key #'car))
-
;;; buff-menu.el ends here
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
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 printed and sorted separately.
-
Optional argument REMEMBER-POS, if non-nil, means to move point
to the entry with the same ID element as the current line.
`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))
(setq saved-col (current-column)))
;; Sort the entries, if necessary.
(when 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))
+ (setq entries (sort entries sorter)))
(unless (functionp tabulated-list-entries)
(setq tabulated-list-entries entries))
;; Without a sorter, we have no way to just update.
(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)))
+ (setq saved-pt (tabulated-list-print-entries
+ entries sorter update entry-id))
(when update
(delete-region (point) (point-max)))
(set-buffer-modified-p nil)
(setq bidi-paragraph-direction 'left-to-right)
(header-line-indent-mode))
-(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 &optional level)
- "Sort TREE using the sort function SORT-FUN."
- (unless level (setq level 1))
- (mapcar (lambda (elt)
- (if (vectorp (cdr elt))
- elt
- (cons (car elt) (tabulated-list-groups-sort
- (cdr elt) sort-function (1+ level)))))
- (funcall sort-function tree level)))
-
-(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