diff --git a/.dir-locals.el b/.dir-locals.el index af92eac5bba..d9ccf82b166 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -15,7 +15,12 @@ "/[ \t]*DEFVAR_[A-Z_ \t(]+\"[^\"]+\",[ \t]\\([A-Za-z0-9_]+\\)/\\1/")))) (etags-regen-ignores . ("test/manual/etags/")) (vc-prepare-patches-separately . nil) - (vc-default-patch-addressee . "bug-gnu-emacs@gnu.org"))) + (vc-default-patch-addressee . "bug-gnu-emacs@gnu.org") + ;; Uncomment these later once people's builds are likely to know + ;; they're safe local variable values. + ;; (vc-trunk-branch-regexps . ("master" "\\`emacs-[0-9]+\\'")) + ;; (vc-topic-branch-regexps . ("\\`feature/")) + )) (c-mode . ((c-file-style . "GNU") (c-noise-macro-names . ("INLINE" "NO_INLINE" "ATTRIBUTE_NO_SANITIZE_UNDEFINED" "ATTRIBUTE_NO_SANITIZE_ADDRESS" diff --git a/doc/emacs/vc1-xtra.texi b/doc/emacs/vc1-xtra.texi index 8f9d3bf34e5..8ffd6506dbe 100644 --- a/doc/emacs/vc1-xtra.texi +++ b/doc/emacs/vc1-xtra.texi @@ -312,8 +312,8 @@ these commands provide specialized versions of @kbd{C-x v M D} (see @pxref{Merge Bases}) which also take into account the state of upstream repositories. These commands are useful both when working on a single branch and when developing features on a separate branch -(@pxref{Branches}). These two cases involve using the commands -differently, and so we will describe them separately. +(@pxref{Branches}). These two cases are conceptually distinct, and so +we will introduce them separately. First, consider working on a single branch. @dfn{Outstanding changes} are those which you haven't yet pushed upstream. This includes both @@ -341,12 +341,14 @@ commands, you can use a prefix argument to specify a particular upstream location.} Second, consider developing a feature on a separate branch. Call this -the @dfn{topic branch},@footnote{Topic branches are sometimes called -``feature branches''. It is also common for the term ``feature branch'' -to be reserved for a particular kind of topic branch, one that another -branch or other branches are repeatedly merged into.} and call the -branch from which the topic branch was originally created the -@dfn{trunk} or @dfn{development trunk}. +the @dfn{topic branch},@footnote{What we mean by a topic branch is any +shorter-lived branch used for work which will later be merged into a +longer-lived branch. Topic branches are sometimes called ``feature +branches''. It is also common for the term ``feature branch'' to be +reserved for a particular kind of topic branch, one that another branch +or other branches are repeatedly merged into.} and call the branch from +which the topic branch was originally created the @dfn{trunk} or +@dfn{development trunk}. In this case, outstanding changes is a more specific notion than just unpushed and uncommitted changes on the topic branch. You're not @@ -357,20 +359,104 @@ upstream repository's development trunk. That means committed changes on the topic branch that haven't yet been merged into the trunk, plus uncommitted changes. -@cindex outgoing base, version control -The @dfn{outgoing base} is the upstream location for which the changes -are destined once they are no longer outstanding. In this case, that's -the upstream version of the trunk, to which you and your collaborators -push finished work. +When the current branch is a topic branch and you type @kbd{C-x v o D}, +Emacs displays a summary of all the changes that are outstanding against +the trunk to which the current branch will be merged. This summary is +in the form of a diff of what committing and pushing all the changes, +@emph{and} subsequently merging the topic branch, would do to the trunk. +As above, you can use @kbd{C-x v o =} instead to limit the display of +changes to the current VC fileset. -To display a summary of outgoing changes in this multi-branch example, -supply a prefix argument, by typing @w{@kbd{C-u C-x v o =}} or -@w{@kbd{C-u C-x v o D}}. When prompted, enter the outgoing base. -Exactly what you must supply here depends on the name of your -development trunk and the version control system in use. For example, -with Git, usually you will enter @kbd{origin/master}. We hope to -improve these commands such that no prefix argument is required in the -multi-branch case, too. +This functionality relies on Emacs correctly detecting whether the +current branch is a trunk or a topic branch, and in the latter case, +correctly determining the branch to which the topic branch will +eventually be merged. If the autodetection doesn't produce the right +results, there are several options to tweak and override it. + +@vindex vc-trunk-branch-regexps +@vindex vc-topic-branch-regexps +The variables @code{vc-trunk-branch-regexps} and +@code{vc-topic-branch-regexps} contain lists of regular expressions +matching the names of branches that should always be considered trunk +and topic branches, respectively. You can also specify prefix arguments +to @kbd{C-x v o D} and @kbd{C-x v o =}. Here is a summary of how to use +these controls: + +@enumerate +@item +If the problem is that Emacs thinks your topic branch is a trunk, you +can add either its name, or a regular expression matching its name +(@pxref{Regexps}), to the @code{vc-topic-branch-regexps} variable. +There are a few special kinds of value to simplify common use cases: + +@itemize +@item +If an element contains no characters that are special in regular +expressions, then the regular expression is implictly anchored at both +ends, i.e., it matches only a branch with exactly that name. + +@item +If the first element of @code{vc-topic-branch-regexps} is the symbol +@code{not}, then the meaning of @code{vc-topic-branch-regexps} is +inverted, in that Emacs treats all branches whose names @emph{don't} +match any element of @code{vc-topic-branch-regexps} to be topic +branches. + +@item +If instead of a list of regular expressions the +@code{vc-topic-branch-regexps} variable has the special value @code{t}, +then Emacs treats as a topic branch any branch that the +@code{vc-trunk-branch-regexps} variable doesn't positively identify as a +trunk. +@end itemize + +@xref{Directory Variables}, regarding how to specify values of +@code{vc-topic-branch-regexps} and @code{vc-trunk-branch-regexps} for a +single VC repository. + +@item +If the problem is that Emacs thinks your trunk is a topic branch, you +can add either its name, or a regular expression matching its name, to +the @code{vc-trunk-branch-regexps} variable. This works just like +@code{vc-topic-branch-regexps} with the same special values we just +described. E.g., if the value of @code{vc-trunk-branch-regexps} is +@code{t}, Emacs treats as a trunk any branch that the +@code{vc-topic-branch-regexps} variable doesn't identify as a topic +branch. + +@item +Supply a double prefix argument, i.e. @w{@kbd{C-u C-u C-x v o @dots{}}}, +and Emacs will treat the current branch as a trunk, no matter what. +This is useful when you simply want to obtain a diff of all outgoing +changes (@pxref{VC Change Log}) plus uncommitted changes. + +@item +@cindex outgoing base, version control +Finally, you can take full manual control by supplying a single prefix +argument, i.e. @w{@kbd{C-u C-x v o @dots{}}}. Emacs will prompt you for +the @dfn{outgoing base}, which is the upstream location for which the +changes are destined once they are no longer outstanding. + +To treat the current branch as a trunk specify a reference to the +upstream version of the current branch, to which you and your +collaborators push finished work. To treat the current branch as a +topic branch specify a reference to the upstream version of the trunk to +which the topic branch will later be merged. + +Exactly how to specify a reference to the upstream version of a branch +depends on the version control system in use. For example, with Git, to +refer to the upstream version of a branch @var{foo}, you would supply +@kbd{origin/@var{foo}}. So if @var{foo} is the current branch then you +would enter an outgoing base of @kbd{origin/@var{foo}} to treat +@var{foo} as a trunk, or an outgoing base of @kbd{origin/@var{bar}} to +treat @var{foo} as a topic branch which will later be merged into a +trunk named @var{bar}. + +If there is a default option, it is what Emacs thinks you need to enter +in order to treat the current branch as a topic branch. If there is no +default, then entering nothing at the prompt means to treat the current +branch as a trunk. +@end enumerate @node Other Working Trees @subsubsection Multiple Working Trees for One Repository diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 29e8a24ca0a..73db9c0f181 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -767,13 +767,79 @@ or an empty string if none." :files files :update-function update-function))) -(defun vc-git--current-branch () +(defun vc-git-working-branch () + "Return the name of the current branch, or nil if HEAD is detached." (vc-git--out-match '("symbolic-ref" "HEAD") "^\\(refs/heads/\\)?\\(.+\\)$" 2)) +(defun vc-git-trunk-or-topic-p () + "Return `topic' if branch has distinct pull and push remotes, else nil. +This is able to identify topic branches for certain forge workflows." + (let* ((branch (vc-git-working-branch)) + (merge (string-trim-right + (vc-git--out-str "config" (format "branch.%s.remote" + branch)))) + (push (string-trim-right + (vc-git--out-str "config" (format "branch.%s.pushRemote" + branch)))) + (push (if (string-empty-p push) + (string-trim-right + (vc-git--out-str "config" "remote.pushDefault")) + push))) + (and (plusp (length merge)) + (plusp (length push)) + (not (equal merge push)) + 'topic))) + +(defun vc-git-topic-outgoing-base () + "Return the outgoing base for the current branch as a string. +This works by considering the current branch as a topic branch +(whether or not it actually is). +Requires that the corresponding trunk exists as a local branch. + +The algorithm employed is as follows. Find all merge bases between the +current branch and other local branches. Each of these is a commit on +the current branch. Use `git merge-base --independent' on them all to +find the topologically most recent. Take the branch for which that +commit is a merge base with the current branch to be the branch into +which the current branch will eventually be merged. Find its upstream. +(If there is more than one branch whose merge base with the current +branch is that same topologically most recent commit, try them +one-by-one, accepting the first that has an upstream.)" + (cl-flet ((get-line () (buffer-substring (point) (pos-eol)))) + (let* ((branches (vc-git-branches)) + (current (pop branches)) + merge-bases) + (with-temp-buffer + (dolist (branch branches) + (erase-buffer) + (when (vc-git--out-ok "merge-base" "--all" branch current) + (goto-char (point-min)) + (while (not (eobp)) + (push branch + (alist-get (get-line) merge-bases nil nil #'equal)) + (forward-line 1)))) + (erase-buffer) + (unless (apply #'vc-git--out-ok "merge-base" "--independent" + (mapcar #'car merge-bases)) + (error "`git merge-base --independent' failed")) + ;; If 'git merge-base --independent' printed more than one line, + ;; just pick the first. + (goto-char (point-min)) + (catch 'ret + (dolist (target (cdr (assoc (get-line) merge-bases))) + (erase-buffer) + (when (vc-git--out-ok "for-each-ref" + "--format=%(upstream:short)" + (concat "refs/heads/" target)) + (goto-char (point-min)) + (let ((outgoing-base (get-line))) + (unless (string-empty-p outgoing-base) + (throw 'ret outgoing-base)))))))))) + (defun vc-git-dir--branch-headers () "Return headers for branch-related information." - (let ((branch (vc-git--current-branch)) + (let ((branch (vc-git-working-branch)) tracking remote-url) (if branch (when-let* ((branch-merge @@ -1758,7 +1824,7 @@ If LIMIT is a non-empty string, use it as a base revision." ;; If the branch has no upstream, and we weren't supplied ;; with one, then fetching is always useless (bug#79952). (or upstream-location - (and-let* ((branch (vc-git--current-branch))) + (and-let* ((branch (vc-git-working-branch))) (with-temp-buffer (vc-git--out-ok "config" "--get" (format "branch.%s.remote" @@ -2235,7 +2301,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"." (defun vc-git-revision-published-p (rev) "Whether we think REV has been pushed such that it is public history. Considers only the current branch. Does not fetch." - (let ((branch (vc-git--current-branch)) + (let ((branch (vc-git-working-branch)) (rev (vc-git--rev-parse rev))) (vc-git--assert-revision-on-branch rev branch) (and @@ -2334,7 +2400,7 @@ Rebase may --autosquash your other squash!/fixup!/amend!; proceed?"))) (defun vc-git-delete-revision (rev) "Rebase current branch to remove REV." - (vc-git--assert-revision-on-branch rev (vc-git--current-branch)) + (vc-git--assert-revision-on-branch rev (vc-git-working-branch)) (with-temp-buffer (vc-git-command t 0 nil "log" "--merges" (format "%s~1.." rev)) (unless (bobp) @@ -2352,13 +2418,13 @@ Rebase may --autosquash your other squash!/fixup!/amend!; proceed?"))) (defun vc-git-delete-revisions-from-end (rev) "Hard reset back to REV. It is an error if REV is not on the current branch." - (vc-git--assert-revision-on-branch rev (vc-git--current-branch)) + (vc-git--assert-revision-on-branch rev (vc-git-working-branch)) (vc-git-command nil 0 nil "reset" "--hard" rev)) (defun vc-git-uncommit-revisions-from-end (rev) "Mixed reset back to REV. It is an error if REV is not on the current branch." - (vc-git--assert-revision-on-branch rev (vc-git--current-branch)) + (vc-git--assert-revision-on-branch rev (vc-git-working-branch)) (vc-git-command nil 0 nil "reset" "--mixed" rev)) (defvar vc-git-extra-menu-map diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index aeed1de5567..90e25ba43f4 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -1941,6 +1941,42 @@ It is an error if REV is not on the current branch." (vc-hg--assert-rev-on-current-branch rev) (vc-hg--reset-back-to rev t)) +(defun vc-hg--working-branch () + "Return alist with currently active bookmark, if any, and current branch. +Keys into the alist are `branch' and `bookmark', values are the name of +the currently active bookmark (or nil) and the name of the current +branch, as strings." + (with-temp-buffer + (vc-hg-command t nil nil "summary") + (goto-char (point-min)) + (re-search-forward "^branch: \\(.+\\)$") + (let ((alist `((branch . ,(match-string 1))))) + (goto-char (point-min)) + (if (re-search-forward "^bookmarks: \\*\\(\\S-+\\)" nil t) + (cl-acons 'bookmark (match-string 1) alist) + alist)))) + +(defun vc-hg-working-branch () + "Return currently active bookmark if one exists, else current branch. +The return value is always a string." + (let ((alist (vc-hg--working-branch))) + (cdr (or (assq 'bookmark alist) (assq 'branch alist))))) + +(defun vc-hg-trunk-or-topic-p () + "Return `topic' if there is a currently active bookmark, else nil." + (and (assq 'bookmark (vc-hg--working-branch)) 'topic)) + +(defun vc-hg-topic-outgoing-base () + "Return outgoing base for current commit considered as a topic branch. +The current implementation always returns the name of the current +branch, meaning to query the remote head for the current branch +(and not any active bookmark if it also exists remotely). +This is based on the following assumptions: +(i) if there is an active bookmark, it will eventually be merged into + whatever the remote head is +(ii) there is only one remote head for the current branch." + (assq 'branch (vc-hg--working-branch))) + (provide 'vc-hg) ;;; vc-hg.el ends here diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index cab05c20db1..2e342c19919 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -1187,6 +1187,14 @@ they had none before." (defun vc-default-extra-menu (_backend) nil) +(defun vc--safe-branch-regexps-p (val) + "Return non-nil if VAL is a safe local value for \\+`vc-*-branch-regexps'." + (or (eq val t) + (and (listp val) + (all (lambda (elt) + (or (symbolp elt) (stringp elt))) + val)))) + (provide 'vc-hooks) ;;; vc-hooks.el ends here diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index fc4a8b2d991..0ce4ce56363 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -610,6 +610,36 @@ ;; 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. +;; +;; - working-branch () +;; +;; Return the name of the current branch, if there is one, else nil. +;; +;; - trunk-or-topic-p () +;; +;; For the current branch, or the closest equivalent for a VCS without +;; named branches, return `trunk' if it is definitely a longer-lived +;; trunk branch, `topic' if it is definitely a shorter-lived topic +;; branch, or nil if no general determination can be made. +;; +;; What counts as a longer-lived or shorter-lived branch for VC is +;; explained in Info node `(emacs)Outstanding Changes' and in the +;; docstrings for the `vc-trunk-branch-regexps' and +;; `vc-topic-branch-regexps' user options. +;; +;; - topic-outgoing-base () +;; +;; Return an outgoing base for the current branch (or the closest +;; equivalent for a VCS without named branches) considered as a topic +;; branch. That is, on the assumption that the current branch is a +;; shorter-lived branch which will later be merged into a longer-lived +;; branch, return, if possible, the upstream location to which those +;; changes will be merged. See Info node `(emacs) Outstanding +;; Changes'. The return value should be suitable for passing to the +;; incoming-revision backend function as its UPSTREAM-LOCATION +;; argument. For example, for Git the value will typically be of the +;; form 'origin/foo' whereas Mercurial uses the unmodified name of the +;; longer-lived branch. ;; MISCELLANEOUS ;; @@ -3126,21 +3156,189 @@ global binding." (vc-symbolic-working-revision (caadr fileset) backend) (called-interactively-p 'interactive)))) -;; For the following two commands, the default meaning for -;; UPSTREAM-LOCATION may become dependent on whether we are on a -;; shorter-lived or longer-lived ("trunk") branch. If we are on the -;; trunk then it will always be the place `vc-push' would push to. If -;; we are on a shorter-lived branch, it may instead become the remote -;; trunk branch from which the shorter-lived branch was branched. That -;; way you can use these commands to get a summary of all unmerged work -;; outstanding on the short-lived branch. -;; -;; The obstacle to doing this is that VC lacks any distinction between -;; shorter-lived and trunk branches. But we all work with both of -;; these, for almost any VCS workflow. E.g. modern workflows which -;; eschew traditional feature branches still have a long-lived trunk -;; plus shorter-lived local branches for merge requests or patch series. -;; --spwhitton +;; This is used in .dir-locals.el in the Emacs source tree. +;;;###autoload (put 'vc-trunk-branch-regexps 'safe-local-variable +;;;###autoload #'vc--safe-branch-regexps-p) +(defcustom vc-trunk-branch-regexps '("trunk" "master" "main" "default") + "Regular expressions matching the names of longer-lived VCS branches. +There value can be of one of the following forms: +- A list of regular expressions. A trunk branch is one whose name + matches any of the regular expressions. If an element of the list + contains no characters that are special in regular expressions, then + the regexp is implicitly anchored at both ends, i.e., it is the full + name of a branch. +- A list whose first element is `not' and whose remaining elements are + regular expressions. This is the same as the previous case except + that a trunk branch is one whose name does *not* match any of the + regular expressions. +- The symbol t. A trunk branch is any branch that + `vc-topic-branch-regexps' does not positively identify as a topic + branch. +- An empty list (or, the symbol nil). The branch name does not indicate + whether a branch is a trunk. Emacs will ask the backend whether it + thinks the current branch is a trunk. + +In VC, trunk branches are those where you've finished sharing the work +on the branch with your collaborators just as soon as you've checked it +in, and in the case of a decentralized VCS, pushed it. In addition, +typically you never delete trunk branches. + +The specific VCS workflow you are using may only acknowledge a single +trunk, and give other names to kinds of branches which VC would consider +to be just further trunks. + +If trunk branches in your project can be identified by name, include +regexps matching their names in the value of this variable. This is +more reliable than letting Emacs ask the backend. + +See also `vc-topic-branch-regexps'." + :type '(choice (repeat :tag "Regexps" string) + (cons :tag "Negated regexps" + (const not) (repeat :tag "Regexps" string)) + (const :tag "Inverse of `vc-branch-trunk-regexps'" t)) + :safe #'vc--safe-branch-regexps-p + :version "31.1") + +;; This is used in .dir-locals.el in the Emacs source tree. +;;;###autoload (put 'vc-topic-branch-regexps 'safe-local-variable +;;;###autoload #'vc--safe-branch-regexps-p) +(defcustom vc-topic-branch-regexps nil + "Regular expressions matching the names of shorter-lived VCS branches. +There value can be of one of the following forms: +- A list of regular expressions. A topic branch is one whose name + matches any of the regular expressions. If an element of the list + contains no characters that are special in regular expressions, then + the regexp is implicitly anchored at both ends, i.e., it is the full + name of a branch. +- A list whose first element is `not' and whose remaining elements are + regular expressions. This is the same as the previous case except + that a topic branch is one whose name does *not* match any of the + regular expressions. +- The symbol t. A topic branch is any branch that + `vc-trunk-branch-regexps' does not positively identify as a trunk + branch. +- An empty list (or, the symbol nil). The branch name does not indicate + whether a branch is a topic branch. Emacs will ask the backend + whether it thinks the current branch is a topic branch. + +In VC, topic branches are those where checking in work, and pushing it +in the case of a decentralized VCS, is not enough to complete the +process of sharing the changes with your collaborators. In addition, +it's required that you merge the topic branch into another branch. +After this is done, typically you delete the topic branch. + +Topic branches are sometimes called \"feature branches\", though it is +also common for that term to be reserved for only a certain kind of +topic branch. + +If topic branches in your project can be identified by name, include +regexps matching their names in the value of this variable. This is +more reliable than letting Emacs ask the backend. + +See also `vc-trunk-branch-regexps'." + :type '(choice (repeat :tag "Regexps" string) + (cons :tag "Negated regexps" + (const not) (repeat :tag "Regexps" string)) + (const :tag "Inverse of `vc-trunk-branch-regexps'" t)) + :safe #'vc--safe-branch-regexps-p + :version "31.1") + +(defun vc--match-branch-name-regexps (branch) + "Match against `vc-trunk-branch-regexps' and `vc-topic-branch-regexps'. +See the docstrings for those two variables for how this matching works. + +If BRANCH matches both sets of regexps we signal an error; this is to +allow for future extension. +If BRANCH matches neither set of regexps return nil to mean that the +defcustoms don't decide the matter of which kind of branch this is." + (when (and (eq vc-trunk-branch-regexps t) + (eq vc-topic-branch-regexps t)) + (user-error "\ +`vc-trunk-branch-regexps' and `vc-topic-branch-regexps' cannot both be `t'")) + (cl-labels ((join-regexps (regexps) + (mapconcat (lambda (elt) + (format (if (equal (regexp-quote elt) elt) + "\\`%s\\'" + "\\(?:%s\\)") + elt)) + regexps "\\|")) + (compile-regexps (regexps) + (if regexps + (let* ((negated (eq (car regexps) 'not)) + (joined (join-regexps (if negated + (cdr regexps) + regexps)))) + (if negated + (lambda (s) (not (string-match-p joined s))) + (lambda (s) (string-match-p joined s)))) + #'ignore)) + (match-trunk (if (eq vc-trunk-branch-regexps t) + (lambda (s) (not (match-topic s))) + (compile-regexps vc-trunk-branch-regexps))) + (match-topic (if (eq vc-topic-branch-regexps t) + (lambda (s) (not (match-trunk s))) + (compile-regexps vc-topic-branch-regexps)))) + (let ((trunk (match-trunk branch)) + (topic (match-topic branch))) + (cond ((and trunk topic) + (error "Branch name `%s' matches both \ +`vc-trunk-branch-regexps' and `vc-topic-branch-regexps'" + branch)) + (trunk 'trunk) + (topic 'topic))))) + +(defun vc--outgoing-base (backend) + "Return an outgoing base for the current branch under VC backend BACKEND. +The outgoing base is the upstream location for which outstanding changes +on this branch are destined once they are no longer outstanding. + +There are two stages to determining the outgoing base. +First we decide whether we think this is a shorter-lived or a +longer-lived (\"trunk\") branch (see `vc-trunk-branch-regexps' and +`vc-topic-branch-regexps' regarding this distinction), as follows: +1. Ask the backend for the name of the current branch. + If it returns non-nil, compare that name against + `vc-trunk-branch-regexps' and `vc-topic-branch-regexps'. +2. If that doesn't settle it, either because the backend returns nil for + the name of the current branch, or because comparing the name against + the two regexp defcustoms yields no decisive answer, call BACKEND's + `trunk-or-topic-p' VC API function. +3. If that doesn't settle it either, assume this is a shorter-lived + branch. This is based on how it's commands primarily intended for + working with shorter-lived branches that call this function. +Second, if we have determined that this is a trunk, return nil, meaning +that the outgoing base is the place to which `vc-push' would push. +Otherwise, we have determined that this is a shorter-lived branch, and +we return the value of calling BACKEND's `topic-outgoing-base' VC API +function." + ;; For further discussion see bug#80006. + (let* ((branch (vc-call-backend backend 'working-branch)) + (type (or (and branch (vc--match-branch-name-regexps branch)) + (vc-call-backend backend 'trunk-or-topic-p) + 'topic))) + (and (eq type 'topic) + (vc-call-backend backend 'topic-outgoing-base)))) + +(defun vc--outgoing-base-mergebase (backend &optional upstream-location refresh) + "Return, under VC backend BACKEND, the merge base with UPSTREAM-LOCATION. +Normally UPSTREAM-LOCATION, if non-nil, is a string. +If UPSTREAM-LOCATION is nil, it means to call `vc--outgoing-base' and +use its return value as UPSTREAM-LOCATION. If `vc--outgoing-base' +returns nil, that means to use the place to which `vc-push' would push. +If UPSTREAM-LOCATION is the special value t, it means to use the place +to which `vc-push' would push as UPSTREAM-LOCATION, unconditionally. +(This is passed when the user invokes an outgoing base command with a + \\`C-u C-u' prefix argument; see `vc--maybe-read-outgoing-base'.) +REFRESH is passed on to `vc--incoming-revision'." + (if-let* ((incoming + (vc--incoming-revision backend + (pcase upstream-location + ('t nil) + ('nil (vc--outgoing-base backend)) + (_ upstream-location)) + refresh))) + (vc-call-backend backend 'mergebase incoming) + (user-error "No incoming revision -- local-only branch?"))) ;;;###autoload (defun vc-root-diff-outgoing-base (&optional upstream-location) @@ -3149,17 +3347,23 @@ The merge base with UPSTREAM-LOCATION means the common ancestor of the working revision and UPSTREAM-LOCATION. Uncommitted changes are included in the diff. -When unspecified UPSTREAM-LOCATION is the place \\[vc-push] would push -to. This default meaning for UPSTREAM-LOCATION may change in a future -release of Emacs. +When unspecified, UPSTREAM-LOCATION is the outgoing base. +For a trunk branch this is always the place \\[vc-push] would push to. +For a topic branch, query the backend for an appropriate outgoing base. +See `vc-trunk-branch-regexps' and `vc-topic-branch-regexps' regarding +the difference between trunk and topic branches. When called interactively with a prefix argument, prompt for UPSTREAM-LOCATION. In some version control systems, UPSTREAM-LOCATION can be a remote branch name. -This command is like `vc-root-diff-outgoing' except that it includes -uncommitted changes." - (interactive (list (vc--maybe-read-upstream-location))) +When called interactively with a \\[universal-argument] \\[universal-argument] \ +prefix argument, always +use the place to which \\[vc-push] would push to as the outgoing base, +i.e., treat this branch as a trunk branch even if Emacs thinks it is a +topic branch. (With a double prefix argument, this command is like +`vc-diff-outgoing' except that it includes uncommitted changes.)" + (interactive (list (vc--maybe-read-outgoing-base))) (vc--with-backend-in-rootdir "VC root-diff" (vc-diff-outgoing-base upstream-location `(,backend (,rootdir))))) @@ -3171,24 +3375,31 @@ The merge base with UPSTREAM-LOCATION means the common ancestor of the working revision and UPSTREAM-LOCATION. Uncommitted changes are included in the diff. -When unspecified UPSTREAM-LOCATION is the place \\[vc-push] would push -to. This default meaning for UPSTREAM-LOCATION may change in a future -release of Emacs. +When unspecified, UPSTREAM-LOCATION is the outgoing base. +For a trunk branch this is always the place \\[vc-push] would push to. +For a topic branch, query the backend for an appropriate outgoing base. +See `vc-trunk-branch-regexps' and `vc-topic-branch-regexps' regarding +the difference between trunk and topic branches. When called interactively with a prefix argument, prompt for UPSTREAM-LOCATION. In some version control systems, UPSTREAM-LOCATION can be a remote branch name. -When called from Lisp, optional argument FILESET overrides the fileset. +When called interactively with a \\[universal-argument] \\[universal-argument] \ +prefix argument, always +use the place to which \\[vc-push] would push to as the outgoing base, +i.e., treat this branch as a trunk branch even if Emacs thinks it is a +topic branch. (With a double prefix argument, this command is like +`vc-diff-outgoing' except that it includes uncommitted changes.) -This command is like to `vc-diff-outgoing' except that it includes -uncommitted changes." - (interactive (list (vc--maybe-read-upstream-location) nil)) - (let* ((fileset (or fileset (vc-deduce-fileset t))) - (backend (car fileset)) - (incoming (vc--incoming-revision backend upstream-location))) +When called from Lisp, optional argument FILESET overrides the fileset." + (interactive (let ((fileset (vc-deduce-fileset t))) + (list (vc--maybe-read-outgoing-base (car fileset)) + fileset))) + (let ((fileset (or fileset (vc-deduce-fileset t)))) (vc-diff-internal vc-allow-async-diff fileset - (vc-call-backend backend 'mergebase incoming) + (vc--outgoing-base-mergebase (car fileset) + upstream-location) nil (called-interactively-p 'interactive)))) @@ -4113,11 +4324,36 @@ starting at that revision. Tags and remote references also work." "History of upstream locations for VC incoming and outgoing commands.") (defun vc--maybe-read-upstream-location () + "Read upstream location if there is a prefix argument, else return nil." (and current-prefix-arg (let ((res (read-string "Upstream location/branch (empty for default): " nil 'vc-remote-location-history))) (and (not (string-empty-p res)) res)))) +(defun vc--maybe-read-outgoing-base (&optional backend) + "Return upstream location for interactive uses of outgoing base commands. +If there is no prefix argument, return nil. +If the current prefix argument is \\`C-u C-u', return t. +Otherwise prompt for an upstream location. +BACKEND is the VC backend." + (cond + ((equal current-prefix-arg '(16)) t) + (current-prefix-arg + (let* ((outgoing-base (vc-call-backend (or backend + (vc-deduce-backend)) + 'topic-outgoing-base)) + ;; If OUTGOING-BASE is non-nil then it isn't possible to + ;; specify an empty string in response to the prompt, which + ;; normally means to treat the current branch as a trunk. + ;; That's okay because you can use a double prefix argument + ;; to force treating the current branch as a trunk. + (res (read-string (if outgoing-base + (format-prompt "Upstream location/branch" + outgoing-base) + "Upstream location/branch (empty to treat as trunk): ") + nil 'vc-remote-location-history outgoing-base))) + (and (not (string-empty-p res)) res))))) + (defun vc--incoming-revision (backend &optional upstream-location refresh) ;; Some backends don't support REFRESH and so always behave as though ;; REFRESH is non-nil. This is not just for a lack of implementation @@ -5624,6 +5860,9 @@ except that this command works only in file-visiting buffers." 'get-change-comment))) (format "Summary: %s\n" (string-trim (funcall fn files rev)))))) +(defalias 'vc-default-working-branch #'ignore) +(defalias 'vc-default-trunk-or-topic-p #'ignore) + ;; These things should probably be generally available diff --git a/test/lisp/vc/vc-tests/vc-test-misc.el b/test/lisp/vc/vc-tests/vc-test-misc.el index 6bf0aed46d9..72dc8de22bf 100644 --- a/test/lisp/vc/vc-tests/vc-test-misc.el +++ b/test/lisp/vc/vc-tests/vc-test-misc.el @@ -217,5 +217,30 @@ (should (equal (buffer-string) "foo\n")))) (kill-buffer buf)))) +(ert-deftest vc-test-match-branch-name-regexps () + "Test `vc--match-branch-name-regexps'." + (let ((vc-trunk-branch-regexps '("master" "main"))) + (let ((vc-topic-branch-regexps '("m.*"))) + (should-error (vc--match-branch-name-regexps "master"))) + (let ((vc-topic-branch-regexps '("f" "o"))) + (should (eq (vc--match-branch-name-regexps "master") 'trunk)) + (should (null (vc--match-branch-name-regexps "foo")))) + (let ((vc-topic-branch-regexps '("f.*" "o"))) + (should (eq (vc--match-branch-name-regexps "master") 'trunk)) + (should (eq (vc--match-branch-name-regexps "foo") 'topic))) + (let (vc-topic-branch-regexps) + (should (eq (vc--match-branch-name-regexps "master") 'trunk)) + (should (null (vc--match-branch-name-regexps "foo")))) + (let ((vc-topic-branch-regexps t)) + (should (eq (vc--match-branch-name-regexps "master") 'trunk)) + (should (eq (vc--match-branch-name-regexps "foo") 'topic)))) + (let ((vc-trunk-branch-regexps '(not "master"))) + (let (vc-topic-branch-regexps) + (should (null (vc--match-branch-name-regexps "master"))) + (should (eq (vc--match-branch-name-regexps "foo") 'trunk))) + (let ((vc-topic-branch-regexps t)) + (should (eq (vc--match-branch-name-regexps "master") 'topic)) + (should (eq (vc--match-branch-name-regexps "foo") 'trunk))))) + (provide 'vc-test-misc) ;;; vc-test-misc.el ends here