-;;; bzrmerge.el ---
+;;; bzrmerge.el --- help merge one Emacs bzr branch to another
-;; Copyright (C) 2010 Stefan Monnier
+;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
-;; Keywords:
+;; Keywords: maint
-;; This program is free software; you can redistribute it and/or modify
+;; 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.
-;; This program is distributed in the hope that it will be useful,
+;; 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
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
-;;
+;; Some usage notes are in admin/notes/bzr.
;;; Code:
+(eval-when-compile
+ (require 'cl)) ; assert
+
+(defvar bzrmerge-skip-regexp
+ "back[- ]?port\\|merge\\|sync\\|re-?generate\\|bump version\\|from trunk"
+ "Regexp matching logs of revisions that might be skipped.
+`bzrmerge-missing' will ask you if it should skip any matches.")
+
+(defconst bzrmerge-buffer "*bzrmerge*"
+ "Working buffer for bzrmerge.")
+
+(defconst bzrmerge-warning-buffer "*bzrmerge warnings*"
+ "Buffer where bzrmerge will display any warnings.")
+
(defun bzrmerge-merges ()
- "Return the list of already merged (not not committed) revisions.
+ "Return the list of already merged (not yet committed) revisions.
The list returned is sorted by oldest-first."
- (with-current-buffer (get-buffer-create "*bzrmerge*")
+ (with-current-buffer (get-buffer-create bzrmerge-buffer)
(erase-buffer)
;; We generally want to make sure we start with a clean tree, but we also
;; want to allow restarts (i.e. with some part of FROM already merged but
(defun bzrmerge-missing (from merges)
"Return the list of revisions that need to be merged.
MERGES is the revisions already merged but not yet committed.
+Asks about skipping revisions with logs matching `bzrmerge-skip-regexp'.
The result is of the form (TOMERGE . TOSKIP) where TOMERGE and TOSKIP
are both lists of revnos, in oldest-first order."
- (with-current-buffer (get-buffer-create "*bzrmerge*")
+ (with-current-buffer (get-buffer-create bzrmerge-buffer)
(erase-buffer)
(call-process "bzr" nil t nil "missing" "--theirs-only"
(expand-file-name from))
(setq revno (string-to-number revno)))
(re-search-forward "^message:\n")
(while (and (not skip)
- (re-search-forward
- "back[- ]?port\\|merge\\|re-?generate\\|bump version" nil t))
+ (re-search-forward bzrmerge-skip-regexp nil t))
(let ((str (buffer-substring (line-beginning-position)
(line-end-position))))
(when (string-match "\\` *" str)
(setq str (substring str (match-end 0))))
(when (string-match "[.!;, ]+\\'" str)
(setq str (substring str 0 (match-beginning 0))))
- (if (save-excursion (y-or-n-p (concat str ": Skip? ")))
- (setq skip t))))
- (if skip
+ (let ((help-form "\
+Type `y' to skip this revision,
+`N' to include it and go on to the next revision,
+`n' to not skip, but continue to search this log entry for skip regexps,
+`q' to quit merging."))
+ (case (save-excursion
+ (read-char-choice
+ (format "%s: Skip (y/n/N/q/%s)? " str
+ (key-description (vector help-char)))
+ '(?y ?n ?N ?q)))
+ (?y (setq skip t))
+ (?q (keyboard-quit))
+ ;; A single log entry can match skip-regexp multiple
+ ;; times. If you are sure you don't want to skip it,
+ ;; you don't want to be asked multiple times.
+ (?N (setq skip 'no))))))
+ (if (eq skip t)
(push revno skipped)
(push revno revnos)))))
(delete-region (point) (point-max)))
- (cons (nreverse revnos) (nreverse skipped)))))
+ (and (or revnos skipped)
+ (cons (nreverse revnos) (nreverse skipped))))))
(defun bzrmerge-resolve (file)
(unless (file-exists-p file) (error "Bzrmerge-resolve: Can't find %s" file))
(with-demoted-errors
(let ((exists (find-buffer-visiting file)))
- (with-current-buffer (find-file-noselect file)
+ (with-current-buffer (let ((enable-local-variables :safe))
+ (find-file-noselect file))
(if (buffer-modified-p)
(error "Unsaved changes in %s" (current-buffer)))
(save-excursion
))
;; Try to resolve the conflicts.
(cond
- ((member file '("configure" "lisp/ldefs-boot.el"))
- (call-process "bzr" nil t nil "revert" file)
+ ((member file '("configure" "lisp/ldefs-boot.el"
+ "lisp/emacs-lisp/cl-loaddefs.el"))
+ ;; We are in the file's buffer, so names are relative.
+ (call-process "bzr" nil t nil "revert"
+ (file-name-nondirectory file))
(revert-buffer nil 'noconfirm))
(t
(goto-char (point-max))
"merge" "-r" (format "%s" endrevno) from)
(call-process "bzr" nil t nil "revert" ".")
(call-process "bzr" nil t nil "unshelve")))
-
+
(defvar bzrmerge-already-done nil)
(defun bzrmerge-apply (missing from)
(setq from (expand-file-name from))
- (with-current-buffer (get-buffer-create "*bzrmerge*")
+ (with-current-buffer (get-buffer-create bzrmerge-buffer)
(erase-buffer)
(when (equal (cdr bzrmerge-already-done) (list from missing))
(setq missing (car bzrmerge-already-done)))
(setq bzrmerge-already-done nil)
(let ((merge (car missing))
(skip (cdr missing))
+ (unsafe nil)
beg end)
(when (or merge skip)
(cond
"--force" "-r" (format "%s..%s" beg end) from)
;; The merge did not update the metadata, so force the next time
;; around to update it (as a "skip").
+ (setq unsafe t)
(push end skip))
(pop-to-buffer (current-buffer))
(sit-for 1)
;; (debug 'after-merge)
;; Check the conflicts.
+ ;; FIXME if using the helpful bzr changelog_merge plugin,
+ ;; there are normally no conflicts in ChangeLogs.
+ ;; But we still want the dates fixing, like bzrmerge-resolve does.
(let ((conflicted nil)
(files ()))
(goto-char (point-min))
(when conflicted
(setq bzrmerge-already-done
(list (cons merge skip) from missing))
+ (if unsafe
+ ;; FIXME: Obviously, we'd rather make it right rather
+ ;; than output such a warning. But I don't know how to add
+ ;; the metadata to bzr's since the technique used in
+ ;; bzrmerge-add-metadata does not work when there
+ ;; are conflicts.
+ (display-warning 'bzrmerge "Resolve conflicts manually.
+¡BEWARE! Important metadata is kept in this Emacs session!
+Do not commit without re-running `M-x bzrmerge' first!"
+ :warning bzrmerge-warning-buffer))
(error "Resolve conflicts manually")))))
(cons merge skip)))))
(when (re-search-forward "submit branch: *" nil t)
(buffer-substring (point) (line-end-position))))))
(read-file-name "From branch: " nil nil nil def))))
+ ;; Eg we ran bzrmerge once, it stopped with conflicts, we fixed them
+ ;; and are running it again.
+ (if (get-buffer bzrmerge-warning-buffer)
+ (kill-buffer bzrmerge-warning-buffer))
(message "Merging from %s..." from)
(require 'vc-bzr)
(let ((default-directory (or (vc-bzr-root default-directory)
(let* ((merges (bzrmerge-merges))
;; OK, we have the status, now check the missing data.
(missing (bzrmerge-missing from merges)))
- (while missing
- (setq missing (bzrmerge-apply missing from))))))
+ (if (not missing)
+ (message "Merging from %s...nothing to merge" from)
+ (while missing
+ (setq missing (bzrmerge-apply missing from)))
+ (message "Merging from %s...done" from)))))
(provide 'bzrmerge)
;;; bzrmerge.el ends here
HCoop / bpt / emacs.git / blobdiff