Merge pull request #5 from eschulte/master

diff operations directly over lists, and support for diff and patch application

Author: froydnj

diff.lisp

@@ -89,6 +89,17 @@
           (let ((code (intern-string interner line)))
             (push code interned-file)))
         (push (coerce (nreverse interned-file) 'simple-vector) interned-files)))))
+
+(defun intern-seqs (&rest seqs)
+  (let ((interner (make-interner))
+        (interned-seqs nil))
+    (dolist (seq seqs (values interner (nreverse interned-seqs)))
+      (let ((interned-seq nil))
+        (loop :for line :in seq :do
+           (let ((code (intern-string interner line)))
+             (push code interned-seq)))
+        (push (coerce (nreverse interned-seq) 'simple-vector) interned-seqs)))))
+
 
 ;;; Computing longest common subsequences between two sequences whose
 ;;; elements compare equal via EQL.  The algorithm used here is based
@@ -244,6 +255,12 @@
 (defun compute-raw-diff (origin modified)
   (convert-lcs-to-diff (compute-lcs origin modified)))
 
+(defun compute-raw-seq-diff (original-seq modified-seq)
+  (multiple-value-bind (interner interned-seqs)
+      (intern-seqs original-seq modified-seq)
+    (declare (ignorable interner))
+    (convert-lcs-to-diff (apply #'compute-lcs interned-seqs))))
+
 
 ;;; producing diffs in "unified diff" format
 
@@ -298,6 +315,50 @@ of context; the default of three should be good enough for most situations.")
    (window-chunks :initform nil
                   :accessor window-chunks)))
 
+(defun apply-seq-window (original-seq window &key (offset 0))
+  "Apply the edits encoded in WINDOW to the ORIGINAL-SEQ."
+  (multiple-value-bind (interner interned-seqs)
+      (apply #'intern-seqs original-seq
+             (mapcar #'chunk-lines (window-chunks window)))
+    (let ((index (original-start-line window))
+          (result (coerce (first interned-seqs) 'list)))
+      (flet ((ind () (+ index offset))
+             (back (line) (interned-object interner line)))
+        (loop
+           for chunk in (window-chunks window)
+           for lines in (mapcar (lambda (l) (coerce l 'list)) (cdr interned-seqs))
+           do (case (chunk-kind chunk)
+                (:common
+                 (mapc (lambda (line)
+                         (assert (eql line (nth (ind) result))
+                                 (line result index)
+                                 "window does not apply at ~d, ~s!=~s "
+                                 (ind) (back line) (back (nth (ind) result)))
+                         (incf index))
+                       lines))
+                ((:replace :delete)
+                 (setf result
+                       (append (subseq result 0 (ind))
+                               (subseq result (+ (ind) (length lines)))))
+                 (incf index  (length lines))
+                 (decf offset (length lines)))
+                ((:insert :create)
+                 (setf result (append (subseq result 0 (ind))
+                                      lines
+                                      (subseq result (ind))))
+                 (incf offset (length lines)))))
+        (values (mapcar #'back result) offset)))))
+
+(defun apply-seq-diff (original-seq diff)
+  "Apply DIFF to the sequence ORIGINAL-SEQ."
+  (apply #'values
+    (reduce
+     (lambda (accumulator window)
+       (destructuring-bind (seq offset) accumulator
+         (multiple-value-call #'list
+           (apply-seq-window seq window :offset offset))))
+     (diff-windows diff) :initial-value (list original-seq 0))))
+
 (deftype chunk-kind () '(member :common :delete :replace :insert :create))
 
 (defclass chunk ()
@@ -488,6 +549,19 @@ DIFF:UNIFIED-DIFF or DIFF:CONTEXT-DIFF."
                                             modified-pathname modified)))
         (walk-diff-regions context diff-regions)))))
 
+(defun generate-seq-diff (diff-kind original-seq modified-seq)
+  "Compute a diff between ORIGINAL-PATHNAME and MODIFIED-PATHNAME."
+  (multiple-value-bind (interner interned-seqs)
+      (intern-seqs original-seq modified-seq)
+    (let* ((original (first interned-seqs))
+           (modified (second interned-seqs))
+           (lcs (compute-lcs original modified)))
+      (let ((diff-regions (convert-lcs-to-diff lcs))
+            (context (create-diff-generator diff-kind interner
+                                            "original" original
+                                            "modified" modified)))
+        (walk-diff-regions context diff-regions)))))
+
 (defun format-diff (diff-kind original-pathname modified-pathname &optional (stream *standard-output*))
   (render-diff (generate-diff diff-kind
                               original-pathname

package.lisp

@@ -4,8 +4,14 @@
   (:use :cl)
   (:export #:*diff-context-lines*
            #:generate-diff
+           #:generate-seq-diff
            #:unified-diff #:context-diff
-           
+
+           #:apply-seq-window
+           #:apply-seq-diff
+           #:apply-seq-patch
+           #:apply-patch
+
            #:render-diff
            #:render-diff-window
            #:format-diff
@@ -28,6 +34,7 @@
            #:chunk-lines
 
            #:compute-raw-diff
+           #:compute-raw-seq-diff
            #:common-diff-region
            #:modified-diff-region
            #:original-start

patch.lisp

@@ -341,3 +341,14 @@
                                  :index-file (and index (pathname index))
                                  :prereq-string prereq)
                   patches)))))))
+
+(defun apply-seq-patch (original-seq patch)
+  "Apply PATCH to the sequence ORIGINAL-SEQ."
+  (apply-seq-diff original-seq (diff patch)))
+
+(defun apply-patch (patch &aux original)
+  "Apply PATCH."
+  (do-file-lines (line (original-pathname (diff patch))) (push line original))
+  (with-open-file (out (original-pathname (diff patch))
+                       :direction :output :if-exists :supersede)
+    (format out "~{~a~^~%~}~%" (apply-seq-patch (nreverse original) patch))))