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

(FILECREATED "24-Apr-92 12:28:19" {DSK}<project>medley2.0>library>LOADPATCHES.;2
 3695   

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

      previous date%: "16-Nov-88 14:11:42" {DSK}<project>medley2.0>library>LOADPATCHES.;1)


(* ; "
Copyright (c) 1985, 1988, 1992 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  7-Feb-92 11:50 by bbb")


(* ;;; "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

                                                                          (DIRECTORYNAME 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  7-Feb-92 11:49 by bbb")


    (* ;; "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 1992))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (585 3524 (LoadPatches 595 . 2543) (COLLECT-PATCH-FILES 2545 . 3522)))))
STOP