:type 'boolean
:version "28.1")
+;; The default is nil because only a VC user who also possesses a lot of
+;; Git-specific knowledge can know when it is okay to rewrite history,
+;; and we can't convey to a relatively Git-naïve user the potential
+;; risks in only the space of a minibuffer y/n prompt.
+(defcustom vc-git-allow-rewriting-history nil
+ "When non-nil, permit Git operations that may rewrite published history.
+
+Many Git 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. See \"Recovering from
+Upstream Rebase\" in the Man page git-rebase(1).
+
+Normally, Emacs refuses to run Git 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")
+
;; History of Git commands.
(defvar vc-git-history nil)
: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
(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))
(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")))
(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-git-allow-rewriting-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-git-allow-rewriting-history
+ (yes-or-no-p
+ (format
+"Commit %s looks to be published; are you sure you want to rewrite history?"
+ rev))))
+ (user-error "Will not rewrite likely-public Git history")))))
+
+(defun vc-git-modify-change-comment (files rev comment)
+ (vc-git--assert-allowed-rewrite rev)
+ (let* ((args (delete "--amend"
+ (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"))))
+ (nothing-staged
+ (zerop
+ (vc-git-command nil t nil "diff" "--cached" "--quiet"))))
+ ;; We want to do just
+ ;;
+ ;; % git commit --only --allow-empty -m...
+ ;; % git rebase --autostash --autosquash -i REV~1
+ ;;
+ ;; because the first command is guaranteed to create an empty commit
+ ;; regardless of the state of the index and working tree. However,
+ ;; that requires git.git commit 319d835, released in Git 2.11.1.
+ ;; In order to support older Git we do this longer, slower sequence:
+ ;;
+ ;; % git stash push
+ ;; % git commit --allow-empty -m...
+ ;; % git rebase --autosquash -i REV~1
+ ;; % git stash pop
+ ;; (unless nothing-staged
+ ;; (vc-git-command nil 0 nil "stash" "push"))
+ (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)))
+ (apply #'vc-git-command nil 0 nil
+ "commit" "--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" "--autosquash" "-i"
+ ;; (format "%s~1" rev)))
+ ;; (unless nothing-staged
+ ;; (vc-git-command nil 0 nil "stash" "pop" "--index"))
+ (message "temporary file is: %s" msg-file)
+ ))
+
(defvar vc-git-extra-menu-map
(let ((map (make-sparse-keymap)))
(define-key map [git-grep]
projects / emacs.git / commitdiff