(FILECREATED "20-Mar-84 15:52:52" {PHYLUM}<LISPCORE>LIBRARY>SAMEDIR.;1
 7330Q  

      changes to:  (VARS SAMEDIRCOMS)
		   (FNS CHECKSAMEDIR HOST&DIRECTORYFIELD)

      previous date: "15-OCT-82 23:31:50" {PHYLUM}<LISP>LIBRARY>SAMEDIR.;1)


(* Copyright (c) 1982, 1984 by Xerox Corporation)

(PRETTYCOMPRINT SAMEDIRCOMS)

(RPAQQ SAMEDIRCOMS
 ((FNS CHECKSAMEDIR HOST&DIRECTORYFIELD)
		    (ADDVARS [MAKEFILEFORMS (OR (NLSETQ (CHECKSAMEDIR FILE))
						(RETFROM (QUOTE MAKEFILE]
			     (MIGRATIONS))
		    (GLOBALVARS MIGRATIONS)))
(DEFINEQ

(CHECKSAMEDIR

  [LAMBDA (FILE)                                             (* bvm: "20-Mar-84 15:38")

    (PROG ((DATES (GETP FILE (QUOTE FILEDATES)))
	   HOST/DIR HOST DIR LST NEWV OKHOST/DIRS)
      AGAIN
          (OR (LISTP DATES)
	      (RETURN))
          [SETQ OKHOST/DIRS (CONS (SETQ HOST/DIR (DIRECTORYNAME T T))
				  (MKLIST (CDR (FASSOC HOST/DIR MIGRATIONS]
          (SELECTQ (SYSTEMTYPE)
		   (TOPS20                                   (* Remove devices for now)

			   (for
 HD in
 OKHOST/DIRS collect
 (OR (FILENAMEFIELD HD (QUOTE DIRECTORY))
							      HD)))
		   NIL)
          (COND
	    ((for
 OLDFILE in
 DATES bind
 HOST DIR never
 (SELECTQ (SYSTEMTYPE)
								(D (FMEMB (HOST&DIRECTORYFIELD

									    (CDR OLDFILE))
									  OKHOST/DIRS))
								(FMEMB (FILENAMEFIELD (CDR OLDFILE)
										      (QUOTE 
											DIRECTORY))
								       OKHOST/DIRS)))
	      (SELECTQ [ASKUSER
			 12Q
			 (QUOTE Y)
			 (LIST (QUOTE "You haven't loaded or written")
			       FILE
			       (QUOTE "in your connected directory")
			       HOST/DIR
			       (QUOTE "-- should I write it out anyway"))
			 (NCONC [AND (GETD (QUOTE CNDIR))
				     (LIST (LIST (QUOTE O)
						 (CONCAT "ops!  Connect to "
							 [SETQ HOST/DIR
							   (SELECTQ (SYSTEMTYPE)
								    (D (HOST&DIRECTORYFIELD

									 (CDAR DATES)))
								    (FILENAMEFIELD (CDAR DATES)
										   (QUOTE DIRECTORY]
							 " [confirm] ")
						 (QUOTE CONFIRMFLG)
						 T)
					   (QUOTE (C "onnect to other directory: "]
				(QUOTE ((Y "es, write it here
")
					 (N "o, abort MAKEFILE
")
					 (E "XEC
"]
		       (Y (RETURN))
		       (N (ERROR!))
		       (E (SELECTQ (SYSTEMTYPE)
				   [(TENEX TOPS20)
				     (EVAL (CADR (FASSOC (QUOTE EXEC)
							 LISPXMACROS]
				   (USEREXEC (QUOTE MAKEFILEXEC>)))
			  (GO AGAIN))
		       (C (SETQ HOST/DIR))
		       (O)
		       (SHOULDNT))
	      [NLSETQ (CNDIR (OR HOST/DIR (READ T T]
	      (GO AGAIN))
	    ((AND [SETQ NEWV (INFILEP (PACKFILENAME (QUOTE VERSION)
						    NIL
						    (QUOTE BODY)
						    (CDAR DATES]
		  (NEQ NEWV (CDAR DATES)))
	      (SELECTQ (ASKUSER 17Q (QUOTE Y)
				(LIST (CDAR DATES)
				      "is not the most recent version (version"
				      (MKSTRING (FILENAMEFIELD NEWV (QUOTE VERSION)))
				      "has since appeared)." "Do you want to make the file anyway"))
		       (Y)
		       (N (ERROR!))
		       (SHOULDNT])

(HOST&DIRECTORYFIELD

  [LAMBDA (FILENAME)                                         (* bvm: "20-Mar-84 15:23")

                                                             (* Returns the host&dir fields packed together)

    (for
 TAIL on
 (UNPACKFILENAME FILENAME) by
 (CDDR TAIL) do
 [COND
							       ((FMEMB (CAR TAIL)
								       (QUOTE (HOST DIRECTORY DEVICE))
								       )
								 (push
 $$VAL (CAR TAIL)
								       (CADR TAIL]
       finally
 (RETURN (PACKFILENAME $$VAL])
)

(ADDTOVAR MAKEFILEFORMS
 (OR (NLSETQ (CHECKSAMEDIR FILE))
			    (RETFROM (QUOTE MAKEFILE))))

(ADDTOVAR MIGRATIONS
 )
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS MIGRATIONS)
)
(PUTPROPS SAMEDIR COPYRIGHT ("Xerox Corporation" 3676Q 3700Q))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1034Q 6677Q (CHECKSAMEDIR 1046Q . 5662Q) (HOST&DIRECTORYFIELD 5664Q . 6675Q)))))
STOP