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.