[Cl-darcs-cvs] r134 - cl-darcs/trunk
mhenoch at common-lisp.net
mhenoch at common-lisp.net
Fri Aug 24 17:33:10 UTC 2007
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
More information about the Cl-darcs-cvs
mailing list