New function project-read-project-by-name

diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 169f6156f5c29c1e0d1eb60fc15a2b9e8c44b913..41ddcf6e49c3be0bd1a78004773256ce9a320ab6 100644 (file)
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -197,7 +197,7 @@ CL struct.")
   "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
+(defcustom project-prompter #'project-read-project-by-name
   "Function to call to prompt for a project.
 The function is either called with no arguments or with one argument,
 which is the prompt string to use.  It should return a project root
@@ -1917,6 +1917,48 @@ When PROMPT is non-nil, use it as the prompt string."
 
 (defvar project--name-history)
 
+(defvar project-name-history nil)
+
+(defcustom project-new-projects-directory "~/"
+  "Name of directory under which to create new projects."
+  :type 'directory)
+
+(defun project-read-project-by-name (&optional prompt)
+  "Read a project name and return its root directory.
+
+Optional argument PROMPT is the prompt string to use, if omitted or nil,
+it defaults to \"Project\".
+
+If no known project matches the selected name, prompt for a
+sub-directory of `project-new-projects-directory' using the selected
+name as the initial input for completion, and return that directory."
+  (let* ((current (project-current))
+         (default (and current (project-name current)))
+         (name (completing-read (format-prompt (or prompt "Project") default)
+                                (lambda (string pred action)
+                                  (if (eq action 'metadata)
+                                      `(metadata (sort-function . minibuffer-sort-alphabetically))
+                                    (complete-with-action
+                                     action
+                                     (seq-keep (lambda (dir)
+                                                 (when-let ((proj (project-current nil dir)))
+                                                   (project-name proj)))
+                                               (project-known-project-roots))
+                                     string pred)))
+                                nil nil nil
+                                'project-name-history
+                                default)))
+    (or (seq-find (lambda (dir)
+                    (when-let ((proj (project-current nil dir)))
+                      (string= (project-name proj) name)))
+                  (project-known-project-roots))
+        (let* ((dir (read-directory-name "Project root directory: "
+                                         project-new-projects-directory
+                                         nil t name))
+               (project (project-current nil dir)))
+          (when project (project-remember-project project))
+          dir))))
+
 (defun project-prompt-project-name (&optional prompt)
   "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,