(FILECREATED "19-JUN-83 13:50:38" <BLISP>FTPFILES.;23
 5838   

      changes to:  (VARS CORRES)

      previous date: "19-MAY-83 23:48:04" <BLISP>FTPFILES.;22)


(* Copyright (c) 1981, 1982, 1983 by Xerox Corporation)

(PRETTYCOMPRINT FTPFILESCOMS)

(RPAQQ FTPFILESCOMS
 ((FNS FTPFILES FTPFILEDATE PLL PSH RDEL)
		     (MACROS BTRACE)
		     (VARS CORRES)))
(DEFINEQ

(FTPFILES

  [LAMBDA (REMOTESPEC PUSH/PULL ALLFLG DIRS)
                                   (* lmm "19-MAY-83 23:47")

    (PROG ((HOST (OR (FILENAMEFIELD REMOTESPEC (QUOTE HOST))
		     (HOSTNAME)))
	   (DIRECTORY (FILENAMEFIELD REMOTESPEC (QUOTE DIRECTORY)))
	   (NAMEFIELD (NAMEFIELD REMOTESPEC T))
	   MAXCP
	   (PUSH
 (SELECTQ PUSH/PULL
			  ((SEND STORE S ST PUSH)
			    T)
			  ((GET RET RETRIEVE NIL PULL R)
			    NIL)
			  (HELP)))
	   DESTPL CNDIR)
          (MINFS 10000 (QUOTE ATOM.CHARS))
          (MINFS 10000 (QUOTE STRING.CHARS))
          (COND
	    [(SETQ CNDIR (STRPOS ">" DIRECTORY))
	      (SETQ CNDIR (SUBATOM DIRECTORY 1 (SUB1 CNDIR]
	    (T (SETQ CNDIR DIRECTORY)))
          (SETQ MAXCP (STRPOS (QUOTE MAXC)
			      HOST))
          (PROG (LOCALFILES DESTINATIONFILES SOURCEDATE DESTDATE ANY TMP REMOTEFILES)
	        (OUTFILE (PACKFILENAME (QUOTE NAME)
				       (QUOTE FTP)
				       (QUOTE EXTENSION)
				       (QUOTE CMD)
				       (QUOTE PROTECTION)
				       "770000"
				       (QUOTE TEMPORARY)
				       T
				       (QUOTE DIRECTORY)
				       (DIRECTORYNAME)))
	        (SETFILEPTR (OUTPUT)
			    0)
	        (SETQ TMP (\INTERNAL/GETPASSWORD HOST))
	        (printout
 NIL "PUPFTP " HOST T "LOGIN " (CAR TMP)
			  " "
			  (CDR TMP)
			  T "CONNECT " CNDIR " " (CDR (\INTERNAL/GETPASSWORD HOST NIL CNDIR NIL))
			  T "DIRECTORY " DIRECTORY T)
	        [SETQ REMOTEFILES (for
 X in
 [PUPFTP HOST [PACK* (QUOTE <)
								DIRECTORY
								(QUOTE >)
								(COND
								  [(EQ NAMEFIELD (PACK))
								    (COND
								      (MAXCP (QUOTE *.*))
								      (T (QUOTE *]
								  (T NAMEFIELD))
								(COND
								  (MAXCP (QUOTE ;0))
								  (T (QUOTE !H]
						    (QUOTE (LIST (NAME-BODY)
								 (CREATION-DATE]
				     collect
 (LIST (U-CASE (CADR (FASSOC (QUOTE NAME-BODY)
									 X)))
						   (FTPFILEDATE
 X]
	        (DIRECTORY (PACKFILENAME (QUOTE BODY)
					 NAMEFIELD
					 (QUOTE EXTENSION)
					 (QUOTE *))
			   [QUOTE (@ (SETQ LOCALFILES (CONS (LIST (NAMEFIELD FILENAME T)
								  (GETFILEINFO JFN (QUOTE 
										    ICREATIONDATE)))
							    LOCALFILES]
			   (QUOTE *)
			   0)
	        [for
 SOURCEPL in
 (COND
				   (PUSH (SETQ DESTINATIONFILES REMOTEFILES)
					 LOCALFILES)
				   (T (SETQ DESTINATIONFILES LOCALFILES)
				      REMOTEFILES))
		   do
 (BTRACE (CAR SOURCEPL))
		      (COND
			((COND
			    [[OR (SETQ DESTPL (FASSOC (CAR SOURCEPL)
						      DESTINATIONFILES))
				 (AND (NOT PUSH)
				      DIRS
				      (SETQ DESTPL (FINDFILE (CAR SOURCEPL)
							     T DIRS))
				      (SETQ DESTPL (LIST (NAMEFIELD DESTPL T)
							 (GETFILEINFO DESTPL (QUOTE ICREATIONDATE]
			      (COND
				((IEQP (CADR SOURCEPL)
				       (CADR DESTPL))
				  (BTRACE " same,")
				  NIL)
				((ILESSP (CADR SOURCEPL)
					 (CADR DESTPL))
				  (BTRACE " more recent on dest,")
				  (SELECTQ ALLFLG
					   (ASK! (EQ (ASKUSER DWIMWAIT (QUOTE N)
							      " copy anyway? ")
						     (QUOTE Y)))
					   NIL))
				(T (SELECTQ ALLFLG
					    (ASK! (BTRACE " newer on source,")
						  (EQ (ASKUSER DWIMWAIT (QUOTE Y)
							       " copy? ")
						      (QUOTE Y)))
					    T]
			    (T (BTRACE " not on dest directory, ")
			       (SELECTQ ALLFLG
					(T T)
					((ASK ASK!)
					  (EQ (ASKUSER DWIMWAIT (QUOTE N)
						       " copy? ")
					      (QUOTE Y)))
					NIL)))
			  (BTRACE " will xfer." T)
			  (SETQ ANY T)
			  (printout
 NIL (COND
				      (PUSH "STORE ")
				      (T "RETRIEVE "))
				    (CAR SOURCEPL)
				    T T T))
			(T (BTRACE " skipped." T]
	        (printout
 NIL "
QUIT
QUIT
")
	        (COND
		  [ANY (BKSYSBUF (CLOSEF (OUTPUT)))
		       (BKSYSBUF "
")
		       (KFORK (SUBSYS (QUOTE RUNFIL]
		  (T (CLOSEF (OUTPUT])

(FTPFILEDATE

  [LAMBDA (PLIST FLD)              (* lmm " 1-MAY-81 22:43")

    (IDATE (OR [STRINGP (CADR (SETQ FLD (FASSOC (QUOTE CREATION-DATE)
						PLIST]
	       (SUBSTRING (CDR FLD)
			  2 -2])

(PLL

  [LAMBDA (FL FLG)                 (* lmm " 1-NOV-82 23:08")

    (FTPFILES
 (PACK* (CADR (OR (ASSOC (DIRECTORYNAME T T)
				      CORRES)
			       (HELP)))
		     FL)
	      (QUOTE PULL)
	      (OR FLG (QUOTE ASK))
	      (CDDR (ASSOC (DIRECTORYNAME T T)
			   CORRES])

(PSH

  [LAMBDA (FL FLG)                 (* lmm " 9-MAR-82 22:21")

    (FTPFILES
 (PACK* (CADR (OR (ASSOC (DIRECTORYNAME T T)
				      CORRES)
			       (HELP)))
		     FL)
	      (QUOTE PUSH)
	      (SELECTQ FLG
		       (NIL (QUOTE ASK))
		       (NO NIL)
		       FLG])

(RDEL

  [LAMBDA (X FLG)                  (* lmm "10-AUG-81 22:32")

    (PUPFTP (QUOTE PHYLUM)
	    (PACK* (COND
		     (FLG (QUOTE <LISPCORE>ALLEGRO>))
		     (T (QUOTE <LISP>ALLEGRO>)))
		   X
		   (QUOTE !*))
	    (QUOTE DELETE?])
)
(DECLARE: EVAL@COMPILE 

(PUTPROPS BTRACE MACRO
 ((X . Y)
			(printout
 T X . Y)))
)

(RPAQQ CORRES
 ((BLISP {PHYLUM}<LISPCORE>SOURCES>)
	       (MANUAL {PHYLUM}<LISPMANUAL>)
	       (LISPUSERS {PHYLUM}<LISPUSERS>)
	       (BLISPUSERS {PHYLUM}<LISPUSERS> LISPUSERS)
	       (NEWLISP {PHYLUM}<LISPCORE>SYSTEM> LISP)
	       (ALISP {PHYLUM}<LISPCORE>FUGUE>)))
(PUTPROPS FTPFILES COPYRIGHT ("Xerox Corporation" 1981 1982 1983))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (379 5367 (FTPFILES 391 . 4302) (FTPFILEDATE 4306 . 4516) (PLL 4520 . 4815) (PSH 4819 . 
5112) (RDEL 5116 . 5364)))))
STOP