Author: mhenoch Date: Mon Nov 27 16:41:32 2006 New Revision: 74 Modified: cl-darcs/trunk/diff.lisp Log: Handle added and removed files Modified: cl-darcs/trunk/diff.lisp ============================================================================== --- cl-darcs/trunk/diff.lisp (original) +++ cl-darcs/trunk/diff.lisp Mon Nov 27 16:41:32 2006 @@ -22,39 +22,71 @@ (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))) + (if (fad:file-exists-p 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 - (with-open-stream (in (open-upath modified :binary t)) - (loop for line = (read-binary-line in nil) - while line collect line))) + (if (fad:file-exists-p modified) + (with-open-stream (in (open-upath modified :binary t)) + (loop for line = (read-binary-line in nil) + while line collect line)) + :nonexistent)) ;; 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))) + (opcodes (when (and (listp original-lines) + (listp modified-lines)) + (difflib:get-opcodes + (make-instance 'difflib:sequence-matcher + :a original-lines + :b modified-lines + :test-function #'equalp)))) patches) + (cond + ((and (eql original-lines :nonexistent) + (eql modified-lines :nonexistent)) + (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 + :old () + :new modified-lines))) + ((eql modified-lines :nonexistent) + ;; Removed file + (list + (make-instance 'hunk-patch + :filename filename + :line-number 1 + :old original-lines + :new ()) + (make-instance 'rm-file-patch + :filename filename))) + (t + ;; Possibly changed file + (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))) - (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))) + (nreverse patches))))) (defun diff-binary-file (original modified &key filename) "Find changes between binary files ORIGINAL and MODIFIED. @@ -96,34 +128,54 @@ :type :wild :version :wild)) (repo-wild (merge-pathnames wild repo)) + (pristine (upath-subdir repo '("_darcs" "pristine"))) + (pristine-wild (merge-pathnames wild pristine)) (original-wild (merge-pathnames wild original)) (modified-wild (merge-pathnames wild modified)) patches) - (dolist (original-pathname (fad:list-directory original)) - (let* ((modified-pathname - (translate-pathname original-pathname original-wild modified-wild)) - (pathname-string - (pathname-to-string - (translate-pathname modified-pathname repo-wild wild)))) - (cond - ((fad:directory-pathname-p original-pathname) - (format t "~&Skipping directory ~A for now" modified-pathname) - (let ((last-element (car (last (pathname-directory original-pathname))))) - (unless (file-boring-p repo last-element) - ;; We have a non-boring subdirectory. - (setf patches (nconc patches - (diff-repo repo original-pathname modified-pathname)))))) + ;; XXX: check if both directories exist - ((file-binary-p repo pathname-string) - (setf patches (nconc patches - (diff-binary-file original-pathname - modified-pathname - :filename pathname-string)))) - - (t - (setf patches (nconc patches - (diff-file original-pathname - modified-pathname - :filename pathname-string))))))) + ;; With fad:list-directory, we get absolute pathnames. We make + ;; them relative to the "root", so they can be compared. + (flet ((original-to-repo-relative (p) + (translate-pathname p pristine-wild wild)) + (modified-to-repo-relative (p) + (translate-pathname p repo-wild wild))) + ;; We list the files in the current directory, both in the + ;; original and the modified tree, and get the union. + (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))) + (cond + ((fad:directory-pathname-p file) + (unless (file-boring-p repo pathname-string) + ;; We have a non-boring subdirectory. + (setf patches (nconc patches + (diff-repo repo original-pathname modified-pathname))))) + + ((file-binary-p repo pathname-string) + (setf patches (nconc patches + (diff-binary-file original-pathname + modified-pathname + :filename pathname-string)))) + + (t + (setf patches (nconc patches + (diff-file original-pathname + modified-pathname + :filename pathname-string))))))) - patches)) + patches))))