mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-06-14 12:31:25 +00:00
Project prompters always default to current project, if any
* lisp/progmodes/project.el (project-prompter) (project-prompt-project-dir, project-prompt-project-name): Delete ALLOW-EMPTY parameter. Default to the current project if there is one. * lisp/vc/vc.el (project-root): Declare. (vc--prompt-other-working-tree): Replace ALLOW-EMPTY parameter with new ALLOW-CURRENT parameter. (vc-working-tree-switch-project): Allow selecting the current working tree, for symmetry with project-switch-project. * etc/NEWS: Update.
This commit is contained in:
Sean Whitton
parent
cb21b7d71f
commit
4795e83a69
3 changed files with 80 additions and 73 deletions
5
etc/NEWS
5
etc/NEWS
|
|
@ -976,11 +976,10 @@ It is equivalent to running 'project-any-command' with
|
|||
The prompt now displays the chosen project on which to invoke a command.
|
||||
|
||||
---
|
||||
*** 'project-prompter' values may be called with up to four arguments.
|
||||
*** 'project-prompter' values may be called with up to three arguments.
|
||||
These allow callers of the value of 'project-prompter' to specify a
|
||||
prompt string; prompt the user to choose between a subset of all the
|
||||
known projects; disallow returning arbitrary directories; and allow
|
||||
returning an empty string.
|
||||
known projects; and disallow returning arbitrary directories.
|
||||
See the docstring of 'project-prompter' for a full specification of
|
||||
these new optional arguments.
|
||||
|
||||
|
|
|
|||
|
|
@ -212,8 +212,8 @@ 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.
|
||||
The function is called either with no arguments or with up to four
|
||||
optional arguments: (&optional PROMPT PREDICATE REQUIRE-KNOWN ALLOW-EMPTY).
|
||||
The function is called either with no arguments or with up to three
|
||||
optional arguments: (&optional PROMPT PREDICATE REQUIRE-KNOWN).
|
||||
|
||||
PROMPT is the prompt string to use.
|
||||
|
||||
|
|
@ -231,12 +231,14 @@ may allow the user to input arbitrary directories. If PREDICATE and
|
|||
REQUIRE-KNOWN are both non-nil, the value of `project-prompter' should
|
||||
not return any project root directory for which PREDICATE returns nil.
|
||||
|
||||
If ALLOW-EMPTY is non-nil, then irrespective of REQUIRE-KNOWN, the user
|
||||
may enter nothing (i.e., just type RET).
|
||||
In this case the function should return \"\". Conventionally this is
|
||||
used to allow the user to select the current project.
|
||||
Callers should append something like \" (empty for current project)\" to
|
||||
PROMPT when passing ALLOW-EMPTY non-nil."
|
||||
The function must always return a valid project.
|
||||
|
||||
If there is a current project, it satisfies PREDICATE (or PREDICATE is
|
||||
nil), and the method of prompting involves a default selection, then
|
||||
this default selection should be the current project root. For example
|
||||
if the function uses `completing-read' then the current project, if any,
|
||||
should be passed as the DEF argument to `completing-read', and returned
|
||||
in the case that the user replies with empty input."
|
||||
:type '(choice (const :tag "Prompt for a project directory"
|
||||
project-prompt-project-dir)
|
||||
(const :tag "Prompt for a project name"
|
||||
|
|
@ -1416,7 +1418,7 @@ directories listed in `vc-directory-exclusion-list'."
|
|||
project "Find file"
|
||||
all-files nil 'file-name-history
|
||||
suggested-filename)))
|
||||
(if (string= file "")
|
||||
(if (string-empty-p file)
|
||||
(user-error "You didn't specify the file")
|
||||
(find-file file))))
|
||||
|
||||
|
|
@ -1845,7 +1847,7 @@ Return non-nil if PROJECT is not a remote project."
|
|||
'(metadata . ((category . project-buffer)
|
||||
(cycle-sort-function . identity))))
|
||||
((and (eq action t)
|
||||
(equal string "")) ;Pcm completion or empty prefix.
|
||||
(string-empty-p string)) ;Pcm completion or empty prefix.
|
||||
(let* ((all (complete-with-action action buffers string pred))
|
||||
(non-internal (cl-remove-if (lambda (b) (= (aref b 0) ?\s)) all)))
|
||||
(if (null non-internal)
|
||||
|
|
@ -2311,8 +2313,7 @@ the project list."
|
|||
|
||||
(defvar project--dir-history)
|
||||
|
||||
(defun project-prompt-project-dir
|
||||
(&optional prompt predicate require-known allow-empty)
|
||||
(defun project-prompt-project-dir (&optional prompt predicate require-known)
|
||||
"Prompt the user for a directory that is one of the known project roots.
|
||||
The project is chosen among projects known from the project list,
|
||||
see `project-list-file'.
|
||||
|
|
@ -2320,13 +2321,17 @@ If PROMPT is non-nil, use it as the prompt string.
|
|||
If PREDICATE is non-nil, filter possible project choices using this
|
||||
function; see `project-prompter' for more details.
|
||||
Unless REQUIRE-KNOWN is non-nil, it's also possible to enter an
|
||||
arbitrary directory not in the list of known projects.
|
||||
If ALLOW-EMPTY is non-nil, it is possible to exit with no input."
|
||||
arbitrary directory not in the list of known projects."
|
||||
(project--ensure-read-project-list)
|
||||
(when-let* ((pred (alist-get 'prompt project-prune-zombie-projects))
|
||||
(inhibit-message t))
|
||||
(project--delete-zombie-projects pred))
|
||||
(let* ((dir-choice "... (choose a dir)")
|
||||
(current (and-let* ((p (project-current))
|
||||
(_ (or (null predicate)
|
||||
(funcall predicate
|
||||
(project-root p)))))
|
||||
(project-root p)))
|
||||
(choices
|
||||
;; XXX: Just using this for the category (for the substring
|
||||
;; completion style).
|
||||
|
|
@ -2334,30 +2339,29 @@ If ALLOW-EMPTY is non-nil, it is possible to exit with no input."
|
|||
(if require-known project--list
|
||||
(append project--list `(,dir-choice)))))
|
||||
(project--dir-history (project-known-project-roots))
|
||||
pr-dir)
|
||||
(cl-loop
|
||||
do (setq pr-dir
|
||||
(let (history-add-new-input)
|
||||
(completing-read (if prompt
|
||||
;; TODO: Use `format-prompt' (Emacs 28.1+)
|
||||
(format "%s: " (substitute-command-keys prompt))
|
||||
"Select project: ")
|
||||
choices
|
||||
(and predicate
|
||||
(lambda (choice)
|
||||
(or (equal choice dir-choice)
|
||||
(funcall predicate choice))))
|
||||
t nil 'project--dir-history)))
|
||||
;; If the user simply pressed RET, do this again until they don't.
|
||||
while (and (not allow-empty) (equal pr-dir "")))
|
||||
(pr-dir ""))
|
||||
(while (string-empty-p pr-dir)
|
||||
;; If the user simply pressed RET (and CURRENT is nil), do this
|
||||
;; again until they don't.
|
||||
(setq pr-dir
|
||||
(let (history-add-new-input)
|
||||
(completing-read
|
||||
;; Emacs 28.1+: Use `format-prompt'.
|
||||
(cond (prompt (format "%s: " prompt))
|
||||
(current "Select project (default current project): ")
|
||||
(t "Select project: "))
|
||||
choices (and predicate
|
||||
(lambda (choice)
|
||||
(or (equal choice dir-choice)
|
||||
(funcall predicate choice))))
|
||||
t nil 'project--dir-history current))))
|
||||
(if (equal pr-dir dir-choice)
|
||||
(read-directory-name "Select directory: " default-directory nil t)
|
||||
pr-dir)))
|
||||
|
||||
(defvar project--name-history)
|
||||
|
||||
(defun project-prompt-project-name
|
||||
(&optional prompt predicate require-known allow-empty)
|
||||
(defun project-prompt-project-name (&optional prompt predicate require-known)
|
||||
"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'.
|
||||
|
|
@ -2365,13 +2369,17 @@ If PROMPT is non-nil, use it as the prompt string.
|
|||
If PREDICATE is non-nil, filter possible project choices using this
|
||||
function; see `project-prompter' for more details.
|
||||
Unless REQUIRE-KNOWN is non-nil, it's also possible to enter an
|
||||
arbitrary directory not in the list of known projects.
|
||||
If ALLOW-EMPTY is non-nil, it is possible to exit with no input."
|
||||
arbitrary directory not in the list of known projects."
|
||||
(when-let* ((pred (alist-get 'prompt project-prune-zombie-projects))
|
||||
(inhibit-message t))
|
||||
(project--delete-zombie-projects pred))
|
||||
(let* ((dir-choice "... (choose a dir)")
|
||||
project--name-history
|
||||
(current (and-let* ((p (project-current))
|
||||
(_ (or (null predicate)
|
||||
(funcall predicate
|
||||
(project-root p)))))
|
||||
(project-name p)))
|
||||
(choices
|
||||
(let (ret)
|
||||
;; Iterate in reverse order so project--name-history is in
|
||||
|
|
@ -2390,22 +2398,22 @@ If ALLOW-EMPTY is non-nil, it is possible to exit with no input."
|
|||
(table (project--file-completion-table
|
||||
(reverse (if require-known choices
|
||||
(cons dir-choice choices)))))
|
||||
pr-name)
|
||||
(cl-loop
|
||||
do (setq pr-name
|
||||
(let (history-add-new-input)
|
||||
(completing-read (if prompt
|
||||
(format "%s: " prompt)
|
||||
"Select project: ")
|
||||
table nil t nil 'project--name-history)))
|
||||
;; If the user simply pressed RET, do this again until they don't.
|
||||
while (and (not allow-empty) (equal pr-name "")))
|
||||
(pcase pr-name
|
||||
("" "")
|
||||
((pred (equal 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))))))))
|
||||
(pr-name ""))
|
||||
(while (string-empty-p pr-name)
|
||||
;; If the user simply pressed RET (and CURRENT is nil), do this
|
||||
;; again until they don't.
|
||||
(setq pr-name
|
||||
(let (history-add-new-input)
|
||||
(completing-read
|
||||
;; Emacs 28.1+: Use `format-prompt'.
|
||||
(cond (prompt (format "%s: " prompt))
|
||||
(current "Select project (default current project): ")
|
||||
(t "Select project: "))
|
||||
table nil t nil 'project--name-history current))))
|
||||
(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 ()
|
||||
|
|
|
|||
|
|
@ -5732,15 +5732,14 @@ When called from Lisp, BACKEND is the VC backend."
|
|||
(dired directory))
|
||||
|
||||
(defvar project-prompter)
|
||||
(declare-function project-root "project")
|
||||
|
||||
(defun vc--prompt-other-working-tree (backend prompt &optional allow-empty)
|
||||
(defun vc--prompt-other-working-tree (backend prompt &optional allow-current)
|
||||
"Invoke `project-prompter' to choose another working tree.
|
||||
BACKEND is the VC backend.
|
||||
PROMPT is the prompt string for `project-prompter'.
|
||||
If ALLOW-EMPTY is non-nil, empty input means the current working tree.
|
||||
In typical usage ALLOW-EMPTY non-nil means that it makes sense to apply
|
||||
the caller's operation to the current working tree."
|
||||
;; If there are no other working trees and ALLOW-EMPTY is non-nil, we
|
||||
If ALLOW-CURRENT is non-nil, allow selecting the current working tree."
|
||||
;; If there are no other working trees and ALLOW-CURRENT is non-nil we
|
||||
;; still invoke the `project-prompter' and require the user to type
|
||||
;; \\`RET', even though it's redundant. Doing it this way means that
|
||||
;; invoking the command on the current working tree works the same
|
||||
|
|
@ -5752,25 +5751,25 @@ the caller's operation to the current working tree."
|
|||
;; stopping to look at the echo area.
|
||||
(let ((trees (vc-call-backend backend 'known-other-working-trees))
|
||||
res)
|
||||
(unless (or trees allow-empty)
|
||||
(user-error
|
||||
(substitute-command-keys
|
||||
"No other working trees. Use \\[vc-add-working-tree] to add one")))
|
||||
(require 'project)
|
||||
(cond* ((bind-and* (_ allow-current)
|
||||
(p (project-current)))
|
||||
(push (project-root p) trees))
|
||||
((null trees)
|
||||
(user-error
|
||||
(substitute-command-keys
|
||||
"No other working trees. Use \\[vc-add-working-tree] to add one"))))
|
||||
(dolist (tree trees)
|
||||
(when-let* ((p (project-current nil tree)))
|
||||
(project-remember-project p nil t)))
|
||||
(setq res
|
||||
(funcall project-prompter
|
||||
(if allow-empty
|
||||
(format "%s (empty for this working tree)"
|
||||
prompt)
|
||||
(if allow-current
|
||||
(concat prompt " (default current working tree)")
|
||||
prompt)
|
||||
(if trees
|
||||
(lambda (k &optional _v)
|
||||
(member (or (car-safe k) k) trees))
|
||||
#'ignore)
|
||||
t allow-empty))
|
||||
(lambda (k &optional _v)
|
||||
(member (or (car-safe k) k) trees))
|
||||
'require-known))
|
||||
(if (string-empty-p res) (vc-root-dir) res)))
|
||||
|
||||
(defvar project-current-directory-override)
|
||||
|
|
@ -5801,7 +5800,8 @@ Prompts for the directory file name of the other working tree."
|
|||
(interactive
|
||||
(list
|
||||
(vc--prompt-other-working-tree (vc-responsible-backend default-directory)
|
||||
"Other working tree to switch to")))
|
||||
"Other working tree to switch to"
|
||||
'allow-current)))
|
||||
(project-switch-project dir))
|
||||
|
||||
;;;###autoload
|
||||
|
|
@ -5814,7 +5814,7 @@ BACKEND is the VC backend."
|
|||
(let ((backend (vc-responsible-backend default-directory)))
|
||||
(list backend
|
||||
(vc--prompt-other-working-tree backend "Delete working tree"
|
||||
'allow-empty))))
|
||||
'allow-current))))
|
||||
(let* ((delete-this (file-in-directory-p default-directory directory))
|
||||
(directory (expand-file-name directory))
|
||||
(default-directory
|
||||
|
|
@ -5860,7 +5860,7 @@ BACKEND is the VC backend."
|
|||
(let ((backend (vc-responsible-backend default-directory)))
|
||||
(list backend
|
||||
(vc--prompt-other-working-tree backend "Relocate working tree"
|
||||
'allow-empty)
|
||||
'allow-current)
|
||||
(read-directory-name "New location for working tree: "
|
||||
(file-name-parent-directory (vc-root-dir))))))
|
||||
(let* ((move-this (file-in-directory-p default-directory from))
|
||||
|
|
|
|||
Loading…
Reference in a new issue