mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-21 06:55:39 +00:00
Support modifying VC change comments for Git
* lisp/vc/vc.el (vc-allow-rewriting-published-history): New option. * lisp/vc/vc-git.el (vc-git--assert-allowed-rewrite) (vc-git-modify-change-comment): New functions (bug#64055). (vc-git--current-branch): Factor out of vc-git-dir--branch-headers. (vc-git--log-edit-extract-headers): Factor out of vc-git-checkin. * etc/NEWS: Announce the new support and option.
This commit is contained in:
Sean Whitton
parent
246d68bd2a
commit
00149f18ea
14
etc/NEWS
14
etc/NEWS
@ -600,6 +600,20 @@ When non-nil, MPC will crossfade between songs for the specified number
|
||||
of seconds. Crossfading can be toggled using the command
|
||||
'mpc-toggle-crossfade' or from the MPC menu.
|
||||
|
||||
** VC
|
||||
|
||||
---
|
||||
*** Using 'e' from Log View mode to modify change comments now works for Git.
|
||||
|
||||
---
|
||||
*** New user option 'vc-allow-rewriting-published-history'.
|
||||
Many VCS commands can change your copy of published change history
|
||||
without warning. If VC commands detect that this could happen, they
|
||||
will stop. You can customize this variable to permit rewriting history
|
||||
even though Emacs thinks it is dangerous.
|
||||
|
||||
So far, this applies only to using 'e' from Log View mode for Git.
|
||||
|
||||
|
||||
* New Modes and Packages in Emacs 31.1
|
||||
|
||||
|
||||
@ -558,8 +558,8 @@ If called interactively, visit the version at point."
|
||||
;; See discussion in bug#64055. --spwhitton
|
||||
;;
|
||||
;; FIXME: We should implement backend actions
|
||||
;; `get-change-comment' and `modify-change-comment' for Git,
|
||||
;; bzr and Hg, so that this command works for those backends.
|
||||
;; `get-change-comment' and `modify-change-comment' for bzr and
|
||||
;; Hg, so that this command works for those backends.
|
||||
;; As discussed in bug#64055, get-change-comment is required,
|
||||
;; and parsing the old comment out of the Log View buffer will
|
||||
;; not do. This is because for these backends there are
|
||||
|
||||
@ -728,11 +728,13 @@ or an empty string if none."
|
||||
:files files
|
||||
:update-function update-function)))
|
||||
|
||||
(defun vc-git--current-branch ()
|
||||
(vc-git--out-match '("symbolic-ref" "HEAD")
|
||||
"^\\(refs/heads/\\)?\\(.+\\)$" 2))
|
||||
|
||||
(defun vc-git-dir--branch-headers ()
|
||||
"Return headers for branch-related information."
|
||||
(let ((branch (vc-git--out-match
|
||||
'("symbolic-ref" "HEAD")
|
||||
"^\\(refs/heads/\\)?\\(.+\\)$" 2))
|
||||
(let ((branch (vc-git--current-branch))
|
||||
tracking remote-url)
|
||||
(if branch
|
||||
(when-let ((branch-merge
|
||||
@ -1082,6 +1084,17 @@ It is based on `log-edit-mode', and has Git-specific extensions."
|
||||
|
||||
(autoload 'vc-switches "vc")
|
||||
|
||||
(defun vc-git--log-edit-extract-headers (comment)
|
||||
(cl-flet ((boolean-arg-fn (argument)
|
||||
(lambda (v) (and (equal v "yes") (list argument)))))
|
||||
(log-edit-extract-headers
|
||||
`(("Author" . "--author")
|
||||
("Date" . "--date")
|
||||
("Amend" . ,(boolean-arg-fn "--amend"))
|
||||
("No-Verify" . ,(boolean-arg-fn "--no-verify"))
|
||||
("Sign-Off" . ,(boolean-arg-fn "--signoff")))
|
||||
comment)))
|
||||
|
||||
(defun vc-git-checkin (files comment &optional _rev)
|
||||
(let* ((file1 (or (car files) default-directory))
|
||||
(root (vc-git-root file1))
|
||||
@ -1180,31 +1193,23 @@ It is based on `log-edit-mode', and has Git-specific extensions."
|
||||
(vc-git-command nil 0 patch-file "apply" "--cached")
|
||||
(delete-file patch-file))))
|
||||
(when to-stash (vc-git--stash-staged-changes files)))
|
||||
(cl-flet ((boolean-arg-fn
|
||||
(argument)
|
||||
(lambda (value) (when (equal value "yes") (list argument)))))
|
||||
;; When operating on the whole tree, better pass "-a" than ".", since "."
|
||||
;; fails when we're committing a merge.
|
||||
(apply #'vc-git-command nil 0 (if (and only (not vc-git-patch-string)) files)
|
||||
(nconc (if msg-file (list "commit" "-F"
|
||||
(file-local-name msg-file))
|
||||
(list "commit" "-m"))
|
||||
(let ((args
|
||||
(log-edit-extract-headers
|
||||
`(("Author" . "--author")
|
||||
("Date" . "--date")
|
||||
("Amend" . ,(boolean-arg-fn "--amend"))
|
||||
("No-Verify" . ,(boolean-arg-fn "--no-verify"))
|
||||
("Sign-Off" . ,(boolean-arg-fn "--signoff")))
|
||||
comment)))
|
||||
(when msg-file
|
||||
(let ((coding-system-for-write
|
||||
(or pcsw vc-git-commits-coding-system)))
|
||||
(write-region (car args) nil msg-file))
|
||||
(setq args (cdr args)))
|
||||
args)
|
||||
(unless vc-git-patch-string
|
||||
(if only (list "--only" "--") '("-a"))))))
|
||||
;; When operating on the whole tree, better pass "-a" than ".",
|
||||
;; since "." fails when we're committing a merge.
|
||||
(apply #'vc-git-command nil 0
|
||||
(if (and only (not vc-git-patch-string)) files)
|
||||
(nconc (if msg-file (list "commit" "-F"
|
||||
(file-local-name msg-file))
|
||||
(list "commit" "-m"))
|
||||
(let ((args
|
||||
(vc-git--log-edit-extract-headers comment)))
|
||||
(when msg-file
|
||||
(let ((coding-system-for-write
|
||||
(or pcsw vc-git-commits-coding-system)))
|
||||
(write-region (car args) nil msg-file))
|
||||
(setq args (cdr args)))
|
||||
args)
|
||||
(unless vc-git-patch-string
|
||||
(if only (list "--only" "--") '("-a")))))
|
||||
(if (and msg-file (file-exists-p msg-file)) (delete-file msg-file))
|
||||
(when to-stash
|
||||
(let ((cached (make-nearby-temp-file "git-cached")))
|
||||
@ -1960,6 +1965,70 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
|
||||
(vc-git-command standard-output 1 nil
|
||||
"log" "--max-count=1" "--pretty=format:%B" rev)))
|
||||
|
||||
(defun vc-git--assert-allowed-rewrite (rev)
|
||||
(when (and (not (eq vc-allow-rewriting-published-history 'no-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 vc-allow-rewriting-published-history
|
||||
(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'")))))
|
||||
|
||||
(defun vc-git-modify-change-comment (files rev comment)
|
||||
(vc-git--assert-allowed-rewrite rev)
|
||||
(let* ((args (vc-git--log-edit-extract-headers comment))
|
||||
(message (format "amend! %s\n\n%s" rev (pop args)))
|
||||
(msg-file
|
||||
;; On MS-Windows, pass the message through a file, to work
|
||||
;; around how command line arguments must be in the system
|
||||
;; codepage, and therefore might not support non-ASCII.
|
||||
;;
|
||||
;; As our other arguments are static, we need not be concerned
|
||||
;; about the encoding of command line arguments in general.
|
||||
;; See `vc-git-checkin' for the more complex case.
|
||||
(and (eq system-type 'windows-nt)
|
||||
(let ((default-directory
|
||||
(or (file-name-directory (or (car files)
|
||||
default-directory))
|
||||
default-directory)))
|
||||
(make-nearby-temp-file "git-msg")))))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(when (cl-intersection '("--author" "--date") args
|
||||
:test #'string=)
|
||||
;; 'git rebase --autosquash' cannot alter authorship.
|
||||
;; See the description of --fixup in git-commit(1).
|
||||
(error
|
||||
"Author: and Date: not supported when modifying existing commits"))
|
||||
(when msg-file
|
||||
(let ((coding-system-for-write
|
||||
(or coding-system-for-write
|
||||
vc-git-commits-coding-system)))
|
||||
(write-region message nil msg-file)))
|
||||
;; Regardless of the state of the index and working tree, this
|
||||
;; will always create an empty commit, thanks to --only.
|
||||
(apply #'vc-git-command nil 0 nil
|
||||
"commit" "--only" "--allow-empty"
|
||||
(nconc (if msg-file
|
||||
(list "-F" (file-local-name msg-file))
|
||||
(list "-m" message))
|
||||
args)))
|
||||
(when (and msg-file (file-exists-p msg-file))
|
||||
(delete-file msg-file))))
|
||||
(with-environment-variables (("GIT_SEQUENCE_EDITOR" "true"))
|
||||
(vc-git-command nil 0 nil "rebase" "--autostash" "--autosquash" "-i"
|
||||
(format "%s~1" rev))))
|
||||
|
||||
(defvar vc-git-extra-menu-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map [git-grep]
|
||||
|
||||
@ -914,6 +914,31 @@ is sensitive to blank lines."
|
||||
:type 'boolean
|
||||
:version "27.1")
|
||||
|
||||
;; The default is nil because only a VC user who also possesses a lot of
|
||||
;; knowledge specific to the VCS in use can know when it is okay to
|
||||
;; rewrite history, and we can't convey to a user who is relatively
|
||||
;; naïve regarding the VCS in use the potential risks in only the space
|
||||
;; of a minibuffer yes/no prompt.
|
||||
;;
|
||||
;; See `vc-git--assert-allowed-rewrite' for an example of how to use
|
||||
;; this variable in VCS backend code.
|
||||
(defcustom vc-allow-rewriting-published-history nil
|
||||
"When non-nil, permit VCS operations that may rewrite published history.
|
||||
|
||||
Many VCS commands can change your copy of published change history
|
||||
without warning. If this occurs, you won't be able to pull and push in
|
||||
the ordinary way until you take special action. For example, for Git,
|
||||
see \"Recovering from Upstream Rebase\" in the Man page git-rebase(1).
|
||||
|
||||
Normally, Emacs refuses to run VCS commands that it thinks will rewrite
|
||||
published history. If you customize this variable to a non-nil value,
|
||||
Emacs will instead prompt you to confirm that you really want to perform
|
||||
the rewrite. A value of `no-ask' means to proceed with no prompting."
|
||||
:type '(choice (const :tag "Don't allow" nil)
|
||||
(const :tag "Prompt to allow" t)
|
||||
(const :tag "Allow without prompting" no-ask))
|
||||
:version "31.1")
|
||||
|
||||
|
||||
;; File property caching
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user