Subject: bug#59502: 29.0.50; [PATCH] Dedicated buffers per project

From: Gabriel <[email-masked]>
Date: Wed, 23 Nov 2022 02:11:36 -0300

Severity: wishlist

Description:

Currently, xref commands in project.el (`project-find-regexp' and
`project-or-external-find-regexp') use a "default" xref buffer (through
a call to `xref-show-xrefs').  It's a "default" buffer because it uses a
constant name ("*xref*") for the xref buffers created (see
`xref-buffer-name').

If a user is working with two or more projects, any xref command will
override a previous "*xref*" buffer.  Thus, it's required that the user
first manually rename any existing xref buffer prior to executing a new
xref command, in order to keep the xref buffers of other projects.  The
same is true for "*Buffer List*", "*Shell Command Output*" and "*Async
Shell Command*" buffers.

Currently, project.el already support prefix names for compilation,
shell and eshell commands (see `project-prefixed-buffer-name' and
`project-compilation-buffer-name-function').  The "*vc-dir*" buffer
created by `project-vc-dir' is handled by uniquify.el
(`vc-dir-prepare-status-buffer' uses `create-file-buffer').

In summary, project.el currently has the following behavior and
customization options:

| Project Command                   | Generated Buffer         | Current Behavior              | Customization Options                      |
|-----------------------------------+--------------------------+-------------------------------+--------------------------------------------|
| `project-find-regexp'             | "*xref*"                 | Use a default buffer          | Not available                              |
| `project-or-external-find-regexp' | "*xref*"                 | Use a default buffer          | Not available                              |
| `project-list-buffers'            | "*Buffer List*"          | Use a default buffer          | Not available                              |
| `project-kill-buffers'            | "*Buffer List*"          | Use a default buffer          | Not available                              |
| `project-shell-command'           | "*Shell Command Output*" | Use a default buffer          | Not available                              |
| `project-async-shell-command'     | "*Async Shell Command*"  | Use a default buffer          | Not available                              |
| `project-compile`                 | "*compilation*"          | Use a default buffer          | `project-compilation-buffer-name-function' |
| `project-vc-dir'                  | "*vc-dir*"               | Use a default buffer          | Through uniquify.el defcustom's            |
| `project-shell'                   | "*shell*"                | Use a project prefixed buffer | Not available                              |
| `project-eshell'                  | "*eshell*"               | Use a project prefixed buffer | Not available                              |

My suggestion is to improve the consistency of how project-related
buffers are created and named, providing sufficient customization
options for users.

Solutions:

1) Make all project-related buffers use by default
`project-prefixed-buffer-name'.  This is similar to how `project-shell'
and `project-eshell' behaves today.  The downsides are the lack of
customization options for users and the introduction of behavior changes
related to how some project-related buffers are currently named.

2) Create dedicated defcustom's for each project-related buffer.  This
is similar to how `project-compile' behaves today, by allowing users to
customize the option `project-compilation-buffer-name-function'.  The
downside is the excessive number of new defcustom's.

3) Create a single defcustom to compute the name of project-related
buffers.  This is similar to how `project-compile' behaves today, but
would be a more general-purpose customization option.  This is currently
my preferred solution (see the attached patch).  I tried to make it
simple, consistent and without introducing behavior changes related to
how project-related buffers are currently named, but I am not really
happy with the implementation.  An example of how users could customize
this option is presented below:

(setopt project-buffer-name-function
        (lambda (name)
            (format "*%s-%s*"
                    (project-name (project-current))
                    name)))

>From 1bd545fac60f955c1d8b6de2db3a0aca6b9d32c5 Mon Sep 17 00:00:00 2001
From: Gabriel do Nascimento Ribeiro <[email-masked]>
Date: Wed, 23 Nov 2022 01:50:21 -0300
Subject: [PATCH 1/1] Add user option `project-buffer-name-function'

* lisp/buff-menu.el (Buffer-menu-buffer-name): New constant to store
the default buffer name.
(list-buffers-noselect): Use the new constant.

* lisp/vc/vc-dir.el (vc-dir-buffer-name): New constant to store
the default buffer name.
(vc-dir): Use the new constant.

* lisp/progmodes/project.el (project-buffer-name-function): New user
option to allow customization of project-related buffer names.
(project-compilation-buffer-name-function): Make obsolete.
(project-buffer-name-default): New function to compute the name of
project-related buffers.
(project-find-regexp, project-or-external-find-regexp, project-vc-dir)
(project-shell, project-eshell, project-async-shell-command)
(project-shell-command, project-compile, project-list-buffers)
(project-kill-buffers): Use the new user option
`project-buffer-name-function' to compute the buffer name.

* etc/NEWS: Announce the changes.
---
 etc/NEWS                  |  8 +++++
 lisp/buff-menu.el         |  7 +++--
 lisp/progmodes/project.el | 65 ++++++++++++++++++++++++++++++---------
 lisp/vc/vc-dir.el         |  7 ++++-
 4 files changed, 69 insertions(+), 18 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 5a65896d69..b3e1b5e3c4 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2263,6 +2263,14 @@ matches.
 ---
 *** New function 'xref-show-xrefs'.
 
