(FILECREATED " 3-Jul-84 00:48:35" {INDIGO}<LOOPS>SOURCES>LOADLOOPS.;93 21561  

      changes to:  (FNS LOADLOOPS)
		   (VARS LoopsPatchFiles)

      previous date: "21-Jun-84 23:41:15" {INDIGO}<LOOPS>SOURCES>LOADLOOPS.;92)


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

(PRETTYCOMPRINT LOADLOOPSCOMS)

(RPAQQ LOADLOOPSCOMS [(* Copyright (c)
			 1982 by Xerox Corporation)
	(* LoopsDate is set each time one makes a new LOADLOOPS file. This means that ordinary 
	   loading (LOADLOOPS)
	   will get the LoopsDate from when LOADLOOPS was made.)
	(E (SETQ LoopsDate (SUBSTRING (DATE)
				      1 9)))
	(FNS CopyFilesUsingSpecs DebugLoops ForceLoadFonts LOADDEMO LOADLOOPS LoopsTeditQuit 
	     NewRelease TESTLOOPS TesterSystem LOADTRUCKIN LOADCOURSE UnMarkChanges WAITMS WAITPAGEFN)
	(VARS LOOPSCOURSEDIR LOOPSDIRECTORY LOOPSFILES SMALLLOOPSFILES TESTCOMPILEDFILES TESTFILES 
	      TESTSOURCEFILES RULESFILES ReleaseFilesSpec TRUCKINDIR TRUCKINFILES PLAYERFILES 
	      PLAYERSDIR DEMODIR DEMOFILES LOOPSCOURSEFILES LOOPSCOURSEFILESDIR LispUserFilesForLoops 
	      OptionalLispuserFiles LispUserFilesForTruckin LoopsDate LoopsPatchFiles)
	(* Now set Lisp flags standardly for Loops)
	(GLOBALVARS WaitMSTimer \FIXP)
	(VARS (WaitMSTimer (SETUPTIMER 0)))
	(* * The function SetNetwork must be modified for use on any machine which will not respond 
	   to the function (ETHERHOSTNUMBER)
	   %. It is called by DB-InitUI which is called every time the user starts up. The variable 
	   NETNUMBER is set by SetNetwork and used in generating unique ids. It is set here to 0 as a 
	   default.)
	(INITVARS (NETNUMBER 0))
	(FNS SetNetwork)
	(* * Some utility functions and macros we like having around)
	(FNS DE FILE i/d PPI PPR LOOPSDIR PROJECTDIR)
	(LISPXMACROS ok)
	(USERMACROS SHOWD FV)
	(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA PPR FILE DE)
									      (NLAML)
									      (LAMA])



(* Copyright (c) 1982 by Xerox Corporation)




(* LoopsDate is set each time one makes a new LOADLOOPS file. This means that ordinary loading 
(LOADLOOPS) will get the LoopsDate from when LOADLOOPS was made.)

(DEFINEQ

(CopyFilesUsingSpecs
  [LAMBDA (specs toDir)                                      (* sm: "27-SEP-83 15:12")
                                                             (* copies files specified in specs to toDir)

          (* specs format: ((files dir flg) .. (files dir flg)). files -
	  lispvar which evals to list of files or a list of files. flg -
	  C compiled only. S file only. B both file and its compiled version)


    (PROG (fromDir files option (status T)
		   copied)
          [for x in specs
	     do [SETQ files (COND
		    [(LITATOM (CAR x))
		      [SETQ y (NLSETQ (EVALV (CAR x]
		      (COND
			((NULL y)
			  (printout TTY "Cannot carryout specs: " x T)
			  NIL)
			(T (CAR y]
		    (T (CAR x]
		(SETQ fromDir (CADR x))
		(COND
		  [files [SETQ option (COND
			     ((NULL (CDDR x))
			       (QUOTE C))
			     (T (CADDR x]
			 (COND
			   ((FMEMB option (QUOTE (S B)))
			     [SETQ copied (for z in files collect (COPYFILE (MKATOM (CONCAT fromDir z)
										    )
									    (MKATOM (CONCAT toDir z]
			     (COND
			       ((FMEMB NIL copied)
				 (SETQ status NIL)))
			     (printout TTY "Copied source files: " files " from: " fromDir " to :" 
				       toDir T)))
			 (COND
			   ((FMEMB option (QUOTE (C B)))
			     [SETQ copied (for z in files collect (COPYFILE (MKATOM (CONCAT fromDir z 
											  ".DCOM"))
									    (MKATOM (CONCAT toDir z 
											  ".DCOM"]
			     (COND
			       ((FMEMB NIL copied)
				 (SETQ status NIL)))
			     (printout TTY "Copied compiled files: " files " from: " fromDir " to :" 
				       toDir T]
		  (T (SETQ status NIL]
          (RETURN status])

(DebugLoops
  [LAMBDA (turnOffFlg)                                       (* dgb: "19-Jun-84 15:26")

          (* Add LOOPSFILES to FILELST and {INDIGO}<LOOPS>SOURCES> to directories, or reverse if turnOffFlg =T.
	  Used to put Loops into a mode for debugging Loops system code.)


    (COND
      (turnOffFlg (SETQ FILELST (for x in FILELST when (NOT (FMEMB x LOOPSFILES)) collect x))
		  (SETQ DIRECTORIES (for x in DIRECTORIES when (NEQ x (QUOTE {INDIGO}<LOOPS>SOURCES>))
				       collect x))
		  (CNDIR))
      (T (SETQ FILELST (UNION LOOPSFILES FILELST))
	 (SETQ DIRECTORIES (UNION (LIST (QUOTE {INDIGO}<LOOPS>SOURCES>))
				  DIRECTORIES))
	 (LOOPSDIR)
	 (for FILE in LOOPSFILES do (AND (GETPROP FILE (QUOTE FILEDATES))
					 (OR (GETPROP FILE (QUOTE FILE))
					     (LOADFNS NIL (PACK* FILE ".DCOM")
						      (QUOTE ALLPROP)
						      (QUOTE VARS])

(ForceLoadFonts
  [LAMBDA NIL                                                (* sm: " 3-AUG-83 13:43")
                                                             (* force different fonts to be loaded in)
    (PROG NIL
          (NEWFONT (QUOTE BIG))
          (NEWFONT (QUOTE PARC])

(LOADDEMO
  [LAMBDA NIL                                                (* dgb: "18-Jun-84 14:56")
                                                             (* Load GAUGES on the property list so one can examine 
							     it for the course Then load truckin and demo files)
    (OR (FMEMB DEMODIR DIRECTORIES)
	(SETQ DIRECTORIES (UNION (LIST DEMODIR LOOPSCOURSEFILESDIR)
				 DIRECTORIES)))
    (LOADTRUCKIN)
    (DOFILESLOAD DEMOFILES)
    (for FILE in LOOPSCOURSEFILES do (LOAD FILE))
    (for FILE in (QUOTE (GAUGES TRUCKINP TRUCKINV TRUCKINDB LOOPSDEMO)) do (LOAD FILE (QUOTE PROP)))
    (ForceLoadFonts])

(LOADLOOPS
  [LAMBDA (option sysoutFlg connectDirectory noScreenSetup)
                                                             (* dgb: " 3-Jul-84 00:10")
    (SETQ option (U-CASE option))
    (CNDIR (OR connectDirectory LOOPSDIRECTORY))
    (SETQ option (SELECTQ option
			  (SMALL (QUOTE SMALLLOOPS))
			  (NIL (QUOTE LOOPS))
			  (DEMO (QUOTE LOOPSDEMO))
			  option))
    (COND
      ((EQ option (QUOTE ?))
	(PRINT 
"LOADLOOPS cases:
option=LOOPS, Standard Loops Loadup
option=SMALLLOOPS Standard not including
  LOOPSDATABASE, GAUGES, or RULESFILES files
option=LOOPSDEMO Standard minus LOOPSDATABASE plus DemoFiles  and files needed for standalone LoopsCourse
option=?, prints this message.
 If sysoutFlg not equal to NIL,
 then ends with a (SYSOUT <option>.SYSOUT).
 If sysoutFlg=T does it to connected directory, else
does a (CNDIR sysoutFlg)
"
	       T)
	NIL)
      ([NOT (FMEMB option (QUOTE (LOOPS SMALLLOOPS LOOPSDEMO ?]
	
"Bad option. option can be one of (LOOPS SMALLLOOPS LOOPSDEMO ?).
For more information type
LOADLOOPS(?)")
      (T (PROG (LISPXHIST LISPXHISTORY)                      (* Binding these variables so history is not saved)
	       (DOFILESLOAD (CONS (QUOTE (SYSLOAD NOERROR FROM LISPUSERS))
				  (APPEND OptionalLispuserFiles LispUserFilesForLoops)))
	       (AND LoopsPatchFiles (DOFILESLOAD LoopsPatchFiles))
	       (SETQ LispDate (SUBSTRING MAKESYSDATE 1 9))
	       (SETQ LoopsDate (SUBSTRING (DATE)
					  1 15))
	       [DOFILESLOAD (CONS (QUOTE COMPILED)
				  (SELECTQ option
					   (SMALLLOOPS SMALLLOOPSFILES)
					   [LOOPSDEMO (LDIFFERENCE (CDR LOOPSFILES)
								   (QUOTE (LOOPSDATABASE]
					   (CDR LOOPSFILES]
	       (MOVD (QUOTE FullInstallMethod)
		     (QUOTE InstallMethod))
	       (AND (FNTYP (QUOTE TEDIT))
		    (TEDIT.SETFUNCTION 24 (FUNCTION LoopsTeditQuit)
				       TEDIT.READTABLE))
	       (COND
		 ((EQ option (QUOTE LOOPSDEMO))
		   (LOADDEMO)
		   (SetUpDemo))
		 ((NULL noScreenSetup)
		   (SetUpScreen)))
	       [COND
		 ((NOT (MEMBER (QUOTE (DB-InitUI))
			       AFTERSYSOUTFORMS))
		   [SETQ AFTERSYSOUTFORMS (APPEND AFTERSYSOUTFORMS (LIST (QUOTE (DB-InitUI]
		   (SETQ AFTERLOGOUTFORMS (APPEND AFTERLOGOUTFORMS (LIST (QUOTE (DB-InitUI]
                                                             (* Don't save any record of changes that have been made 
							     in loading)
	       (UnMarkChanges)
	       (SETQ FILELST NIL)
	       (SETQ LOGINHOST/DIR NIL)
	       (SETQ INITIALSLST)
	       (SETQ USERNAME NIL)
	       (SETQ FIRSTNAME (QUOTE SirOrMadam))
	       (SETPROPLIST (QUOTE KBINIT))                  (* Set directories etc to Lisp vanilla)
	       (CLEARW TTY))
	 (ENDLOADUP)
	 (COND
	   (sysoutFlg (COND
			((NEQ T sysoutFlg)
			  (/CNDIR sysoutFlg)))
		      (MAKESYS (PACK* option ".SYSOUT")
			       option])

(LoopsTeditQuit
  [LAMBDA (stream value)                                     (* dgb: "30-Apr-84 17:56")
    (TEDIT.QUIT stream (COND
		  ((STRINGP value)
		    value)
		  ((type? TEXTOBJ value)
		    (COERCETEXTOBJ value (QUOTE STRINGP)))
		  (T (ERROR value "wrong type"])

(NewRelease
  [LAMBDA (indigoPass maxcPass date)                         (* sm: "28-SEP-83 10:49")
                                                             (* makes a new release of Loops by copying files first 
							     to IndigoReleaseDir and then to MaxcReleaseDir)
                                                             (* date if passed is the subdir used for 
							     IndigoReleaseDir else current date is used)
    (PROG (indigoDir sourceDir status IndigoCleanupCommd MaxcReleaseCommd)
          (OR indigoPass (SETQ indigoPass (INTTY "Enter your Indigo password: ")))
          (OR maxcPass (SETQ maxcPass (INTTY "Enter password for Maxc Loops directory: ")))
          [COND
	    (date)
	    (T (SETQ date (SUBSTRING (GDATE)
				     1 9]
          (SETQ sourceDir (MKATOM (CONCAT IndigoReleaseDir date ">")))
          (SETQ indigoDir (MKATOM (CONCAT "{indigo}" sourceDir)))
          (SETQ IndigoCleanupCommd (CONCAT "dir " sourceDir "
" "del *,
conf

" "q
"))
          (CHAT (QUOTE INDIGO)
		NIL IndigoCleanupCommd)
          (SETQ status (CopyFilesUsingSpecs ReleaseFilesSpec indigoDir))
          (COND
	    ((NOT status)
	      (printout TTY "Files not copied properly to: " indigoDir T "RELEASE ABORTED!!" T)
	      (RETURN NIL)))
          (SETQ MaxcReleaseCommd (CONCAT "1
" "CONN loops " maxcPass "
" "del *.*
" "pupftp indigo
" "log " (USERNAME)
					 indigoPass "
" "automatic ret " sourceDir "*
" "q
" "logout
" (CHARACTER 3)
					 "logout
"))
          (CHAT (QUOTE MAXC)
		NIL MaxcReleaseCommd])

(TESTLOOPS
  [LAMBDA (SOURCESFLG)                                       (* dgb: "19-Jun-84 14:55")
                                                             (* Load tester -- use symbolics if SOURCEFLG=T and run 
							     test once)
    (SETQ DIRECTORIES (UNION (LIST (QUOTE {INDIGO}<LOOPS>SOURCES))
			     DIRECTORIES))
    [COND
      (SOURCESFLG (PROGN (for x in (QUOTE (LTBASIC LTKER LTDB LTCASES)) do (LOAD x))
			 (SETQ LTLOADEDREST T)))
      (T (LOAD (QUOTE LTBASIC.DCOM]
    (TestForever 0])

(TesterSystem
  [LAMBDA NIL                                                (* sm: " 5-AUG-83 10:13")

          (* * Initialize LoopsDemo for Lisp/Loops course -- offered at Leesburg.)

                                                             (* Try to force different fonts to be loaded for 
							     isolated version)
    (ForceLoadFonts)
    (LOAD (QUOTE {PHYLUM}<LISPCORE>SOURCES>FILEBROWSER.DCOM))
    (SETQ FILELST NIL)
    (LOAD (QUOTE LTBASIC.DCOM))
    (LoadLTSystemCI)
    (LOAD (QUOTE LTCASES))
    (SETQ LeesburgFlg T)
    (CHANGENAME (QUOTE \SET.TTYINBOLDFONT)
		(QUOTE FONTCOPY)
		(QUOTE EVQ))
    (SETQ LOOPSCOURSEDIR (QUOTE {FS:}<LOOPSCOURSE>))
    (SETQ LISPUSERSDIRECTORIES NIL)
    (SETQ FONTDIRECTORIES NIL)
    (SETQ NS.DEFAULT.PRINTER (QUOTE LISPPRINT))
    (SETQ USERNAME (QUOTE NotLoggedIn))
    (PRINTERMODE (QUOTE INTERPRESS))
    (SETQ DEMOFLGSETUP T)
    (SETQ DIRECTORIES (LIST NIL (QUOTE {FS:}<LOOPS>])

(LOADTRUCKIN
  [LAMBDA (sourceFlg)                                        (* sm: " 9-SEP-83 12:53")
    (PROG NIL

          (* * Load the necessary files.)


          (APPLY (QUOTE FILESLOAD)
		 (CONS (QUOTE (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES))
		       LispUserFilesForTruckin))
          [OR (FMEMB PLAYERSDIR DIRECTORIES)
	      (COND
		((NULL DIRECTORIES)
		  (SETQ DIRECTORIES (LIST PLAYERSDIR)))
		(T (RPLACD DIRECTORIES (CONS PLAYERSDIR (CDR DIRECTORIES]
          [OR (FMEMB TRUCKINDIR DIRECTORIES)
	      (COND
		((NULL DIRECTORIES)
		  (SETQ DIRECTORIES (LIST TRUCKINDIR)))
		(T (RPLACD DIRECTORIES (CONS TRUCKINDIR (CDR DIRECTORIES]
          (COND
	    (sourceFlg (for F in TRUCKINFILES do (LOAD F)))
	    (T (DOFILESLOAD TRUCKINFILES)))                  (* (LOAD (QUOTE LOOPSGATEWAY.DCOM)))

          (* * Initialize the game.)


          (InitializeTruckin)

          (* * Load the Truckin Player files.)


          (COND
	    (sourceFlg (for F in PLAYERFILES do (LOAD F)))
	    (T (DOFILESLOAD PLAYERFILES)))
          (RETURN NIL])

(LOADCOURSE
  [LAMBDA NIL                                                (* sm: " 9-SEP-83 17:03")
                                                             (* loads the files needed for the lisp part of the 
							     loops/lisp course)
    (PROG NIL
          [SETQ DIRECTORIES (CONS NIL (CONS LOOPSCOURSEFILESDIR (CDR DIRECTORIES]

          (* * Load exercises for the Lisp part of the course.)


          (for FILE in LOOPSCOURSEFILES do (LOAD FILE])

(UnMarkChanges
  [LAMBDA (FILES)                                            (* dgb: " 9-Mar-84 11:16")

          (* * Unmark all changes that have been made and forget files to list and compile)


    (PROG (COMTYPE)
          (SETQ NOTLISTEDFILES NIL)
          (SETQ NOTCOMPILEDFILES NIL)
          [for COM in (MakeChangeComs (QUOTE OLDCHANGES)
				      FILES)
	     do (COND
		  ((NEQ (SETQ COMTYPE (CAR COM))
			(QUOTE *))
		    (for ITEM in (CDR COM) do (UNMARKASCHANGED ITEM COMTYPE]
          (RETURN OLDCHANGES])

(WAITMS
  [LAMBDA (numMS)                                            (* sm: " 9-AUG-83 02:33")
    (forDuration (ITIMES numMS \RCLKMILLISECOND) timerUnits (QUOTE TICKS) usingTimer WaitMSTimer
       do NIL)
    T])

(WAITPAGEFN
  [LAMBDA NIL                                                (* dgb: " 7-JUN-82 11:46")
    (PROG NIL
      LP  (COND
	    ((KEYDOWNP (QUOTE CTRL))                         (* WAIT IF THE CTRL KEY IS DOWN)
	      (COND
		((KEYDOWNP (QUOTE LSHIFT))                   (* Hold page using ordinary page full fn if no 
							     typeahead)
		  (RETURN NIL)))
	      (GO LP)))
          (COND
	    (WAITPAGEFLG                                     (* Use ordinary function if WAITPAGEFLG is T)
			 (RETURN NIL)))
          (RETURN T])
)

(RPAQQ LOOPSCOURSEDIR "{IVY}<LOOPSCOURSE>")

(RPAQQ LOOPSDIRECTORY {INDIGO}<LOOPS>SOURCES)

(RPAQQ LOOPSFILES (LOADLOOPS BLOCKLOOKUP LOOPSSCREEN LOOPSSTRUC LOOPSPRINT LOOPSACCESS LOOPSUID 
			     LOOPSAV LOOPSEDIT LOOPSMETHODS LOOPSKERNEL LOOPSUTILITY LOOPSMIXIN 
			     LOOPSDATABASE LOOPSINSPECT LOOPSWINDOW LOOPSBROWSE LOOPSRULES 
			     LOOPSRULESP LOOPSRULESC LOOPSRULESD GAUGES))

(RPAQQ SMALLLOOPSFILES (LOADLOOPS BLOCKLOOKUP LOOPSSCREEN LOOPSSTRUC LOOPSPRINT LOOPSACCESS LOOPSUID 
				  LOOPSAV LOOPSEDIT LOOPSMETHODS LOOPSKERNEL LOOPSUTILITY LOOPSMIXIN 
				  LOOPSINSPECT LOOPSWINDOW LOOPSBROWSE))

(RPAQQ TESTCOMPILEDFILES (LTBASIC LTBCLS LTCASES LTDB LTKER LTLOAD))

(RPAQQ TESTFILES (LTBASIC LTBCLS LTCASES LTDB LTKER LTLOAD LT1.KB))

(RPAQQ TESTSOURCEFILES (LT1.KB))

(RPAQQ RULESFILES (LOOPSRULES LOOPSRULESP LOOPSRULESC LOOPSRULESD))

(RPAQQ ReleaseFilesSpec ((LOOPSFILES {indigo}<LOOPS>SOURCES> B)
			 (TRUCKINFILES {indigo}<loops>truckin>multi> B)
			 (PLAYERFILES {indigo}<loops>truckin>multi> B)
			 (DEMOFILES {indigo}<LOOPS>demo> B)
			 (TESTSOURCEFILES {indigo}<LOOPS>SOURCES> S)
			 (TESTCOMPILEDFILES {indigo}<LOOPS>SOURCES> B)))

(RPAQQ TRUCKINDIR {INDIGO}<LOOPS>TRUCKIN>MULTI)

(RPAQQ TRUCKINFILES (TRUCKIN TRUCKINM TRUCKINR TRUCKINI TRUCKINDB TRUCKINP TRUCKINV LOOPSGATEWAY))

(RPAQQ PLAYERFILES (TRAVELER PEDDLER PLANNER))

(RPAQQ PLAYERSDIR {INDIGO}<LOOPS>TRUCKIN>MULTI)

(RPAQQ DEMODIR {INDIGO}<LOOPS>DEMO>)

(RPAQQ DEMOFILES (LOOPSDEMO))

(RPAQQ LOOPSCOURSEFILES (EXERCISE1 SIMPLEG TRANSLATE DEMOSCRIPT))

(RPAQQ LOOPSCOURSEFILESDIR {INDIGO}<LOOPS>COURSE>)

(RPAQQ LispUserFilesForLoops (GRAPHER ICONW TTY HISTMENU TMENU INMENU READNUMBER ANIMATE))

(RPAQQ OptionalLispuserFiles (PAGEHOLD SINGLEFILEINDEX PATCHUP BROWSER CROCK))

(RPAQQ LispUserFilesForTruckin (EVALSERVER LLCOLOR COLOR))

(RPAQQ LoopsDate " 3-Jul-84")

(RPAQQ LoopsPatchFiles ({ERIS}<TEDIT>TEDITHCPYPATCH.DCOM))



(* Now set Lisp flags standardly for Loops)

(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS WaitMSTimer \FIXP)
)

(RPAQ WaitMSTimer (SETUPTIMER 0))
(* * The function SetNetwork must be modified for use on any machine which will not respond to 
the function (ETHERHOSTNUMBER) %. It is called by DB-InitUI which is called every time the user
 starts up. The variable NETNUMBER is set by SetNetwork and used in generating unique ids. It 
is set here to 0 as a default.)


(RPAQ? NETNUMBER 0)
(DEFINEQ

(SetNetwork
  [LAMBDA NIL                                                (* edited: " 6-JUL-83 17:07")

          (* Fn to set the NETNUMBER. This is a 14-bit number used in generating unique identifiers in LOOPS..
	  This number should be unique across machines whose users intend to share knowledge bases.)


    (PROG (etherHostNumber)
          (SETQ etherHostNumber (ETHERHOSTNUMBER))
          (COND
	    ((ZEROP etherHostNumber)
	      (HELPCHECK 
       "Help -- The ETHERHOSTNUMBER is zero.  LOOPS uses this number to make unique identifiers."))
	    (T (SETQ NETNUMBER (RSH (ETHERHOSTNUMBER)
				    8])
)
(* * Some utility functions and macros we like having around)

(DEFINEQ

(DE
  [NLAMBDA L                                                 (* dgb: "26-JUN-83 12:37")
                                                             (* Shorthand for defining functions.)
    (DEFINE (COND
	      ((LISTP (CAR L))
		L)
	      (T (LIST L)))
	    T])

(FILE
  [NLAMBDA ARGS                                              (* dgb: "26-JUN-83 12:38")

          (* * Allows one to create a file giving the commands explicitly e.g. -
	  (FILE FOO (VARS * FUMVARS) (FNS * FNSLIST)) -
	  will create FOOCOMS and make file FOO)


    [COND
      ((CDR ARGS)
	(/SETATOMVAL (FILECOMS (CAR ARGS))
		     (COND
		       ((AND (LITATOM (CADR ARGS))
			     (NULL (CDDR ARGS)))
			 (GETATOMVAL (CADR ARGS)))
		       (T (CDR ARGS]
    (RESETFORM (RADIX 10)
	       (MAKEFILE (CAR ARGS])

(i/d
  [LAMBDA (item)                                             (* dgb: " 3-DEC-82 01:46")
                                                             (* short form of call)
    (INSPECT/DATATYPE item])

(PPI
  [LAMBDA (INSTANCE RECORDNAME FILE)                         (* dgb: " 3-DEC-82 01:46")
                                                             (* Pretty-prints an instance of a record.)
    (PROG [(POS (ADD1 (POSITION FILE)))
	   (DEC (RECLOOK (OR RECORDNAME (COND
			       ((LISTP INSTANCE)
				 (CAR INSTANCE))
			       (T (TYPENAME INSTANCE]
          (COND
	    (DEC (printout FILE "[" %# (for FIELD in (RECORDFIELDNAMES DEC)
					  unless (EQ FIELD (QUOTE PERFORMOPS))
					  do (printout NIL .TAB0 POS .P2 FIELD " = " .PPV
						       (RECORDACCESS FIELD INSTANCE DEC)))
			   "]" T))
	    (T (printout FILE .PPV INSTANCE T])

(PPR
  [NLAMBDA X                                                 (* dgb: " 3-DEC-82 01:47")
                                                             (* Prettyprints the record definition of record name 
							     given.)
    (RESETFORM (OUTPUT T)
	       (MAPC (OR (LISTP X)
			 (LIST X))
		     (FUNCTION (LAMBDA (R)
			 [PRINTDEF (OR (APPEND (RECLOOK R)
					       (FIELDLOOK R))
				       (CONS R (QUOTE (not found]
			 (TERPRI T])

(LOOPSDIR
  [LAMBDA (SUBDIR)                                           (* dgb: " 8-JUN-83 11:16")

          (* * Connects to the directory for saving LOOPS sources.)


    (/CNDIR (PACK* (QUOTE {INDIGO}<LOOPS>)
		   (OR SUBDIR (QUOTE SOURCES])

(PROJECTDIR
  [LAMBDA (subDirectory)                                     (* mjs: "14-JUL-82 16:47")
    (/CNDIR (CONCAT (QUOTE {INDIGO}<KBVLSI>)
		    (OR subDirectory (QUOTE LISP))
		    (QUOTE >])
)

(ADDTOVAR LISPXMACROS (ok (RETFROM (OR (STKPOS (QUOTE USEREXEC))
				       (QUOTE LISPX))
				   T T)))

(ADDTOVAR EDITMACROS (FV NIL (E (FREEVARS (%#%# (ORR (UP 1)
						     NIL))
					  T)))
	  [SHOWD NIL UP
		 (ORR ((E (RESETFORM (OUTPUT T)
				     (PROGN (PRINTDEF (OR [EDITGETD (%#%# 1)
								    (AND (CDR L)
									 (EDITL0 L (QUOTE (!0]
							  (ERROR!))
						      NIL T)
					    (TERPRI)))
			  T))
		      ((E (QUOTE SHOWD?])

(ADDTOVAR EDITCOMSA SHOWD FV)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA PPR FILE DE)

(ADDTOVAR NLAML )

(ADDTOVAR LAMA )
)
(PUTPROPS LOADLOOPS COPYRIGHT ("Xerox Corporation" 1983 1984))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (2157 14944 (CopyFilesUsingSpecs 2167 . 3872) (DebugLoops 3874 . 4801) (ForceLoadFonts 
4803 . 5099) (LOADDEMO 5101 . 5763) (LOADLOOPS 5765 . 8609) (LoopsTeditQuit 8611 . 8896) (NewRelease 
8898 . 10467) (TESTLOOPS 10469 . 11004) (TesterSystem 11006 . 11969) (LOADTRUCKIN 11971 . 13080) (
LOADCOURSE 13082 . 13575) (UnMarkChanges 13577 . 14136) (WAITMS 14138 . 14376) (WAITPAGEFN 14378 . 
14942)) (17467 18108 (SetNetwork 17477 . 18106)) (18177 20842 (DE 18187 . 18466) (FILE 18468 . 19007) 
(i/d 19009 . 19226) (PPI 19228 . 19913) (PPR 19915 . 20374) (LOOPSDIR 20376 . 20632) (PROJECTDIR 20634
 . 20840)))))
STOP