procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add support for prompting for projects by name

Browse source 
* lisp/progmodes/project.el (project-prompter):
New user option (bug#62759).
(project-prompt-project-name): New function.
This commit is contained in:
Spencer Baugh 2023-04-10 15:11:06 -04:00 • committed by Dmitry Gutov
parent 2d3947ba7a
commit 9efa6d2cf2
1 changed files with 40 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

43
lisp/progmodes/project.el
View file

@ -202,6 +202,17 @@ 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
"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 @@ of the project instance object."
(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 @@ passed to `message' as its first argument."
"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 @@ It's also possible to enter an arbitrary directory not in the list."
(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 @@ made from `project-switch-commands'.
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))))