(DEFINE-FILE-INFO PACKAGE "XCL" READTABLE "XCL" BASE 10)

(IL:FILECREATED "15-Jan-88 18:24:54" IL:{QV}<NOTECARDS>1.3LNEXT>WHERE-IS-PATCH.\;2
 4178   

      IL:|changes| IL:|to:|  (IL:VARS IL:WHERE-IS-PATCHCOMS)
                             (IL:PROPS (IL:WHERE-IS-PATCH IL:MAKEFILE-ENVIRONMENT))

      IL:|previous| IL:|date:| "15-Jan-88 18:23:01" IL:{QV}<NOTECARDS>1.3LNEXT>WHERE-IS-PATCH.\;1)


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

(IL:PRETTYCOMPRINT IL:WHERE-IS-PATCHCOMS)

(IL:RPAQQ IL:WHERE-IS-PATCHCOMS
 ((IL:FILES (IL:FROM IL:LISPUSERS)
                                        IL:NEW-WHERE-IS)
                                 (IL:FUNCTIONS WHERE-IS-NOTICE)
                                 (IL:PROP (IL:FILETYPE IL:MAKEFILE-ENVIRONMENT)
                                        IL:WHERE-IS-PATCH)))
(IL:FILESLOAD (IL:FROM IL:LISPUSERS)
       IL:NEW-WHERE-IS)

(DEFUN WHERE-IS-NOTICE
 (DATABASE-FILE &KEY (FILES "*.;")
                              (NEW NIL)
                              (USE-FULLNAME NIL)
                              (DEFINE-TYPES (WHERE-IS-DEFAULT-DEFINE-TYPES))
                              (HASH-FILE-SIZE *WHERE-IS-HASH-FILE-SIZE*)
                              (QUIET NIL)
                              (TEMP-FILE NIL))
   (LET*
    ((FILE (IF TEMP-FILE (IF NEW TEMP-FILE (IL:COPYFILE DATABASE-FILE TEMP-FILE))
               DATABASE-FILE))
     (HASH-FILE:HASH-FILE (IF NEW (HASH-FILE:MAKE-HASH-FILE FILE HASH-FILE-SIZE)
                              (HASH-FILE:OPEN-HASH-FILE FILE :DIRECTION :IO)))
     (HASH-FILE::*DELETE-OLD-VERSION-ON-REHASH* T))
    (UNWIND-PROTECT
     (DOLIST
      (PATHNAME (WHERE-IS-FILES FILES))
      (UNLESS QUIET (FORMAT T ";;; ~A ." (NAMESTRING PATHNAME)))
      (LET ((NAMESTRING (WHERE-IS-NAMESTRING PATHNAME)))
           (IF (AND (NOT NEW)
                    (LET ((OLD-WRITE-DATE (WHERE-IS-GET-WRITE-DATE NAMESTRING HASH-FILE:HASH-FILE)))
                         (AND OLD-WRITE-DATE (= (FILE-WRITE-DATE PATHNAME)
                                                OLD-WRITE-DATE))))
               (UNLESS QUIET (FORMAT T " up to date.~%"))
               (MULTIPLE-VALUE-BIND
                (FILE-VARS VALUES)
                (WHERE-IS-READ-COMS PATHNAME)
                (WHEN FILE-VARS 
          
          (IL:* IL:|;;| "bind the filevars s.t. IL:INFILECOMS? will find them")

                      (PROGV FILE-VARS VALUES (UNLESS QUIET (PRINC "."))
                             (DOLIST (TYPE DEFINE-TYPES)
                                    (LET ((NAMES (IL:INFILECOMS? NIL TYPE (FIRST FILE-VARS))))
                                         (WHEN (CONSP NAMES)
          
          (IL:* IL:|;;| "IL:INFILECOMS? sometimes returns T.")

                                               (DOLIST (NAME NAMES)
                                                      (WHERE-IS-NOTICE-INTERNAL NAME TYPE
                                                             (IF USE-FULLNAME (NAMESTRING PATHNAME)
                                                                 NAMESTRING)
                                                             HASH-FILE:HASH-FILE))))))
                      (WHERE-IS-SET-WRITE-DATE NAMESTRING PATHNAME HASH-FILE:HASH-FILE)
                      (UNLESS QUIET (PRINC ". done.")
                             (TERPRI)))))))
     (HASH-FILE:CLOSE-HASH-FILE HASH-FILE:HASH-FILE))
    (LET ((PATHNAME (PATHNAME (HASH-FILE::HASH-FILE-STREAM HASH-FILE:HASH-FILE))))
         (COND
            (TEMP-FILE (UNLESS QUIET (FORMAT T ";;; Renaming ~A ... " (NAMESTRING PATHNAME)))
                   (MULTIPLE-VALUE-BIND (MERGED TRUE-NAME REAL-TRUE-NAME)
                          (RENAME-FILE PATHNAME DATABASE-FILE)
                          (UNLESS QUIET (FORMAT T "~A~%" (NAMESTRING REAL-TRUE-NAME)))
                          REAL-TRUE-NAME))
            (T PATHNAME)))))


(IL:PUTPROPS IL:WHERE-IS-PATCH IL:FILETYPE
 :COMPILE-FILE)

(IL:PUTPROPS IL:WHERE-IS-PATCH IL:MAKEFILE-ENVIRONMENT
 (:PACKAGE "XCL" :READTABLE "XCL" :BASE 10))
(IL:PUTPROPS IL:WHERE-IS-PATCH IL:COPYRIGHT ("Xerox Corporation" 1988))
(IL:DECLARE\: IL:DONTCOPY
  (IL:FILEMAP (NIL)))
IL:STOP