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

[mhenoch at common-lisp.net]

Author: mhenoch
Date: Wed Nov 22 15:00:24 2006
New Revision: 67

Added:
   cl-darcs/trunk/diff.lisp
Modified:
   cl-darcs/trunk/cl-darcs.asd
Log:
Start hacking diff


Modified: cl-darcs/trunk/cl-darcs.asd
==============================================================================
--- cl-darcs/trunk/cl-darcs.asd	(original)
+++ cl-darcs/trunk/cl-darcs.asd	Wed Nov 22 15:00:24 2006
@@ -21,7 +21,9 @@
 	       ;; Files and directories
 	       :cl-fad
 	       ;; Regexps
-	       :cl-ppcre)
+	       :cl-ppcre
+	       ;; Diff
+	       :cl-difflib)
 
   :components
   ((:file "packages")

Added: cl-darcs/trunk/diff.lisp
==============================================================================
--- (empty file)
+++ cl-darcs/trunk/diff.lisp	Wed Nov 22 15:00:24 2006
@@ -0,0 +1,57 @@
+;;; Copyright (C) 2006 Magnus Henoch
+;;;
+;;; 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 2 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, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
+
+(in-package :darcs)
+
+(defun diff-file (original modified &key filename)
+  "Find changes between ORIGINAL and MODIFIED.
+Return a list of HUNK-PATCHes.  Use FILENAME as their filename."
+  (setf original (make-upath original))
+  (setf modified (make-upath modified))
+  (let* ((original-lines
+	  (with-open-stream (in (open-upath original :binary t))
+	    (loop for line = (read-binary-line in nil)
+	       while line collect line)))
+	 (modified-lines
+	  (with-open-stream (in (open-upath modified :binary t))
+	    (loop for line = (read-binary-line in nil)
+	       while line collect line)))
+
+	 ;; using equalp is safe (i.e. non-case-clobbering), as
+	 ;; we use bytes instead of characters
+	 (opcodes (difflib:get-opcodes
+		   (make-instance 'difflib:sequence-matcher
+				  :a original-lines
+				  :b modified-lines
+				  :test-function #'equalp)))
+
+	 patches)
+
+    (dolist (opcode opcodes)
+      (unless (eql (difflib:opcode-tag opcode) :equal)
+	 (push 
+	  (make-instance 'hunk-patch
+			 :filename filename
+			 :line-number (difflib:opcode-j1 opcode)
+			 :old (subseq original-lines
+					      (difflib:opcode-i1 opcode)
+					      (difflib:opcode-i2 opcode))
+			 :new (subseq modified-lines
+					      (difflib:opcode-j1 opcode)
+					      (difflib:opcode-j2 opcode)))
+	  patches)))
+
+    (nreverse patches)))