'From etoys3.0 of 24 February 2008 [latest update: #2081] on 23 August 2008 at 12:37:24 am'!
"Change Set:		cleanupHG1
Date:			22 August 2008
Author:			Yoshiki Ohshima

This changeset reverts some methods (see methods with older stamps), remove Class>>deactivate that is remnant from the decunft module system, and change the way file services are registered to FileList.

Remove the reference to #initialDeepCopierSize.  It is always constant 4096:
Object>>veryDeepCopy
Object>>veryDeepCopySibling
DeepCopier>>initialize

Revert to the older versions when there is no significant differences:
Object>>notify:
ByteArray>>pointerAt:put:
ByteArray>>structAt:length:
ContextPart>>doPrimitive:method:receiver:args:
Debugger>>buildMorphicNotifierLabelled:message:
Debugger class>>openContext:label:contents:
FileDirectory>>assureExistence
HTTPSocket>>getResponseUpTo:
HTTPSocket>>getRestOfBuffer:
Inspector>>object:
Inspector>>selectedSlotName
MenuItemMorph>>deselectItem
MenuItemMorph>>isEnabled:
MenuMorph>>add:subMenu:
MenuMorph>>add:target:selector:argumentList:
MenuMorph>>deleteIfPopUp
MenuMorph>>detachSubMenu:
MenuMorph>>items
MessageNode>>checkBlock:as:from:
MethodContext>>cannotReturn: result
ObjectExplorerWrapper>>asString
SecurityManager>>storeSecurityKeys
SelectorBrowser>>open
ServerDirectory>>fileNames
SortedCollection>>defaultSort:to:
SortedCollection>>sort:to:

Remove the reference to #deactivate.
Class>>removeFromSystem:

Remove the reference to #requestSelector.
SimpleServiceEntry>>addServiceFor:toMenu:


Funnel the one to create an instance on the class side.
SimpleServiceEntry class>>provider:label:selector:


Centralizing the file service registory.
ChangeSorter class>>initialize
FileList class>>initialize
Morph class>>initialize
ArchiveViewer class>>initialize
BookMorph class>>initialize
GStreamerMoviePlayerMorph class>>initialize 
MPEGMoviePlayerMorph class>>initialize 
SugarLauncher class>>initialize
TTCFont class>>initialize

Remove unused methods.
Collection removeSelector: #topologicallySortedUsing:.
SortedCollection removeSelector: #sortTopologically.
SortedCollection removeSelector: #should:precede:.

Class removeSelector: #deactivate.

HTTPSocket removeSelector: #logToTranscript.

FileDirectoryTest removeSelector: #myAssuredDirectory.
FileDirectoryTest removeSelector: #myDirectory.
FileDirectoryTest removeSelector: #myLocalDirectoryName.
FileDirectoryTest removeSelector: #testDirectoryNamed.

Object removeSelector: #initialDeepCopierSize.

ExternalStructureInspector removeSelector: #fieldList.
ExternalStructureInspector removeSelector: #replaceSelectionValue:.
ExternalStructureInspector removeSelector: #selection.

SimpleServiceEntry removeSelector: #requestSelector.

#(AnimatedImageMorph ChangeList DummyToolWorkingWithFileList EventRecorderMorph FileContentsBrowser FileStream FlashMorphReader Form GZipWriteStream InternalTranslator MoviePlayerMorph MPEGMoviePlayerMorph ProjectViewMorph SARInstaller ScorePlayerMorph SugarLauncher TTFontReader) do: [:e | (Smalltalk at: e asSymbol) class removeSelector: #initialize].

Form class removeSelector: #rgbMul.

ServerDirectory class removeSelector: #transferServerDefinitionsToExternal.
MoviePlayerMorph class removeSelector: #openAsMovie:.
"!


!Object methodsFor: 'copying' stamp: 'yo 8/22/2008 21:32'!
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 mapUniClasses.
	copier references associationsDo: [:assoc | 
		assoc value veryDeepFixupWith: copier].
	copier fixDependents.
	^ new! !

!Object methodsFor: 'copying' stamp: 'yo 8/22/2008 21:32'!
veryDeepCopySibling
	"Do a complete tree copy using a dictionary.  Substitute a clone of oldPlayer for the root.  Normally, a Player or non systemDefined object would have a new class.  We do not want one this time.  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".
	copier newUniClasses: false.
	new _ self veryDeepCopyWith: copier.
	copier mapUniClasses.
	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'"! !


