Function: vc-backend-for-registration
vc-backend-for-registration is a byte-compiled function defined in
vc.el.gz.
Signature
(vc-backend-for-registration FILE)
Documentation
Return a backend that can be used for registering FILE.
If no backend declares itself responsible for FILE, then FILE must not be in a version controlled directory, so try to create a repository, prompting for the directory and the VC backend to use.
Source Code
;; Defined in /usr/src/emacs/lisp/vc/vc.el.gz
;;; Code for deducing what fileset and backend to assume
(defun vc-backend-for-registration (file)
"Return a backend that can be used for registering FILE.
If no backend declares itself responsible for FILE, then FILE
must not be in a version controlled directory, so try to create a
repository, prompting for the directory and the VC backend to
use."
(catch 'found
;; First try: find a responsible backend, it must be a backend
;; under which FILE is not yet registered and with the most
;; specific path to FILE.
(let ((max 0)
bk)
(dolist (backend vc-handled-backends)
(when (not (vc-call-backend backend 'registered file))
(let* ((dir-name (vc-call-backend backend 'responsible-p file))
(len (and dir-name
(length (file-name-split
(expand-file-name dir-name))))))
(when (and len (> len max))
(setq max len bk backend)))))
(when bk
(throw 'found bk)))
;; no responsible backend
(let* ((possible-backends
(let (pos)
(dolist (crt vc-handled-backends)
(when (vc-find-backend-function crt 'create-repo)
(push crt pos)))
pos))
(bk
(intern
;; Read the VC backend from the user, only
;; complete with the backends that have the
;; 'create-repo method.
(completing-read
(format "%s is not in a version controlled directory.\nUse VC backend: " file)
(mapcar #'symbol-name possible-backends) nil t)))
(repo-dir
(let ((def-dir (file-name-directory file)))
;; read the directory where to create the
;; repository, make sure it's a parent of
;; file.
(read-file-name
(format "create %s repository in: " bk)
default-directory def-dir t nil
(lambda (arg)
(message "arg %s" arg)
(and (file-directory-p arg)
(string-prefix-p (expand-file-name arg) def-dir)))))))
(let ((default-directory repo-dir))
(vc-call-backend bk 'create-repo))
(throw 'found bk))))