h36078

s 00200/00000/00000

d D 1.1 91/03/08 04:49:02 hopkins 1 0

c date and time created 91/03/08 04:49:02 by hopkins

e

u

U

f e 0

t

T

I 1

systemdict /collapse known not {
	systemdict /collapse false put
} if

%----------------------------------------------
% class manager
%

/class_mgr growabledict begin
/ParentDictArray nullarray def
/class_mgr {/class_mgr where pop} def
/superclass null def
/superclasses nullarray def
/classname /class_mgr def

%----------------------------------------------
% class_shared
%

/class_shared dictbegin
/superclass null def
/superclasses nullarray def
/classname /class_shared def
/obsolete nullproc def

/new {		% -- instance
	//collapse {[superclass]} {superclasses} ifelse [currentdict] append
	dictbegin /ParentDictArray exch def dictend
} def

/compile {	% --
	ps_script length 0 ne {
		{ 
			currentprocess /ProcessName (Script Compiler) put
			currentprocess /ErrorDetailLevel 1 put
			{ps_script cvx exec} stopped {
				currentprocess /$error get
			} {null} ifelse
		} fork waitprocess dup null ne {
			/$error exch def
		} {pop} ifelse
	} if
} def

dictend def

%----------------------------------------------
% class_class
%

/class_class dictbegin
/superclass null def
/superclasses nullarray def
/classname /class_class def
/obsolete nullproc def

/new {	% pdb-script ps-script -- shared-class
	null shared {
		% pdb ps null object null
		pop dup /ps_script get 3 index eq {
			dup /pdb_script get 4 index eq {
				exch pop exit
			} {pop} ifelse
		} {pop} ifelse
	} forall 
	dup null eq {
		pop 
		currentdict growabledict begin
		harden
		/superclass 1 index def
		/classname 1 index /classname get def
		dup /superclasses get [3 -1 roll] append
		/superclasses 1 index def
		/ParentDictArray 
			ParentDictArray [//class_shared] append 
			3 -1 roll append def
		/ps_script exch def
		/pdb_script exch def
		currentdict end

		shared 1 index soften null put
		dup class_mgr /addclient ObsoleteService send
		/compile 1 index send
		readonly
	} {3 1 roll pop pop harden} ifelse
} def

%----------------------------------------------
% defining the super class
%

/superclass {	% name --
	find_class dup null ne {
		//collapse {dup {def} forall} if
		/superclass 1 index def
		dup /superclasses get [3 -1 roll] append 
		/superclasses 1 index def
		/ParentDictArray ParentDictArray 3 -1 roll append def
		currentdict dictbegin
		{currentfile cvx exec} 1 index send
		dictend pop pop
	} {pop} ifelse
} def

%----------------------------------------------
% persistent variables
%

/persist {	% var --
	persistent 1 index arraycontains? {pop} {
		/persistent persistent [4 -1 roll] append def
	} ifelse
} def

/unpersist {	% var --
	[exch persistent {
		2 copy eq {pop exit} {exch} ifelse
	} forall pop]
	/persistent exch def
} def

dictend def

%----------------------------------------------
% finding classes
%

/class_paths [
	(HOME) getenv (/class) append
	(HOME) getenv (/hn/ol) append
	(HOME) getenv (/hn/src) append
] def

/find_class {	% class-name -- class|null
	class_mgr 1 index known {
		class_mgr exch get harden
	} {
		(%.PS) [2 index] sprintf
		class_paths (r) filepathopen {
			%1 index DEBUG
			dictbegin
			/ParentDictArray [class_mgr //class_class] def
			{mark exch cvx exec cleartomark} currentdict send
			/classfile exch def
			/classname exch def
			/shared growabledict def
			currentdict /superclass known not {
				/superclass null def
				/superclasses nullarray def
			} if
			/ParentDictArray [class_mgr //class_class] def
			dictend readonly

			dup class_mgr /addclient ObsoleteService send
			class_mgr 1 index dup /classname get exch soften put
		} {
			pop /error ne {
				/error find_class
			} {null} ifelse
		} ifelse
	} ifelse
} def

%----------------------------------------------
% deleting classes
%

/HandleObsoleteTarget {	% class --
	%(class obsolete: % %) [2 index dup /classname get exch /shared known () (shared) ifelse] sprintf DEBUG
	dup /shared known {
		currentdict 1 index /classname get undef pop
	} {
		dup /superclass get dup null ne {
			/shared get exch undef
		} {pop pop} ifelse
	} ifelse
} def


%----------------------------------------------
% End of class_mgr
%

currentdict /class_shared undef
currentdict /class_class undef
currentdict end def

%----------------------------------------------
% create objects
%

/newobject {	% classname -- object|null
	/find_class class_mgr send dup null ne {
		//nullstring //nullstring /new 4 -1 roll send
		dup null ne {
			/new exch send
		} if
	} if
} def

E 1