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

(FILECREATED "16-Nov-88 14:11:42" {PHYLUM}<BURWELL>LISP>LYRIC>LOADPATCHES.;3
 3441   

      changes to%:  (VARS LOADPATCHESCOMS)
                    (FNS LoadPatches COLLECT-PATCH-FILES)

      previous date%: "27-Sep-88 22:56:49" {PHYLUM}<BURWELL>LISP>LYRIC>LOADPATCHES.;1)


(* "
Copyright (c) 1985, 1988 by Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT LOADPATCHESCOMS)

(RPAQQ LOADPATCHESCOMS
 ((FNS LoadPatches COLLECT-PATCH-FILES)
                        (DECLARE%: DONTCOPY (PROP FILETYPE LOADPATCHES))))
(DEFINEQ

(LoadPatches

  [LAMBDA (DIRECTORY LDFLG AFTERDATE)
                      (* ; "Edited 16-Nov-88 13:08 by Burwell")


(* ;;; "Load all compiled files from the directory")


    (DECLARE
 (GLOBALVARS *COMPILED-EXTENSIONS*))
    (LET [(files (SORT (for
 EXT in
 *COMPILED-EXTENSIONS*
                          bind
 (AFTERIDATE _ (if
 AFTERDATE
                                                 then
 (OR (IDATE AFTERDATE)
                                                          0)
                                               else
 0)) join
 (COLLECT-PATCH-FILES
 DIRECTORY EXT 
                                                                    AFTERIDATE))
                       (FUNCTION (LAMBDA (X Y)
                                   (LESSP (CDR X)
                                          (CDR Y]            (* ; 

                                                             "files are sorted by increasing date")

         (for
 file in
 files do
 (SELECTQ LDFLG
                                   (HIDDEN                   (* ; 

                                                         "Load the file, but don't put it on FILELST")

                                           (LOAD? (CAR file)
                                                  T)
                                           (SETQ FILELST (DREMOVE (FILENAMEFIELD (CAR file)
                                                                         'NAME)
                                                                FILELST)))
                                   (LOAD? (CAR file)
                                          LDFLG)))
         files])

(COLLECT-PATCH-FILES

  [LAMBDA (DIRECTORY EXT AFTERIDATE)
                       (* ; "Edited 16-Nov-88 13:13 by Burwell")


    (* ;; "Generate list of files in DIRECTORY with extension EXT more recent than idate AFTERIDATE.  Return list of pairs (file . date).  Omits subdirectories.")


    (RESETLST
        (LET ((FILING.ENUMERATION.DEPTH 1)
              (NAKED-DIR (UNPACKFILENAME.STRING DIRECTORY 'DIRECTORY))
              FILE DATE)
             (bind
 [GEN _ (\GENERATEFILES (CONCAT DIRECTORY "*." EXT ";")
                                 '(ICREATIONDATE)
                                 '(SORT RESETLST] while
 (SETQ FILE (\GENERATENEXTFILE GEN))
                when
 (AND (STRING-EQUAL (UNPACKFILENAME.STRING FILE 'DIRECTORY)
                                 NAKED-DIR)
                          (> (SETQ DATE (\GENERATEFILEINFO GEN 'ICREATIONDATE))
                             AFTERIDATE)) collect
 (CONS FILE DATE))))])
)
(DECLARE%: DONTCOPY 

(PUTPROPS LOADPATCHES
 FILETYPE
 :COMPILE-FILE)
)
(PUTPROPS LOADPATCHES COPYRIGHT ("Xerox Corporation" 1985 1988))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (608 3275 (LoadPatches 618 . 2308) (COLLECT-PATCH-FILES 2310 . 3273)))))
STOP