bug#50344: C-x v keybinding for vc-print-branch-log

[Juri Linkov]

>>> Maybe I should express this wish in a separate bug, but:
>>>
>>> It would be nice if vc-create-tag allowed to specify start-point
>>> conveniently:
>>>
>>> git checkout -b new-branch-name START-POINT
>>>
>>> Currently I do this in shell.
>>
>> Perhaps we could do that with 'C-u C-u'.
>>
>> Yes, a separate feature request is preferable.
>
> I'm also thinking of a separate command for branch creation, wrote all
> that in bug#50643.  Thanks.

The following patch adds two new branch commands.

> However, I don't use tags much (besides creation - only "git fetch
> --tags"), so I cannot add anything meaningful here.
> Otherwise, the plan for C-x v b prefix looks great.
> Other commands, like maybe "C-x v b r" - rename, could be added then.

I can't find the existing vc API method for renaming tags/branches.

> The command could have a mode for specifying START-POINT, so for Git the
> command becomes "git checkout -b new-branch-name START-POINT".  This
> could be on C-u (unless there're other frequent "customization" cases).

The existing API method has no argument for START-POINT.
Maybe every backend could handle its prefix arg directly
from current-prefix-arg?  For example,

 (defun vc-git-create-tag (dir name branchp)
   (if current-prefix-arg (completion-read "Start point: ") ...

diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index b7760e3bba..2b6ebdfb74 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -865,6 +865,9 @@ vc-prefix-map
   (let ((map (make-sparse-keymap)))
     (define-key map "a" #'vc-update-change-log)
     (define-key map "b" #'vc-switch-backend)
+    (define-key map "Bc" #'vc-create-branch)
+    (define-key map "Bl" #'vc-print-branch-log)
+    (define-key map "Bs" #'vc-switch-branch)
     (define-key map "d" #'vc-dir)
     (define-key map "g" #'vc-annotate)
     (define-key map "G" #'vc-ignore)
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index edc4169465..cdebf4a3d3 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -2350,7 +2372,23 @@ vc-create-tag
   (message "Making %s... done" (if branchp "branch" "tag")))
 
 ;;;###autoload
-(defun vc-retrieve-tag (dir name)
+(defun vc-create-branch (dir name)
+  "Descending recursively from DIR, make a branch called NAME.
+After a new branch is made, the files are checked out in that new branch.
+Uses `vc-create-tag' with the non-nil arg `branchp'."
+  (interactive
+   (let ((granularity
+         (vc-call-backend (vc-responsible-backend default-directory)
+                          'revision-granularity)))
+     (list
+      (if (eq granularity 'repository)
+         default-directory
+       (read-directory-name "Directory: " default-directory default-directory 
t))
+      (read-string "New branch name: " nil 'vc-revision-history))))
+  (vc-create-tag dir name t))
+
+;;;###autoload
+(defun vc-retrieve-tag (dir name &optional branchp)
   "For each file in or below DIR, retrieve their tagged version NAME.
 NAME can name a branch, in which case this command will switch to the
 named branch in the directory DIR.
@@ -2375,15 +2413,21 @@ vc-retrieve-tag
              (read-directory-name "Directory: " default-directory nil t))))
      (list
       dir
-      (vc-read-revision (format-prompt "Tag name to retrieve" "latest 
revisions")
+      (vc-read-revision (format-prompt
+                         (if current-prefix-arg
+                             "Branch name to retrieve"
+                           "Tag name to retrieve")
+                         "latest revisions")
                         (list dir)
-                        (vc-responsible-backend dir)))))
+                        (vc-responsible-backend dir))
+      current-prefix-arg)))
   (let* ((backend (vc-responsible-backend dir))
          (update (when (vc-call-backend backend 'update-on-retrieve-tag)
                    (yes-or-no-p "Update any affected buffers? ")))
         (msg (if (or (not name) (string= name ""))
                  (format "Updating %s... " (abbreviate-file-name dir))
-               (format "Retrieving tag %s into %s... "
+               (format "Retrieving %s %s into %s... "
+                        (if branchp "branch" "tag")
                        name (abbreviate-file-name dir)))))
     (message "%s" msg)
     (vc-call-backend backend 'retrieve-tag dir name update)
@@ -2391,6 +2435,25 @@ vc-retrieve-tag
     (run-hooks 'vc-retrieve-tag-hook)
     (message "%s" (concat msg "done"))))
 
+;;;###autoload
+(defun vc-switch-branch (dir name)
+  "Switch to the branch NAME in the directory DIR.
+If NAME is empty, it refers to the latest revisions of the current branch.
+Uses `vc-retrieve-tag' with the non-nil arg `branchp'."
+  (interactive
+   (let* ((granularity
+           (vc-call-backend (vc-responsible-backend default-directory)
+                            'revision-granularity))
+          (dir
+           (if (eq granularity 'repository)
+               (expand-file-name (vc-root-dir))
+             (read-directory-name "Directory: " default-directory nil t))))
+     (list
+      dir
+      (vc-read-revision (format-prompt "Branch name to retrieve" "latest 
revisions")
+                        (list dir)
+                        (vc-responsible-backend dir)))))
+  (vc-retrieve-tag dir name t))
 
 ;; Miscellaneous other entry points