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

[mhenoch at common-lisp.net]

Author: mhenoch
Date: Wed Nov 22 15:45:32 2006
New Revision: 70

Modified:
   cl-darcs/trunk/diff.lisp
Log:
Add diff-binary-file and use it


Modified: cl-darcs/trunk/diff.lisp
==============================================================================
--- cl-darcs/trunk/diff.lisp	(original)
+++ cl-darcs/trunk/diff.lisp	Wed Nov 22 15:45:32 2006
@@ -56,6 +56,32 @@
 
     (nreverse patches)))
 
+(defun diff-binary-file (original modified &key filename)
+  "Find changes between binary files ORIGINAL and MODIFIED.
+Use FILENAME as their filename.
+Return a list of one BINARY-PATCH, or an empty list if
+the files are equal."
+  (with-open-file (o original
+		      :direction :input :if-does-not-exist :error
+		      :element-type '(unsigned-byte 8))
+    (with-open-file (m modified
+		       :direction :input :if-does-not-exist :error
+		       :element-type '(unsigned-byte 8))
+      (let ((o-contents
+	     (make-array (file-length o)
+			 :element-type '(unsigned-byte 8)))
+	    (m-contents
+	     (make-array (file-length m)
+			 :element-type '(unsigned-byte 8))))
+	(read-sequence o-contents o)
+	(read-sequence m-contents m)
+	(unless (equalp o-contents m-contents)
+	  (list
+	   (make-instance 'binary-patch
+			  :filename filename
+			  :oldhex o-contents
+			  :newhex m-contents)))))))
+
 (defun diff-repo (repo &optional original modified)
   "Find changes in REPO from pristine tree.
 Return a list of patches.
@@ -88,7 +114,10 @@
 	   )
 
 	  ((file-binary-p repo pathname-string)
-	   (format t "~&Skipping binary file ~A for now" modified-pathname))
+	   (setf patches (nconc patches
+				(diff-binary-file original-pathname
+						  modified-pathname
+						  :filename pathname-string))))
 
 	  (t
 	   (setf patches (nconc patches