Subject: bug#62759: closed (Re: bug#62759: [PATCH] add support for prompting for projects by name)

From: [email-masked] (GNU bug Tracking System)
Date: Mon, 10 Apr 2023 23:21:02 +0000

Your bug report

#62759: [PATCH] add support for prompting for projects by name

which was filed against the emacs package, has been closed.

The explanation is attached below, along with your original report.
If you require more details, please reply to [email-masked].

-- 
62759: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=62759
GNU Bug Tracking System
Contact [email-masked] with problems

Subject: Re: bug#62759: [PATCH] add support for prompting for projects by name
From: Dmitry Gutov <[email-masked]>
To: Spencer Baugh <[email-masked]>, [email-masked]
Date: Tue, 11 Apr 2023 02:20:22 +0300
List-Id: <debbugs-submit.debbugs.gnu.org>

Hi! Thanks for the patch. Pushed to master.

Next time please also add the full common message, though.

Also note that the idea behind the current default (and also why it 
doesn't return a project instance: just the dir) was to avoid visiting 
all the directories -- because some might be unavailable at this exact 
moment (e.g. remote, over Tramp, and currently disconnected), and some 
simply slow.

It shouldn't hurt to have this as an alternative behavior, though.

Subject: [PATCH] add support for prompting for projects by name
From: Spencer Baugh <[email-masked]>
To: [email-masked]
Date: Mon, 10 Apr 2023 15:14:53 -0400
List-Id: <debbugs-submit.debbugs.gnu.org>

Tags: patch

This add a new function project-prompt-project-name, and a
project-prompter customize variable which can be used to switch between
that function and the existing project-prompt-project-dir.

In GNU Emacs 29.0.60 (build 3, x86_64-pc-linux-gnu, X toolkit, cairo
 version 1.15.12, Xaw scroll bars) of 2023-03-13 built on
 igm-qws-u22796a
Repository revision: e759905d2e0828eac4c8164b09113b40f6899656
Repository branch: emacs-29
Windowing system distributor 'The X.Org Foundation', version 11.0.12011000
System Description: CentOS Linux 7 (Core)

Configured using:
 'configure --with-x-toolkit=lucid --with-modules
 --with-gif=ifavailable'

>From e7a03ab0e74bddadf8fa349587ab60cc7f63f6c2 Mon Sep 17 00:00:00 2001
From: Spencer Baugh <[email-masked]>
Date: Mon, 10 Apr 2023 15:11:06 -0400
Subject: [PATCH] add support for prompting for projects by name

---
 lisp/progmodes/project.el | 43 ++++++++++++++++++++++++++++++++++++---
 1 file changed, 40 insertions(+), 3 deletions(-)

diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 877d79353aa..e7c0bd2069b 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -202,6 +202,17 @@ project-current-directory-override
   "Value to use instead of `default-directory' when detecting the project.
 When it is non-nil, `project-current' will always skip prompting too.")
 
+(defcustom project-prompter #'project-prompt-project-dir
+  "Function to call to prompt for a project.
+Called with no arguments and should return a project root dir."
+  :type '(choice (const :tag "Prompt for a project directory"
+                        project-prompt-project-dir)
+                 (const :tag "Prompt for a project name"
+                        project-prompt-project-name)
+                 (function :tag "Custom function" nil))
+  :group 'project
+  :version "30.1")
+
 ;;;###autoload
 (defun project-current (&optional maybe-prompt directory)
   "Return the project instance in DIRECTORY, defaulting to `default-directory'.
@@ -226,7 +237,7 @@ project-current
      (pr)
      ((unless project-current-directory-override
         maybe-prompt)
-      (setq directory (project-prompt-project-dir)
+      (setq directory (funcall project-prompter)
             pr (project--find-in-directory directory))))
     (when maybe-prompt
       (if pr
@@ -1615,7 +1626,7 @@ project-forget-project
   "Remove directory PROJECT-ROOT from the project list.
 PROJECT-ROOT is the root directory of a known project listed in
 the project list."
-  (interactive (list (project-prompt-project-dir)))
+  (interactive (list (funcall project-prompter)))
   (project--remove-from-project-list
    project-root "Project `%s' removed from known projects"))
 
@@ -1639,6 +1650,32 @@ project-prompt-project-dir
         (read-directory-name "Select directory: " default-directory nil t)
       pr-dir)))
 
+(defun project-prompt-project-name ()
+  "Prompt the user for a project, by name, that is one of the known project roots.
+The project is chosen among projects known from the project list,
+see `project-list-file'.
+It's also possible to enter an arbitrary directory not in the list."
+  (let* ((dir-choice "... (choose a dir)")
+         (choices
+          (let (ret)
+            (dolist (dir (project-known-project-roots))
+              ;; we filter out directories that no longer map to a project,
+              ;; since they don't have a clean project-name.
+              (if-let (proj (project--find-in-directory dir))
+                  (push (cons (project-name proj) proj) ret)))
+            ret))
+         ;; XXX: Just using this for the category (for the substring
+         ;; completion style).
+         (table (project--file-completion-table (cons dir-choice choices)))
+         (pr-name ""))
+    (while (equal pr-name "")
+      ;; If the user simply pressed RET, do this again until they don't.
+      (setq pr-name (completing-read "Select project: " table nil t)))
+    (if (equal pr-name dir-choice)
+        (read-directory-name "Select directory: " default-directory nil t)
+      (let ((proj (assoc pr-name choices)))
+        (if (stringp proj) proj (project-root (cdr proj)))))))
+
 ;;;###autoload
 (defun project-known-project-roots ()
   "Return the list of root directories of all known projects."
@@ -1826,7 +1863,7 @@ project-switch-project
 
 When called in a program, it will use the project corresponding
 to directory DIR."
-  (interactive (list (project-prompt-project-dir)))
+  (interactive (list (funcall project-prompter)))
   (let ((command (if (symbolp project-switch-commands)
                      project-switch-commands
                    (project--switch-project-command))))
-- 
2.30.2