;;; -*- Mode:LISP; Package:USER; Readtable:CL; Base:10 -*-

(defun compare-sources(source-dir &aux old-src new-src)
  (setq old-src (make-pathname
		  :host "it"
		  :directory (list "RELEASE-3" (string-upcase source-dir))
		  :name :wild
		  :type :lisp
		  :version :highest))
  (setq new-src (make-pathname
		  :defaults old-src
		  :directory (list "L" (string-upcase source-dir))
		  :host "opus"))
  (let((oldfiles (directory old-src)))
    (do*((files oldfiles (cdr files)))
	((null files))
      (let*((old (car files))
	    (old-vers (pathname-version old))
	    (new (make-pathname :defaults old :version :newest))
	    (new-vers (pathname-version (truename new))))
	(if (equal old-vers new-vers)
	    (format t "~%Same versions for ~a:~a;~a"
		    (pathname-host old)
		    (send old :string-for-directory)
		    (pathname-name old))
	  (srccom:source-compare old new))))))

(defun save-sourcelist(&optional
		       (dir "it:release-3;")
		       (outfile "it:keith.release-4;sources-rel3.text"))
  (let((spaces (make-string 50. :initial-element #\space))
       (out-stream (if outfile (open outfile  :direction :output)
		     standard-output)))
    (with-open-stream (out out-stream)
      (loop for elt in (local:directoryr dir
					 :include-dirnames t :default-version :highest)
	    do (format out "~%~a~a" 
		       (substring spaces
				  0 
				  (* 2 (length (let((dir (send elt :directory)))
						 (if (atom dir) nil dir)))))
		       (send elt :string-for-printing))))))