1 ;;; bzrmerge.el --- help merge one Emacs bzr branch to another
3 ;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
5 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
8 ;; GNU Emacs is free software: you can redistribute it and/or modify
9 ;; it under the terms of the GNU General Public License as published by
10 ;; the Free Software Foundation, either version 3 of the License, or
11 ;; (at your option) any later version.
13 ;; GNU Emacs is distributed in the hope that it will be useful,
14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 ;; GNU General Public License for more details.
18 ;; You should have received a copy of the GNU General Public License
19 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23 ;; Some usage notes are in admin/notes/bzr.
27 (eval-when-compile (require 'cl-lib))
29 (defvar bzrmerge-skip-regexp
30 "back[- ]?port\\|merge\\|sync\\|re-?generate\\|bump version\\|from trunk\\|\
32 "Regexp matching logs of revisions that might be skipped.
33 `bzrmerge-missing' will ask you if it should skip any matches.")
35 (defconst bzrmerge-buffer "*bzrmerge*"
36 "Working buffer for bzrmerge.")
38 (defconst bzrmerge-warning-buffer "*bzrmerge warnings*"
39 "Buffer where bzrmerge will display any warnings.")
41 (defun bzrmerge-merges ()
42 "Return the list of already merged (not yet committed) revisions.
43 The list returned is sorted by oldest-first."
44 (with-current-buffer (get-buffer-create bzrmerge-buffer)
46 ;; We generally want to make sure we start with a clean tree, but we also
47 ;; want to allow restarts (i.e. with some part of FROM already merged but
48 ;; not yet committed). Unversioned (unknown) files in the tree
50 (call-process "bzr" nil t nil "status" "-v")
51 (goto-char (point-min))
52 (when (re-search-forward "^conflicts:\n" nil t)
53 (user-error "You still have unresolved conflicts"))
56 (if (not (re-search-forward "^pending merges:\n" nil t))
58 (goto-char (point-min))
60 (re-search-forward "^\\([a-z ]*\\):\n" nil t)
63 (not (equal "unknown" (match-string 1)))))))
65 (user-error "You still have uncommitted changes"))
66 ;; This is really stupid, but it seems there's no easy way to figure
67 ;; out which revisions have been merged already. The only info I can
68 ;; find is the "pending merges" from "bzr status -v", which is not
69 ;; very machine-friendly.
71 (skip-chars-forward " ")
72 (push (buffer-substring (point) (line-end-position)) merges)
76 (defun bzrmerge-check-match (merge)
77 ;; Make sure the MERGES match the revisions on the FROM branch.
78 ;; Stupidly the best form of MERGES I can find is the one from
79 ;; "bzr status -v" which is very machine non-friendly, so I have
80 ;; to do some fuzzy matching.
84 (if (re-search-forward "^author: *\\([^<]*[^ ]\\) +<.*"
88 (if (re-search-forward
89 "^committer: *\\([^<]*[^< ]\\) +<" nil t)
93 (if (re-search-forward
94 "^timestamp:[^0-9]*\\([-0-9]+\\)" nil t)
98 (if (re-search-forward "^message:[ \n]*" nil t)
99 (buffer-substring (point) (line-end-position))))))
100 ;; The `merge' may have a truncated line1 with "...", so get
101 ;; rid of any "..." and then look for a prefix match.
102 (when (string-match "\\.+\\'" merge)
103 (setq merge (substring merge 0 (match-beginning 0))))
105 merge (concat author " " timestamp " " line1))
107 merge (concat author " " timestamp " [merge] " line1)))))
109 (defun bzrmerge-missing (from merges)
110 "Return the list of revisions that need to be merged.
111 MERGES is the revisions already merged but not yet committed.
112 Asks about skipping revisions with logs matching `bzrmerge-skip-regexp'.
113 The result is of the form (TOMERGE . TOSKIP) where TOMERGE and TOSKIP
114 are both lists of revnos, in oldest-first order."
115 (with-current-buffer (get-buffer-create bzrmerge-buffer)
117 (call-process "bzr" nil t nil "missing" "--theirs-only"
118 (expand-file-name from))
119 (let ((revnos ()) (skipped ()))
120 (pop-to-buffer (current-buffer))
121 (goto-char (point-max))
122 (while (re-search-backward "^------------------------------------------------------------\nrevno: \\([0-9.]+\\).*" nil t)
125 (while (not (bzrmerge-check-match (pop merges)))
127 (error "Unmatched tip of merged revisions")))
128 (let ((case-fold-search t)
129 (revno (match-string 1))
131 (if (string-match "\\." revno)
132 (error "Unexpected dotted revno!")
133 (setq revno (string-to-number revno)))
134 (re-search-forward "^message:\n")
135 (while (and (not skip)
136 (re-search-forward bzrmerge-skip-regexp nil t))
137 (let ((str (buffer-substring (line-beginning-position)
138 (line-end-position))))
139 (when (string-match "\\` *" str)
140 (setq str (substring str (match-end 0))))
141 (when (string-match "[.!;, ]+\\'" str)
142 (setq str (substring str 0 (match-beginning 0))))
144 Type `y' to skip this revision,
145 `N' to include it and go on to the next revision,
146 `n' to not skip, but continue to search this log entry for skip regexps,
147 `q' to quit merging."))
148 (pcase (save-excursion
150 (format "%s: Skip (y/n/N/q/%s)? " str
151 (key-description (vector help-char)))
154 (`?q (keyboard-quit))
155 ;; A single log entry can match skip-regexp multiple
156 ;; times. If you are sure you don't want to skip it,
157 ;; you don't want to be asked multiple times.
158 (`?N (setq skip 'no))))))
161 (push revno revnos)))))
162 (delete-region (point) (point-max)))
163 (and (or revnos skipped)
164 (cons (nreverse revnos) (nreverse skipped))))))
166 (defun bzrmerge-resolve (file)
167 (unless (file-exists-p file) (error "Bzrmerge-resolve: Can't find %s" file))
169 (let ((exists (find-buffer-visiting file)))
170 (with-current-buffer (let ((enable-local-variables :safe)
171 (enable-local-eval nil))
172 (find-file-noselect file))
173 (if (buffer-modified-p)
174 (user-error "Unsaved changes in %s" (current-buffer)))
177 ((derived-mode-p 'change-log-mode)
178 ;; Fix up dates before resolving the conflicts.
179 (goto-char (point-min))
180 (let ((diff-auto-refine-mode nil))
181 (while (re-search-forward smerge-begin-re nil t)
182 (smerge-match-conflict)
183 (smerge-ensure-match 3)
184 (let ((start1 (match-beginning 1))
186 (start3 (match-beginning 3))
187 (end3 (copy-marker (match-end 3) t)))
189 (while (re-search-forward change-log-start-entry-re end3 t)
190 (let* ((str (match-string 0))
191 (newstr (save-match-data
192 (concat (add-log-iso8601-time-string)
193 (when (string-match " *\\'" str)
194 (match-string 0 str))))))
195 (replace-match newstr t t)))
196 ;; change-log-resolve-conflict prefers to put match-1's
197 ;; elements first (for equal dates), whereas we want to put
199 (let ((match3 (buffer-substring start3 end3))
200 (match1 (buffer-substring start1 end1)))
201 (delete-region start3 end3)
204 (delete-region start1 end1)
207 ;; (pop-to-buffer (current-buffer)) (debug 'before-resolve)
209 ;; Try to resolve the conflicts.
211 ((member file '("configure" "lisp/ldefs-boot.el"
212 "lisp/emacs-lisp/cl-loaddefs.el"))
213 ;; We are in the file's buffer, so names are relative.
214 (call-process "bzr" nil t nil "revert"
215 (file-name-nondirectory file))
216 (revert-buffer nil 'noconfirm))
218 (goto-char (point-max))
219 (while (re-search-backward smerge-begin-re nil t)
222 (smerge-match-conflict)
224 ;; (when (derived-mode-p 'change-log-mode)
225 ;; (pop-to-buffer (current-buffer)) (debug 'after-resolve))
227 (goto-char (point-min))
228 (prog1 (re-search-forward smerge-begin-re nil t)
229 (unless exists (kill-buffer))))))))
231 (defun bzrmerge-add-metadata (from endrevno)
232 "Add the metadata for a merge of FROM upto ENDREVNO.
233 Does not make other difference."
234 (if (with-temp-buffer
235 (call-process "bzr" nil t nil "status")
236 (goto-char (point-min))
237 (re-search-forward "^conflicts:\n" nil t))
238 (error "Don't know how to add metadata in the presence of conflicts")
239 (call-process "bzr" nil t nil "shelve" "--all"
240 "-m" "Bzrmerge shelved merge during skipping")
241 (call-process "bzr" nil t nil "revert")
242 (call-process "bzr" nil t nil
243 "merge" "-r" (format "%s" endrevno) from)
244 (call-process "bzr" nil t nil "revert" ".")
245 (call-process "bzr" nil t nil "unshelve")))
247 (defvar bzrmerge-already-done nil)
249 (defun bzrmerge-apply (missing from)
250 (setq from (expand-file-name from))
251 (with-current-buffer (get-buffer-create bzrmerge-buffer)
253 (when (equal (cdr bzrmerge-already-done) (list from missing))
254 (setq missing (car bzrmerge-already-done)))
255 (setq bzrmerge-already-done nil)
256 (let ((merge (car missing))
260 (when (or merge skip)
262 ((and skip (or (null merge) (< (car skip) (car merge))))
263 ;; Do a "skip" (i.e. merge the meta-data only).
264 (setq beg (1- (car skip)))
265 (while (and skip (or (null merge) (< (car skip) (car merge))))
266 (cl-assert (> (car skip) (or end beg)))
267 (setq end (pop skip)))
268 (message "Skipping %s..%s" beg end)
269 (bzrmerge-add-metadata from end))
272 ;; Do a "normal" merge.
273 (cl-assert (or (null skip) (< (car merge) (car skip))))
274 (setq beg (1- (car merge)))
275 (while (and merge (or (null skip) (< (car merge) (car skip))))
276 (cl-assert (> (car merge) (or end beg)))
277 (setq end (pop merge)))
278 (message "Merging %s..%s" beg end)
279 (if (with-temp-buffer
280 (call-process "bzr" nil t nil "status")
281 (zerop (buffer-size)))
282 (call-process "bzr" nil t nil
283 "merge" "-r" (format "%s" end) from)
284 ;; Stupidly, "bzr merge --force -r A..B" dos not maintain the
285 ;; metadata properly except when the checkout is clean.
286 (call-process "bzr" nil t nil "merge"
287 "--force" "-r" (format "%s..%s" beg end) from)
288 ;; The merge did not update the metadata, so force the next time
289 ;; around to update it (as a "skip").
292 (pop-to-buffer (current-buffer))
294 ;; (debug 'after-merge)
295 ;; Check the conflicts.
296 ;; FIXME if using the helpful bzr changelog_merge plugin,
297 ;; there are normally no conflicts in ChangeLogs.
298 ;; But we still want the dates fixing, like bzrmerge-resolve does.
299 (let ((conflicted nil)
301 (goto-char (point-min))
302 (when (re-search-forward "bzr: ERROR:" nil t)
303 (error "Internal Bazaar error!!"))
304 (while (re-search-forward "^Text conflict in " nil t)
305 (push (buffer-substring (point) (line-end-position)) files))
306 (if (re-search-forward "^\\([0-9]+\\) conflicts encountered" nil t)
307 (if (/= (length files) (string-to-number (match-string 1)))
309 (if files (setq conflicted t)))
311 (if (bzrmerge-resolve file)
312 (setq conflicted t)))
314 (setq bzrmerge-already-done
315 (list (cons merge skip) from missing))
317 ;; FIXME: Obviously, we'd rather make it right rather
318 ;; than output such a warning. But I don't know how to add
319 ;; the metadata to bzr's since the technique used in
320 ;; bzrmerge-add-metadata does not work when there
322 (display-warning 'bzrmerge "Resolve conflicts manually.
323 BEWARE! Important metadata is kept in this Emacs session!
324 Do not commit without re-running `M-x bzrmerge' first!"
325 :warning bzrmerge-warning-buffer))
326 (user-error "Resolve conflicts manually")))))
327 (cons merge skip)))))
329 (defun bzrmerge (from)
330 "Merge from branch FROM into `default-directory'."
335 (call-process "bzr" nil t nil "info")
336 (goto-char (point-min))
337 (when (re-search-forward "submit branch: *" nil t)
338 (buffer-substring (point) (line-end-position))))))
339 (read-file-name "From branch: " nil nil nil def))))
340 ;; Eg we ran bzrmerge once, it stopped with conflicts, we fixed them
341 ;; and are running it again.
342 (if (get-buffer bzrmerge-warning-buffer)
343 (kill-buffer bzrmerge-warning-buffer))
344 (message "Merging from %s..." from)
346 (let ((default-directory (or (vc-bzr-root default-directory)
347 (error "Not in a Bzr tree"))))
348 ;; First, check the status.
349 (let* ((merges (bzrmerge-merges))
350 ;; OK, we have the status, now check the missing data.
351 (missing (bzrmerge-missing from merges)))
353 (message "Merging from %s...nothing to merge" from)
355 (setq missing (bzrmerge-apply missing from)))
356 (message "Merging from %s...done" from)))))
359 ;;; bzrmerge.el ends here