[Cl-darcs-cvs] r10 - cl-darcs/trunk

[mhenoch at common-lisp.net]

Author: mhenoch
Date: Wed Jun 21 10:57:40 2006
New Revision: 10

Modified:
   cl-darcs/trunk/apply-patch.lisp
Log:
Correctly treat hunks in reverse order


Modified: cl-darcs/trunk/apply-patch.lisp
==============================================================================
--- cl-darcs/trunk/apply-patch.lisp	(original)
+++ cl-darcs/trunk/apply-patch.lisp	Wed Jun 21 10:57:40 2006
@@ -212,25 +212,30 @@
   "Apply a list of patches, attempting to optimize for adjacent hunks."
   (dformat "~&Looking for adjacent hunks...")
   (loop while patches
-       do
-       (etypecase (car patches)
-	 (hunk-patch
-	  (let ((filename (patch-filename (car patches))))
-	    (loop while (and (typep (car patches) 'hunk-patch)
-			     (equal (patch-filename (car patches)) filename))
-	       collect (car patches) into hunks
-	       do (setf patches (cdr patches))
-	       finally (loop
-			    (restart-case
-				(progn
-				  (apply-hunk-list hunks repodir)
-				  (return))
-			      (retry-hunks ()
-				  :report (lambda (stream)
-					    (format stream "Retry patch ~A to ~A" hunks filename))))))))
-	 (patch
-	  (apply-patch (car patches) repodir)
-	  (setf patches (cdr patches))))))
+     do
+     (etypecase (car patches)
+       (hunk-patch
+	(let ((filename (patch-filename (car patches)))
+	      (line-number 0))
+	  (loop while (and (typep (car patches) 'hunk-patch)
+			   (equal (patch-filename (car patches)) filename)
+			   (>= (hunk-line-number (car patches)) line-number))
+	     collect (car patches) into hunks
+	     do (setf line-number (+
+				   (hunk-line-number (car patches))
+				   (length (hunk-new-lines (car patches)))))
+	     (setf patches (cdr patches))
+	     finally (loop
+			(restart-case
+			    (progn
+			      (apply-hunk-list hunks repodir)
+			      (return))
+			  (retry-hunks ()
+			    :report (lambda (stream)
+				      (format stream "Retry patch ~A to ~A" hunks filename))))))))
+       (patch
+	(apply-patch (car patches) repodir)
+	(setf patches (cdr patches))))))
 
 (defun apply-hunk-list (hunks repodir)
   "Apply HUNKS to REPODIR.