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

(FILECREATED "12-Oct-2020 23:48:57" 
{DSK}<Users>kaplan>Local>medley3.5>lispcore>lispusers>COMPAREDIRECTORIES.;261
 60872  

      changes to%:  (FNS COMPAREDIRECTORIES CDFILES COMPAREDIRECTORIES.INFOS CDPRINT.LINE CDPRINT)

      previous date%: "12-Oct-2020 20:22:51" 
{DSK}<Users>kaplan>Local>medley3.5>lispcore>lispusers>COMPAREDIRECTORIES.;254)


(* ; "
Copyright (c) 1985, 1986, 1987, 1988, 1990, 1994, 1998, 2018, 2020 by Venue & Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT COMPAREDIRECTORIESCOMS)

(RPAQQ COMPAREDIRECTORIESCOMS

       (
        (* ;; "Compare the contents of two directories.")


        (FNS COMPAREDIRECTORIES CDFILES COMPAREDIRECTORIES.INFOS MATCHNAME)
        (FNS CDPRINT CDPRINT.LINE)
        (FNS CDMAP CDENTRY CDSUBSET)
        (FNS BINCOMP EOLTYPE)
        (RECORDS CDENTRY CDINFO)
        
        (* ;; "look for compiled files older than the sources")


        (FNS FIND-UNCOMPILED-FILES FIND-UNSOURCED-FILES FIND-SOURCE-FILES FIND-COMPILED-FILES 
             FIND-UNLOADED-FILES FIND-LOADED-FILES FIND-MULTICOMPILED-FILES)
        (FNS CREATED-AS SOURCE-FOR-COMPILED-P COMPILE-SOURCE-DATE-DIFF)
        (FNS FIX-DIRECTORY-DATES FIX-EQUIV-DATES COPY-COMPARED-FILES COPY-MISSING-FILES 
             COMPILED-ON-SAME-SOURCE)
        [VARS (ONESECOND (IDIFFERENCE (IDATE "1-Jan-2020 12:00:01")
                                (IDATE "1-Jan-2020 12:00:00"]
        (INITVARS (LASTCDENTRIES NIL))
        (COMS (FNS COMPARE-ENTRY-SOURCE-FILES)
              (FILES COMPARESOURCES))))



(* ;; "Compare the contents of two directories.")


(DEFINEQ

(COMPAREDIRECTORIES

  [LAMBDA (DIR1 DIR2 SELECT FILEPATTERNS EXTENSIONSTOAVOID USEDIRECTORYDATE OUTPUTFILE ALLVERSIONS)

                                                            (* ; "Edited 12-Oct-2020 23:48 by rmk:")


    (* ;; "Compare the contents of two directories, e.g., for change-control purposes.  Compares files matching FILEPATTERN (or *.*;) on DIR1 and DIR2, listing which is newer, or when one is not found on the other.  If SELECT is or contains SAME/=, BEFORE/<, AFTER/>, then files where DIR1 is the same as, earlier than, or later than DIR2 are selected. SELECT= NIL is the same as (<  >), T is the same as (< > =).  Also allows selection based on file-length criteria.")


    (* ;; "")


    (* ;; "Unless USEDIRECTORYDATE, comparison is with respect to the the LISP filecreated dates if evailable.")


    (* ;; "")


    (* ;; "If OUTPUTFILE is NIL, the list of compared entries is returned.  Otherwise the selected entries are printed on OUTPUTFILE (T for the display).")


    [SETQ SELECT (SELECTQ SELECT
                     (NIL '(< > -* *-))
                     (T '(< > -* *- =))
                     (FOR
 S IN
 (MKLIST SELECT) COLLECT
 (SELECTQ S
                                                                       ((AFTER >) 
                                                                            '>)
                                                                       ((BEFORE <) 
                                                                            '<)
                                                                       ((SAME SAMEDATE =) 
                                                                            '=)
                                                                       (AUTHOR 'AUTHOR)
                                                                       (-* '-*)
                                                                       (*- '*-)
                                                                       (ERROR 
                                                                      "UNRECOGNIZED SELECT PARAMETER"
                                                                              S]
    (PROG (INFOS1 INFOS2 CANDIDATES SELECTED COMPAREDATE)
          [SETQ COMPAREDATE (INTERSECTION SELECT '(< > =]

     (* ;; "DIRECTORYNAME here to get unrelativized specifications for header.")


          (SETQ DIR1 (OR (DIRECTORYNAME (OR DIR1 T))
                         (ERROR "DIRECTORY DOES NOT EXIST" DIR1)))
          (SETQ DIR2 (OR (DIRECTORYNAME (OR DIR2 T))
                         (ERROR "DIRECTORY DOES NOT EXIST" DIR2)))
          (PRINTOUT T "Comparing " DIR1 6 "vs. " DIR2 T "as of " (DATE)
                 " selecting " SELECT " ... ")
          (SETQ INFOS1 (COMPAREDIRECTORIES.INFOS
 (CDFILES
 DIR1 FILEPATTERNS EXTENSIONSTOAVOID
                                                            ALLVERSIONS)
                              USEDIRECTORYDATE))
          (SETQ INFOS2 (COMPAREDIRECTORIES.INFOS
 (CDFILES
 DIR2 FILEPATTERNS EXTENSIONSTOAVOID
                                                            ALLVERSIONS)
                              USEDIRECTORYDATE))
          (CL:UNLESS (AND INFOS2 INFOS1)
                 (RETURN))

     (* ;; "At this point the CAR of each info is the atomic match-name. Peel it off to produce candidate entries.")


     (* ;; 

   "Look through all of the I2's because multiple versions (if VERSIONS) have the same matchname")


          [SETQ CANDIDATES (FOR
 I1 IN
 INFOS1
                              JOIN
 (IF
 ALLVERSIONS
                                           THEN
 (OR (FOR
 I2 IN
 INFOS2
                                                           WHEN
 (EQ (CAR I2)
                                                                        (CAR I1))
                                                           COLLECT
 (LIST (CAR I1)
                                                                             (CDR I1)
                                                                             (CDR I2)))
                                                        (CONS (LIST (CAR I1)
                                                                    (CDR I1)
                                                                    NIL)))
                                         ELSE
 (CONS (LIST (CAR I1)
                                                              (CDR I1)
                                                              (CDR (ASSOC (CAR I1)
                                                                          INFOS2]

     (* ;; "Could be some 2's without 1's")


          (SORT [NCONC CANDIDATES (FOR
 I2 IN
 INFOS2 UNLESS
 (ASSOC (CAR I2)
                                                                              CANDIDATES)
                                     COLLECT
 (LIST (CAR I2)
                                                       NIL
                                                       (CDR I2]
                T)

     (* ;; "CANDIDATES is now a sorted list of the form (matchname entry1 entry2) where an entry consists of (fullname date length author)")


     (* ;; "Do the SELECT filtering and insert the date relation.")


          [SETQ SELECTED
           (FOR
 C MATCHNAME INFO1 INFO2 IDATE1 IDATE2 DATEREL BINCOMP IN
 CANDIDATES
              EACHTIME
 (SETQ MATCHNAME (POP
 C))
                    (SETQ INFO1 (POP
 C))
                    (SETQ INFO2 (POP
 C))
                    (IF
 (AND INFO1 INFO2)
                        THEN
 (SETQ IDATE1 (IDATE (FETCH
 DATE OF
 INFO1)))
                              (SETQ IDATE2 (IDATE (FETCH
 DATE OF
 INFO2)))
                              (SETQ DATEREL (IF
 (IGREATERP IDATE1 IDATE2)
                                                THEN
 '>
                                              ELSEIF
 (ILESSP IDATE1 IDATE2)
                                                THEN
 '<
                                              ELSE
 '=))
                      ELSE
 

                            (* ;; "Just for printing--no comparison")


                            (SETQ DATEREL '*))
              WHEN
 (IF
 (AND INFO1 INFO2)
                           THEN
 (OR (NULL COMPAREDATE)
                                        (SELECTQ DATEREL
                                            (> (MEMB '> SELECT))
                                            (< (MEMB '< SELECT))
                                            (= (MEMB '= SELECT))
                                            (SHOULDNT)))
                         ELSEIF
 INFO1
                           THEN
 

                                 (* ;; "OK if INFO2 is missing?")


                                 (MEMB '*- SELECT)
                         ELSE
 

                               (* ;; "OK if INFO1 is missing?")


                               (MEMB '-* SELECT))
              COLLECT
 (CREATE
 CDENTRY
                                 MATCHNAME _ MATCHNAME
                                 INFO1 _ INFO1
                                 DATEREL _ DATEREL
                                 INFO2 _ INFO2
                                 EQUIV _ (CL:UNLESS (EQ DATEREL '*)
                                             (BINCOMP
 (FETCH
 FULLNAME OF
 INFO1)
                                                    (FETCH
 FULLNAME OF
 INFO2)
                                                    T))]
          (PRINTOUT T (LENGTH SELECTED)
                 " entries" T)
          (PUSH
 SELECTED (LIST DIR1 DIR2 SELECT (DATE)))
          (SETQ LASTCDENTRIES SELECTED)
          (CL:UNLESS OUTPUTFILE (RETURN SELECTED))
          (RETURN (CDPRINT
 SELECTED OUTPUTFILE (MEMB 'AUTHOR SELECT SELECT])

(CDFILES

  [LAMBDA (DIR FILEPATTERNS EXTENSIONSTOAVOID ALLVERSIONS DEPTH)

                                                            (* ; "Edited 12-Oct-2020 23:48 by rmk:")


    (* ;; "Returns a list of fullnames for files that satisfy the criteria")


    (* ;; "For each name returned by (DIRECTORY DIR), assumes that FILEPATTERNS applies to the suffix after the directory (i.e. after NAMEPOS).  That includes possibly subdirectories, dotted files in ultimate file names, and versions.")


    (* ;; "     Exclude subdirectories unless FILEPATTERNS includes *>*")


    (* ;; "     Exclude dotted files (.xxx) unless FILEPATTERNS includes .*")


    (* ;; "     Exclude files with extensions in EXTENSIONSTOAVOID (*=NIL does no filtering)")


    (* ;; "     Exclude older versions unless ALLVERSIONS=T")


    (* ;; "  DEPTH is the number of subdirectories below the ones specified in DIR (NIL top-level of DIR only, T = any depth)")


    (* ;; "Resolve relative directories, so we can suppress subdirectory matches.   ")


    (SETQ EXTENSIONSTOAVOID (MKLIST (U-CASE EXTENSIONSTOAVOID)))
    [SETQ FILEPATTERNS (MKLIST (OR FILEPATTERNS '*]
    (FOR
 FP FN FPNAME FPEXT (TOPDIR _ (DIRECTORYNAME (OR DIR T))) IN
 FILEPATTERNS
       JOIN
 [SETQ FPNAME (U-CASE (OR (FILENAMEFIELD FP 'NAME)
                                         '*]
             [SETQ FPEXT (U-CASE (OR (FILENAMEFIELD FP 'EXTENSION)
                                     '*]
             (SETQ FN (PACKFILENAME.STRING 'VERSION (CL:IF ALLVERSIONS
                                                        '*
                                                        "")
                             'DIRECTORY TOPDIR 'NAME '* 'EXTENSION '*)) 

             (* ;; "DEPTH is the number of internal %">%"")


             [IF
 (OR (EQ DEPTH T)
                         (EQ FP '*))
                 THEN
 (SETQ DEPTH MAX.SMALLP)
               ELSEIF
 DEPTH
               ELSE
 (SETQ DEPTH (BIND
 (CNT _ 0)
                                           (POS _ 0)
                                           (FNDIR _ (FILENAMEFIELD FN 'DIRECTORY))
                                       WHILE
 (SETQ POS (STRPOS ">" FNDIR (ADD1 POS)))
                                       DO
 (ADD
 CNT 1) FINALLY
 (RETURN CNT]
             (FOR
 FULLNAME NAME EXT THISDEPTH IN
 (DIRECTORY FN)
                EACHTIME
 [SETQ NAME (U-CASE (FILENAMEFIELD FULLNAME 'NAME]
                      [SETQ EXT (U-CASE (FILENAMEFIELD FULLNAME 'EXTENSION]
                      (SETQ THISDEPTH (BIND
 (CNT _ 0)
                                             (POS _ 0)
                                             (FNDIR _ (FILENAMEFIELD FULLNAME 'DIRECTORY))
                                         WHILE
 (SETQ POS (STRPOS ">" FNDIR (ADD1 POS)))
                                         DO
 (ADD
 CNT 1) FINALLY
 (RETURN CNT))) 

                      (* ;; "An empty subdirectory may appear without name or extensions")

 WHEN
 (AND (OR NAME EXT)
               (OR (EQ FPNAME '*)
                   (EQ FPNAME NAME))
               (OR (EQ FPEXT '*)
                   (EQ FPEXT EXT))) UNLESS
 [OR (IGREATERP THISDEPTH DEPTH)
                                                   (AND EXT (OR (MEMB '* EXTENSIONSTOAVOID)
                                                                (MEMB EXT EXTENSIONSTOAVOID]
                COLLECT
 FULLNAME) FINALLY
 (CL:UNLESS $$VAL (PRINTOUT T 
                                                                          "No relevant files in " 
                                                                          TOPDIR T])

(COMPAREDIRECTORIES.INFOS

  [LAMBDA (FILES USEDIRECTORYDATE)
                      (* ; "Edited 12-Oct-2020 21:56 by rmk:")


    (* ;; "Value is a list of CDINFOS with the match-name consed on to the front")


    (FOR
 FULLNAME TYPE LDATE IN
 FILES
       COLLECT
 

             (* ;; "GDATE/IDATE in case Y2K")


             (SETQ LDATE (FILEDATE FULLNAME))                (* ; "Is it a Lisp file?")

             (CONS (MATCHNAME
 FULLNAME)
                   (CREATE
 CDINFO
                          FULLNAME _ FULLNAME
                          DATE _ [GDATE (IDATE (IF
 USEDIRECTORYDATE
                                                   THEN
 (GETFILEINFO FULLNAME 'CREATIONDATE)
                                                 ELSEIF
 (OR LDATE (GETFILEINFO FULLNAME
                                                                             'CREATIONDATE]
                          LENGTH _ (GETFILEINFO FULLNAME 'LENGTH)
                          AUTHOR _ (GETFILEINFO FULLNAME 'AUTHOR)
                          TYPE _ (IF
 LDATE
                                     THEN
 (CL:IF (MEMB (FILENAMEFIELD FULLNAME 'EXTENSION)
                                                           *COMPILED-EXTENSIONS*)
                                                  'COMPILED
                                                  'SOURCE)
                                   ELSE
 (PRINTFILETYPE FULLNAME])

(MATCHNAME

  [LAMBDA (NAME)
                                        (* ; "Edited  5-Sep-2020 13:41 by rmk:")


    (* ;; "The NAME.DIR for matching related files")


    (LET ((M (PACKFILENAME 'HOST NIL 'VERSION NIL 'DIRECTORY NIL 'BODY NAME)))

         (* ;; "Strip off the nuisance period")


         (CL:IF (EQ (CHARCODE %.)
                    (NTHCHARCODE M -1))
             (SUBATOM M 1 -2)
             M)])
)
(DEFINEQ

(CDPRINT

  [LAMBDA (CDENTRIES FILE PRINTAUTHOR)
                  (* ; "Edited 12-Oct-2020 21:47 by rmk:")


    (* ;; "Typically CDENTRIES will have a header.  If not, we fake one up, at least for the directories and today's date.")


    (CL:UNLESS CDENTRIES
        (PRINTOUT T T "Note:  Using LASTCDENTRIES" T T)
        (SETQ CDENTRIES LASTCDENTRIES))
    (RESETLST
        (LET (INFO1 TEXT STREAM DATE1POS ENDDATE1 DIR1 DIR2 (HEADER (CAR CDENTRIES)))
             (CL:UNLESS (STRINGP (CADR HEADER))
                 (SETQ HEADER (LIST [FOR
 E IN
 CDENTRIES WHEN
 (FETCH
 INFO1
                                                                            OF
 E)
                                       DO
 (RETURN (PACKFILENAME 'NAME NIL 'EXTENSION NIL
                                                             'VERSION NIL 'BODY
                                                             (FETCH
 FULLNAME
                                                                OF
 (FETCH
 INFO1 OF
 E]
                                    [FOR
 E IN
 CDENTRIES WHEN
 (FETCH
 INFO2
                                                                            OF
 E)
                                       DO
 (RETURN (PACKFILENAME 'NAME NIL 'EXTENSION NIL
                                                             'VERSION NIL 'BODY
                                                             (FETCH
 FULLNAME
                                                                OF
 (FETCH
 INFO2 OF
 E]
                                    NIL
                                    (DATE)))
                 (PUSH
 CDENTRIES HEADER))
             (SETQ DIR1 (CAR HEADER))
             (SETQ DIR2 (CADR HEADER))
             (CL:UNLESS (SETQ STREAM (GETSTREAM FILE 'OUTPUT T))
                 [RESETSAVE (SETQ STREAM (OPENSTREAM (PACKFILENAME 'EXTENSION 'TXT 'BODY FILE)
                                                'OUTPUT
                                                'NEW))
                        '(PROGN (CLOSEF? OLDVALUE])
             (CL:WHEN DIR1
                 (PRINTOUT STREAM "Comparing " DIR1 6 "vs. " DIR2 T "as of " (CADDDR HEADER))
                 (CL:WHEN (CADDR HEADER)
                     (PRINTOUT STREAM " selecting " (CADDR HEADER)))
                 (PRINTOUT STREAM -2 (LENGTH (CDR CDENTRIES))
                        " entries" T T))
             (LINELENGTH 1000 STREAM)                        (* ; "Don't wrap")


             (* ;; "DATE1POS is the position of the first character of INFO1's date, used for tabbing.  We have to measure the filename, date, size, and author if desired")


             (IF
 (CDR CDENTRIES)
                 THEN
 (FOR
 E INFO1 (MAXDATE1WIDTH _ 0)
                                 (SPACEWIDTH _ 1)
                                 (PARENWIDTH _ 2) IN
 (CDR CDENTRIES)
                             WHEN
 (SETQ INFO1 (FETCH
 INFO1 OF
 E))
                             LARGEST
 [SETQ MAXDATE1WIDTH (IMAX MAXDATE1WIDTH
                                                                   (NCHARS (FETCH
 DATE
                                                                              OF
 INFO1]
                                   (IPLUS (NCHARS (PACKFILENAME 'HOST NIL 'DIRECTORY NIL 'BODY
                                                         (FETCH
 FULLNAME OF
 INFO1)))
                                          (NCHARS (FETCH
 LENGTH OF
 INFO1))
                                          (CL:IF PRINTAUTHOR
                                              (IPLUS SPACEWIDTH PARENWIDTH
                                                     (NCHARS (FETCH
 AUTHOR OF
 INFO1)))
                                              0)) FINALLY
 

                                                        (* ;; 

                            "First 4 for width of equiv.  $$EXTREME is NIL if there are no INFO1's")


                                                        (SETQ DATE1POS (IPLUS (OR $$EXTREME 10)
                                                                              4
                                                                              (ITIMES 3 SPACEWIDTH)))
                                                        (SETQ ENDDATE1 (IPLUS DATE1POS MAXDATE1WIDTH)
                                                         ))
                       (FOR
 E IN
 (CDR CDENTRIES) DO
 (CDPRINT.LINE
 STREAM E 
                                                                       PRINTAUTHOR DATE1POS ENDDATE1)
                              )
               ELSE
 (PRINTOUT T "CDENTRIES is empty" T))
             (AND STREAM (CLOSEF? STREAM))))])

(CDPRINT.LINE

  [LAMBDA (STREAM ENTRY PRINTAUTHOR DATE1POS ENDDATE1)
  (* ; "Edited 12-Oct-2020 21:47 by rmk:")


    (* ;; "Format one line of the directory comparison listing.  If PRINTAUTHOR and AUTHOR1 or AUTHOR2 are non-NIL, list the author in parens; otherwise omit it.")


    (LET ((INFO1 (FETCH
 INFO1 OF
 ENTRY))
          (INFO2 (FETCH
 INFO2 OF
 ENTRY))
          EQUIV)
         (SETQ EQUIV (FETCH
 EQUIV OF
 ENTRY))
         (PRINTOUT STREAM (SELECTQ EQUIV
                              (T "==")
                              (NIL "  ")
                              (IF
 (EQUAL EQUIV '(CR LF))
                                  THEN
 "CL"
                                ELSEIF
 (EQUAL EQUIV '(LF CR))
                                  THEN
 "LC"
                                ELSEIF
 (EQ 'CRLF (CAR EQUIV))
                                  THEN
 (CONCAT "2" (CL:IF (EQ 'CR (CADR EQUIV))
                                                           'L
                                                           'C))
                                ELSE
 

                                      (* ;; "CADR must be CRLF")


                                      (CONCAT (CL:IF (EQ 'CR (CAR EQUIV))
                                                  'L
                                                  'C)
                                             "2")))
                " ")
         (CL:WHEN INFO1
             (PRINTOUT STREAM (PACKFILENAME 'HOST NIL 'DIRECTORY NIL 'BODY (FETCH
 FULLNAME
                                                                              OF
 INFO1))
                    " ")
             (CL:WHEN PRINTAUTHOR
                 (PRINTOUT STREAM "(" (FETCH
 AUTHOR OF
 INFO1)
                        ") "))
             (PRINTOUT STREAM (FETCH
 LENGTH OF
 INFO1)
                    .TAB0 DATE1POS (FETCH
 DATE OF
 INFO1)))
         (PRINTOUT STREAM .TAB0 ENDDATE1 "  " (FETCH
 DATEREL OF
 ENTRY)
                "  ")
         (CL:WHEN INFO2
             (PRINTOUT STREAM (FETCH
 DATE OF
 INFO2)
                    "   "
                    (PACKFILENAME 'HOST NIL 'DIRECTORY NIL 'BODY (FETCH
 FULLNAME OF
 INFO2))
                    " ")
             (CL:WHEN PRINTAUTHOR
                 (PRINTOUT STREAM "(" (FETCH
 AUTHOR OF
 INFO2)
                        ") "))
             (PRINTOUT STREAM (FETCH
 LENGTH OF
 INFO2)))
         (TERPRI STREAM])
)
(DEFINEQ

(CDMAP

  [LAMBDA (CDENTRIES FN)
                                (* ; "Edited  6-Sep-2020 15:58 by rmk:")

    (CL:UNLESS CDENTRIES
        (PRINTOUT T T "Note:  Using LASTCDENTRIES" T T)
        (SETQ CDENTRIES LASTCDENTRIES))
    (FOR
 CDE MATCHNAME INFO1 DATEREL INFO2 EQUIV IN
 (CDR CDENTRIES)
       DECLARE
 (SPECVARS MATCHNAME INFO1 DATEREL INFO2 EQUIV)
       EACHTIME
 (SETQ MATCHNAME (FETCH
 MATCHNAME OF
 CDE))
             (SETQ INFO1 (FETCH
 INFO1 OF
 CDE))
             (SETQ DATEREL (FETCH
 DATEREL OF
 CDE))
             (SETQ INFO2 (FETCH
 INFO2 OF
 CDE))
             (SETQ EQUIV (FETCH
 EQUIV OF
 CDE)) DO
 (APPLY* FN CDE])

(CDENTRY

  [LAMBDA (MATCHNAME
 CDENTRIES)
                     (* ; "Edited  5-Sep-2020 21:09 by rmk:")

    (ASSOC MATCHNAME (OR CDENTRIES LASTCDENTRIES])

(CDSUBSET

  [LAMBDA (CDENTRIES FN)
                                (* ; "Edited 15-Sep-2020 13:49 by rmk:")

    (CL:UNLESS CDENTRIES
        (PRINTOUT T T "Note:  Using LASTCDENTRIES" T T)
        (SETQ CDENTRIES LASTCDENTRIES))
    (CONS (CAR CDENTRIES)
          (FOR
 CDE MATCHNAME INFO1 DATEREL INFO2 EQUIV IN
 (CDR CDENTRIES)
             DECLARE
 (SPECVARS MATCHNAME INFO1 DATEREL INFO2 EQUIV)
             EACHTIME
 (SETQ MATCHNAME (FETCH
 MATCHNAME OF
 CDE))
                   (SETQ INFO1 (FETCH
 INFO1 OF
 CDE))
                   (SETQ DATEREL (FETCH
 DATEREL OF
 CDE))
                   (SETQ INFO2 (FETCH
 INFO2 OF
 CDE))
                   (SETQ EQUIV (FETCH
 EQUIV OF
 CDE)) WHEN
 (APPLY* FN CDE) COLLECT

                                                                                      CDE])
)
(DEFINEQ

(BINCOMP

  [LAMBDA (FILE1 FILE2 EOLDIFFOK)
                       (* ; "Edited 12-Oct-2020 17:14 by rmk:")


    (* ;; "Returns T if FILE1 and FILE2 are byte-equivalent.  Returns EOLDIFF if they are byte equivalent except for CR/LF/CRLF exchanges.  ")


    (IF
 (IEQP (GETFILEINFO FILE1 'LENGTH)
                  (GETFILEINFO FILE2 'LENGTH))
        THEN
 [CL:WITH-OPEN-FILE
                  (STREAM1 FILE1 :DIRECTION :INPUT)
                  (CL:WITH-OPEN-FILE
                   (STREAM2 FILE2 :DIRECTION :INPUT)
                   (SETFILEINFO STREAM1 'ENDOFSTREAMOP (FUNCTION NILL))
                   (BIND
 B1 B2 EOL1 EOL2 EOLDIFF WHILE
 (SETQ B1 (\BIN STREAM1))
                      UNLESS
 (EQ B1 (SETQ B2 (\BIN STREAM2)))
                      DO
 (CL:UNLESS (AND EOLDIFFOK (SELCHARQ B1
                                                            (CR (CL:WHEN (EQ EOL1 'LF)
                                                                       (RETURN NIL))
                                                                (SETQ EOL1 'CR)
                                                                (SETQ EOL2 'LF)
                                                                (EQ B2 (CHARCODE LF)))
                                                            (LF (CL:WHEN (EQ EOL1 'CR)
                                                                       (RETURN NIL))
                                                                (SETQ EOL1 'LF)
                                                                (SETQ EOL2 'CR)
                                                                (EQ B2 (CHARCODE CR)))
                                                            NIL))
                                    (RETURN NIL))
                            (CL:UNLESS EOLDIFF
                                (SETQ EOLDIFF (LIST EOL1 EOL2))) FINALLY
 (RETURN (OR EOLDIFF T]
      ELSEIF
 EOLDIFFOK
        THEN


        (* ;; "Lengths are different possibly because of CRLF to CR/LF substitutions.")


        (* ;; 

      "More complex code could detect the EOLTYPE incrementally without separate passes, but ...")


        (LET ((EOL1 (EOLTYPE
 FILE1))
              (EOL2 (EOLTYPE
 FILE2)))
             (CL:WHEN (IF
 [AND (EQ EOL1 'CRLF)
                                   (MEMB EOL2 '(LF CR]
                        ELSEIF
 [AND (EQ EOL2 'CRLF)
                                        (MEMB EOL1 '(LF CR]
                          THEN
 (SWAP
 FILE1 FILE2))

                 (* ;; "FILE1 is now CRLF, FILE2 is not.  If FILE1 isn't longer, it can't have a CRLF that corresponds to a CR or LF.")


                 (CL:WHEN (IGREATERP (GETFILEINFO FILE1 'LENGTH)
                                 (GETFILEINFO FILE2 'LENGTH))
                     [CL:WITH-OPEN-FILE (STREAM1 FILE1 :DIRECTION :INPUT)
                            (CL:WITH-OPEN-FILE (STREAM2 FILE2 :DIRECTION :INPUT)
                                   (SETFILEINFO STREAM1 'ENDOFSTREAMOP (FUNCTION NILL))
                                   (BIND
 B1 B2 EOLDIFF WHILE
 (SETQ B1 (\BIN STREAM1))
                                      UNLESS
 (EQ B1 (SETQ B2 (\BIN STREAM2)))
                                      DO
 (CL:UNLESS [AND (EQ (CHARCODE CR)
                                                                 B1)
                                                             (EQ (CHARCODE LF)
                                                                 (\BIN STREAM1))
                                                             (MEMB B2 (CHARCODE (CR LF]
                                                    (RETURN NIL))
                                            (CL:UNLESS EOLDIFF
                                                (SETQ EOLDIFF (LIST EOL1 EOL2)))
                                      FINALLY
 (RETURN (OR EOLDIFF T]))])

(EOLTYPE

  [LAMBDA (FILE)
                                        (* ; "Edited  3-Sep-2020 17:05 by rmk:")


    (* ;; "Returns the EOLCONVENTION of FILE if it only sees one kind, NIL if it can't decide.")


    (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT)
           (SETFILEINFO STREAM 'ENDOFSTREAMOP (FUNCTION NILL))
           (BIND
 EOLTYPE
              DO
 (SELCHARQ (OR (\BIN STREAM)
                                   (RETURN EOLTYPE))
                          (CR (IF
 (EQ (CHARCODE LF)
                                          (\PEEKBIN STREAM T))
                                  THEN
 (CL:WHEN (MEMB EOLTYPE '(LF CR))
                                                  (RETURN NIL))
                                        (\BIN STREAM)
                                        (SETQ EOLTYPE 'CRLF)
                                ELSEIF
 (MEMB EOLTYPE '(LF CRLF))
                                  THEN
 (RETURN NIL)
                                ELSE
 (SETQ EOLTYPE 'CR)))
                          (LF (CL:WHEN (MEMB EOLTYPE '(CR CRLF))
                                     (RETURN NIL))
                              (SETQ EOLTYPE 'LF))
                          NIL])
)
(DECLARE%: EVAL@COMPILE

(RECORD CDENTRY
 (MATCHNAME INFO1 DATEREL INFO2 . EQUIV))

(RECORD CDINFO
 (FULLNAME DATE LENGTH AUTHOR TYPE))
)



(* ;; "look for compiled files older than the sources")


(DEFINEQ

(FIND-UNCOMPILED-FILES

  [LAMBDA (FILES DFASLMARGIN COMPILEEXTS)
               (* ; "Edited 20-Sep-2020 23:04 by rmk:")

                                                             (* ; "Edited  3-Nov-94 15:17 by jds")


    (* ;; "Produces a list of the source files in FILES that have no corresponding compiled file")


    (* ;; "This determines whether there is at least one compiled file.  If there are two or more, that's a problem")


    (* ;; "We want the most recent version only")


    (* ;; "Source files have a 2-element created-as with a non-NIL date")


    (SETQ FILES (FOR
 F IN
 (OR (LISTP FILES)
                                      (FILDIR FILES)) UNLESS
 (MEMB (SETQ F (PACKFILENAME
                                                                                'VERSION NIL
                                                                                'BODY F))
                                                                       $$VAL) COLLECT
 F))
    (FOR
 F SCREATION FILES IN
 FILES WHEN
 (AND (CADR (SETQ SCREATION (CREATED-AS

                                                                                 F)))
                                                          (NOT (CDDR SCREATION)))
       WHEN
 [SETQ FILES
                 (FOR
 CEXT CF IN
 (OR COMPILEEXTS *COMPILED-EXTENSIONS*)
                    WHEN
 (SETQ CF (INFILEP (PACKFILENAME 'EXTENSION CEXT 'VERSION NIL
                                                      'BODY F)))
                    COLLECT
 (CL:WHEN (SOURCE-FOR-COMPILED-P
 SCREATION CF DFASLMARGIN)
                                       (RETURN NIL))
                          CF
                    FINALLY
 

                          (* ;; "If we found some compiled files, they weren't on this source.  If there weren't any compiled files to check, maybe there weren't any functions.")


                          (* ;; 

      "NLSETQ because we don't want to stop if there is an error, typically from a package problem")


                          (RETURN (OR $$VAL (LET [(FCOMS (CAR (NLSETQ (GETDEF (FILECOMS F)
                                                                             'VARS F]
                                                 (IF
 (NULL FCOMS)
                                                     THEN
 

                                                           (* ;; 

                                               "GETDEF caused an error.  Maybe a package problem. ")


                                                           (AND NIL 'NOCOMMANDS)
                                                   ELSEIF
 (INFILECOMS? NIL '(FUNCTIONS FNS)
                                                                     FCOMS)
                                                     THEN
 T]
       COLLECT
 (CONS F (SELECTQ FILES
                               (T NIL)
                               (NOCOMMANDS (CONS "No commands"))
                               (FOR
 CF IN
 FILES COLLECT
 

                                                        (* ;; 

           "Positive means that compiled is later than source, normal order but maybe by too much.")


                                                              (* ;; 

                                            "Negative means that compiled came before source.  Odd")


                                                              (LIST CF (COMPILE-SOURCE-DATE-DIFF

                                                                        CF SCREATION])

(FIND-UNSOURCED-FILES

  [LAMBDA (FILES DFASLMARGIN COMPILEEXTS)
               (* ; "Edited 15-Sep-2020 15:32 by rmk:")

                                                             (* ; "Edited  3-Nov-94 15:17 by jds")


    (* ;; 

  "Produces a list of compiled FILES for which no source file can be found in the same directory.")


    (* ;; "The source date in at least one DFASL was off by a second, maybe some sort of IDATE rounding?  So, give a margin.")


    (* ;; 

"We want the most recent version only.  Check CREATED-AS to make sure it really is a compiled file.")


    (* ;; "Sort to get lcoms and dfasls next to each other.")


    (LET (CCREATEDS)
         (SETQ CCREATEDS (FOR
 CEXT FOUND CCREATED INSIDE
 (OR COMPILEEXTS 
                                                                     *COMPILED-EXTENSIONS*)
                            JOIN
 (FOR
 CF IN
 [OR (LISTP FILES)
                                                            (FILDIR (PACKFILENAME 'EXTENSION CEXT
                                                                           'VERSION "" 'BODY
                                                                           '*]
                                        WHEN
 (CDDR (SETQ CCREATED (CREATED-AS
 CF)))
                                        UNLESS
 (MEMBER CCREATED $$VAL) COLLECT
 CCREATED)))

         (* ;; "CCREATEDS is now a list of CREATED-AS items")


         (FOR
 CC SF IN
 CCREATEDS UNLESS
 (AND [SETQ SF (INFILEP (PACKFILENAME 'EXTENSION 
                                                                                  NIL 'VERSION NIL
                                                                                  'BODY
                                                                                  (CAR CC]
                                                         (SOURCE-FOR-COMPILED-P
 (SETQ SF
                                                                                     (CREATED-AS

                                                                                      SF))
                                                                CC DFASLMARGIN))
            COLLECT
 [LIST (CAR CC)
                              (AND SF (LIST (CAR SF)
                                            (ROUND (COMPILE-SOURCE-DATE-DIFF
 CC SF]
            FINALLY
 (RETURN (SORT $$VAL (FUNCTION (LAMBDA (CF1 CF2)
                                                        (ALPHORDER (FILENAMEFIELD (CAR CF1)
                                                                          'NAME)
                                                               (FILENAMEFIELD (CAR CF2)
                                                                      'NAME])

(FIND-SOURCE-FILES

  [LAMBDA (CFILES SDIRS DFASLMARGIN)
                    (* ; "Edited  9-Sep-2020 12:26 by rmk:")


    (* ;; "Returns (CFILE . SFILES) pairs where CFILE is a Lisp compiled file in CFILES SFILES is a list of source files in SDIRS that CFILE was compiled on.")


    (* ;; "This suggests that one of CFILES should be copied to the SFILE directory.")


    (SETQ SDIRS (FOR
 SD INSIDE
 (OR SDIRS T) COLLECT
 (DIRECTORYNAME SD)))
    (SORT (FOR
 CF SFILES CNAME CCREATED IN
 (OR (LISTP CFILES)
                                                       (FILDIR CFILES))
             WHEN
 (AND (SETQ CNAME (INFILEP CF))
                           (CDDR (SETQ CCREATED (CREATED-AS
 CF)))
                           (SETQ SFILES (FOR
 SD SF IN
 SDIRS
                                           WHEN
 (AND (SETQ SF (INFILEP (PACKFILENAME
                                                                            'NAME
                                                                            (FILENAMEFIELD
                                                                             CF
                                                                             'NAME)
                                                                            'BODY SD)))
                                                         (SOURCE-FOR-COMPILED-P
 SF CCREATED 
                                                                DFASLMARGIN)) COLLECT
 SF)))
             COLLECT
 (CONS CNAME SFILES))
          (FUNCTION (LAMBDA (P1 P2)
                      (ALPHORDER (FILENAMEFIELD (CAR P1))
                             (FILENAMEFIELD (CAR P2])

(FIND-COMPILED-FILES

  [LAMBDA (SFILES CDIRS DFASLMARGIN)
                    (* ; "Edited  9-Sep-2020 12:26 by rmk:")


    (* ;; "Returns (SFILE . CFILES) pairs where SFILE is a Lisp source file in SFILES CFILES is a list of compiled files in CDIRS that were compiled on SFILE.")


    (* ;; "FILEDATE is true for source files and compiled files")


    (* ;; "This suggests that one of CFILES should be copied to the SFILE directory.")


    (SETQ CDIRS (FOR
 CD INSIDE
 (OR CDIRS T) COLLECT
 (DIRECTORYNAME CD)))
    (SORT (FOR
 SF CFILES SNAME SCREATED IN
 (OR (LISTP SFILES)
                                                       (FILDIR SFILES))
             WHEN
 [AND (SETQ SNAME (INFILEP SF))
                           (SETQ SCREATED (CREATED-AS
 SF))
                           (NOT (CDDR SCREATED))
                           (SETQ CFILES (FOR
 CEXT (ROOT _ (FILENAMEFIELD SNAME 'NAME))
                                           IN
 *COMPILED-EXTENSIONS*
                                           JOIN
 (FOR
 CD CF IN
 CDIRS
                                                       WHEN
 (AND (SETQ CF
                                                                      (INFILEP (PACKFILENAME
                                                                                'NAME ROOT
                                                                                'EXTENSION CEXT
                                                                                'BODY CD)))
                                                                     (SOURCE-FOR-COMPILED-P

                                                                      SCREATED CF DFASLMARGIN))
                                                       COLLECT
 CF] COLLECT
 (CONS SNAME CFILES
                                                                                         ))
          (FUNCTION (LAMBDA (P1 P2)
                      (ALPHORDER (FILENAMEFIELD (CAR P1))
                             (FILENAMEFIELD (CAR P2])

(FIND-UNLOADED-FILES

  [LAMBDA (FILES)
                                       (* ; "Edited  9-Sep-2020 19:35 by rmk:")


    (* ;; "Returns the files in FILES that don't have FILECREATED properties and presumably are therefore not loaded in the current sysout.")


    (FOR
 F IN
 (OR (LISTP FILES)
                          (FILDIR FILES)) WHEN
 (AND (SETQ F (INFILEP (CL:IF (LISTP F)
                                                                             (CAR F)
                                                                             F)))
                                                        (FILEDATE F))
       UNLESS
 (GETP (FILENAMEFIELD F 'NAME)
                        'FILEDATES) COLLECT
 F])

(FIND-LOADED-FILES

  [LAMBDA (ROOTFILENAMES)
                               (* ; "Edited 19-Sep-2020 07:20 by rmk:")

    (FOR
 RN INSIDE
 ROOTFILENAMES WHEN
 (GETP RN 'FILEDATES)
       COLLECT
 (CONS RN (FOR
 F IN
 LOADEDFILELST WHEN
 (EQ RN (FILENAMEFIELD
                                                                             F
                                                                             'NAME)) COLLECT

                                                                                     F])

(FIND-MULTICOMPILED-FILES

  [LAMBDA (FILES SHOWINFO)
                              (* ; "Edited 20-Sep-2020 20:57 by rmk:")


    (* ;; "Returns a list of names for files in FILES that have multiple compilations")


    (LET (SFILES)
         (FOR
 F EXT NAME IN
 (OR (LISTP FILES)
                                        (FILDIR FILES)) WHEN
 (MEMB (SETQ EXT (FILENAMEFIELD
                                                                                  F
                                                                                  'EXTENSION))
                                                                       *COMPILED-EXTENSIONS*)
            DO
 (SETQ NAME (FILENAMEFIELD F 'NAME)) 

                  (* ;; "PUSHNEW because we haven't filtered out versions")


                  (PUSHNEW
 [CDR (OR (ASSOC NAME SFILES)
                                        (CAR (PUSH
 SFILES (CONS NAME]
                         EXT))
         (FOR
 S IN
 SFILES WHEN
 (CDDR S)
            COLLECT
 (IF
 SHOWINFO
                            THEN
 `[,(CAR S)
                                       ,(CADAR (FIND-LOADED-FILES
 (CAR S)))
                                       ,(CREATED-AS
 (CAR S))
                                       ,@(FOR
 EXT IN
 (SORT (CDR S))
                                            COLLECT
 (CREATED-AS
 (PACKFILENAME 'EXTENSION EXT
                                                                               'BODY
                                                                               (CAR S]
                          ELSE
 (CAR S])
)
(DEFINEQ

(CREATED-AS

  [LAMBDA (FILE)
                                        (* ; "Edited 20-Sep-2020 23:06 by rmk:")


    (* ;; "For lisp source files, returns (filecreatename filecreateddate)")


    (* ;; "For lisp compiled files, returns (cfilename cfiledate sfilecreatename sfilecreateddate)")


    (* ;; "For other files, (fullfilename NIL)")


    (* ;; "The cfilename is just the current directory name for DFASLs.")


    (* ;; "So:  (CADR value) is non-NIL for Lisp files.  Of those, (CDDR value) is non-NIL for compiled files.")


    (* ;; "We disable the package delimiter because the atoms in changes may have a packages that we don't know.")


    (CL:WITH-OPEN-FILE
     (STREAM FILE :DIRECTION :INPUT)
     (LET
      (FILEDATE FILENAME SOURCEDATE SOURCENAME LINE POS)
      [IF
 (EQ (CHARCODE %()
                  (SKIPSEPRCODES STREAM))
          THEN
                                           (* ; "Managed source or LCOM")

          (RESETLST
              [LET (FORM SFORM (RDTBL (FIND-READTABLE "OLD-INTERLISP-FILE")))
                   (SETQ POS (GETFILEPTR STREAM))
                   (READCCODE STREAM)
                   (IF
 (EQ 'DEFINE-FILE-INFO (RATOM STREAM RDTBL))
                       THEN
 

                             (* ;; "Reading is package-safe")


                             (SETFILEPTR STREAM POS)
                             (SETQ FORM (READ STREAM RDTBL))
                             (SETQ RDTBL (FIND-READTABLE (LISTGET (CDR FORM)
                                                                :READTABLE)))
                     ELSE
 (SETFILEPTR STREAM POS))
                   (CL:WHEN (EQ 'PACKAGEDELIM (GETSYNTAX '%: RDTBL))
                       [RESETSAVE (SETSYNTAX '%: 'OTHER RDTBL)
                              `(SETSYNTAX %: PACKAGEDELIM ,RDTBL])

                   (* ;; "One way or the other, we're ready for the filecreated")


                   (CL:WHEN (EQ (CHARCODE %()
                                (SKIPSEPRCODES STREAM))
                       (SETQ FORM (READ STREAM RDTBL))
                       (CL:WHEN (MEMB (U-CASE (CAR FORM))
                                      '(FILECREATED IL%:FILECREATED))

                           (* ;; "IL%%:FILECREATED because we screwed the readtable.")


                           (IF
 [STREQUAL "compiled on " (CAR (LISTP (CADDR FORM]
                               THEN
                      (* ; "LCOM, get source info")

                                     (IF
 [AND (EQ (CHARCODE %()
                                                      (SKIPSEPRCODES STREAM))
                                                  (MEMB [U-CASE (CAR (SETQ SFORM (READ STREAM RDTBL]
                                                        '(FILECREATED IL%:FILECREATED]
                                         THEN
 (SETQ FILENAME (FULLNAME STREAM))
                                               (SETQ FILEDATE (CADR FORM))
                                               (SETQ SOURCENAME (CADDR SFORM))
                                               (SETQ SOURCEDATE (CADR SFORM))
                                       ELSE
 (SETQ FILENAME (FULLNAME STREAM))
                                             (SETQ FILEDATE (CADR FORM)))
                             ELSE
 (SETQ FILENAME (CADDR FORM))
                                   (SETQ FILEDATE (CADR FORM)))))])
        ELSEIF
 (SETQ POS (STRPOS "XCL Compiler output for source file " (SETQ LINE (CL:READ-LINE
                                                                                        STREAM))
                                    1 NIL NIL T))
          THEN
                                           (* ; "DFASL compiled?")

                (SETQ SOURCENAME (SUBATOM LINE POS))
                (CL:WHEN (SETQ POS (STRPOS "Source file created " (SETQ LINE (CL:READ-LINE STREAM))
                                          1 NIL NIL T))
                    [SETQ SOURCEDATE (GDATE (IDATE (SUBSTRING LINE POS]
                    (CL:WHEN (SETQ POS (STRPOS "FASL file created " (SETQ LINE (CL:READ-LINE STREAM))
                                              1 NIL NIL T))
                        [SETQ FILEDATE (GDATE (IDATE (SUBSTRING LINE POS]))]

      (* ;; "Revert filenames to Interlisp package if needed:")


      (CL:WHEN (STRPOS "IL:" FILENAME)
          (SETQ FILENAME (SUBATOM FILENAME 4)))
      (CL:WHEN (STRPOS "IL:" SOURCENAME)
          (SETQ SOURCENAME (MKATOM SOURCENAME 4)))

      (* ;; "Return DATE NIL if file is not a Lisp file")


      `(,(OR FILENAME (FULLNAME STREAM))
        ,(AND FILEDATE (GDATE (IDATE FILEDATE)))
        ,@(CL:WHEN SOURCENAME
              (LIST SOURCENAME (GDATE (IDATE SOURCEDATE))))])

(SOURCE-FOR-COMPILED-P

  [LAMBDA (SOURCE COMPILED DFASLMARGIN)
                 (* ; "Edited 21-Sep-2020 16:56 by rmk:")


    (* ;; "There seems to be some variation between the source dates in dfasl files and the filecreated date in the sources, they often don't match exactly.  But if they are within DFASLMARGIN, we assume a match.  We require exact date match for LCOMS")


    (* ;; "This is needed for dfasl files created before they recorded the source filecreated name and date instead of the directory source name and date when compile took place.")


    (* ;; "")


    (* ;; "DFASLMARGIN is a pair (after before) where we assume a match if the compiled date is no more than after minutes after the source date and no more than before minuts before (the diff is negative then).")


    (* ;; "A single positive integer x is interpreted as (x 0).  A single negative integer x is interpreted as (-x x) (before or after x).")


    (* ;; "Default is (20 0).")


    (* ;; "T is positive or negative infinity")


    (CL:UNLESS (LISTP SOURCE)
        (SETQ SOURCE (CREATED-AS
 SOURCE)))
    (CL:UNLESS (LISTP COMPILED)
        (SETQ COMPILED (CREATED-AS
 COMPILED)))
    (SETQ DFASLMARGIN (IF
 (NULL DFASLMARGIN)
                          THEN
 

                                (* ;; 

                       "If compiled is later than source by less than 20 minutes, it's probably OK")


                                '(20 0)
                        ELSEIF
 (LISTP DFASLMARGIN)
                        ELSEIF
 (IGREATERP DFASLMARGIN 0)
                          THEN
 (LIST DFASLMARGIN 0)
                        ELSEIF
 (MINUSP DFASLMARGIN)
                          THEN
 (LIST (MINUS DFASLMARGIN)
                                         DFASLMARGIN)))
    (OR (EQUAL (CAR SOURCE)
               (CADDR COMPILED))
        (EQUAL (CADR SOURCE)
               (CADDDR COMPILED))
        (AND [EQ 'DFASL (U-CASE (FILENAMEFIELD (CAR COMPILED)
                                       'EXTENSION]
             (LET ((TIMEDIFF (COMPILE-SOURCE-DATE-DIFF
 COMPILED SOURCE)))

                  (* ;; "If compiled was no more than 20 minutes later, it's probably OK.  Of no more than DFASLMARGIN earlier, if it is negative.")


                  (AND (OR (EQ T (CAR DFASLMARGIN))
                           (LEQ TIMEDIFF (CAR DFASLMARGIN)))
                       (OR (EQ T (CADR DFASLMARGIN))
                           (GEQ TIMEDIFF (CADR DFASLMARGIN])

(COMPILE-SOURCE-DATE-DIFF

  [LAMBDA (CFILE SFILE)
                                 (* ; "Edited 20-Sep-2020 22:59 by rmk:")


    (* ;; "Positive means that compiled is later than source, normal order but maybe by too much. Negative means that compiled came before source, i.e., compiled on a source that didn't yet exist.")


    (* ;; "Value is in minutes")


    (ROUND (FQUOTIENT [IDIFFERENCE [IDATE (CADDDR (OR (LISTP CFILE)
                                                      (CREATED-AS
 CFILE]
                             (IDATE (CADR (OR (LISTP SFILE)
                                              (CREATED-AS
 SFILE]
                  (TIMES 60 ONESECOND])
)
(DEFINEQ

(FIX-DIRECTORY-DATES

  [LAMBDA (FILES)
                                       (* ; "Edited  6-Sep-2020 15:08 by rmk:")


    (* ;; "For Lisp source and compiled files, ensures that the directory file date corresponds to the  filecreated date. Returns the list of files whose dates were changed.")


    (* ;; "This allows for the fact that directory dates that  are no later than, say, 30 seconds of the filecreated date are probably OK--the directory date may be set when the file is closed.")


    (* ;; "Use IDATEs in case FDCDATE is not Y2K.")


    (* ;; "Stop if directory date is more than 2 minutes earlier than the filecreated date.  Earlier could be because the dates are asserted at different points in the filing process.  But 2 minutes is worth thinking about.  Returning from HELP will get them aligned.")


    (FOR
 F DIDATE FCDATE IN
 (OR (LISTP FILES)
                                        (FILDIR FILES)) WHEN
 (SETQ FCDATE (FILEDATE F))
       UNLESS
 (IEQP (SETQ DIDATE (GETFILEINFO F 'ICREATIONDATE))
                        (SETQ FCDATE (IDATE FCDATE))) COLLECT
 (CL:WHEN (IGREATERP (IDIFFERENCE
                                                                                       FCDATE DIDATE)
                                                                                  (ITIMES 120 
                                                                                         ONESECOND))
                                                                      (HELP 
                                                       "DIRECTORY DATE EARLIER THAN FILECREATED DATE"
                                                                            (LIST F (GDATE DIDATE)
                                                                                  (GDATE FCDATE))))
                                                            (SETFILEINFO F 'ICREATIONDATE FCDATE)
                                                            F])

(FIX-EQUIV-DATES

  [LAMBDA (CDENTRIES)
                                   (* ; "Edited  1-Sep-2020 16:21 by rmk:")


    (* ;; "For every entry whose files are EQUIVALENT and whose filedates are different, sets the directory of the file with the later date to be the date of the one with the earlier date.  This preumes that the later one must have been a copy. ")


    (CL:UNLESS CDENTRIES
        (PRINTOUT T "Note:  Using LASTCDENTRIES" T)
        (SETQ CDENTRIES LASTCDENTRIES))
    (FOR
 CDE EARLY LATE IN
 (CDR CDENTRIES) WHEN
 (FETCH
 EQUIV OF
 CDE)
       UNLESS
 (EQ '= (FETCH
 DATEREL OF
 CDE))
       COLLECT
 (SELECTQ (FETCH
 DATEREL OF
 CDE)
                       (> (SETQ EARLY (FETCH
 INFO2 OF
 CDE))
                          (SETQ LATE (FETCH
 INFO1 OF
 CDE)))
                       (< (SETQ EARLY (FETCH
 INFO1 OF
 CDE))
                          (SETQ LATE (FETCH
 INFO2 OF
 CDE)))
                       (SHOULDNT))
             (SETFILEINFO (FETCH
 FULLNAME OF
 LATE)
                    'ICREATIONDATE
                    (GETFILEINFO (FETCH
 FULLNAME OF
 EARLY)
                           'ICREATIONDATE))
             (FETCH
 FULLNAME OF
 LATE])

(COPY-COMPARED-FILES

  [LAMBDA (CDENTRIES TARGET MATCHNAMES)
                 (* ; "Edited  1-Sep-2020 16:20 by rmk:")


    (* ;; "Copies source files to target files whose matchname belongs to MATCHNAMES, if given.")


    (* ;; "TARGET is 1 or 2, indicating which side of the CD entry is the target.  Value is the list of matchnames whose files have been copied.")


    (* ;; "Directory filedates and other properties are preserved.")


    (CL:UNLESS (MEMB TARGET '(1 2))
           (ERROR "INVALID TARGET" TARGET))
    (CL:UNLESS CDENTRIES
        (PRINTOUT T "Note:  Using LASTCDENTRIES" T)
        (SETQ CDENTRIES LASTCDENTRIES))
    (SETQ MATCHNAMES (MKLIST MATCHNAMES))
    (FOR
 CDE SINFO TINFO MATCHNAME IN
 (CDR CDENTRIES) EACHTIME
 (SETQ SINFO
                                                                            (FETCH
 INFO1
                                                                               OF
 CDE))
                                                                    (SETQ TINFO (FETCH
 INFO2
                                                                                   OF
 CDE))
                                                                    (CL:WHEN (EQ TARGET 1)
                                                                           (SWAP
 SINFO TINFO))
                                                                    (SETQ MATCHNAME
                                                                     (FETCH
 MATCHNAME
                                                                        OF
 CDE))
       WHEN
 (AND (FETCH
 FULLNAME OF
 SINFO)
                     (FETCH
 FULLNAME OF
 TINFO)) UNLESS
 (AND MATCHNAMES
                                                                        (NOT (MEMB MATCHNAME 
                                                                                   MATCHNAMES)))
       COLLECT
 (COPYFILE (FETCH
 FULLNAME OF
 SINFO)
                          (PACKFILENAME 'VERSION NIL 'BODY (FETCH
 FULLNAME OF
 TINFO)))
             MATCHNAME])

(COPY-MISSING-FILES

  [LAMBDA (CDENTRIES TARGET MATCHNAMES)
                 (* ; "Edited  1-Sep-2020 16:21 by rmk:")


    (* ;; "Copies source files to target files whose matchname belongs to MATCHNAMES, if given.")


    (* ;; "TARGET is 1 or 2, indicating which side of the CD entry is the target.  Value is the list of matchnames whose files have been copied.")


    (* ;; "Directory filedates and other properties are preserved.")


    (CL:UNLESS (MEMB TARGET '(1 2))
           (ERROR "INVALID TARGET" TARGET))
    (CL:UNLESS CDENTRIES
        (PRINTOUT T "Note:  Using LASTCDENTRIES" T)
        (SETQ CDENTRIES LASTCDENTRIES))
    (CL:UNLESS (STRINGP (CADR (CAR CDENTRIES)))
        (ERROR "(CAR CDENTRIES) IS NOT A VALID PARAMETER LIST" (CAR CDENTRIES)))
    (SETQ MATCHNAMES (MKLIST MATCHNAMES))
    (FOR
 CDE SINFO TINFO TDIR MATCHNAME (TDIR _ (CL:IF (EQ TARGET 1)
                                                        (CAAR CDENTRIES)
                                                        (CADAR CDENTRIES))) IN
 (CDR CDENTRIES)
       EACHTIME
 (SETQ MATCHNAME (FETCH
 MATCHNAME OF
 CDE))
             (SETQ SINFO (FETCH
 INFO1 OF
 CDE))
             (SETQ TINFO (FETCH
 INFO2 OF
 CDE))
             (CL:WHEN (EQ TARGET 1)
                    (SWAP
 SINFO TINFO)) WHEN
 (AND (FETCH
 FULLNAME OF
 SINFO)
                                                          (NOT (FETCH
 FULLNAME OF
 TINFO)))
       UNLESS
 (AND MATCHNAMES (NOT (MEMB MATCHNAME MATCHNAMES)))
       COLLECT
 

             (* ;; "Using the source fullname in the target should preserve the version number")


             (COPYFILE (FETCH
 FULLNAME OF
 SINFO)
                    (PACKFILENAME 'BODY TDIR 'BODY (FETCH
 FULLNAME OF
 SINFO)))
             MATCHNAME])

(COMPILED-ON-SAME-SOURCE

  [LAMBDA (CDENTRIES)
                                   (* ; "Edited  9-Sep-2020 13:00 by rmk:")


    (* ;; "Returms a subset of CDENTRIES consisting of files that are compiled on the same source (i.e. their source names or dates are the same). Preserves the header.")


    (CDSUBSET
 CDENTRIES (FUNCTION (LAMBDA (CDE)
                                        (DECLARE
 (USEDFREE INFO1 INFO2))
                                        (LET (CREATED1 CREATED2)
                                             (CL:WHEN [AND (EQ 'COMPILED (FETCH
 TYPE OF

                                                                                         INFO1))
                                                           (EQ 'COMPILED (FETCH
 TYPE OF

                                                                                         INFO2))
                                                           [CDDR (SETQ CREATED1
                                                                  (CREATED-AS
 (FETCH
 FULLNAME
                                                                                     OF
 INFO1]
                                                           (CDDR (SETQ CREATED2
                                                                  (CREATED-AS
 (FETCH
 FULLNAME
                                                                                     OF
 INFO2]
                                                 (OR (EQUAL (CADDR CREATED1)
                                                            (CADDR CREATED2))
                                                     (EQUAL (CADDDR CREATED1)
                                                            (CADDDR CREATED2))))])
)

(RPAQ ONESECOND
 (IDIFFERENCE (IDATE "1-Jan-2020 12:00:01")
                           (IDATE "1-Jan-2020 12:00:00")))

(RPAQ? LASTCDENTRIES
 NIL)
(DEFINEQ

(COMPARE-ENTRY-SOURCE-FILES

  [LAMBDA (CDENTRY LISTSTREAM EXAMINE DW?)
              (* ; "Edited 30-Aug-2020 12:22 by rmk:")


    (* ;; "Wrapper to call COMPARESOURCES on the Lisp source files of CDENTRY")


    (CL:WHEN [AND (EQ 'SOURCE (FETCH
 TYPE OF
 (FETCH
 INFO1 OF
 CDENTRY)))
                  (EQ 'SOURCE (FETCH
 TYPE OF
 (FETCH
 INFO2 OF
 CDENTRY]
        (COMPARESOURCES (FETCH
 FULLNAME OF
 (FETCH
 INFO1 OF
 CDENTRY))
               (FETCH
 FULLNAME OF
 (FETCH
 INFO2 OF
 CDENTRY))
               EXAMINE DW? LISTSTREAM))])
)

(FILESLOAD COMPARESOURCES)
(PUTPROPS COMPAREDIRECTORIES COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1994 1998
 2018 2020))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (1680 15255 (COMPAREDIRECTORIES 1690 . 9637) (CDFILES 9639 . 13357) (
COMPAREDIRECTORIES.INFOS 13359 . 14818) (MATCHNAME 14820 . 15253)) (15256 22558 (CDPRINT 15266 . 20045
) (CDPRINT.LINE 20047 . 22556)) (22559 24311 (CDMAP 22569 . 23265) (CDENTRY 23267 . 23435) (CDSUBSET 
23437 . 24309)) (24312 29482 (BINCOMP 24322 . 28250) (EOLTYPE 28252 . 29480)) (29691 42898 (
FIND-UNCOMPILED-FILES 29701 . 33344) (FIND-UNSOURCED-FILES 33346 . 36155) (FIND-SOURCE-FILES 36157 . 
37861) (FIND-COMPILED-FILES 37863 . 39941) (FIND-UNLOADED-FILES 39943 . 40687) (FIND-LOADED-FILES 
40689 . 41243) (FIND-MULTICOMPILED-FILES 41245 . 42896)) (42899 50931 (CREATED-AS 42909 . 47706) (
SOURCE-FOR-COMPILED-P 47708 . 50236) (COMPILE-SOURCE-DATE-DIFF 50238 . 50929)) (50932 59939 (
FIX-DIRECTORY-DATES 50942 . 52938) (FIX-EQUIV-DATES 52940 . 54200) (COPY-COMPARED-FILES 54202 . 56326)
 (COPY-MISSING-FILES 56328 . 58167) (COMPILED-ON-SAME-SOURCE 58169 . 59937)) (60094 60705 (
COMPARE-ENTRY-SOURCE-FILES 60104 . 60703)))))
STOP