++++
+*** New user option 'project-buffer-name-function'.
+This control the name of project-related buffers.
+
+---
+*** 'project-compilation-buffer-name-function' is now obsolete.
+Use the new user option 'project-buffer-name-function' instead.
+
 ** File notifications
 
 +++
diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el
index aa5f70edf2..e6b91682dd 100644
--- a/lisp/buff-menu.el
+++ b/lisp/buff-menu.el
@@ -95,6 +95,9 @@ Buffer-menu-use-frame-buffer-list
   :group 'Buffer-menu
   :version "22.1")
 
+(defconst Buffer-menu-buffer-name "*Buffer List*"
+  "Name of the output buffer for `buffer-menu' and related commands.")
+
 (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
@@ -634,11 +637,11 @@ list-buffers-noselect
 that filters out buffers from the list of buffers.
 See more at `Buffer-menu-filter-predicate'."
   (let ((old-buffer (current-buffer))
-	(buffer (get-buffer-create "*Buffer List*")))
+        (buffer (get-buffer-create Buffer-menu-buffer-name)))
     (with-current-buffer buffer
       (Buffer-menu-mode)
       (setq Buffer-menu-files-only
-	    (and files-only (>= (prefix-numeric-value files-only) 0)))
+            (and files-only (>= (prefix-numeric-value files-only) 0)))
       (setq Buffer-menu-filter-predicate filter-predicate)
       (list-buffers--refresh buffer-list old-buffer)
       (tabulated-list-print))
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 751e240a56..d706bd128f 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -818,7 +818,8 @@ project-find-regexp
                                             caller-dir nil t)))
               (project--files-in-directory dir
                                            nil
-                                           (grep-read-files regexp))))))
+                                           (grep-read-files regexp)))))
+         (xref-buffer-name (funcall project-buffer-name-function "xref")))
     (xref-show-xrefs
      (apply-partially #'project--find-regexp-in-files regexp files)
      nil)))
@@ -846,7 +847,8 @@ project-or-external-find-regexp
          (files
           (project-files pr (cons
                              (project-root pr)
-                             (project-external-roots pr)))))
+                             (project-external-roots pr))))
+         (xref-buffer-name (funcall project-buffer-name-function "xref")))
     (xref-show-xrefs
      (apply-partially #'project--find-regexp-in-files regexp files)
      nil)))
@@ -1024,7 +1026,8 @@ project-dired
 (defun project-vc-dir ()
   "Run VC-Dir in the current project's root."
   (interactive)
-  (vc-dir (project-root (project-current t))))
+  (let ((vc-dir-buffer-name (funcall project-buffer-name-function "vc-dir")))
+    (vc-dir (project-root (project-current t)))))
 
 (declare-function comint-check-proc "comint")
 
@@ -1038,13 +1041,13 @@ project-shell
   (interactive)
   (require 'comint)
   (let* ((default-directory (project-root (project-current t)))
-         (default-project-shell-name (project-prefixed-buffer-name "shell"))
-         (shell-buffer (get-buffer default-project-shell-name)))
+         (buffer-name (funcall project-buffer-name-function "shell"))
+         (shell-buffer (get-buffer buffer-name)))
     (if (and shell-buffer (not current-prefix-arg))
         (if (comint-check-proc shell-buffer)
             (pop-to-buffer shell-buffer (bound-and-true-p display-comint-buffer-action))
           (shell shell-buffer))
-      (shell (generate-new-buffer-name default-project-shell-name)))))
+      (shell (generate-new-buffer-name buffer-name)))))
 
 ;;;###autoload
 (defun project-eshell ()
@@ -1056,7 +1059,7 @@ project-eshell
   (interactive)
   (defvar eshell-buffer-name)
   (let* ((default-directory (project-root (project-current t)))
-         (eshell-buffer-name (project-prefixed-buffer-name "eshell"))
+         (eshell-buffer-name (funcall project-buffer-name-function "eshell"))
          (eshell-buffer (get-buffer eshell-buffer-name)))
     (if (and eshell-buffer (not current-prefix-arg))
         (pop-to-buffer eshell-buffer (bound-and-true-p display-comint-buffer-action))
@@ -1067,7 +1070,9 @@ project-async-shell-command
   "Run `async-shell-command' in the current project's root directory."
   (declare (interactive-only async-shell-command))
   (interactive)
-  (let ((default-directory (project-root (project-current t))))
+  (let ((default-directory (project-root (project-current t)))
+        (shell-command-buffer-name-async (funcall project-buffer-name-function
+                                                  "Async Shell Command")))
     (call-interactively #'async-shell-command)))
 
 ;;;###autoload
@@ -1075,7 +1080,9 @@ project-shell-command
   "Run `shell-command' in the current project's root directory."
   (declare (interactive-only shell-command))
   (interactive)
-  (let ((default-directory (project-root (project-current t))))
+  (let ((default-directory (project-root (project-current t)))
+        (shell-command-buffer-name (funcall project-buffer-name-function
+                                            "Shell Command Output")))
     (call-interactively #'shell-command)))
 
 (declare-function fileloop-continue "fileloop" ())
@@ -1136,6 +1143,32 @@ project-compilation-buffer-name-function
                  (const :tag "Prefixed with root directory name"
                         project-prefixed-buffer-name)
                  (function :tag "Custom function")))
+(make-obsolete-variable 'project-compilation-buffer-name-function
+                        'project-buffer-name-function
+                        "29.1")
+
+(defcustom project-buffer-name-function 'project-buffer-name-default
+  "Function to compute the name of a project buffer.
+Function receives one argument, the base buffer name as string.
+It should return the buffer name as string."
+  :version "29.1"
+  :group 'project
+  :type 'function)
+
+(defun project-buffer-name-default (name)
+  "Function to compute buffer names for project commands."
+  (pcase name
+    ("compilation"          (compilation--default-buffer-name name))
+    ("shell"                (project-prefixed-buffer-name name))
+    ("eshell"               (project-prefixed-buffer-name name))
+    ("Shell Command Output" shell-command-buffer-name)
+    ("Async Shell Command"  shell-command-buffer-name-async)
+    ("Buffer List"          Buffer-menu-buffer-name)
+    ("xref"                 xref-buffer-name)
+    ("vc-dir"               vc-dir-buffer-name)
+    (t                      (format "*%s-%s*"
+                                    (project-name (project-current))
+                                    name))))
 
 ;;;###autoload
 (defun project-compile ()
@@ -1143,9 +1176,9 @@ project-compile
   (declare (interactive-only compile))
   (interactive)
   (let ((default-directory (project-root (project-current t)))
-        (compilation-buffer-name-function
-         (or project-compilation-buffer-name-function
-             compilation-buffer-name-function)))
+        (compilation-buffer-name-function (lambda (_)
+                                            (funcall project-buffer-name-function
+                                                     "compilation"))))
     (call-interactively #'compile)))
 
 (defcustom project-ignore-buffer-conditions nil
@@ -1231,13 +1264,13 @@ project-display-buffer-other-frame
 ;;;###autoload
 (defun project-list-buffers (&optional arg)
   "Display a list of project buffers.
-The list is displayed in a buffer named \"*Buffer List*\".
 
 By default, all project buffers are listed except those whose names
 start with a space (which are for internal use).  With prefix argument
 ARG, show only buffers that are visiting files."
   (interactive "P")
-  (let ((pr (project-current t)))
+  (let ((pr (project-current t))
+        (Buffer-menu-buffer-name (funcall project-buffer-name-function "Buffer List")))
     (display-buffer
      (if (version< emacs-version "29.0.50")
          (let ((buf (list-buffers-noselect arg (project-buffers pr))))
@@ -1365,6 +1398,8 @@ project-kill-buffers
   (interactive)
   (let* ((pr (project-current t))
          (bufs (project--buffers-to-kill pr))
+         (Buffer-menu-buffer-name (funcall project-buffer-name-function
+                                           "Buffer List"))
          (query-user (lambda ()
                        (yes-or-no-p
                         (format "Kill %d buffers in %s? "
@@ -1377,7 +1412,7 @@ project-kill-buffers
           (project-kill-buffers-display-buffer-list
            (when
                (with-current-buffer-window
-                   (get-buffer-create "*Buffer List*")
+                   (get-buffer-create Buffer-menu-buffer-name)
                    `(display-buffer--maybe-at-bottom
                      (dedicated . t)
                      (window-height . (fit-window-to-buffer))
diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el
index 037de415e6..ff7ac2e025 100644
--- a/lisp/vc/vc-dir.el
+++ b/lisp/vc/vc-dir.el
@@ -118,6 +118,10 @@ vc-dir-status-ignored
   ;; To distinguish files and directories.
   directory)
 
+;;;###autoload
+(defconst vc-dir-buffer-name "*vc-dir*"
+  "Name of the output buffer for `vc-dir' command.")
+
 (defvar vc-ewoc nil)
 
 (defvar vc-dir-process-buffer nil
@@ -1446,7 +1450,8 @@ vc-dir
   (unless backend
     (setq backend (vc-responsible-backend dir)))
   (let (pop-up-windows)		      ; based on cvs-examine; bug#6204
-    (pop-to-buffer (vc-dir-prepare-status-buffer "*vc-dir*" dir backend)))
+    (pop-to-buffer (vc-dir-prepare-status-buffer vc-dir-buffer-name
+                                                 dir backend)))
   (if (derived-mode-p 'vc-dir-mode)
       (vc-dir-refresh)
     ;; FIXME: find a better way to pass the backend to `vc-dir-mode'.
-- 
2.34.1

Please share your comments or suggestions.

---
Gabriel