From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Stefan Monnier Newsgroups: gmane.emacs.devel Subject: Merging emacs-23 into trunk Date: Tue, 09 Nov 2010 16:30:10 -0500 Message-ID: NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: dough.gmane.org 1289338234 26915 80.91.229.12 (9 Nov 2010 21:30:34 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Tue, 9 Nov 2010 21:30:34 +0000 (UTC) To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Tue Nov 09 22:30:30 2010 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1PFvlm-0006eg-My for ged-emacs-devel@m.gmane.org; Tue, 09 Nov 2010 22:30:23 +0100 Original-Received: from localhost ([127.0.0.1]:54965 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1PFvll-0008JS-5B for ged-emacs-devel@m.gmane.org; Tue, 09 Nov 2010 16:30:21 -0500 Original-Received: from [140.186.70.92] (port=34142 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1PFvle-0008JL-VX for emacs-devel@gnu.org; Tue, 09 Nov 2010 16:30:16 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1PFvld-0003ta-U0 for emacs-devel@gnu.org; Tue, 09 Nov 2010 16:30:14 -0500 Original-Received: from pruche.dit.umontreal.ca ([132.204.246.22]:59663) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1PFvld-0003t5-G0 for emacs-devel@gnu.org; Tue, 09 Nov 2010 16:30:13 -0500 Original-Received: from faina.iro.umontreal.ca (lechon.iro.umontreal.ca [132.204.27.242]) by pruche.dit.umontreal.ca (8.14.1/8.14.1) with ESMTP id oA9LUBnY014226; Tue, 9 Nov 2010 16:30:11 -0500 Original-Received: by faina.iro.umontreal.ca (Postfix, from userid 20848) id B1B49B422A; Tue, 9 Nov 2010 16:30:10 -0500 (EST) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.0.50 (gnu/linux) X-NAI-Spam-Score: 0 X-NAI-Spam-Rules: 1 Rules triggered RV3674=0 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 3) X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:132484 Archived-At: --=-=-= Content-Type: text/plain FWIW, here's the code I've used to merge the emacs-23 branch into the trunk. It presumes that the commits I don't want to include have the keyword "backport" or "merge" in it, so please make sure you include such keywords in your "not to be merged" commits in the future. It's pretty rough, and is scaringly slow (to some extent because of bzr's braindead lack of support for merging into a tree that's not clean). But that merge seemed like a good opportunity, since it had many backports and a naive merge generated tons of conflicts (a large part of them due to "bump version"). BTW, thanks Chong for committing the "bump version" separately from any real change, so I could just skip that patch rather than try and come up with some clever way to recognize and auto-resolve the resulting conflicts. Stefan --=-=-= Content-Type: application/emacs-lisp Content-Disposition: attachment; filename=bzrmerge.el Content-Transfer-Encoding: quoted-printable ;;; bzrmerge.el ---=20 ;; Copyright (C) 2010 Stefan Monnier ;; Author: Stefan Monnier ;; Keywords:=20 ;; This program 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, ;; 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 . ;;; Commentary: ;;=20 ;;; Code: (defun bzrmerge-merges () "Return the list of already merged (not not committed) revisions. The list returned is sorted by oldest-first." (with-current-buffer (get-buffer-create "*bzrmerge*") (erase-buffer) ;; We generally want to make sure we start with a clean tree, but we al= so ;; want to allow restarts (i.e. with some part of FROM already merged b= ut ;; not yet committed). (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 ())) (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")) ;; 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 c= an ;; find is the "pending merges" from "bzr status -v", which is not ;; very machine-friendly. (while (not (eobp)) (skip-chars-forward " ") (push (buffer-substring (point) (line-end-position)) merges) (forward-line 1))) merges))) (defun bzrmerge-check-match (merge) ;; Make sure the MERGES match the revisions on the FROM branch. ;; Stupidly the best form of MERGES I can find is the one from ;; "bzr status -v" which is very machine non-friendly, so I have ;; to do some fuzzy matching. (let ((author (or (save-excursion (if (re-search-forward "^author: *\\([^<]*[^ ]\\) +<.*" nil t) (match-string 1))) (save-excursion (if (re-search-forward "^committer: *\\([^<]*[^< ]\\) +<" nil t) (match-string 1))))) (timestamp (save-excursion (if (re-search-forward "^timestamp:[^0-9]*\\([-0-9]+\\)" nil t) (match-string 1)))) (line1 (save-excursion (if (re-search-forward "^message:[ \n]*" nil t) (buffer-substring (point) (line-end-position)))))) ;; The `merge' may have a truncated line1 with "...", so get ;; rid of any "..." and then look for a prefix match. (when (string-match "\\.+\\'" merge) (setq merge (substring merge 0 (match-beginning 0)))) (or (string-prefix-p merge (concat author " " timestamp " " line1)) (string-prefix-p merge (concat author " " timestamp " [merge] " line1))))) (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. 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*") (erase-buffer) (call-process "bzr" nil t nil "missing" "--theirs-only" (expand-file-name from)) (let ((revnos ()) (skipped ())) (pop-to-buffer (current-buffer)) (goto-char (point-max)) (while (re-search-backward "^----------------------------------------= --------------------\nrevno: \\([0-9.]+\\).*" nil t) (save-excursion (if merges (while (not (bzrmerge-check-match (pop merges))) (unless merges (error "Unmatched tip of merged revisions"))) (let ((case-fold-search t) (revno (match-string 1)) (skip nil)) (if (string-match "\\." revno) (error "Unexpected dotted revno!") (setq revno (string-to-number revno))) (re-search-forward "^message:\n") (while (and (not skip) (re-search-forward "back[- ]?port\\|merge\\|re-?generate\\|bump ver= sion" 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 (push revno skipped) (push revno revnos))))) (delete-region (point) (point-max))) (cons (nreverse revnos) (nreverse skipped))))) (defun bzrmerge-resolve (file) (unless (file-exists-p file) (error "Bzrmerge-resolve: Can't find %s" fil= e)) (with-demoted-errors (let ((exists (find-buffer-visiting file))) (with-current-buffer (find-file-noselect file) (if (buffer-modified-p) (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)) (let ((diff-auto-refine-mode nil)) (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 " *\\'" st= r) (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 p= ut ;; 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. (cond ((member file '("configure" "lisp/ldefs-boot.el")) (call-process "bzr" nil t nil "revert" 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))) (goto-char (point-min)) (prog1 (re-search-forward smerge-begin-re nil t) (unless exists (kill-buffer)))))))) (defun bzrmerge-add-metadata (from endrevno) "Add the metadata for a merge of FROM upto ENDREVNO. Does not make other difference." (if (with-temp-buffer (call-process "bzr" nil t nil "status") (goto-char (point-min)) (re-search-forward "^conflicts:\n" nil t)) (error "Don't know how to add metadata in the presence of conflicts") (call-process "bzr" nil t nil "shelve" "--all" "-m" "Bzrmerge shelved merge during skipping") (call-process "bzr" nil t nil "revert") (call-process "bzr" nil t nil "merge" "-r" (format "%s" endrevno) from) (call-process "bzr" nil t nil "revert" ".") (call-process "bzr" nil t nil "unshelve"))) =20=20 (defvar bzrmerge-already-done nil) (defun bzrmerge-apply (missing from) (setq from (expand-file-name from)) (with-current-buffer (get-buffer-create "*bzrmerge*") (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)) beg end) (when (or merge skip) (cond ((and skip (or (null merge) (< (car skip) (car merge)))) ;; 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))) (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)))) (setq beg (1- (car merge))) (while (and merge (or (null skip) (< (car merge) (car skip)))) (assert (> (car merge) (or end beg))) (setq end (pop merge))) (message "Merging %s..%s" beg end) (if (with-temp-buffer (call-process "bzr" nil t nil "status") (zerop (buffer-size))) (call-process "bzr" nil t nil "merge" "-r" (format "%s" end) from) ;; Stupidly, "bzr merge --force -r A..B" dos not maintain the ;; metadata properly except when the checkout is clean. (call-process "bzr" nil t nil "merge" "--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"). (push end skip)) (pop-to-buffer (current-buffer)) (sit-for 1) ;; (debug 'after-merge) ;; Check the conflicts. (let ((conflicted nil) (files ())) (goto-char (point-min)) (when (re-search-forward "bzr: ERROR:" nil t) (error "Internal Bazaar error!!")) (while (re-search-forward "^Text conflict in " nil t) (push (buffer-substring (point) (line-end-position)) files)) (if (re-search-forward "^\\([0-9]+\\) conflicts encountered" ni= l t) (if (/=3D (length files) (string-to-number (match-string 1)= )) (setq conflicted t)) (if files (setq conflicted t))) (dolist (file files) (if (bzrmerge-resolve file) (setq conflicted t))) (when conflicted (setq bzrmerge-already-done (list (cons merge skip) from missing)) (error "Resolve conflicts manually"))))) (cons merge skip))))) (defun bzrmerge (from) "Merge from branch FROM into `default-directory'." (interactive (list (let ((def (with-temp-buffer (call-process "bzr" nil t nil "info") (goto-char (point-min)) (when (re-search-forward "submit branch: *" nil t) (buffer-substring (point) (line-end-position)))))) (read-file-name "From branch: " nil nil nil def)))) (message "Merging from %s..." from) (require 'vc-bzr) (let ((default-directory (or (vc-bzr-root default-directory) (error "Not in a Bzr tree")))) ;; First, check the status. (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)))))) (provide 'bzrmerge) ;;; bzrmerge.el ends here --=-=-=--