!ByteArray methodsFor: 'nil' stamp: 'ar 11/28/1999 23:09'!
pointerAt: byteOffset put: value
	"Store a pointer object at the given byte address"
	value isExternalAddress ifFalse:[^self error:'Only external addresses can be stored'].
	1 to: 4 do:[:i|
		self unsignedByteAt: byteOffset+i-1 put: (value basicAt: byteOffset)].
	^value! !

!ByteArray methodsFor: 'nil' stamp: 'ar 11/28/1999 23:14'!
structAt: byteOffset length: length
	"Return a structure of the given length starting at the indicated byte offset."
	| value |
	value _ ByteArray new: length.
	1 to: length do:[:i|
		value unsignedByteAt: byteOffset+i-1 put: (self unsignedByteAt: i)].
	^value! !


!Class methodsFor: 'initialize-release' stamp: 'yo 8/22/2008 23:36'!
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].
	self environment forgetClass: self logged: logged.
	self obsolete.! !


!ChangeSorter class methodsFor: 'class initialization' stamp: 'yo 8/22/2008 21:52'!
initialize
	"Initialize the class variables"

	AllChangeSets == nil ifTrue:
		[AllChangeSets _ OrderedCollection new].
	self gatherChangeSets.
	ChangeSetCategories ifNil:
		[self initializeChangeSetCategories].
	RecentUpdateMarker _ 0.

	"ChangeSorter initialize"

	self registerInFlapsRegistry.
! !


!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]! !


!Debugger methodsFor: 'nil' stamp: 'rhi 12/20/2000 16:56'!
buildMorphicNotifierLabelled: label message: messageString
	| notifyPane window contentTop extentToUse |
	self expandStack.
	window _ (PreDebugWindow labelled: label) model: self.

	contentTop _ 0.2.
	extentToUse _ 450 @ 156. "nice and wide to show plenty of the error msg"
	window addMorph: (self buttonRowForPreDebugWindow: window)
				frame: (0@0 corner: 1 @ contentTop).

	Preferences eToyFriendly
		ifFalse:
			[notifyPane _ PluggableListMorph on: self list: #contextStackList
				selected: #contextStackIndex changeSelected: #debugAt:
				menu: nil keystroke: nil]
		ifTrue:
			[notifyPane _ PluggableTextMorph on: self text: nil accept: nil
				readSelection: nil menu: #debugProceedMenu:.
			notifyPane editString: (self preDebugNotifierContentsFrom: messageString);
				askBeforeDiscardingEdits: false].

	window addMorph: notifyPane frame: (0@contentTop corner: 1@1).
	"window deleteCloseBox.
		chickened out by commenting the above line out, sw 8/14/2000 12:54"
	window setBalloonTextForCloseBox.

	^ window openInWorldExtent: extentToUse! !


!Debugger class methodsFor: 'nil' stamp: 'hmm 7/16/2001 21:44'!
openContext: aContext label: aString contents: contentsString
	| isolationHead |
	"Open a notifier in response to an error, halt, or notify. A notifier view just shows a short view of the sender stack and provides a menu that lets the user open a full debugger."
	<primitive: 19> "Simulation guard"
	ErrorRecursion not & Preferences logDebuggerStackToFile ifTrue:
		[Smalltalk logError: aString inContext: aContext to: 'SqueakDebug.log'].
	ErrorRecursion ifTrue:
		[ErrorRecursion _ false.
		(isolationHead _ CurrentProjectRefactoring currentIsolationHead)
			ifNil: [self primitiveError: aString]
			ifNotNil: [isolationHead revoke]].
	ErrorRecursion _ true.
	self informExistingDebugger: aContext label: aString.
	(Debugger context: aContext isolationHead: isolationHead)
		openNotifierContents: contentsString
		label: aString.
	ErrorRecursion _ false.
	Processor activeProcess suspend.
! !


!DeepCopier methodsFor: 'full copy' stamp: 'yo 8/22/2008 21:22'!
initialize

	| size |
	size _ 4096.
	references _ IdentityDictionary new: size.
	uniClasses _ IdentityDictionary new.	"UniClass -> new UniClass"
	"self isItTimeToCheckVariables ifTrue: [self checkVariables]."
		"no more checking at runtime"
	newUniClasses _ true.! !


