From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Juri Linkov Newsgroups: gmane.emacs.bugs Subject: bug#69305: outline-minor-mode for tabulated-list-mode Date: Thu, 22 Feb 2024 09:44:40 +0200 Organization: LINKOV.NET Message-ID: <86cyspt02f.fsf@mail.linkov.net> References: <86msrtvi06.fsf@mail.linkov.net> <86frxlmy1d.fsf@gnu.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="9300"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/30.0.50 (x86_64-pc-linux-gnu) Cc: 69305@debbugs.gnu.org To: Eli Zaretskii Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Thu Feb 22 08:48:03 2024 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1rd3oI-00027I-PQ for geb-bug-gnu-emacs@m.gmane-mx.org; Thu, 22 Feb 2024 08:48:02 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1rd3nx-0005Zt-Uh; Thu, 22 Feb 2024 02:47:41 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rd3nw-0005WS-0G for bug-gnu-emacs@gnu.org; Thu, 22 Feb 2024 02:47:40 -0500 Original-Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1rd3nv-0004Hv-88 for bug-gnu-emacs@gnu.org; Thu, 22 Feb 2024 02:47:39 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1rd3oH-0007GW-Oi for bug-gnu-emacs@gnu.org; Thu, 22 Feb 2024 02:48:01 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Juri Linkov Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Thu, 22 Feb 2024 07:48:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 69305 X-GNU-PR-Package: emacs Original-Received: via spool by 69305-submit@debbugs.gnu.org id=B69305.170858806627890 (code B ref 69305); Thu, 22 Feb 2024 07:48:01 +0000 Original-Received: (at 69305) by debbugs.gnu.org; 22 Feb 2024 07:47:46 +0000 Original-Received: from localhost ([127.0.0.1]:60620 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rd3o1-0007Fl-Qh for submit@debbugs.gnu.org; Thu, 22 Feb 2024 02:47:46 -0500 Original-Received: from relay9-d.mail.gandi.net ([217.70.183.199]:50109) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rd3ny-0007FG-Hj for 69305@debbugs.gnu.org; Thu, 22 Feb 2024 02:47:44 -0500 Original-Received: by mail.gandi.net (Postfix) with ESMTPSA id CE7E6FF802; Thu, 22 Feb 2024 07:47:12 +0000 (UTC) In-Reply-To: <86frxlmy1d.fsf@gnu.org> (Eli Zaretskii's message of "Wed, 21 Feb 2024 21:12:46 +0200") X-GND-Sasl: juri@linkov.net X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:280435 Archived-At: --=-=-= Content-Type: text/plain >> >> +(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. --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=tabulated-list-groups.patch 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 --=-=-=--