'From Cuis 1.0 of 6 March 2009 [latest update: #5989] on 13 March 2009 at 10:20:50 am'!

!Object methodsFor: 'copying' stamp: 'jmv 3/9/2009 10:22'!
veryDeepCopy
	"Do a complete tree copy using a dictionary.  An object in the tree twice is only copied once.  All references to the object in the copy of the tree will point to the new copy."

	| copier new |
	copier _ DeepCopier new initialize: 4096 "self initialDeepCopierSize".
	new _ self veryDeepCopyWith: copier.
	copier references associationsDo: [:assoc | 
		assoc value veryDeepFixupWith: copier].
	copier fixDependents.
	^ new! !

!Object methodsFor: 'nil' stamp: 'tk 4/16/1998 15:54'!
notify: aString 
	"Create and schedule a Notifier with the argument as the message in 
	order to request confirmation before a process can proceed."

	Debugger
		openContext: thisContext
		label: 'Notifier'
		contents: aString

	"nil notify: 'confirmation message'"! !


!Class methodsFor: 'initialize-release' stamp: 'jmv 3/13/2009 09:54'!
removeFromSystem: logged
	"Forget the receiver from the Smalltalk global dictionary. Any existing 
	instances will refer to an obsolete version of the receiver."
	
	"keep the class name and category for triggering the system change message. If we wait to long, then we get obsolete information which is not what we want."

	"tell class to unload itself"
	self unload.
	self superclass ifNotNil:
		["If we have no superclass there's nothing to be remembered"
		self superclass addObsoleteSubclass: self].
	Smalltalk forgetClass: self logged: logged.
	self obsolete.! !


!ContextPart methodsFor: 'nil' stamp: 'ar 5/25/2000 20:47'!
doPrimitive: primitiveIndex method: meth receiver: receiver args: arguments 
	"Simulate a primitive method whose index is primitiveIndex.  The
	simulated receiver and arguments are given as arguments to this message."

	| value |
	<primitive: 19> "Simulation guard"
	"If successful, push result and return resuming context,
		else ^ PrimitiveFailToken"
	(primitiveIndex = 19) ifTrue:[
		Debugger 
			openContext: self
			label:'Code simulation error'
			contents: self shortStack].

	(primitiveIndex = 80 and: [receiver isKindOf: ContextPart])
		ifTrue: [^self push: ((BlockContext newForMethod: receiver home method)
						home: receiver home
						startpc: pc + 2
						nargs: (arguments at: 1))].
	(primitiveIndex = 81 and: [receiver isMemberOf: BlockContext])
		ifTrue: [^receiver pushArgs: arguments from: self].
	primitiveIndex = 83 "afr 9/11/1998 19:50"
		ifTrue: [^ self send: arguments first to: receiver
					with: arguments allButFirst
					super: false].
	primitiveIndex = 84 "afr 9/11/1998 19:50"
		ifTrue: [^ self send: arguments first to: receiver
					with: (arguments at: 2)
					super: false].
	arguments size > 6 ifTrue: [^ PrimitiveFailToken].
	primitiveIndex = 117 
		ifTrue:[value _ self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments]
		ifFalse:[value _ receiver tryPrimitive: primitiveIndex withArgs: arguments].
	value == PrimitiveFailToken
		ifTrue: [^ PrimitiveFailToken]
		ifFalse: [^ self push: value]! !


!DeepCopier methodsFor: 'like fullCopy' stamp: 'jmv 3/13/2009 10:00'!
initialize

	references _ IdentityDictionary new: 4096.
	"self isItTimeToCheckVariables ifTrue: [self checkVariables]."
		"no more checking at runtime"
! !


!FileDirectory methodsFor: 'nil' stamp: 'sw 1/25/2002 12:38'!
assureExistence
	"Make sure the current directory exists. If necessary, create all parts in between"

	^ self containingDirectory assureExistenceOfPath: self localName! !


