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

;;; COMP-DIR

(in-package 'user)

(export '(comp-dir filename-equal filename-lessp filename-greaterp))

(defun comp-dir(old-dir new-dir &optional compare-files &aux old-missing new-missing)
"Compare two directories by filename contents (ignoring version numbers).
If COMPARE-FILES is non-NIL, files are source-compared."
  (declare(special compare-files old-dir new-dir old-missing new-missing))
  (comp-dir1 (directory old-dir) (directory new-dir))
  (setq old-missing (reverse old-missing))
  (setq new-missing (reverse new-missing))
  (if old-missing
      (format t "~&~s files not found in ~a: ~~{~a~%~}~"
	      (length old-missing)
	      (namestring new-dir)
	      (mapcar #'namestring old-missing)))
  (if new-missing
      (format t "~&~s files not found in ~a: ~~{~a~%~}~"
	      (length new-missing)
	      (namestring old-dir)
	      (mapcar #'namestring new-missing)))
  (format t "~&Done.")
  (values old-missing
	  new-missing))

(defun filename-equal(old new)
  (and
    (string-equal (pathname-name old)
		  (pathname-name new))
    (string-equal (pathname-type old)
		  (pathname-type new))))

(defun filename-lessp(old new)
  (or
    (string-lessp (pathname-name old)
		  (pathname-name new))
    (and
      (string-equal (pathname-name old)
		    (pathname-name new))
      (string-lessp (pathname-type old)
		    (pathname-type new)))))

(defun filename-sourcep(filename)
  (mem #'string-equal
       (send (pathname filename) :type)
       fs:character-file-types ))

(defsubst filename-greaterp(old new)
  (not(filename-lessp old new)))

(defun comp-dir1(old new)
  (declare(special compare-files old-dir new-dir old-missing new-missing))
  (cond
    ((null old) (setq new-missing (append (reverse new) new-missing)))
    ((null new) (setq old-missing (append (reverse old) old-missing)))
    (t (let* ((old-file (car old))
	      (old-filename (file-namestring old-file))
	      (new-file (car new))
	      (new-filename (file-namestring new-file)))
	 (cond
	   ((filename-equal old-file new-file) 
	    (format t "~&Present in both: ~a" old-filename)
	    (if (and compare-files (filename-sourcep old-file))
		(srccom:source-compare old-file new-file))
	    (comp-dir1 (cdr old) (cdr new)))
	   ((filename-lessp old-file new-file)
	    (push (car old) old-missing)
	    (format t "~&Missing from ~s: ~a"
		    (namestring new-dir)
		    old-filename)
	    (comp-dir1 (cdr old) new))
	   (t
	    (push (car new) new-missing)
	    (format t "~&Missing from ~s: ~a"
		    (namestring old-dir)
		    new-filename)
	    (comp-dir1 old (cdr new)))
	   )))))