!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! !


!FileList class methodsFor: 'class initialization' stamp: 'yo 8/22/2008 23:38'!
initialize
	"FileList initialize"

	RecentDirs := OrderedCollection new.
	(self systemNavigation allClassesImplementing: #fileReaderServicesForFile:suffix:) do: 		[:providerMetaclass |
			self registerFileReader: providerMetaclass soleInstance].

	#(AnimatedImageMorph AnonymousSoundMorph ChangeList DummyToolWorkingWithFileList EventRecorderMorph FileContentsBrowser FileStream FlashMorphReader Form GZipWriteStream InternalTranslator MoviePlayerMorph MPEGMoviePlayerMorph OggSpeexCodec OggVorbisCodec ProjectViewMorph SARInstaller ScorePlayerMorph SugarLauncher TTFontReader)  do: [:cls |
	Smalltalk at: cls asSymbol ifPresent: [:c | self registerFileReader: c]].! !


!HTTPSocket methodsFor: 'nil' stamp: 'tk 9/22/1998 11:39'!
getResponseUpTo: markerString
	"Keep reading until the marker is seen.  Return three parts: header, marker, beginningOfData.  Fails if no marker in first 2000 chars." 

	| buf response bytesRead tester mm |
	buf _ String new: 2000.
	response _ WriteStream on: buf.
	tester _ 1. mm _ 1.
	[tester _ tester - markerString size + 1 max: 1.  "rewind a little, in case the marker crosses a read boundary"
	tester to: response position do: [:tt |
		(buf at: tt) = (markerString at: mm) ifTrue: [mm _ mm + 1] ifFalse: [mm _ 1].
			"Not totally correct for markers like xx0xx"
		mm > markerString size ifTrue: ["got it"
			^ Array with: (buf copyFrom: 1 to: tt+1-mm)
				with: markerString
				with: (buf copyFrom: tt+1 to: response position)]].
	 tester _ 1 max: response position.	"OK if mm in the middle"
	 (response position < buf size) & (self isConnected | self dataAvailable)] whileTrue: [
		(self waitForDataUntil: (Socket deadlineSecs: 5)) ifFalse: [
			Transcript show: 'data was late'; cr].
		bytesRead _ self primSocket: socketHandle receiveDataInto: buf 
			startingAt: response position + 1 count: buf size - response position.
		"response position+1 to: response position+bytesRead do: [:ii | 
			response nextPut: (buf at: ii)].	totally redundant, but needed to advance position!!"
		response instVarAt: 2 "position" put: 
			(response position + bytesRead)].	"horrible, but fast"

	^ Array with: response contents
		with: ''
		with: ''		"Marker not found and connection closed"
! !

!HTTPSocket methodsFor: 'nil' stamp: 'mir 6/15/2001 17:51'!
getRestOfBuffer: beginning
	"We don't know the length.  Keep going until connection is closed.  Part of it has already been received.  Response is of type text, not binary."

	| buf response bytesRead |
	response _ RWBinaryOrTextStream on: (String new: 2000).
	response nextPutAll: beginning.
	buf _ String new: 2000.

	[self isConnected | self dataAvailable] 
	whileTrue: [
		(self waitForDataUntil: (Socket deadlineSecs: 5)) ifFalse: [
	 		Transcript show: 'data was slow'; cr].
		bytesRead _ self primSocket: socketHandle receiveDataInto: buf 
				startingAt: 1 count: buf size. 
		bytesRead > 0 ifTrue: [  
			response nextPutAll: (buf copyFrom: 1 to: bytesRead)] ].
	Transcript cr; show: 'data byte count: ', response position printString.
	response reset.	"position: 0."
	^ response
! !


!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! !


!MenuItemMorph methodsFor: 'nil' stamp: 'di 2/23/98 16:24'!
deselectItem
	| item |
	self isSelected: false.
	subMenu ifNotNil: [subMenu deleteIfPopUp].
	(owner isKindOf: MenuMorph) ifTrue:
		[item _ owner popUpOwner.
		(item isKindOf: MenuItemMorph) ifTrue: [item deselectItem]].
! !

!MenuItemMorph methodsFor: 'nil' stamp: 'jm 11/4/97 07:46'!
isEnabled: aBoolean

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


