Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-16 09:14:18 +00:00
Code Issues Projects Releases Packages Wiki Activity

New revision-published-p VC backend API function (bug#79408)

Browse source 
* lisp/vc/vc-git.el (vc-git-revision-published-p): New function.
(vc-git--assert-allowed-rewrite): Use it.
* lisp/vc/vc-hg.el (vc-hg-revision-published-p): New function.
* lisp/vc/vc.el: Specify revision-published-p backend API
function (bug#79408).
This commit is contained in:
Sean Whitton 2025-10-26 14:35:59 +00:00
parent ac835686b5
commit ab5e64aa95
3 changed files with 45 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

43
lisp/vc/vc-git.el
View file

@ -2208,27 +2208,40 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
(format "Summary: %s\n(cherry picked from commit %s)\n"
comment rev))))
(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)))
;; 'git branch --contains' is a porcelain command whose output could
;; change in the future.
(unless (zerop (vc-git-command nil 1 nil "merge-base"
"--is-ancestor" rev branch))
(error "Revision %s does not exist on branch %s" rev branch))
(and
;; BRANCH has an upstream.
(with-temp-buffer
(vc-git--out-ok "config" "--get"
(format "branch.%s.merge" branch)))
;; REV is not outgoing.
(not (cl-member rev
(split-string
(with-output-to-string
(vc-git-command standard-output 0 nil "log"
"--pretty=format:%H"
"@{upstream}..HEAD")))
:test #'string-prefix-p)))))
(defun vc-git--assert-allowed-rewrite (rev)
(when (and (not (and vc-allow-rewriting-published-history
(not (eq vc-allow-rewriting-published-history 'ask))))
;; Check there is an upstream.
(with-temp-buffer
(vc-git--out-ok "config" "--get"
(format "branch.%s.merge"
(vc-git--current-branch)))))
(let ((outgoing (split-string
(with-output-to-string
(vc-git-command standard-output 0 nil "log"
"--pretty=format:%H"
"@{upstream}..HEAD")))))
(unless (or (cl-member rev outgoing :test #'string-prefix-p)
(and (eq vc-allow-rewriting-published-history 'ask)
(vc-git-revision-published-p rev)
(not (and (eq vc-allow-rewriting-published-history 'ask)
(yes-or-no-p
(format "\
Commit %s appears published; allow rewriting history?"
rev))))
(user-error "\
Will not rewrite likely-public history; see option `vc-allow-rewriting-published-history'")))))
rev)))))
(user-error "Will not rewrite likely-public history; \
see option `vc-allow-rewriting-published-history'")))
(defun vc-git-modify-change-comment (files rev comment)
(vc-git--assert-allowed-rewrite rev)

7
lisp/vc/vc-hg.el
View file

@ -1832,6 +1832,13 @@ Cannot relocate first working tree because this would break other working trees"
;; comment by just one line break, for 'hg graft'.
(format "Summary: %s\n(grafted from %s)\n" comment long))))
(defun vc-hg-revision-published-p (rev)
"Whether REV has been pushed such that it is public history.
Always has to fetch, like `vc-hg-incoming-revision' does."
(with-temp-buffer
(vc-hg-command t 0 nil "log" (format "--rev=outgoing() and %s" rev))
(<= (point-max) 1)))
(provide 'vc-hg)
;;; vc-hg.el ends here

10
lisp/vc/vc.el
View file

@ -544,6 +544,16 @@
;;
;; Return the most recent revision of FILE that made a change
;; on LINE.
;;
;; - revision-published-p (rev)
;;
;; For a distributed VCS, return whether REV is part of the public
;; history of this branch, or only local history. I.e., whether REV
;; has been pushed. Implementations should not consider whether REV
;; is part of the public history of any other branches.
;; It is an error if REV is not present on the current branch.
;; Centralized VCS *must not* implement this, and there is no default
;; implementation.
;; TAG/BRANCH SYSTEM
;;