From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Juri Linkov Newsgroups: gmane.emacs.bugs Subject: bug#50344: C-x v keybinding for vc-print-branch-log Date: Sun, 11 Sep 2022 18:10:08 +0300 Organization: LINKOV.NET Message-ID: <86y1uqxaj7.fsf@mail.linkov.net> References: <87mtoux1ha.fsf@mail.linkov.net> <87tuiv4hvc.fsf@gnus.org> <87fsudsngq.fsf@mail.linkov.net> <87k0jora9d.fsf@gnus.org> <7ba6c699-cfe5-4fa3-92dd-55b1e227aacf@yandex.ru> <874kaptwki.fsf@mail.linkov.net> <878rz5pc9i.fsf@mail.linkov.net> <83ily91djz.fsf@gnu.org> <878rz5w9cf.fsf@mail.linkov.net> <83ee8x1bn8.fsf@gnu.org> <834k9t0z9d.fsf@gnu.org> <83v929ynpt.fsf@gnu.org> <03e150fc-5825-16ee-9022-db53de43dbc1@yandex.ru> <04c3e90b-a9a8-724d-1f2c-98c43e9f9658@yandex.ru> <87a679nlq1.fsf@melete.silentflame.com> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="5660"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/29.0.50 (x86_64-pc-linux-gnu) Cc: 50344@debbugs.gnu.org, larsi@gnus.org, Filipp Gunbin , Dmitry Gutov To: Sean Whitton Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Sun Sep 11 17:12:13 2022 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1oXOd1-0001Gz-Oq for geb-bug-gnu-emacs@m.gmane-mx.org; Sun, 11 Sep 2022 17:12:11 +0200 Original-Received: from localhost ([::1]:33700 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1oXOd0-00033b-F1 for geb-bug-gnu-emacs@m.gmane-mx.org; Sun, 11 Sep 2022 11:12:10 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:59066) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oXOcr-00032g-VH for bug-gnu-emacs@gnu.org; Sun, 11 Sep 2022 11:12:01 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:54482) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oXOcr-0002WD-Mv for bug-gnu-emacs@gnu.org; Sun, 11 Sep 2022 11:12:01 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1oXOcr-0002tq-I8 for bug-gnu-emacs@gnu.org; Sun, 11 Sep 2022 11:12:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Juri Linkov Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sun, 11 Sep 2022 15:12:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 50344 X-GNU-PR-Package: emacs Original-Received: via spool by 50344-submit@debbugs.gnu.org id=B50344.166290911511133 (code B ref 50344); Sun, 11 Sep 2022 15:12:01 +0000 Original-Received: (at 50344) by debbugs.gnu.org; 11 Sep 2022 15:11:55 +0000 Original-Received: from localhost ([127.0.0.1]:43181 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oXOck-0002tV-Gu for submit@debbugs.gnu.org; Sun, 11 Sep 2022 11:11:55 -0400 Original-Received: from relay11.mail.gandi.net ([217.70.178.231]:49821) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oXOci-0002t2-1Y for 50344@debbugs.gnu.org; Sun, 11 Sep 2022 11:11:52 -0400 Original-Received: (Authenticated sender: juri@linkov.net) by mail.gandi.net (Postfix) with ESMTPSA id 31594100002; Sun, 11 Sep 2022 15:11:42 +0000 (UTC) In-Reply-To: <87a679nlq1.fsf@melete.silentflame.com> (Sean Whitton's message of "Thu, 08 Sep 2022 22:46:46 -0700") X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.io gmane.emacs.bugs:242175 Archived-At: --=-=-= Content-Type: text/plain >> I have pushed the change which obsoletes vc-switch-backend now. >> >> Which should remove the main obstacle to adding the branches map with good >> binding in Emacs 29. > > Would now perhaps be an appropriate time to go ahead and add the > branches map? Here is the complete patch that addresses all concerns raised during this long discussion: --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=vc-create-branch.patch diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index c4f0671d64..a9627a2862 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 @@ -2432,7 +2431,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. @@ -2442,6 +2457,8 @@ vc-retrieve-tag 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 @@ -2457,15 +2474,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 + "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) @@ -2473,6 +2496,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 "Switch to branch" "latest revisions") + (list dir) + (vc-responsible-backend dir))))) + (vc-retrieve-tag dir name t)) ;; Miscellaneous other entry points diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 2941cc75be..792981b142 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 +1590,25 @@ vc-git-annotate-extract-revision-at-line (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..8f9e6010ee 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -857,6 +857,9 @@ vc-kill-buffer-hook ;; (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 +887,6 @@ vc-prefix-map (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-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 @@ vc-dir-mode-map (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)) --=-=-=--