!MenuMorph methodsFor: 'nil' stamp: 'jm 11/4/97 07:46'!
add: aString subMenu: aMenuMorph
	"Append the given submenu with the given label."

	| item |
	item _ MenuItemMorph new.
	item contents: aString;
		subMenu: aMenuMorph.
	self addMorphBack: item.
! !

!MenuMorph methodsFor: 'nil' stamp: 'sw 11/6/2000 13:44'!
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.  Answer the appended menu item."

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

!MenuMorph methodsFor: 'nil' stamp: 'di 10/28/1999 09:50'!
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 topRendererOrSelf delete].
	(popUpOwner notNil and: [popUpOwner isKindOf: MenuItemMorph]) ifTrue: [
		popUpOwner isSelected: false.
		(popUpOwner owner isKindOf: MenuMorph)
			ifTrue: [popUpOwner owner deleteIfPopUp]].
! !

!MenuMorph methodsFor: 'nil' stamp: 'jm 11/4/97 07:46'!
detachSubMenu: evt

	| possibleTargets item subMenu |
	possibleTargets _ evt hand argumentOrNil morphsAt: evt hand targetOffset.
	item _ possibleTargets detect: [:each | each isKindOf: MenuItemMorph] 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].
! !

!MenuMorph methodsFor: 'nil' stamp: 'jm 11/4/97 07:46'!
items

	^ submorphs select: [:m | m isKindOf: MenuItemMorph]
! !


!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! !


!Morph class methodsFor: 'nil'!
initialize
	"Morph initialize"

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


!ArchiveViewer class methodsFor: 'class initialization' stamp: 'yo 8/22/2008 21:50'!
initialize
	"ArchiveViewer initialize"

	Smalltalk addToShutDownList: self.! !


!BookMorph class methodsFor: 'class initialization' stamp: 'yo 8/22/2008 21:52'!
initialize

	self registerInFlapsRegistry.	! !


!GStreamerMoviePlayerMorph class methodsFor: 'class initialization' stamp: 'yo 8/22/2008 21:54'!
initialize 
    "GStreamerMoviePlayerMorph initialize."

	self registerInFlapsRegistry.	! !


!MPEGMoviePlayerMorph class methodsFor: 'class initialization' stamp: 'yo 8/22/2008 21:55'!
initialize 
    "MPEGMoviePlayerMorph initialize."

	self registerInFlapsRegistry.	! !


!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! !


!SecurityManager methodsFor: 'nil' stamp: 'sw 1/25/2002 12:41'!
storeSecurityKeys
	"Store the keys file for the current user"
	"SecurityManager default storeSecurityKeys"

	| fd loc file |
	self isInRestrictedMode ifTrue:[^self]. "no point in even trying"
	loc _ self secureUserDirectory. "where to put it"
	loc last = FileDirectory pathNameDelimiter ifFalse:
		[loc _ loc copyWith: FileDirectory pathNameDelimiter].
	fd _ FileDirectory on: loc.
	fd assureExistence.
	fd deleteFileNamed: self keysFileName ifAbsent:[].
	file _ fd newFileNamed: self keysFileName.
	{privateKeyPair. trustedKeys} storeOn: file.
	file close! !


!SelectorBrowser methodsFor: 'nil' stamp: 'sma 4/30/2000 10:14'!
open
	"Create a Browser that lets you type part of a selector, shows a list of selectors,
	shows the classes of the one you chose, and spwns a full browser on it.
		SelectorBrowser new open
	"

	| selectorListView typeInView topView classListView exampleView |
	Smalltalk isMorphic ifTrue: [^ self openAsMorph].

	selectorIndex _ classListIndex _ 0.
	topView _ (StandardSystemView new) model: self.
	topView borderWidth: 1.
		"label and minSize taken care of by caller"

	typeInView _ PluggableTextView on: self 
			text: #contents accept: #contents:notifying:
			readSelection: #contentsSelection menu: #codePaneMenu:shifted:.
	typeInView window: (0@0 extent: 50@14);
		askBeforeDiscardingEdits: false.
	topView addSubView: typeInView.

	selectorListView _ PluggableListView on: self
		list: #messageList
		selected: #messageListIndex
		changeSelected: #messageListIndex:
		menu: #selectorMenu:
		keystroke: #messageListKey:from:.
	selectorListView menuTitleSelector: #selectorMenuTitle.
	selectorListView window: (0 @ 0 extent: 50 @ 46).
	topView addSubView: selectorListView below: typeInView.

	classListView _ PluggableListView on: self
		list: #classList
		selected: #classListIndex
		changeSelected: #classListIndex:
		menu: nil	"never anything selected"
		keystroke: #arrowKey:from:.
	classListView menuTitleSelector: #classListSelectorTitle.
	classListView window: (0 @ 0 extent: 50 @ 60).
	topView addSubView: classListView toRightOf: typeInView.

	exampleView _ PluggableTextView on: self 
			text: #byExample accept: #byExample:
			readSelection: #contentsSelection menu: #codePaneMenu:shifted:.
	exampleView window: (0@0 extent: 100@40);
		askBeforeDiscardingEdits: false.
	topView addSubView: exampleView below: selectorListView.


	topView label: 'Method Finder'.
	topView minimumSize: 350@250; maximumSize: 350@250.
	topView subViews do: [:each | each controller].
	topView controller open.