!Inspector methodsFor: 'nil' stamp: 'hmm 7/29/2001 20:54'!
object: anObject 
	"Set anObject to be the object being inspected by the receiver."

	| oldIndex |
	anObject == object
		ifTrue: [self update]
		ifFalse:
			[oldIndex _ selectionIndex <= 2 ifTrue: [selectionIndex] ifFalse: [0].
			self inspect: anObject.
			oldIndex _ oldIndex min: self fieldList size.
			self changed: #inspectObject.
			oldIndex > 0
				ifTrue: [self toggleIndex: oldIndex]
				ifFalse: [self changed: #fieldList.
						self changed: #contents]]! !

!Inspector methodsFor: 'nil' stamp: 'tk 10/27/2000 14:59'!
selectedSlotName
	^ self fieldList at: selectionIndex! !


!MessageNode methodsFor: 'nil'!
checkBlock: node as: nodeName from: encoder

	node canBeSpecialArgument ifTrue: [^node isMemberOf: BlockNode].
	((node isKindOf: BlockNode) and: [node numberOfArguments > 0])
		ifTrue:	[^encoder notify: '<- ', nodeName , ' of ' ,
					(MacroSelectors at: special) , ' must be 0-argument block']
		ifFalse: [^encoder notify: '<- ', nodeName , ' of ' ,
					(MacroSelectors at: special) , ' must be a block or variable']! !


!MethodContext methodsFor: 'nil' stamp: 'tfei 6/7/1999 20:46'!
cannotReturn: result

	Debugger
		openContext: thisContext
		label: 'computation has been terminated'
		contents: thisContext printString! !


!ObjectExplorerWrapper methodsFor: 'nil' stamp: 'sge 4/12/2001 08:24'!
asString
	| explorerString string |
	explorerString _ 
		[item asExplorerString]
			on: Error 
			do: ['<error in asExplorerString: evaluate "' , itemName , ' asExplorerString" to debug>'].
	string _ itemName , ': ' , explorerString.
	(string includes: Character cr)
		ifTrue: [^ string withSeparatorsCompacted].
	^ string! !


!OldMenuItemMorph methodsFor: 'accessing' stamp: 'jmv 3/13/2009 10:04'!
isEnabled: aBoolean

	isEnabled = aBoolean ifTrue: [^ self].
	isEnabled _ aBoolean.
	self color: (aBoolean ifTrue: [Color black] ifFalse: [Color gray]).
! !

!OldMenuItemMorph methodsFor: 'private' stamp: 'jmv 3/13/2009 10:03'!
deselectItem
	| item |
	self isSelected: false.
	subMenu ifNotNil: [subMenu deleteIfPopUp].
	(owner isKindOf: OldMenuMorph) 
		ifTrue: 
			[item _ owner popUpOwner.
			(item isKindOf: OldMenuItemMorph) ifTrue: [item deselectItem]]! !


!OldMenuMorph methodsFor: 'construction' stamp: 'jmv 3/13/2009 10:05'!
add: aString target: target selector: aSymbol argumentList: argList 
	"Append a menu item with the given label. If the item is selected, it will send the given selector to the target object with the given arguments. If the selector takes one more argument than the number of arguments in the given list, then the triggering event is supplied as as the last argument."

	| item |
	item _ OldMenuItemMorph new
		contents: aString;
		target: target;
		selector: aSymbol;
		arguments: argList asArray.
	self addMorphBack: item.
	^item! !

!OldMenuMorph methodsFor: 'control' stamp: 'jmv 3/13/2009 10:06'!
deleteIfPopUp
	"Remove this menu from the screen if stayUp is not true. If it is a submenu, also remove its owning menu."

	stayUp ifFalse: [self delete].
	(popUpOwner notNil and: [popUpOwner isKindOf: OldMenuItemMorph]) ifTrue:  [
		popUpOwner isSelected: false.
		(popUpOwner owner isKindOf: OldMenuMorph) 
			ifTrue: [popUpOwner owner deleteIfPopUp]]! !

!OldMenuMorph methodsFor: 'menu' stamp: 'jmv 3/13/2009 10:07'!
detachSubMenu: evt 
	| possibleTargets item subMenu |
	possibleTargets _ evt hand argumentOrNil morphsAt: evt hand targetOffset.
	item _ possibleTargets detect: [ :any | any isKindOf: OldMenuItemMorph] ifNone: [^self].
	subMenu _ item subMenu.
	subMenu ifNotNil:  [
		item subMenu: nil.
		item delete.
		subMenu stayUp: true.
		subMenu popUpOwner: nil.
		subMenu addTitle: item contents.
		evt hand attachMorph: subMenu]! !


!OldMorph class methodsFor: 'class initialization' stamp: 'jmv 3/13/2009 10:09'!
initialize
	"Morph initialize"

	"this empty array object is shared by all morphs with no submorphs:"
	EmptyArray _ Array new! !


!SimpleServiceEntry methodsFor: 'services menu' stamp: 'jmv 3/13/2009 10:12'!
addServiceFor: served toMenu: aMenu
	aMenu add: self label 
		target: self 
		selector: #performServiceFor:
		argument: served.
	self useLineAfter ifTrue: [ aMenu addLine ].! !


!SimpleServiceEntry class methodsFor: 'instance creation' stamp: 'yo 8/22/2008 20:58'!
provider: anObject label: aString selector: aSymbol

	^self provider: anObject label: aString selector: aSymbol description: ''.
! !


!SortedCollection methodsFor: 'private' stamp: 'stp 04/23/1999 05:32'!
defaultSort: i to: j 
	"Sort elements i through j of self to be nondescending according to
	sortBlock."	"Assume the default sort block ([:x :y | x <= y])."

	| di dij dj tt ij k l n |
	"The prefix d means the data at that index."
	(n _ j + 1  - i) <= 1 ifTrue: [^self].	"Nothing to sort." 
	 "Sort di,dj."
	di _ array at: i.
	dj _ array at: j.
	(di <= dj) "i.e., should di precede dj?"
		ifFalse: 
			[array swap: i with: j.
			 tt _ di.
			 di _ dj.
			 dj _ tt].
	n > 2
		ifTrue:  "More than two elements."
			[ij _ (i + j) // 2.  "ij is the midpoint of i and j."
			 dij _ array at: ij.  "Sort di,dij,dj.  Make dij be their median."
			 (di <= dij) "i.e. should di precede dij?"
			   ifTrue: 
				[(dij <= dj) "i.e., should dij precede dj?"
				  ifFalse: 
					[array swap: j with: ij.
					 dij _ dj]]
			   ifFalse:  "i.e. di should come after dij"
				[array swap: i with: ij.
				 dij _ di].
			n > 3
			  ifTrue:  "More than three elements."
				["Find k>i and l<j such that dk,dij,dl are in reverse order.
				Swap k and l.  Repeat this procedure until k and l pass each other."
				 k _ i.
				 l _ j.
				 [[l _ l - 1.  k <= l and: [dij <= (array at: l)]]
				   whileTrue.  "i.e. while dl succeeds dij"
				  [k _ k + 1.  k <= l and: [(array at: k) <= dij]]
				   whileTrue.  "i.e. while dij succeeds dk"
				  k <= l]
				   whileTrue:
					[array swap: k with: l]. 
	"Now l<k (either 1 or 2 less), and di through dl are all less than or equal to dk
	through dj.  Sort those two segments."
				self defaultSort: i to: l.
				self defaultSort: k to: j]]! !

!SortedCollection methodsFor: 'private' stamp: 'stp 04/23/1999 05:33'!
sort: i to: j 
	"Sort elements i through j of self to be nondescending according to
	sortBlock."

	| di dij dj tt ij k l n |
	sortBlock ifNil: [^self defaultSort: i to: j].
	"The prefix d means the data at that index."
	(n _ j + 1  - i) <= 1 ifTrue: [^self].	"Nothing to sort." 
	 "Sort di,dj."
	di _ array at: i.
	dj _ array at: j.
	(sortBlock value: di value: dj) "i.e., should di precede dj?"
		ifFalse: 
			[array swap: i with: j.
			 tt _ di.
			 di _ dj.
			 dj _ tt].
	n > 2
		ifTrue:  "More than two elements."
			[ij _ (i + j) // 2.  "ij is the midpoint of i and j."
			 dij _ array at: ij.  "Sort di,dij,dj.  Make dij be their median."
			 (sortBlock value: di value: dij) "i.e. should di precede dij?"
			   ifTrue: 
				[(sortBlock value: dij value: dj) "i.e., should dij precede dj?"
				  ifFalse: 
					[array swap: j with: ij.
					 dij _ dj]]
			   ifFalse:  "i.e. di should come after dij"
				[array swap: i with: ij.
				 dij _ di].
			n > 3
			  ifTrue:  "More than three elements."
				["Find k>i and l<j such that dk,dij,dl are in reverse order.
				Swap k and l.  Repeat this procedure until k and l pass each other."
				 k _ i.
				 l _ j.
				 [[l _ l - 1.  k <= l and: [sortBlock value: dij value: (array at: l)]]
				   whileTrue.  "i.e. while dl succeeds dij"
				  [k _ k + 1.  k <= l and: [sortBlock value: (array at: k) value: dij]]
				   whileTrue.  "i.e. while dij succeeds dk"
				  k <= l]
				   whileTrue:
					[array swap: k with: l]. 
	"Now l<k (either 1 or 2 less), and di through dl are all less than or equal to dk
	through dj.  Sort those two segments."
				self sort: i to: l.
				self sort: k to: j]]! !

SimpleServiceEntry removeSelector: #requestSelector!
OldMorph initialize!
Class removeSelector: #deactivate!
Object removeSelector: #initialDeepCopierSize!
