(FILECREATED "11-Mar-85 16:13:08" {ERIS}<LISPCORE>SOURCES>FILEPKG.;50
 191150 

      changes to:  (FNS EDITFROMFILE)

      previous date: "18-Feb-85 15:33:47" {ERIS}<LISPCORE>SOURCES>FILEPKG.;49)


(* Copyright (c) 1982, 1983, 1984, 1985 by Xerox Corporation. All rights reserved. The following 
program was created in 1982  but has not been published within the meaning of the copyright law, is 
furnished under license, and may not be used, copied and/or disclosed except in accordance with the 
terms of said license.)

(PRETTYCOMPRINT FILEPKGCOMS)

(RPAQQ FILEPKGCOMS
 [(COMS (* 
	"standard records for accessing file package type/command parts. Exported for 
	  PRETTY")
			  (FNS FILEPKGCOMPROPS)
			  (EXPORT (DECLARE: EVAL@COMPILE DONTCOPY (RECORDS * FILEPKGRECORDS)))
			  (FNS SEARCHPRETTYTYPELST PRETTYDEFMACROS)
			  (INITRECORDS * FILEPKGRECORDS))
	(INITVARS (MSDATABASELST))
	(* * "making, adding, listing, compiling files")
	(FNS CLEANUP COMPILEFILES COMPILEFILES0 CONTINUEDIT MAKEFILE FILECHANGES FILEPKG.MERGECHANGES 
	     FILEPKG.CHANGEDFNS MAKEFILE1 MAKEFILES ADDFILE ADDFILE0 LISTFILES)
	(INITVARS (FILELST)
		  (LOADEDFILELST)
		  (NOTLISTEDFILES)
		  (NOTCOMPILEDFILES)
		  (MAKEFILEFORMS)
		  (NILCOMS))
	(ADDVARS (MAKEFILEOPTIONS RC C LIST FAST CLISP CLISPIFY NIL REMAKE NEW NOCLISP CLISP%  F ST 
				  STF (REC . RC)
				  (BREC . RC)
				  (TC . C)
				  (BC . C)
				  (TCOMPL . C)
				  (BCOMPL . C)))
	[INITVARS (MAKEFILEREMAKEFLG T)
		  (CLEANUPOPTIONS (QUOTE (RC]
	(* * "scanning file coms")
	(FNS FILEPKGCHANGES GETFILEPKGTYPE MARKASCHANGED FILECOMS WHEREIS SMASHFILECOMS FILEFNSLST 
	     FILECOMSLST UPDATEFILES INFILECOMS? INFILECOMTAIL INFILECOMS INFILECOM INFILECOMSVALS 
	     INFILECOMSVAL INFILECOMSPROP IFCPROPS IFCEXPRTYPE IFCPROPSCAN IFCDECLARE INFILEPAIRS 
	     INFILECOMSMACRO)
	(* * "adding to a file")
	(FNS FILES? FILES?1 ADDTOFILES? ADDTOFILE WHATIS ADDTOCOMS ADDTOCOM ADDTOCOM1 ADDNEWCOM 
	     MAKENEWCOM DEFAULTMAKENEWCOM)
	(INITVARS (DEFAULTCOMHASFILEFLG))
	(FNS MERGEINSERT MERGEINSERT1)
	(INITVARS [ADDTOFILEKEYLST (QUOTE ((%[ "" EXPLAINSTRING 
				       "[ -- prettyprint the item to terminal and then ask again"
					       NOECHOFLG T)
					   (%
 "" EXPLAINSTRING 
					       "{line-feed} - same as previous response"
					       NOECHOFLG T)
					   (%  " 
" EXPLAINSTRING "{space} - no action" NOECHOFLG T)
					   (%] "Nowhere
" EXPLAINSTRING "] - nowhere, item is marked as a dummy
" NOECHOFLG T)
					   [%( "List:  (" EXPLAINSTRING "(list name)" NOECHOFLG T 
					       KEYLST (( "" CONFIRMFLG (%) %] %  %
)
							  RETURN
							  (CDR ANSWER]
					   (@ "Near: " EXPLAINSTRING 
					     "@ other-item   -- put the item near the other item"
					      NOECHOFLG T KEYLST (( "" CONFIRMFLG (%
)
								     RETURN ANSWER)))
					   (%
 "" RETURN (QUOTE % ))
					   ("" "File name: " EXPLAINSTRING "a file name" KEYLST
					       (]
		  (LASTFILE))
	(* * "deleting an item from a file")
	(FNS DELFROMFILES DELFROMCOM DELFROMCOM1 DELFROMCOMS REMOVEITEM MOVETOFILE)
	(P (MOVD? (QUOTE DELFROMFILES)
		  (QUOTE DELFROMFILE))
	   (MOVD? (QUOTE MOVETOFILE)
		  (QUOTE MOVEITEM)))
	(ADDVARS (SYSPROPS PROPTYPE VARTYPE))
	(ADDVARS * (LIST (CONS (QUOTE SYSPROPS)
			       MACROPROPS)))
	(* * "functions for doing things and marking them changed and auxiliary functions")
	(FNS SAVEPUT PUTPROPS ADDTOVAR APPENDTOVAR)
	(FNS UNMARKASCHANGED PREEDITFN POSTEDITPROPS POSTEDITALISTS)
	(ADDVARS (LISPXFNS (PUT . SAVEPUT)
			   (PUTPROP . SAVEPUT)))
	(* * "sub-functions for file package commands & types")
	(FNS ALISTS.WHENCHANGED CLEARCLISPARRAY EXPRESSIONS.WHENCHANGED MAKEALISTCOMS MAKEFILESCOMS 
	     MAKELISPXMACROSCOMS MAKEPROPSCOMS MAKEUSERMACROSCOMS PROPS.WHENCHANGED)
	(ADDVARS (MACROPROPS MACRO BYTEMACRO ALTOMACRO JMACRO VAXMACRO DMACRO 10MACRO)
		 (SYSPROPS PROPTYPE))
	(PROP PROPTYPE I.S.OPR SUBR LIST CODE BRKINFO BROKEN-IN BROKEN FILEDATES FILE FILEMAP EXPR 
	      ADVICE READVICE ADVISED VALUE)
	(PROP VARTYPE BAKTRACELST BREAKMACROS COMPILETYPELST EDITMACROS ERRORTYPELST FONTDEFS 
	      LISPXHISTORYMACROS LISPXMACROS PRETTYDEFMACROS PRETTYEQUIVLST PRETTYPRINTMACROS 
	      PRETTYPRINTYPEMACROS USERMACROS)
	(PROP PROPTYPE * (PROGN MACROPROPS))
	(* * "Define the commands below AFTER the various properties have been established.")
	(USERMACROS M)
	(* * GETDEF "functions")
	(FNS RENAME CHANGECALLERS)
	(FNS SHOWDEF COPYDEF GETDEF GETDEFCOM GETDEFCOM0 GETDEFCURRENT GETDEFERR GETDEFFROMFILE 
	     GETDEFSAVED PUTDEF EDITDEF LOADDEF DWIMDEF DELDEF DELFROMLIST HASDEF GETFILEDEF SAVEDEF 
	     UNSAVEDEF COMPAREDEFS COMPARE TYPESOF)
	(* Must come after PUTDEF)
	(COMS (* * 
"how to dump FILEPKGCOMS. The SPLST must be initialized to contain FILEPKGCOMS 
     in order to get started.")
	      (FNS FILEPKGCOM FILEPKGTYPE)
	      (PROP ARGNAMES FILEPKGCOM)
	      (ADDVARS (FILEPKGCOMSPLST FILEPKGCOMS)
		       (FILEPKGTYPES FILEPKGCOMS))
	      (FILEPKGCOMS FILEPKGCOMS)
	      (FILEPKGCOMS ADVICE ALISTS DEFS EDITMACROS EXPRESSIONS FIELDS FILES FILEPKGTYPES 
			   FILEVARS FNS INITVARS INITRECORDS LISPXCOMS LISPXMACROS MACROS 
			   PRETTYDEFMACROS PROPS RECORDS SYSRECORDS USERMACROS VARS *))
	(INITVARS (SAVEDDEFS)
		  (DEFAULTRENAMEMETHOD))
	(* * EDITCALLERS)
	(FNS FINDCALLERS EDITCALLERS EDITFROMFILE FINDATS LOOKIN)
	(FNS SEPRCASE)
	(INITVARS (SEPRCASE)
		  (CLISPCASE))
	(P (MOVD? (QUOTE INFILEP)
		  (QUOTE FINDFILE))
	   (* "or else from SPELLFILE"))
	(BLOCKS (FINDATS FINDATS)
		(EDITFROMFILE EDITFROMFILE LOOKIN (GLOBALVARS EDITLOADFNSFLG)
			      (NOLINKFNS LOADFROM))
		(NIL SEPRCASE FINDCALLERS EDITCALLERS (LOCALVARS . T)
		     (GLOBALVARS SYSFILES CLISPCASE SEPRCASE CLISPFLG CLISPCHARS FCHARAR)))
	(COMS (* * EXPORT)
	      (FNS IMPORTFILE IMPORTEVAL CHECKIMPORTS GATHEREXPORTS)
	      (FILEPKGCOMS EXPORT)
	      (INITVARS (EXPORTDEFSTRING (CONCAT "(* FOLLOWING " "DEFINITIONS EXPORTED)")))
	      (BLOCKS (IMPORTFILE IMPORTFILE IMPORTEVAL)))
	(* * for GAINSPACE)
	(FNS CLEARFILEPKG)
	[ADDVARS (GAINSPACEFORMS (FILELST "erase filepkg information" (CLEARFILEPKG RESPONSE)
					  ((Y "es")
					   (N "o")
					   (E . "verything")
					   (F "ilemaps only
"]
	(BLOCKS (NIL CLEARFILEPKG (GLOBALVARS SMASHPROPSLST1)))
	(GLOBALVARS #LISTFILESCHARS #UNDOSAVES ADDTOFILEKEYLST BUILDMAPFLG CLEANUPOPTIONS CLISPARRAY 
		    CLISPIFYPRETTYFLG COMPILE.EXT DECLARETAGSLST DEFAULTRENAMEMETHOD DFNFLG 
		    DWIMESSGAG DWIMFLG DWIMIFYCOMPFLG DWIMLOADFNSFLG DWIMWAIT FILELST FILEPKGCOMSPLST 
		    FILEPKGFLG FILEPKGTYPES FILERDTBL FONTCHANGEFLG HISTORYCOMS HISTSTR0 I.S.OPRLST 
		    LASTFILE LISPXCOMS LISPXHISTORY LISPXHISTORYMACROS LISPXMACROS LISTFILESTR 
		    LOADEDFILELST MACROPROPS MAKEFILEFORMS MAKEFILEOPTIONS MAKEFILEREMAKEFLG 
		    MSDATABASELST NOSPELLFLG NOTCOMPILEDFILES NOTLISTEDFILES PRETTYDEFMACROS 
		    PRETTYFLG PRETTYHEADER PRETTYTRANFLG PRETTYTYPELST SAVEDDEFS SYSFILES SYSPROPS 
		    USERMACROS USERRECLST USERWORDS)
	(COMS (* RESOURCE "management")
	      (MACROS INITRESOURCE NEWRESOURCE GETRESOURCE FREERESOURCE WITH-RESOURCE WITH-RESOURCES)
	      (FNS \GR.METHODEXPANDER \GR.WITHRESOURCEMAC)
	      (FILEPKGCOMS RESOURCES INITRESOURCES)
	      (FNS \GR.GETDEFFN \GR.PUTDEFFN \GR.DELDEFFN \GR.CONTENTS \GR.GvarInitLst)
	      (FNS \GR.MAKEPRETTYCOMSL \IGR.MAKEPRETTYCOMSL)
	      (INITVARS (GLOBAL.RESOURCES))
	      (GLOBALVARS GLOBAL.RESOURCES)
	      (PROP ARGNAMES INITRESOURCE NEWRESOURCE GETRESOURCE FREERESOURCE))
	(COMS (* "need only be in ABC")
	      (MACROS GLOBALRESOURCE GLOBALRESOURCES)
	      (FILEPKGCOMS GLOBALRESOURCES)
	      (MACROS RELEASERESOURCE))
	(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
		  (ADDVARS (NLAMA \IGR.MAKEPRETTYCOMSL \GR.MAKEPRETTYCOMSL MAKEUSERMACROSCOMS 
				  MAKEPROPSCOMS MAKELISPXMACROSCOMS MAKEFILESCOMS MAKEALISTCOMS 
				  APPENDTOVAR ADDTOVAR PUTPROPS LISTFILES COMPILEFILES CLEANUP 
				  PRETTYDEFMACROS FILEPKGCOMPROPS)
			   (NLAML)
			   (LAMA FILEPKGTYPE FILEPKGCOM FILEPKGCHANGES)))
	(BLOCKS (DELFROMCOMS DELFROMCOMS DELFROMCOM DELFROMCOM1 REMOVEITEM (NOLINKFNS . T)
			     (SPECVARS COMSNAME))
		(MERGEINSERT MERGEINSERT MERGEINSERT1 (NOLINKFNS . T))
		(ADDTOFILEBLOCK ADDTOFILES? ADDTOFILE WHATIS ADDTOCOMS ADDTOCOM ADDTOCOM1 ADDNEWCOM
				(NOLINKFNS . T)
				(SPECVARS COMSNAME)
				(ENTRIES ADDTOFILE ADDTOCOMS ADDTOFILES?))
		(INFILECOMS? INFILECOMS? INFILECOMTAIL INFILECOMS INFILECOM INFILECOMSVAL 
			     INFILECOMSVALS INFILEPAIRS INFILECOMSMACRO IFCPROPS IFCEXPRTYPE 
			     IFCPROPSCAN IFCDECLARE (LOCALFREEVARS NAME LITERALS VAL TYPE ONFILETYPE 
								   ORIGFLG)
			     INFILECOMSPROP
			     (GLOBALVARS DWIMLOADFNSFLG))
		(NIL MAKEFILE (LOCALVARS . T)
		     (SPECVARS FILE OPTIONS REPRINTFNS SOURCEFILE FILETYPE FILEDATES CHANGES))
		(ADDFILE ADDFILE ADDFILE0 (NOLINKFNS . T)
			 (GLOBALVARS ADDSPELLFLG))
		(FILEPKGCHANGES FILEPKGCHANGES (NOLINKFNS . T))
		(NIL ADDTOVAR APPENDTOVAR ALISTS.WHENCHANGED CHANGECALLERS CLEANUP CLEARCLISPARRAY 
		     COMPARE COMPAREDEFS COMPILEFILES COMPILEFILES0 CONTINUEDIT COPYDEF 
		     DEFAULTMAKENEWCOM DELFROMFILES EDITDEF EXPRESSIONS.WHENCHANGED FILECOMS 
		     FILECOMSLST FILEFNSLST FILEPKGCOM FILEPKGCOMPROPS FILEPKGTYPE FILES? FILES?1 
		     GETFILEPKGTYPE HASDEF INFILECOMTAIL LOADDEF MAKEALISTCOMS MAKEFILE1 MAKEFILES 
		     MAKEFILESCOMS MAKELISPXMACROSCOMS MAKENEWCOM MAKEPROPSCOMS MAKEUSERMACROSCOMS 
		     MARKASCHANGED MOVETOFILE POSTEDITPROPS PREEDITFN PRETTYDEFMACROS 
		     PROPS.WHENCHANGED PUTDEF PUTPROPS RENAME SAVEDEF SAVEPUT SEARCHPRETTYTYPELST 
		     SHOWDEF SMASHFILECOMS TYPESOF UNMARKASCHANGED UNSAVEDEF UPDATEFILES
		     (GLOBALVARS #UNDOSAVES SYSFILES MARKASCHANGEDSTATS ADDSPELLFLG COMPILE.EXT 
				 EDITMACROS EDITLOADFNSFLG LOADOPTIONS)
		     (LOCALVARS . T))
		(DELDEF DELDEF DELFROMLIST (NOLINKFNS . T))
		(GETDEF GETDEF DWIMDEF GETDEFCOM GETDEFCOM0 GETDEFERR GETDEFCURRENT GETDEFFROMFILE 
			GETDEFSAVED (RETFNS GETDEFCOM)
			(NOLINKFNS . T)
			(GLOBALVARS NOT-FOUNDTAG])



(* "standard records for accessing file package type/command parts. Exported for 
	  PRETTY")


(DEFINEQ

(FILEPKGCOMPROPS

  [NLAMBDA PROPS
    (MAPC PROPS (FUNCTION (LAMBDA (Y)
	      (OR (MEMB Y SYSPROPS)
		  (SETQ SYSPROPS (CONS Y SYSPROPS)))
	      (PUT Y (QUOTE PROPTYPE)
		   (QUOTE FILEPKGCOMS])
)
(* FOLLOWING DEFINITIONS EXPORTED)


(DECLARE: EVAL@COMPILE DONTCOPY 

(RPAQQ FILEPKGRECORDS
 (FILEPKGCOM FILEPKGTYPE FILE FILEDATEPAIR FILEPROP))
[DECLARE: EVAL@COMPILE 

(ACCESSFNS FILEPKGCOM
 [[ADD
 (
GETPROP
 DATUM (
QUOTE
 ADDTOPRETTYCOM))
			    (UNDOABLE (
COND

					(NEWVALUE (
/PUTPROP
 DATUM (
QUOTE
 ADDTOPRETTYCOM)
							    NEWVALUE))
					(T (
/REMPROP
 DATUM (
QUOTE
 ADDTOPRETTYCOM]
		       [DELETE (
GETPROP
 DATUM (
QUOTE
 DELFROMPRETTYCOM))
			       (UNDOABLE (
COND

					   (NEWVALUE (
/PUTPROP
 DATUM (
QUOTE
 DELFROMPRETTYCOM)
							       NEWVALUE))
					   (T (
/REMPROP
 DATUM (
QUOTE
 DELFROMPRETTYCOM]
		       [PRETTYTYPE (
GETPROP
 DATUM (
QUOTE
 PRETTYTYPE))
				   (UNDOABLE (
COND

					       (NEWVALUE (
/PUTPROP
 DATUM (
QUOTE
 PRETTYTYPE)
								   NEWVALUE))
					       (T (
/REMPROP
 DATUM (
QUOTE
 PRETTYTYPE]
		       [CONTENTS (
GETPROP
 DATUM (
QUOTE
 FILEPKGCONTENTS))
				 (UNDOABLE (
COND

					     (NEWVALUE (
/PUTPROP
 DATUM (
QUOTE
 FILEPKGCONTENTS)
								 NEWVALUE))
					     (T (
/REMPROP
 DATUM (
QUOTE
 FILEPKGCONTENTS]
		       (MACRO [
CDR
 (
FASSOC
 DATUM (
GETTOPVAL
 (
QUOTE
 PRETTYDEFMACROS]
			      (STANDARD [
COND

					  [NEWVALUE (
PUTASSOC
 DATUM NEWVALUE
							      (
OR
 (
LISTP
 (
GETTOPVAL
 (
QUOTE
 
										  PRETTYDEFMACROS)))
								  (
SETTOPVAL
 (
QUOTE
 PRETTYDEFMACROS)
									     (
LIST
 (
LIST
 DATUM]
					  (T (
SETTOPVAL
 (
QUOTE
 PRETTYDEFMACROS)
							(
REMOVE
 (
FASSOC
 DATUM (
GETTOPVAL

									  (
QUOTE
 PRETTYDEFMACROS)))
								(
GETTOPVAL
 (
QUOTE
 PRETTYDEFMACROS]
					UNDOABLE
					(
COND

					  [NEWVALUE (
/PUTASSOC
 DATUM NEWVALUE
							       (
OR
 (
LISTP
 (
GETTOPVAL
 (
QUOTE
 
										  PRETTYDEFMACROS)))
								   (
/SETTOPVAL
 (
QUOTE
 PRETTYDEFMACROS)
									       (
LIST
 (
LIST
 DATUM]
					  (T (
/SETTOPVAL
 (
QUOTE
 PRETTYDEFMACROS)
							 (
REMOVE
 (
FASSOC
 DATUM (
GETTOPVAL

									   (
QUOTE
 PRETTYDEFMACROS)))
								 (
GETTOPVAL
 (
QUOTE
 PRETTYDEFMACROS]
                                                             (* Not an atom record cause want REMPROP on NILs.)

                                                             (* NOTE: PRETTCOM on PRETTY has open-coded access to 

							     the MACRO property.)

		      (INIT (
FILEPKGCOMPROPS
 ADDTOPRETTYCOM DELFROMPRETTYCOM PRETTYTYPE 
					     FILEPKGCONTENTS)))

(ACCESSFNS FILEPKGTYPE
 [[NEWCOM (
GETPROP
 DATUM (
QUOTE
 NEWCOMFN))
				(UNDOABLE (
COND

					    (NEWVALUE (
/PUTPROP
 DATUM (
QUOTE
 NEWCOMFN)
								NEWVALUE))
					    (T (
/REMPROP
 DATUM (
QUOTE
 NEWCOMFN]
			[WHENFILED (
GETPROP
 DATUM (
QUOTE
 NOTICEFN))
				   (UNDOABLE (
COND

					       (NEWVALUE (
/PUTPROP
 DATUM (
QUOTE
 NOTICEFN)
								   NEWVALUE))
					       (T (
/REMPROP
 DATUM (
QUOTE
 NOTICEFN]
			[WHENUNFILED (
GETPROP
 DATUM (
QUOTE
 WHENUNFILED))
				     (UNDOABLE (
COND

						 (NEWVALUE (
/PUTPROP
 DATUM (
QUOTE
 WHENUNFILED)
								     NEWVALUE))
						 (T (
/REMPROP
 DATUM (
QUOTE
 WHENUNFILED]
			[
GETDEF
 (
GETPROP
 DATUM (
QUOTE
 GETDEF))
				(UNDOABLE (
COND

					    (NEWVALUE (
/PUTPROP
 DATUM (
QUOTE
 GETDEF)
								NEWVALUE))
					    (T (
/REMPROP
 DATUM (
QUOTE
 GETDEF]
			[
PUTDEF
 (
GETPROP
 DATUM (
QUOTE
 PUTDEF))
				(UNDOABLE (
COND

					    (NEWVALUE (
/PUTPROP
 DATUM (
QUOTE
 PUTDEF)
								NEWVALUE))
					    (T (
/REMPROP
 DATUM (
QUOTE
 PUTDEF]
			[
DELDEF
 (
GETPROP
 DATUM (
QUOTE
 DELDEF))
				(UNDOABLE (
COND

					    (NEWVALUE (
/PUTPROP
 DATUM (
QUOTE
 DELDEF)
								NEWVALUE))
					    (T (
/REMPROP
 DATUM (
QUOTE
 DELDEF]
			[WHENCHANGED (
GETPROP
 DATUM (
QUOTE
 WHENCHANGED))
				     (UNDOABLE (
COND

						 (NEWVALUE (
/PUTPROP
 DATUM (
QUOTE
 WHENCHANGED)
								     NEWVALUE))
						 (T (
/REMPROP
 DATUM (
QUOTE
 WHENCHANGED]
			[
HASDEF
 (
GETPROP
 DATUM (
QUOTE
 HASDEF))
				(UNDOABLE (
COND

					    (NEWVALUE (
/PUTPROP
 DATUM (
QUOTE
 HASDEF)
								NEWVALUE))
					    (T (
/REMPROP
 DATUM (
QUOTE
 HASDEF]
			[
EDITDEF
 (
GETPROP
 DATUM (
QUOTE
 EDITDEF))
				 (UNDOABLE (
COND

					     (NEWVALUE (
/PUTPROP
 DATUM (
QUOTE
 EDITDEF)
								 NEWVALUE))
					     (T (
/REMPROP
 DATUM (
QUOTE
 EDITDEF]
			[FILEGETDEF (
GETPROP
 DATUM (
QUOTE
 FILEGETDEF))
				    (UNDOABLE (
COND

						(NEWVALUE (
/PUTPROP
 DATUM (
QUOTE
 FILEGETDEF)
								    NEWVALUE))
						(T (
/REMPROP
 DATUM (
QUOTE
 FILEGETDEF]
			(CHANGEDLST (
CAR
 (
SEARCHPRETTYTYPELST
 DATUM))
				    (
CAR
 (
SEARCHPRETTYTYPELST
 DATUM NEWVALUE)))
			(CHANGED (
GETTOPVAL
 (
CAR
 (
SEARCHPRETTYTYPELST
 DATUM)))
				 (STANDARD (
SETTOPVAL
 (
CAR
 (
SEARCHPRETTYTYPELST
 DATUM NEWVALUE))
						      NEWVALUE)
					   UNDOABLE
					   (
/SETTOPVAL
 (
CAR
 (
SEARCHPRETTYTYPELST
 DATUM NEWVALUE))
						       NEWVALUE)))
			(DESCRIPTION (
CAR
 (
CDDR
 (
SEARCHPRETTYTYPELST
 DATUM)))
				     (
CAR
 (
RPLACA
 (
CDDR
 (
SEARCHPRETTYTYPELST
 DATUM NEWVALUE))
						  NEWVALUE)))
			(ALLFIELDS NIL (
/SETTOPVAL
 (
QUOTE
 PRETTYTYPELST)
						   (
REMOVE
 (
SEARCHPRETTYTYPELST
 DATUM)
							   (
GETTOPVAL
 (
QUOTE
 PRETTYTYPELST]
                                                             (* NOTE: PRETTYCOM on PRETTY has open-coded access to 

							     GETDEF property)

		       (INIT (
FILEPKGCOMPROPS
 NEWCOMFN NOTICEFN WHENCHANGED GETDEF PUTDEF EDITDEF 
					      DELDEF HASDEF)
			     (
ADDTOVAR
 PRETTYTYPELST)))

(ATOMRECORD FILE
 (
FILECHANGES
 FILEDATES FILEMAP)
		 [
ACCESSFNS
 FILE ((FILEPROP (
GETPROP
 DATUM (
QUOTE
 FILE))
					    (STANDARD (
PUTPROP
 DATUM (
QUOTE
 FILE)
							       NEWVALUE)
						      UNDOABLE
						      (
/PUTPROP
 DATUM (
QUOTE
 FILE)
								NEWVALUE])

(RECORD FILEDATEPAIR
 (
FILEDATE
 . DATEFILENAME))

(RECORD FILEPROP
 ((COMSNAME . LOADTYPE) . TOBEDUMPED))
]
(FILEPKGCOMPROPS ADDTOPRETTYCOM DELFROMPRETTYCOM PRETTYTYPE FILEPKGCONTENTS)
(FILEPKGCOMPROPS NEWCOMFN NOTICEFN WHENCHANGED GETDEF PUTDEF EDITDEF DELDEF HASDEF)
(ADDTOVAR PRETTYTYPELST)
)


(* END EXPORTED DEFINITIONS)

(DEFINEQ

(SEARCHPRETTYTYPELST

  [LAMBDA (TYPE FLG)                                        (* rmk: " 3-JAN-82 22:55")

                                                            (* access functions used by the records)

    (AND (LITATOM TYPE)
	 (OR (find
 X in
 PRETTYTYPELST suchthat
 (EQ (CADR X)
						   TYPE))
	     (COND
	       (FLG [/SETTOPVAL (QUOTE PRETTYTYPELST)
				(CONS (SETQ FLG (LIST (PACK* (QUOTE CHANGED)
							     TYPE
							     (QUOTE LST))
						      TYPE NIL))
				      (GETTOPVAL (QUOTE PRETTYTYPELST]
		    (OR (LISTP (GETTOPVAL (CAR FLG)))
			(/SETTOPVAL (CAR FLG)
				    NIL))
		    FLG])

(PRETTYDEFMACROS

  [NLAMBDA ARGS                                             (* lmm " 5-SEP-78 16:16")

                                                            (* included so that old files will continue to load)

    (for
 X in
 ARGS collect
 (FILEPKGCOM
 (CAR X)
				       (QUOTE MACRO)
				       (CDR X])
)

(RPAQQ FILEPKGRECORDS
 (FILEPKGCOM FILEPKGTYPE FILE FILEDATEPAIR FILEPROP))
(FILEPKGCOMPROPS ADDTOPRETTYCOM DELFROMPRETTYCOM PRETTYTYPE FILEPKGCONTENTS)
(FILEPKGCOMPROPS NEWCOMFN NOTICEFN WHENCHANGED GETDEF PUTDEF EDITDEF DELDEF HASDEF)
(ADDTOVAR PRETTYTYPELST)

(RPAQ? MSDATABASELST
 )
(* * "making, adding, listing, compiling files")


(DEFINEQ

(CLEANUP

  [NLAMBDA FILES                                             (* lmm "14-Aug-84 19:17")

    (PROG (TEM1 TEM2 OPTIONS)
          (COND
	    ([LISTP (CAR (SETQ FILES (NLAMBDA.ARGS FILES]
	      (SETQ OPTIONS (CAR FILES))
	      (SETQ FILES (CDR FILES)))
	    (T (SETQ OPTIONS CLEANUPOPTIONS)))
          (RETURN (APPEND (MAKEFILES
 OPTIONS FILES)
			  (COND
			    ((NOT (MEMB (QUOTE LIST)
					OPTIONS))
			      NIL)
			    ((NULL FILES)
			      (LISTFILES))
			    ((SETQ TEM1 (INTERSECTION FILES NOTLISTEDFILES))
                                                             (* Intersection check because LISTFILES applied to NIL 

							     means list all of NOTLISTEDFILES.)

			      (APPLY (QUOTE LISTFILES)
				     TEM1)))
			  (COND
			    [(NULL (SETQ TEM1 (MEMB (QUOTE RC)
						    OPTIONS]
			    ((NULL FILES)
			      (COMPILEFILES0
 (SETQ TEM2 NOTCOMPILEDFILES)
					     (CDR TEM1))
			      TEM2)
			    ((SETQ TEM2 (INTERSECTION FILES NOTCOMPILEDFILES))
			      (COMPILEFILES0
 TEM2 (CDR TEM1))
			      TEM2])

(COMPILEFILES

  [NLAMBDA FILES                                             (* lmm "14-Aug-84 19:17")

    (COND
      ([LISTP (CAR (SETQ FILES (NLAMBDA.ARGS FILES]
	(COMPILEFILES0
 (CDR FILES)
		       (CAR FILES)))
      (T (COMPILEFILES0
 FILES])

(COMPILEFILES0

  [LAMBDA (FILES OPTIONS)                                   (* rmk: "19-FEB-83 21:59")

    (for
 X OPTS (RCFLG _ T) on
 (OR FILES NOTCOMPILEDFILES) first
 (SETQ OPTS
								   (SELECTQ (CAR (LISTP OPTIONS))
									    (C (SETQ RCFLG NIL)
									       (CDR OPTIONS))
									    (RC (CDR OPTIONS))
									    OPTIONS))
       do
 (MAKEFILE1
 (OR (MISSPELLED? (CAR X)
				      70 FILELST NIL X)
			 (CAR X))
		     RCFLG OPTS X])

(CONTINUEDIT

  [LAMBDA (FILE)                                            (* rmk: "19-FEB-83 14:59")

    (PROG (FL TEM X)
          (SETQ FILE (INPUT (INFILE FILE)))
          (SETFILEPTR FILE 0)
          (SETQ X (READ FILE FILERDTBL))
          (CLOSEF FILE)
          (COND
	    ([NOT (fetch
 FILEPROP of
 (SETQ FL (ROOTFILENAME
 FILE]
	      (LOADFROM FILE)                               (* also calls addfile to notice the file.)

	      ))
          (/replace
 FILECHANGES of
 FL (FILECHANGES
 X))
          [/replace
 FILEDATES of
 FL with
 (LIST (create
 FILEDATEPAIR
						       FILEDATE _(CADR X)
						       DATEFILENAME _ FILE)
					       (create
 FILEDATEPAIR
						       FILEDATE _[CAR (SETQ TEM
									(CDR (MEMB (QUOTE date:)
										   X]
						       DATEFILENAME _(CADR TEM]
          (RETURN FILE])

(MAKEFILE

  [LAMBDA (FILE OPTIONS REPRINTFNS SOURCEFILE)               (* lmm " 1-Oct-84 12:14")


          (* OPTIONS: FAST means dump with PRETTYFLG set to NIL; LIST means list the FILE; RC means RECOMPILE, uses BRECOMPILE

	  if FILEblocks is NOBIND, OTHERWISE RECOMPILE; -

	  C means COMPILE, uses BCOMPL if FILEblocks is NOBIND, otherwise TCOMPL; -

	  for C AND RC assume ST unless next option is F.)



    (
PROG
 (FILETYPE ROOTNAME FILEPROP CHANGES FILEDATES (Z (ADDFILE
 FILE)))
          (
SETQ
 FILE (
CAR
 Z))                                (* Necessary because FILE might have been misspelled.)

          (
SETQ
 ROOTNAME (
CADR
 Z))                           (* result of (ROOTFILENAME FILE), or if FILE is 

							     corrected, result of applying ROOTFILENAME to correct 

							     value.)

          (
SETQ
 FILEPROP (
CDDR
 Z))
          (UPDATEFILES
)                                      (* Want updating done after file is added to filelst, 

							     so any functions that are being dumped are marked as 

							     having been dumped.)

          (
SETQ
 OPTIONS (
MKLIST
 OPTIONS))
          (
SETQ
 CHANGES (fetch
 TOBEDUMPED of
 FILEPROP))
          (
SETQ
 FILEDATES (
LISTP
 (fetch
 FILEDATES of
 ROOTNAME)))
          (
SETQ
 FILETYPE (
GETPROP
 ROOTNAME (
QUOTE
 FILETYPE)))
      LP0 (if
 (
AND
 (
NULL
 (fetch
 LOADTYPE of
 FILEPROP))
		   (
NULL
 FILEDATES))
	      then
                                           (* File has never been loaded and never dumped i.e. 

							     user just set up COMS in core)

	    elseif
 [
OR
 (
EQMEMB
 (
QUOTE
 NEW)
			       OPTIONS)
		       (
AND
 (
NULL
 MAKEFILEREMAKEFLG)
			    (
NOT
 (
MEMB
 (
QUOTE
 REMAKE)
				       OPTIONS]
	      then
 (
COND

		     ((
AND
 (fetch
 LOADTYPE of
 FILEPROP)
			   (
NEQ
 T (fetch
 LOADTYPE of
 FILEPROP)))
		       (
LISPXPRIN2
 FILE T T)
		       (
LISPXPRIN1
 (
SELECTQ
 (fetch
 LOADTYPE of
 FILEPROP)
					    (
LOADCOMP
 
					      "the file was loaded for compilation purposes only")
					    ((compiled Compiled COMPILED)
					      " -- only the compiled file has been loaded
")
					    ((loadfns LOADFNS)
					      " -- only some of its symbolics have been loaded
")
					    (
SHOULDNT
))
				   T)
		       (
COND

			 ((
NEQ
 (
ASKUSER
 DWIMWAIT (
QUOTE
 Y)
					(
QUOTE
 "do you want to go ahead and MAKEFILE anyway ?"))
			       (
QUOTE
 Y))                    (* E.g. user loads a .com file and then resets the COMS

							     or defines the functons by hand.)

			   (
GO
 OUT)))
		       (/replace
 LOADTYPE of
 FILEPROP with
 NIL)))
		   (
SETQ
 SOURCEFILE NIL)
		   (
SETQ
 REPRINTFNS NIL)
	    elseif
 SOURCEFILE
	      then
                                           (* source file given)

	    elseif
 [
AND
 FILEDATES (
OR
 [
AND
 (
SETQ
 SOURCEFILE (
FINDFILE
 ROOTNAME))
					   (
EQUAL
 (
FILEDATE
 SOURCEFILE)
						  (fetch
 FILEDATE of
 (
CAR
 FILEDATES]
				      (
AND
 [
NEQ
 SOURCEFILE (
SETQ
 SOURCEFILE (fetch
 DATEFILENAME
									       of
 (
CAR
 FILEDATES]
					   (
INFILEP
 SOURCEFILE)
					   (
EQUAL
 (
FILEDATE
 SOURCEFILE)
						  (fetch
 FILEDATE of
 (
CAR
 FILEDATES]
	      then
 (/replace
 DATEFILENAME of
 (
CAR
 FILEDATES) with
 SOURCEFILE)
		   (
OR
 REPRINTFNS (
SETQ
 REPRINTFNS (FILEPKG.CHANGEDFNS
 CHANGES)))
	    elseif
 [
AND
 (
CDR
 FILEDATES)
			[
SETQ
 SOURCEFILE (
INFILEP
 (fetch
 DATEFILENAME of
 (
CADR
 FILEDATES]
			(
EQUAL
 (
FILEDATE
 SOURCEFILE)
			       (fetch
 FILEDATE of
 (
CADR
 FILEDATES]
	      then
                                           (* prevous version file is gone, drop back to original 

							     daddy file and dump everything that has been changed.)

		   (
SETQ
 CHANGES (FILEPKG.MERGECHANGES
 (fetch
 TOBEDUMPED of
 FILEPROP)
						       (fetch
 FILECHANGES of
 ROOTNAME)))
		   (
SETQ
 REPRINTFNS (FILEPKG.CHANGEDFNS
 CHANGES))
	    else
 (
LISPXPRIN1
 (
QUOTE
 
			    "can't find either the previous version or the original version of 
")
			     T)
		 (
LISPXPRIN2
 FILE T T)
		 (
LISPXPRIN1
 (
QUOTE
 ", so it will have to be written anew
")
			     T)
		 (
SETQ
 SOURCEFILE NIL)
		 (
SETQ
 REPRINTFNS NIL)
		 (push
 OPTIONS (
QUOTE
 NEW))
		 (
SETQ
 CHANGES (fetch
 FILECHANGES of
 ROOTNAME))
		 (
GO
 LP0))
          [
COND

	    ((
AND
 SOURCEFILE (
SETQ
 Z (
SELECTQ
 (fetch
 LOADTYPE of
 FILEPROP)
					      (
LOADCOMP
      (* only loaded via LOADCOMP.

							     Need to do LOADFROM)

							(
LIST
 (
QUOTE
 N)
							      SOURCEFILE "was loaded with LOADCOMP"
							      (
QUOTE
 -)
							      "LOADFROM it to obtain VARS/COMS"))
					      (Compiled (
AND
 (INFILECOMS?
 (
QUOTE
 DONTCOPY)
									  (
QUOTE
 DECLARE:)
									  (fetch
 COMSNAME
									     of
 FILEPROP))
							     (
LIST
 (
QUOTE
 Y)
								   "only compiled version of" 
								   ROOTNAME 
				    "was loaded; LOADVARS the (DECLARE .. DONTCOPY ) expressions")))
					      ((compiled loadfns)
						(
LIST
 (
QUOTE
 N)
						      "Only some functions from" SOURCEFILE 
					 "loaded via LOADFNS. Load all other expressions from it"))
					      NIL)))
	      (
COND

		((
EQ
 (
ASKUSER
 DWIMWAIT (
CAR
 Z)
			      (
CDR
 Z))
		     (
QUOTE
 Y))
		  (
SELECTQ
 (fetch
 LOADTYPE of
 FILEPROP)
			   (
LOADCOMP
                         (* file was never actually loaded, justloadcomped.

							     thus no filecoms)

				     (
LOADFROM
 SOURCEFILE))
			   (Compiled 

          (* This is going to be a remake. If it was originally loaded as a compiled file, must first do a LOADFROM in order 

	  to get the properties set up by declare: etc.)



				     (
LOADVARS
 (
QUOTE
 DONTCOPY)
					       SOURCEFILE)
				     (/replace
 LOADTYPE of
 FILEPROP with
 (
QUOTE
 COMPILED))
                                                             (* So wont have to be done again.)


          (* These are the only DECLARE:'s that are not also on the copiled file. Note that a DECLARE: DONTEVAL@LOAD will be 

	  found and evaluated, but the corresponding expressions wont be evaluated from within the DECLARE: Not worthwhile to 

	  bother setting up a complicated edit pattern to screen these out, especially if you consider expressions like 

	  (DECLARE: -- DONTEVAL@LOAD -- DOEVAL@LOAD --))



				     )
			   ((loadfns compiled)

          (* This is going to be a remake, but the original call to LOADFNS didnt specify all the VARS, so some expressions 

	  may not have been loaded.)



			     (
LOADVARS
 T SOURCEFILE))
			   NIL))
		(T (
GO
 OUT]
          (
RESETLST
 [
COND

		      ((
MEMB
 (
QUOTE
 NOCLISP)
			     OPTIONS)
			(
RESETSAVE
 PRETTYTRANFLG T))
		      ((
MEMB
 (
QUOTE
 CLISP% )
			     OPTIONS)
			(
RESETSAVE
 PRETTYTRANFLG (
QUOTE
 BOTH]
		    (
RESETSAVE
 #UNDOSAVES)
		    (
COND

		      ((
MEMB
 (
QUOTE
 FAST)
			     OPTIONS)
			(
RESETSAVE
 PRETTYFLG NIL)))
		    [
COND

		      ((
OR
 (
MEMB
 (
QUOTE
 CLISPIFY)
				 OPTIONS)
			   (
MEMB
 (
QUOTE
 CLISP)
				 OPTIONS))
			(
RESETSAVE
 CLISPIFYPRETTYFLG T))
		      ((
OR
 (
EQ
 FILETYPE (
QUOTE
 CLISP))
			   (
MEMB
 (
QUOTE
 CLISP)
				 (
LISTP
 FILETYPE)))
			(
RESETSAVE
 CLISPIFYPRETTYFLG (
QUOTE
 CHANGES]
		    (
SELECTQ
 (
RADIX
)
			     ((8 10)                         (* make sure radix is either 8 or 10, because all 

							     others don't read in like they print)

			       NIL)
			     (
RESETSAVE
 (
RADIX
 10)))
		    (for
 X in
 MAKEFILEFORMS do
 (
ERSETQ
 (
EVAL
 X)))
		    (
SETQ
 FILE (
PRETTYDEF
 NIL FILE (fetch
 COMSNAME of
 FILEPROP)
					  REPRINTFNS SOURCEFILE CHANGES)))
          (
SETQ
 LASTFILE ROOTNAME)
          (/replace
 TOBEDUMPED of
 FILEPROP with
 NIL)
          (
COND

	    ((
NOT
 (
EQMEMB
 (
QUOTE
 DON'TLIST)
			  FILETYPE))
	      (pushnew
 NOTLISTEDFILES ROOTNAME)))
          (
COND

	    ((
AND
 (
NOT
 (
EQMEMB
 (
QUOTE
 DON'TCOMPILE)
			       FILETYPE))
		  (INFILECOMS?
 T (
QUOTE
 FNS)
			       (fetch
 COMSNAME of
 FILEPROP)))
                                                             (* No functions in the file.)

	      (pushnew
 NOTCOMPILEDFILES ROOTNAME)))
          [for
 TAIL OPT on
 OPTIONS
	     do
 (
SETQ
 OPT (
CAR
 TAIL))
		(
SELECTQ
 OPT
			 [RC (
AND
 (
MEMB
 ROOTNAME NOTCOMPILEDFILES)
				  (MAKEFILE1
 FILE T (
CDR
 TAIL]
			 [C (
AND
 (
MEMB
 ROOTNAME NOTCOMPILEDFILES)
				 (MAKEFILE1
 FILE NIL (
CDR
 TAIL]
			 [
LIST
 (
AND
 (
MEMB
 ROOTNAME NOTLISTEDFILES)
				    (
APPLY
 (
QUOTE
 LISTFILES)
					   (
LIST
 FILE]
			 (
COND

			   ((
MEMB
 OPT MAKEFILEOPTIONS))
			   ((
FIXSPELL
 OPT NIL MAKEFILEOPTIONS NIL OPTIONS)
			     (
GO
 $$LP))
			   (T (
ERROR
 "Unrecognized MAKEFILE option" OPT]
          (
RETURN
 FILE)
      OUT (
RETURN
 (
CONS
 FILE (
QUOTE
 (
QUOTE
 (- MAKEFILE not performed.])

(FILECHANGES
  [LAMBDA (FILE TYPE)                           (* rmk: "22-MAY-82 13:44"
)

          (* If FILE is a list, it is assumed to be a 
	  file-created expressions; otherwise, the filecreated
	  expression is read from FILE.
	  If TYPE, returns the list of changed items of that 
	  type from the changes expression.
	  If TYPE=NIL, returns the whole list of typed 
	  change-lists)


    (PROG [FNS
	    CHANGES
	    (FCEXPR
	      (OR
		(LISTP FILE)
		(AND
		  FILE
		  (RESETLST
		    (PROG (OPENFLG)
		          [COND
			    ((SETQ OPENFLG (OPENP FILE (QUOTE INPUT)))
			      (SETQ FILE OPENFLG))
			    (T                  (* INFILE used instead 
						of INFILEP to allow for 
						error correction.)
			       (RESETSAVE (SETQ FILE
					    (OPENFILE FILE
						      (QUOTE INPUT)))
					  (QUOTE (PROGN (CLOSEF? 
							   OLDVALUE]
		      LP  (COND
			    ((FILEPOS (QUOTE "(FILECREATED")
				      FILE NIL (IPLUS (GETFILEPTR
							FILE)
						      20))
			      (RETURN (READ FILE FILERDTBL)))
			    ((AND OPENFLG (RANDACCESSP FILE))
                                                (* File was originally 
						open. If possible, reset
						to beginning and try 
						again.)
			      (RESETSAVE NIL (LIST (QUOTE SETFILEPTR)
						   FILE
						   (GETFILEPTR FILE)))
			      (SETQ OPENFLG NIL)
			      (SETFILEPTR FILE 0)
			      (GO LP]
          (SETQ CHANGES (LDIFF (SETQ CHANGES
				 (CDR (MEMB (QUOTE to:)
					    FCEXPR)))
			       (MEMB (QUOTE previous)
				     CHANGES)))
          [AND TYPE (NEQ TYPE (QUOTE FNS))
	       (RETURN (CDR (ASSOC TYPE CHANGES]
          (SETQ FNS (SUBSET CHANGES (FUNCTION LITATOM)))
          (RETURN (COND
		    [TYPE                       (* TYPE=FNS cause of 
						test above.)
			  (NCONC FNS (CDR (ASSOC (QUOTE FNS)
						 CHANGES]
		    [FNS (CONS (CONS (QUOTE FNS)
				     FNS)
			       (SUBSET CHANGES (FUNCTION LISTP]
		    (T CHANGES])

(FILEPKG.MERGECHANGES
  [LAMBDA (C1 C2)                               (* rmk: "24-MAY-82 23:09"
)

          (* Merges 2 changes lists into a single one.
	  Treat LITATOM's as FNS, to accomodate old-style 
	  format on files.)


    (for E2 TEMP (VAL _(for E1 in C1 when (CDR (LISTP E1))
			  collect (APPEND E1)))
       in C2 do [COND
		  ((SETQ TEMP (ASSOC (CAR E2)
				     VAL))
		    (NCONC TEMP (for X in (CDR E2)
				   unless (MEMBER X (CDR TEMP))
				   collect X)))
		  (T (SETQ VAL (NCONC1 VAL (APPEND E2]
       finally (RETURN VAL])

(FILEPKG.CHANGEDFNS
  [LAMBDA (CHANGES)                             (* rmk: "20-MAY-82 22:00"
)

          (* Returns list of function names from a 
	  file-changes list. Interprets old format 
	  (functios are atoms) and new format 
	  (with explicit type headers))


    (CDR (ASSOC (QUOTE FNS)
		CHANGES])

(MAKEFILE1

  [LAMBDA (FILE RECOMPFLG OPTIONS OTHERFILES)               (* rmk: "19-FEB-83 21:43")

    (PROG (GROUP (ROOTNAME (ROOTFILENAME
 FILE)))
          (SETQ GROUP (GETPROP ROOTNAME (QUOTE FILEGROUP)))
          (COND
	    ([find
 X in
 GROUP suchthat
 (AND (NEQ X ROOTNAME)
					    (OR (fetch
 TOBEDUMPED of
 (fetch
 FILEPROP of
 X))
						(MEMB X OTHERFILES]

          (* The file in question must be recompiled with other files, and one of the remaining files still needs to be 

	  dumped, or else one of the other file is further down the list of files being compiled. Wait..)



	      (RETURN)))
          (LISPXPRIN1 (QUOTE "
compiling ")
		      T)
          (LISPXPRINT (OR GROUP FILE)
		      T T)
          [COND
	    ((MEMB (CAR OPTIONS)
		   (QUOTE (ST F S STF)))
	      (LISPXUNREAD (LIST (CAR OPTIONS]
          (LISPXPRINT [COND
			[GROUP                              (* File contained in FILEGROUP.

							    Therefore must be blockcompiled.)

			       (COND
				 (RECOMPFLG (BRECOMPILE GROUP))
				 (T (BCOMPL GROUP]
			[(INFILECOMS?
 T (QUOTE BLOCKS)
				      (FILECOMS
 ROOTNAME))
			  (COND
			    (RECOMPFLG (BRECOMPILE FILE))
			    (T (BCOMPL (LIST FILE]
			(RECOMPFLG (RECOMPILE FILE))
			(T (TCOMPL (LIST FILE]
		      T T])

(MAKEFILES

  [LAMBDA (OPTIONS FILES)                                   (* rmk: "23-FEB-83 21:20")

    (RESETVARS (#UNDOSAVES)
	       (UPDATEFILES
)
	       [COND
		 ((NULL FILES)
		   (for
 TYPE FLG in
 FILEPKGTYPES when
 [FILES?1
 TYPE (COND
								 ((NULL FLG)
                                                            (* Gets printed the first time)

								   (QUOTE 
				    "****NOTE: the following are not contained on any file:
    "))
								 (T (QUOTE "    "]
		      do
 (SETQ FLG T) finally
 (AND FLG (ADDTOFILES?
]
	       (SETQ OPTIONS (MKLIST OPTIONS))
	       (RETURN (for
 FILE inside
 (OR FILES FILELST) when
 [fetch
 TOBEDUMPED
								   of
 (LISTP (fetch
 FILEPROP
										of
 (ROOTFILENAME
										     FILE]
			  collect
 (LISPXPRIN2 FILE T T)
				  (LISPXPRIN1 (QUOTE ...)
					      T)
				  (PROG1 (MAKEFILE
 FILE OPTIONS)
					 (LISPXTERPRI T])

(ADDFILE

  [LAMBDA (FILE LOADTYPE PRLST FCLST)                        (* rmk: "23-FEB-83 21:25")


          (* PRLST is the FILEPKGCHANGES prior to this file operation, FCLST is a list of file-created arguments, a singleton 

	  for a symbolic file, and a list whose car represents the compiled file and whose cdr represent symbolic files 

	  compiled into it, for compiled files.)



    (
PROG
 (VAL FLST (ROOTNAME (
ROOTFILENAME
 FILE)))
          [
COND

	    ([
AND
 LOADTYPE (
NOT
 (
MEMB
 FILE (
GETTOPVAL
 (
QUOTE
 LOADEDFILELST]
	      (
/SETTOPVAL
 (
QUOTE
 LOADEDFILELST)
			  (
CONS
 FILE (
GETTOPVAL
 (
QUOTE
 LOADEDFILELST]
          [
COND

	    ([
AND
 (
NOT
 FCLST)
		  (
NOT
 (
SETQ
 FCLST (
CADDR
 (fetch
 FILEMAP of
 ROOTNAME]
	      (
SETQ
 VAL (ADDFILE0
 ROOTNAME LOADTYPE FILE)))
	    [(
NULL
 (
CDR
 FCLST))                              (* A simple symbolic file)

	      (
SETQ
 FCLST (
CAR
 FCLST))
	      (
SETQ
 VAL (ADDFILE0
 (
COND

				    ((
LITATOM
 (
CADR
 FCLST))
				      (
ROOTFILENAME
 (
CADR
 FCLST)))
				    (T ROOTNAME))
				  LOADTYPE FILE (
CAR
 FCLST]
	    (T                                               (* A compiled file, skip the first expression 

							     representing the compiled file itself, look at the cdr 

							     representing the symbolic files.)

	       (
SELECTQ
 LOADTYPE
			((T LOADFNS)
			  (
SETQ
 LOADTYPE (
QUOTE
 Compiled)))
			(loadfns (
SETQ
 LOADTYPE (
QUOTE
 compiled)))
			(
LOADCOMP
                            (* loadcomp on compiled file.

							     Don't notice since we don't know what its state is)

				  NIL)
			(
SHOULDNT
))
	       (for
 X in
 (
CDR
 FCLST) when
 (
LITATOM
 (
CADR
 X))
		  do
 (push
 FLST (
CADR
 X))
		     (
OR
 (
EQ
 LOADTYPE (
QUOTE
 LOADCOMP))
			 (ADDFILE0
 (
ROOTFILENAME
 (
CADR
 X))
				   LOADTYPE
				   (
CADR
 X)
				   (
CAR
 X]
          (UPDATEFILES
 PRLST (
OR
 FLST (
LIST
 FILE)))
          [
AND
 LOADTYPE (for
 TYPE CHANGED in
 FILEPKGTYPES when
 (
AND
 (
LITATOM
 TYPE)
								    (
SETQ
 CHANGED
								      (fetch
 CHANGED of
 TYPE)))
			   do
 (/replace
 CHANGED of
 TYPE with
 (
INTERSECTION
 (
CDR
 (
ASSOC
 TYPE PRLST))
									   CHANGED]
          (
AND
 ADDSPELLFLG (
ADDSPELL
 ROOTNAME USERWORDS))
          (
RETURN
 VAL])

(ADDFILE0

  [LAMBDA (ROOTNAME LOADTYPE FULLNAME DAT)                   (* lmm "28-Nov-84 16:47")

    (
PROG
 (COMS X FILEPROP FLG TEM)
      TOP (
SETQ
 COMS (FILECOMS
 ROOTNAME))
          [
COND

	    ((
SETQ
 FILEPROP (fetch
 FILEPROP of
 ROOTNAME))
	      (
COND

		([
AND
 LOADTYPE (
FMEMB
 LOADTYPE
				      (
CDR
 (
FMEMB
 (fetch
 LOADTYPE of
 FILEPROP)
						  (
QUOTE
 (
LOADCOMP
 loadfns compiled Compiled LOADFNS 
								   COMPILED NIL T]
		  (/replace
 LOADTYPE of
 FILEPROP with
 LOADTYPE)

          (* This call to aDDFILE reflects a 'higher' degree of loading, so upgrade property. 'loadfns' means just some 

	  information from file, if go to do makefile, must do loadfrom, 'compiled' is like 'loadfns' but for compiled files 

	  e.g. user does LOADFNS on compiled file. 'Compiled' means all but DECLARE: expressions are in.

	  e.g. user does LOAD of a compiled file. COMPILED means everything is in, e.g. user does LOADDFROM a compiled file.

	  LOADFNS means everything in, e.g. user des LOADFROM symbolic file. COMPILED and LOADFNS are equivaeltn in that means

	  dont have to do any more loading when go to do a makefile but makefile NEW isnt permitted. NIL is a makefile when 

	  coms were set up in core. T is full load of symbolic file. The check on TYPE=NIL is bcause dont want to upgrade as 

	  result of call from makefile, i.e. no new informaton there.)




          (* LOADCOMP means file was loadcomp'ed. note that the actual structure is a tree, not a list, and the above is only 

	  an approximation. if you do a loadcomp, and then load the compiled file, the state will be left with latter, but 

	  then loadcomp? will loadcomp again because compiled files might not contain all the declare: EVAL@COMPILE 

	  expressions, e.g. macros, records etc. however,in most cases, loadcomp is used independently of other loading, e.g. 

	  for compilation purposes only, so this will at least permit loadcomp? to work.)



		  (
GO
 OUT))
		(T (
GO
 OUT1]
          (
COND

	    [(
OR
 LOADTYPE (
LISTP
 (
GETTOPVAL
 COMS)))
	      (
SETQ
 FILEPROP (/replace
 FILEPROP of
 ROOTNAME
				with
 (create
 FILEPROP
					     COMSNAME _ COMS
					     LOADTYPE _ LOADTYPE]
	    (FLG (
GO
 ERROR))
	    ((
AND
 DWIMFLG (
EQ
 ROOTNAME FULLNAME)
		  (
SETQ
 ROOTNAME (
MISSPELLED?
 ROOTNAME 70 FILELST T)))

          (* The EQ check is so as not to try correcting if the user has specified a version number or directory, as it is too

	  messy trying to take them out, and then put them back in on the corrected root name.)



	      (
SETQ
 FULLNAME ROOTNAME)
	      (
SETQ
 FLG T)                                   (* so wont try to spelling correct again if file isnt 

							     there)

	      (
GO
 TOP))
	    (T (
GO
 ERROR)))
      OUT [
AND
 LOADTYPE DAT (/replace
 FILEDATES of
 ROOTNAME
			       with
 (
LIST
 (create
 FILEDATEPAIR
						  FILEDATE _ DAT
						  DATEFILENAME _ FULLNAME]
          (
AND
 (
EQ
 LOADTYPE T)
	       (/replace
 TOBEDUMPED of
 FILEPROP with
 NIL))
      OUT1[
COND

	    ([
AND
 (
LISTP
 (
GETTOPVAL
 COMS))
		  (
NOT
 (
FMEMB
 ROOTNAME (
GETTOPVAL
 (
QUOTE
 FILELST]
                                                             (* coms wuld not be set up on a loadccomp.)

	      (
/SETTOPVAL
 (
QUOTE
 FILELST)
			  (
CONS
 ROOTNAME (
GETTOPVAL
 (
QUOTE
 FILELST]
          (
RETURN
 (
COND

		    ((
NULL
 LOADTYPE)                         (* call from makefile.)

		      (
CONS
 FULLNAME (
CONS
 ROOTNAME FILEPROP)))
		    (T FILEPROP)))
      ERROR
          (
ERROR
 FULLNAME "not file name." T])

(LISTFILES

  [NLAMBDA FILES                                             (* rmk: " 3-Dec-84 08:58")

    (DECLARE
 (
GLOBALVARS
 NOTLISTEDFILES))                    (* LISTFILES1 is machinedependent)

    (for
 FILE FULLNAME OPTIONS in
 (
COND

				    (FILES (
SETQ
 FILES (
NLAMBDA.ARGS
 FILES)))
				    (T NOTLISTEDFILES))
       when
 (
COND

	      ((
LISTP
 FILE)
		(
SETQ
 OPTIONS (
APPEND
 FILE OPTIONS))
		NIL)
	      ((
SETQ
 FULLNAME (
FINDFILE
 FILE))
		FULLNAME)
	      (T (printout
 T FILE " not found." T)
		 NIL))
       collect
 [
COND

		 ((
LISTFILES1
 FULLNAME OPTIONS)
		   (
SETQ
 NOTLISTEDFILES (
REMOVE
 (
NAMEFIELD
 FULLNAME T)
						NOTLISTEDFILES]
	       FULLNAME])
)

(RPAQ? FILELST
 )

(RPAQ? LOADEDFILELST
 )

(RPAQ? NOTLISTEDFILES
 )

(RPAQ? NOTCOMPILEDFILES
 )

(RPAQ? MAKEFILEFORMS
 )

(RPAQ? NILCOMS
 )

(ADDTOVAR MAKEFILEOPTIONS
 RC C LIST FAST CLISP CLISPIFY NIL REMAKE NEW NOCLISP CLISP%  F ST STF
			     (REC . RC)
			     (BREC . RC)
			     (TC . C)
			     (BC . C)
			     (TCOMPL . C)
			     (BCOMPL . C))

(RPAQ? MAKEFILEREMAKEFLG
 T)

(RPAQ? CLEANUPOPTIONS
 (QUOTE (RC)))
(* * "scanning file coms")


(DEFINEQ

(FILEPKGCHANGES

  [LAMBDA N                                                  (* lmm "22-JUL-83 13:35")

    (COND
      [(EQ N 0)
	(PROG (TEM)
	      (RETURN (for
 X in
 FILEPKGTYPES when
 (AND (LITATOM X)
						       (SETQ TEM (FILEPKGCHANGES
 X)))
			 collect
 (CONS X TEM]
      [(EQ (ARG N 1)
	   T)
	(for
 X in
 FILEPKGTYPES when
 (LITATOM X) collect
 (CONS X (FILEPKGCHANGES
 X]
      [(EQ N 1)
	(COND
	  [(LISTP (ARG N 1))
	    (for
 X in
 (ARG N 1) when
 (FMEMB (CAR X)
					    FILEPKGTYPES)
	       do
 (/replace
 CHANGED of
 (CAR X) with
 (CDR X]
	  (T (for
 Y on
 (fetch
 CHANGED of
 (ARG N 1)) when
 [AND (CAR Y)
							      (NOT (MEMBER (CAR Y)
									   (CDR Y]
		collect
 (CAR Y]
      (T (/replace
 CHANGED of
 (ARG N 1) with
 (ARG N 2])

(GETFILEPKGTYPE

  [LAMBDA (TYPE ONLY NOERROR NAME)                           (* lmm "28-Sep-84 11:25")

    (
COND

      [(
LISTP
 TYPE)
	(for
 X in
 TYPE collect
 (
OR
 (GETFILEPKGTYPE
 X ONLY NOERROR NAME)
				   (
RETURN
]
      ((
EQ
 TYPE (
QUOTE
 ?))
	(
AND
 NAME (TYPESOF
 NAME)))
      [(
AND
 (
NEQ
 ONLY (
QUOTE
 COMS))
	    (
LITATOM
 TYPE)
	    (
OR
 (
SELECTQ
 TYPE
			 (NIL (
QUOTE
 FNS))
			 (T (
QUOTE
 VARS))
			 NIL)
		(
PROG1
 (
CAR
 (
FMEMB
 TYPE FILEPKGTYPES))       (* If the TYPE is exactly a filepkgtype ...)

		       )
		(
PROG1
 (
CDR
 (
ASSOC
 TYPE FILEPKGTYPES))       (* or if it is synonym'd as a filepkgtype ...)

		       ]
      [(
AND
 (
NEQ
 ONLY (
QUOTE
 TYPE))
	    (
LITATOM
 TYPE)
	    (
PROG1
 (
CAR
 (
FMEMB
 TYPE FILEPKGCOMSPLST))        (* Prefer an exact match quickly)

		   ]
      [(
AND
 (
NEQ
 ONLY (
QUOTE
 COMS))
	    (
LITATOM
 TYPE)
	    (
PROG1
 (
AND
 (
NEQ
 (
NTHCHARCODE
 TYPE -1)
			     (
CHARCODE
 S))
			(GETFILEPKGTYPE
 (
PACK*
 TYPE (
QUOTE
 S))
					ONLY T))             (* or maybe it only needs pluralizing)

		   ]
      [(
FIXSPELL
 TYPE NIL (
SELECTQ
 ONLY
				   (TYPE FILEPKGTYPES)
				   (COMS FILEPKGCOMSPLST)
				   (
UNION
 FILEPKGTYPES FILEPKGCOMSPLST]
      ((
NOT
 NOERROR)
	(
ERROR
 (
SELECTQ
 ONLY
			(TYPE "invalid file package type")
			(COMS "unrecognized file package command")
			"Bad file package type/command")
	       TYPE])

(MARKASCHANGED

  [LAMBDA (NAME TYPE REASON)                                (* rmk: "24-MAR-83 23:22")

    (COND
      (FILEPKGFLG (SELECTQ REASON
			   ((DEFINED CHANGED DELETED CLISP))
			   (NIL                             (* For backward compatibility)

				(SETQQ REASON CHANGED))
			   (T (SETQQ REASON DEFINED))
			   (ERROR "BAD REASON" REASON))
		  (SETQ TYPE (GETFILEPKGTYPE
 TYPE (QUOTE TYPE)))
		  (for
 X inside
 (fetch
 WHENCHANGED of
 TYPE) do
 (APPLY* X NAME TYPE
								       (SELECTQ REASON
										(DEFINED 
                                                            (* The user hasn't updated himself)

											 T)
										(CHANGED NIL)
										REASON)))
		  (AND MSDATABASELST (NEQ REASON (QUOTE CLISP))
		       (MSMARKCHANGED NAME TYPE REASON))
		  (COND
		    ((EQ TYPE (QUOTE FILES))
		      (MARKASCHANGED
 (FILECOMS
 NAME)
				     (QUOTE VARS)
				     REASON))
		    ((EQ REASON (QUOTE DELETED))
		      (for
 L on
 (fetch
 CHANGED of
 TYPE) when
 (EQ (CAR L)
								 NAME)
			 do
 (/RPLACA L NIL))                (* unmark as changed and remove from files)

		      (DELFROMFILES
 NAME TYPE))
		    ((OR (NEQ REASON (QUOTE CLISP))
			 (NULL CLISPIFYPRETTYFLG))

          (* If CLISPIFYPRETTYFLG=NIL, the user doesn't want clisp on files. The fact that we just removed some clisp suggests

	  that he'd like to see the new version dumped. But since this doesn't guarantee that clisp won't appear 

	  (only the functions that get dwimified are noticed), this probably isn't worth doing. It also makes the file package

	  virtually useless for someone with CLISPIFYPRETTYFLG=NIL working on files made by a user who has 

	  CLISPIFYPRETTYFLG=T.)



		      (SETQ TYPE (push
 (fetch
 CHANGED of
 TYPE)
				       NAME))
		      (COND
			(LISPXHIST (UNDOSAVE (LIST (QUOTE /RPLACA)
						   TYPE)
					     LISPXHIST)))   (* Undone by smashing with NIL, so that each call to 

							    MARKASCHANGED can be handled independently.)

		      ))
		  NAME])

(FILECOMS

  [LAMBDA (FILE X)                                          (* rmk: "19-FEB-83 13:55")

    (COND
      ((AND (NULL FILE)
	    (NULL X))
	(QUOTE NILCOMS))
      [(AND (OR (NULL X)
		(EQ X (QUOTE COMS)))
	    (fetch
 COMSNAME of
 (LISTP (fetch
 FILEPROP of
 FILE]
      (T (PACK* (NAMEFIELD FILE)
		(OR X (QUOTE COMS])

(WHEREIS

  (LAMBDA (NAME TYPE FILES FN)                               (* JonL "24-Jul-84 19:47")

    (COND
      ((EQ NAME T)                                           (* T as a NAME has a special meaning to INFILECOMS? so 

							     don't pass through.)

	NIL)
      (FN                                                    (* TYPE is coerced by the innards of INFILECOMS?)

	  (for
 FILE in
 (OR (LISTP FILES)
			   FILELST)
	     when
 (INFILECOMS?
 NAME TYPE (FILECOMS
 FILE)) do
 (APPLY* FN NAME FILE)))
      (T (SUBSET (OR (LISTP FILES)
		     FILELST)
		 (FUNCTION (LAMBDA (FILE)
		     (INFILECOMS?
 NAME TYPE (FILECOMS
 FILE)))))))))

(SMASHFILECOMS

  [LAMBDA (FILE)                                            (* rmk: "19-FEB-83 22:15")

    (for
 X in
 (FILECOMSLST
 FILE (QUOTE FILEVARS)) when
 (LITATOM X) do
 (SETTOPVAL X (QUOTE NOBIND)))
    FILE])

(FILEFNSLST

  [LAMBDA (FILE)                                            (* lmm " 7-SEP-78 18:47")

    (FILECOMSLST
 FILE (QUOTE FNS])

(FILECOMSLST

  (LAMBDA (FILE TYPE FLG)                                    (* JonL "24-Jul-84 19:48")

                                                             (* TYPE is coerced in the innards of INFILECOMS?)

    (COND
      ((EQ FLG (QUOTE UPDATE))
	(CDR (INFILECOMS?
 NIL TYPE (FILECOMS
 FILE)
			  FLG)))
      (T (INFILECOMS?
 NIL TYPE (FILECOMS
 FILE)
		      FLG)))))

(UPDATEFILES

  [LAMBDA (PRLST FLST)                                      (* rmk: "19-FEB-83 14:27")

                                                            (* PRLST may be the value of FILEPKGCHANGES before some 

							    operation (e.g. LOAD, LOADFNS) involving the files in 

							    FLST began.)

    (for
 TYPE CHANGED in
 FILEPKGTYPES when
 (SETQ CHANGED (fetch
 CHANGED of
 TYPE))
       do
 (COND
	    ((NULL (SETQ CHANGED (FILEPKGCHANGES
 TYPE)))    (* FILEPKGCHANGES eliminates duplicates)

	      (/replace
 CHANGED of
 TYPE with
 NIL))
	    (T (for
 FILE FOUND FILEPROP COMS LST TYPEDPROP PCHANGES (PREVITEMS _(CDR (ASSOC TYPE 
											    PRLST)))
		  in
 FILELST
		  first
 (SETQ LST (INFILECOMS?
 CHANGED TYPE (QUOTE NILCOMS)
					       (QUOTE UPDATE)))

          (* First check NIL=Nowhere. LST:1 contains variables whose values are on the file literally.

	  These are "found" but not marked. LST::1 contains all other items.)



			(SETQ FOUND (NCONC (CAR LST)
					   (CDR LST)
					   FOUND))
		  do
 (SETQ PCHANGES (COND
			 ((FMEMB (fetch
 DATEFILENAME of
 (CAR (fetch
 FILEDATES of
 FILE)))
				 FLST)

          (* PREVITEMS are changed items that were previously on the changed list, before PRLST was computed as this 

	  LOAD/LOADFNS began. Thus, by this intersection we only worry about items that were previously changed;

	  any items that were only changed during this operation are ignored.)



			   (INTERSECTION CHANGED PREVITEMS))
			 (T CHANGED)))
		     [COND
		       ([AND PCHANGES [SETQ COMS (fetch
 COMSNAME
						    of
 (SETQ FILEPROP (LISTP (fetch
 FILEPROP
										of
 FILE]
			     (SETQ LST (INFILECOMS?
 PCHANGES TYPE COMS (QUOTE UPDATE]

          (* LST:1 is a list of the times that literally appear on this file, LST::1 is a list of those whose literal values 

	  are not in the coms)



			 [COND
			   ((CDR LST)                       (* CDR items must be distributed)

			     [COND
			       ((NULL (fetch
 TOBEDUMPED of
 FILEPROP))
                                                            (* Only finagle global lists the first time an item is 

							    added to PROP, when PROP::1 goes from NIL to non-NIL)

				 [/SETTOPVAL (QUOTE NOTLISTEDFILES)
					     (REMOVE FILE (GETTOPVAL (QUOTE NOTLISTEDFILES]
				 (/SETTOPVAL (QUOTE NOTCOMPILEDFILES)
					     (REMOVE FILE (GETTOPVAL (QUOTE NOTCOMPILEDFILES]
                                                            (* Get the (possibly new) TYPE item list to smash)

			     [COND
			       [(SETQ TYPEDPROP (ASSOC TYPE (fetch
 TOBEDUMPED of
 FILEPROP]
			       (T (/NCONC1 FILEPROP (SETQ TYPEDPROP (CONS TYPE]
                                                            (* Now distribute items to the file property)

			     (for
 Y in
 (CDR LST) unless
 (MEMBER Y (CDR TYPEDPROP))
				do
 (/NCONC1 TYPEDPROP Y]
			 (SETQ FOUND (NCONC (CAR LST)
					    (CDR LST)
					    FOUND]
		  finally
 (/replace
 CHANGED of
 TYPE with
 (LDIFFERENCE CHANGED FOUND])

(INFILECOMS?

  [LAMBDA (NAME TYPE COMS ONFILETYPE)                        (* rmk: " 3-JAN-82 22:56")


          (* Returns T if NAME is 'CONTAINED' in COMS. If NAME is NIL, then value is a list of all of the functions 

	  contained in COMS. If NAME=T, value is T if there are any elements of type TYPE, otherwise NIL 

	  (this feature is used for deciding whether or not (and how) to compile files.) Called by FILEFNSLST 

	  (which is used by BRECOMPILE) and by NEWFILE1. while elements are the subset of NAME which are on the file in 

	  other case)




          (* if ONFILETYPE is UPDATE, then NAME is a list of elements, and INFILECOMS? returns the dotted pair of 

	  (literals . elements) where literals are those which are "literally" on the file (e.g. (VARS 

	  (X 3))) -

	  if ONEFILETYPE is EDIT, then NAME is interpreted as for ONFILETYPE=NIL, but only those elements which are not on 

	  the file literally and which are not subparts of other types are returned)



    (PROG (VAL LITERALS ORIGFLG)
          (SETQ TYPE (GETFILEPKGTYPE
 TYPE))
          (SELECTQ ONFILETYPE
		   (EDIT (SELECTQ TYPE
				  (FILEVARS (RETURN))
				  NIL))
		   NIL)
          [COND
	    ((LITATOM COMS)
	      (SELECTQ TYPE
		       ((VARS FILEVARS)                      (* the COMS of a file are also on it)

			 (INFILECOMSVAL
 COMS))
		       NIL)
	      (SETQ COMS (GETATOMVAL COMS]
          (INFILECOMS
 COMS)
          (SETQ VAL (DREVERSE VAL))
          (RETURN (COND
		    ((EQ ONFILETYPE (QUOTE UPDATE))
		      (CONS LITERALS VAL))
		    (T VAL])

(INFILECOMTAIL

  [LAMBDA (COM FLG)                                          (* lmm "27-Aug-84 21:42")

    [SETQ COM (COND
	((EQ (CADR COM)
	     (QUOTE *))
	  (COND
	    [(LITATOM (CADDR COM))
	      (LISTP (GETATOMVAL (CADDR COM]
	    (T [RESETVARS (DWIMLOADFNSFLG)
		          (NLSETQ (SETQ COM (EVAL (CADDR COM]
	       COM)))
	(T (CDR COM]
    (if
 (NOT FLG)
	then
 [SUBSET COM (FUNCTION (LAMBDA (X)
			 (OR (NLISTP X)
			     (NEQ (CAR X)
				  COMMENTFLG]
      else
 COM])

(INFILECOMS

  [LAMBDA (COMS)                                            (* rmk: "19-FEB-83 22:17")

    (for
 X in
 COMS do
 (INFILECOM
 X])

(INFILECOM

  [LAMBDA (COM)                                              (* lmm "27-Aug-84 21:43")

    (COND
      [(NLISTP COM)
	(COND
	  ((EQ TYPE (QUOTE VARS))
	    (INFILECOMSVAL
 COM]
      ((EQ (CAR COM)
	   COMMENTFLG)                                       (* must be special case'd first so that 

							     (* * values) doesn't make it look like "values" is a 

							     variable -)

                                                             (* don't know why I should bother, but someone might 

							     want to know all of the comments on a file???)

	(COND
	  ((EQ TYPE COMMENTFLG)
	    (INFILECOMSVAL
 COM T)))
	NIL)
      (T (PROG ((COMNAME (CAR COM))
		(TAIL (CDR COM))
		CFN TEM)
	       (COND
		 [[COND
		     ((SETQ CFN (fetch
 (FILEPKGCOM
 CONTENTS) of
 COMNAME))
		       (SETQ TEM (APPLY* CFN COM (COND
					   ((AND (NULL ONFILETYPE)
						 (LISTP NAME))
                                                             (* call from WHEREIS of a name which is a list)

					     (LIST NAME))
					   (T NAME))
					 TYPE ONFILETYPE)))
		     ((SETQ CFN (fetch
 (FILEPKGCOM
 PRETTYTYPE) of
 COMNAME))
                                                             (* for compatability)

		       (SETQ TEM (APPLY* CFN COM TYPE NAME]
		   (COND
		     [(NLISTP TEM)
		       (COND
			 ((EQ TEM T)
			   (COND
			     ((OR (EQ NAME T)
				  (NULL ONFILETYPE))
			       (RETFROM (QUOTE INFILECOMS?)
					T]
		     (T (INFILECOMSVALS
 TEM]
		 ((LISTP TAIL)

          (* this SELECTQ handles the "exceptional cases" for the built in types. There is an explicit RETURN in the SELECTQ

	  clause if the default is handled)



		   (SELECTQ COMNAME
			    ((PROP IFPROP)
			      (SETQ TAIL (CDR TAIL)))
			    NIL)
		   [COND
		     ((EQ (CAR TAIL)
			  (QUOTE *))
		       (COND
			 ((LITATOM (CADR TAIL))
			   (SELECTQ TYPE
				    ((VARS FILEVARS)
				      (INFILECOMSVAL
 (CADR TAIL)))
				    NIL))
			 ((AND (LISTP (CADR TAIL))
			       (EQ ONFILETYPE (QUOTE UPDATE))
			       (EQ TYPE (QUOTE VARS))
			       (EQ (CAADR TAIL)
				   (QUOTE PROGN))
			       (FMEMB (CAR (LAST (CADR TAIL)))
				      NAME))
			   (SETQ VAL (CONS (CADR TAIL)
					   VAL]
		   (SELECTQ COMNAME
			    ((COMS EXPORT)
			      (INFILECOMS
 (INFILECOMTAIL
 COM)))
			    [DECLARE:                        (* skip over DECLARE: tags)

				      (RETURN (IFCDECLARE
 (INFILECOMTAIL
 COM)
							  (EQ TYPE (QUOTE DECLARE:]
			    [ORIGINAL                        (* dont expand macros)

				      (PROG ((ORIGFLG T))
					    (INFILECOMS
 (INFILECOMTAIL
 COM]
			    ((PROP IFPROP)                   (* this currently does not handle "pseudo-types" of 

							     PROPNAMES)

			      (SELECTQ TYPE
				       (PROPS (IFCPROPSCAN
 (INFILECOMTAIL
 (CDR COM))
							   (CADR COM)))
				       (MACROS (INFILECOMSMACRO
 (INFILECOMTAIL
 (CDR COM))
								(CADR COM)))
				       NIL))
			    (PROPS (RETURN (IFCPROPS
 COM)))
			    (MACROS (RETURN (SELECTQ TYPE
						     (PROPS (IFCPROPSCAN
 (INFILECOMTAIL
 COM)
									 MACROPROPS))
						     (MACROS (INFILECOMSVALS
 (INFILECOMTAIL
 COM)))
						     NIL)))
			    (ALISTS                          (* sigh. This should probably also "coerce" when asking 

							     for LISPXMACROS, etc.)

				    (RETURN (SELECTQ TYPE
						     (ALISTS (INFILEPAIRS
 (INFILECOMTAIL
 COM)))
						     NIL)))
			    [(ADVICE ADVISE)                 (* this code turns (ADVISE (FOO IN FOOBLOCK)) to 

							     FOO-IN-FOOBLOCK)

			      (RETURN (COND
					((OR (EQ TYPE (QUOTE ADVICE))
					     (EQ TYPE (QUOTE ADVISE)))
					  (for
 X in
 (INFILECOMTAIL
 COM) do
 (INFILECOMSVALS

									     (PACK-IN- X]
			    [P (RETURN (SELECTQ TYPE
						((EXPRESSIONS P)
						  (INFILECOMSVALS
 (INFILECOMTAIL
 COM T)
								  T))
						(COND
						  ((NULL ONFILETYPE)
                                                             (* for WHEREIS and FILECOMSLST)

						    (SELECTQ TYPE
							     (I.S.OPRS (IFCEXPRTYPE
 COM (QUOTE 
											  I.S.OPR)))
							     (TEMPLATES (IFCEXPRTYPE
 COM
										     (QUOTE 
										      SETTEMPLATE)))
							     (ADVICE (IFCEXPRTYPE
 COM (QUOTE ADVISE)))
							     NIL]
			    [(ADDVARS APPENDVARS)
			      (SELECTQ TYPE
				       [VARS (RETURN (AND (NULL ONFILETYPE)
							  (for
 X in
 (INFILECOMTAIL
 COM T)
							     do
 (INFILECOMSVAL
 (CAR X)
									       T]
				       [ALISTS (RETURN (for
 X in
 (INFILECOMTAIL
 COM)
							  when
 (EQMEMB (QUOTE ALIST)
								       (GETPROP (CAR X)
										(QUOTE VARTYPE)))
							  do
 (for
 Z in
 (CDR X)
								do
 (INFILECOMSVAL

								     (LIST (CAR X)
									   (CAR Z))
								     T]
				       (OR (EQ TYPE COMNAME)
					   (RETURN]
			    [(VARS INITVARS FILEVARS UGLYVARS HORRIBLEVARS CONSTANTS ARRAY)
			      (RETURN (COND
					((EQ TYPE (QUOTE EXPRESSIONS))
					  (for
 X in
 (INFILECOMTAIL
 COM) when
 (LISTP X)
					     do
 (INFILECOMSVAL
 (CONS (QUOTE SETQ)
								     X)
							       T)))
					((OR (EQ TYPE (QUOTE VARS))
					     (EQ TYPE COMNAME))
                                                             (* either want all VARS, or else want all FILEVARS and 

							     this is a FILEVARS command)

					  (for
 X in
 (INFILECOMTAIL
 COM)
					     do
 (COND
						  ((LISTP X)
						    (INFILECOMSVAL
 (CAR X)
								   T))
						  (T (INFILECOMSVAL
 X (EQ COMNAME (QUOTE INITVARS]
			    [DEFS (RETURN (for
 X in
 (INFILECOMTAIL
 COM) when
 (EQ TYPE (CAR X))
					     do
 (INFILECOMSVALS
 (CDR X]
			    (FILES (RETURN))
			    NIL)

          (* * Exceptional cases now handled. If TYPE matches (CAR COM) then scan the tail as usual.

	  Else expand the com's MACRO, if it has one, unless there was a CONTENTS function)



		   (COND
		     ((EQ COMNAME TYPE)
		       (INFILECOMSVALS
 (INFILECOMTAIL
 COM)))
		     ((AND (OR (NULL CFN)
			       (AND (EQ CFN T)
				    (NULL ONFILETYPE)))
			   (NULL ORIGFLG)
			   (SETQ TEM (fetch
 (FILEPKGCOM
 MACRO) of
 COMNAME)))
		       (INFILECOMS
 (SUBPAIR (CAR TEM)
					    (INFILECOMTAIL
 COM)
					    (CDR TEM])

(INFILECOMSVALS

  [LAMBDA (X FLG)                                           (* rmk: "19-FEB-83 22:22")

    (for
 Y in
 X do
 (INFILECOMSVAL
 Y FLG])

(INFILECOMSVAL

  [LAMBDA (X FLG)                                            (* bvm: " 2-Dec-83 14:58")

    (COND
      [(EQ ONFILETYPE (QUOTE UPDATE))
	(AND (OR (NULL NAME)
		 (MEMBER X NAME))
	     (COND
	       (FLG (SETQ LITERALS (CONS X LITERALS)))
	       (T (SETQ VAL (CONS X VAL]
      ((AND (EQ ONFILETYPE (QUOTE EDIT))
	    FLG)                                             (* literals should not be edited as they are on the 

							     fileCOMS)

	NIL)
      ([OR (EQ NAME T)
	   (COND
	     ((LITATOM NAME)
	       (EQ NAME X))
	     (T (EQUAL NAME X]
	(RETFROM (FUNCTION INFILECOMS?)
		 T))
      ((NULL NAME)
	(SETQ VAL (CONS X VAL])

(INFILECOMSPROP

  [LAMBDA (AT PROP)                                         (* lmm "25-SEP-81 17:15")

    (COND
      [(EQ ONFILETYPE (QUOTE UPDATE))
	(AND [OR (NULL NAME)
		 (find
 X in
 NAME suchthat
 (AND (EQ (CAR X)
						   AT)
					       (EQ (CADR X)
						   PROP]
	     (SETQ VAL (CONS (LIST AT PROP)
			     VAL]
      ((OR (EQ NAME T)
	   (AND (EQ (CAR NAME)
		    AT)
		(EQ (CADR NAME)
		    PROP)))
	(RETFROM (FUNCTION INFILECOMS?)
		 T))
      ((NULL NAME)
	(SETQ VAL (CONS (LIST AT PROP)
			VAL])

(IFCPROPS

  [LAMBDA (COM)                                              (* bvm: " 2-Dec-83 14:24")


          (* * Examine a PROPS com for objects of specified TYPE)



    (SELECTQ TYPE
	     (PROPS                                          (* the PROPS command can actually take 

							     (PROPNAME at1 at2 ...))

		    (INFILEPAIRS
 (INFILECOMTAIL
 COM)))
	     [PROP                                           (* return the atoms which have any properties at all)

		   (for
 PAIR in
 (INFILECOMTAIL
 COM) do
 (for
 ATNAME inside
 (CAR PAIR)
							  do
 (INFILECOMSVAL
 ATNAME]
	     [MACROS                                         (* only MACRO properties)

		     (for
 PAIR in
 (INFILECOMTAIL
 COM) do
 (INFILECOMSMACRO
 (CAR PAIR)
									  (CDR PAIR]
	     NIL])

(IFCEXPRTYPE

  [LAMBDA (COM FN)                                           (* bvm: " 2-Dec-83 14:30")


          (* * Recognizes expressions in COM (a P com) that are calls to function FN)



    (for
 SUBCOM in
 (INFILECOMTAIL
 COM) when
 (AND (EQ (CAR SUBCOM)
						     FN)
						 (EQ (CAR (LISTP (CADR SUBCOM)))
						     (QUOTE QUOTE)))
       do
 (INFILECOMSVAL
 [COND
			   [(EQ FN (QUOTE ADVISE))
			     (PACK-IN- (CADR (CADR COM]
			   (T (CADR (CADR SUBCOM]
			 T])

(IFCPROPSCAN

  [LAMBDA (ATOMS PROPNAMES)                                  (* bvm: " 2-Dec-83 15:10")


          (* * Recognizes members of ATOMS as being names (atom prop) of type PROPS for any prop in PROPNAMES)



    (for
 AT in
 ATOMS unless
 [COND
			      [(EQ ONFILETYPE (QUOTE UPDATE))
				(COND
				  (NAME (NOT (ASSOC AT NAME]
			      ((LISTP NAME)
				(NEQ AT (CAR NAME]
       do
 (COND
	    ((EQ PROPNAMES (QUOTE ALL))
	      (for
 PROP in
 (GETPROPLIST AT) by
 (CDDR PROP) when
 (NOT (FMEMB PROP SYSPROPS))
		 collect
 (INFILECOMSPROP
 AT PROP)))
	    (T (for
 PROP inside
 PROPNAMES do
 (INFILECOMSPROP
 AT PROP])

(IFCDECLARE

  [LAMBDA (TAIL WANTDECLARE)                                (* lmm "19-Aug-84 14:17")

    (PROG ((TAIL TAIL))
      LP  (COND
	    ((LISTP TAIL)
	      [SELECTQ (CAR TAIL)
		       ((EVAL@LOADWHEN EVAL@COMPILEWHEN COPYWHEN)
			 [AND WANTDECLARE (INFILECOMSVAL
 (LIST (CAR TAIL)
							       (CADR TAIL]
			 (SETQ TAIL (CDR TAIL)))
		       (COMPILERVARS (RETURN))
		       (COND
			 [(FMEMB (CAR TAIL)
				 DECLARETAGSLST)
			   (COND
			     (WANTDECLARE (INFILECOMSVAL
 (CAR TAIL]
			 (T (INFILECOM
 (CAR TAIL]
	      (SETQ TAIL (CDR TAIL))
	      (GO LP])

(INFILEPAIRS

  [LAMBDA (LST)                                             (* lmm " 4-DEC-78 09:51")

    (for
 LL in
 LST do
 (for
 X inside
 (CAR LL) do
 (for
 Y inside
 (CDR LL)
						   do
 (INFILECOMSVAL
 (LIST X Y])

(INFILECOMSMACRO

  [LAMBDA (ATS PROPS)                                       (* lmm "28-SEP-78 18:35")


          (* this function is used, given a PROP or PROPS command, to tell which MACROS are contained in it.

	  -

	  Normally (e.g. for WHEREIS and FILECOMSLST) it wants to return if the command contains any of the MACROPROPS for the

	  given atom. However, for UPDATE, it only wants a "hit" if the command contains ALL of the macro properties)



    (for
 AT inside
 ATS do
 (AND [OR (NEQ ONFILETYPE (QUOTE UPDATE))
				   (EVERY (PROPNAMES AT)
					  (FUNCTION (LAMBDA (X)
					      (OR (NOT (FMEMB X MACROPROPS))
						  (EQMEMB X PROPS]
			       [SOME MACROPROPS (FUNCTION (LAMBDA (PROP)
					 (EQMEMB PROP PROPS]
			       (INFILECOMSVAL
 AT])
)
(* * "adding to a file")


(DEFINEQ

(FILES?

  [LAMBDA NIL                                               (* rmk: "19-FEB-83 22:26")

    (UPDATEFILES
)
    (PROG (FILES)
          (COND
	    ((SETQ FILES (for
 FL in
 FILELST when
 (fetch
 TOBEDUMPED
						    of
 (LISTP (fetch
 FILEPROP of
 FL)))
			    collect
 FL))
	      (MAPRINT FILES T NIL (QUOTE "...to be dumped.
")
		       (QUOTE ,)
		       NIL T)))
          (for
 TYPE FLG in
 FILEPKGTYPES when
 (FILES?1
 TYPE (AND FILES "    plus ")
						      (AND (NULL FILES)
							   "...to be dumped."))
	     do
 (SETQ FLG T) finally
 (AND FLG (ADDTOFILES?
)))
          (AND (SETQ FILES NOTLISTEDFILES)
	       (MAPRINT FILES T NIL (QUOTE "...to be listed.
")
			(QUOTE ,)
			NIL T))
          (AND (SETQ FILES NOTCOMPILEDFILES)
	       (MAPRINT FILES T NIL (QUOTE "...to be compiled.
")
			(QUOTE ,)
			NIL T))
          (RETURN])

(FILES?1

  [LAMBDA (TYPE X Y)                                        (* rmk: "22-MAY-81 13:51")

    (PROG (STR LST)
          (COND
	    ([NOT (AND (LITATOM TYPE)
		       (SETQ STR (fetch
 DESCRIPTION of
 TYPE))
		       (LISTP (SETQ LST (fetch
 CHANGED of
 TYPE]
	      (RETURN NIL)))
          (AND X (LISPXPRIN1 X T))
          (LISPXPRIN1 (QUOTE "the ")
		      T)
          (LISPXPRIN1 STR T)
          (COND
	    (NIL (IGREATERP (LENGTH LST)
			    6)
		 (LISPXPRIN1 (QUOTE " on ")
			     T)
		 (LISPXPRIN2 (CAR TYPE)
			     T T))
	    (T (MAPRINT LST T (QUOTE ": ")
			NIL
			(QUOTE ,)
			(FUNCTION [LAMBDA (X)
			    (COND
			      ((NOT (ILESSP (IPLUS (POSITION T)
						   (NCHARS X T T)
						   3)
					    (LINELENGTH NIL T)))
				(LISPXTERPRI T)
				(LISPXPRIN1 "         " T)))
			    (LISPXPRIN2 X T T])
			T)))
          (AND Y (LISPXPRIN1 Y T))
          (LISPXTERPRI T)
          (RETURN T])

(ADDTOFILES?

  [LAMBDA (NOASKSTR)                                         (* rmk: " 9-JUN-82 22:57")

                                                             (* ask user about all of the things that need to be 

							     dumped, and distribute them to the files that he says)

    (
ERSETQ

      (
PROG
 [BUFS (VARSCHANGES (fetch
 CHANGED of
 (
QUOTE
 VARS]

          (* Save VARS list at the beginning, so that changes that might occur from adding things to files 

	  (e.g. changing NILCOMS) will not be processed differently depending on the order of elements in FILEPKGTYPES)



	    [
COND

	      (NOASKSTR (
PRIN1
 NOASKSTR T))
	      (T (
DOBE
)
		 (
SETQ
 BUFS (
READP
 T))
		 (
SELECTQ
 (
ASKUSER
 DWIMWAIT (
QUOTE
 N)
				   (
QUOTE
 ("want to say where the above go"))
				   (
QUOTE
 ((Y "es
")
					    (N "o
")
					    (%] "Nowhere
" EXPLAINSTRING "] - nowhere, all items will be marked as dummy
" NOECHOFLG T)))
				   T)
			  (N (
RETURN
))
			  (%] (for
 TYPE in
 FILEPKGTYPES do
 (for
 NAME in
 (fetch
 CHANGED of
 TYPE)
							      do
 (ADDTOFILE
 NAME TYPE NIL)))
			      (
RETURN
))
			  NIL)                               (* if there was type-ahead BEFORE the askuser, then 

							     don't allow it now)

		 (
COND

		   (BUFS (
SETQ
 BUFS (
COND

			     ((
READP
 T)
			       (
LINBUF
)
			       (
SYSBUF
)
			       (
SETQ
 BUFS (
CLBUFS
 NIL T READBUF]
	    [for
 TYPE STR LST in
 FILEPKGTYPES when
 [
AND
 (
SETQ
 STR (fetch
 DESCRIPTION of
 TYPE))
							(
LISTP
 (
SETQ
 LST
								 (
COND

								   ((
EQ
 TYPE (
QUOTE
 VARS))
								     VARSCHANGES)
								   (T (fetch
 CHANGED of
 TYPE]
	       do

		(printout
 T "(" STR ")" T)
		(for
 NAME TEM FILE in
 LST when
 NAME
		   do

		    (
PROG
 NIL
		      LP  (
PRIN2
 NAME T)
		          (
SPACES
 2 T)                       (* if user typed ahead before entering addtofiles?? 

							     then dont allow typeahead here, because it will 

							     justgobble his earlier typeahead.)

		          (
SELECTQ
 (
SETQ
 TEM (
ASKUSER
 NIL NIL NIL ADDTOFILEKEYLST T))
				   (%[ (
ERSETQ
 (
PROGN
 (SHOWDEF
 NAME TYPE T)

          (* the DOBE is so that if the user control-E's after the printout is done but before it appears on the screen that 

	  the control-E will merely clear output buffer)



						      (
DOBE
)))
				       (
GO
 LP))
				   (%] (
SETQ
 FILE))
				   (%                        (* space. means no action)

				       (
RETURN
))
				   (%
 (
PRINT
 (
OR
 (
SETQ
 FILE LASTFILE)
						  (
QUOTE
 Nowhere))
					      T))
				   (
SETQ
 FILE TEM))
		          (
OR

			    (
ERSETQ
 (
PROG
 (TEM COMSNAME PLACE LISTNAME NEAR)
				          (
SETQ
 PLACE (WHATIS
 FILE NIL TYPE))
				          [
COND

					    ((
LITATOM
 PLACE)
                                                             (* file name)

					      (
SETQ
 FILE PLACE)
					      (
OR
 (ADDTOCOMS
 (
SETQ
 COMSNAME (FILECOMS
 FILE))
							     NAME TYPE NEAR LISTNAME)
						  (ADDNEWCOM
 COMSNAME NAME TYPE NIL FILE))
					      (for
 F in
 (fetch
 WHENFILED of
 TYPE)
						 do
 (
APPLY*
 F NAME TYPE FILE))
                                                             (* This isn't factored to the end, cause ADDTOLISTNAME 

							     might have to deal with a set of old elements on the 

							     listname.)

					      )
					    ((
EQ
 (
CAR
 PLACE)
						 (
QUOTE
 Near:))
					      (
SETQ
 NEAR (
CADR
 PLACE))
					      (
COND

						([
SOME
 FILELST (
FUNCTION
 (LAMBDA (FL)
							   (ADDTOCOMS
 (FILECOMS
 (
SETQ
 FILE FL))
								      NAME TYPE NEAR LISTNAME]
						  (
PRINT
 (
LIST
 (
QUOTE
 on)
							       FILE)
							 T T))
						(T (
PRINT
 (
LIST
 (
CADR
 PLACE)
								(
QUOTE
 not)
								(
QUOTE
 found))
							  T T)
						   (
ERROR!
)))
					      (for
 F in
 (fetch
 WHENFILED of
 TYPE)
						 do
 (
APPLY*
 F NAME TYPE FILE)))
					    ([
OR
 [
UNDONLSETQ

						   (
PROGN
 (
SAVESET
 (
SETQ
 LISTNAME (
CAR
 PLACE))
								   (MERGEINSERT
 NAME
										(
LISTP
 (
GETTOPVAL

											 LISTNAME))
										T)
								   T
								   (
QUOTE
 NOPRINT))
							  (
OR
 (
SETQ
 FILE
								(
CAR
 (WHEREIS
 NAME TYPE FILELST)))
							      (
ERROR!
]
						 (
SOME
 FILELST (
FUNCTION
 (LAMBDA (X)
							   (ADDTOCOMS
 (FILECOMS
 (
SETQ
 FILE X))
								      NAME TYPE NEAR LISTNAME]
					      (
PRIN1
 "  value is filed on " T)
					      (
PRINT
 FILE T T)
					      (for
 F in
 (fetch
 WHENFILED of
 TYPE)
						 do
 (
APPLY*
 F NAME TYPE FILE))

          (* Only have to notice the single new item here, unlike the case in ADDNEWCOM below, cause other items on the list 

	  already belong and were previously noticed)



					      )
					    (T (
PRIN1
 "    put list " T)
					       (
PRIN2
 (
CAR
 PLACE)
						      T T)
					       (
SETQ
 FILE
						 (WHATIS
 (
ASKUSER
 NIL NIL " on file: "
								  [
QUOTE
 (("" "" EXPLAINSTRING 
									      "a file name"
									      KEYLST
									      (]
								  T)
							 (
QUOTE
 FILE)))
					       (
SAVESET
 (
CAR
 PLACE)
							(MERGEINSERT
 NAME (
LISTP
 (
GETTOPVAL

										   (
CAR
 PLACE)))
								     T)
							T
							(
QUOTE
 NOPRINT))
                                                             (* Add new item before new command, so that user's new 

							     command function can inspect 

							     (CAR PLACE) and see all the items involved.)

					       (ADDNEWCOM
 (FILECOMS
 FILE)
							  NAME TYPE (
CAR
 PLACE)
							  FILE)
					       (for
 F in
 (fetch
 WHENFILED of
 TYPE)
						  do
 (for
 I in
 (
GETTOPVAL
 (
CAR
 PLACE))
							do
 (
APPLY*
 F I TYPE FILE]
				          (
AND
 FILE (ADDFILE
 FILE))
				          (
SETQ
 LASTFILE PLACE)))
			    (
GO
 LP]
	    (
AND
 BUFS (
BKBUFS
 BUFS))
	    (UPDATEFILES
])

(ADDTOFILE

  [LAMBDA (NAME TYPE FILE NEAR LISTNAME)                     (* lmm "21-Nov-84 11:43")

                                                             (* adds NAME to the file FILE)

    (
PROG
 (TEM COMSNAME)
          [
SETQ
 TYPE (
OR
 (GETFILEPKGTYPE
 TYPE NIL T)
			 (
COND

			   ((
FMEMB
 TYPE FILELST)
			     (GETFILEPKGTYPE
 (swap
 TYPE FILE)))
			   (T (GETFILEPKGTYPE
 TYPE]
          (
SETQ
 FILE (WHATIS
 FILE (
QUOTE
 FILE)))
          (
OR
 (ADDTOCOMS
 (
SETQ
 COMSNAME (FILECOMS
 FILE))
			 NAME TYPE NEAR LISTNAME)
	      (ADDNEWCOM
 COMSNAME NAME TYPE NIL FILE))
          (for
 F in
 (fetch
 WHENFILED of
 TYPE) do
 (
APPLY*
 F NAME TYPE FILE))
          (
AND
 FILE (
NOT
 (
FMEMB
 FILE FILELST))
	       (ADDFILE
 FILE))
          (
RETURN
 FILE])

(WHATIS

  [LAMBDA (USERINPUT ONLY)                                   (* lmm "28-Nov-84 16:49")


          (* decides whether USERINPUT is a file or a list name -

	  if ONLY is nil, means either a listname or a filename is accepatble; if ONLY is LIST then only a listname is 

	  acceptable and if ONLY is FILE then only a file name is acceptable)



    (
PROG
 (TEM UCASE)
          (
RETURN
 (
COND

		    ((
NULL
 USERINPUT)                        (* nowhere)

		      NIL)
		    [(
LISTP
 USERINPUT)
		      (
COND

			(ONLY (
ERROR!
))
			(T (
SELECTQ
 (
CAR
 USERINPUT)
				    ((@ Near:)
				      (
CONS
 (
QUOTE
 Near:)
					    (
CDR
 USERINPUT)))
				    (WHATIS
 (
CAR
 USERINPUT)
					    (
QUOTE
 LIST]
		    ([
AND
 (
NEQ
 ONLY (
QUOTE
 LIST))
			  (
OR
 (
FMEMB
 (
SETQ
 TEM (
SETQ
 UCASE (
U-CASE
 USERINPUT)))
				     FILELST)
			      (
LISTP
 (
GETTOPVAL
 (FILECOMS
 UCASE)))
			      (
SETQ
 TEM (
FIXSPELL
 UCASE NIL FILELST T]
		      TEM)
		    ((
AND
 (
NEQ
 ONLY (
QUOTE
 FILE))
			  (
LISTP
 (
GETTOPVAL
 USERINPUT)))
		      (
LIST
 USERINPUT))
		    ((
AND
 (
NEQ
 ONLY (
QUOTE
 LIST))
			  (
EQ
 (
ASKUSER
 NIL NIL (
LIST
 "create new file" UCASE)
				       NIL T)
			      (
QUOTE
 Y)))
		      UCASE)
		    ((
AND
 (
NEQ
 ONLY (
QUOTE
 FILE))
			  (
EQ
 (
ASKUSER
 NIL NIL (
LIST
 "create new list" USERINPUT)
				       NIL T)
			      (
QUOTE
 Y)))
		      (
LIST
 USERINPUT))
		    (T                                       (* none of above)

		       (
ERROR!
])

(ADDTOCOMS

  [LAMBDA (COMS NAME TYPE NEAR LISTNAME)                     (* rmk: "10-JUN-82 22:53")


          (* try to insert NAME of type TYPE command list COMS (either a coms name, or a just a list of coms); return NIL if 

	  unsuccessful. If LISTNAME is given, then only insert by adding to LISTNAME %. If NEAR is given, only insert near it)



    (
COND

      ((
NULL
 COMS)
	NIL)
      [(
LITATOM
 COMS)                                        (* given a name of a command;

							     rebind COMSNAME to current variable and try to add to 

							     its value)

	(
OR
 [
PROG
 ((COMSNAME COMS))
	          (
RETURN
 (ADDTOCOMS
 (
LISTP
 (
GETTOPVAL
 COMSNAME))
				     NAME TYPE NEAR (
AND
 (
NEQ
 COMS LISTNAME)
							 LISTNAME]
	    (
AND
 (
EQ
 COMS LISTNAME)
		 (ADDNEWCOM
 COMS NAME TYPE]
      (T (
SETQ
 TYPE (GETFILEPKGTYPE
 TYPE))
	 (for
 TAIL on
 COMS do
 (
COND

				[(
LISTP
 (
CAR
 TAIL))
				  (
COND

				    ((ADDTOCOM
 (
CAR
 TAIL)
					       NAME TYPE NEAR LISTNAME)
				      (
RETURN
 T]
				(T (
SELECTQ
 (
CAR
 TAIL)
					    ((EVAL@LOADWHEN EVAL@COMPILEWHEN COPYWHEN)
					      (
SETQ
 TAIL (
CDR
 TAIL)))
					    NIL])

(ADDTOCOM
  [LAMBDA (COM NAME TYPE NEAR LISTNAME)         (* rmk: "10-JUN-82 23:09"
)                                               (* tries to insert NAME 
						into the prettycom COM;
						returns NIL if 
						unsuccessful)
    (PROG (TEM)
          (COND
	    ([AND NEAR (NOT (INFILECOMS? NEAR TYPE (LIST COM]
	      (RETURN)))
          [COND
	    ((SETQ TEM (fetch ADD of (CAR COM)))
	      (RETURN (COND
			((OR (NULL LISTNAME)
			     (INFILECOMS? LISTNAME (QUOTE FILEVARS)
					  (LIST COM)))
			  (AND (SETQ TEM
				 (APPLY* TEM COM NAME TYPE NEAR))
			       (MARKASCHANGED COMSNAME (QUOTE VARS)))
			  TEM]
          (RETURN
	    (SELECTQ
	      (CAR COM)
	      [FNS
		(AND
		  (EQ TYPE (QUOTE FNS))
		  (OR [AND (NOT LISTNAME)
			   (NOT NEAR)
			   (NOT (FMEMB NAME (CDR COM)))
			   MSDATABASELST
			   (for X (CALLERS _(GETRELATION NAME
							 (QUOTE CALL)
							 T))
				(CALLEES _(GETRELATION NAME
						       (QUOTE CALL)))
			      on (CDR COM) first (OR CALLERS CALLEES
						     (RETURN))
			      do 

          (* If there is no particular specification, try 
	  adding it before its callees or after its callers.)


				 (COND
				   ((FMEMB (CAR X)
					   CALLEES)
				     (/ATTACH NAME X)
				     (RETURN T))
				   ((FMEMB (CAR X)
					   CALLERS)
				     (/RPLACD X (CONS NAME
						      (CDR X)))
				     (RETURN T]
		      (ADDTOCOM1 COM NAME NEAR LISTNAME]
	      [(VARS INITVARS)
		(COND
		  ((OR (EQ (CAR COM)
			   (QUOTE VARS))
		       NEAR LISTNAME)           (* Don't stick on 
						INITVARS unless NEAR or 
						LISTNAME says we 
						should.)
		    (SELECTQ TYPE
			     [EXPRESSIONS (COND
					    ((EQ (CAR NAME)
						 (QUOTE SETQ))
					      (ADDTOCOM1 COM
							 (CDR NAME)
							 NEAR LISTNAME]
			     (VARS (ADDTOCOM1 COM NAME NEAR LISTNAME))
			     NIL]
	      (COMS (ADDTOCOMS (COND
				 [(EQ (CADR COM)
				      (QUOTE *))
				   (COND
				     ((LITATOM (CADDR COM))
				       (CADDR COM))
				     (T (RETURN]
				 (T (CDR COM)))
			       NAME TYPE NEAR LISTNAME))
	      (DECLARE: (AND (OR LISTNAME NEAR)
			     (ADDTOCOMS (COND
					  [(EQ (CADR COM)
					       (QUOTE *))
					    (COND
					      ((LITATOM (CADDR COM))
						(CADDR COM))
					      (T (RETURN]
					  (T (CDR COM)))
					NAME TYPE NEAR LISTNAME)))
	      ((ADVISE ADVICE)
		(AND (EQ TYPE (QUOTE ADVICE))
		     (ADDTOCOM1 COM NAME NEAR LISTNAME)))
	      ((PROP IFPROP)
		(SELECTQ
		  TYPE
		  (PROPS (COND
			   ((EQ (CADR COM)
				(CADR NAME))
			     (ADDTOCOM1 (CDR COM)
					(CAR NAME)
					NEAR LISTNAME))
			   ((AND (EQ (CAR NAME)
				     (CADDR COM))
				 (NULL (CDDDR COM)))
			     [/RPLACA (CDR COM)
				      (UNION (MKLIST (CDR NAME))
					     (MKLIST (CADR COM]
			     (MARKASCHANGED COMSNAME (QUOTE VARS))
			     T)))
		  [MACROS (COND
			    ([AND (for PROP inside (CADR COM)
				     always (EQMEMB PROP MACROPROPS))
				  (for PROP in MACROPROPS
				     always (OR (EQMEMB PROP
							(CADR COM))
						(NOT (GETPROP NAME PROP]

          (* every property in the command is a macro prop 
	  and, either this is an IFPROP or else the MACROS are
	  changed)


			      (ADDTOCOM1 (CDR COM)
					 NAME NEAR LISTNAME]
		  NIL))
	      ((PROPS ALISTS)
		(AND
		  (EQ TYPE (CAR COM))
		  (ADDTOCOM1
		    COM
		    (/NCONC1
		      (OR
			[ASSOC
			  (CAR NAME)
			  (COND
			    [(EQ (CADR COM)
				 (QUOTE *))
			      (COND
				[(LITATOM (CADDR COM))
				  (AND (OR (NULL LISTNAME)
					   (EQ (CADDR COM)
					       LISTNAME))
				       (GETTOPVAL (CADDR COM]
				(T (RETURN]
			    (T (CDR COM]
			(LIST (CAR NAME)))
		      (CADR NAME))
		    NEAR LISTNAME)))
	      [P (COND
		   ((AND (EQ TYPE (QUOTE EXPRESSIONS))
			 (NEQ (CAR NAME)
			      (QUOTE SETQ)))
		     (ADDTOCOM1 COM NAME NEAR LISTNAME]
	      (AND (EQ (CAR COM)
		       TYPE)
		   (ADDTOCOM1 COM NAME NEAR LISTNAME])

(ADDTOCOM1

  [LAMBDA (COM NAME NEAR LISTNAME)                          (* rmk: " 3-JAN-82 22:53")

    (COND
      [(EQ (CADR COM)
	   (QUOTE *))                                       (* add to list name)

	(AND [COND
	       (LISTNAME (EQ (CADDR COM)
			     LISTNAME))
	       (T (LITATOM (CADDR COM]
	     (SAVESET (CADDR COM)
		      [PROGN [SETQ COM (LISTP (GETTOPVAL (CADDR COM]
			     (COND
			       ((AND NEAR (SETQ NEAR (MEMBER NEAR COM)))
				 (/RPLACD NEAR (CONS NAME (CDR NEAR)))
				 COM)
			       (T (MERGEINSERT
 NAME COM T]
		      T
		      (QUOTE NOPRINT]
      ((NULL LISTNAME)                                      (* add to standard com)

	[AND (NOT (MEMBER NAME (CDR COM)))
	     (COND
	       [(SETQ NEAR (MEMBER NEAR COM))
		 (/RPLACD NEAR (CONS NAME (CDR NEAR]
	       (T (/RPLACD COM (MERGEINSERT
 NAME (CDR COM]
	(MARKASCHANGED
 COMSNAME (QUOTE VARS))
	T])

(ADDNEWCOM

  [LAMBDA (COMSNAME NAME TYPE LISTNAME FILE)                (* rmk: " 3-JAN-82 22:53")


          (* Adds to COMSNAME a new command that will dump NAME as a TYPE on FILE. -

	  if LISTNAME is given, then use it as the listname)



    (PROG (NEWCOM OLDCOM TAIL)
          (SETQ NEWCOM (MAKENEWCOM
 NAME TYPE LISTNAME FILE))
          [COND
	    ((NLISTP (SETQ TAIL (GETTOPVAL COMSNAME)))
	      (RETURN (SAVESET COMSNAME (LIST NEWCOM)
			       T
			       (QUOTE NOPRINT]
      LP  [COND
	    ((OR (NLISTP (SETQ OLDCOM (CAR TAIL)))
		 (SELECTQ (CAR OLDCOM)
			  ((LOCALVARS SPECVARS BLOCKS)
			    T)
			  (DECLARE: (FMEMB (QUOTE COMPILERVARS)
					   (CDR OLDCOM)))
			  NIL))
	      (/ATTACH NEWCOM TAIL))
	    ((LISTP (CDR TAIL))
	      (SETQ TAIL (CDR TAIL))
	      (GO LP))
	    (T (/RPLACD TAIL (LIST NEWCOM]
          (MARKASCHANGED
 COMSNAME (QUOTE VARS])

(MAKENEWCOM

  [LAMBDA (NAME TYPE LISTNAME FILE)                          (* lmm "17-Oct-84 12:30")

    (
SETQ
 TYPE (GETFILEPKGTYPE
 TYPE))
    (
PROG
 (TEM)

          (* the user function MUST (a) check if FILE = T and not do anything destructive (since this is only for showdef) and

	  (b) if LISTNAME is given, then use it rather than generating a different listname)



          (
AND
 (
LISTP
 NAME)
	       (
SETQ
 NAME (
COPY
 NAME)))
          (
RETURN
 (
OR
 (
AND
 (
SETQ
 TEM (fetch
 NEWCOM of
 TYPE))
			   (
APPLY*
 TEM NAME TYPE LISTNAME FILE))
		      (
SELECTQ
 TYPE
			       [PROPS (
AND
 (
NULL
 LISTNAME)
					   (
CONS
 (
QUOTE
 PROP)
						 (
CONS
 (
COND

							 ((
AND
 (
LISTP
 (
CDR
 NAME))
							       (
NULL
 (
CDDR
 NAME)))
							   (
CADR
 NAME))
							 (T (
CDR
 NAME)))
						       (
OR
 (
LISTP
 (
CAR
 NAME))
							   (
LIST
 (
CAR
 NAME]
			       [EXPRESSIONS (
COND

					      ((
EQ
 (
CAR
 NAME)
						   (
QUOTE
 SETQ))
						(MAKENEWCOM
 (
CDR
 NAME)
							    (
QUOTE
 VARS)
							    LISTNAME FILE))
					      (T (
CONS
 (
QUOTE
 P)
						       (
COND

							 (LISTNAME (
LIST
 (
QUOTE
 *)
									 LISTNAME))
							 (T (
LIST
 NAME]
			       (ADVICE (DEFAULTMAKENEWCOM
 NAME (
QUOTE
 ADVISE)
							  LISTNAME FILE))
			       NIL)
		      (DEFAULTMAKENEWCOM
 NAME TYPE LISTNAME FILE])

(DEFAULTMAKENEWCOM

  [LAMBDA (NAME TYPE LISTNAME FILE)
                                   (* lmm "20-OCT-82 22:48")

    (COND
      ((NOT (OR (FMEMB TYPE FILEPKGCOMSPLST)
		(fetch
 MACRO of
 TYPE)
		(fetch
 GETDEF of
 TYPE)))
	(ERROR "no defined way to dump or obtain the definition of " (OR (fetch
 DESCRIPTION
									    of
 TYPE)
									 TYPE)
	       T))
      ((NULL DEFAULTCOMHASFILEFLG)
                                   (* disable FOOFNS FOOVARS junk)

	(LIST TYPE NAME))
      ((EQ FILE T)                 (* FILE=T only when called from SHOWDEF)

	(LIST TYPE NAME))
      ([OR LISTNAME (AND FILE (SAVESET (SETQ LISTNAME (FILECOMS
 FILE TYPE))
				       (MERGEINSERT
 NAME (LISTP (GETTOPVAL LISTNAME))
						    T)
				       T
				       (QUOTE NOPRINT]
                                   (* The check (AND FILE --) is so that it will not bother with making listnames 

				   just for deleting items)

	(LIST TYPE (QUOTE *)
	      LISTNAME))
      (T (LIST TYPE NAME])
)

(RPAQ? DEFAULTCOMHASFILEFLG
 )
(DEFINEQ

(MERGEINSERT

  [LAMBDA (NEW LST ONEFLG)                                  (* edited: "15-AUG-78 21:46")


          (* searches LST to find the most reasonable place to insert NEW. DOES NOTHING IF ONEFLG IS T AND NEW IS ALREADY A 

	  MEMBER OF LST)



    (COND
      ((AND ONEFLG (MEMBER NEW LST))
	LST)
      (T (PROG ((N 0)
		LST1 PLACE TEM)
	       (SETQ LST1 LST)
	   LP  

          (* finds the function with the longest leading common substring. The idea is that if the list is only paatially 

	  sorted, want to insert the new thing in among those function that look like they are related.)



	       (COND
		 ((NULL LST1)
		   (GO OUT))
		 ((SETQ TEM (STRPOS (CAR LST1)
				    NEW 1 NIL T T))

          (* this takes precedence over even a longer string so that for example in the list (ADDTOFILES? ADDTOFILE), 

	  ADDTOFILE1 will be inserted aater ADDTOFILE)



		   (SETQ N (SUB1 TEM))
		   (SETQ PLACE LST1)
		   (GO OUT))
		 ((IGREATERP (SETQ TEM (MERGEINSERT1
 (CAR LST1)
						     NEW))
			     N)
		   (SETQ N TEM)
		   (SETQ PLACE LST1)))
	       (SETQ LST1 (CDR LST1))
	       (GO LP)
	   OUT (SETQ TEM (CAR PLACE))
	       (OR [SOME (OR PLACE LST)
			 (FUNCTION (LAMBDA (X LST)
			     (COND
			       ([OR (ALPHORDER NEW X)
				    (AND PLACE (NOT (ALPHORDER TEM X]

          (* for example, if the FNS list is something like (... FOO FOO1 ...) where the ... may ormay not be in order, e.g. 

	  (ZAP FOO FOO1 BLAH), then want to insert FOO2 after FOO1, i.e. before BLAH, even though FOO2 wold not come before 

	  BLAH in a sorted lit.)



				 (/ATTACH NEW LST))
			       (T (SETQ TEM X)
				  NIL]
		   (SETQ LST (/NCONC1 LST NEW)))
	       (RETURN LST])

(MERGEINSERT1
  [LAMBDA (X Y)                                 (* rmk: "24-MAY-82 00:05"
)

          (* value is the number of leading characters of X 
	  and Y that agree.)


    (PROG ((N 1)
	   C1 C2)
      LP  [COND
	    ((OR (NULL (SETQ C1 (NTHCHARCODE X N)))
		 (NULL (SETQ C2 (NTHCHARCODE Y N)))
		 (NEQ C1 C2))
	      (RETURN (SUB1 N]
          (SETQ N (ADD1 N))
          (GO LP])
)

(RPAQ? ADDTOFILEKEYLST
 [QUOTE ((%[ "" EXPLAINSTRING 
				   "[ -- prettyprint the item to terminal and then ask again"
				   NOECHOFLG T)
			       (%
 "" EXPLAINSTRING "{line-feed} - same as previous response" 
				   NOECHOFLG T)
			       (%  " 
" EXPLAINSTRING "{space} - no action" NOECHOFLG T)
			       (%] "Nowhere
" EXPLAINSTRING "] - nowhere, item is marked as a dummy
" NOECHOFLG T)
			       [%( "List:  (" EXPLAINSTRING "(list name)" NOECHOFLG T KEYLST
				   (( "" CONFIRMFLG (%) %] %  %
)
				       RETURN
				       (CDR ANSWER]
			       (@ "Near: " EXPLAINSTRING 
				  "@ other-item   -- put the item near the other item"
				  NOECHOFLG T KEYLST (( "" CONFIRMFLG (%
)
							 RETURN ANSWER)))
			       (%
 "" RETURN (QUOTE % ))
			       ("" "File name: " EXPLAINSTRING "a file name" KEYLST (])

(RPAQ? LASTFILE
 )
(* * "deleting an item from a file")


(DEFINEQ

(DELFROMFILES

  [LAMBDA (NAME TYPE FILES)                                 (* rmk: " 6-MAR-82 13:16")

                                                            (* Eliminates NAME as an item of type TYPE in COMS.)

    (PROG (COMS)
          (SETQ TYPE (GETFILEPKGTYPE
 TYPE))
          (RETURN (for
 FILE inside
 (OR FILES FILELST)
		     when
 [PROG1 (DELFROMCOMS
 (SETQ COMS (FILECOMS
 FILE))
					      NAME TYPE)
				 (COND
				   ((INFILECOMS?
 NAME TYPE COMS)
				     (printout
 T "(could not delete " NAME " from " FILE ")" T]
		     collect
 (for
 FN in
 (fetch
 WHENUNFILED of
 TYPE)
				do
 (APPLY* FN NAME TYPE FILE))
			     FILE])

(DELFROMCOM
  [LAMBDA (COM NAME TYPE)                       (* rmk: "10-JUN-82 22:34"
)                                               (* Tries to delete NAME 
						from COM)
    (PROG (TEM VAR NEW)
          (COND
	    ((SETQ TEM (fetch DELETE of (CAR COM)))
	      (AND (SETQ TEM (APPLY* TEM COM NAME TYPE))
		   (MARKASCHANGED COMSNAME (QUOTE VARS)))
	      (RETURN TEM)))
          (RETURN
	    (SELECTQ
	      (CAR COM)
	      ((DECLARE: COMS)
		(DELFROMCOMS (COND
			       [(EQ (CADR COM)
				    (QUOTE *))
				 (COND
				   ((LITATOM (CADDR COM))
				     (CADDR COM))
				   (T (RETURN]
			       (T (CDR COM)))
			     NAME TYPE))
	      [(ALISTS PROPS)
		(AND (EQ TYPE (CAR COM))
		     (COND
		       ((EQ (CADR COM)
			    (QUOTE *))
			 (COND
			   ([AND (LITATOM (SETQ VAR (CADDR COM)))
				 (SETQ TEM (ASSOC (CAR NAME)
						  (GETTOPVAL VAR)))
				 (NEQ (CDR TEM)
				      (SETQ TEM (REMOVEITEM
					  (CADR NAME)
					  (CDR TEM]
			     (SAVESET VAR TEM T (QUOTE NOPRINT))
			     T)))
		       ([AND [CDR (SETQ TEM (ASSOC (CAR NAME)
						   (CDR COM]
			     (NEQ (CDR TEM)
				  (SETQ NEW (REMOVEITEM (CADR NAME)
							(CDR TEM]
			 (/RPLACD TEM NEW)
			 (MARKASCHANGED COMSNAME (QUOTE VARS))
			 T]
	      [BLOCKS 

          (* Remove function name from blocks declarations.
	  This isn't entirely correctly, since in removing the
	  name from the block variables, it will hit homonyms 
	  in globalvars, specvars, etc.)


		      (AND (EQ TYPE (QUOTE FNS))
			   (for BLOCK in (INFILECOMTAIL COM T)
			      do (AND (MEMB NAME BLOCK)
				      (/DREMOVE NAME BLOCK))
				 (for X in BLOCK
				    when (AND (LISTP X)
					      (MEMB NAME (CDR X)))
				    do (/RPLACD X (REMOVE NAME
							  (CDR X]
	      [(PROP IFPROP)
		(SELECTQ
		  TYPE
		  [PROPS
		    (RETURN
		      (COND
			((EQ (CADR COM)
			     (CADR NAME))
			  (DELFROMCOM1 (CDR COM)
				       (CAR NAME)))
			((AND (EQMEMB (CADR NAME)
				      (CADR COM))
			      [NULL (CDR (SETQ TEM (PRETTYCOM1
					     (CDR COM]
			      (EQ (CAR TEM)
				  (CAR NAME)))
			  [/RPLACA (CDR COM)
				   (REMOVE (CADR NAME)
					   (MKLIST (CADR COM]
			  (MARKASCHANGED COMSNAME (QUOTE VARS))
			  T]
		  (COND
		    ([for PROP inside (CADR COM)
			always (EQ TYPE (GETPROP PROP (QUOTE PROPTYPE]
		      (DELFROMCOM1 (CDR COM)
				   NAME]
	      ((RECORDS INITRECORDS SYSRECORDS)
		(AND (EQ TYPE (QUOTE RECORDS))
		     (DELFROMCOM1 COM NAME)))
	      (P (AND (EQ TYPE (QUOTE EXPRESSIONS))
		      (DELFROMCOM1 COM NAME)))
	      ((VARS INITVARS)
		(AND (EQ TYPE (QUOTE VARS))
		     (DELFROMCOM1 COM NAME T)))
	      (AND (EQ TYPE (CAR COM))
		   (DELFROMCOM1 COM NAME])

(DELFROMCOM1
  [LAMBDA (COM NAME FLG)                        (* rmk: "10-JUN-82 22:44"
)

          (* FLG is passed on to REMOVEITEM, determines 
	  whether lists whose CAR is NAME will be removed)


    (PROG (TEM VAL)
          (RETURN (COND
		    ((EQ (CADR COM)
			 (QUOTE *))
		      (COND
			([AND (LITATOM (SETQ TEM (CADDR COM)))
			      (NEQ (SETQ VAL (GETTOPVAL TEM))
				   (SETQ VAL (REMOVEITEM NAME VAL FLG]
			  (SAVESET TEM VAL T (QUOTE NOPRINT))
			  T)))
		    ((NEQ (CDR COM)
			  (SETQ TEM (REMOVEITEM NAME (CDR COM)
						FLG)))
		      (/RPLACD COM TEM)
		      (MARKASCHANGED COMSNAME (QUOTE VARS))
		      T])

(DELFROMCOMS

  [LAMBDA (COMS NAME TYPE)                                  (* rmk: " 7-MAR-82 14:12")


          (* delete NAME of type TYPE from the coms COMS (either the name of some coms or a list) -

	  return T if it does anything)



    (COND
      [(LITATOM COMS)
	(PROG ((COMSNAME COMS))
	      (RETURN (AND (LISTP (SETQ COMS (GETTOPVAL COMSNAME)))
			   (DELFROMCOMS
 COMS NAME TYPE]
      (T (PROG (DONE)
	       (SETQ TYPE (GETFILEPKGTYPE
 TYPE))
	   LP  (COND
		 ((NLISTP COMS)
		   (RETURN DONE)))
	       [COND
		 ((LISTP (CAR COMS))
		   (SELECTQ (DELFROMCOM
 (CAR COMS)
					NAME TYPE)
			    (ALL (/RPLNODE2 COMS (CDR COMS))
				 (SETQQ DONE ALL)
				 (GO LP))
			    (NIL)
			    (SETQ DONE T)))
		 (T (SELECTQ (CAR COMS)
			     ((EVAL@LOADWHEN EVAL@COMPILEWHEN COPYWHEN)
			       (SETQ COMS (CDR COMS)))
			     (COND
			       ((AND (EQ TYPE (QUOTE VARS))
				     (EQ NAME (CAR COMS)))
				 (/RPLNODE2 COMS (CDR COMS))
				 (SETQ DONE T)
				 (GO LP]
	       (SETQ COMS (CDR COMS))
	       (GO LP])

(REMOVEITEM

  [LAMBDA (X LST FLG)                                       (* lmm "10-FEB-78 17:29")

                                                            (* returns a subset of LST with X deleted;

							    if FLG is set, also remove elements whose CAR is X)

    (COND
      [[OR (FMEMB X LST)
	   (AND FLG (SOME LST (FUNCTION (LAMBDA (Y)
			      (EQ (CAR (LISTP Y))
				  X]
	(SUBSET LST (FUNCTION (LAMBDA (Y)
		    (AND (NEQ Y X)
			 (OR (NOT FLG)
			     (NLISTP Y)
			     (NEQ (CAR Y)
				  X]
      (T LST])

(MOVETOFILE

  [LAMBDA (TOFILE NAME TYPE FROMFILE)                       (* rmk: "18-OCT-79 19:51")

                                                            (* To move items between files)

    (SETQ TYPE (GETFILEPKGTYPE
 TYPE))
    [COND
      ((OR (EQ TYPE (QUOTE FNS))
	   FROMFILE)                                        (* FNS definition can reside on file if LOADFNS was 

							    done. This guarantees that it is loaded.)

	(PUTDEF
 NAME TYPE (GETDEF
 NAME TYPE FROMFILE (QUOTE (NOCOPY NODWIM]
    (AND (EQ TYPE (QUOTE FNS))
	 (MARKASCHANGED
 NAME TYPE))                         (* FNS won't get dumped unless they are "changed")

    (DELFROMFILES
 NAME TYPE FROMFILE)
    (ADDTOFILE
 NAME TYPE TOFILE])
)
(MOVD? (QUOTE DELFROMFILES)
       (QUOTE DELFROMFILE))
(MOVD? (QUOTE MOVETOFILE)
       (QUOTE MOVEITEM))

(ADDTOVAR SYSPROPS
 PROPTYPE VARTYPE)

(ADDTOVAR SYSPROPS
 MACRO BYTEMACRO ALTOMACRO JMACRO VAXMACRO DMACRO 10MACRO)
(* * "functions for doing things and marking them changed and auxiliary functions")


(DEFINEQ

(SAVEPUT

  [LAMBDA (ATM PROP VAL)                                     (* lmm " 7-May-84 16:56")

                                                             (* analogous to SAVESET but also marks changed property 

							     lists; LISPXFNS are marked to change PUT and PUTPROP to 

							     SAVEPUT)

    [COND
      ((NOT (LITATOM ATM))
	(ERRORX (LIST 14 ATM]
    (PROG ((X (GETPROPLIST ATM))
	   X0 TEM OLDFLG)
      LOOP(COND
	    ((NLISTP X)
	      (COND
		((AND (NULL X)
		      X0)                                    (* typical case. property list ran out on an even parity

							     position. e.g. (A B C D))

		  (SETQ TEM (LIST PROP VAL))
		  (AND LISPXHIST (UNDOSAVE (LIST (QUOTE /PUT-1)
						 ATM TEM)
					   LISPXHIST))
		  (FRPLACD (CDR X0)
			   TEM)
		  (GO RET)))

          (* propety list was initially NIL or a non-list, or else it ended in a non-list following an even parity position,

	  e.g. (A B . C) fall through and add new property at beginning)



	      )
	    ((NLISTP (CDR X))

          (* property list runs out on an odd parity, or ends in an odd list following an odd parity, e.g. 

	  (A B C) or (A B C . D) fall through and add at beginning.)



	      )
	    [(EQ (CAR X)
		 PROP)
	      (SETQ OLDFLG (NEQ (EQUALN (CADR X)
					VAL 400)
				T))                          (* i.e. it probably changed)

	      (/RPLACA (CDR X)
		       VAL)
	      (COND
		((NOT OLDFLG)
		  (GO RET1))
		(T (OR (EQ DFNFLG T)
		       (LISPXPRINT (LIST (QUOTE new)
					 PROP
					 (QUOTE property)
					 (QUOTE for)
					 ATM)
				   T T))
		   (GO RET]
	    (T (SETQ X (CDDR (SETQ X0 X)))
	       (GO LOOP)))
          [SETQ TEM (CONS PROP (CONS VAL (GETPROPLIST ATM]
          (SETPROPLIST ATM TEM)
          (AND LISPXHIST (UNDOSAVE (LIST (QUOTE /PUT-1)
					 ATM TEM)
				   LISPXHIST))
      RET (MARKASCHANGED
 (LIST ATM PROP)
			 (QUOTE PROPS)
			 (NOT OLDFLG))
      RET1(AND ADDSPELLFLG (ADDSPELL ATM 0))
          (RETURN VAL])

(PUTPROPS

  [NLAMBDA X                                                (* lmm: " 5-FEB-77 21:33:16")

                                                            (* redefined to call SAVEPUT rather than /PUT)

    (MAP (CDR X)
	 (FUNCTION [LAMBDA (Y)
	     (SAVEPUT
 (CAR X)
		      (CAR Y)
		      (CADR Y)
		      T])
	 (FUNCTION CDDR])

(ADDTOVAR

  [NLAMBDA X                                                (* rmk: "18-FEB-82 21:49")

                                                            (* redefined to handle alists specially)

    (PROG ((VAR (CAR X))
	   [VAL (OR (AND (EQ DFNFLG (QUOTE ALLPROP))
			 (GETPROP (CAR X)
				  (QUOTE VALUE)))
		    (LISTP (GETTOPVAL (CAR X]
	   TYPE FLG)
          [COND
	    [[AND (NEQ DFNFLG (QUOTE ALLPROP))
		  (SETQ TYPE (GETPROP VAR (QUOTE VARTYPE)))
		  (SETQ TYPE (OR (LISTGET1 (LISTP TYPE)
					   (QUOTE ALIST))
				 (EQ TYPE (QUOTE ALIST]
	      [MAPC
		(CDR X)
		(FUNCTION (LAMBDA (PAIR OLDENTRY)
		    (COND
		      ((NLISTP PAIR)
			(SETQ VAL (CONS PAIR VAL))
			(SETQ FLG T))
		      ((NOT
			  (EQUAL (SETQ OLDENTRY
				   (SELECTQ
				     TYPE
				     [USERMACROS (CAR (SOME VAL
							    (FUNCTION (LAMBDA (OP)
								(AND (EQ (CAR OP)
									 (CAR PAIR))
								     (EQ (NULL (CADR OP))
									 (NULL (CADR PAIR]
				     (FASSOC (CAR PAIR)
					     VAL)))
				 PAIR))
			(OR (NULL OLDENTRY)
			    (EQ DFNFLG T)
			    (LISPXPRINT (LIST (QUOTE new)
					      VAR
					      (QUOTE entry)
					      (QUOTE for)
					      (CAR PAIR))
					T T))
			(MARKASCHANGED
 (LIST VAR (CAR PAIR))
				       (QUOTE ALISTS)
				       (NULL OLDENTRY))
			(SETQ VAL (CONS PAIR (COND
					  (OLDENTRY (/DREMOVE OLDENTRY VAL))
					  (T VAL]
	      (COND
		(FLG (SAVESET VAR VAL T (QUOTE NOPRINT)))
		(T (/SETTOPVAL VAR VAL]
	    (T                                              (* in shallow system, addtovar works on current 

							    binding.)

	       (RESETVARS [(DFNFLG (COND
				     ((EQ DFNFLG (QUOTE ALLPROP))
				       (QUOTE PROP))
				     (T DFNFLG]
		          (COND
			    ((OR VAL (CDR X))
			      (SAVESET VAR (UNION (CDR X)
						  VAL)
				       T
				       (QUOTE NOPRINT)))
			    ((EQ (QUOTE NOBIND)
				 (GETTOPVAL VAR))           (* The semantics of (ADDVARS 

							    (FOO)) are to initiilize FOO to NIL if it is NOBIND, 

							    otherwise leave it alone.)

			      (/SETTOPVAL VAR NIL]
          (RETURN VAR])

(APPENDTOVAR

  [NLAMBDA X                                                (* rmk: "18-FEB-82 21:49")

                                                            (* redefined to handle alists specially)

    (PROG ((VAR (CAR X))
	   [VAL (OR (AND (EQ DFNFLG (QUOTE ALLPROP))
			 (GETPROP (CAR X)
				  (QUOTE VALUE)))
		    (LISTP (GETTOPVAL (CAR X]
	   TYPE FLG)
          [COND
	    [[AND (NEQ DFNFLG (QUOTE ALLPROP))
		  (SETQ TYPE (GETPROP VAR (QUOTE VARTYPE)))
		  (SETQ TYPE (OR (LISTGET1 (LISTP TYPE)
					   (QUOTE ALIST))
				 (EQ TYPE (QUOTE ALIST]
	      [MAPC
		(CDR X)
		(FUNCTION (LAMBDA (PAIR OLDENTRY)
		    (COND
		      ((NLISTP PAIR)
			(SETQ VAL (CONS PAIR VAL))
			(SETQ FLG T))
		      ((NOT
			  (EQUAL (SETQ OLDENTRY
				   (SELECTQ
				     TYPE
				     [USERMACROS (CAR (SOME VAL
							    (FUNCTION (LAMBDA (OP)
								(AND (EQ (CAR OP)
									 (CAR PAIR))
								     (EQ (NULL (CADR OP))
									 (NULL (CADR PAIR]
				     (FASSOC (CAR PAIR)
					     VAL)))
				 PAIR))
			(OR (NULL OLDENTRY)
			    (EQ DFNFLG T)
			    (LISPXPRINT (LIST (QUOTE new)
					      VAR
					      (QUOTE entry)
					      (QUOTE for)
					      (CAR PAIR))
					T T))
			(MARKASCHANGED
 (LIST VAR (CAR PAIR))
				       (QUOTE ALISTS)
				       (NULL OLDENTRY))
			(SETQ VAL (APPEND (COND
					    (OLDENTRY (/DREMOVE OLDENTRY VAL))
					    (T VAL))
					  (LIST PAIR]
	      (COND
		(FLG (SAVESET VAR VAL T (QUOTE NOPRINT)))
		(T (/SETTOPVAL VAR VAL]
	    (T                                              (* in shallow system, addtovar works on current 

							    binding.)

	       (RESETVARS [(DFNFLG (COND
				     ((EQ DFNFLG (QUOTE ALLPROP))
				       (QUOTE PROP))
				     (T DFNFLG]
		          (COND
			    ((OR VAL (CDR X))
			      (SAVESET VAR (APPEND VAL (LDIFFERENCE (CDR X)
								    VAL))
				       T
				       (QUOTE NOPRINT)))
			    ((EQ (QUOTE NOBIND)
				 (GETTOPVAL VAR))           (* The semantics of (ADDVARS 

							    (FOO)) are to initiilize FOO to NIL if it is NOBIND, 

							    otherwise leave it alone.)

			      (/SETTOPVAL VAR NIL]
          (RETURN VAR])
)
(DEFINEQ

(UNMARKASCHANGED

  (LAMBDA (NAME TYPE)                                        (* JonL "24-Jul-84 19:59")

                                                             (* says to remove NAME from TYPE's changedlst, and also 

							     to remove it from any FILE properties.

							     Value is name if anything is done)

    (PROG (ANYFLG)
          (bind
 TAIL (CHANGED _(fetch
 CHANGED of
 (SETQ TYPE (GETFILEPKGTYPE
 TYPE (QUOTE TYPE)))))
	     while
 (SETQ TAIL (MEMBER NAME CHANGED))
	     do
 (/RPLACA TAIL)
		(SETQ ANYFLG T))
          (for
 F TAIL PROP TYPEDPROP in
 FILELST
	     when
 (SETQ TAIL (MEMBER NAME (CDR (SETQ TYPEDPROP (ASSOC TYPE
								      (fetch
 TOBEDUMPED
									 of
 (SETQ PROP
									      (fetch
 FILEPROP
										 of
 F))))))))
	     do
 (SETQ ANYFLG T)
		(COND
		  ((SETQ TAIL (REMOVE (CAR TAIL)
				      (CDR TYPEDPROP)))
		    (/RPLACD TYPEDPROP TAIL))
		  (T (/replace
 TOBEDUMPED of
 PROP with
 (REMOVE TYPEDPROP (fetch
 TOBEDUMPED
									    of
 PROP))))))
          (RETURN (AND ANYFLG NAME)))))

(PREEDITFN

  [LAMBDA (ATM TYPE EDITCHANGES)                            (* rmk: "18-FEB-82 21:49")

                                                            (* EDITL is advised to call this before editing 

							    something)

    (AND FILEPKGFLG (SELECTQ TYPE
			     [PROPLST [AND (OR CLISPARRAY (PROGN (CLISPTRAN (CONS)
									    (CONS))
								 CLISPARRAY))
					   (for
 X in
 (GETPROPLIST ATM)
					      do
 (OR (NLISTP X)
						     (GETHASH X CLISPARRAY)
						     (PUTHASH X (CONS (CAR X)
								      (CDR X))
							      CLISPARRAY]

          (* note that if CLISPARRAY is disabled that ALL properties of an edited prop list will get marked as changed if any 

	  destructive edit is made)



				      (RESETSAVE NIL (LIST (FUNCTION POSTEDITPROPS)
							   EDITCHANGES
							   (APPEND (GETPROPLIST ATM]
			     [VARS (COND
				     ((EQMEMB (QUOTE ALIST)
					      (GETPROP ATM (QUOTE VARTYPE)))
				       [AND (OR CLISPARRAY (PROGN (CLISPTRAN (CONS)
									     (CONS))
								  CLISPARRAY))
					    (for
 X in
 (EVALV ATM)
					       do
 (OR (NLISTP X)
						      (GETHASH X CLISPARRAY)
						      (PUTHASH X (CONS (CAR X)
								       (CDR X))
							       CLISPARRAY]
				       (RESETSAVE NIL (LIST (FUNCTION POSTEDITALISTS)
							    EDITCHANGES
							    (for
 X in
 (EVALV ATM)
							       collect
 (CAR X]
			     NIL])

(POSTEDITPROPS

  [LAMBDA (EDITCHANGES OLDPROPS)                            (* rmk: "18-FEB-82 21:50")

                                                            (* was RESETSAVE'd from PREEDITFN)

    (PROG (OV FOUNDCHANGE)
          (OR FILEPKGFLG (RETURN))
          (COND
	    ((CADR EDITCHANGES)
	      (for
 NEWPROP on
 (GETPROPLIST (CAR EDITCHANGES)) by
 (CDDR NEWPROP)
		 when
 (for
 OLDPROP on
 OLDPROPS by
 (CDDR OLDPROP)
			 do
 (COND
			      ((EQ (CAR OLDPROP)
				   (CAR NEWPROP))           (* Found the property)

				[AND (EQ (CADR OLDPROP)
					 (CADR NEWPROP))
				     (COND
				       ((NLISTP (CADR OLDPROP))
                                                            (* value is same)

					 (RETURN))
				       ((AND CLISPARRAY (SETQ OV (GETHASH (CADR NEWPROP)
									  CLISPARRAY))
					     (EQ (CAADR NEWPROP)
						 (CAR OV))
					     (EQ (CDADR NEWPROP)
						 (CDR OV)))
					 (PUTHASH (CADR NEWPROP)
						  NIL CLISPARRAY)
                                                            (* value has been edited (CLISPARRAY translation went 

							    away))

					 (RETURN]
				(RETURN T)))
			 finally
                            (* didn't find the property)

				 (RETURN T))
		 do
 (MARKASCHANGED
 (LIST (CAR EDITCHANGES)
					 (CAR NEWPROP))
				   (QUOTE PROPS)
				   NIL)
		    (SETQ FOUNDCHANGE T))
	      (AND FOUNDCHANGE (RPLACA (CDR EDITCHANGES)
				       NIL])

(POSTEDITALISTS

  [LAMBDA (EDITCHANGES OLDTOKENS)                           (* rmk: " 4-JAN-82 10:14")

    (PROG [OV FOUNDCHANGE (NEWENTRIES (GETTOPVAL (CAR EDITCHANGES]
                                                            (* called after an ALIST has been edited)

          (OR FILEPKGFLG (RETURN))
          (COND
	    ((CADR EDITCHANGES)
	      (for
 X in
 OLDTOKENS when
 (NOT (FASSOC X NEWENTRIES)) do
 (MARKASCHANGED

									(LIST (CAR EDITCHANGES)
									      X)
									(QUOTE ALISTS)
									NIL)
								      (SETQ FOUNDCHANGE T))
	      [for
 NEWENTRY in
 NEWENTRIES do
 (COND
					       ([AND (LISTP NEWENTRY)
						     (NOT (AND CLISPARRAY (SETQ OV (GETHASH NEWENTRY 
										       CLISPARRAY))
							       (EQ (CAR NEWENTRY)
								   (CAR OV))
							       (EQ (CDR NEWENTRY)
								   (CDR OV]
						 (PUTHASH NEWENTRY NIL CLISPARRAY)
						 (MARKASCHANGED
 (LIST (CAR EDITCHANGES)
								      (CAR NEWENTRY))
								(QUOTE ALISTS)
								NIL)
						 (SETQ FOUNDCHANGE T]
	      (AND FOUNDCHANGE (RPLACA (CDR EDITCHANGES)
				       NIL])
)

(ADDTOVAR LISPXFNS
 (PUT . SAVEPUT)
		   (PUTPROP . SAVEPUT))
(* * "sub-functions for file package commands & types")


(DEFINEQ

(ALISTS.WHENCHANGED

  [LAMBDA (NAME TYPE NEWFLG)                                (* lmm "16-OCT-78 20:02")

                                                            (* called by MARKASCHANGED when an ALIST entry has 

							    changed)

    (PROG [(VARTYPE (GETPROP (CAR NAME)
			     (QUOTE VARTYPE]
          (AND (LISTP VARTYPE)
	       (EQ (CAR VARTYPE)
		   (QUOTE ALIST))
	       (RETFROM (QUOTE MARKASCHANGED)
			(MARKASCHANGED
 (CADR NAME)
				       (CADR VARTYPE)
				       NEWFLG])

(CLEARCLISPARRAY

  [LAMBDA (NAME TYPE REASON)
    (DECLARE (SPECVARS NAME TYPE REASON))                    (* lmm "14-Aug-84 15:03")

    (AND CLISPARRAY (MAPHASH CLISPARRAY (COND
			       [(EQ TYPE (QUOTE I.S.OPRS))
				 (FUNCTION (LAMBDA (TRAN FORM)
				     (AND (MEMB NAME FORM)
					  (PUTHASH FORM NIL CLISPARRAY]
			       (T                            (* MACRO CHANGED)

				  (FUNCTION (LAMBDA (TRAN FORM)
				      (COND
					((OR (EQ NAME (CAR FORM))
					     (EQ (CAR (GETPROP (CAR FORM)
							       (QUOTE CLISPWORD)))
						 (QUOTE CHANGETRAN)))
					  (PUTHASH FORM NIL CLISPARRAY])

(EXPRESSIONS.WHENCHANGED

  [LAMBDA (EXPR)                                            (* rmk: "19-FEB-83 22:28")

    (SELECTQ (CAR EXPR)
	     ((SETQ SETQQ)
	       (UNMARKASCHANGED
 (CADR EXPR)
				(QUOTE VARS)))
	     ((PROGN PROG)
	       (for
 X in
 (CDR EXPR) do
 (EXPRESSIONS.WHENCHANGED
 X)))
	     [ADVISE (AND (EQ (CAADR EXPR)
			      (QUOTE QUOTE))
			  (for
 FN in
 (PACK-IN- (CADR (CADR EXPR))) do
 (UNMARKASCHANGED
 FN
										       (QUOTE ADVICE]
	     NIL])

(MAKEALISTCOMS

  [NLAMBDA X                                                 (* rmk: "14-OCT-83 13:34")

                                                             (* make command to dump prettydefmacros)

    (LIST (CONS (QUOTE ADDVARS)
		(for
 PR in
 X join
 (for
 ALISTNAME inside
 (CAR PR)
				     collect

				      (CONS ALISTNAME
					    (for
 ATNAME inside
 (CDR PR) bind
 ENTRY
					       when
 (SETQ ENTRY
						      (OR (SASSOC ATNAME (GETTOPVAL ALISTNAME))
							  (PROGN (LISPXPRINT (LIST (QUOTE no)
										   ATNAME
										   (QUOTE entry)
										   (QUOTE on)
										   ALISTNAME)
									     T T)
								 NIL)))
					       collect
 ENTRY])

(MAKEFILESCOMS

  (NLAMBDA FILES                                             (* JonL "12-FEB-83 19:02")

                                                             (* This scans the command just to warn the user about 

							     any errors. Must match up with the big SELECTQ in 

							     FILESLOAD NIL)

    (for
 FILE in
 FILES
       do
 (OR (LITATOM FILE)
	      (while
 (LISTP FILE)
		 do
 (SELECTQ (CAR (OR (LISTP FILE)
				      (RETURN)))
			     ((LOADCOMP LOADFROM))
			     (FROM (pop
 FILE)
				   (if
 (OR (EQ (CAR FILE)
					       (QUOTE VALUEOF))
					   (if
 (AND (EQ (CAR FILE)
							(QUOTE VALUE))
						    (EQ (CADR FILE)
							(QUOTE OF)))
					       then
 (pop
 FILE)))
				       then
 (pop
 FILE)))
			     ((COMPILED LOAD EXTENSION EXT SOURCE SYMBOLIC IMPORT NOERROR))
			     (OR (FMEMB (CAR FILE)
					LOADOPTIONS)
				 (PRINT (CONS (CAR FILE)
					      (QUOTE (-- unrecognized FILES option)))
					T)))
		    (pop
 FILE))))
    (CONS (QUOTE FILESLOAD)
	  FILES)))

(MAKELISPXMACROSCOMS

  [NLAMBDA X                                                (* lmm " 5-SEP-78 23:15")

    (PROG (TEM TEM2)
          (RETURN (CONS [CONS (QUOTE ALISTS)
			      (SETQ TEM (NCONC (AND [SETQ TEM (SUBSET X (FUNCTION (LAMBDA (Z)
									  (FASSOC Z 
									       LISPXHISTORYMACROS]
						    (LIST (CONS (QUOTE LISPXHISTORYMACROS)
								TEM)))
					       (AND [SETQ TEM (SUBSET X (FUNCTION (LAMBDA (Z)
									  (FASSOC Z LISPXMACROS]
						    (LIST (CONS (QUOTE LISPXMACROS)
								TEM]
			(SETQ TEM2 (NCONC [AND [SETQ TEM2 (SUBSET X (FUNCTION (LAMBDA (Z)
								      (FMEMB Z LISPXCOMS]
					       (LIST (LIST (QUOTE ADDVARS)
							   (CONS (QUOTE LISPXCOMS)
								 TEM2]
					  (AND [SETQ TEM2 (SUBSET X (FUNCTION (LAMBDA (Z)
								      (FMEMB Z HISTORYCOMS]
					       (LIST (LIST (QUOTE ADDVARS)
							   (CONS (QUOTE HISTORYCOMS)
								 TEM2])

(MAKEPROPSCOMS

  [NLAMBDA X                                                (* lmm "26-FEB-78 17:10")

                                                            (* make command to dump PROPS)

    (for
 PAIR in
 X collect
 (CONS (QUOTE PROP)
				 (CONS (COND
					 ((AND (LISTP (CDR PAIR))
					       (NULL (CDDR PAIR)))
					   (CADR PAIR))
					 (T (CDR PAIR)))
				       (OR (LISTP (CAR PAIR))
					   (LIST (CAR PAIR])

(MAKEUSERMACROSCOMS

  [NLAMBDA X                                                (* rmk: " 3-JAN-82 23:20")

    (PROG (TEM)
          [COND
	    [X (for
 Y in
 X do
 (OR (FASSOC Y USERMACROS)
				  (FASSOC Y EDITMACROS)
				  (LISPXPRINT (CONS Y (QUOTE (-- no entry on USERMACROS)))
					      T T]
	    (T (SETQ X (INTERSECTION (SETQ X (MAPCAR USERMACROS (QUOTE CAR)))
				     X]
          (RETURN (LIST (CONS (QUOTE ADDVARS)
			      (NCONC (for
 VAR in
 (QUOTE (USERMACROS EDITMACROS))
					when
 (SETQ TEM (for
 Y in
 (GETTOPVAL VAR)
							  when
 (FMEMB (CAR Y)
								      X)
							  collect
 Y))
					collect
 (CONS VAR TEM))
				     (for
 LST in
 (QUOTE (EDITCOMSA EDITCOMSL COMPACTHISTORYCOMS 
								   DONTSAVEHISTORYCOMS))
					when
 [SETQ TEM (SUBSET (GETTOPVAL LST)
							       (FUNCTION (LAMBDA (Y)
								   (OR (FMEMB Y X)
								       (AND (LISTP Y)
									    (FMEMB (CAR Y)
										   X]
					collect
 (CONS LST TEM])

(PROPS.WHENCHANGED

  [LAMBDA (NAME TYPE NEWFLG)                                (* lmm " 7-SEP-78 22:08")

    (PROG [(PROPTYPE (GETPROP (CADR NAME)
			      (QUOTE PROPTYPE]
          (COND
	    [PROPTYPE (RETFROM (QUOTE MARKASCHANGED)
			       (COND
				 ((NEQ PROPTYPE (QUOTE IGNORE))
				   (MARKASCHANGED
 (CAR NAME)
						  PROPTYPE NEWFLG]
	    (T (SELECTQ (CADR NAME)
			(CLISPWORD (CLEARCLISPARRAY
 (CAR NAME)))
			NIL])
)

(ADDTOVAR MACROPROPS
 MACRO BYTEMACRO ALTOMACRO JMACRO VAXMACRO DMACRO 10MACRO)

(ADDTOVAR SYSPROPS
 PROPTYPE)

(PUTPROPS I.S.OPR PROPTYPE
 I.S.OPRS)

(PUTPROPS SUBR PROPTYPE
 IGNORE)

(PUTPROPS LIST PROPTYPE
 IGNORE)

(PUTPROPS CODE PROPTYPE
 IGNORE)

(PUTPROPS BRKINFO PROPTYPE
 IGNORE)

(PUTPROPS BROKEN-IN PROPTYPE
 IGNORE)

(PUTPROPS BROKEN PROPTYPE
 IGNORE)

(PUTPROPS FILEDATES PROPTYPE
 IGNORE)

(PUTPROPS FILE PROPTYPE
 IGNORE)

(PUTPROPS FILEMAP PROPTYPE
 IGNORE)

(PUTPROPS EXPR PROPTYPE
 FNS)

(PUTPROPS ADVICE PROPTYPE
 ADVICE)

(PUTPROPS READVICE PROPTYPE
 ADVICE)

(PUTPROPS ADVISED PROPTYPE
 ADVICE)

(PUTPROPS VALUE PROPTYPE
 VARS)

(PUTPROPS BAKTRACELST VARTYPE
 ALIST)

(PUTPROPS BREAKMACROS VARTYPE
 ALIST)

(PUTPROPS COMPILETYPELST VARTYPE
 ALIST)

(PUTPROPS EDITMACROS VARTYPE
 (ALIST USERMACROS))

(PUTPROPS ERRORTYPELST VARTYPE
 ALIST)

(PUTPROPS FONTDEFS VARTYPE
 ALIST)

(PUTPROPS LISPXHISTORYMACROS VARTYPE
 (ALIST LISPXMACROS))

(PUTPROPS LISPXMACROS VARTYPE
 (ALIST LISPXMACROS))

(PUTPROPS PRETTYDEFMACROS VARTYPE
 (ALIST FILEPKGCOMS))

(PUTPROPS PRETTYEQUIVLST VARTYPE
 ALIST)

(PUTPROPS PRETTYPRINTMACROS VARTYPE
 ALIST)

(PUTPROPS PRETTYPRINTYPEMACROS VARTYPE
 ALIST)

(PUTPROPS USERMACROS VARTYPE
 (ALIST USERMACROS))

(PUTPROPS MACRO PROPTYPE
 MACROS)

(PUTPROPS BYTEMACRO PROPTYPE
 MACROS)

(PUTPROPS ALTOMACRO PROPTYPE
 MACROS)

(PUTPROPS JMACRO PROPTYPE
 MACROS)

(PUTPROPS VAXMACRO PROPTYPE
 MACROS)

(PUTPROPS DMACRO PROPTYPE
 MACROS)

(PUTPROPS 10MACRO PROPTYPE
 MACROS)
(* * "Define the commands below AFTER the various properties have been established.")



(ADDTOVAR USERMACROS
 (M (X . Y)
			(E (MARKASCHANGED (COND ((LISTP (QUOTE X))
						 (CAR (QUOTE X)))
						(T (QUOTE X)))
					  (QUOTE USERMACROS))
			   T)
			(ORIGINAL (M X . Y))))

(ADDTOVAR EDITMACROS
 (M (X . Y)
			(E (MARKASCHANGED (COND ((LISTP (QUOTE X))
						 (CAR (QUOTE X)))
						(T (QUOTE X)))
					  (QUOTE USERMACROS))
			   T)
			(ORIGINAL (M X . Y))))

(ADDTOVAR EDITCOMSL
 M)
(* * GETDEF "functions")


(DEFINEQ

(RENAME

  (LAMBDA (OLD
 NEW TYPES FILES METHOD)                       (* JonL "24-Jul-84 20:01")

    (PROG ((TYPES (GETFILEPKGTYPE
 TYPES (QUOTE TYPE)
				  NIL OLD)))

          (* special kludge: change the callers BEFORE if we are changing a field; this is so the CHANGECALLERS won't get an

	  UNABLE TO DWIMIFY message)



          (for
 TYPE inside
 TYPES when
 (NEQ TYPE (QUOTE FIELDS)) do
 (COPYDEF
 OLD NEW TYPE NIL
									    (COND
									      ((EQ TYPE (QUOTE VARS))
										(QUOTE NOERROR)))))
          (CHANGECALLERS
 OLD NEW TYPES FILES METHOD)
          (for
 TYPE inside
 TYPES do
 (COND
				      ((AND (EQ TYPE (QUOTE FIELDS))
					    (HASDEF
 OLD (QUOTE FIELDS)))

          (* The HASDEF test is because the rename might already have been done in EDITFROMFILE in the CHANGECALLERS, if it 

	  found a record with the field on a file. Otherwise, COPYDEF essentially will just do the necessary substitution in

	  the existing record declarations, given that definitions for FIELDS are mutually exclusive.)



					(COPYDEF
 OLD NEW (QUOTE FIELDS)))
				      (T (DELDEF
 OLD TYPE))))
          (RETURN NEW))))

(CHANGECALLERS

  (LAMBDA (OLD
 NEW TYPES FILES METHOD)                       (* JonL "24-Jul-84 20:03")

    (PROG (REL TEM EDITCOMS (TYPES (GETFILEPKGTYPE
 (OR TYPES (QUOTE (FNS MACROS TEMPLATES)))))
	       FNS)
          (SETQ EDITCOMS
	    (LIST (COND
		    ((SETQ TEM (TYPESOF
 OLD NIL TYPES))
		      (printout
 T "Warning --" OLD " is also used as " TEM T)

          (* This creates a "command" that searches like EXAM, but interrogates the user about whether to do the R.

	  Y means do it, No means skip, anything else goes into TTY.)



		      (SUBPAIR (QUOTE (OLD NEW))
			       (LIST OLD NEW)
			       (QUOTE (BIND (LPQ (F OLD N)
						 (MARK #1)
						 (ORR (1 !0 P)
						      NIL)
						 (MARK #2)
						 (COMS (SELECTQ (ASKUSER NIL NIL "   Replace ? "
									 (QUOTE ((Y "Yes
")
										  (N "No
")
										  (%
 "")
										  (%  "")
										  (%
 "")
										  (& "")))
									 NIL NIL (QUOTE (NOECHOFLG
											  T)))
								(Y (QUOTE (R1 OLD NEW)))
								(N NIL)
								(QUOTE TTY:)))
						 (MARK #3)
						 (IF
 (EQ (## (\ #3))
							 (## (\ #2)))
						     ((\ #1))
						     NIL))))))
		    (T (LIST (QUOTE R)
			     OLD NEW)))))
          (SELECTQ (OR METHOD (COND
			 ((AND (EQ DEFAULTRENAMEMETHOD (QUOTE MASTERSCOPE))
			       MSDATABASELST)
			   (QUOTE MASTERSCOPE))
			 (T (QUOTE EDITCALLERS))))
		   (MASTERSCOPE (for
 TYPE inside
 TYPES
				   do
 (COND
					((SETQ TEM (SELECTQ TYPE
							    (FNS (QUOTE CALL))
							    (MACROS (QUOTE (CALL DIRECTLY)))
							    (VARS (QUOTE (USE OR
 BIND)))
							    ((RECORDS FIELDS I.S.OPRS TYPES)
							      (LIST (QUOTE USE)
								    (QUOTE AS)
								    TYPE))
							    NIL))
					  (COND
					    (REL (SETQ REL (LIST TEM (QUOTE OR)
								 REL)))
					    (T (SETQ REL TEM))))))
				(COND
				  (REL (MAPC (SETQ FNS (NCONC (COND
								((NULL FILES)
								  (UPDATEFILES
)
								  (FILEPKGCHANGES
 (QUOTE FNS))))
							      (for
 FILE inside
 (OR FILES FILELST)
								 join
 (FILEFNSLST
 FILE))))
					     (FUNCTION UPDATEFN))
				       (SETQ FNS (INTERSECTION (GETRELATION OLD (SETQ REL
									      (PARSERELATION REL))
									    T)
							       FNS)))))
		   (EDITCALLERS
 (SETQ FILES (for
 X inside
 (OR FILES FILELST)
					       when
 (SETQ TEM (EDITCALLERS
 OLD X T))
					       collect
 (PROGN (SETQ FNS (NCONC FNS (CDR TEM)))
							      X))))
		   (ERROR "UNRECOGNIZED RENAME METHOD" METHOD))
          (AND (EQMEMB (QUOTE FNS)
		       TYPES)
	       (FMEMB OLD FNS)
	       (SETQ FNS (REMOVE OLD FNS)))
          (EDITFROMFILE
 FNS FILES OLD EDITCOMS)
          (for
 TYPE inside
 TYPES
	     do
 (for
 FILE in
 (WHEREIS
 OLD TYPE FILES)
		   do
 (AND (ADDTOFILE
 NEW TYPE FILE)
			   (DELFROMFILES
 OLD TYPE FILE)
			   (printout
 T OLD " changed to " NEW " on " FILE)))
		(COND
		  ((SETQ TEM (WHEREIS
 OLD TYPE FILES))
		    (printout
 T "Couldn't change " OLD " to " NEW " as " TYPE " on " TEM))))
          (COND
	    (REL (UPDATECHANGED)
		 (COND
		   ((AND (SETQ TEM (GETRELATION OLD REL T))
			 (WHEREIS
 TEM (QUOTE FNS)
				  FILES))
		     (printout
 T "Couldn't find where " OLD " is referenced in " TEM T))))))))
)
(DEFINEQ

(SHOWDEF

  [LAMBDA (NAME TYPE FILE)                                   (* lmm " 3-Jan-85 17:32")

                                                             (* prettyprint NAME as it would be dumped as a TYPE)

    (
RESETLST
 (
PROG
 (ORIGFLG FNSLST FL PRETTYCOMSLST)
		    (DECLARE
 (
SPECVARS
 . T))
		    [
AND
 FILE (
NEQ
 FILE (
OUTPUT
))
			 (if
 (
SETQ
 FL (
OPENP
 FILE (
QUOTE
 OUTPUT)))
			     then
 (
RESETSAVE
 (
OUTPUT
 FL))
			   else
 (
OUTFILE
 FILE)
				(
RESETSAVE
 NIL (
LIST
 (
FUNCTION
 CLOSEF?)
						     (
OUTPUT
]
		    (
PRETTYCOM
 (MAKENEWCOM
 NAME TYPE])

(COPYDEF

  [LAMBDA (OLD NEW TYPE SOURCE OPTIONS)                      (* lmm "14-Aug-84 18:38")

                                                             (* like MOVD, but takes a type.)

    (PROG (TEM DEF)
          (SETQ TYPE (GETFILEPKGTYPE
 TYPE (QUOTE TYPE)))
          [SETQ DEF (GETDEF
 OLD TYPE SOURCE (COND
			      ((EQ OPTIONS (QUOTE NOCOPY))
				NIL)
			      (T (REMOVE (QUOTE NOCOPY)
					 (MKLIST OPTIONS]    (* The default is for GETDEF to return a COPY.

							     Make sure that NOCOPY isn't in options though.)

          (SELECTQ TYPE
		   (VARS)
		   [FILES (for X in (CAR DEF)
			       do                            (* change all the listnames which are of form 

							     filenameTYPE)

			       (SELECTQ (CAR X)
					((PROP IFPROP)
					  (SETQ X (CDR X)))
					NIL)
			       (COND
				 ((EQ (CADR X)
				      (QUOTE *))
				   (SETQ X (CDDR X))
				   (COND
				     ((AND (LITATOM (CAR X))
					   (SETQ TEM (STRPOS OLD (CAR X)
							     1 NIL T T)))
				       (SAVESET (SETQ TEM (PACK* NEW (SUBATOM (CAR X)
									      TEM -1)))
						(COPY (GETTOPVAL (CAR X)))
						T)
				       (FRPLACA X TEM]
		   ((PROPS ALISTS)
		     (OR (EQ (CAR NEW)
			     (CAR OLD))
			 (DSUBST (CAR NEW)
				 (CAR OLD)
				 DEF))
		     (OR (EQ (CADR NEW)
			     (CADR OLD))
			 (DSUBST (CADR NEW)
				 (CADR OLD)
				 DEF)))
		   (DSUBST NEW OLD DEF))
          (PUTDEF
 NEW TYPE DEF)
          (RETURN NEW])

(GETDEF

  [LAMBDA (NAME TYPE SOURCE OPTIONS)                         (* rmk: "13-JUL-83 02:58")


          (* returns the definition of NAME as a TYPE from SOURCE; cause ERROR if not found unless OPTIONS is NOERROR -

	  usually returns a copy unless OPTIONS is NOCOPY in which case it tries not to return a copy -

	  FLG=NOCOPY is currently only used from SAVEDEF where SOURCE is always 0 -

	  If options is or contains a string, returns that string instead of causing error if no def found.

	  The caller can figure out what happened, even for types for which NIL/NOBIND might have defs.)



    (PROG (DEF TEM NODEF (NOCOPY (EQMEMB (QUOTE NOCOPY)
					 OPTIONS)))
          (DECLARE
 (SPECVARS NODEF NOCOPY))
          (SELECTQ OPTIONS
		   (0 (SETQQ OPTIONS (NOERROR NODWIM))
		      (SETQ NOCOPY T))
		   (1 (SETQQ OPTIONS (NOERROR NODWIM FAST ARGLIST))
		      (SETQ NOCOPY T))
		   (T (SETQQ OPTIONS SPELL))
		   NIL)
          (SETQ TYPE (GETFILEPKGTYPE
 TYPE (QUOTE TYPE)))
          (SELECTQ SOURCE
		   (0 (SETQQ SOURCE CURRENT))
		   (T (SETQQ SOURCE SAVED))
		   (NIL (SETQQ SOURCE ?))
		   NIL)
          [SELECTQ SOURCE
		   (CURRENT (SETQ DEF (GETDEFCURRENT
 NAME TYPE OPTIONS)))
		   [? (SETQ DEF (GETDEFCURRENT
 NAME TYPE (QUOTE NOERROR)))
		      (COND
			(NODEF (SETQ NODEF NIL)
			       (SETQ DEF (GETDEFSAVED
 NAME TYPE (QUOTE NOERROR)))
			       (COND
				 (NODEF (SETQ NODEF NIL)
					(SETQ DEF (GETDEFFROMFILE
 NAME TYPE (QUOTE FILE)
								  OPTIONS]
		   (SAVED (SETQ DEF (GETDEFSAVED
 NAME TYPE OPTIONS)))
		   (COND
		     ((AND (LISTP SOURCE)
			   (EQ (CAR SOURCE)
			       (QUOTE =)))
		       (SETQ DEF (CDR SOURCE)))
		     (T (SETQ DEF (GETDEFFROMFILE
 NAME TYPE SOURCE OPTIONS))
			(SETQ NOCOPY T]
          (OR NOCOPY (SETQ DEF (COPY DEF)))
          (COND
	    ((AND (EQ TYPE (QUOTE FNS))
		  (NOT (EQMEMB (QUOTE NODWIM)
			       OPTIONS)))
	      (DWIMDEF
 DEF NAME SOURCE)))
          (RETURN DEF])

(GETDEFCOM

  [LAMBDA (X)                                               (* rmk: " 8-FEB-81 21:49")


          (* In the case where GETDEF doesn't know how to get the definition of something, it resorts to asking the file 

	  package to print it out to a file and then reading the file back in. Actually, though, that is a two stage process 

	  where the "command" to print out the datum is first macro expanded and then executed. -

	  In some cases, you can tell what would be printed without printing it by looking at the prettydef-macro expansion.

	  That is what GETDEFCOM does: it takes a list of prettydef commands and returns what Would be printed by those 

	  commands (or NIL if it is "too hard" to figure out.) -

	  A few of the commands are special-cased inside GETDEFCOM0 because they occur frequently or are simple.)



    (for
 Y in
 X join
 (GETDEFCOM0
 Y])

(GETDEFCOM0

  [LAMBDA (COM)                                             (* wt: " 7-FEB-79 23:28")

    (PROG (TEM)
          (RETURN (COND
		    ((SETQ TEM (fetch
 MACRO of
 (CAR COM)))

          (* COND ((fetch CONTENTS of (CAR COM)) (* if it has a CONTENTS function, generally means it is not safe to evaluate)

	  (RETFROM (QUOTE GETDEFCOM))))



		      (for
 Y in
 (SUBPAIR (CAR TEM)
					 (PRETTYCOM1 COM)
					 (CDR TEM))
			 join
 (GETDEFCOM0
 Y)))
		    (T (SELECTQ (CAR COM)
				(COMS (for
 X in
 (PRETTYCOM1 COM) join
 (GETDEFCOM0
 X)))
				(ADDVARS (for
 Y in
 (PRETTYCOM1 COM) collect
 (CONS (QUOTE ADDTOVAR)
										  Y)))
				(APPENDVARS (for
 Y in
 (PRETTYCOM1 COM) collect
 (CONS (QUOTE 
										      APPENDTOVAR)
										     Y)))
				(P (APPEND (PRETTYCOM1 COM)))
				(RETFROM (QUOTE GETDEFCOM])

(GETDEFCURRENT

  [LAMBDA (NAME TYPE OPTIONS)                                (* rrb "22-Mar-84 11:37")

                                                             (* Gets the current definition--source=0)

    (DECLARE
 (USEDFREE NOCOPY))
    (PROG (DEF)
          (RETURN
	    (COND
	      ((AND (SETQ DEF (fetch
 GETDEF of
 TYPE))
		    (NEQ DEF T))

          (* We assign T to types whose GETDEF is normally handled in the SELECTQ below but whose MACRO is to be defaulted 

	  to the PUTDEF/GETDEF in PRETTYCOM.)



		(OR (APPLY* DEF NAME TYPE OPTIONS)
		    (GETDEFERR
 NAME TYPE OPTIONS)))
	      (T (SELECTQ
		   TYPE
		   (FNS (OR (EXPRP (SETQ DEF (VIRGINFN NAME)))
			    (RETURN (GETDEFERR
 NAME TYPE OPTIONS)))
			DEF)
		   (VARS (COND
			   ((EQ (SETQ DEF (GETTOPVAL NAME))
				(QUOTE NOBIND))
			     (GETDEFERR
 NAME TYPE OPTIONS))
			   (T DEF)))
		   [RECORDS                                  (* always copy because of consequences of not doing so)

			    (COND
			      ((SETQ DEF (RECLOOK NAME))
				(SETQ NOCOPY T)              (* Don't copy twice)

				(SETQ DEF (COPY DEF)))
			      (T (GETDEFERR
 NAME TYPE OPTIONS]
		   [FILES                                    (* what is the "definition" of a file? -- I guess the 

							     COMS which say what it contains)

			  (UPDATEFILES
)
			  (PROG (COMPLETENAME)
			        (RETURN (LIST (OR [AND (SETQ COMPLETENAME (GETFILEDEF
 NAME))
						       (LISTP (GETTOPVAL (FILECOMS
 COMPLETENAME]
						  (RETURN (GETDEFERR
 NAME TYPE OPTIONS)))
					      (fetch
 TOBEDUMPED of
 (fetch
 FILEPROP of
 COMPLETENAME))
					      (LISTP (fetch
 FILEDATES of
 COMPLETENAME]
		   [FIELDS (COND
			     ((SETQ DEF (FIELDLOOK NAME))
			       (SETQ NOCOPY T)
			       (MKPROGN (COPY DEF)))
			     (T (GETDEFERR
 NAME TYPE OPTIONS]
		   [TEMPLATES (LIST (QUOTE SETTEMPLATE)
				    (KWOTE NAME)
				    (KWOTE (OR (GETTEMPLATE NAME)
					       (RETURN (GETDEFERR
 NAME TYPE OPTIONS]
		   [MACROS (CONS (QUOTE PUTPROPS)
				 (CONS NAME (OR (for
 X on
 (GETPROPLIST NAME) by
 (CDDR X)
						   when
 (FMEMB (CAR X)
							       MACROPROPS)
						   join
 (LIST (CAR X)
							      (CADR X)))
						(RETURN (GETDEFERR
 NAME TYPE OPTIONS]
		   (ADVISE (OR (GETPROP NAME (QUOTE ADVICE))
			       (CDR (GETPROP NAME (QUOTE READVICE)))
			       (GETDEFERR
 NAME TYPE OPTIONS)))
		   (EXPRESSIONS NAME)
		   [PROPS (LIST (QUOTE PUTPROPS)
				(CAR NAME)
				(CADR NAME)
				(CADR (OR (SOME (GETPROPLIST (CAR NAME))
						[FUNCTION (LAMBDA (X)
						    (EQ X (CADR NAME]
						(FUNCTION CDDR))
					  (RETURN (GETDEFERR
 NAME TYPE OPTIONS]
		   [FILEPKGCOMS (PROG ((COM (FILEPKGCOM
 NAME))
				       (TYP (FILEPKGTYPE
 NAME)))
				      (RETURN (COND
						((AND COM TYP)
						  (LIST (CONS (QUOTE COM)
							      COM)
							(CONS (QUOTE TYPE)
							      TYP)))
						(COM (LIST (CONS (QUOTE COM)
								 COM)))
						(TYP (LIST (CONS (QUOTE TYPE)
								 TYP]
		   [FILEVARS (COND
			       ((AND (LISTP (SETQ DEF (GETTOPVAL NAME)))
				     (WHEREIS
 NAME (QUOTE FILEVARS)))
				 DEF)
			       (T (GETDEFERR
 NAME TYPE OPTIONS]
		   (PROG [FILE (COMS (LIST (MAKENEWCOM
 NAME TYPE]
		         [COND
			   ((NOT (SETQ DEF (GETDEFCOM
 COMS)))
			     (RESETLST (RESETSAVE PRETTYFLG)
				       (RESETSAVE FONTCHANGEFLG)
				       (RESETSAVE BUILDMAPFLG)
				       [RESETSAVE (PRETTYDEF NIL (SETQ FILE
							       (OPENFILE (SELECTQ
									   (SYSTEMTYPE)
									   (D (QUOTE 
									    {CORE}FILEPKG.SCRATCH))
									   (QUOTE FILEPKG.SCRATCH;T))
									 (QUOTE OUTPUT)))
							     COMS)
						  (QUOTE (PROGN (CLOSEF? OLDVALUE)
								(DELFILE OLDVALUE]
				       (CLOSEF? FILE)
				       [SETQ DEF
					 (for
 X in
 (READFILE FILE)
					    join
 (SELECTQ (CAR X)
							  ((PRETTYCOMPRINT FILEMAP *)
							    NIL)
							  (DECLARE:
							    (for
 Y on
 (CDR X)
							       unless
 (SELECTQ (CAR Y)
									       ((COPYWHEN 
										    EVAL@LOADWHEN 
										 EVAL@COMPILEWHEN)
										 (RETURN
										   (LIST Y)))
									       (FMEMB (CAR Y)
										      DECLARETAGSLST))
							       collect
 (CAR Y)))
							  (PROGN (CDR X))
							  (LIST X]
				       (SETQ NOCOPY T))
			     (OR DEF (RETURN (GETDEFERR
 NAME TYPE OPTIONS]
		         (RETURN (MKPROGN DEF])

(GETDEFERR

  [LAMBDA (NAME TYPE OPTIONS MSG)                            (* rmk: "13-JUL-83 03:01")

    (DECLARE
 (USEDFREE NODEF))                               (* Message non-null if looking for saved or filed 

							     definition.)

    (PROG (TEM)
          (RETURN (COND
		    ((AND (EQMEMB (QUOTE NOERROR)
				  OPTIONS)
			  (NOT (EQMEMB (QUOTE HASDEF)
				       OPTIONS)))            (* We want to do the string search in the HASDEF case)

		      (SETQ NODEF T)                         (* Return the null definition--NIL or NOBIND)

		      (AND (EQ TYPE (QUOTE VARS))
			   (QUOTE NOBIND)))
		    [(AND (NULL MSG)
			  (EQMEMB (QUOTE SPELL)
				  OPTIONS)
			  (SETQ TEM (HASDEF
 NAME TYPE NIL (OR (LISTGET1 (LISTP OPTIONS)
									(QUOTE SPELL))
							      T)))
			  (NEQ TEM NAME))
		      (RETFROM (QUOTE GETDEF)
			       (GETDEF
 TEM TYPE (QUOTE ?)
				       (CONS (QUOTE NOERROR)
					     (MKLIST OPTIONS]
		    (T (for
 O inside
 OPTIONS when
 (STRINGP O) do
 (RETFROM (QUOTE GETDEF)
									  O)
			  finally
 (ERROR NAME (CONS TYPE (QUOTE (definition not found)))
					 T])

(GETDEFFROMFILE

  [LAMBDA (NAME TYPE SOURCE OPTIONS)                        (* rmk: " 3-AUG-83 22:07")

                                                            (* Tries to get definition from source file.

							    If successful, returns the definition.

							    Otherwise returns NIL or NOBIND if OPTIONS contains 

							    NOERROR.)

    (DECLARE
 (SPECVARS NAME)
	     (USEDFREE NODEF))
    (RESETVARS (NOT-FOUNDTAG)
	       (RETURN
		 (for
 FILE DEF TEM TEM2 inside
 (COND
						 ((EQ SOURCE (QUOTE FILE))
						   (WHEREIS
 NAME TYPE T))
						 (T SOURCE))
		    when

		     [AND
		       (SETQ TEM (OR (AND (FMEMB FILE FILELST)
					  [SETQ TEM (fetch
 DATEFILENAME
						       of
 (CAR (LISTP (fetch
 FILEDATES of
 FILE]
					  (INFILEP TEM))
				     (FINDFILE FILE T)))
		       (COND
			 ((SETQ TEM2 (fetch
 FILEGETDEF of
 TYPE))
			   (SETQ DEF (APPLY* TEM2 NAME TYPE TEM OPTIONS)))
			 (T
			   (SELECTQ
			     TYPE
			     [FNS (SETQ DEF (COND
				      [[AND (EQMEMB (QUOTE FAST)
						    OPTIONS)
					    (EQ TEM (CAR (SETQ TEM2 (fetch
 FILEMAP of
 FILE]
					(for
 PAIR TEM3 in
 (CDADR TEM2)
					   when
 [SETQ TEM3 (CADR (ASSOC NAME (CDDR PAIR]
					   do
 [OR (OPENP TEM)
						  (RESETSAVE NIL (LIST (QUOTE CLOSEF?)
								       (INPUT (INFILE TEM]
					      (SETFILEPTR TEM TEM3)
					      (RETURN (COND
							((EQMEMB (QUOTE ARGLIST)
								 OPTIONS)
							  (RATOM TEM FILERDTBL)
							  (READ TEM FILERDTBL)
							  (RATOM TEM FILERDTBL)
							  (LIST (READ TEM FILERDTBL)
								(READ TEM FILERDTBL)))
							(T (CADR (READ TEM FILERDTBL]
				      (T (CADR (FASSOC NAME (LOADEFS NAME TEM]
			     ((VARS FILEVARS)
			       (for
 X in
 (LOADFNS NIL TEM (QUOTE GETDEF)
						  NAME)
				  do
 (SELECTQ (CAR X)
					      ((RPAQQ SETQQ)
						(SETQ DEF (CADDR X))
						(RETURN T))
					      ((RPAQ SETQ RPAQ?)
						(SETQ DEF (EVAL (CADDR X)))
						(RETURN T))
					      NIL)))
			     [MACROS (for
 X in
 [LOADFNS NIL TEM (QUOTE GETDEF)
							(QUOTE (LAMBDA (FIRST
 SECOND)
								       (AND (EQ FIRST (QUOTE PUTPROPS)
										)
									    (EQ SECOND NAME]
					join
 (for
 TAIL on
 (CDDR X) by
 (CDDR TAIL)
						when
 (FMEMB (CAR TAIL)
							    MACROPROPS)
						join
 (LIST (CAR TAIL)
							   (CADR TAIL)))
					finally
 (RETURN (AND $$VAL (SETQ DEF (CONS (QUOTE PUTPROPS)
										   (CONS NAME $$VAL]
			     [PROPS (for
 X in
 [LOADFNS NIL TEM (QUOTE GETDEF)
						       (QUOTE (LAMBDA (FIRST
 SECOND)
								      (AND (EQ FIRST (QUOTE PUTPROPS))
									   (EQ SECOND (CAR NAME]
				       join
 (for
 TAIL on
 (CDDR X) by
 (CDDR TAIL)
					       when
 (EQ (CAR TAIL)
							(CADR NAME))
					       join
 (LIST (CAR TAIL)
							  (CADR TAIL)))
				       finally
 (RETURN (AND $$VAL (SETQ DEF
							      (CONS (QUOTE PUTPROPS)
								    (CONS (CAR NAME)
									  $$VAL]
			     [RECORDS
			       (SETQ DEF
				 (MKPROGN
				   (LOADFNS NIL TEM (QUOTE GETDEF)
					    (QUOTE (LAMBDA
						     (FIRST
 SECOND)
						     (AND (MEMB FIRST CLISPRECORDTYPES)
							  (OR (EQ SECOND NAME)
							      (AND (MEMB SECOND (QUOTE (%( %[)))
								   (PROGN (RATOM)
									  (RATOM)
									  (RATOM)
									  (EQ NAME (RATOM]
			     [ALISTS (for
 X in
 [LOADFNS NIL TEM (QUOTE GETDEF)
							(QUOTE (LAMBDA (FIRST
 SECOND)
								       (AND (EQ FIRST (QUOTE ADDTOVAR)
										)
									    (EQ SECOND (CAR NAME]
					when
 (SETQ X (ASSOC (CADR NAME)
							    (CDDR X)))
					collect
 X finally
 (RETURN
							    (AND $$VAL (SETQ DEF
								   (CONS (QUOTE ADDTOVAR)
									 (CONS (CAR NAME)
									       $$VAL]
			     [LISPXMACROS
			       (SETQ DEF
				 (MKPROGN (for
 X
					     in
 [LOADFNS NIL TEM (QUOTE GETDEF)
							 (QUOTE (LAMBDA
								  (FIRST
 SECOND)
								  (AND (EQ FIRST (QUOTE ADDTOVAR))
								       (MEMB SECOND
									     (QUOTE (LISPXMACROS
										      LISPXCOMS)))
								       T]
					     when
 (SELECTQ (CADR X)
							   [LISPXMACROS 
                                                            (* Rebuild the expressions cause there might be other 

							    elements in the ADDTOVAR)

									(AND (SETQ X
									       (ASSOC NAME
										      (CDDR X)))
									     (SETQ X
									       (LIST (QUOTE ADDTOVAR)
										     (QUOTE 
										      LISPXMACROS)
										     X]
							   [LISPXCOMS (COND
									((MEMB NAME (CDDR X))
									  (SETQ X
									    (LIST (QUOTE ADDTOVAR)
										  (QUOTE LISPXCOMS)
										  NAME)))
									((SETQ X (ASSOC NAME
											(CDDR X)))
                                                            (* For synonym pairs)

									  (SETQ X
									    (LIST (QUOTE ADDTOVAR)
										  (QUOTE LISPXCOMS)
										  X]
							   NIL)
					     collect
 X]
			     (RESETLST (RESETSAVE (RESETUNDO))
				       [RESETVARS (PRETTYHEADER)
					          (LOADFNS NIL TEM T (COND
							     ((LITATOM NAME)
                                                            (* If an atom, only bother with expressions that contain

							    it)

							       (CONS (LIST (QUOTE &)
									   (QUOTE ..)
									   NAME)))
							     (T T]
				       [SETQ DEF (GETDEFCURRENT
 NAME TYPE (CONS (QUOTE NOERROR)
										(MKLIST OPTIONS]
				       (PROG1 (NULL NODEF)
					      (SETQ NODEF NIL]
		    do
 (AND (EQ SOURCE (QUOTE FILE))
			    (OR (FMEMB FILE FILELST)
				(PRINT (LIST (QUOTE from)
					     TEM)
				       T T)))               (* Copying and dwimifying are done in GETDEF)

		       (RETURN DEF)
		    finally
 (RETURN (GETDEFERR
 NAME TYPE OPTIONS (APPEND (QUOTE (no definition on))
									 (MKLIST SOURCE])

(GETDEFSAVED

  [LAMBDA (NAME TYPE OPTIONS)                               (* rmk: "14-JAN-81 22:58")

                                                            (* Gets the "saved" definition--source=T)

    (SELECTQ TYPE
	     (FNS (OR (GETPROP NAME (QUOTE EXPR))
		      (GETDEFERR
 NAME TYPE OPTIONS "no saved definition for")))
	     [VARS                                          (* The value of a variable is never substituted into and

							    never COPIED)

		   (for
 X on
 (GETPROPLIST NAME) by
 (CDDR X) when
 (EQ (CAR X)
								     (QUOTE VALUE))
		      do
 (RETURN (CADR X)) finally
 (RETURN (GETDEFERR
 NAME TYPE OPTIONS 
								      "no saved value for "]
	     (CDR (OR (SASSOC NAME (FASSOC TYPE SAVEDDEFS))
		      (GETDEFERR
 NAME TYPE OPTIONS "no saved definition for "])

(PUTDEF

  (LAMBDA (NAME TYPE DEFINITION)                             (* JonL "24-Jul-84 17:58")

    (SETQ TYPE (GETFILEPKGTYPE
 TYPE (QUOTE TYPE)))
    (PROG (TEM)
          (COND
	    ((SETQ TEM (fetch
 PUTDEF of
 TYPE))
	      (APPLY* TEM NAME TYPE DEFINITION))
	    (T (SELECTQ TYPE
			(FNS (DEFINE (LIST (LIST NAME DEFINITION))))
			(VARS (SAVESET NAME DEFINITION T))
			(FILES (PUTDEF
 (FILECOMS
 NAME)
				       (QUOTE VARS)
				       (CAR DEFINITION))     (* DEFINE THE COMS)

			       (ADDFILE
 NAME)                (* MAKE SURE IT IS A FILE PACKAGE ENTITY)

			       (change
 (fetch
 TOBEDUMPED of
 (fetch
 FILEPROP of
 NAME))
				       (FILEPKG.MERGECHANGES
 (CADR DEFINITION)
							     DATUM))
			       (OR (fetch
 FILEDATES of
 NAME)
				   (replace
 FILEDATES of
 NAME with
 (CADDR DEFINITION))))
			(ADVISE (PROG (TEM)
				      (/PUT NAME (QUOTE READVICE)
					    (CONS (COND
						    ((SETQ TEM (STRPOS "-IN-" NAME))
						      (CONS (SUBATOM NAME 1 (SUB1 TEM))
							    (SUBATOM NAME (IPLUS TEM 4)
								     -1))))
						  DEFINITION)))
				(APPLY* (QUOTE READVISE)
					NAME))
			(FILEPKGCOMS (PROG (COM TYP)
				           (SELECTQ (CAR (LISTP DEFINITION))
						    (COM (SETQ COM (CDR DEFINITION)))
						    (TYPE (SETQ TYP (CDR DEFINITION)))
						    (PROGN (SETQ COM (CDR (ASSOC (QUOTE COM)
										 DEFINITION)))
							   (SETQ TYP (CDR (ASSOC (QUOTE TYPE)
										 DEFINITION)))))
                                                             (* Check properties first, so that we don't smash some 

							     and then get an error in a later call to 

							     FILEPKGCOM/TYPE)

				           (for
 I in
 COM by
 (CDDR I)
					      do
 (SELECTQ I
							  ((ADD
 DELETE MACRO CONTENTS CONTAIN COM))
							  (ERROR I 
							      "not file package command property")))
                                                             (* COM merely adds to spelling list, for builtins)

				           (FILEPKGCOM
 NAME (QUOTE CONTENTS)
						       (OR (LISTGET COM (QUOTE CONTENTS))
							   (LISTGET COM (QUOTE CONTAIN))))
                                                             (* Until CONTAIN is de-documented.)

				           (for
 PROP in
 (QUOTE (ADD DELETE MACRO COM))
					      do
 (FILEPKGCOM
 NAME PROP (LISTGET COM PROP)))
				           (for
 I in
 TYP by
 (CDDR I)
					      do
 (SELECTQ I
							  ((DESCRIPTION WHENCHANGED WHENFILED 
									WHENUNFILED NEWCOM GETDEF 
									FILEGETDEF PUTDEF EDITDEF 
									DELDEF TYPE))
							  (ERROR I 
							 "not file package type/command property")))
                                                             (* TYPE merely adds to spelling list, for builtins)

				           (for
 PROP
					      in
 (QUOTE (DESCRIPTION WHENCHANGED WHENFILED 
								     WHENUNFILED NEWCOM GETDEF 
								     FILEGETDEF PUTDEF EDITDEF DELDEF 
								     TYPE))
					      do
 (FILEPKGTYPE
 NAME PROP (LISTGET TYP PROP)))))
			(EVAL DEFINITION)))))
    NAME))

(EDITDEF

  [LAMBDA (NAME TYPE SOURCE EDITCOMS)                       (* rmk: "13-JUL-83 03:02")

    (DECLARE
 (SPECVARS SOURCE))

          (* lets you edit anything. Given name and type, call editor on the definition (loading it in from SOURCE if 

	  necessary). If you change it, then the definition gets "unsaved")



    (SETQ TYPE (GETFILEPKGTYPE
 TYPE (QUOTE TYPE)))
    (OR SOURCE (SETQQ SOURCE ?))
    [COND
      ((AND (EQ TYPE (QUOTE FNS))
	    (EQ SOURCE (QUOTE ?))
	    EDITLOADFNSFLG
	    (WHEREIS
 NAME TYPE))
	(APPLY (FUNCTION EDITF)
	       (CONS NAME EDITCOMS)))
      (T (PROG ((DEF (GETDEF
 NAME TYPE SOURCE (QUOTE NOCOPY)))
		RETRY)
	   LP  (SETQ RETRY)
	       [EDITE DEF EDITCOMS NAME TYPE
		      (FUNCTION (LAMBDA (NAME DEF TYPE EXITFLG)
			  (PROG ((OLDDEF (GETDEF
 NAME TYPE (QUOTE CURRENT)
						 0)))       (* this function is called when there were changes made)

			        (MARKASCHANGED
 NAME TYPE)
			        (COND
				  [EXITFLG                  (* exited with OK)

					   (RESETVARS ((DFNFLG T))

          (* rebind DFNFLG to T because we do not want to warn the user (he knows that the thing got edited, since the exit 

	  was a normal one))



						      (COND
							((NEQ (EQUALN DEF OLDDEF 1000)
							      T)
                                                            (* not sure the definitions are identical)

							  (SELECTQ SOURCE
								   ((? 0))
								   (printout
 T "unsaved" T))
							  (SAVEDEF
 NAME TYPE OLDDEF)
                                                            (* save old definition)

							  (OR (ERSETQ (PUTDEF
 NAME TYPE DEF))
							      (SETQ RETRY T]
				  (T                        (* abnormal exit, but changes made;

							    save the definition but don't PUTDEF it.

							    Don't warn user about unsaving if the definitions are 

							    equal)

				     (OR (EQ T (EQUALN DEF OLDDEF 1000))
					 (printout
 T NAME " definition as " TYPE " not changed." T))
				     (SAVEDEF
 NAME TYPE DEF]
	       (COND
		 (RETRY (SETQ EDITCOMS)
			(GO LP]
    NAME])

(LOADDEF

  [LAMBDA (NAME TYPE SOURCE)                                (* lmm "13-SEP-78 01:34")

    (PUTDEF
 NAME TYPE (GETDEF
 NAME TYPE SOURCE (QUOTE (NODWIM NOCOPY])

(DWIMDEF

  [LAMBDA (DEF FN SOURCE)                                   (* rmk: "13-JUL-83 02:59")

    (AND [OR (EQ DWIMIFYCOMPFLG T)
	     (EQ CLISPIFYPRETTYFLG T)
	     (EQ (CAR (CADDR DEF))
		 (QUOTE CLISP:))
	     (SELECTQ SOURCE
		      ((CURRENT SAVED FILE ?)
			NIL)
		      (AND (LITATOM SOURCE)
			   (EQMEMB (QUOTE CLISP)
				   (GETPROP SOURCE (QUOTE FILETYPE]
	 (RESETVARS ((NOSPELLFLG T)
		     (DWIMESSGAG T)
		     FILEPKGFLG)
		    (PROG (LISPXHIST)
		          (DWIMIFY0 DEF (COND
				      ((OR (LISTP FN)
					   (NULL FN))
					(QUOTE ?))
				      (T FN))
				    NIL DEF])

(DELDEF

  (LAMBDA (NAME TYPE)                                        (* JonL "24-Jul-84 20:05")

    (PROG (TEM)
          (SETQ TYPE (GETFILEPKGTYPE
 TYPE (QUOTE TYPE)))
      LP  (COND
	    ((SETQ TEM (fetch
 DELDEF of
 TYPE))
	      (APPLY* TEM NAME TYPE))
	    (T (SELECTQ TYPE
			(FNS                                 (* special because GETDEF of a FNS is only its EXPR 

							     definitio, and DELDEF should only remove such)

			     (AND (EXPRP NAME)
				  (/PUTD NAME))
			     (REMPROP NAME (QUOTE EXPR))
			     (AND MSDATABASELST (MASTERSCOPE (LIST (QUOTE ERASE)
								   (KWOTE NAME)))))
			(VARS (/SETTOPVAL NAME (QUOTE NOBIND)))
			(FILES (for
 LST in
 (QUOTE (FILELST NOTCOMPILEDFILES NOTLISTEDFILES))
				  do
 (/SETTOPVAL LST (REMOVE NAME (GETTOPVAL LST))))
			       (/replace
 FILEPROP of
 NAME with
 NIL)
			       (/replace
 FILECHANGES of
 NAME with
 NIL)
			       (/replace
 FILEMAP of
 NAME with
 NIL)
			       (/replace
 FILEDATES of
 NAME with
 NIL))
			(RECORDS (APPLY* (QUOTE EDITREC)
					 NIL
					 (LIST (QUOTE DELETE)
					       (LIST (QUOTE F)
						     (RECLOOK NAME NIL NIL NIL T)))))
			(FIELDS (APPLY (FUNCTION PROGN)
				       (SUBST NIL NAME (FIELDLOOK NAME))))
			(FILEPKGCOMS (DELFROMLIST
 (QUOTE FILEPKGCOMSPLST)
						  NAME)
				     (DELFROMLIST
 (QUOTE FILEPKGTYPES)
						  NAME)
				     (for
 FIELD on
 (FILEPKGCOM
 NAME) by
 (CDDR FIELD)
					do
 (FILEPKGCOM
 NAME (CAR FIELD)
						       NIL))
				     (for
 FIELD on
 (FILEPKGTYPE
 NAME) by
 (CDDR FIELD)
					do
 (FILEPKGTYPE
 NAME (CAR FIELD)
							NIL))
				     (/replace
 ALLFIELDS of
 NAME with
 NIL))
			(ALISTS (AND (LISTP NAME)
				     (DELFROMLIST
 (CAR NAME)
						  (FASSOC (CADR NAME)
							  (GETTOPVAL (CAR NAME))))))
			(MACROS (for
 P in
 MACROPROPS do
 (/REMPROP NAME P)))
			(PROPS (AND (LISTP NAME)
				    (/REMPROP (CAR NAME)
					      (CADR NAME))))
			(LISPXMACROS (DELFROMLIST
 (QUOTE LISPXMACROS)
						  (FASSOC NAME LISPXMACROS))
				     (DELFROMLIST
 (QUOTE LISPXHISTORYMACROS)
						  (FASSOC NAME LISPXHISTORYMACROS))
				     (DELFROMLIST
 (QUOTE LISPXCOMS)
						  NAME)
				     (DELFROMLIST
 (QUOTE HISTORYCOMS)
						  NAME))
			(PRIN1 (LIST "Note: deleting" TYPE "not implemented yet")
			       T))))
          (MARKASCHANGED
 NAME TYPE (QUOTE DELETED))
          (RETURN NAME))))

(DELFROMLIST

  [LAMBDA (VAR VAL)                                         (* rmk: " 3-JAN-82 23:22")

    (AND (FMEMB VAL (GETTOPVAL VAR))
	 (/SETTOPVAL VAR (SUBSET (GETTOPVAL VAR)
				 (FUNCTION (LAMBDA (X)
				     (AND (NEQ X VAL)
					  (OR (NLISTP X)
					      (NEQ (CDR X)
						   VAL])

(HASDEF

  [LAMBDA (NAME TYPE SOURCE SPELLFLG)                        (* lmm "27-Aug-84 23:51")

                                                             (* is NAME the name of something of type TYPE? NIL 

							     SOURCE means 0, not ?)

    (DECLARE
 (SPECVARS TYPE))
    (if
 [OR (LISTP TYPE)
	    (LISTP (SETQ TYPE (GETFILEPKGTYPE
 TYPE (QUOTE TYPE]
	then
                                                 (* ignore SPELLFLG)

	     (for
 TY in
 TYPE do
 (AND (SETQ $$VAL (HASDEF
 NAME TY SOURCE))
				     (RETURN $$VAL)))
      else

       (PROG [NODEF (OPTS (QUOTE ("no def" NODWIM NOCOPY NOERROR HASDEF]
	     (SETQ NODEF (CAR OPTS))
	     (OR SOURCE (SETQQ SOURCE CURRENT))
	     (RETURN
	       (SELECTQ SOURCE
			[(CURRENT 0)
			  (COND
			    ([OR (MEMBER NAME (fetch
 CHANGED of
 TYPE))
				 (COND
				   [(LISTP NAME)
				     (SELECTQ TYPE
					      (PROPS (GETPROP (CAR NAME)
							      (CADR NAME)))
					      ((FILES TEMPLATES MACROS LISPXMACROS VARS I.S.OPRS FNS 
						      FIELDS USERMACROS ADVICE FILEVARS FILEPKGCOMS)
						NIL)
					      (NEQ NODEF (GETDEF
 NAME TYPE (QUOTE CURRENT)
								 OPTS]
				   (T (SELECTQ TYPE
					       (FILES        (* if NAME is FOO, look for FOO.LSP on FILELST)

						      (GETFILEDEF
 NAME))
					       (TEMPLATES (GETTEMPLATE NAME))
					       (MACROS (GETLIS NAME MACROPROPS))
					       (LISPXMACROS (OR (FASSOC NAME LISPXMACROS)
								(FASSOC NAME LISPXHISTORYMACROS)))
					       (VARS (NEQ (GETTOPVAL NAME)
							  (QUOTE NOBIND)))
					       (RECORDS (RECLOOK NAME))
					       [I.S.OPRS (PROG [(TEM (GETPROP NAME (QUOTE CLISPWORD]
							       (RETURN (AND TEM (EQ (CAR TEM)
										    (QUOTE FORWORD))
									    (GETPROP (CDR TEM)
										     (QUOTE I.S.OPR]
					       [FNS (AND (GETD NAME)
							 (EXPRP (GETD NAME]
					       (FIELDS (RECORDFIELD? NAME))
					       (USERMACROS (FASSOC NAME USERMACROS))
					       [ADVICE (GETLIS NAME (QUOTE (ADVICE READVICE]
					       (FILEVARS)
					       ((PROPS ALISTS DEFS EXPRESSIONS)
						 NIL)
					       (FILEPKGCOMS (OR (FMEMB NAME FILEPKGCOMSPLST)
								(FMEMB NAME FILEPKGTYPES)))
					       (NEQ NODEF (GETDEF
 NAME TYPE (QUOTE CURRENT)
								  OPTS]
			      (OR NAME T))
			    (SPELLFLG (SELECTQ TYPE
					       ((ALISTS PROPS)
						 (ERROR NAME "?"))
					       (FIXSPELL NAME NIL
							 (SELECTQ
							   TYPE
							   (FILES FILELST)
							   (FILEPKGCOMS (UNION FILEPKGCOMSPLST 
									       FILEPKGTYPES))
							   [FIELDS (for
 X in
 USERRECLST
								      join
 (APPEND (RECORDFIELDNAMES
										     X]
							   (RECORDS (for
 X in
 USERRECLST
								       when
 (LITATOM (CADR X))
								       collect
 (CADR X)))
							   (LISPXMACROS LISPXCOMS)
							   (I.S.OPRS I.S.OPRLST)
							   (USERMACROS (MAPCAR
									 USERMACROS
									 (FUNCTION CAR)))
							   USERWORDS)
							 NIL
							 (LISTP SPELLFLG)
							 [FUNCTION (LAMBDA (X)
							     (HASDEF
 X TYPE (QUOTE CURRENT]
							 NIL T]
			[? (OR (HASDEF
 NAME TYPE (QUOTE CURRENT)
				       SPELLFLG)
			       (HASDEF
 NAME TYPE (QUOTE SAVED))
			       (AND (EQ TYPE (QUOTE FNS))
				    (WHEREIS
 NAME TYPE T]
			((SAVED T)
			  (NEQ NODEF (GETDEF
 NAME TYPE (QUOTE SAVED)
					     OPTS)))
			(NEQ NODEF (GETDEF
 NAME TYPE SOURCE OPTS])

(GETFILEDEF

  [LAMBDA (FILENAME)                                         (* rrb "22-Mar-84 11:40")

                                                             (* returns the official file name from a file name if 

							     NAME is FOO, look for FOO.LSP on FILELST)

    (OR (CAR (FMEMB FILENAME FILELST))
	(for
 FILE in
 FILELST when
 (STRPOS FILENAME FILE 1 NIL T)
	   do
 (COND
		((EQ (FILENAMEFIELD FILE (QUOTE NAME))
		     FILENAME)
		  (RETURN FILE])

(SAVEDEF

  (LAMBDA (NAME TYPE DEFINITION)                             (* JonL "24-Jul-84 20:11")

    (COND
      ((AND (LISTP NAME)
	    (NULL TYPE))
	(MAPCAR NAME (FUNCTION (LAMBDA (I)
		    (SAVEDEF
 I (QUOTE FNS))))))
      (T (SELECTQ (SETQ TYPE (GETFILEPKGTYPE
 TYPE (QUOTE TYPE)))
		  (FNS (AND (OR DEFINITION (SETQ DEFINITION (GETD NAME)))
			    (/PUT NAME (SETQ TYPE (COND
				      ((SUBRP DEFINITION)
					(QUOTE SUBR))
				      ((EXPRP DEFINITION)
					(QUOTE EXPR))
				      ((CCODEP DEFINITION)
					(QUOTE CODE))
				      (T (QUOTE LIST))))
				  DEFINITION)))
		  (VARS (AND (NEQ (OR DEFINITION (SETQ DEFINITION (GETTOPVAL NAME)))
				  (QUOTE NOBIND))
			     (EQ DEFINITION (GETTOPVAL NAME))
			     (/PUT NAME (SETQ TYPE (QUOTE VALUE))
				   DEFINITION)))
		  (AND (OR DEFINITION (SETQ DEFINITION (GETDEF
 NAME TYPE (QUOTE CURRENT)
							       (QUOTE (NOCOPY NOERROR NODWIM)))))
		       (/PUTASSOC NAME DEFINITION (OR (CDR (FASSOC TYPE SAVEDDEFS))
						      (CAR (SETQ SAVEDDEFS
							     (CONS (LIST TYPE (CONS NAME))
								   SAVEDDEFS)))))))
	 TYPE))))

(UNSAVEDEF

  (LAMBDA (NAME TYPE DEF)                                    (* JonL "24-Jul-84 20:11")

    (SELECTQ TYPE
	     ((NIL EXPR CODE SUBR LIST)
	       (COND
		 ((LISTP NAME)                               (* for compatibility)

		   (MAPCAR NAME (FUNCTION (LAMBDA (X)
			       (UNSAVED1 X TYPE)))))
		 (T (UNSAVED1 NAME TYPE))))
	     (PROG NIL
	           (OR DEF (SETQ DEF (GETDEF
 NAME (SETQ TYPE (GETFILEPKGTYPE
 TYPE (QUOTE TYPE)))
					     (QUOTE SAVED)
					     0))
		       (RETURN (CONS TYPE (QUOTE (not found)))))
	           (OR (EQ DFNFLG T)
		       (SAVEDEF
 NAME TYPE))
	           (RESETVARS ((DFNFLG T))
			      (PUTDEF
 NAME TYPE DEF))
	           (RETURN TYPE)))))

(COMPAREDEFS

  [LAMBDA (NAME TYPE SOURCES)                               (* rmk: "19-FEB-83 14:06")

    (COND
      ((AND (LISTP TYPE)
	    (GETFILEPKGTYPE
 SOURCES NIL T))
	(swap
 TYPE SOURCES)))
    (PROG (DEF DEFS)
          [COND
	    ((NULL SOURCES)
	      (SETQ SOURCES (WHEREIS
 NAME TYPE T))
	      (AND [OR (MEMBER NAME (FILEPKGCHANGES
 TYPE))
		       (SOME SOURCES (FUNCTION (LAMBDA (FILE)
				 (MEMBER NAME (fetch
 TOBEDUMPED of
 (fetch
 FILEPROP of
 FILE]
		   (push
 SOURCES NIL]
          [COND
	    [(NULL SOURCES)
	      (RETURN (QUOTE (not found]
	    ((NULL (CDR SOURCES))
	      (RETURN (QUOTE (one only]
          [for
 SRC in
 SOURCES do
 (AND [SETQ DEF (GETDEF
 NAME TYPE SRC (QUOTE (NOERROR NOCOPY]
				      (OR [SOME DEFS (FUNCTION (LAMBDA (DP)
						    (COMPARELST DEF (CDR DP]
					  (push
 DEFS (CONS SRC DEF]
          (RETURN (COND
		    ((CDR DEFS)
		      [for
 S1 on
 (DREVERSE DEFS) do
 (for
 S2 on
 (CDR S1)
						       do
 (PRIN2 NAME T T)
							  (AND (CAAR S1)
							       (PRIN1 " from " T)
							       (PRIN2 (CAAR S1)
								      T T))
							  (PRIN1 " and " T)
							  (PRIN2 NAME T T)
							  (COND
							    ((CAAR S2)
							      (PRIN1 " from " T)
							      (PRIN2 (CAAR S2)
								     T T)))
							  (PRIN1 " differ:" T)
							  (TERPRI T)
							  (COMPARELISTS (CDAR S1)
									(CDAR S2]
		      (QUOTE DIFFERENT))
		    (T (QUOTE SAME])

(COMPARE

  [LAMBDA (NAME1 NAME2 TYPE SOURCE1 SOURCE2)                (* lmm " 5-SEP-78 13:37")

    (PROG [[DEF1 (GETDEF
 NAME1 TYPE SOURCE1 (QUOTE (NOERROR NOCOPY]
	   (DEF2 (GETDEF
 NAME2 TYPE SOURCE2 (QUOTE (NOERROR NOCOPY]
          (COND
	    ((COMPARELST DEF1 DEF2)
	      (RETURN)))
          (PRIN2 NAME1 T T)
          (COND
	    (SOURCE1 (PRIN1 " from " T)
		     (PRIN2 SOURCE1 T T)))
          (PRIN1 " and " T)
          (PRIN2 NAME2 T T)
          (COND
	    (SOURCE2 (PRIN1 " from " T)
		     (PRIN2 SOURCE2 T T)))
          (PRIN1 " differ:" T)
          (TERPRI T)
          (COMPARELISTS DEF1 DEF2)
          (RETURN T])

(TYPESOF

  [LAMBDA (NAME POSSIBLETYPES IMPOSSIBLETYPES SOURCE)        (* bvm: "28-Mar-84 14:36")

                                                             (* return list of all known types which NAME names)

    (for
 TYPE inside
 (OR POSSIBLETYPES FILEPKGTYPES) when
 (AND (LITATOM TYPE)
							       (NOT (EQMEMB TYPE IMPOSSIBLETYPES))
							       (HASDEF
 NAME TYPE SOURCE))
       collect
 TYPE])
)



(* Must come after PUTDEF)


(* * 
"how to dump FILEPKGCOMS. The SPLST must be initialized to contain FILEPKGCOMS 
     in order to get started.")


(DEFINEQ

(FILEPKGCOM

  (LAMBDA N                                                  (* JonL "10-Jul-84 19:38")

    (PROG (TEM (COM (ARG N 1)))
          (RETURN (COND
		    ((EQ N 1)
		      (OR (for
 FIELD in
 (QUOTE (MACRO CONTENTS DELETE ADD))
			     when
 (SETQ TEM (FILEPKGCOM
 COM FIELD)) join
 (LIST FIELD TEM))
			  (AND (FMEMB COM (GETTOPVAL (QUOTE FILEPKGCOMSPLST)))
			       (LIST (QUOTE COM)
				     T))
			  (AND (SETQ TEM (CDR (ASSOC COM (GETTOPVAL (QUOTE FILEPKGCOMSPLST)))))
			       (LIST (QUOTE COM)
				     TEM))))
		    ((EQ N 2)
		      (SELECTQ
			(ARG N 2)
			(ADD (fetch
 ADD of
 COM))
			(DELETE (fetch
 DELETE of
 COM))
			(MACRO (fetch
 MACRO of
 COM))
			((CONTENTS CONTAIN)
			  (OR (fetch
 (FILEPKGCOM
 CONTENTS) of
 COM)
			      (COND
				((SETQ COM (fetch
 (FILEPKGCOM
 PRETTYTYPE) of
 COM))
				  (COND
				    ((EQ COM (QUOTE NILL))
				      COM)
				    ((EQ (CAR COM)
					 (QUOTE LAMBDA))
				      (CONS (CAR COM)
					    (CONS (CONS (CAADR COM)
							(CONS (OR (CADDR (CADR COM))
								  (QUOTE NAME))
							      (CONS (CADR (CADR COM))
								    (CDDDR (CADR COM)))))
						  (SUBST (QUOTE INFILECOMTAIL)
							 (QUOTE PRETTYCOM1)
							 (CDDR COM)))))
				    (T (LIST (QUOTE LAMBDA)
					     (QUOTE (COM TYPE NAME))
					     (CONS COM (QUOTE (COM TYPE NAME))))))))))
			(COM (OR (AND (FMEMB COM (GETTOPVAL (QUOTE FILEPKGCOMSPLST)))
				      T)
				 (CDR (ASSOC COM (GETTOPVAL (QUOTE FILEPKGCOMSPLST))))))
			(ERROR (ARG N 2)
			       "not file package command property")))
		    (T (for
 I TEM2 from
 2 to
 N by
 2
			  do
 (SETQ TEM (ARG N (ADD1 I)))
			     (COND
			       ((EQ (ARG N I)
				    (QUOTE COM))
				 (SELECTQ TEM
					  (NIL)
					  (T (OR (FMEMB COM (GETTOPVAL (QUOTE FILEPKGCOMSPLST)))
						 (/SETTOPVAL (QUOTE FILEPKGCOMSPLST)
							     (CONS COM (GETTOPVAL (QUOTE 
										  FILEPKGCOMSPLST)))))
					     )
					  (COND
					    ((SETQ TEM2 (ASSOC COM (GETTOPVAL (QUOTE FILEPKGCOMSPLST))
							       ))
					      (/RPLACD TEM2 TEM))
					    (T (/SETTOPVAL (QUOTE FILEPKGCOMSPLST)
							   (CONS (CONS COM TEM)
								 (GETTOPVAL (QUOTE FILEPKGCOMSPLST))))
					       ))))
			       (T (AND TEM (OR (FMEMB COM (GETTOPVAL (QUOTE FILEPKGCOMSPLST)))
					       (/SETTOPVAL (QUOTE FILEPKGCOMSPLST)
							   (CONS COM (GETTOPVAL (QUOTE 
										  FILEPKGCOMSPLST)))))
				       )
				  (SELECTQ (ARG N I)
					   (ADD (/replace
 (FILEPKGCOM
 ADD) of
 COM with
 TEM))
					   (DELETE (/replace
 (FILEPKGCOM
 DELETE) of
 COM with
 TEM))
					   (MACRO (/replace
 (FILEPKGCOM
 MACRO) of
 COM with
 TEM))
					   ((CONTENTS CONTAIN)
					     (/replace
 (FILEPKGCOM
 CONTENTS) of
 COM with
 TEM))
					   (ERROR (ARG N I)
						  "not file package command property")))))
		       (MARKASCHANGED
 COM (QUOTE FILEPKGCOMS))))))))

(FILEPKGTYPE

  [LAMBDA N                                                 (* rmk: "19-FEB-82 13:28")

    (PROG ((TYPE (ARG N 1))
	   TEM)
          (RETURN (COND
		    [(EQ N 1)
		      (OR (for
 FIELD
			     in
 (QUOTE (DESCRIPTION WHENCHANGED WHENFILED WHENUNFILED NEWCOM GETDEF 
						    FILEGETDEF PUTDEF EDITDEF DELDEF))
			     when
 (SETQ TEM (FILEPKGTYPE
 TYPE FIELD)) join
 (LIST FIELD TEM))
			  (AND (FMEMB TYPE (GETTOPVAL (QUOTE FILEPKGTYPES)))
			       (LIST (QUOTE TYPE)
				     T))
			  (AND [SETQ TEM (CDR (ASSOC TYPE (GETTOPVAL (QUOTE FILEPKGTYPES]
			       (LIST (QUOTE TYPE)
				     TEM]
		    ((EQ N 2)
		      (SELECTQ (ARG N 2)
			       (DESCRIPTION (fetch
 DESCRIPTION of
 TYPE))
			       (WHENCHANGED (fetch
 WHENCHANGED of
 TYPE))
			       (WHENFILED (fetch
 WHENFILED of
 TYPE))
			       (WHENUNFILED (fetch
 WHENUNFILED of
 TYPE))
			       (NEWCOM (fetch
 NEWCOM of
 TYPE))
			       (GETDEF
 (fetch
 GETDEF of
 TYPE))
			       (FILEGETDEF (fetch
 FILEGETDEF of
 TYPE))
			       (PUTDEF
 (fetch
 PUTDEF of
 TYPE))
			       (DELDEF
 (fetch
 DELDEF of
 TYPE))
			       (EDITDEF
 (fetch
 EDITDEF of
 TYPE))
			       [TYPE (OR (AND (FMEMB TYPE (GETTOPVAL (QUOTE FILEPKGTYPES)))
					      T)
					 (CDR (ASSOC TYPE (GETTOPVAL (QUOTE FILEPKGTYPES]
			       (ERROR (ARG N 2)
				      "not file package type property")))
		    (T [for
 I TEM2 from
 2 to
 N by
 2
			  do
 (SETQ TEM (ARG N (ADD1 I)))
			     (COND
			       [(EQ (ARG N I)
				    (QUOTE TYPE))
				 (SELECTQ TEM
					  (NIL)
					  [T (OR (FMEMB TYPE (GETTOPVAL (QUOTE FILEPKGTYPES)))
						 (/SETTOPVAL (QUOTE FILEPKGTYPES)
							     (CONS TYPE (GETTOPVAL (QUOTE 
										     FILEPKGTYPES]
					  (COND
					    ([SETQ TEM2 (ASSOC TYPE (GETTOPVAL (QUOTE FILEPKGTYPES]
					      (/RPLACD TEM2 TEM))
					    (T (/SETTOPVAL (QUOTE FILEPKGTYPES)
							   (CONS (CONS TYPE TEM)
								 (GETTOPVAL (QUOTE FILEPKGTYPES]
			       (T [AND TEM (OR (FMEMB TYPE (GETTOPVAL (QUOTE FILEPKGTYPES)))
					       (/SETTOPVAL (QUOTE FILEPKGTYPES)
							   (CONS TYPE (GETTOPVAL (QUOTE FILEPKGTYPES]
				  (SELECTQ (ARG N I)
					   (DESCRIPTION (/replace
 DESCRIPTION of
 TYPE with
 TEM))
					   (WHENCHANGED (/replace
 WHENCHANGED of
 TYPE with
 TEM))
					   (WHENFILED (/replace
 WHENFILED of
 TYPE with
 TEM))
					   (WHENUNFILED (/replace
 WHENUNFILED of
 TYPE with
 TEM))
					   (NEWCOM (/replace
 NEWCOM of
 TYPE with
 TEM))
					   (GETDEF
 (/replace
 GETDEF of
 TYPE with
 TEM))
					   (FILEGETDEF (/replace
 FILEGETDEF of
 TYPE with
 TEM))
					   (PUTDEF
 (/replace
 PUTDEF of
 TYPE with
 TEM))
					   (DELDEF
 (/replace
 DELDEF of
 TYPE with
 TEM))
					   (EDITDEF
 (/replace
 EDITDEF of
 TYPE with
 TEM))
					   (ERROR (ARG N I)
						  "not file package command/type property"]
		       (MARKASCHANGED
 TYPE (QUOTE FILEPKGCOMS])
)

(PUTPROPS FILEPKGCOM ARGNAMES
 (COMMANDNAME (KEYWORDS: MACRO ADD DELETE CONTENTS)))

(ADDTOVAR FILEPKGCOMSPLST
 FILEPKGCOMS)

(ADDTOVAR FILEPKGTYPES
 FILEPKGCOMS)
(PUTDEF (QUOTE FILEPKGCOMS) (QUOTE FILEPKGCOMS) (QUOTE ([COM CONTENTS (LAMBDA
							       (COM NAME TYPE)
							       (* Revert to NILL when no longer 
								  coercing PRETTYDEFMACROS to 
								  FILEPKGCOMS)
							       (AND (EQ TYPE (QUOTE FILEPKGCOMS))
								    (INFILECOMTAIL COM]
							(TYPE DESCRIPTION 
							      "file package commands/types"
							      GETDEF T))))
(PUTDEF (QUOTE ADVICE) (QUOTE FILEPKGCOMS) (QUOTE ((COM COM T)
						   (TYPE DESCRIPTION "advice"))))
(PUTDEF (QUOTE ALISTS) (QUOTE FILEPKGCOMS) [QUOTE ([COM MACRO (X (COMS * (MAKEALISTCOMS . X]
						   (TYPE DESCRIPTION "alist entries" WHENCHANGED
							 (ALISTS.WHENCHANGED])
(PUTDEF (QUOTE DEFS) (QUOTE FILEPKGCOMS) [QUOTE ((COM MACRO (X (COMS . X])
(PUTDEF (QUOTE EDITMACROS) (QUOTE FILEPKGCOMS) (QUOTE ((TYPE TYPE USERMACROS))))
(PUTDEF (QUOTE EXPRESSIONS) (QUOTE FILEPKGCOMS) (QUOTE ((TYPE DESCRIPTION "expressions" WHENCHANGED
							      (EXPRESSIONS.WHENCHANGED)
							      EDITDEF NILL))))
(PUTDEF (QUOTE FIELDS) (QUOTE FILEPKGCOMS) (QUOTE ((TYPE EDITDEF NILL))))
(PUTDEF (QUOTE FILES) (QUOTE FILEPKGCOMS) (QUOTE ([COM MACRO [X (P * (CONS (MAKEFILESCOMS . X]
						       CONTENTS
						       (LAMBDA (COM NAME TYPE)
							       (AND (EQ TYPE (QUOTE FILES))
								    (SUBSET (INFILECOMTAIL COM)
									    (FUNCTION LITATOM]
						  (TYPE EDITDEF NILL))))
(PUTDEF (QUOTE FILEPKGTYPES) (QUOTE FILEPKGCOMS) (QUOTE ((COM COM FILEPKGCOMS)
							 (TYPE TYPE FILEPKGCOMS))))
(PUTDEF (QUOTE FILEVARS) (QUOTE FILEPKGCOMS) (QUOTE ((COM MACRO (X (VARS . X)))
						     (TYPE EDITDEF NILL))))
(PUTDEF (QUOTE FNS) (QUOTE FILEPKGCOMS) (QUOTE ((COM COM T)
						(TYPE DESCRIPTION "functions"))))
(PUTDEF (QUOTE INITVARS) (QUOTE FILEPKGCOMS) (QUOTE ((COM COM T))))
(PUTDEF (QUOTE INITRECORDS) (QUOTE FILEPKGCOMS) [QUOTE ((COM MACRO (X (P * (RECORDALLOCATIONS . X)))
							     CONTENTS
							     (LAMBDA (COM NAME TYPE ONFILETYPE)
								     (AND (NULL ONFILETYPE)
									  (EQ TYPE (QUOTE RECORDS))
									  (INFILECOMTAIL COM])
(PUTDEF (QUOTE LISPXCOMS) (QUOTE FILEPKGCOMS) (QUOTE ((TYPE TYPE LISPXMACROS))))
(PUTDEF (QUOTE LISPXMACROS) (QUOTE FILEPKGCOMS) (QUOTE ((COM MACRO (X (COMS * (MAKELISPXMACROSCOMS . 
									      X)))
							     CONTENTS NILL)
							(TYPE DESCRIPTION "LISPX commands"))))
(PUTDEF (QUOTE MACROS) (QUOTE FILEPKGCOMS) (QUOTE
					     ([COM
						MACRO
						(X
						  (DECLARE:
						    EVAL@COMPILE
						    (PROPS
						      *
						      (MAPCAR (QUOTE X)
							      (FUNCTION
								(LAMBDA
								  (Y)
								  (CONS Y (OR (INTERSECTION
										(PROPNAMES Y)
										MACROPROPS)
									      (CAR MACROPROPS]
					      (TYPE DESCRIPTION "compiler macros" WHENCHANGED
						    (CLEARCLISPARRAY)
						    EDITDEF NILL))))
(PUTDEF (QUOTE PRETTYDEFMACROS) (QUOTE FILEPKGCOMS) (QUOTE ((COM COM FILEPKGCOMS))))
(PUTDEF (QUOTE PROPS) (QUOTE FILEPKGCOMS) [QUOTE ([COM MACRO (X (COMS * (MAKEPROPSCOMS . X]
						  (TYPE DESCRIPTION "property lists" WHENCHANGED
							(PROPS.WHENCHANGED])
(PUTDEF (QUOTE RECORDS) (QUOTE FILEPKGCOMS) (QUOTE ([COM MACRO (X (E (RECORDECLARATIONS . X))
								  (INITRECORDS . X))
							 CONTENTS
							 (LAMBDA
							   (COM NAME TYPE ONFILETYPE)
							   (AND (EQ TYPE (QUOTE FIELDS))
								(NULL ONFILETYPE)
								(MAPCONC (INFILECOMTAIL COM)
									 (FUNCTION
									   (LAMBDA
									     (X)
									     (APPEND (RECORDFIELDNAMES
										       X]
						    (TYPE DESCRIPTION "records"))))
(PUTDEF (QUOTE SYSRECORDS) (QUOTE FILEPKGCOMS) [QUOTE ((COM MACRO (X (E (SAVEONSYSRECLST . X)))
							    CONTENTS
							    (LAMBDA (COM NAME TYPE ONFILETYPE)
								    (AND (NULL ONFILETYPE)
									 (EQ TYPE (QUOTE RECORDS))
									 (INFILECOMTAIL COM])
(PUTDEF (QUOTE USERMACROS) (QUOTE FILEPKGCOMS) (QUOTE ((COM MACRO (X (COMS * (MAKEUSERMACROSCOMS . X))
								     )
							    CONTENTS NILL)
						       (TYPE DESCRIPTION "edit macros"))))
(PUTDEF (QUOTE VARS) (QUOTE FILEPKGCOMS) (QUOTE ((COM COM T)
						 (TYPE DESCRIPTION "variables"))))
(PUTDEF (QUOTE *) (QUOTE FILEPKGCOMS) (QUOTE ((COM CONTENTS NILL))))

(RPAQ? SAVEDDEFS
 )

(RPAQ? DEFAULTRENAMEMETHOD
 )
(* * EDITCALLERS)


(DEFINEQ

(FINDCALLERS

  [LAMBDA (ATOMS FILES)                                     (* lmm "30-SEP-78 01:36")

    (PROG ((X (EDITCALLERS
 ATOMS FILES T)))
          (RETURN (NCONC (DREVERSE (CDR X))
			 (AND (CAR X)
			      (LIST (CONS (COND
					    ((CDR X)
					      (QUOTE "plus other places on"))
					    (T (QUOTE on)))
					  (CAR X])

(EDITCALLERS

  [LAMBDA (ATOMS FILES COMS)       (* lmm " 4-JUN-83 23:41")

    (PROG (FFILEPOSPATTERNS I FNS OTHERSFILES EDITPATTERN NOMAPFLG)
          [SETQ FFILEPOSPATTERNS (for
 ATOM in
 (SETQ ATOMS (MKLIST ATOMS))
				    collect
 (CONCAT (COND
						      ((EQ (CHCON1 ATOM)
							   (CHARCODE ESCAPE))
							(SETQ ATOM (SUBSTRING ATOM 2 -1))
							"")
						      (T " "))
						    (COND
						      ((SETQ I (STRPOS (QUOTE )
								       ATOM))
							(SUBSTRING ATOM 1 (SUB1 I)))
						      (T ATOM))
						    (COND
						      (I "")
						      (T " "]
          (SETQ EDITPATTERN (EDITFPAT (CONS (QUOTE *ANY*)
					    ATOMS)))
          [for
 FILE in
 (COND
			 ((NULL FILES)
			   FILELST)
			 ((EQ FILES T)
			   (UNION SYSFILES FILELST))
			 ((LISTP FILES)
			   FILES)
			 (T (LIST FILES)))
	     do

	      (PROG (MAP FULL PRINTFLG)
		    (OR (SETQ FULL (FINDFILE FILE))
			(RETURN (LISPXPRINT (CONS FILE (QUOTE (not found)))
					    T T)))
		    (PRIN2 (SETQ FULL (INPUT (INFILE FULL)))
			   T T)
		    (PRIN1 ": " T)
		    (for
 PATTERN in
 FFILEPOSPATTERNS
		       do

			(SETFILEPTR FULL (SETQ I 0))
			(while
 (SETQ I (FFILEPOS PATTERN FULL I NIL NIL T (SEPRCASE
 DWIMIFYCOMPFLG)))
			   do

			    (COND
			      ((NULL PRINTFLG)
                                   (* cause the printing of the filename to be saved on history list)

				(SETQ PRINTFLG T)
				(LISPXPRIN2 FULL T T T)

          (* print with NODOFLG=T means just to record the printing; the idea is that only those files in which something is 

	  found will be remembered on the history list)



				(LISPXPRIN1 ": " T NIL T)))
			    [OR
			      [AND (NEQ MAP T)
				   (SOME (CDR (OR MAP [PROGN (SETFILEPTR FULL 0)
							     (SETQ MAP (OR (GETFILEMAP FULL FILE)
									   (LOADFILEMAP FULL]
						  (PROGN 
                                   (* file has no filemap)

							 (SETQ MAP (SETQ NOMAPFLG T))
							 (LISPXPRIN1 " no filemap!" T)
							 NIL)))
					 (FUNCTION (LAMBDA (X)
					     (AND (ILESSP (CAR X)
							  I)
						  (IGREATERP (CADR X)
							     I)
						  (SOME (CDDR X)
							(FUNCTION (LAMBDA (Z)
							    (COND
							      ((AND (ILESSP (CADR Z)
									    I)
								    (IGREATERP (CDDR Z)
									       I))
								[COND
								  ((NOT (FMEMB (CAR Z)
									       FNS))
								    (SETQ FNS
								      (CONS (LISPXPRIN2 (CAR Z)
											T T)
									    FNS]
								(SETQ I (CDDR Z))
								T]
			      (PROGN (LISPXPRIN2 I T T)
				     (OR (FMEMB FILE OTHERSFILES)
					 (SETQ OTHERSFILES (CONS FILE OTHERSFILES]
			    (LISPXSPACES 1 T)))
		    (CLOSEF FULL)
		    (COND
		      (PRINTFLG (LISPXTERPRI T))
		      (T (TERPRI T)))
		    (COND
		      ((NEQ COMS T)
			(COND
			  ((OR FNS OTHERSFILES)
			    (EDITFROMFILE
 (OR NOMAPFLG (DREVERSE FNS))
					  FULL EDITPATTERN COMS (NULL OTHERSFILES))
			    (SETQ OTHERSFILES)
			    (SETQ FNS]
          (COND
	    ((EQ COMS T)
	      (RETURN (CONS OTHERSFILES FNS])

(EDITFROMFILE

  [LAMBDA (FNS FILES EDITPATTERN EDITCOMS ONLYTYPES)         (* rmk: "11-Mar-85 14:08")

    (
RESETVARS
 [(EDITLOADFNSFLG (
COND

				  ((
EQ
 EDITLOADFNSFLG T)
				    (
QUOTE
 (T . NO)))
				  (T EDITLOADFNSFLG]
	       (
PROG
 NIL
		     [
OR
 EDITCOMS (
SETQ
 EDITCOMS (
LIST
 (
LIST
 (
QUOTE
 EXAM)
							     EDITPATTERN]
		     (
AND

		       (
SETQ
 FILES (for
 FILE inside
 (
OR
 FILES FILELST)
				      when
 (
OR
 (
AND
 EDITLOADFNSFLG (
FMEMB
 (
ROOTFILENAME
 FILE)
									  FILELST))
					       (
COND

						 ((
EQ
 (
QUOTE
 Y)
						      (
ASKUSER
 DWIMWAIT (
QUOTE
 Y)
							       (
LIST
 "load from" FILE)
							       NIL T))
						   (
LOADFROM
 FILE FNS (
QUOTE
 ALLPROP))
						   T)))
				      collect
 FILE))
		       (for
 TYPE in
 [
COND

				      ((
LISTP
 ONLYTYPES))
				      (ONLYTYPES (
QUOTE
 (FNS)))
				      (T 

          (* Move FNS to the front. This means that all the fns will be dwimified and editted before anything else 

	  (like a rename of fields) is done.)



					 (
CONS
 (
QUOTE
 FNS)
					       (
REMOVE
 (
QUOTE
 FNS)
						       FILEPKGTYPES]
			  when
 (
AND
 (
LITATOM
 TYPE)
				    (
NEQ
 (fetch
 EDITDEF of
 TYPE)
					 (
QUOTE
 NILL)))
			  do

			   (
PROG
 (SEEN)
			         (for
 FILE inside
 FILES
				    do

				     (for
 NAME in
 [
COND

						    ((
AND
 (
EQ
 TYPE (
QUOTE
 FNS))
							  (
NEQ
 FNS T))
                                                             (* for this type, we are given the list of items)

						      (
PROG1
 FNS (
SETQ
 FNS NIL)))
						    (T       (* only want the values of "TYPE" which are not part of

							     some other type)

						       (FILECOMSLST
 FILE TYPE (
QUOTE
 EDIT]
					unless
 (
MEMBER
 NAME SEEN)
					do

					 (
ERSETQ

					   (
PROG
 (DEF)
					         (
COND

						   ((
OR
 (
AND
 (
EQ
 TYPE (
QUOTE
 FNS))
							     (
NEQ
 FNS T))
							(
AND
 (
LISTP
 (
SETQ
 DEF (GETDEF
 NAME TYPE
										      (
QUOTE
 CURRENT)
										      0)))
							     (LOOKIN
 DEF EDITPATTERN)))
						     (
COND

						       ((
NULL
 SEEN)
							 (
LISPXPRIN1
 "editing the " T)
							 (
LISPXPRIN1
 (
OR
 (fetch
 DESCRIPTION
									    of
 TYPE)
									 TYPE)
								     T)
							 (
LISPXSPACES
 1 T)))
						     (
SETQ
 SEEN (
CONS
 NAME SEEN))
						     (
LISPXPRIN2
 NAME T T)
						     (
LISPXPRIN1
 ":
" T)
						     (
COND

						       ((
NOT

							   (
ERSETQ

							     (EDITDEF

							       NAME TYPE
							       (
OR
 (
AND
 DEF (
CONS
 (
QUOTE
 =)
										  DEF))
								   FILE)
							       EDITCOMS)))
							 (
LISPXPRIN1
 "failed" T)))
						     (
LISPXTERPRI
 T])

(FINDATS

  [LAMBDA (X L)                                             (* lmm "11-FEB-78 16:03")

    (COND
      ((NLISTP X)
	(FMEMB X L))
      (T (OR (FINDATS
 (CAR X)
		      L)
	     (FINDATS
 (CDR X)
		      L])

(LOOKIN

  [LAMBDA (X PAT)                                           (* lmm "11-MAR-78 14:20")

    (COND
      ([AND (EQ (CAR PAT)
		(QUOTE *ANY*))
	    (EVERY (CDR PAT)
		   (FUNCTION (LAMBDA (X)
		       (AND (LITATOM X)
			    (NOT (STRPOS (QUOTE )
					 X]
	(FINDATS
 X (CDR PAT)))
      (T (EDITFINDP X PAT T])
)
(DEFINEQ

(SEPRCASE

  [LAMBDA (CLFLG)                                           (* rmk: "19-FEB-83 22:42")

                                                            (* make a case array for FFILEPOS in which all of the 

							    seprs, breaks, and (possibly) clisp chars are all 

							    equivalent)

    (OR (COND
	  (CLFLG (ARRAYP CLISPCASE))
	  (T (ARRAYP SEPRCASE)))
	(for
 X (CA _(CASEARRAY)) in
 (NCONC (AND CLFLG (for
 Y in
 CLISPCHARS collect
 (CHCON1 Y)))
					   (GETSEPR FILERDTBL)
					   (GETBRK FILERDTBL))
	   do
 (SETCASEARRAY CA X 0) finally
 (RETURN (COND
						      (CLFLG (SETQ CLISPCASE CA))
						      (T (SETQ SEPRCASE CA])
)

(RPAQ? SEPRCASE
 )

(RPAQ? CLISPCASE
 )
(MOVD? (QUOTE INFILEP)
       (QUOTE FINDFILE))
(* "or else from SPELLFILE")
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: FINDATS FINDATS)
(BLOCK: EDITFROMFILE EDITFROMFILE LOOKIN (GLOBALVARS EDITLOADFNSFLG)
	(NOLINKFNS LOADFROM))
(BLOCK: NIL SEPRCASE FINDCALLERS EDITCALLERS (LOCALVARS . T)
	(GLOBALVARS SYSFILES CLISPCASE SEPRCASE CLISPFLG CLISPCHARS FCHARAR))
]
(* * EXPORT)


(DEFINEQ

(IMPORTFILE

  (LAMBDA (FILE RETURNFLG)                                   (* JonL "20-Jul-84 03:23")

    (DECLARE
 (GLOBALVARS EXPORTDEFSTRING))                   (* This is not a literal so that filepkg can be 

							     imported. Not a constant cause it is used in the EXPORT 

							     command.)

    (SETQ FILE (OPENFILE FILE (QUOTE INPUT)))
    (PROG1 (NCONC (RESETFORM (INPUT FILE)
			     (RESETVARS (FILEPKGFLG DFNFLG MSDATABASELST (NORMALCOMMENTSFLG T))
				        (RETURN (while
 (FFILEPOS EXPORTDEFSTRING FILE NIL NIL NIL T)
						   bind
 DEF join
 (until
 (EQUAL (SETQ DEF
										 (READ FILE FILERDTBL)
										 )
									       (QUOTE (* END EXPORTED 
										      DEFINITIONS)))
								    join
 (IMPORTEVAL
 DEF RETURNFLG))))
			       ))
		  (IMPORTEVAL
 (LIST (QUOTE PUTPROP)
				    (KWOTE (ROOTFILENAME FILE))
				    (QUOTE (QUOTE IMPORTDATE))
				    (LIST (QUOTE IDATE)
					  (GETFILEINFO FILE (QUOTE CREATIONDATE))))
			      RETURNFLG))
	   (CLOSEF? FILE))))

(IMPORTEVAL

  [LAMBDA (FORM RETURNFLG)                                  (* lmm " 7-MAY-81 00:03")

                                                            (* Ignore DONTEVAL@LOAD'S -

							    If RETURNFLG is on, return list of forms)

    (AND (LISTP FORM)
	 (COND
	   ((EQ (CAR FORM)
		(QUOTE DECLARE:))
	     (for
 Z in
 (CDR FORM) join
 (IMPORTEVAL
 Z RETURNFLG)))
	   (T (AND (NEQ RETURNFLG T)
		   (EVAL FORM))
	      (AND RETURNFLG (LIST FORM])

(CHECKIMPORTS

  [LAMBDA (FILES NOASKFLG)                                  (* rmk: "19-FEB-83 16:31")

                                                            (* Loads exported definitions from new versions of 

							    FILES.)

    (COND
      ((AND (SETQ FILES (for
 FILE inside
 FILES bind
 FULLFILENAME DATE
			   when
 [AND (SETQ FULLFILENAME (FINDFILE FILE T))
				     (OR [NOT (SETQ DATE (GETPROP (ROOTFILENAME
 FILE)
								  (QUOTE IMPORTDATE]
					 (NOT (IEQP DATE (GETFILEINFO FULLFILENAME (QUOTE 
										    ICREATIONDATE]
			   collect
 (LIST FILE FULLFILENAME)))
	    (OR NOASKFLG (SELECTQ (ASKUSER 5 (QUOTE Y)
					   (LIST "load new exports from "
						 (MAPCAR FILES (FUNCTION CAR)))
					   (QUOTE ((Y "es
")
						    (N "o
")))
					   T)
				  (N NIL)
				  T)))
	(for
 FILE in
 FILES do
 (IMPORTFILE
 (CADR FILE])

(GATHEREXPORTS

  [LAMBDA (FROMFILES TOFILE FLG)                             (* rmk: "18-Feb-85 15:33")

                                                             (* Copies all exported definitions from FROMFILES to 

							     TOFILE.)

    (
RESETLST
 [
RESETSAVE
 (
OUTFILE
 TOFILE)
			 (
QUOTE
 (
PROGN
 (
CLOSEF?
 (
OUTPUT
 OLDVALUE]
	      (printout
 NIL "(LISPXPRIN1 %"EXPORTS GATHERED FROM " (
DIRECTORYNAME
 T)
			" ON "
			(
DATE
)
			"%"  T)" T "(LISPXTERPRI T)" T)
	      (for
 F inside
 FROMFILES
		 do
 (if
 (
SETQ
 F (
FINDFILE
 F T))
			then
 (
MAPC
 (IMPORTFILE
 F (
OR
 FLG T))
				   (
FUNCTION
 PRINT))
		      else
 (printout
 NIL T "(HELP (QUOTE " .P2 F 
				     ") %"File not found during GATHEREXPORTS%")"))
		    (
TERPRI
))
	      (
PRINT
 (
QUOTE
 STOP))
	      (
TERPRI
)
	      (
OUTPUT
])
)
(PUTDEF (QUOTE EXPORT) (QUOTE FILEPKGCOMS) [QUOTE ((COM MACRO (X (E (PRIN1 EXPORTDEFSTRING)
								    (TERPRI)
								    (TERPRI)
								    (TERPRI))
								 (COMS . X)
								 (E (PRIN1 
							       "

(* END EXPORTED DEFINITIONS)

"])

(RPAQ? EXPORTDEFSTRING
 (CONCAT "(* FOLLOWING " "DEFINITIONS EXPORTED)"))
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: IMPORTFILE IMPORTFILE IMPORTEVAL)
]
(* * for GAINSPACE)


(DEFINEQ

(CLEARFILEPKG

  [LAMBDA (FLG)                                             (* rmk: "19-FEB-83 14:07")

    (PROG NIL
          (SELECTQ FLG
		   ((NIL T))
		   (SETQ SMASHPROPSLST1 (CONS (QUOTE FILEMAP)
					      SMASHPROPSLST1)))
          (COND
	    ((SELECTQ FLG
		      ((E T)
			T)
		      (Y (TERPRI T)
			 (PRIN1 "you can delete just the filemaps -
" T)
			 (PROG1 [ASKUSER NIL NIL "are you sure you want to delete EVERYTHING ? "
					 (QUOTE ((Y "es - everything" RETURN T)
						  (N "o - just the filemaps" RETURN NIL)
						  (E "verything" RETURN T)
						  (F "ilemaps only" RETURN NIL]
				(TERPRI T)))
		      NIL)
	      (UPDATEFILES
)
	      [SETQ FILELST (SUBSET FILELST (FUNCTION (LAMBDA (FILE)
					(COND
					  ((fetch
 TOBEDUMPED of
 (fetch
 FILEPROP of
 FILE))
					    (PRINT FILE T T)
					    (PRIN1 " has changes, not wiped." T)
					    (TERPRI T)
					    T)
					  (T (replace
 FILEPROP of
 FILE with
 NIL)
					     (replace
 FILECHANGES of
 FILE with
 NIL)
					     (replace
 FILEMAP of
 FILE with
 NIL)
					     (SMASHFILECOMS
 FILE)
					     (NCONC1 SYSFILES FILE)
					     NIL]
	      (SETQ LOADEDFILELST])
)

(ADDTOVAR GAINSPACEFORMS
 (FILELST "erase filepkg information" (CLEARFILEPKG RESPONSE)
				  ((Y "es")
				   (N "o")
				   (E . "verything")
				   (F "ilemaps only
"))))
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: NIL CLEARFILEPKG (GLOBALVARS SMASHPROPSLST1))
]
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS #LISTFILESCHARS #UNDOSAVES ADDTOFILEKEYLST BUILDMAPFLG CLEANUPOPTIONS CLISPARRAY 
	    CLISPIFYPRETTYFLG COMPILE.EXT DECLARETAGSLST DEFAULTRENAMEMETHOD DFNFLG DWIMESSGAG 
	    DWIMFLG DWIMIFYCOMPFLG DWIMLOADFNSFLG DWIMWAIT FILELST FILEPKGCOMSPLST FILEPKGFLG 
	    FILEPKGTYPES FILERDTBL FONTCHANGEFLG HISTORYCOMS HISTSTR0 I.S.OPRLST LASTFILE LISPXCOMS 
	    LISPXHISTORY LISPXHISTORYMACROS LISPXMACROS LISTFILESTR LOADEDFILELST MACROPROPS 
	    MAKEFILEFORMS MAKEFILEOPTIONS MAKEFILEREMAKEFLG MSDATABASELST NOSPELLFLG NOTCOMPILEDFILES 
	    NOTLISTEDFILES PRETTYDEFMACROS PRETTYFLG PRETTYHEADER PRETTYTRANFLG PRETTYTYPELST 
	    SAVEDDEFS SYSFILES SYSPROPS USERMACROS USERRECLST USERWORDS)
)



(* RESOURCE "management")


(DECLARE: EVAL@COMPILE 

(PUTPROPS INITRESOURCE MACRO
 (X (
\GR.METHODEXPANDER
 X (
QUOTE
 INIT))))

(PUTPROPS NEWRESOURCE MACRO
 (X (
\GR.METHODEXPANDER
 X (
QUOTE
 NEW))))

(PUTPROPS GETRESOURCE MACRO
 (X (
\GR.METHODEXPANDER
 X (
QUOTE
 GET))))

(PUTPROPS FREERESOURCE MACRO
 (X (
\GR.METHODEXPANDER
 X (
QUOTE
 FREE))))

(PUTPROPS WITH-RESOURCE MACRO
 (= . WITH-RESOURCES))

(PUTPROPS WITH-RESOURCES MACRO
 (X (
\GR.WITHRESOURCEMAC
 X)))
)
(DEFINEQ

(\GR.METHODEXPANDER

  (LAMBDA (X METHOD)                                         (* JonL " 8-Oct-84 16:05")

    (
PROG
 (DEF RVAR (NAME (
OR
 (
CAR
 (
LISTP
 X))
			      X)))
          (
RETURN
 (if
 (
NULL
 (
SETQ
 DEF (
LISTGET
 (
SETQ
 DEF (GETDEF
 NAME (
QUOTE
 RESOURCES)))
					       METHOD)))
		      then
                                   (* Although these could all be implemented by 

							     functions, this is the default 

							     (and common) case; so just put in-line here.)

			   (
SETQ
 RVAR (
PACK*
 (
QUOTE
 \)
					     NAME
					     (
QUOTE
 .GLOBALRESOURCE)))
			   (
SELECTQ
 METHOD
				    (GET (
BQUOTE
 (
PROGN
 (DECLARE
 (
GLOBALVARS
 , RVAR))
							(
COND

							  (, RVAR (
PROG1
 , RVAR (
SETQ
 , RVAR NIL)))
							  (T (NEWRESOURCE , NAME))))))
				    (FREE (
BQUOTE
 (
PROGN
 (DECLARE
 (
GLOBALVARS
 , RVAR))
							 (
SETQ
 , RVAR , (
CADR
 X)))))
				    (INIT (
BQUOTE
 (
/SETTOPVAL
 (
QUOTE
 , RVAR))))
				    (NEW (
ERROR
 "No NEW method for resource" NAME))
				    (
SHOULDNT
))
		    elseif
 (
FNTYP
 DEF)
		      then
 (
APPLY
 DEF X)
		    elseif
 (
LISTP
 DEF)
		      then
 (
SUBPAIR
 (
QUOTE
 (RESOURCENAME ARGS))
				    (
LIST
 NAME (
CDR
 X))
				    DEF)
		    else
 (
ERROR
 (
CONCAT
 "Bad resource " METHOD " method for " NAME)
				DEF))))))

(\GR.WITHRESOURCEMAC

  [LAMBDA (X)                                                (* rmk: "15-Jun-84 10:51")

    (PROG [(NAMES (MKLIST (CAR X)))
	   (FORMS (\DECL.COMNT.PROCESS (CDR X]
          (RETURN (CONS [CONS (QUOTE LAMBDA)
			      (CONS NAMES (APPEND (CAR FORMS)
						  (CADR FORMS)
						  (LIST (CONS (QUOTE PROG1)
							      (CONS (CONS (QUOTE PROGN)
									  (CDDR FORMS))
								    (for
 NAME in
 NAMES
								       collect
 (LIST (QUOTE 
										     FREERESOURCE)
										     NAME NAME]
			(for
 NAME in
 NAMES collect
 (LIST (QUOTE GETRESOURCE)
							 NAME])
)
(PUTDEF (QUOTE RESOURCES) (QUOTE FILEPKGCOMS) (QUOTE ((COM MACRO [X (DECLARE: EVAL@COMPILE
									      (P * (
									      \GR.MAKEPRETTYCOMSL . X]
							   CONTENTS \GR.CONTENTS)
						      (TYPE DESCRIPTION "global resources" GETDEF 
							    \GR.GETDEFFN PUTDEF \GR.PUTDEFFN DELDEF 
							    \GR.DELDEFFN))))
(PUTDEF (QUOTE INITRESOURCES) (QUOTE FILEPKGCOMS) (QUOTE ((COM MACRO (X (P * (\IGR.MAKEPRETTYCOMSL . 
									     X)))
							       CONTENTS \GR.CONTENTS))))
(DEFINEQ

(\GR.GETDEFFN

  [LAMBDA (NAME TYPE)                                        (* rmk: "14-Jun-84 22:39")

    (CDR (ASSOC NAME GLOBAL.RESOURCES])

(\GR.PUTDEFFN

  (LAMBDA (NAME TYPE DEF)                                    (* JonL "20-Jul-84 03:31")

    (if
 (OR (NULL NAME)
	    (NOT (LITATOM NAME)))
	then
 (ERRORX (LIST 14 NAME)))
    (if
 (AND (LISTP DEF)
	     (NOT (LISTGET DEF (QUOTE NEW))))
	then
 

          (* * Conversion from old format -- to be flushed soon after CAROL release. Jonl 5/14/84)



	     (SETQ DEF (LIST (QUOTE NEW)
			     DEF))
      elseif
 (AND DEF (NOT (LISTGET (LISTP DEF)
				    (QUOTE NEW))))
	then
 (ERROR "No NEW method for resource" NAME))      (* Note that the variable GLOBAL.RESOURCES has been 

							     GLOBALVAR'd by the file COMS)

    (if
 (NULL DEF)
	then
 (\GR.DELDEFFN
 NAME TYPE)
      else
 (PROG NIL
	         (MARKASCHANGED
 NAME (QUOTE RESOURCES)
				(if
 (SETQ TYPE (ASSOC NAME GLOBAL.RESOURCES))
				    then
                     (* The initialization has to be performed regardless of 

							     whether or not the definition has changed.)

					 (EVAL (\GR.METHODEXPANDER
 NAME (QUOTE INIT)))
					 (AND (EQUAL DEF (CDR TYPE))
					      (RETURN))
					 (/RPLACD TYPE DEF)
					 (QUOTE CHANGED)
				  else
 (/SETTOPVAL (QUOTE GLOBAL.RESOURCES)
						   (CONS (CONS NAME DEF)
							 GLOBAL.RESOURCES))
				       (EVAL (\GR.METHODEXPANDER
 NAME (QUOTE INIT)))
				       (QUOTE DEFINED)))))
    NAME))

(\GR.DELDEFFN

  [LAMBDA (NAME TYPE)                                        (* rmk: "15-Jun-84 11:23")

    (if
 (NOT (AND NAME (LITATOM NAME)))
	then
 (ERRORX (LIST 14 NAME)))
    (PROG ((DEF (ASSOC NAME GLOBAL.RESOURCES)))
          (if
 DEF
	      then
 (MARKASCHANGED
 NAME (QUOTE RESOURCES)
				  (QUOTE DELETED))
		   (/SETTOPVAL (QUOTE GLOBAL.RESOURCES)
			       (REMOVE DEF GLOBAL.RESOURCES))
		   (if
 (NULL (LISTGET (CDR DEF)
				      (QUOTE GET)))
		       then
                                  (* Help clean up mess left by the default case)

			    (/SETTOPVAL (PACK* (QUOTE \)
					       NAME
					       (QUOTE .GLOBALRESOURCE))
					(QUOTE NOBIND)))
		   (RETURN T])

(\GR.CONTENTS

  [LAMBDA (COM NAME TYPE)                                    (* rmk: "14-Jun-84 22:29")

    (COND
      ((EQ TYPE (QUOTE RESOURCES))
	[SETQ COM (COND
	    ((EQ (CAR (LISTP (CDR COM)))
		 (QUOTE *))
	      (EVAL (CADDR COM)))
	    (T (CDR COM]
	(COND
	  ((EQ NAME T)
	    (AND COM T))
	  ((AND NAME (LITATOM NAME))
	    (AND [find
 X in
 COM suchthat
 (EQ NAME (COND
					       ((LISTP X)
						 (CAR X))
					       (T X]
		 T))
	  (T (MAPCAR COM (FUNCTION (LAMBDA (X)
			 (COND
			   ((LISTP X)
			     (CAR X))
			   (T X])

(\GR.GvarInitLst

  (LAMBDA (NAME)                                             (* JonL "21-Oct-84 15:50")

    (
BQUOTE
 (
/SETTOPVAL
 (
QUOTE
 , (
MKATOM
 (
CONCAT
 "\RESOURCE." NAME ".LST")))
			(
LIST
 NIL)))))
)
(DEFINEQ

(\GR.MAKEPRETTYCOMSL

  [NLAMBDA L                                                 (* rmk: "14-Jun-84 22:31")

    [COND
      ((EQ (CAR (LISTP L))
	   (QUOTE *))
	(SETQ L (EVAL (CADR L]
    (for
 Y NAME DEF in
 L
       collect
 [COND
		 [(LISTP Y)
		   (SETQ NAME (CAR Y))
		   (SETQ DEF (CAR (LISTP (CDR Y]
		 (T (SETQ NAME Y)
		    (SETQ DEF (GETDEF
 NAME (QUOTE RESOURCES]
	       (OR (AND NAME (LITATOM NAME))
		   (ERROR "Bad filepkg command" L))
	       (SUBPAIR (QUOTE (NAME DEF))
			(LIST NAME DEF)
			(QUOTE (PUTDEF
 (QUOTE NAME)
				       (QUOTE RESOURCES)
				       (QUOTE DEF])

(\IGR.MAKEPRETTYCOMSL

  (NLAMBDA L                                                 (* JonL "24-Oct-84 18:49")

    (if
 (
EQ
 (
CAR
 (
LISTP
 L))
	    (
QUOTE
 *))
	then
 (
SETQ
 L (
EVAL
 (
CADR
 L))))
    (for
 NAME in
 L collect
 (
LISPFORM.SIMPLIFY
 (
LIST
 (
QUOTE
 INITRESOURCE)
						    NAME)
					      T))))
)

(RPAQ? GLOBAL.RESOURCES
 )
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS GLOBAL.RESOURCES)
)

(PUTPROPS INITRESOURCE ARGNAMES
 ("<RESOURCENAME>" . ARGS))

(PUTPROPS NEWRESOURCE ARGNAMES
 ("<RESOURCENAME>" . ARGS))

(PUTPROPS GETRESOURCE ARGNAMES
 ("<RESOURCENAME>" . ARGS))

(PUTPROPS FREERESOURCE ARGNAMES
 ("<RESOURCENAME>" DATUM . ARGS))



(* "need only be in ABC")


(DECLARE: EVAL@COMPILE 

(PUTPROPS GLOBALRESOURCE MACRO
 (= . WITH-RESOURCES))

(PUTPROPS GLOBALRESOURCES MACRO
 (= . WITH-RESOURCES))
)
(PUTDEF (QUOTE GLOBALRESOURCES) (QUOTE FILEPKGCOMS) (QUOTE ((COM MACRO (X (DECLARE: DONTCOPY
										    (RESOURCES . X))
									  (INITRESOURCES . X)))
							    (TYPE TYPE RESOURCES))))
(DECLARE: EVAL@COMPILE 

(PUTPROPS RELEASERESOURCE MACRO
 [ARGS ([LAMBDA (RVALVAR)
					  (
OR
 (
AND
 (
LITATOM
 RVALVAR)
						   RVALVAR
						   (
NEQ
 T RVALVAR))
					      (
ERROR
 "Must RELEASERESOURCE from a variable" ARGS]
					(
CADR
 ARGS))
				      (
SUBPAIR
 (
QUOTE
 (RNAME RVALVAR . FORMS))
					       ARGS
					       (
QUOTE
 (
PROGN
 (FREERESOURCE RNAME RVALVAR)
							     (
PROG1
 (
PROGN
 . FORMS)
								    (
SETQ
 RVALVAR (GETRESOURCE RNAME])
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA
 \IGR.MAKEPRETTYCOMSL \GR.MAKEPRETTYCOMSL MAKEUSERMACROSCOMS MAKEPROPSCOMS 
				     MAKELISPXMACROSCOMS MAKEFILESCOMS MAKEALISTCOMS APPENDTOVAR 
				     ADDTOVAR PUTPROPS LISTFILES COMPILEFILES CLEANUP PRETTYDEFMACROS 
				     FILEPKGCOMPROPS)

(ADDTOVAR NLAML
 )

(ADDTOVAR LAMA
 FILEPKGTYPE FILEPKGCOM FILEPKGCHANGES)
)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: DELFROMCOMS DELFROMCOMS DELFROMCOM DELFROMCOM1 REMOVEITEM (NOLINKFNS . T)
	(SPECVARS COMSNAME))
(BLOCK: MERGEINSERT MERGEINSERT MERGEINSERT1 (NOLINKFNS . T))
(BLOCK: ADDTOFILEBLOCK ADDTOFILES? ADDTOFILE WHATIS ADDTOCOMS ADDTOCOM ADDTOCOM1 ADDNEWCOM
	(NOLINKFNS . T)
	(SPECVARS COMSNAME)
	(ENTRIES ADDTOFILE ADDTOCOMS ADDTOFILES?))
(BLOCK: INFILECOMS? INFILECOMS? INFILECOMTAIL INFILECOMS INFILECOM INFILECOMSVAL INFILECOMSVALS 
	INFILEPAIRS INFILECOMSMACRO IFCPROPS IFCEXPRTYPE IFCPROPSCAN IFCDECLARE
	(LOCALFREEVARS NAME LITERALS VAL TYPE ONFILETYPE ORIGFLG)
	INFILECOMSPROP
	(GLOBALVARS DWIMLOADFNSFLG))
(BLOCK: NIL MAKEFILE (LOCALVARS . T)
	(SPECVARS FILE OPTIONS REPRINTFNS SOURCEFILE FILETYPE FILEDATES CHANGES))
(BLOCK: ADDFILE ADDFILE ADDFILE0 (NOLINKFNS . T)
	(GLOBALVARS ADDSPELLFLG))
(BLOCK: FILEPKGCHANGES FILEPKGCHANGES (NOLINKFNS . T))
(BLOCK: NIL ADDTOVAR APPENDTOVAR ALISTS.WHENCHANGED CHANGECALLERS CLEANUP CLEARCLISPARRAY COMPARE 
	COMPAREDEFS COMPILEFILES COMPILEFILES0 CONTINUEDIT COPYDEF DEFAULTMAKENEWCOM DELFROMFILES 
	EDITDEF EXPRESSIONS.WHENCHANGED FILECOMS FILECOMSLST FILEFNSLST FILEPKGCOM FILEPKGCOMPROPS 
	FILEPKGTYPE FILES? FILES?1 GETFILEPKGTYPE HASDEF INFILECOMTAIL LOADDEF MAKEALISTCOMS 
	MAKEFILE1 MAKEFILES MAKEFILESCOMS MAKELISPXMACROSCOMS MAKENEWCOM MAKEPROPSCOMS 
	MAKEUSERMACROSCOMS MARKASCHANGED MOVETOFILE POSTEDITPROPS PREEDITFN PRETTYDEFMACROS 
	PROPS.WHENCHANGED PUTDEF PUTPROPS RENAME SAVEDEF SAVEPUT SEARCHPRETTYTYPELST SHOWDEF 
	SMASHFILECOMS TYPESOF UNMARKASCHANGED UNSAVEDEF UPDATEFILES
	(GLOBALVARS #UNDOSAVES SYSFILES MARKASCHANGEDSTATS ADDSPELLFLG COMPILE.EXT EDITMACROS 
		    EDITLOADFNSFLG LOADOPTIONS)
	(LOCALVARS . T))
(BLOCK: DELDEF DELDEF DELFROMLIST (NOLINKFNS . T))
(BLOCK: GETDEF GETDEF DWIMDEF GETDEFCOM GETDEFCOM0 GETDEFERR GETDEFCURRENT GETDEFFROMFILE GETDEFSAVED
	(RETFNS GETDEFCOM)
	(NOLINKFNS . T)
	(GLOBALVARS NOT-FOUNDTAG))
]
(PUTPROPS FILEPKG COPYRIGHT ("Xerox Corporation" T 1982 1983 1984 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (10086 10298 (FILEPKGCOMPROPS 10096 . 10296)) (16692 17673 (SEARCHPRETTYTYPELST 16702 . 
17334) (PRETTYDEFMACROS 17336 . 17671)) (18023 42230 (CLEANUP 18033 . 19096) (COMPILEFILES 19098 . 
19359) (COMPILEFILES0 19361 . 19836) (CONTINUEDIT 19838 . 20707) (MAKEFILE 20709 . 30141) (FILECHANGES
 30143 . 32067) (FILEPKG.MERGECHANGES 32069 . 32615) (FILEPKG.CHANGEDFNS 32617 . 32925) (MAKEFILE1 
32927 . 34240) (MAKEFILES 34242 . 35185) (ADDFILE 35187 . 37677) (ADDFILE0 37679 . 41475) (LISTFILES 
41477 . 42228)) (42715 65865 (FILEPKGCHANGES 42725 . 43568) (GETFILEPKGTYPE 43570 . 45111) (
MARKASCHANGED 45113 . 47199) (FILECOMS 47201 . 47547) (WHEREIS 47549 . 48234) (SMASHFILECOMS 48236 . 
48476) (FILEFNSLST 48478 . 48622) (FILECOMSLST 48624 . 49024) (UPDATEFILES 49026 . 52180) (INFILECOMS?
 52182 . 53790) (INFILECOMTAIL 53792 . 54288) (INFILECOMS 54290 . 54449) (INFILECOM 54451 . 60824) (
INFILECOMSVALS 60826 . 60994) (INFILECOMSVAL 60996 . 61658) (INFILECOMSPROP 61660 . 62188) (IFCPROPS 
62190 . 63032) (IFCEXPRTYPE 63034 . 63539) (IFCPROPSCAN 63541 . 64223) (IFCDECLARE 64225 . 64813) (
INFILEPAIRS 64815 . 65071) (INFILECOMSMACRO 65073 . 65863)) (65897 85935 (FILES? 65907 . 66814) (
FILES?1 66816 . 67749) (ADDTOFILES? 67751 . 74026) (ADDTOFILE 74028 . 74886) (WHATIS 74888 . 76513) (
ADDTOCOMS 76515 . 77765) (ADDTOCOM 77767 . 81629) (ADDTOCOM1 81631 . 82538) (ADDNEWCOM 82540 . 83435) 
(MAKENEWCOM 83437 . 84902) (DEFAULTMAKENEWCOM 84904 . 85933)) (85971 88097 (MERGEINSERT 85981 . 87704)
 (MERGEINSERT1 87706 . 88095)) (88990 95331 (DELFROMFILES 89000 . 89698) (DELFROMCOM 89700 . 92356) (
DELFROMCOM1 92358 . 92991) (DELFROMCOMS 92993 . 94036) (REMOVEITEM 94038 . 94573) (MOVETOFILE 94575 . 
95329)) (95653 102275 (SAVEPUT 95663 . 97670) (PUTPROPS 97672 . 98022) (ADDTOVAR 98024 . 100124) (
APPENDTOVAR 100126 . 102273)) (102276 107424 (UNMARKASCHANGED 102286 . 103407) (PREEDITFN 103409 . 
104828) (POSTEDITPROPS 104830 . 106298) (POSTEDITALISTS 106300 . 107422)) (107553 113783 (
ALISTS.WHENCHANGED 107563 . 108076) (CLEARCLISPARRAY 108078 . 108689) (EXPRESSIONS.WHENCHANGED 108691
 . 109201) (MAKEALISTCOMS 109203 . 109923) (MAKEFILESCOMS 109925 . 110984) (MAKELISPXMACROSCOMS 110986
 . 111884) (MAKEPROPSCOMS 111886 . 112330) (MAKEUSERMACROSCOMS 112332 . 113337) (PROPS.WHENCHANGED 
113339 . 113781)) (115939 120455 (RENAME 115949 . 117152) (CHANGECALLERS 117154 . 120453)) (120456 
155779 (SHOWDEF 120466 . 121110) (COPYDEF 121112 . 122581) (GETDEF 122583 . 124579) (GETDEFCOM 124581
 . 125499) (GETDEFCOM0 125501 . 126384) (GETDEFCURRENT 126386 . 130817) (GETDEFERR 130819 . 131965) (
GETDEFFROMFILE 131967 . 137819) (GETDEFSAVED 137821 . 138662) (PUTDEF 138664 . 141781) (EDITDEF 141783
 . 143914) (LOADDEF 143916 . 144097) (DWIMDEF 144099 . 144698) (DELDEF 144700 . 147182) (DELFROMLIST 
147184 . 147484) (HASDEF 147486 . 150897) (GETFILEDEF 150899 . 151386) (SAVEDEF 151388 . 152492) (
UNSAVEDEF 152494 . 153210) (COMPAREDEFS 153212 . 154690) (COMPARE 154692 . 155343) (TYPESOF 155345 . 
155777)) (155939 161947 (FILEPKGCOM 155949 . 158881) (FILEPKGTYPE 158883 . 161945)) (166337 173197 (
FINDCALLERS 166347 . 166691) (EDITCALLERS 166693 . 169730) (EDITFROMFILE 169732 . 172637) (FINDATS 
172639 . 172867) (LOOKIN 172869 . 173195)) (173198 173895 (SEPRCASE 173208 . 173893)) (174338 177670 (
IMPORTFILE 174348 . 175389) (IMPORTEVAL 175391 . 175873) (CHECKIMPORTS 175875 . 176765) (GATHEREXPORTS
 176767 . 177668)) (178114 179323 (CLEARFILEPKG 178124 . 179321)) (180858 182924 (\GR.METHODEXPANDER 
180868 . 182305) (\GR.WITHRESOURCEMAC 182307 . 182922)) (183409 186472 (\GR.GETDEFFN 183419 . 183568) 
(\GR.PUTDEFFN 183570 . 184960) (\GR.DELDEFFN 184962 . 185678) (\GR.CONTENTS 185680 . 186237) (
\GR.GvarInitLst 186239 . 186470)) (186473 187460 (\GR.MAKEPRETTYCOMSL 186483 . 187097) (
\IGR.MAKEPRETTYCOMSL 187099 . 187458)))))
STOP