2021-01-31 23:00:39 +00:00
|
|
|
|
;;; gitmerge.el --- help merge one Emacs branch into another -*- lexical-binding: t; -*-
|
2014-11-27 17:22:00 +00:00
|
|
|
|
|
2023-01-01 10:31:12 +00:00
|
|
|
|
;; Copyright (C) 2010-2023 Free Software Foundation, Inc.
|
2014-11-27 17:22:00 +00:00
|
|
|
|
|
|
|
|
|
;; Authors: David Engster <deng@randomsample.de>
|
|
|
|
|
;; Stefan Monnier <monnier@iro.umontreal.ca>
|
|
|
|
|
|
|
|
|
|
;; Keywords: maint
|
|
|
|
|
|
2021-02-08 08:03:27 +00:00
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
|
|
2014-11-27 17:22:00 +00:00
|
|
|
|
;; GNU Emacs is free software: you can redistribute it and/or modify
|
|
|
|
|
;; it under the terms of the GNU General Public License as published by
|
|
|
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
|
|
|
;; (at your option) any later version.
|
|
|
|
|
|
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
|
|
;; GNU General Public License for more details.
|
|
|
|
|
|
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
2017-09-13 22:52:52 +00:00
|
|
|
|
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
2014-11-27 17:22:00 +00:00
|
|
|
|
|
|
|
|
|
;;; Commentary:
|
|
|
|
|
|
|
|
|
|
;; Rewrite of bzrmerge.el, but using git.
|
|
|
|
|
;;
|
|
|
|
|
;; In a nutshell: For merging foo into master, do
|
|
|
|
|
;;
|
|
|
|
|
;; - 'git checkout master' in Emacs repository
|
|
|
|
|
;; - Start Emacs, cd to Emacs repository
|
|
|
|
|
;; - M-x gitmerge
|
|
|
|
|
;; - Choose branch 'foo' or 'origin/foo', depending on whether you
|
|
|
|
|
;; like to merge from a local tracking branch or from the remote
|
|
|
|
|
;; (does not make a difference if the local tracking branch is
|
|
|
|
|
;; up-to-date).
|
|
|
|
|
;; - Mark commits you'd like to skip, meaning to only merge their
|
|
|
|
|
;; metadata (merge strategy 'ours').
|
2021-11-11 09:22:05 +00:00
|
|
|
|
;; - Hit 'm' to start merging. Skipped commits will be merged separately.
|
2014-11-27 17:22:00 +00:00
|
|
|
|
;; - If conflicts cannot be resolved automatically, you'll have to do
|
2021-11-11 09:22:05 +00:00
|
|
|
|
;; it manually. In that case, resolve the conflicts and restart
|
|
|
|
|
;; gitmerge, which will automatically resume. It will add resolved
|
2014-11-27 17:22:00 +00:00
|
|
|
|
;; files, commit the pending merge and continue merging the rest.
|
|
|
|
|
;; - Inspect master branch, and if everything looks OK, push.
|
|
|
|
|
|
|
|
|
|
;;; Code:
|
|
|
|
|
|
|
|
|
|
(require 'vc-git)
|
|
|
|
|
(require 'smerge-mode)
|
|
|
|
|
|
|
|
|
|
(defvar gitmerge-skip-regexp
|
2015-12-26 04:37:36 +00:00
|
|
|
|
;; We used to include "sync" in there, but in my experience it only
|
|
|
|
|
;; caused false positives. --Stef
|
2017-12-19 00:49:51 +00:00
|
|
|
|
(let ((skip "back[- ]?port\\|cherry picked from commit\\|\
|
2018-12-10 17:42:17 +00:00
|
|
|
|
\\(do\\( no\\|n['’]\\)t\\|no need to\\) merge\\|not to be merged\\|\
|
2019-12-30 17:28:29 +00:00
|
|
|
|
bump Emacs version\\|Auto-commit"))
|
2017-12-19 00:49:51 +00:00
|
|
|
|
(if noninteractive skip
|
|
|
|
|
;; "Regenerate" is quite prone to false positives.
|
|
|
|
|
;; We only want to skip merging things like AUTHORS and ldefs-boot.
|
|
|
|
|
;; These should be covered by "bump version" and "auto-commit".
|
|
|
|
|
;; It doesn't do much harm if we merge one of those files by mistake.
|
|
|
|
|
;; So it's better to err on the side of false negatives.
|
|
|
|
|
(concat skip "\\|re-?generate\\|from trunk")))
|
2014-11-27 17:22:00 +00:00
|
|
|
|
"Regexp matching logs of revisions that might be skipped.
|
|
|
|
|
`gitmerge-missing' will ask you if it should skip any matches.")
|
|
|
|
|
|
2017-12-19 00:56:21 +00:00
|
|
|
|
(defvar gitmerge-minimum-missing 10
|
|
|
|
|
"Minimum number of missing commits to consider merging in batch mode.")
|
|
|
|
|
|
2021-11-23 10:39:21 +00:00
|
|
|
|
(defvar gitmerge-status-file (locate-user-emacs-file "gitmerge-status")
|
2014-11-27 17:22:00 +00:00
|
|
|
|
"File where missing commits will be saved between sessions.")
|
|
|
|
|
|
|
|
|
|
(defvar gitmerge-ignore-branches-regexp
|
|
|
|
|
"origin/\\(\\(HEAD\\|master\\)$\\|\\(old-branches\\|other-branches\\)/\\)"
|
|
|
|
|
"Regexp matching branches we want to ignore.")
|
|
|
|
|
|
|
|
|
|
(defface gitmerge-skip-face
|
|
|
|
|
'((t (:strike-through t)))
|
|
|
|
|
"Face for skipped commits.")
|
|
|
|
|
|
2017-12-02 03:03:05 +00:00
|
|
|
|
(defvar gitmerge-default-branch nil
|
|
|
|
|
"Default for branch that should be merged.
|
|
|
|
|
If nil, the function `gitmerge-default-branch' guesses.")
|
2014-11-27 17:22:00 +00:00
|
|
|
|
|
|
|
|
|
(defconst gitmerge-buffer "*gitmerge*"
|
|
|
|
|
"Working buffer for gitmerge.")
|
|
|
|
|
|
|
|
|
|
(defconst gitmerge-output-buffer "*gitmerge output*"
|
|
|
|
|
"Buffer for displaying git output.")
|
|
|
|
|
|
|
|
|
|
(defconst gitmerge-warning-buffer "*gitmerge warnings*"
|
|
|
|
|
"Buffer where gitmerge will display any warnings.")
|
|
|
|
|
|
|
|
|
|
(defvar gitmerge-log-regexp
|
|
|
|
|
"^\\([A-Z ]\\)\\s-*\\([0-9a-f]+\\) \\(.+?\\): \\(.*\\)$")
|
|
|
|
|
|
2021-11-21 09:10:07 +00:00
|
|
|
|
(defvar gitmerge-mode-map
|
|
|
|
|
(let ((map (make-keymap)))
|
2022-09-21 08:10:22 +00:00
|
|
|
|
(define-key map [(l)] #'gitmerge-show-log)
|
|
|
|
|
(define-key map [(d)] #'gitmerge-show-diff)
|
|
|
|
|
(define-key map [(f)] #'gitmerge-show-files)
|
|
|
|
|
(define-key map [(s)] #'gitmerge-toggle-skip)
|
|
|
|
|
(define-key map [(m)] #'gitmerge-start-merge)
|
|
|
|
|
;; For convenience:
|
|
|
|
|
(define-key map [(n)] #'next-line)
|
|
|
|
|
(define-key map [(p)] #'previous-line)
|
2021-11-21 09:10:07 +00:00
|
|
|
|
map)
|
|
|
|
|
"Keymap for gitmerge major mode.")
|
|
|
|
|
|
2014-12-05 20:20:02 +00:00
|
|
|
|
|
|
|
|
|
(defvar gitmerge-mode-font-lock-keywords
|
|
|
|
|
`((,gitmerge-log-regexp
|
|
|
|
|
(1 font-lock-warning-face)
|
|
|
|
|
(2 font-lock-constant-face)
|
|
|
|
|
(3 font-lock-builtin-face)
|
|
|
|
|
(4 font-lock-comment-face))))
|
|
|
|
|
|
2014-11-27 17:22:00 +00:00
|
|
|
|
(defvar gitmerge--commits nil)
|
|
|
|
|
(defvar gitmerge--from nil)
|
|
|
|
|
|
2017-12-02 03:03:05 +00:00
|
|
|
|
(defun gitmerge-emacs-version (&optional branch)
|
|
|
|
|
"Return the major version of Emacs, optionally in BRANCH."
|
|
|
|
|
(with-temp-buffer
|
|
|
|
|
(if (not branch)
|
|
|
|
|
(insert-file-contents "configure.ac")
|
2021-11-03 18:50:34 +00:00
|
|
|
|
(let ((coding-system-for-read vc-git-log-output-coding-system))
|
|
|
|
|
(call-process "git" nil t nil "show" (format "%s:configure.ac" branch)))
|
2017-12-02 03:03:05 +00:00
|
|
|
|
(goto-char (point-min)))
|
2022-07-06 04:25:44 +00:00
|
|
|
|
(re-search-forward "^AC_INIT([^,]+, \\[?\\([0-9]+\\)\\.")
|
2017-12-02 03:03:05 +00:00
|
|
|
|
(string-to-number (match-string 1))))
|
|
|
|
|
|
|
|
|
|
(defun gitmerge-default-branch ()
|
2021-11-11 09:22:05 +00:00
|
|
|
|
"Default for branch that should be merged; e.g. \"origin/emacs-28\"."
|
2017-12-02 03:03:05 +00:00
|
|
|
|
(or gitmerge-default-branch
|
|
|
|
|
(format "origin/emacs-%s" (1- (gitmerge-emacs-version)))))
|
|
|
|
|
|
2014-11-27 17:22:00 +00:00
|
|
|
|
(defun gitmerge-get-sha1 ()
|
|
|
|
|
"Get SHA1 from commit at point."
|
|
|
|
|
(save-excursion
|
2022-08-23 02:54:57 +00:00
|
|
|
|
(goto-char (line-beginning-position))
|
2014-11-27 17:22:00 +00:00
|
|
|
|
(when (looking-at "^[A-Z ]\\s-*\\([a-f0-9]+\\)")
|
|
|
|
|
(match-string 1))))
|
|
|
|
|
|
|
|
|
|
(defun gitmerge-show-log ()
|
|
|
|
|
"Show log of commit at point."
|
|
|
|
|
(interactive)
|
|
|
|
|
(save-selected-window
|
|
|
|
|
(let ((commit (gitmerge-get-sha1)))
|
|
|
|
|
(when commit
|
|
|
|
|
(pop-to-buffer (get-buffer-create gitmerge-output-buffer))
|
|
|
|
|
(fundamental-mode)
|
|
|
|
|
(erase-buffer)
|
2021-11-03 18:50:34 +00:00
|
|
|
|
(let ((coding-system-for-read vc-git-log-output-coding-system))
|
|
|
|
|
(call-process "git" nil t nil "log" "-1" commit))
|
2014-11-27 17:22:00 +00:00
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(gitmerge-highlight-skip-regexp)))))
|
|
|
|
|
|
|
|
|
|
(defun gitmerge-show-diff ()
|
|
|
|
|
"Show diff of commit at point."
|
|
|
|
|
(interactive)
|
|
|
|
|
(save-selected-window
|
|
|
|
|
(let ((commit (gitmerge-get-sha1)))
|
|
|
|
|
(when commit
|
|
|
|
|
(pop-to-buffer (get-buffer-create gitmerge-output-buffer))
|
|
|
|
|
(erase-buffer)
|
2021-11-03 18:50:34 +00:00
|
|
|
|
(let ((coding-system-for-read vc-git-log-output-coding-system))
|
|
|
|
|
(call-process "git" nil t nil "diff-tree" "-p" commit))
|
2014-11-27 17:22:00 +00:00
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(diff-mode)))))
|
|
|
|
|
|
|
|
|
|
(defun gitmerge-show-files ()
|
|
|
|
|
"Show changed files of commit at point."
|
|
|
|
|
(interactive)
|
|
|
|
|
(save-selected-window
|
|
|
|
|
(let ((commit (gitmerge-get-sha1)))
|
|
|
|
|
(when commit
|
|
|
|
|
(pop-to-buffer (get-buffer-create gitmerge-output-buffer))
|
|
|
|
|
(erase-buffer)
|
|
|
|
|
(fundamental-mode)
|
2021-11-03 18:50:34 +00:00
|
|
|
|
(let ((coding-system-for-read vc-git-log-output-coding-system))
|
|
|
|
|
(call-process "git" nil t nil "diff" "--name-only"
|
|
|
|
|
(concat commit "^!")))
|
2014-11-27 17:22:00 +00:00
|
|
|
|
(goto-char (point-min))))))
|
|
|
|
|
|
|
|
|
|
(defun gitmerge-toggle-skip ()
|
|
|
|
|
"Toggle skipping of commit at point."
|
|
|
|
|
(interactive)
|
|
|
|
|
(let ((commit (gitmerge-get-sha1))
|
|
|
|
|
skip)
|
|
|
|
|
(when commit
|
|
|
|
|
(save-excursion
|
2022-08-23 02:54:57 +00:00
|
|
|
|
(goto-char (line-beginning-position))
|
2014-11-27 17:22:00 +00:00
|
|
|
|
(when (looking-at "^\\([A-Z ]\\)\\s-*\\([a-f0-9]+\\)")
|
|
|
|
|
(setq skip (string= (match-string 1) " "))
|
|
|
|
|
(goto-char (match-beginning 2))
|
|
|
|
|
(gitmerge-handle-skip-overlay skip)
|
|
|
|
|
(dolist (ct gitmerge--commits)
|
|
|
|
|
(when (string-match commit (car ct))
|
|
|
|
|
(setcdr ct (when skip "M"))))
|
2022-08-23 02:54:57 +00:00
|
|
|
|
(goto-char (line-beginning-position))
|
2014-11-27 17:22:00 +00:00
|
|
|
|
(setq buffer-read-only nil)
|
|
|
|
|
(delete-char 1)
|
|
|
|
|
(insert (if skip "M" " "))
|
|
|
|
|
(setq buffer-read-only t))))))
|
2014-11-29 07:54:57 +00:00
|
|
|
|
|
2014-11-27 17:22:00 +00:00
|
|
|
|
(defun gitmerge-highlight-skip-regexp ()
|
|
|
|
|
"Highlight strings that match `gitmerge-skip-regexp'."
|
|
|
|
|
(save-excursion
|
2016-03-22 19:53:54 +00:00
|
|
|
|
(let ((case-fold-search t))
|
|
|
|
|
(while (re-search-forward gitmerge-skip-regexp nil t)
|
|
|
|
|
(put-text-property (match-beginning 0) (match-end 0)
|
|
|
|
|
'face 'font-lock-warning-face)))))
|
2014-11-27 17:22:00 +00:00
|
|
|
|
|
|
|
|
|
(defun gitmerge-missing (from)
|
|
|
|
|
"Return the list of revisions that need to be merged from FROM.
|
|
|
|
|
Will detect a default set of skipped revision by looking at
|
|
|
|
|
cherry mark and search for `gitmerge-skip-regexp'. The result is
|
|
|
|
|
a list with entries of the form (SHA1 . SKIP), where SKIP denotes
|
|
|
|
|
if and why this commit should be skipped."
|
2017-12-19 00:38:25 +00:00
|
|
|
|
(message "Finding missing commits...")
|
2014-11-27 17:22:00 +00:00
|
|
|
|
(let (commits)
|
|
|
|
|
;; Go through the log and remember all commits that match
|
|
|
|
|
;; `gitmerge-skip-regexp' or are marked by --cherry-mark.
|
|
|
|
|
(with-temp-buffer
|
2021-11-03 18:50:34 +00:00
|
|
|
|
(let ((coding-system-for-read vc-git-log-output-coding-system))
|
|
|
|
|
(call-process "git" nil t nil "log" "--cherry-mark" "--left-only"
|
|
|
|
|
"--no-decorate"
|
|
|
|
|
(concat from "..." (car (vc-git-branches)))))
|
2014-11-27 17:22:00 +00:00
|
|
|
|
(goto-char (point-max))
|
|
|
|
|
(while (re-search-backward "^commit \\(.+\\) \\([0-9a-f]+\\).*" nil t)
|
|
|
|
|
(let ((cherrymark (match-string 1))
|
|
|
|
|
(commit (match-string 2)))
|
|
|
|
|
(push (list commit) commits)
|
|
|
|
|
(if (string= cherrymark "=")
|
|
|
|
|
;; Commit was recognized as backported by cherry-mark.
|
|
|
|
|
(setcdr (car commits) "C")
|
|
|
|
|
(save-excursion
|
|
|
|
|
(let ((case-fold-search t))
|
|
|
|
|
(while (not (looking-at "^\\s-+[^ ]+"))
|
|
|
|
|
(forward-line))
|
|
|
|
|
(when (re-search-forward gitmerge-skip-regexp nil t)
|
|
|
|
|
(setcdr (car commits) "R"))))))
|
|
|
|
|
(delete-region (point) (point-max))))
|
2017-12-19 00:38:25 +00:00
|
|
|
|
(message "Finding missing commits...done")
|
2014-11-27 17:22:00 +00:00
|
|
|
|
(nreverse commits)))
|
|
|
|
|
|
|
|
|
|
(defun gitmerge-setup-log-buffer (commits from)
|
|
|
|
|
"Create the buffer for choosing commits."
|
|
|
|
|
(with-current-buffer (get-buffer-create gitmerge-buffer)
|
|
|
|
|
(erase-buffer)
|
2021-11-03 18:50:34 +00:00
|
|
|
|
(let ((coding-system-for-read vc-git-log-output-coding-system))
|
|
|
|
|
(call-process "git" nil t nil "log" "--left-only"
|
|
|
|
|
"--pretty=format:%h %<(20,trunc) %an: %<(100,trunc) %s"
|
|
|
|
|
(concat from "..." (car (vc-git-branches)))))
|
2014-11-27 17:22:00 +00:00
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(while (looking-at "^\\([a-f0-9]+\\)")
|
|
|
|
|
(let ((skipreason (gitmerge-skip-commit-p (match-string 1) commits)))
|
|
|
|
|
(if (null skipreason)
|
|
|
|
|
(insert " ")
|
|
|
|
|
(insert skipreason " ")
|
|
|
|
|
(gitmerge-handle-skip-overlay t)))
|
|
|
|
|
(forward-line))
|
|
|
|
|
(current-buffer)))
|
|
|
|
|
|
|
|
|
|
(defun gitmerge-handle-skip-overlay (skip)
|
|
|
|
|
"Create or delete overlay on SHA1, depending on SKIP."
|
|
|
|
|
(when (looking-at "[0-9a-f]+")
|
|
|
|
|
(if skip
|
|
|
|
|
(let ((ov (make-overlay (point)
|
|
|
|
|
(match-end 0))))
|
|
|
|
|
(overlay-put ov 'face 'gitmerge-skip-face))
|
|
|
|
|
(remove-overlays (point) (match-end 0)
|
|
|
|
|
'face 'gitmerge-skip-face))))
|
|
|
|
|
|
|
|
|
|
(defun gitmerge-skip-commit-p (commit skips)
|
|
|
|
|
"Tell whether COMMIT should be skipped.
|
|
|
|
|
COMMIT is an (possibly abbreviated) SHA1. SKIPS is list of
|
|
|
|
|
cons'es with commits that should be skipped and the reason.
|
|
|
|
|
Return value is string which denotes reason, or nil if commit
|
|
|
|
|
should not be skipped."
|
|
|
|
|
(let (found skip)
|
|
|
|
|
(while (and (setq skip (pop skips))
|
|
|
|
|
(not found))
|
|
|
|
|
(when (string-match commit (car skip))
|
|
|
|
|
(setq found (cdr skip))))
|
|
|
|
|
found))
|
|
|
|
|
|
2018-10-24 17:20:01 +00:00
|
|
|
|
(defvar change-log-start-entry-re) ; in add-log, which defines change-log-mode
|
|
|
|
|
(declare-function add-log-iso8601-time-string "add-log" ())
|
|
|
|
|
|
2014-11-27 17:22:00 +00:00
|
|
|
|
(defun gitmerge-resolve (file)
|
|
|
|
|
"Try to resolve conflicts in FILE with smerge.
|
|
|
|
|
Returns non-nil if conflicts remain."
|
|
|
|
|
(unless (file-exists-p file) (error "Gitmerge-resolve: Can't find %s" file))
|
|
|
|
|
(with-demoted-errors
|
|
|
|
|
(let ((exists (find-buffer-visiting file)))
|
|
|
|
|
(with-current-buffer (let ((enable-local-variables :safe)
|
|
|
|
|
(enable-local-eval nil))
|
|
|
|
|
(find-file-noselect file))
|
|
|
|
|
(if (buffer-modified-p)
|
|
|
|
|
(user-error "Unsaved changes in %s" (current-buffer)))
|
|
|
|
|
(save-excursion
|
|
|
|
|
(cond
|
|
|
|
|
((derived-mode-p 'change-log-mode)
|
|
|
|
|
;; Fix up dates before resolving the conflicts.
|
|
|
|
|
(goto-char (point-min))
|
2019-02-24 15:13:13 +00:00
|
|
|
|
(let ((diff-refine nil))
|
2014-11-27 17:22:00 +00:00
|
|
|
|
(while (re-search-forward smerge-begin-re nil t)
|
|
|
|
|
(smerge-match-conflict)
|
|
|
|
|
(smerge-ensure-match 3)
|
|
|
|
|
(let ((start1 (match-beginning 1))
|
|
|
|
|
(end1 (match-end 1))
|
|
|
|
|
(start3 (match-beginning 3))
|
|
|
|
|
(end3 (copy-marker (match-end 3) t)))
|
|
|
|
|
(goto-char start3)
|
|
|
|
|
(while (re-search-forward change-log-start-entry-re end3 t)
|
|
|
|
|
(let* ((str (match-string 0))
|
|
|
|
|
(newstr (save-match-data
|
|
|
|
|
(concat (add-log-iso8601-time-string)
|
|
|
|
|
(when (string-match " *\\'" str)
|
|
|
|
|
(match-string 0 str))))))
|
|
|
|
|
(replace-match newstr t t)))
|
|
|
|
|
;; change-log-resolve-conflict prefers to put match-1's
|
|
|
|
|
;; elements first (for equal dates), whereas we want to put
|
|
|
|
|
;; match-3's first.
|
|
|
|
|
(let ((match3 (buffer-substring start3 end3))
|
|
|
|
|
(match1 (buffer-substring start1 end1)))
|
|
|
|
|
(delete-region start3 end3)
|
|
|
|
|
(goto-char start3)
|
|
|
|
|
(insert match1)
|
|
|
|
|
(delete-region start1 end1)
|
|
|
|
|
(goto-char start1)
|
|
|
|
|
(insert match3)))))
|
|
|
|
|
;; (pop-to-buffer (current-buffer)) (debug 'before-resolve)
|
|
|
|
|
))
|
|
|
|
|
;; Try to resolve the conflicts.
|
2021-11-03 18:50:34 +00:00
|
|
|
|
(let ((coding-system-for-read vc-git-log-output-coding-system)
|
|
|
|
|
temp)
|
2017-12-02 03:06:40 +00:00
|
|
|
|
(cond
|
2018-10-24 17:20:01 +00:00
|
|
|
|
;; FIXME when merging release branch to master, we still
|
|
|
|
|
;; need to detect and handle the case where NEWS was modified
|
|
|
|
|
;; without a conflict. We should abort if NEWS gets changed.
|
2017-12-02 03:06:40 +00:00
|
|
|
|
((and (equal file "etc/NEWS")
|
|
|
|
|
(ignore-errors
|
|
|
|
|
(setq temp
|
|
|
|
|
(format "NEWS.%s"
|
|
|
|
|
(gitmerge-emacs-version gitmerge--from))))
|
|
|
|
|
(file-exists-p temp)
|
|
|
|
|
(or noninteractive
|
2017-12-13 02:58:38 +00:00
|
|
|
|
(y-or-n-p "Try to fix NEWS conflict? ")))
|
2017-12-02 03:06:40 +00:00
|
|
|
|
(let ((relfile (file-name-nondirectory file))
|
2018-10-24 17:20:01 +00:00
|
|
|
|
(patchfile (concat temp "-gitmerge.patch")))
|
|
|
|
|
(call-process "git" nil `(:file ,patchfile) nil "diff"
|
|
|
|
|
(format ":1:%s" file)
|
|
|
|
|
(format ":3:%s" file))
|
|
|
|
|
(if (eq 0 (call-process "patch" patchfile nil nil temp))
|
2017-12-02 03:06:40 +00:00
|
|
|
|
(progn
|
2018-10-24 17:20:01 +00:00
|
|
|
|
;; We intentionally use a non-temporary name for this
|
|
|
|
|
;; file, and only delete it if applied successfully.
|
|
|
|
|
(delete-file patchfile)
|
|
|
|
|
(call-process "git" nil t nil "add" "--" temp)
|
2017-12-02 03:06:40 +00:00
|
|
|
|
(call-process "git" nil t nil "reset" "--" relfile)
|
|
|
|
|
(call-process "git" nil t nil "checkout" "--" relfile)
|
2018-10-24 17:20:01 +00:00
|
|
|
|
(revert-buffer nil 'noconfirm))
|
|
|
|
|
;; The conflict markers remain so we return non-nil.
|
|
|
|
|
(message "Failed to fix NEWS conflict"))))
|
2017-12-02 03:06:40 +00:00
|
|
|
|
;; Generated files.
|
2020-07-29 22:15:15 +00:00
|
|
|
|
((member file '("lisp/ldefs-boot.el" "etc/AUTHORS"))
|
2017-12-02 03:06:40 +00:00
|
|
|
|
;; We are in the file's buffer, so names are relative.
|
|
|
|
|
(call-process "git" nil t nil "reset" "--"
|
|
|
|
|
(file-name-nondirectory file))
|
|
|
|
|
(call-process "git" nil t nil "checkout" "--"
|
|
|
|
|
(file-name-nondirectory file))
|
|
|
|
|
(revert-buffer nil 'noconfirm))
|
|
|
|
|
(t
|
|
|
|
|
(goto-char (point-max))
|
|
|
|
|
(while (re-search-backward smerge-begin-re nil t)
|
|
|
|
|
(save-excursion
|
|
|
|
|
(ignore-errors
|
|
|
|
|
(smerge-match-conflict)
|
|
|
|
|
(smerge-resolve))))
|
|
|
|
|
;; (when (derived-mode-p 'change-log-mode)
|
|
|
|
|
;; (pop-to-buffer (current-buffer)) (debug 'after-resolve))
|
|
|
|
|
(save-buffer))))
|
2014-11-27 17:22:00 +00:00
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(prog1 (re-search-forward smerge-begin-re nil t)
|
|
|
|
|
(unless exists (kill-buffer))))))))
|
|
|
|
|
|
|
|
|
|
(defun gitmerge-commit-message (beg end skip branch)
|
|
|
|
|
"Create commit message for merging BEG to END from BRANCH.
|
|
|
|
|
SKIP denotes whether those commits are actually skipped. If END
|
|
|
|
|
is nil, only the single commit BEG is merged."
|
|
|
|
|
(with-temp-buffer
|
2015-06-11 01:13:51 +00:00
|
|
|
|
;; We do not insert "; " for non-skipped messages,
|
|
|
|
|
;; because the date of those entries is helpful in figuring out
|
|
|
|
|
;; when things got merged, since git does not track that.
|
|
|
|
|
(insert (if skip "; " "")
|
2015-06-02 06:16:03 +00:00
|
|
|
|
"Merge from " branch "\n\n"
|
2014-11-27 17:22:00 +00:00
|
|
|
|
(if skip
|
|
|
|
|
(concat "The following commit"
|
|
|
|
|
(if end "s were " " was ")
|
|
|
|
|
"skipped:\n\n")
|
|
|
|
|
""))
|
2021-11-03 18:50:34 +00:00
|
|
|
|
(let ((coding-system-for-read vc-git-log-output-coding-system))
|
|
|
|
|
(apply #'call-process "git" nil t nil "log" "--oneline"
|
|
|
|
|
(if end (list (concat beg "~.." end))
|
|
|
|
|
`("-1" ,beg))))
|
2014-11-27 17:22:00 +00:00
|
|
|
|
(insert "\n")
|
2016-03-22 23:42:28 +00:00
|
|
|
|
;; Truncate to 72 chars so that the resulting ChangeLog line fits in 80.
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(while (re-search-forward "^\\(.\\{69\\}\\).\\{4,\\}" nil t)
|
|
|
|
|
(replace-match "\\1..."))
|
2014-11-27 17:22:00 +00:00
|
|
|
|
(buffer-string)))
|
|
|
|
|
|
|
|
|
|
(defun gitmerge-apply (missing from)
|
|
|
|
|
"Merge commits in MISSING from branch FROM.
|
|
|
|
|
MISSING must be a list of SHA1 strings."
|
|
|
|
|
(with-current-buffer (get-buffer-create gitmerge-output-buffer)
|
|
|
|
|
(erase-buffer)
|
|
|
|
|
(let* ((skip (cdar missing))
|
2021-11-03 18:50:34 +00:00
|
|
|
|
(coding-system-for-read vc-git-log-output-coding-system)
|
2014-11-27 17:22:00 +00:00
|
|
|
|
(beg (car (pop missing)))
|
2021-11-03 18:50:34 +00:00
|
|
|
|
end commitmessage commitmessage1 commitmessage-file status)
|
2014-11-27 17:22:00 +00:00
|
|
|
|
;; Determine last revision with same boolean skip status.
|
|
|
|
|
(while (and missing
|
|
|
|
|
(eq (null (cdar missing))
|
|
|
|
|
(null skip)))
|
|
|
|
|
(setq end (car (pop missing))))
|
|
|
|
|
(setq commitmessage
|
|
|
|
|
(gitmerge-commit-message beg end skip from))
|
|
|
|
|
(message "%s %s%s"
|
|
|
|
|
(if skip "Skipping" "Merging")
|
|
|
|
|
(substring beg 0 6)
|
|
|
|
|
(if end (concat ".." (substring end 0 6)) ""))
|
|
|
|
|
(unless end
|
|
|
|
|
(setq end beg))
|
2021-11-03 18:50:34 +00:00
|
|
|
|
(when (eq system-type 'windows-nt)
|
|
|
|
|
;; Command lines on MS-Windows cannot include newlines.
|
|
|
|
|
;; Since "git merge" doesn't accept a -F FILE option, we
|
|
|
|
|
;; commit the merge with a shortened single-line log message,
|
|
|
|
|
;; and then invoke "git commit --amend" with the full log
|
|
|
|
|
;; message from a temporary file.
|
|
|
|
|
(setq commitmessage1
|
|
|
|
|
;; Make sure the commit message is at most a single line.
|
|
|
|
|
(car (split-string commitmessage "[\f\n\r\v]+")))
|
|
|
|
|
(setq commitmessage-file (make-nearby-temp-file "gitmerge-msg"))
|
|
|
|
|
(let ((coding-system-for-write vc-git-commits-coding-system))
|
|
|
|
|
(write-region commitmessage nil commitmessage-file nil 'silent)))
|
|
|
|
|
(unless (setq status
|
|
|
|
|
(zerop
|
|
|
|
|
(apply #'call-process "git" nil t nil "merge" "--no-ff"
|
|
|
|
|
(append (when skip '("-s" "ours"))
|
|
|
|
|
(if commitmessage-file
|
|
|
|
|
`("-m" ,commitmessage1 ,end)
|
|
|
|
|
`("-m" ,commitmessage ,end))))))
|
2014-11-27 17:22:00 +00:00
|
|
|
|
(gitmerge-write-missing missing from)
|
2021-11-03 18:50:34 +00:00
|
|
|
|
(gitmerge-resolve-unmerged))
|
|
|
|
|
(when (and commitmessage-file (file-exists-p commitmessage-file))
|
|
|
|
|
(if status
|
|
|
|
|
(call-process "git" nil t nil
|
|
|
|
|
"commit" "--amend" "-F" commitmessage-file))
|
|
|
|
|
(delete-file commitmessage-file)))
|
2014-11-27 17:22:00 +00:00
|
|
|
|
missing))
|
|
|
|
|
|
|
|
|
|
(defun gitmerge-resolve-unmerged ()
|
|
|
|
|
"Resolve all files that are unmerged.
|
|
|
|
|
Throw an user-error if we cannot resolve automatically."
|
|
|
|
|
(with-current-buffer (get-buffer-create gitmerge-output-buffer)
|
|
|
|
|
(erase-buffer)
|
2021-11-03 18:50:34 +00:00
|
|
|
|
(let ((coding-system-for-read vc-git-log-output-coding-system)
|
|
|
|
|
files conflicted)
|
2014-11-27 17:22:00 +00:00
|
|
|
|
;; List unmerged files
|
|
|
|
|
(if (not (zerop
|
|
|
|
|
(call-process "git" nil t nil
|
|
|
|
|
"diff" "--name-only" "--diff-filter=U")))
|
2021-11-11 09:22:05 +00:00
|
|
|
|
(error "Error listing unmerged files. Resolve manually.")
|
2014-11-27 17:22:00 +00:00
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(while (not (eobp))
|
|
|
|
|
(push (buffer-substring (point) (line-end-position)) files)
|
2014-11-29 07:54:57 +00:00
|
|
|
|
(forward-line))
|
2014-11-27 17:22:00 +00:00
|
|
|
|
(dolist (file files)
|
|
|
|
|
(if (gitmerge-resolve file)
|
|
|
|
|
;; File still has conflicts
|
|
|
|
|
(setq conflicted t)
|
|
|
|
|
;; Mark as resolved
|
|
|
|
|
(call-process "git" nil t nil "add" file)))
|
2017-12-13 02:58:38 +00:00
|
|
|
|
(if (not conflicted)
|
|
|
|
|
(and files (not (gitmerge-commit))
|
|
|
|
|
(error "Error committing resolution - fix it manually"))
|
2014-11-27 17:22:00 +00:00
|
|
|
|
(with-current-buffer (get-buffer-create gitmerge-warning-buffer)
|
|
|
|
|
(erase-buffer)
|
|
|
|
|
(insert "For the following files, conflicts could\n"
|
|
|
|
|
"not be resolved automatically:\n\n")
|
2018-01-15 20:43:16 +00:00
|
|
|
|
(let ((conflicts
|
|
|
|
|
(with-temp-buffer
|
|
|
|
|
(call-process "git" nil t nil
|
|
|
|
|
"diff" "--name-only" "--diff-filter=U")
|
|
|
|
|
(buffer-string))))
|
|
|
|
|
(insert conflicts)
|
|
|
|
|
(if noninteractive (message "Conflicts in:\n%s" conflicts)))
|
2014-11-27 17:22:00 +00:00
|
|
|
|
(insert "\nResolve the conflicts manually, then run gitmerge again."
|
|
|
|
|
"\nNote:\n - You don't have to add resolved files or "
|
|
|
|
|
"commit the merge yourself (but you can)."
|
|
|
|
|
"\n - You can safely close this Emacs session and do this "
|
|
|
|
|
"in a new one."
|
|
|
|
|
"\n - When running gitmerge again, remember that you must "
|
2017-11-08 20:36:45 +00:00
|
|
|
|
"do that from within the Emacs repo.\n")
|
2014-11-27 17:22:00 +00:00
|
|
|
|
(pop-to-buffer (current-buffer)))
|
|
|
|
|
(user-error "Resolve the conflicts manually"))))))
|
|
|
|
|
|
|
|
|
|
(defun gitmerge-repo-clean ()
|
|
|
|
|
"Return non-nil if repository is clean."
|
|
|
|
|
(with-temp-buffer
|
2021-11-03 18:50:34 +00:00
|
|
|
|
(let ((coding-system-for-read vc-git-log-output-coding-system))
|
2014-11-27 17:22:00 +00:00
|
|
|
|
(call-process "git" nil t nil
|
|
|
|
|
"diff" "--staged" "--name-only")
|
|
|
|
|
(call-process "git" nil t nil
|
|
|
|
|
"diff" "--name-only")
|
2021-11-03 18:50:34 +00:00
|
|
|
|
(zerop (buffer-size)))))
|
2014-11-29 07:54:57 +00:00
|
|
|
|
|
2017-12-13 02:58:38 +00:00
|
|
|
|
(defun gitmerge-commit ()
|
|
|
|
|
"Commit, and return non-nil if it succeeds."
|
|
|
|
|
(with-current-buffer (get-buffer-create gitmerge-output-buffer)
|
2021-11-03 18:50:34 +00:00
|
|
|
|
(let ((coding-system-for-read vc-git-log-output-coding-system))
|
|
|
|
|
(erase-buffer)
|
|
|
|
|
(eq 0 (call-process "git" nil t nil "commit" "--no-edit")))))
|
2017-12-13 02:58:38 +00:00
|
|
|
|
|
2014-11-27 17:22:00 +00:00
|
|
|
|
(defun gitmerge-maybe-resume ()
|
|
|
|
|
"Check if we have to resume a merge.
|
|
|
|
|
If so, add no longer conflicted files and commit."
|
2018-06-12 00:41:07 +00:00
|
|
|
|
(let ((mergehead
|
|
|
|
|
(file-exists-p
|
|
|
|
|
(expand-file-name
|
|
|
|
|
"MERGE_HEAD"
|
|
|
|
|
(car (process-lines
|
|
|
|
|
"git" "rev-parse" "--no-flags" "--git-dir")))))
|
2014-11-27 17:22:00 +00:00
|
|
|
|
(statusexist (file-exists-p gitmerge-status-file)))
|
|
|
|
|
(when (and mergehead (not statusexist))
|
|
|
|
|
(user-error "Unfinished merge, but no record of a previous gitmerge run"))
|
|
|
|
|
(when (and (not mergehead)
|
|
|
|
|
(not (gitmerge-repo-clean)))
|
|
|
|
|
(user-error "Repository is not clean"))
|
|
|
|
|
(when statusexist
|
2017-12-19 00:38:25 +00:00
|
|
|
|
(if (or noninteractive (not (y-or-n-p "Resume merge? ")))
|
2014-11-27 17:22:00 +00:00
|
|
|
|
(progn
|
|
|
|
|
(delete-file gitmerge-status-file)
|
|
|
|
|
;; No resume.
|
|
|
|
|
nil)
|
|
|
|
|
(message "OK, resuming...")
|
|
|
|
|
(gitmerge-resolve-unmerged)
|
|
|
|
|
;; Commit the merge.
|
|
|
|
|
(when mergehead
|
2017-12-13 02:58:38 +00:00
|
|
|
|
(or (gitmerge-commit)
|
|
|
|
|
(error "Git error during merge - fix it manually")))
|
2014-11-29 07:54:57 +00:00
|
|
|
|
;; Successfully resumed.
|
2014-11-27 17:22:00 +00:00
|
|
|
|
t))))
|
|
|
|
|
|
|
|
|
|
(defun gitmerge-get-all-branches ()
|
|
|
|
|
"Return list of all branches, including remotes."
|
|
|
|
|
(with-temp-buffer
|
|
|
|
|
(unless (zerop (call-process "git" nil t nil
|
|
|
|
|
"branch" "-a"))
|
|
|
|
|
(error "Git error listing remote branches"))
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(let (branches branch)
|
|
|
|
|
(while (not (eobp))
|
|
|
|
|
(when (looking-at "^[^\\*]\\s-*\\(?:remotes/\\)?\\(.+\\)$")
|
|
|
|
|
(setq branch (match-string 1))
|
|
|
|
|
(unless (string-match gitmerge-ignore-branches-regexp branch)
|
|
|
|
|
(push branch branches)))
|
|
|
|
|
(forward-line))
|
|
|
|
|
(nreverse branches))))
|
|
|
|
|
|
|
|
|
|
(defun gitmerge-write-missing (missing from)
|
|
|
|
|
"Write list of commits MISSING into `gitmerge-status-file'.
|
|
|
|
|
Branch FROM will be prepended to the list."
|
|
|
|
|
(with-current-buffer
|
|
|
|
|
(find-file-noselect gitmerge-status-file)
|
|
|
|
|
(erase-buffer)
|
|
|
|
|
(insert
|
|
|
|
|
(prin1-to-string (append (list from) missing))
|
|
|
|
|
"\n")
|
|
|
|
|
(save-buffer)
|
|
|
|
|
(kill-buffer)))
|
|
|
|
|
|
|
|
|
|
(defun gitmerge-read-missing ()
|
|
|
|
|
"Read list of missing commits from `gitmerge-status-file'."
|
|
|
|
|
(with-current-buffer
|
|
|
|
|
(find-file-noselect gitmerge-status-file)
|
|
|
|
|
(unless (zerop (buffer-size))
|
|
|
|
|
(prog1 (read (buffer-string))
|
|
|
|
|
(kill-buffer)))))
|
|
|
|
|
|
2014-12-05 20:20:02 +00:00
|
|
|
|
(define-derived-mode gitmerge-mode special-mode "gitmerge"
|
2014-11-27 17:22:00 +00:00
|
|
|
|
"Major mode for Emacs branch merging."
|
|
|
|
|
(set-syntax-table text-mode-syntax-table)
|
|
|
|
|
(setq buffer-read-only t)
|
2014-12-05 20:20:02 +00:00
|
|
|
|
(setq-local truncate-lines t)
|
|
|
|
|
(setq-local font-lock-defaults '(gitmerge-mode-font-lock-keywords)))
|
2014-11-27 17:22:00 +00:00
|
|
|
|
|
|
|
|
|
(defun gitmerge (from)
|
|
|
|
|
"Merge from branch FROM into `default-directory'."
|
|
|
|
|
(interactive
|
|
|
|
|
(if (not (vc-git-root default-directory))
|
|
|
|
|
(user-error "Not in a git tree")
|
|
|
|
|
(let ((default-directory (vc-git-root default-directory)))
|
|
|
|
|
(list
|
|
|
|
|
(if (gitmerge-maybe-resume)
|
|
|
|
|
'resume
|
2017-12-19 00:38:25 +00:00
|
|
|
|
(if noninteractive
|
|
|
|
|
(or (pop command-line-args-left)
|
|
|
|
|
(gitmerge-default-branch))
|
|
|
|
|
(completing-read "Merge branch: "
|
|
|
|
|
(gitmerge-get-all-branches)
|
|
|
|
|
nil t (gitmerge-default-branch))))))))
|
2014-11-27 17:22:00 +00:00
|
|
|
|
(let ((default-directory (vc-git-root default-directory)))
|
|
|
|
|
(if (eq from 'resume)
|
|
|
|
|
(progn
|
|
|
|
|
(setq gitmerge--commits (gitmerge-read-missing))
|
|
|
|
|
(setq gitmerge--from (pop gitmerge--commits))
|
|
|
|
|
;; Directly continue with the merge.
|
|
|
|
|
(gitmerge-start-merge))
|
|
|
|
|
(setq gitmerge--commits (gitmerge-missing from))
|
|
|
|
|
(setq gitmerge--from from)
|
|
|
|
|
(when (null gitmerge--commits)
|
|
|
|
|
(user-error "Nothing to merge"))
|
2017-12-19 00:56:21 +00:00
|
|
|
|
(and noninteractive
|
|
|
|
|
gitmerge-minimum-missing
|
|
|
|
|
(< (length gitmerge--commits) gitmerge-minimum-missing)
|
|
|
|
|
(user-error "Number of missing commits (%s) is less than %s"
|
|
|
|
|
(length gitmerge--commits)
|
|
|
|
|
gitmerge-minimum-missing))
|
2014-11-27 17:22:00 +00:00
|
|
|
|
(with-current-buffer
|
|
|
|
|
(gitmerge-setup-log-buffer gitmerge--commits gitmerge--from)
|
|
|
|
|
(goto-char (point-min))
|
2022-09-21 08:11:15 +00:00
|
|
|
|
(insert (substitute-command-keys
|
|
|
|
|
(concat
|
|
|
|
|
(propertize "Commands: " 'font-lock-face 'bold)
|
|
|
|
|
"\\<gitmerge-mode-map>"
|
|
|
|
|
"(\\[gitmerge-toggle-skip]) Toggle skip, "
|
|
|
|
|
"(\\[gitmerge-show-log]) Show log, "
|
|
|
|
|
"(\\[gitmerge-show-diff]) Show diff, "
|
|
|
|
|
"(\\[gitmerge-show-files]) Show files, "
|
|
|
|
|
"(\\[gitmerge-start-merge]) Start merge\n"
|
|
|
|
|
(propertize "Flags: " 'font-lock-face 'bold)
|
|
|
|
|
"(C) Detected backport (cherry-mark), (R) Matches skip "
|
|
|
|
|
"regexp, (M) Manually picked\n\n")))
|
2014-11-27 17:22:00 +00:00
|
|
|
|
(gitmerge-mode)
|
2017-12-19 00:38:25 +00:00
|
|
|
|
(pop-to-buffer (current-buffer))
|
|
|
|
|
(if noninteractive (gitmerge-start-merge))))))
|
2014-11-27 17:22:00 +00:00
|
|
|
|
|
|
|
|
|
(defun gitmerge-start-merge ()
|
|
|
|
|
(interactive)
|
|
|
|
|
(when (not (vc-git-root default-directory))
|
|
|
|
|
(user-error "Not in a git tree"))
|
|
|
|
|
(let ((default-directory (vc-git-root default-directory)))
|
|
|
|
|
(while gitmerge--commits
|
|
|
|
|
(setq gitmerge--commits
|
|
|
|
|
(gitmerge-apply gitmerge--commits gitmerge--from)))
|
|
|
|
|
(when (file-exists-p gitmerge-status-file)
|
|
|
|
|
(delete-file gitmerge-status-file))
|
|
|
|
|
(message "Merging from %s...done" gitmerge--from)))
|
|
|
|
|
|
|
|
|
|
(provide 'gitmerge)
|
|
|
|
|
|
|
|
|
|
;;; gitmerge.el ends here
|