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

mhenoch at common-lisp.net mhenoch at common-lisp.net
Sat Feb 24 23:50:52 UTC 2007


Author: mhenoch
Date: Sat Feb 24 18:50:52 2007
New Revision: 98

Modified:
   cl-darcs/trunk/apply-patch.lisp
Log:
Fix APPLY-PATCH for TOKEN-REPLACE-PATCH


Modified: cl-darcs/trunk/apply-patch.lisp
==============================================================================
--- cl-darcs/trunk/apply-patch.lisp	(original)
+++ cl-darcs/trunk/apply-patch.lisp	Sat Feb 24 18:50:52 2007
@@ -186,27 +186,27 @@
 			     (token-regexp patch))))
 	(replacement (format nil "\\1~A\\2" (new-token patch))))
     (dformat "~&Patching ~A with ~A." filename patch)
-    (with-file-patching (in out filename) (apply-patch patch repodir)
+    (with-file-patching (in out filename)
       (let ((file-empty t))
 	(flet ((maybe-terpri ()
 		 ;; Unless we're writing the first line, we have to
 		 ;; terminate the previous one.
 		 (if file-empty
 		     (setf file-empty nil)
-		     (terpri out))))
+		     (write-byte 10 out))))
 	  (loop
-	       (multiple-value-bind (line delim) (read-until #\Newline in nil :eof)
-		 (setf line (coerce line 'string))
-		 (when (cl-ppcre:scan new-regexp line)
-		   (cerror "Ignore" "While replacing ~S with ~S, found ~S before patching: ~S."
-			   (old-token patch) (new-token patch) (new-token patch) line))
-
-		 (maybe-terpri)
-		 (when (eql delim :eof)
-		   (return))
-
-		 (let ((patched-line (cl-ppcre:regex-replace-all old-regexp line replacement)))
-		   (write-string patched-line out)))))))))
+	     (let ((line (read-binary-line in nil :eof)))
+	       (when (eql line :eof)
+		 (return))
+	       (maybe-terpri)
+
+	       (setf line (bytes-to-string line))
+	       (when (cl-ppcre:scan new-regexp line)
+		 (cerror "Ignore" "While replacing ~S with ~S, found ~S before patching: ~S."
+			 (old-token patch) (new-token patch) (new-token patch) line))
+	       
+	       (let ((patched-line (cl-ppcre:regex-replace-all old-regexp line replacement)))
+		 (write-sequence (string-to-bytes patched-line) out)))))))))
       
 (defmethod apply-patch ((patch hunk-patch) repodir)
   "Apply a single hunk patch to REPODIR."



More information about the Cl-darcs-cvs mailing list