Function: vc--prompt-other-working-tree

vc--prompt-other-working-tree is a byte-compiled function defined in vc.el.gz.

Signature

(vc--prompt-other-working-tree BACKEND PROMPT &optional ALLOW-CURRENT)

Documentation

Invoke project-prompter to choose another working tree.

BACKEND is the VC backend. PROMPT is the prompt string for project-prompter. If ALLOW-CURRENT is non-nil, allow selecting the current working tree. Respects vc-quick-select-current-working-tree, which see.

Source Code

;; Defined in /usr/src/emacs/lisp/vc/vc.el.gz
(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-CURRENT is non-nil, allow selecting the current working tree.
Respects `vc-quick-select-current-working-tree', which see."
  (require 'project)
  (let* ((trees (vc-call-backend backend 'known-other-working-trees))
         (cur (or (project-current nil (vc-root-dir backend))
                  (error "No current project")))
         (root (project-root cur)))
    (dolist (tree trees)
      (when-let* ((p (project-current nil tree)))
        (project-remember-project p nil t)))
    (cond* (allow-current
            (project-remember-project cur nil t)
            (push root trees)
            :non-exit)
           ((null trees)
            (user-error
             (substitute-command-keys "\
No other working trees.  Use \\[vc-add-working-tree] to add one")))
           ((and allow-current
                 vc-quick-select-current-working-tree
                 (null (cdr trees)))
            root)
           ((bind* (prompt
                    (if allow-current
                        (concat prompt
                                " (default current working tree)")
                      prompt))
                   (res (funcall project-prompter prompt
                                 (lambda (k &optional _v)
                                   (member (or (car-safe k) k) trees))
                                 'require-known))))
           ((and allow-current (string-empty-p res)) root)
           ((or (string-empty-p res) (not (stringp res)))
            (user-error "Invalid response"))
           (t res))))