(FILECREATED "21-Jun-85 15:49:06" {ERIS}<LISPCORE>LIBRARY>COPYFILES.;49 17430
changes to: (I.S.OPRS INFILES)
(VARS COPYFILESCOMS)
previous date: " 6-Jun-85 14:09:14" {ERIS}<LISPCORE>LIBRARY>COPYFILES.;48)
(* Copyright (c) 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT COPYFILESCOMS)
(RPAQQ COPYFILESCOMS ((FNS COPYFILES MAPFILES COPIEDFILENAME COPIEDFILEPATTERN COPIEDFILEMATCH
COPIEDTOSPEC ESPATTERN NOHOST COMPAREFILES)
(VARS COPYFILESENUMERATE)
(I.S.OPRS INFILES)))
(DEFINEQ
(COPYFILES
[LAMBDA (FROMSPEC TOSPEC OPTIONS) (* lmm " 6-Jun-85 14:08")
(* Copies the files specified in FROMSPEC to the destination in TOSPEC. Which versions get copied, whether to copy
old files, etc. is controlled by OPTIONS.)
(LET ((COPYFILESOUTPUT T)
(COPYFILES.WHENTOSKIP (FUNCTION ILEQ))
(COPYFILESALWAYS T)
(COPYFILESVERSIONS NIL)
(COPYFILESRENAME NIL)
(COPYFILESASK NIL)
(COPYFILESASKDEFAULT)
(COPYFILESREPLACE NIL)
(COPYFILESPURGESOURCE NIL)
(COPYFILESPURGE NIL)
(COPYFILESTERSE)
(COPYFILESTOSPEC (COPIEDTOSPEC TOSPEC)))
(DECLARE (SPECVARS . T))
[for X inside OPTIONS
do (* Run thru the options, turning them into internal
flag settings and functional specifications.)
(SELECTQ X
(QUIET (* Don't want to hear about files as they're copied.
Set the output file to NIL to suppress printing.)
(SETQ COPYFILESOUTPUT NIL))
(TERSE (* Only print a %. per file copied.
Set the TERSE flag.)
(SETQ COPYFILESOUTPUT NIL)
(SETQ COPYFILESTERSE T))
((RENAME MOVE) (* He wants the files moved, not copied.)
(SETQ COPYFILESRENAME T))
(ALWAYS (* ALWAYS copy the files specified.)
(SETQ COPYFILESALWAYS T) (* Tell it so)
(SETQ COPYFILES.WHENTOSKIP (FUNCTION NILL))
(* And say never to skip a potential file)
)
(> (* Only copy if the source has a newer version than the
destination.)
(SETQ COPYFILES.WHENTOSKIP (FUNCTION ILEQ))
(SETQ COPYFILESALWAYS NIL))
((= =A) (* = without ALWAYS doesn't make a lot of sense)
(SETQ COPYFILES.WHENTOSKIP (FUNCTION TRUE))
(SETQ COPYFILESALWAYS T))
(%# (* Skip files that are the same on the destination)
(SETQ COPYFILES.WHENTOSKIP (FUNCTION EQUAL))
(SETQ COPYFILESALWAYS NIL))
(ALLVERSIONS (SETQ COPYFILESVERSIONS T))
(%#A (SETQ COPYFILES.WHENTOSKIP (FUNCTION EQUAL))
(SETQ COPYFILESALWAYS T))
(>A (SETQ COPYFILES.WHENTOSKIP (FUNCTION ILEQ))
(SETQ COPYFILESALWAYS T))
(ASK (SETQ COPYFILESASK T))
(PURGE (SETQ COPYFILESPURGE T))
(PURGESOURCE (SETQ COPYFILESPURGESOURCE T)
(SETQ COPYFILESALWAYS NIL))
(REPLACE (SETQ COPYFILESREPLACE T))
(COND
[(AND (LISTP X)
(EQ (CAR X)
(QUOTE OUTPUT)))
(SETQ COPYFILESOUTPUT (OPENSTREAM (CADR X)
(QUOTE OUTPUT)
(QUOTE NEW]
((AND (LISTP X)
(EQ (CAR X)
(QUOTE ASK)))
(SETQ COPYFILESASK T)
(SETQ COPYFILESASKDEFAULT (CADR X)))
(T (ERROR X "unrecognized option"]
(AND COPYFILESASK (NOT COPYFILESOUTPUT)
(SETQ COPYFILESOUTPUT T))
(MAPFILES FROMSPEC
[FUNCTION (LAMBDA (FILENAME CRDATE)
[PROG (NEWFILENAME NF CF DT1 DT2 HELPFLAG)
(DECLARE (SPECVARS HELPFLAG))
(AND COPYFILESOUTPUT (printout COPYFILESOUTPUT .TAB0 0 FILENAME))
(* List the candidate file's name)
[OR (ERSETQ (SETQ NEWFILENAME (COPIEDFILENAME FILENAME FROMSPEC
COPYFILESTOSPEC
COPYFILESVERSIONS)))
(RETURN (AND COPYFILESOUTPUT (printout COPYFILESOUTPUT
" illegal file name "]
(* Find out what the file's name would be at the
destination.)
[SETQ DT1 (if CRDATE
then (IDATE CRDATE)
else (GETFILEINFO FILENAME (QUOTE ICREATIONDATE]
[if (OR (NOT COPYFILESALWAYS)
(NEQ COPYFILES.WHENTOSKIP (QUOTE NILL)))
then (* We aren't ALWAYS copying.
So have to check this file to see if it meets the copy
criteria.)
(COND
[(SETQ NF (INFILEP NEWFILENAME))
(* There is a file of the same name at the destination.
CHeck it out.)
(SETQ DT2 (GETFILEINFO NF (QUOTE ICREATIONDATE)))
(* The destination file's create date)
(AND COPYFILESOUTPUT (printout COPYFILESOUTPUT " ["
(GDATE DT1)
"]" " vs. " NF "["
(if DT2
then (GDATE DT2)
else "no date?")
"]"))
(* Tell the user we're comparing dates)
(COND
((AND DT2 (APPLY* COPYFILES.WHENTOSKIP DT1 DT2))
(* If the file has a create date, and it meets the SKIP
criteria, then skip over this file)
(AND COPYFILESOUTPUT (printout COPYFILESOUTPUT " skipped.")
)
(RETURN]
(COPYFILESPURGESOURCE
(* We're to purge the source directory of
non-corresponding files)
[COND
([PROGN (AND COPYFILESOUTPUT
(printout COPYFILESOUTPUT
" (no corresponding "
NEWFILENAME "), ")
)
(OR (NOT COPYFILESASK)
(EQ (QUOTE Y)
(ASKUSER DWIMWAIT
COPYFILESASKDEFAULT
"delete? "
NIL T]
([LAMBDA (STR)
(AND COPYFILESOUTPUT
(printout COPYFILESOUTPUT STR]
(if (DELFILE FILENAME)
then " deleted."
else " couldn't delete."]
(RETURN))
((NOT COPYFILESALWAYS)
(* file doesn't exist on destination)
(AND COPYFILESOUTPUT (printout COPYFILESOUTPUT
" does not exist on destination -- skipped"))
(RETURN]
(if (AND COPYFILESREPLACE NF)
then (SETQ NEWFILENAME NF))
(if COPYFILESOUTPUT
then (* Write out the file's new name, and tell him we're
copying or moving it.)
(printout COPYFILESOUTPUT (if COPYFILESRENAME
then " rename"
else " copy"))
(if (NOT NF)
then (printout COPYFILESOUTPUT " to (new file) " NEWFILENAME)))
(COND
((AND COPYFILESASK (NEQ (ASKUSER DWIMWAIT COPYFILESASKDEFAULT "? " NIL T)
(QUOTE Y)))
(RETURN)))
[OR [ERSETQ (SETQ CF (COND
(COPYFILESRENAME (RENAMEFILE FILENAME NEWFILENAME))
(T (COPYFILE FILENAME NEWFILENAME]
(RETURN (AND COPYFILESOUTPUT (printout COPYFILESOUTPUT " failed."]
(if COPYFILESOUTPUT
then (if (AND (NOT COPYFILESASK)
(NOT NF)
(STRPOS NEWFILENAME CF 1 NIL 1 NIL (UPPERCASEARRAY)))
then (printout COPYFILESOUTPUT
(OR (SUBSTRING CF (ADD1 (NCHARS NEWFILENAME)))
"."))
else (printout COPYFILESOUTPUT " => " CF]
(AND COPYFILESTERSE (PRIN1 "." COPYFILESTERSE]
"*"
(if COPYFILESVERSIONS
then "*"
else ""))
[if COPYFILESPURGE
then (* delete from source if doesn't exist on destination)
(AND COPYFILESOUTPUT (printout COPYFILESOUTPUT T
"Deleting files on destination but not on source"
T))
(COPYFILES TOSPEC FROMSPEC (APPEND (if COPYFILESOUTPUT
then (LIST (LIST (QUOTE OUTPUT)
COPYFILESOUTPUT)))
(if COPYFILESASK
then (LIST (LIST (QUOTE ASK)
COPYFILESASKDEFAULT)))
(QUOTE (= PURGESOURCE]
(COND
(COPYFILESOUTPUT (TAB 0 0 COPYFILESOUTPUT)
(NEQ COPYFILESOUTPUT T)
(CLOSEF COPYFILESOUTPUT])
(MAPFILES
[LAMBDA (FILESPEC FN DEFAULTEXT DEFAULTVERS) (* jds "27-Feb-85 11:46")
(* Run thru all the files that match FILESPEC, calling
FN on each such file name)
(if (LISTP FILESPEC)
then (for X in FILESPEC do (MAPFILES X FN DEFAULTEXT DEFAULTVERS))
elseif [OR (STRPOS "*" FILESPEC)
(FMEMB (NTHCHARCODE FILESPEC -1)
(CHARCODE (> %) %] } :]
then [PROG ([FILEGROUP (\GENERATEFILES (DIRECTORY.FILL.PATTERN FILESPEC DEFAULTEXT
DEFAULTVERS)
(QUOTE (CREATIONDATE))
(QUOTE (SORT]
NAME)
(if COPYFILESENUMERATE
then (for PAIR in [while (SETQ NAME (\GENERATENEXTFILE FILEGROUP))
collect (CONS (if (LISTP NAME)
then (CONCATCODES NAME)
else NAME)
(\GENERATEFILEINFO FILEGROUP (QUOTE
CREATIONDATE]
do (APPLY* FN (CAR PAIR)
(CDR PAIR)))
else (while (SETQ NAME (\GENERATENEXTFILE FILEGROUP))
do (APPLY* FN (if (LISTP NAME)
then (CONCATCODES NAME)
else NAME)
(\GENERATEFILEINFO FILEGROUP (QUOTE CREATIONDATE]
elseif (SETQ FILESPEC (INFILEP FILESPEC))
then (APPLY* FN FILESPEC (GETFILEINFO FILESPEC (QUOTE CREATIONDATE])
(COPIEDFILENAME
[LAMBDA (FILENAME FROMSPEC COPIEDSPEC PRESERVEVERSION) (* lmm "23-Nov-84 14:38")
(* FILENAME is the file produced by the directory enumeration. FROMSPEC is the original "FROM" specification, and
COPIEDSPEC is either a directory specification (string) or else a list, CDR of which is a list of character atoms.)
[SETQ FILENAME (COND
[(LISTP COPIEDSPEC) (* NOHOST strips off the HOST ortion)
(CONCATLIST (COPIEDFILEPATTERN (NOHOST (ESPATTERN FROMSPEC))
(CDR COPIEDSPEC)
(NOHOST (UNPACK (COND
(PRESERVEVERSION FILENAME)
(T (PACKFILENAME.STRING (QUOTE VERSION)
NIL
(QUOTE BODY)
FILENAME]
(T (PACKFILENAME.STRING (QUOTE DIRECTORY)
TOSPEC
(QUOTE HOST)
NIL
(QUOTE DEVICE)
NIL
(QUOTE DIRECTORY)
NIL
(QUOTE BODY)
(if PRESERVEVERSION
then FILENAME
else (PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
FILENAME]
(if (EQ (NTHCHARCODE FILENAME -1)
(CHARCODE %.))
then
(* this is a terrible kludge, to get around the problem that for some devices, (INFILEP "FOO.") fails while
(INFILEP "FOO") doesn't. This stripping off of a terminal "." doesn't hurt, but doesn't belong here.
Necessary for getting a working version for the harmony release.)
(SUBSTRING FILENAME 1 -2 FILENAME)
else FILENAME])
(COPIEDFILEPATTERN
[LAMBDA (FRPAT TOPAT CHARS) (* lmm "23-Nov-84 17:49")
(PROG NIL
(while [AND FRPAT (EQ (U-CASE (CAR FRPAT))
(U-CASE (CAR CHARS]
do (pop FRPAT)
(pop CHARS))
(RETURN (NCONC (on old TOPAT while (NEQ (CAR TOPAT)
(QUOTE *))
collect (CAR TOPAT))
(COND
((AND FRPAT (NEQ (CAR FRPAT)
(QUOTE *)))
(if [AND (NULL CHARS)
(EQUAL FRPAT (QUOTE (%. *)))
(OR (NULL TOPAT)
(EQUAL TOPAT (QUOTE (*]
then NIL
else (ERROR "FROMSPEC doesn't match generated file")))
(TOPAT (* both TOPAT and FRPAT start with *)
(NCONC [LDIFF CHARS (SETQ CHARS (for X on CHARS
when (COPIEDFILEMATCH
X
(CDR FRPAT))
do (SETQ $$VAL X]
(COPIEDFILEPATTERN (CDR FRPAT)
(CDR TOPAT)
CHARS)))
(T (OR (COPIEDFILEMATCH CHARS FRPAT)
(ERROR "file pattern doesn't match"))
NIL])
(COPIEDFILEMATCH
[LAMBDA (CHARS FRPAT) (* lmm "30-Oct-84 13:33")
(PROG NIL
LP (if (NULL FRPAT)
then (RETURN (NULL CHARS))
elseif (EQ (CAR FRPAT)
(QUOTE *))
then [RETURN (OR (NULL (CDR FRPAT))
(find X on CHARS suchthat (COPIEDFILEMATCH X (CDR FRPAT]
elseif (EQ (U-CASE (POP FRPAT))
(U-CASE (POP CHARS)))
then (GO LP)
else (RETURN])
(COPIEDTOSPEC
[LAMBDA (SPEC) (* lmm " 5-Oct-84 23:13")
(if (STRPOS "*" SPEC)
then (CONS (QUOTE PATTERN)
(ESPATTERN SPEC))
else (OR (DIRECTORYNAME SPEC)
(ERROR SPEC "not a valid directory"])
(ESPATTERN
[LAMBDA (X) (* lmm "23-Nov-84 10:53")
(for Y on (UNPACK X) collect (if (EQ (CAR Y)
(QUOTE *))
then (if [AND (EQ (CADR Y)
(QUOTE %.))
(EQ (CADDR Y)
(QUOTE *))
(FMEMB (CADDDR Y)
(QUOTE (NIL ;]
then (RPLACD Y (CDDDR Y)))
(QUOTE *)
else (CAR Y])
(NOHOST
[LAMBDA (UP)
(SELECTQ (CAR UP)
(({ %( %[)
(do (pop UP)
(SELECTQ (CAR UP)
(NIL (RETURN))
((} %) %])
(RETURN (pop UP)))
(' (pop UP))
NIL)))
NIL)
UP])
(COMPAREFILES
[LAMBDA (OLDFILE NEWFILE) (* lmm " 7-Sep-84 11:57")
(* Compare two files to see if their contents are the
same.)
(PROG ([OSTREAM (OPENSTREAM OLDFILE (QUOTE INPUT)
(QUOTE OLD)
(QUOTE (SEQUENTIAL T]
[NSTREAM (OPENSTREAM NEWFILE (QUOTE INPUT)
(QUOTE OLD)
(QUOTE (SEQUENTIAL T]
OLEN NLEN)
(SETQ OLEN (GETFILEINFO OSTREAM (QUOTE LENGTH)))
(SETQ NLEN (GETFILEINFO NSTREAM (QUOTE LENGTH)))
[COND
((NOT (EQP OLEN NLEN)) (* If they files are of different lengths, they aren't
the same.)
(ERROR "File lengths differ: " (CONCAT OLEN " vs " NLEN]
[COND
(OLEN (* FTP returns NIL for the length of an empty file!)
(for BYTEPOS from 0 to (SUB1 OLEN) do (COND
((NEQ (BIN OSTREAM)
(BIN NSTREAM))
(ERROR "Files differ at byte " BYTEPOS]
(CLOSEF? OSTREAM)
(CLOSEF? NSTREAM))
T])
)
(RPAQQ COPYFILESENUMERATE T)
(DECLARE: EVAL@COMPILE
(I.S.OPR (QUOTE INFILES)
NIL
[QUOTE (SUBST (GENSYM)
(QUOTE GENVAR)
(QUOTE (BIND GENVAR ← (\GENERATEFILES BODY NIL (QUOTE (SORT)))
EACHTIME
(PROGN (OR (SETQ I.V. (\GENERATENEXTFILE GENVAR))
(GO $$OUT))
(IF (LISTP I.V.)
THEN
(SETQ I.V. (CONCATCODES I.V.]
T)
)
(PUTPROPS COPYFILES COPYRIGHT ("Xerox Corporation" 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (553 16945 (COPYFILES 563 . 9551) (MAPFILES 9553 . 11112) (COPIEDFILENAME 11114 . 12735)
(COPIEDFILEPATTERN 12737 . 14007) (COPIEDFILEMATCH 14009 . 14581) (COPIEDTOSPEC 14583 . 14890) (
ESPATTERN 14892 . 15402) (NOHOST 15404 . 15675) (COMPAREFILES 15677 . 16943)))))
STOP