Author: mhenoch Date: Wed Nov 22 15:30:46 2006 New Revision: 68 Modified: cl-darcs/trunk/diff.lisp Log: Add diff-repo Modified: cl-darcs/trunk/diff.lisp ============================================================================== --- cl-darcs/trunk/diff.lisp (original) +++ cl-darcs/trunk/diff.lisp Wed Nov 22 15:30:46 2006 @@ -55,3 +55,41 @@ patches))) (nreverse patches))) + +(defun diff-repo (repo &optional original modified) + "Find changes in REPO from pristine tree. +Return a list of patches. +ORIGINAL and MODIFIED specify directories to start from." + (setf repo (fad:pathname-as-directory repo)) + (unless (and original modified) + (setf modified repo) + (setf original (upath-subdir repo '("_darcs" "pristine")))) + + (let* ((wild (make-pathname :directory '(:relative :wild-inferiors) + :name :wild + :type :wild + :version :wild)) + (repo-wild (merge-pathnames wild repo)) + (original-wild (merge-pathnames wild original)) + (modified-wild (merge-pathnames wild modified)) + patches) + (dolist (original-pathname (fad:list-directory original)) + (let ((relative-pathname + (translate-pathname original-pathname original-wild repo-wild)) + (modified-pathname + (translate-pathname original-pathname original-wild modified-wild))) + (cond + ((fad:directory-pathname-p original-pathname) + (format t "~&Skipping directory ~A for now" original-pathname) + ;; (let ((last-element (car (last (pathname-directory original-pathname))))) + ;; (unless (file-boring-p repo last-element) + ;; ;; We have a non-boring subdirectory. + ) + (t + (setf patches (nconc patches + (diff-file original-pathname + modified-pathname + :filename + (pathname-to-string relative-pathname)))))))) + + patches))