X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/99a33b77e15b9a075024701d060d912b2fd87caf..refs/heads/wip:/admin/bzrmerge.el

diff --git a/admin/bzrmerge.el b/admin/bzrmerge.el
index 583f0d8886..924033b155 100644
--- a/admin/bzrmerge.el
+++ b/admin/bzrmerge.el
@@ -1,9 +1,9 @@
 ;;; 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
@@ -24,11 +24,11 @@
 
 ;;; 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.")
 
@@ -45,17 +45,24 @@ The list returned is sorted by oldest-first."
     (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
@@ -133,9 +140,23 @@ are both lists of revnos, in oldest-first order."
                     (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)))
@@ -146,10 +167,11 @@ are both lists of revnos, in oldest-first order."
   (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)
@@ -241,17 +263,17 @@ Does not make other difference."
           ;; 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
@@ -298,10 +320,10 @@ Does not make other difference."
                   ;; 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)