master 71302884dd: 'C-x v b' prefix key is used for branch commands to create/switch/print branch

[Juri Linkov]

branch: master
commit 71302884dd3dec26e34916c30e3893dd15b786f8
Author: Juri Linkov <juri@linkov.net>
Commit: Juri Linkov <juri@linkov.net>

    'C-x v b' prefix key is used for branch commands to create/switch/print 
branch
    
    * lisp/vc/vc.el (vc-create-branch): New command.
    (vc-retrieve-tag): Add new optional arg 'branchp'.
    (vc-switch-branch): New command (bug#50344).
    
    * lisp/vc/vc-hooks.el (vc-prefix-map): Bind "b c" to vc-create-branch,
    "b l" to vc-print-branch-log, "b s" to vc-switch-branch.  Remove obsolete
    and suppressed "b" from vc-switch-backend.
    
    * lisp/vc/vc-dir.el (vc-dir-mode-map): Rebind 'branch-map' from "B" to "b"
    for consistency with 'vc-prefix-map'.
    
    * lisp/vc/vc-git.el (vc-git-create-tag): For a new branch read
    its start-point.  Ask a confirmation if modified files exist.
---
 etc/NEWS            |  4 ++++
 lisp/vc/vc-dir.el   |  2 +-
 lisp/vc/vc-git.el   | 22 +++++++++++++++-----
 lisp/vc/vc-hooks.el |  6 +++---
 lisp/vc/vc.el       | 58 +++++++++++++++++++++++++++++++++++++++++++++--------
 5 files changed, 75 insertions(+), 17 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 4248b46d8b..562cb70182 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1647,6 +1647,10 @@ info node.  This command only works for the Emacs and 
Emacs Lisp manuals.
 
 ** VC
 
+*** 'C-x v b' prefix key is used now for branch commands.
+'vc-print-branch-log' is bound to 'C-x v b l', and new commands are
+'vc-create-branch' ('C-x v b c') and 'vc-switch-branch' ('C-x v b s').
+
 +++
 *** New command '%' ('vc-dir-mark-by-regexp').
 This command marks files based on a regexp.  If given a prefix
diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el
index 068a66b25b..aa8bad7961 100644
--- a/lisp/vc/vc-dir.el
+++ b/lisp/vc/vc-dir.el
@@ -356,7 +356,7 @@ See `run-hooks'."
     (define-key map "G" #'vc-dir-ignore)
 
     (let ((branch-map (make-sparse-keymap)))
-      (define-key map "B" branch-map)
+      (define-key map "b" branch-map)
       (define-key branch-map "c" #'vc-create-tag)
       (define-key branch-map "l" #'vc-print-branch-log)
       (define-key branch-map "s" #'vc-retrieve-tag))
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 2941cc75be..8d8ea33f8b 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -82,7 +82,7 @@
 ;; - annotate-time ()                              OK
 ;; - annotate-current-time ()                      NOT NEEDED
 ;; - annotate-extract-revision-at-line ()          OK
-;; TAG SYSTEM
+;; TAG/BRANCH SYSTEM
 ;; - create-tag (dir name branchp)                 OK
 ;; - retrieve-tag (dir name update)                OK
 ;; MISCELLANEOUS
@@ -1572,13 +1572,25 @@ This requires git 1.8.4 or later, for the \"-L\" option 
of \"git log\"."
                    (expand-file-name fname (vc-git-root default-directory))))
          revision)))))
 
-;;; TAG SYSTEM
+;;; TAG/BRANCH SYSTEM
+
+(declare-function vc-read-revision "vc"
+                  (prompt &optional files backend default initial-input))
 
 (defun vc-git-create-tag (dir name branchp)
-  (let ((default-directory dir))
-    (and (vc-git-command nil 0 nil "update-index" "--refresh")
+  (let ((default-directory dir)
+        (start-point (when branchp (vc-read-revision
+                                    (format-prompt "Start point"
+                                                   (car (vc-git-branches)))
+                                    (list dir) 'Git))))
+    (and (or (zerop (vc-git-command nil t nil "update-index" "--refresh"))
+             (y-or-n-p "Modified files exist.  Proceed? ")
+             (user-error (format "Can't create %s with modified files"
+                                 (if branchp "branch" "tag"))))
          (if branchp
-             (vc-git-command nil 0 nil "checkout" "-b" name)
+             (vc-git-command nil 0 nil "checkout" "-b" name
+                             (when (and start-point (not (eq start-point "")))
+                               start-point))
            (vc-git-command nil 0 nil "tag" name)))))
 
 (defun vc-git-retrieve-tag (dir name _update)
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index 1f0eeb7e18..7f0d9e4d86 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -857,6 +857,9 @@ In the latter case, VC mode is deactivated for this buffer."
 ;; (autoload 'vc-prefix-map "vc" nil nil 'keymap)
 (defvar-keymap vc-prefix-map
   "a"   #'vc-update-change-log
+  "b c" #'vc-create-branch
+  "b l" #'vc-print-branch-log
+  "b s" #'vc-switch-branch
   "d"   #'vc-dir
   "g"   #'vc-annotate
   "G"   #'vc-ignore
@@ -883,9 +886,6 @@ In the latter case, VC mode is deactivated for this buffer."
 (fset 'vc-prefix-map vc-prefix-map)
 (define-key ctl-x-map "v" 'vc-prefix-map)
 
-(with-suppressed-warnings ((obsolete vc-switch-backend))
-  (keymap-set vc-prefix-map "b" #'vc-switch-backend))
-
 (defvar vc-menu-map
   (let ((map (make-sparse-keymap "Version Control")))
     ;;(define-key map [show-files]
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index c75356c4bd..8491690a4e 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -449,7 +449,7 @@
 ;;
 ;;   Return the common ancestor between REV1 and REV2 revisions.
 
-;; TAG SYSTEM
+;; TAG/BRANCH SYSTEM
 ;;
 ;; - create-tag (dir name branchp)
 ;;
@@ -464,8 +464,9 @@
 ;; - retrieve-tag (dir name update)
 ;;
 ;;   Retrieve the version tagged by NAME of all registered files at or below 
DIR.
+;;   If NAME is a branch name, switch to that branch.
 ;;   If UPDATE is non-nil, then update buffers of any files in the
-;;   tag that are currently visited.  The default implementation
+;;   tag/branch that are currently visited.  The default implementation
 ;;   does a sanity check whether there aren't any uncommitted changes at
 ;;   or below DIR, and then performs a tree walk, using the `checkout'
 ;;   function to retrieve the corresponding revisions.
@@ -664,8 +665,6 @@
 ;;   display the branch name in the mode-line.  Replace
 ;;   vc-cvs-sticky-tag with that.
 ;;
-;; - Add a primitives for switching to a branch (creating it if required.
-;;
 ;; - Add the ability to list tags and branches.
 ;;
 ;;;; Unify two different versions of the amend capability
@@ -2433,7 +2432,23 @@ checked out in that new branch."
   (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.
@@ -2443,6 +2458,8 @@ If NAME is empty, it refers to the latest revisions of 
the current branch.
 If locking is used for the files in DIR, then there must not be any
 locked files at or below DIR (but if NAME is empty, locked files are
 allowed and simply skipped).
+If the prefix argument BRANCHP is given, switch the branch
+and check out the files in that branch.
 This function runs the hook `vc-retrieve-tag-hook' when finished."
   (interactive
    (let* ((granularity
@@ -2458,15 +2475,21 @@ This function runs the hook `vc-retrieve-tag-hook' when 
finished."
              (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
+                             "Switch to branch"
+                           "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)
@@ -2474,6 +2497,25 @@ This function runs the hook `vc-retrieve-tag-hook' when 
finished."
     (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 "Switch to branch" "latest revisions")
+                        (list dir)
+                        (vc-responsible-backend dir)))))
+  (vc-retrieve-tag dir name t))
 
 ;; Miscellaneous other entry points