(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "28-Jul-87 22:55:16" {ERINYES}<LISPUSERS>LYRIC>COMPAREDIRECTORIES.;2 6761
changes to%: (FNS COMPAREDIRECTORIES)
previous date%: "21-Jan-87 18:10:18" {ERINYES}<LISPUSERS>LYRIC>COMPAREDIRECTORIES.;1)
(* "
Copyright (c) 1985, 1986, 1987 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT COMPAREDIRECTORIESCOMS)
(RPAQQ COMPAREDIRECTORIESCOMS (
(* ;; "Compare the contents to two directories.")
(FNS COMPAREDIRECTORIES COMPAREDIRS.FORMATLINE)))
(* ;; "Compare the contents to two directories.")
(DEFINEQ
(COMPAREDIRECTORIES
[LAMBDA (FROMDIR TODIR SHOW=FILESTOO FILEPATTERN LISTINGFILE EXTENSIONSTOAVOID)
(* ; "Edited 28-Jul-87 22:54 by James.pa")
(* ;; "Compare the contents of two directories, e.g., for change-control purposes. Compares files matching FILEPATTERN (or *.*;) on FROMDIR and TODIR, listing which is newer, or when one is not found on the other. If SHOW=FILESTOO, then files that are the same are also listed. LISTINGFILE is either a filename for an interpress master, or NIL to go to the display.")
(LET [(LISTINGSTREAM (COND
[LISTINGFILE (OPENIMAGESTREAM LISTINGFILE 'INTERPRESS '(LANDSCAPE T]
(T NIL]
(COND
(LISTINGSTREAM (MOVETO (DSPLEFTMARGIN NIL LISTINGSTREAM)
(IDIFFERENCE (DSPTOPMARGIN NIL LISTINGSTREAM)
(FONTPROP (DSPFONT NIL LISTINGSTREAM)
'ASCENT))
LISTINGSTREAM)))
[for FILENAME infiles (PACKFILENAME.STRING 'BODY FROMDIR 'BODY (OR FILEPATTERN '*.*;))
bind DT1 DT2 TON SHORT-FROM SHORT-TO when (NOT (MEMBER (UNPACKFILENAME FILENAME
'EXTENSION)
EXTENSIONSTOAVOID))
do (PRINTOUT T FILENAME T)
(COND
[[SETQ TON (INFILEP (PACKFILENAME.STRING 'DIRECTORY TODIR 'VERSION NIL 'BODY
(SETQ SHORT-FROM (PACKFILENAME.STRING 'HOST NIL
'DIRECTORY NIL 'DEVICE NIL
'BODY FILENAME]
(SETQ SHORT-TO (PACKFILENAME.STRING 'HOST NIL 'DIRECTORY NIL 'DEVICE NIL
'BODY TON))
(COND
[[EQUAL (SETQ DT1 (GETFILEINFO FILENAME 'ICREATIONDATE))
(SETQ DT2 (GETFILEINFO TON 'ICREATIONDATE]
(* same)
(COND
(SHOW=FILESTOO (COMPAREDIRS.FORMATLINE LISTINGSTREAM SHORT-FROM NIL
(GDATE DT1)
" same as "
(GDATE DT2)
SHORT-TO NIL]
(T (COMPAREDIRS.FORMATLINE LISTINGSTREAM SHORT-FROM (GETFILEINFO FILENAME
'AUTHOR)
(GDATE DT1)
(COND
((LESSP DT1 DT2)
" older than ")
(T " newer than "))
(GDATE DT2)
SHORT-TO NIL]
(T (COMPAREDIRS.FORMATLINE LISTINGSTREAM SHORT-FROM (GETFILEINFO FILENAME
'AUTHOR)
(GETFILEINFO FILENAME 'CREATIONDATE)
" not found"
(GDATE DT2)
"" "" NIL]
(AND LISTINGSTREAM (CLOSEF LISTINGSTREAM])
(COMPAREDIRS.FORMATLINE
[LAMBDA (STREAM FROM FROMAUTHOR FDATE COMP TDATE TO TOAUTHOR)
(* ; "Edited 21-Jan-87 17:00 by jds")
(* ;; "Format one line of the directory comparison listing. If FROMAUTHOR or TOAUTHOR are non-NIL, list the author in parens; otherwise omit it.")
(COND
(STREAM (* ;
"It's an interpress stream, where TAB doesn't work right.")
(LET ((SPACEWIDTH (CHARWIDTH (CHARCODE SPACE)
STREAM))
(LEFTMARGIN (DSPLEFTMARGIN NIL STREAM)))
(PRINTOUT STREAM FROM (COND
(FROMAUTHOR (CONCAT "(" FROMAUTHOR ")"))
(T "")))
(DSPXPOSITION (IPLUS LEFTMARGIN (ITIMES 45 SPACEWIDTH))
STREAM)
(PRINTOUT STREAM "[" FDATE "]" 69)
(DSPXPOSITION (IPLUS LEFTMARGIN (ITIMES 69 SPACEWIDTH))
STREAM)
(PRINTOUT STREAM COMP)
(DSPXPOSITION (IPLUS LEFTMARGIN (ITIMES 83 SPACEWIDTH))
STREAM)
(PRINTOUT STREAM "[" TDATE "]")
(DSPXPOSITION (IPLUS LEFTMARGIN (ITIMES 103 SPACEWIDTH))
STREAM)
(PRINTOUT STREAM TO (COND
(TOAUTHOR (CONCAT "(" TOAUTHOR ")"))
(T ""))
T)))
(T (* ; "the display, where TAB does work.")
(PRINTOUT STREAM FROM (COND
(FROMAUTHOR (CONCAT "(" FROMAUTHOR ")"))
(T ""))
45 "[" FDATE "]" 69 COMP 83 "[" TDATE "]" 103 TO (COND
(TOAUTHOR (CONCAT "(" TOAUTHOR
")"))
(T ""))
T])
)
(PUTPROPS COMPAREDIRECTORIES COPYRIGHT ("Xerox Corporation" 1985 1986 1987))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (676 6661 (COMPAREDIRECTORIES 686 . 4327) (COMPAREDIRS.FORMATLINE 4329 . 6659)))))
STOP