(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")

(FILECREATED "22-Sep-87 15:19:06" {ERINYES}<LISPUSERS>LYRIC>COMPARE-PATHS.\;3
 4836   

      |changes| |to:|  (FUNCTIONS XCL-USER::COMPARE-PATHS XCL-USER::COMPARE-FLOPPY)
                       (VARS COMPARE-PATHSCOMS)

      |previous| |date:| "22-Sep-87 12:03:37" {ERINYES}<LISPUSERS>LYRIC>COMPARE-PATHS.\;1)


; Copyright (c) 1987 by Xerox Corporation.  All rights reserved.

(PRETTYCOMPRINT COMPARE-PATHSCOMS)

(RPAQQ COMPARE-PATHSCOMS
 ((FUNCTIONS XCL-USER::COMPARE-FLOPPY XCL-USER::COMPARE-PATHS)))

(CL:DEFUN XCL-USER::COMPARE-FLOPPY
 (XCL-USER::FLOPPYPATH XCL-USER::FSPATH) 

(* |;;;| "This resoundingly dumb function walks IL:COMPARESOURCES down the files of two directories.")

 (LET* ((XCL-USER::FLOPPYFILES (DIRECTORY XCL-USER::FLOPPYPATH))
        (XCL-USER::FSFILES (DIRECTORY XCL-USER::FSPATH)))
       (WHILE
 (AND XCL-USER::FLOPPYFILES XCL-USER::FSFILES) BIND
 XCL-USER::FLOPPYNAME 
                                                                 XCL-USER::FSNAME
          DO
 (CL:SETQ XCL-USER::FLOPPYNAME (CL:PATHNAME-NAME (PATHNAME (CAR XCL-USER::FLOPPYFILES))))
             (CL:SETQ XCL-USER::FSNAME (CL:PATHNAME-NAME (PATHNAME (CAR XCL-USER::FSFILES))))
             (COND
                ((CL:STRING= XCL-USER::FLOPPYNAME XCL-USER::FSNAME)
                 (LET ((XCL-USER::FLOPPYDATE (GETFILEINFO (CAR XCL-USER::FLOPPYFILES)
                                                    'CREATIONDATE))
                       (XCL-USER::FSDATE (GETFILEINFO (CAR XCL-USER::FSFILES)
                                                'CREATIONDATE)))
                      (IF
 (NOT (CL:STRING= XCL-USER::FLOPPYDATE XCL-USER::FSDATE))
                          THEN
 (CL:FORMAT T "Creation dates for ~s don't match:~%~S: ~S  ~S: ~S ~2%" 
                                      XCL-USER::FLOPPYNAME (CAR XCL-USER::FLOPPYFILES)
                                      XCL-USER::FLOPPYDATE
                                      (CAR XCL-USER::FSFILES)
                                      XCL-USER::FSDATE)
                        ELSE
 (COMPARESOURCES (CAR XCL-USER::FLOPPYFILES)
                                    (CAR XCL-USER::FSFILES))
                             (CL:FORMAT T "~%")))
                 (CL:POP XCL-USER::FLOPPYFILES)
                 (CL:POP XCL-USER::FSFILES))
                ((CL:STRING< XCL-USER::FLOPPYNAME XCL-USER::FSNAME)
                 (CL:FORMAT T "File ~S not found on ~S~%" (CAR XCL-USER::FLOPPYFILES)
                        XCL-USER::FSPATH)
                 (CL:POP XCL-USER::FLOPPYFILES))
                (T (CL:POP XCL-USER::FSFILES))))
       (WHILE
 XCL-USER::FLOPPYFILES DO
 (CL:FORMAT T "File ~S not found on ~S~%" (CAR 
                                                                                XCL-USER::FLOPPYFILES
                                                                                     )
                                              XCL-USER::FSPATH)
                                       (CL:POP XCL-USER::FLOPPYFILES))))


(CL:DEFUN XCL-USER::COMPARE-PATHS
 (XCL-USER::PATH1 XCL-USER::PATH2) 

(* |;;;| "This resoundingly dumb function walks IL:COMPARESOURCES down the files of two directories.")

 (LET* ((XCL-USER::PL1 (DIRECTORY XCL-USER::PATH1))
        (XCL-USER::PL2 (DIRECTORY XCL-USER::PATH2)))
       (WHILE
 (AND XCL-USER::PL1 XCL-USER::PL2) BIND
 XCL-USER::PN1 XCL-USER::PN2
          DO
 (CL:SETQ XCL-USER::PN1 (CL:PATHNAME-NAME (PATHNAME (CAR XCL-USER::PL1))))
             (CL:SETQ XCL-USER::PN2 (CL:PATHNAME-NAME (PATHNAME (CAR XCL-USER::PL2))))
             (COND
                ((CL:STRING= XCL-USER::PN1 XCL-USER::PN2)
                 (COMPARESOURCES (CAR XCL-USER::PL1)
                        (CAR XCL-USER::PL2))
                 (CL:FORMAT T "~%")
                 (CL:POP XCL-USER::PL1)
                 (CL:POP XCL-USER::PL2))
                ((CL:STRING< XCL-USER::PN1 XCL-USER::PN2)
                 (CL:FORMAT T "File ~S not found on ~S~%" (CAR XCL-USER::PL1)
                        XCL-USER::PATH2)
                 (CL:POP XCL-USER::PL1))
                (T (CL:FORMAT T "File ~S not found on ~S~%" (CAR XCL-USER::PL2)
                          XCL-USER::PATH1)
                   (CL:POP XCL-USER::PL2))))
       (WHILE
 XCL-USER::PL1 DO
 (CL:FORMAT T "File ~S not found on ~S~%" (CAR XCL-USER::PL1)
                                      XCL-USER::PATH2)
                               (CL:POP XCL-USER::PL1))
       (WHILE
 XCL-USER::PL2 DO
 (CL:FORMAT T "File ~S not found on ~S~%" (CAR XCL-USER::PL2)
                                      XCL-USER::PATH1)
                               (CL:POP XCL-USER::PL2))))

(PUTPROPS COMPARE-PATHS COPYRIGHT ("Xerox Corporation" 1987))
(DECLARE\: DONTCOPY
  (FILEMAP (NIL)))
STOP