;;; bzrmerge.el --- help merge one Emacs bzr branch to another
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
-;; Keywords:
+;; Keywords: maint
;; 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
;;; Code:
-(eval-when-compile
- (require 'cl)) ; assert
+(eval-when-compile (require 'cl-lib))
(defvar bzrmerge-skip-regexp
- "back[- ]?port\\|merge\\|sync\\|re-?generate\\|bump version"
+ "back[- ]?port\\|merge\\|sync\\|re-?generate\\|bump version\\|from trunk\\|\
+Auto-commit"
"Regexp matching logs of revisions that might be skipped.
`bzrmerge-missing' will ask you if it should skip any matches.")
(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
- ;; not yet committed).
+ ;; not yet committed). Unversioned (unknown) files in the tree
+ ;; are also ok.
(call-process "bzr" nil t nil "status" "-v")
(goto-char (point-min))
(when (re-search-forward "^conflicts:\n" nil t)
- (error "You still have unresolved conflicts"))
- (let ((merges ()))
+ (user-error "You still have unresolved conflicts"))
+ (let ((merges ())
+ found)
(if (not (re-search-forward "^pending merges:\n" nil t))
(when (save-excursion
(goto-char (point-min))
- (re-search-forward "^[a-z ]*:\n" nil t))
- (error "You still have uncommitted changes"))
+ (while (and
+ (re-search-forward "^\\([a-z ]*\\):\n" nil t)
+ (not
+ (setq found
+ (not (equal "unknown" (match-string 1)))))))
+ found)
+ (user-error "You still have uncommitted changes"))
;; This is really stupid, but it seems there's no easy way to figure
;; out which revisions have been merged already. The only info I can
;; find is the "pending merges" from "bzr status -v", which is not
(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."))
+ (pcase (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)))
(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 (let ((enable-local-variables :safe))
+ (with-current-buffer (let ((enable-local-variables :safe)
+ (enable-local-eval nil))
(find-file-noselect file))
(if (buffer-modified-p)
- (error "Unsaved changes in %s" (current-buffer)))
+ (user-error "Unsaved changes in %s" (current-buffer)))
(save-excursion
(cond
((derived-mode-p 'change-log-mode)
;; Do a "skip" (i.e. merge the meta-data only).
(setq beg (1- (car skip)))
(while (and skip (or (null merge) (< (car skip) (car merge))))
- (assert (> (car skip) (or end beg)))
+ (cl-assert (> (car skip) (or end beg)))
(setq end (pop skip)))
(message "Skipping %s..%s" beg end)
(bzrmerge-add-metadata from end))
(t
;; Do a "normal" merge.
- (assert (or (null skip) (< (car merge) (car skip))))
+ (cl-assert (or (null skip) (< (car merge) (car skip))))
(setq beg (1- (car merge)))
(while (and merge (or (null skip) (< (car merge) (car skip))))
- (assert (> (car merge) (or end beg)))
+ (cl-assert (> (car merge) (or end beg)))
(setq end (pop merge)))
(message "Merging %s..%s" beg end)
(if (with-temp-buffer
;; 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!
+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")))))
+ (user-error "Resolve conflicts manually")))))
(cons merge skip)))))
(defun bzrmerge (from)
HCoop / bpt / emacs.git / blobdiff