Google
 

Trailing-Edge - PDP-10 Archives - -
There are no other files named in the archive.
(FILECREATED "22-OCT-81 11:31:47" {PHYLUM}<LISPUSERS>SAMEDIR.;2    3076

     changes to:  CHECKSAMEDIR SAMEDIRCOMS

     previous date: "22-OCT-81 11:29:37" {PHYLUM}<LISPUSERS>SAMEDIR.;1
)

(* copyright (c) 1981 Xerox Corporation)

(PRETTYCOMPRINT SAMEDIRCOMS)

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

(CHECKSAMEDIR
  [LAMBDA (FILE)                                             (* bvm: "22-OCT-81 11:28")
    (PROG ((DATES (GETP FILE (QUOTE FILEDATES)))
	   HOST/DIR DIR2 HOST DIR LST NEWV)
      AGAIN
          (OR (LISTP DATES)
	      (RETURN))
          (SETQ HOST/DIR (DIRECTORYNAME T T))
          [SETQ DIR (SELECTQ (SYSTEMTYPE)
			     (TENEX HOST/DIR)
			     (TOPS20 (SETQ HOST/DIR (OR (FILENAMEFIELD HOST/DIR (QUOTE DIRECTORY))
							HOST/DIR)))
			     (PROGN (SETQ DIR (UNPACKFILENAME HOST/DIR))
				    (SETQ HOST (LISTGET DIR (QUOTE HOST)))
				    (LISTGET DIR (QUOTE DIRECTORY]
          (SETQ DIR2 (CDR (FASSOC HOST/DIR MIGRATIONS)))
          (COND
	    ([NOTANY DATES (FUNCTION (LAMBDA (X)
			 (SELECTQ (SYSTEMTYPE)
				  [(ALTO D)
				    (SETQ LST (UNPACKFILENAME (CDR X)))
				    (OR [NULL (SETQ X (LISTGET LST (QUOTE HOST]
					(AND (EQ X HOST)
					     (EQ (LISTGET LST (QUOTE DIRECTORY))
						 DIR))
					(AND DIR2 (EQ X (FILENAMEFIELD DIR2 (QUOTE HOST)))
					     (EQ (LISTGET LST (QUOTE DIRECTORY))
						 (FILENAMEFIELD DIR2 (QUOTE HOST]
				  (OR [NULL (SETQ X (FILENAMEFIELD (CDR X)
								   (QUOTE DIRECTORY]
				      (EQ X DIR)
				      (EQ X DIR2]
	      (SELECTQ [ASKUSER 10 (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 (QUOTE (C "onnect to: "]
				       (QUOTE ((Y "es
")
						(N "o
")
						(E "XEC
"]
		       (Y)
		       (N (ERROR!))
		       (E (SELECTQ (SYSTEMTYPE)
				   [(TENEX TOPS20)
				     (EVAL (CADR (FASSOC (QUOTE EXEC)
							 LISPXMACROS]
				   (USEREXEC (QUOTE MAKEFILEXEC>)))
			  (GO AGAIN))
		       (C (NLSETQ (CNDIR (READ T T)))
			  (GO AGAIN))
		       (SHOULDNT)))
	    ((AND [SETQ NEWV (INFILEP (PACKFILENAME (QUOTE VERSION)
						    NIL
						    (QUOTE BODY)
						    (CDAR DATES]
		  (NEQ NEWV (CDAR DATES)))
	      (SELECTQ (ASKUSER 15 (QUOTE Y)
				(LIST (CDAR DATES)
				      "is not the most recent version (version"
				      (FILENAMEFIELD NEWV (QUOTE VERSION))
				      "has since appeared)." "Do you want to make the file anyway"))
		       (Y)
		       (N (ERROR!))
		       (SHOULDNT])
)

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

(ADDTOVAR MIGRATIONS )
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS MIGRATIONS)
)
(DECLARE: DONTCOPY
  (FILEMAP(NIL (477 2847 (CHECKSAMEDIR 489 . 2844)))))
STOP