bug#58784: 28.2; project-buffers incorrect under let-bound default-directory

[Dmitry Gutov <dgutov@yandex.ru>]

[-- Attachment #1: Type: text/plain, Size: 2563 bytes --]

Hi!

On 26.10.2022 03:13, Sean Devlin wrote:
> The project.el function project-buffers can return incorrect results
> when invoked while a let-binding for default-directory is in
> effect. This is because project-buffers (both the default and vc-based
> implementations) does its work by inspecting the local value of
> default-directory in each buffer, and the let-binding temporarily
> affects this value.
> 
> To see this in action, start emacs with -Q and evaluate the following
> forms in order:
> 
> (require 'project)
> 
> (find-file-noselect "/tmp/tmpfile")
> (setq my-project '(transient . "/tmp/"))
> 
> ;; just the tmpfile
> (project-buffers my-project)
> 
> ;; both tmpfile and scratch
> (let ((default-directory "/tmp/"))
>    (project-buffers my-project))

Thanks for the report, I can see the problem.

> In the last form, project-buffers includes the current buffer (i.e. the
> scratch buffer in our example) with the results. (This is true even if
> the current buffer is visiting a file in some unrelated directory.)
> 
> This matters because the command project-switch-project let-binds
> default-directory before calling project-switch-commands. This means
> that if you set project-switch-commands to some function that calls
> project-buffers, you will get incorrect results.
> 
> For example, evaluate the following forms in order:
> 
> (defun my-list-project-buffers ()
>    "List the current project's buffers."
>    (interactive)
>    (let ((buffer-list (project-buffers (project-current t)))
> 	(buffer-name (project-prefixed-buffer-name "my-project-buffer-list")))
>      (with-current-buffer (get-buffer-create buffer-name)
>        (erase-buffer)
>        (save-excursion
> 	(dolist (buffer buffer-list)
> 	  (insert (buffer-name buffer))
> 	  (insert ?\n))))
>      (switch-to-buffer buffer-name)))
> 
> (setq project-switch-commands #'my-list-project-buffers)

Looks like a reimplementation of projectile-ibuffer, seems useful.

> ;; list tmpfile but also scratch
> (project-switch-project "/tmp/")

Not sure how to fix this, though. In bug#53626 we discussed a somewhat 
similar problem, and a let-binding seems impossible to "escape".

What else can we do? One option is to change the signature of every 
compatible command to take the project object as its first argument. 
Might have been more realistic when the package was first written, too 
much breakage now, probably.

Another would be to add a new var to help override the project choice 
without touch default-directory.

Something like the attached. Please try it out.

[-- Attachment #2: project-current-directory-override.diff --]
[-- Type: text/x-patch, Size: 1839 bytes --]

diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index ac278edd40..48ed033fa1 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -175,8 +175,14 @@ project-find-functions
 `cl-defmethod' can dispatch on, like a cons cell, or a list, or a
 CL struct.")
 
-(defvar project-current-inhibit-prompt nil
-  "Non-nil to skip prompting the user in `project-current'.")
+(define-obsolete-variable-alias
+  'project-current-inhibit-prompt
+  'project-current-directory-override
+  "29.1")
+
+(defvar project-current-directory-override nil
+  "Value to use instead of `default-directory' when detecting the project.
+When it is non-nil, `project-current' will skip always skip prompting.")
 
 ;;;###autoload
 (defun project-current (&optional maybe-prompt directory)
@@ -195,11 +201,12 @@ project-current
 
 See the doc string of `project-find-functions' for the general form
 of the project instance object."
-  (unless directory (setq directory default-directory))
+  (unless directory (setq directory (or project-current-directory-override
+                                        default-directory)))
   (let ((pr (project--find-in-directory directory)))
     (cond
      (pr)
-     ((unless project-current-inhibit-prompt
+     ((unless project-current-directory-override
         maybe-prompt)
       (setq directory (project-prompt-project-dir)
             pr (project--find-in-directory directory))))
@@ -1667,8 +1674,7 @@ project-switch-project
   (let ((command (if (symbolp project-switch-commands)
                      project-switch-commands
                    (project--switch-project-command))))
-    (let ((default-directory dir)
-          (project-current-inhibit-prompt t))
+    (let ((project-current-directory-override dir))
       (call-interactively command))))
 
 (provide 'project)