(FILECREATED "23-Nov-84 17:54:23" {ERIS}<LISPCORE>LIBRARY>COPYFILES.;46 14626
changes to: (VARS COPYFILESENUMERATE)
(FNS COPIEDFILEPATTERN)
previous date: "23-Nov-84 14:40:30" {ERIS}<LISPCORE>LIBRARY>COPYFILES.;44)
(* Copyright (c) 1984 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT COPYFILESCOMS)
(RPAQQ COPYFILESCOMS ((FNS COPYFILES MAPFILES COPIEDFILENAME COPIEDFILEPATTERN COPIEDFILEMATCH
COPIEDTOSPEC ESPATTERN NOHOST COMPAREFILES)
(VARS COPYFILESENUMERATE)))
(DEFINEQ
(COPYFILES
[LAMBDA (FROMSPEC TOSPEC OPTIONS) (* lmm "20-Nov-84 16:14")
(PROG ((COPYFILESOUTPUT T)
(COPYFILES.WHENTOSKIP (FUNCTION EQUAL))
(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 (SELECTQ X
(QUIET (SETQ COPYFILESOUTPUT NIL))
(TERSE (SETQ COPYFILESOUTPUT NIL)
(SETQ COPYFILESTERSE T))
((RENAME MOVE)
(SETQ COPYFILESRENAME T))
(ALWAYS (SETQ COPYFILESALWAYS T)
(SETQ COPYFILES.WHENTOSKIP
(FUNCTION NILL)))
(> (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))
(# (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))
[OR (ERSETQ (SETQ NEWFILENAME (COPIEDFILENAME FILENAME FROMSPEC
COPYFILESTOSPEC
COPYFILESVERSIONS)))
(RETURN (AND COPYFILESOUTPUT (printout COPYFILESOUTPUT
" illegal file name "]
[SETQ DT1 (if CRDATE
then (IDATE CRDATE)
else (GETFILEINFO FILENAME (QUOTE ICREATIONDATE]
[if (OR (NOT COPYFILESALWAYS)
(NEQ COPYFILES.WHENTOSKIP (QUOTE NILL)))
then (COND
[(SETQ NF (INFILEP NEWFILENAME))
(SETQ DT2 (GETFILEINFO NF (QUOTE ICREATIONDATE)))
(AND COPYFILESOUTPUT (printout COPYFILESOUTPUT " ["
(GDATE DT1)
"]" " vs. " NF "["
(if DT2
then (GDATE DT2)
else "no date?")
"]"))
(COND
((AND DT2 (APPLY* COPYFILES.WHENTOSKIP DT1 DT2))
(AND COPYFILESOUTPUT (printout COPYFILESOUTPUT
" skipped."))
(RETURN]
(COPYFILESPURGESOURCE [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 (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) (* lmm "23-Nov-84 13:28")
(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)
(PUTPROPS COPYFILES COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (530 14512 (COPYFILES 540 . 7282) (MAPFILES 7284 . 8679) (COPIEDFILENAME 8681 . 10302) (
COPIEDFILEPATTERN 10304 . 11574) (COPIEDFILEMATCH 11576 . 12148) (COPIEDTOSPEC 12150 . 12457) (
ESPATTERN 12459 . 12969) (NOHOST 12971 . 13242) (COMPAREFILES 13244 . 14510)))))
STOP