! !


!ServerDirectory methodsFor: 'nil' stamp: 'RAA 6/23/2000 09:46'!
fileNames
	"Return a collection of names for the files (but not directories) in this directory."
	"(ServerDirectory serverNamed: 'UIUCArchive') fileNames"

	self isTypeFTP | self isTypeFile ifFalse: [
		^ self error: 'To see a directory, use file:// or ftp://'
	].
	^ (self entries select: [:entry | (entry at: 4) not])
		collect: [:entry | entry first]
! !


!SimpleServiceEntry methodsFor: 'services menu' stamp: 'yo 8/22/2008 21:40'!
addServiceFor: served toMenu: aMenu
	aMenu add: self label 
		target: self 
		selector: #performServiceFor: "self requestSelector "
		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]]! !


!SugarLauncher class methodsFor: 'class initialization' stamp: 'yo 8/22/2008 21:57'!
initialize
	"self initialize"

	"Our startUp is handled by AutoStart, but not shutDown"
	Smalltalk addToShutDownList: self after: AutoStart! !


!TTCFont class methodsFor: 'class initialization' stamp: 'yo 8/22/2008 21:57'!
initialize
"
	self initialize
"

	| tt |
	GlyphCacheSize := 512.
	GlyphCacheData := Array new: GlyphCacheSize.
	GlyphCacheIndex := 0.
	
	tt _ TTFontDescription default.
	tt ifNotNil: [self newTextStyleFromTT: tt].

	Smalltalk addToShutDownList: self.! !

TTCFont initialize!
SugarLauncher initialize!
MPEGMoviePlayerMorph initialize!
GStreamerMoviePlayerMorph initialize!
BookMorph initialize!
ArchiveViewer initialize!
Morph initialize!
FileList initialize!
ChangeSorter initialize!
"Postscript:
Leave the line above, and replace the rest of this comment by a useful one.
Executable statements should follow this comment, and should
be separated by periods, with no exclamation points (!!).
Be sure to put any further comments in double-quotes, like this one."
Collection removeSelector: #topologicallySortedUsing:.
SortedCollection removeSelector: #sortTopologically.
SortedCollection removeSelector: #should:precede:.

Class removeSelector: #deactivate.

HTTPSocket removeSelector: #logToTranscript.

FileDirectoryTest removeSelector: #myAssuredDirectory.
FileDirectoryTest removeSelector: #myDirectory.
FileDirectoryTest removeSelector: #myLocalDirectoryName.
FileDirectoryTest removeSelector: #testDirectoryNamed.

Object removeSelector: #initialDeepCopierSize.

ExternalStructureInspector removeSelector: #fieldList.
ExternalStructureInspector removeSelector: #replaceSelectionValue:.
ExternalStructureInspector removeSelector: #selection.

SimpleServiceEntry removeSelector: #requestSelector.

#(AnimatedImageMorph ChangeList DummyToolWorkingWithFileList EventRecorderMorph FileContentsBrowser FileStream FlashMorphReader Form GZipWriteStream InternalTranslator MoviePlayerMorph MPEGMoviePlayerMorph ProjectViewMorph SARInstaller ScorePlayerMorph SugarLauncher TTFontReader) do: [:e | (Smalltalk at: e asSymbol) class removeSelector: #initialize].

Form class removeSelector: #rgbMul.

ServerDirectory class removeSelector: #transferServerDefinitionsToExternal.
MoviePlayerMorph class removeSelector: #openAsMovie:.
!