Author: mhenoch Date: Fri Aug 24 13:33:10 2007 New Revision: 134 Modified: cl-darcs/trunk/diff.lisp Log: Use the "pending" patch to keep track of new files and directories when diffing. Modified: cl-darcs/trunk/diff.lisp ============================================================================== --- cl-darcs/trunk/diff.lisp (original) +++ cl-darcs/trunk/diff.lisp Fri Aug 24 13:33:10 2007 @@ -1,4 +1,4 @@ -;;; Copyright (C) 2006 Magnus Henoch +;;; Copyright (C) 2006, 2007 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 @@ -19,16 +19,16 @@ (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)) + (when original (setf original (make-upath original))) + (when modified (setf modified (make-upath modified))) (let* ((original-lines - (if (fad:file-exists-p original) + (if original (with-open-stream (in (open-upath original :binary t)) (loop for line = (read-binary-line in nil) while line collect line)) :nonexistent)) (modified-lines - (if (fad:file-exists-p modified) + (if modified (with-open-stream (in (open-upath modified :binary t)) (loop for line = (read-binary-line in nil) while line collect line)) @@ -51,10 +51,7 @@ (error "Neither ~A nor ~A exist." original modified)) ((eql original-lines :nonexistent) ;; Newly created file - ;; XXX: should we automatically add such files? (list - (make-instance 'add-file-patch - :filename filename) (make-instance 'hunk-patch :filename filename :line-number 1 @@ -67,9 +64,7 @@ :filename filename :line-number 1 :old original-lines - :new ()) - (make-instance 'rm-file-patch - :filename filename))) + :new ()))) (t ;; Possibly changed file (dolist (opcode opcodes) @@ -90,29 +85,35 @@ (defun diff-binary-file (original modified &key filename) "Find changes between binary files ORIGINAL and MODIFIED. +ORIGINAL and MODIFIED can be NIL, meaning an empty file. 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))))))) + (let ((o-contents + (when original + (with-open-file (o original + :direction :input :if-does-not-exist :error + :element-type '(unsigned-byte 8)) + (let ((data + (make-array (file-length o) + :element-type '(unsigned-byte 8)))) + (read-sequence data o))))) + (m-contents + (when modified + (with-open-file (m modified + :direction :input :if-does-not-exist :error + :element-type '(unsigned-byte 8)) + (let ((data + (make-array (file-length m) + :element-type '(unsigned-byte 8)))) + (read-sequence data m))))) + (empty (make-array 0 :element-type '(unsigned-byte 8)))) + (unless (equalp o-contents m-contents) + (list + (make-instance 'binary-patch + :filename filename + :oldhex (or o-contents empty) + :newhex (or m-contents empty)))))) (defun diff-repo (repo &optional original modified) "Find changes in REPO from pristine tree. @@ -132,6 +133,7 @@ (pristine-wild (merge-pathnames wild pristine)) (original-wild (merge-pathnames wild original)) (modified-wild (merge-pathnames wild modified)) + (pending (read-pending repo)) patches) ;; XXX: check if both directories exist @@ -141,25 +143,48 @@ (pathname (enough-namestring p pristine))) (modified-to-repo-relative (p) (pathname (enough-namestring p repo)))) - ;; We list the files in the current directory, both in the - ;; original and the modified tree, and get the union. + ;; We list the files in the original tree. (let* ((files-in-original (mapcar #'original-to-repo-relative (fad:list-directory original))) - (files-in-modified - (mapcar #'modified-to-repo-relative - (fad:list-directory modified))) - (files (nunion files-in-original files-in-modified - :test #'equal))) - ;; Then we iterate through the union. - (dolist (file files) - (let ((original-pathname - (merge-pathnames file pristine)) - (modified-pathname - (merge-pathnames file repo)) - (pathname-string - (pathname-to-string file))) - (unless (file-boring-p repo pathname-string) + pruned-pending) + ;; Create patch objects for newly added files and directories, + ;; and remember pending patches not creating new files or + ;; directories. + (dolist (p (patches pending)) + (typecase p + (add-file-patch + (let ((pathname-string (pathname-to-string (patch-filename p))) + (new-file (merge-pathnames (patch-filename p) repo))) + (setf patches + (nconc patches + (list* p + (if (file-binary-p repo pathname-string) + (diff-binary-file nil new-file :filename pathname-string) + (diff-file nil new-file :filename pathname-string))))))) + (add-dir-patch + (setf patches (nconc patches (list p)))) + (t + (push p pruned-pending)))) + (setf (patches pending) (nreverse pruned-pending)) + + ;; Then for each original file, find out its fate. + (dolist (file files-in-original) + ;; Was it touched by some "pending" patch? + (multiple-value-bind (touching new-name) + (find-touching pending file :forward) + (if touching + ;; If yes, we want to record those patches, and remember the new name. + (setf patches (nconc patches (patches touching))) + ;; If not, it has the same name as before. + (setf new-name file)) + + (let ((original-pathname + (merge-pathnames file pristine)) + (modified-pathname + (merge-pathnames new-name repo)) + (pathname-string + (pathname-to-string new-name))) (cond ((fad:directory-pathname-p file) (setf patches (nconc patches