[Pkg] The Trunk: EToys-ul.283.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Mar 13 14:42:04 UTC 2017


Levente Uzonyi uploaded a new version of EToys to project The Trunk:
http://source.squeak.org/trunk/EToys-ul.283.mcz

==================== Summary ====================

Name: EToys-ul.283
Author: ul
Time: 13 March 2017, 5:04:42.609389 am
UUID: f38b0bdc-0ebf-4490-989a-d56f2f614acb
Ancestors: EToys-eem.282

- re-removed methods reintroduced recently from Delay and Dictionary
- SortedCollection Whack-a-mole

=============== Diff against EToys-eem.282 ===============

Item was changed:
  ----- Method: ChangeSetCategory>>fileOutAllChangeSets (in category 'services') -----
  fileOutAllChangeSets
  	"File out all the nonempty change sets in the current category, suppressing the checks for slips that might otherwise ensue.  Obtain user confirmation before undertaking this possibly prodigious task."
  
  	| aList |
  	aList := self elementsInOrder select:
  		[:aChangeSet  | aChangeSet isEmpty not].
+ 	aList isEmpty ifTrue: [^ self inform: 'sorry, all the change sets in this category are empty'].
- 	aList size == 0 ifTrue: [^ self inform: 'sorry, all the change sets in this category are empty'].
  	(self confirm: 'This will result in filing out ', aList size printString, ' change set(s)
  Are you certain you want to do this?') ifFalse: [^ self].
  
  	Preferences setFlag: #checkForSlips toValue: false during: 
+ 		[ChangeSorter fileOutChangeSetsNamed: (aList collect: [:m | m name]) sort]!
- 		[ChangeSorter fileOutChangeSetsNamed: (aList collect: [:m | m name]) asSortedArray]!

Item was changed:
  ----- Method: CodecDemoMorph>>selectCodec (in category 'as yet unclassified') -----
  selectCodec
  
  	| aMenu codecs newCodec |
  	aMenu := CustomMenu new title: 'Codec:'.
+ 	codecs := SoundCodec allSubclasses collect: [:c | c name] as: OrderedCollection.
- 	codecs := (SoundCodec allSubclasses collect: [:c | c name]) asSortedCollection.
  	codecs add: 'None'.
+ 	codecs sort do:[:cName | aMenu add: cName action: cName].
+ 	newCodec := aMenu startUp ifNil: [^ self].
- 	codecs do:[:cName | aMenu add: cName action: cName].
- 	newCodec := aMenu startUp.
- 	newCodec ifNil: [^ self].
  	self codecClassName: newCodec.
  !

Item was changed:
  ----- Method: CrosticPanel>>showHintsWindow (in category 'menu') -----
  showHintsWindow
  	| hints |
  	(self confirm: 'As hints, you will be given the five longest answers.
  Do you really want to do this?' translated)
  		ifFalse: [^ self].
+ 	hints := (answers sorted: [:x :y | x size > y size]) first: 5.
- 	hints := (answers
- 				asSortedCollection: [:x :y | x size > y size]) asArray copyFrom: 1 to: 5.
  	((StringHolder new contents: 'The five longest answers are...
  ' translated
  			, (String
  					streamContents: [:strm | 
  						hints
  							do: [:hint | strm cr;
  									nextPutAll: (hint
  											collect: [:i | quote at: i])].
  						strm cr; cr]) , 'Good luck!!' translated)
  		embeddedInMorphicWindowLabeled: 'Crostic Hints' translated)
  		setWindowColor: (Color
  				r: 1.0
  				g: 0.6
  				b: 0.0);
  		 openInWorld: self world extent: 198 @ 154!

Item was removed:
- ----- Method: Delay class>>scheduleDelay: (in category '*Etoys-Squeakland-timer process') -----
- scheduleDelay: aDelay
- 	"Private. Schedule this Delay."
- 	aDelay beingWaitedOn: true.
- 	ActiveDelay ifNil:[
- 		ActiveDelay := aDelay
- 	] ifNotNil:[
- 		aDelay resumptionTime < ActiveDelay resumptionTime ifTrue:[
- 			SuspendedDelays add: ActiveDelay.
- 			ActiveDelay := aDelay.
- 		] ifFalse: [SuspendedDelays add: aDelay].
- 	].
- !

Item was removed:
- ----- Method: Delay class>>startTimerInterruptWatcher (in category '*Etoys-Squeakland-timer process') -----
- startTimerInterruptWatcher
- 	"Reset the class variables that keep track of active Delays and re-start the timer interrupt watcher process. Any currently scheduled delays are forgotten."
- 	"Delay startTimerInterruptWatcher"
- 	| p |
- 	self stopTimerEventLoop.
- 	self stopTimerInterruptWatcher.
- 	TimingSemaphore := Semaphore new.
- 	AccessProtect := Semaphore forMutualExclusion.
- 	SuspendedDelays := 
- 		SortedCollection sortBlock: 
- 			[:d1 :d2 | d1 resumptionTime <= d2 resumptionTime].
- 	ActiveDelay := nil.
- 	p := [self timerInterruptWatcher] newProcess.
- 	p priority: Processor timingPriority.
- 	p resume.
- !

Item was removed:
- ----- Method: Delay class>>stopTimerInterruptWatcher (in category '*Etoys-Squeakland-timer process') -----
- stopTimerInterruptWatcher
- 	"Reset the class variables that keep track of active Delays and re-start the timer interrupt watcher process. Any currently scheduled delays are forgotten."
- 	"Delay startTimerInterruptWatcher"
- 	self primSignal: nil atUTCMicroseconds: 0.
- 	TimingSemaphore ifNotNil:
- 		[TimingSemaphore terminateProcess]!

Item was changed:
  ----- Method: DialectParser class>>test (in category 'as yet unclassified') -----
  test    "DialectParser test"
  
  "PrettyPrints the source for every method in the system in the alternative syntax, and then compiles that source and verifies that it generates identical code.  No changes are actually made to the system.  At the time of this writing, only two methods caused complaints (reported in Transcript and displayed in browse window after running):
  
  	BalloonEngineSimulation circleCosTable and
  	BalloonEngineSimulation circleSinTable.
  
  These are not errors, but merely a case of Floats embedded in literal arrays, and thus not specially checked for roundoff errors.
  
  Note that if an error or interruption occurs during execution of this method, the alternativeSyntax preference will be left on.
  
  NOTE:  Some methods may not compare properly until the system has been recompiled once.  Do this by executing...
  		Smalltalk recompileAllFrom: 'AARDVAARK'.
  "
  
  	 | newCodeString methodNode oldMethod newMethod badOnes n heading |
  	Preferences enable: #printAlternateSyntax.
  	badOnes := OrderedCollection new.
  	Transcript clear.
  	Smalltalk forgetDoIts.
  'Formatting and recompiling all classes...'
  displayProgressAt: Sensor cursorPoint
  from: 0 to: CompiledMethod instanceCount
  during: [:bar | n := 0.
  	Smalltalk allClassesDo:  "{MethodNode} do:"  "<- to check one class"
  		[:nonMeta |  "Transcript cr; show: nonMeta name."
  		{nonMeta. nonMeta class} do:
  		[:cls |
  		cls selectors do:
  			[:selector | (n := n+1) \\ 100 = 0 ifTrue: [bar value: n].
  			newCodeString := (cls compilerClass new)
  				format: (cls sourceCodeAt: selector)
  				in: cls notifying: nil decorated: Preferences colorWhenPrettyPrinting.
  			heading := cls organization categoryOfElement: selector.
  			methodNode := cls compilerClass new
  						compile: newCodeString
  						in: cls notifying: (SyntaxError new category: heading)
  						ifFail: [].
  			newMethod := methodNode generate: CompiledMethodTrailer empty.
  			oldMethod := cls compiledMethodAt: selector.
  			"Transcript cr; show: cls name , ' ' , selector."
  			oldMethod = newMethod ifFalse:
  				[Transcript cr; show: '***' , cls name , ' ' , selector.
  				oldMethod size = newMethod size ifFalse:
  					[Transcript show: ' difft size'].
  				oldMethod header = newMethod header ifFalse:
  					[Transcript show: ' difft header'].
  				oldMethod literals = newMethod literals ifFalse:
  					[Transcript show: ' difft literals'].
  				Transcript endEntry.
  				badOnes add: cls name , ' ' , selector]]]].
  ].
+ 	self systemNavigation browseMessageList: badOnes sort name: 'Formatter Discrepancies'.
- 	self systemNavigation browseMessageList: badOnes asSortedCollection name: 'Formatter Discrepancies'.
  	Preferences disable: #printAlternateSyntax.
  !

Item was removed:
- ----- Method: Dictionary>>explorerContentsWithIndexCollect: (in category '*Etoys-Squeakland-user interface') -----
- explorerContentsWithIndexCollect: twoArgBlock
- 
- 	| sortedKeys |
- 	sortedKeys := self keys asSortedCollection: [:x :y |
- 		((x isString and: [y isString])
- 			or: [x isNumber and: [y isNumber]])
- 			ifTrue: [x < y]
- 			ifFalse: [x class == y class
- 				ifTrue: [x printString < y printString]
- 				ifFalse: [x class name < y class name]]].
- 	^ sortedKeys collect: [:k | twoArgBlock value: (self at: k) value: k].
- !

Item was changed:
  ----- Method: EFontBDFFontReaderForRanges>>readRangesForSimplifiedChinese:overrideWith:otherRanges:additionalOverrideRange: (in category '*Etoys-Squeakland-as yet unclassified') -----
  readRangesForSimplifiedChinese: ranges overrideWith: otherFileName otherRanges: otherRanges additionalOverrideRange: additionalRange
  
  	| xTable strikeWidth glyphs ascent descent minAscii maxAscii maxWidth chars charsNum height form encoding bbx width blt lastAscii pointSize ret lastValue start end |
  	form := encoding := bbx := nil.
  	self initialize.
  	self readAttributes.
  	height := Integer readFromString: ((properties at: #FONTBOUNDINGBOX) at: 2).
  	ascent := Integer readFromString: (properties at: 'FONT_ASCENT' asSymbol) first.
  	descent := Integer readFromString: (properties at: 'FONT_DESCENT' asSymbol) first.
  	(properties includesKey: 'POINT_SIZE' asSymbol) ifTrue: [
  		pointSize := (Integer readFromString: (properties at: 'POINT_SIZE' asSymbol) first) // 10.
  	] ifFalse: [
  		pointSize := (ascent + descent) * 72 // 96.
  	].
  		
  	
  	maxWidth := 0.
  	minAscii := 16r200000.
  	strikeWidth := 0.
  	maxAscii := 0.
  
  	charsNum := Integer readFromString: (properties at: #CHARS) first.
  	chars := Set new: charsNum.
  
  	self readCharactersInRanges2: ranges storeInto: chars.
  	chars := self override2: chars with: otherFileName ranges: otherRanges transcodingTable: (UCSTable jisx0208Table) additionalRange: additionalRange.
  
+ 	chars := chars sorted: [:x :y | (x at: 2) <= (y at: 2)].
- 	chars := chars asSortedCollection: [:x :y | (x at: 2) <= (y at: 2)].
  	charsNum := chars size. "undefined encodings make this different"
  	
  	chars do: [:array |
  		encoding := array at: 2.
  		bbx := array at: 3..
  		width := bbx at: 1.
  		maxWidth := maxWidth max: width.
  		minAscii := minAscii min: encoding.
  		maxAscii := maxAscii max: encoding.
  		strikeWidth := strikeWidth + width.
  	].
  
  	glyphs := Form extent: strikeWidth at height.
  	blt := BitBlt toForm: glyphs.
  	start := ((ranges collect: [:r | r first]), (additionalRange collect: [:r2 | r2 first])) min.
  	end := ((ranges collect: [:r | r second]), (additionalRange collect: [:r2 | r2 second])) max + 3.
  	"xRange := Array with: (Array with: ((ranges collect: [:r | r first]), (additionalRange collect: [:r2 | r2 first])) min
  						with: (((ranges collect: [:r | r second]), (additionalRange collect: [:r2 | r2 second])) max + 2))."
  	"xTable := XTableForUnicodeFont new
  		ranges: xRange."
  	xTable := SparseLargeTable new: end chunkSize: 64 arrayClass: Array base: start defaultValue: -1.
  	lastAscii := start.
  	xTable at: lastAscii + 2 put: 0.
  	1 to: charsNum do: [:i |
  		form := (chars at: i) first.
  		encoding := (chars at: i) second.
  		bbx := (chars at: i) third.
  		"lastAscii+1 to: encoding-1 do: [:a | xTable at: a+2 put: (xTable at: a+1)]."
  		lastValue := xTable at: lastAscii + 1 + 1.
  		xTable at: encoding + 1 put: lastValue.
  		blt copy: (((xTable at: encoding+1)@(ascent - (bbx at: 2) - (bbx at: 4)))
  				extent: (bbx at: 1)@(bbx at: 2))
  			from: 0 at 0 in: form.
  		xTable at: encoding+2 put: (xTable at: encoding+1)+(bbx at: 1).
  		lastAscii := encoding.
  	].
  	xTable at: xTable size put: (xTable at: xTable size - 1).
  	xTable zapDefaultOnlyEntries.
  	ret := Array new: 8.
  	ret at: 1 put: xTable.
  	ret at: 2 put: glyphs.
  	ret at: 3 put: minAscii.
  	ret at: 4 put: maxAscii.
  	ret at: 5 put: maxWidth.
  	ret at: 6 put: ascent.
  	ret at: 7 put: descent.
  	ret at: 8 put: pointSize.
  	^ret.
  " ^{xTable. glyphs. minAscii. maxAscii. maxWidth. ascent. descent. pointSize}"
  !

Item was changed:
  ----- Method: EToyVocabulary>>allMethodsInCategory:forInstance:ofClass: (in category 'method list') -----
  allMethodsInCategory: aCategoryName forInstance: anObject ofClass: aClass
  	"Answer a list of all methods in the etoy interface which are in the given category, on behalf of anObject, or if it is nil, aClass"
  
  	| aCategory unfiltered suitableSelectors isAll |
  
  	aCategoryName ifNil: [^ OrderedCollection new].
  	aClass isUniClass ifTrue:
  		[aCategoryName = ScriptingSystem nameForScriptsCategory ifTrue:
  			[^ aClass namedTileScriptSelectors].
  		aCategoryName = ScriptingSystem nameForInstanceVariablesCategory ifTrue:
  			[^ aClass slotInfo keys asArray sort collect:
  				[:anInstVarName | anInstVarName asGetterSelector]]].
  	unfiltered := (isAll := aCategoryName = self allCategoryName)
  		ifTrue:
  			[methodInterfaces collect: [:anInterface | anInterface selector]]
  		ifFalse:
  			[aCategory := categories detect: [:cat | cat categoryName = aCategoryName] 
  							ifNone: [^ OrderedCollection new].
  			aCategory elementsInOrder collect: [:anElement | anElement selector]].
  
  	(anObject isKindOf: Player) ifTrue:
  		[suitableSelectors := anObject costume selectorsForViewer.
  		unfiltered := unfiltered  select:
  			[:aSelector | suitableSelectors includes: aSelector]].
  	(isAll and: [aClass isUniClass]) ifTrue:
  		[unfiltered addAll: aClass namedTileScriptSelectors.
  		unfiltered addAll: (aClass slotInfo keys asArray sort collect:
  			[:anInstVarName | anInstVarName asGetterSelector])].
  
+ 	^ (unfiltered copyWithoutAll: #(dummy unused)) sorted!
- 	^ (unfiltered copyWithoutAll: #(dummy unused)) asSortedArray!

Item was changed:
  ----- Method: EToyVocabulary>>initialize (in category 'initialization') -----
  initialize
  	"Initialize the receiver (automatically called when instances are created via 'new')"
  
  	| classes categorySymbols |
  	super initialize.
  	self vocabularyName: #eToy.
  	self documentation: '"EToy" is a vocabulary that provides the equivalent of the 1997-2000 etoy prototype'.
  	categorySymbols := Set new.
  	classes := self class morphClassesDeclaringViewerAdditions.
  	classes do:
  		[:aMorphClass | categorySymbols addAll: aMorphClass unfilteredCategoriesForViewer].
  	self addCustomCategoriesTo: categorySymbols.  "For benefit, e.g., of EToyVectorVocabulary"
  
  	categorySymbols asOrderedCollection do:
  		[:aCategorySymbol | | selectors aMethodCategory |
  			aMethodCategory := ElementCategory new categoryName: aCategorySymbol.
  			selectors := Set new.
  			classes do:
  				[:aMorphClass |
  					 (aMorphClass additionsToViewerCategory: aCategorySymbol) do:
  						[:anElement | | selector aMethodInterface |
  						aMethodInterface := self methodInterfaceFrom: anElement.
  						selectors add: (selector := aMethodInterface selector).
  						(methodInterfaces includesKey: selector) ifFalse:
  							[methodInterfaces at: selector put: aMethodInterface].
  						self flag: #deferred.
  						"NB at present, the *setter* does not get its own method interface.  Need to revisit"].
  
+ 			(selectors copyWithout: #unused) sorted do:
- 			(selectors copyWithout: #unused) asSortedArray do:
  				[:aSelector |
  					aMethodCategory elementAt: aSelector put: (methodInterfaces at: aSelector)]].
  				 
  			self addCategory: aMethodCategory].
  
  	self addCategoryNamed: ScriptingSystem nameForInstanceVariablesCategory.
  	self addCategoryNamed: ScriptingSystem nameForScriptsCategory.
  	self setCategoryDocumentationStrings.
  	(self respondsTo: #applyMasterOrdering)
  		ifTrue: [ self applyMasterOrdering ].!

Item was changed:
  ----- Method: EtoysPresenter>>allKnownScriptSelectors (in category 'playerList') -----
  allKnownScriptSelectors
  	"Answer a list of all the selectors implemented by any user-scripted objected within the scope of the receiver"
  
  	| aSet allUniclasses |
  	aSet := Set with: ('script' translated , '1') asSymbol.
  	allUniclasses := (self presenter allPlayersWithUniclasses collect:
  		[:aPlayer | aPlayer class]) asSet.
  	allUniclasses do:
  		[:aUniclass | aSet addAll: aUniclass namedTileScriptSelectors].
+ 	^ aSet sorted
- 	^ aSet asSortedArray
  
  "ActiveWorld presenter allKnownScriptSelectors"
  !

Item was changed:
  ----- Method: EtoysPresenter>>allKnownUnaryScriptSelectors (in category 'playerList') -----
  allKnownUnaryScriptSelectors
  	"Answer a list of all the unary selectors implemented by any user-scripted objected within the scope of the receiver; include #emptyScript as a bail-out"
  
  	| aSet allUniclasses |
  	aSet := Set with: #emptyScript.
  	allUniclasses := (self allPlayersWithUniclasses collect:
  		[:aPlayer | aPlayer class]) asSet.
  	allUniclasses do:
  		[:aUniclass | aSet addAll: aUniclass namedUnaryTileScriptSelectors].
+ 	^ aSet sorted
- 	^ aSet asSortedArray
  
  "ActiveWorld presenter allKnownUnaryScriptSelectors"
  !

Item was changed:
  ----- Method: EtoysPresenter>>reallyAllExtantPlayers (in category 'intialize') -----
  reallyAllExtantPlayers
  	
+ 	^self reallyAllExtantPlayersNoSort sorted:
+ 		[:a :b | a externalName < b externalName]!
- 	^ ((self reallyAllExtantPlayersNoSort) asSortedCollection:
- 			[:a :b | a externalName < b externalName]) asArray!

Item was changed:
  ----- Method: EventRollMorph>>pushChangesBackToEventTheatre (in category 'processing') -----
  pushChangesBackToEventTheatre
  	"Push the event-tape changes implied by the user's edit in the event-roll back into the originating event theatre."
  
+ 	| allNewEvents |
- 	| allNewEvents newTape |
  	allNewEvents := Array streamContents:
  		[:aStream |
  			rawEventTape do:
  				[:e | (e isMemberOf: MorphicUnknownEvent) ifTrue:
  					[aStream nextPut: e]].   "Misc directives such as do not condense & worldlet bounds"
  
  			actualRoll submorphs do:
  				[:m |
  					m putEventsOnto: aStream]].
  					
+ 	allNewEvents sort: [:a :b | a timeStamp < b timeStamp].
+ 	eventTheatre acceptNewTape: allNewEvents.
+ 	self acceptTape: allNewEvents.
- 	newTape := allNewEvents asSortedCollection: [:a :b | a timeStamp < b timeStamp].
- 	eventTheatre acceptNewTape: newTape.
- 	self acceptTape: newTape.
  	self formulate!

Item was changed:
  ----- Method: EventTapeParser class>>executableEventTapeFromCompactTape: (in category 'services') -----
  executableEventTapeFromCompactTape: aCompactEventTape
  	"Formulate a full fresh event tape from the given compact event tape."
  
  	| allEvents |
  	allEvents := Array streamContents:
  		[:aStream |
  			aCompactEventTape do:
  				[:anEvent |
  					anEvent expandOnto: aStream]].
+ 	^allEvents sort: [:a :b | a timeStamp < b timeStamp]!
- 	^ (allEvents asSortedCollection: [:a :b | a timeStamp < b timeStamp]) asArray!

Item was changed:
  ----- Method: Form>>asStringFormOn: (in category '*Etoys-Squeakland-fileIn/Out') -----
  asStringFormOn: aStream
  	"XXX unfinished, see CursorWithAlpha class>>olpcNormal"
  	| used characters bitsStream |
  	used := bits asSet.
  	used size > 36 ifTrue: [self error: 'too many colors'].
  	characters := Dictionary new.
+ 	used sorted withIndexDo: [:value :index |
- 	used := used asSortedCollection.
- 	used withIndexDo: [:value :index |
  		characters at: value put: (Character digitValue: index).
  		aStream nextPutAll: '16r'.
  		value printOn: aStream base: 16.
  		aStream space].
  	bitsStream := bits readStream.
  	1 to: height do: [:y |
  		1 to: width do: [:x | aStream nextPut: (characters at: bitsStream next)].
  		aStream crtab: 2].
  	^ aStream!

Item was changed:
  ----- Method: FreeCellBoard>>pickGame: (in category 'initialization') -----
  pickGame: aSeedOrNil 
  	| sorted msg |
  	cardDeck := PlayingCardDeck newDeck.
  	aSeedOrNil == 1
  		ifTrue: ["Special case of game 1 does a time profile playing the entire 
  			(trivial) game."
  			sorted := cardDeck submorphs
+ 						sorted: [:a :b | a cardNumber >= b cardNumber].
- 						asSortedCollection: [:a :b | a cardNumber >= b cardNumber].
  			cardDeck removeAllMorphs; addAllMorphs: sorted.
  			self resetBoard.
  			self world doOneCycle.
  			Utilities
  				informUser: 'Game #1 is a special case
  for performance analysis' translated
  				during: [msg := self world firstSubmorph.
  					msg align: msg topRight with: owner bottomRight.
  					MessageTally
  						spyOn: [sorted last owner doubleClickOnCard: sorted last]]]
  		ifFalse: [aSeedOrNil
  				ifNotNil: [cardDeck seed: aSeedOrNil].
  			cardDeck shuffle.
  			self resetBoard]!

Item was changed:
  ----- Method: MonthMorph>>selectedDates (in category 'access') -----
  selectedDates
  	| answer |
+ 	answer := OrderedCollection new.
- 	answer := SortedCollection new.
  	self submorphsDo:
  		[:each |
  		(each isKindOf: WeekMorph) ifTrue: [answer addAll: each selectedDates]].
+ 	^ answer sort!
- 	^ answer !

Item was changed:
  ----- Method: Morph>>reassessBackgroundShape (in category '*Etoys-card in a stack') -----
  reassessBackgroundShape
  	"A change has been made which may affect the instance structure of the Card uniclass that holds the instance state, which can also be thought of as the 'card data'."
  
  	"Caution: still to be done: the mechanism so that when a new instance variable is added, it gets initialized in all subinstances of the receiver's player, which are the cards of this shape.  One needs to take into account here the instance variable names coming in; those that are unchanged should keep their values, but those that have newly arrived should obtain their default values from the morphs on whose behalf they are being maintained in the model"
  
  	| requestedName |
  	self isStackBackground ifFalse: [^Beeper beep].	"bulletproof against deconstruction"
  	Cursor wait showWhile: 
+ 			[ | variableDocks takenNames sepDataMorphs existing |variableDocks := OrderedCollection new.	"This will be stored in the uniclass's 
- 			[ | variableDocks takenNames sepDataMorphs sorted existing |variableDocks := OrderedCollection new.	"This will be stored in the uniclass's 
  			class-side inst var #variableDocks"
  			takenNames := OrderedCollection new.
  			sepDataMorphs := OrderedCollection new.	"fields, holders of per-card data"
  			self submorphs do: 
  					[:aMorph | 
  					aMorph renderedMorph holdsSeparateDataForEachInstance 
  						ifTrue: [sepDataMorphs add: aMorph renderedMorph]
  						ifFalse: 
  							["look for buried fields, inside a frame"
  
  							aMorph renderedMorph isShared 
  								ifTrue: 
  									[aMorph allMorphs do: 
  											[:mm | 
  											mm renderedMorph holdsSeparateDataForEachInstance 
  												ifTrue: [sepDataMorphs add: mm renderedMorph]]]]].
+ 			sepDataMorphs 
+ 				sort: [:a :b | (a valueOfProperty: #cardInstance) notNil];	"puts existing ones first"
+ 				do: 
- 			sorted := SortedCollection new 
- 						sortBlock: [:a :b | (a valueOfProperty: #cardInstance) notNil].	"puts existing ones first"
- 			sorted addAll: sepDataMorphs.
- 			sorted do: 
  					[:aMorph | | docks | 
  					docks := aMorph variableDocks.
  					"Each morph can request multiple variables.  
  	This complicates matters somewhat but creates a generality for Fabrk-like uses.
  	Each spec is an instance of VariableDock, and it provides a point of departure
  	for the negotiation between the PasteUp and its constitutent morphs"
  					docks do: 
  							[:aVariableDock | | uniqueName | 
  							uniqueName := self player 
  										uniqueInstanceVariableNameLike: (requestedName := aVariableDock 
  														variableName)
  										excluding: takenNames.
  							uniqueName ~= requestedName 
  								ifTrue: 
  									[aVariableDock variableName: uniqueName.
  									aMorph noteNegotiatedName: uniqueName for: requestedName].
  							takenNames add: uniqueName].
  					variableDocks addAll: docks].
  			existing := self player class instVarNames.
+ 			variableDocks sort:
+ 				[:dock1 :dock2 | | name2 name1 | 
+ 				name1 := dock1 variableName.
+ 				name2 := dock2 variableName.
+ 				(existing indexOf: name1) 
+ 					< (existing indexOf: name2 ifAbsent: [variableDocks size])].
- 			variableDocks := (variableDocks asSortedCollection: 
- 							[:dock1 :dock2 | | name2 name1 | 
- 							name1 := dock1 variableName.
- 							name2 := dock2 variableName.
- 							(existing indexOf: name1) 
- 								< (existing indexOf: name2 ifAbsent: [variableDocks size])]) 
- 						asOrderedCollection.
  			self player class setNewInstVarNames: (variableDocks 
  						collect: [:info | info variableName asString]).
  			"NB: sets up accessors, and removes obsolete ones"
  			self player class newVariableDocks: variableDocks]!

Item was changed:
  ----- Method: Object>>methodInterfacesInPresentationOrderFrom:forCategory: (in category '*Etoys-viewer') -----
  methodInterfacesInPresentationOrderFrom: interfaceList forCategory: aCategory 
  	"Answer the interface list sorted in desired presentation order, using a 
  	static master-ordering list, q.v. The category parameter allows an 
  	escape in case one wants to apply different order strategies in different 
  	categories, but for now a single master-priority-ordering is used -- see 
  	the comment in method EToyVocabulary.masterOrderingOfPhraseSymbols"
  
  	| masterOrder ordered unordered |
  	masterOrder := Vocabulary eToyVocabulary masterOrderingOfPhraseSymbols.
+ 	ordered := OrderedCollection new. 
+ 	unordered := OrderedCollection new.
- 	ordered := SortedCollection sortBlock: [:a :b | a key < b key].
- 	unordered := SortedCollection sortBlock: [:a :b | a wording < b wording].
  
  	interfaceList do: [:interface | 
  		| index |
  		index := masterOrder indexOf: interface elementSymbol.
+ 		index = 0
+ 			ifTrue: [unordered addLast: interface]
+ 			ifFalse: [ordered addLast: index -> interface]].
- 		index isZero
- 			ifTrue: [unordered add: interface]
- 			ifFalse: [ordered add: index -> interface]].
  
+ 	ordered sort: [:a :b | a key < b key].
+ 	unordered sort: [:a :b | a wording < b wording].
+ 	
  	^ Array
  		streamContents: [:stream | 
  			ordered do: [:assoc | stream nextPut: assoc value].
  			stream nextPutAll: unordered]!

Item was changed:
  ----- Method: ParseNodeBuilder>>script:with:in: (in category 'all') -----
  script: sexp with: aDictionary in: aWorld
  
  	| playerClassId playerClass selector n selOrFalse argSexp arguments block tmps |
  	context := aDictionary.
  	playerClassId := sexp attributeAt: #playerClass.
  	playerClass := aDictionary at: playerClassId asSymbol ifAbsent: [self error: ''].	
  	encoder := ScriptEncoder new init: playerClass context: nil notifying: nil; referenceObject: aWorld.
  	selector := (sexp attributeAt: #scriptName) asSymbol.
  	n := MethodNode new.
  	selOrFalse := encoder encodeSelector: selector.
  
  	tmps := sexp elements detect: [:e | e keyword = #temporary] ifNone: [nil].
  	tmps ifNotNil: [
  		tmps elements  do: [:t |
  			self temporary: t.
  		].
  	].
  
+ 	argSexp := (sexp elements select: [:e | e keyword == #parameter]) sort: [:a :b | (a attributeAt: #position) asNumber < (b attributeAt: #position) asNumber].
- 	argSexp := (sexp elements select: [:e | e keyword == #parameter]) asSortedCollection: [:a :b | (a attributeAt: #position) asNumber < (b attributeAt: #position) asNumber].
  	arguments := argSexp collect: [:e | self parse: e].
  	block := self parse: (sexp elements detect: [:e | e keyword == #sequence]).
  	^ n
  		selector: selOrFalse
  		arguments: arguments
  		precedence: selector precedence
  		temporaries: #()
  		block: block
  		encoder: encoder
  		primitive: 0.!

Item was changed:
  ----- Method: Player>>offerGetterTiles: (in category 'slots-user') -----
  offerGetterTiles: slotName 
  	"For a player-type slot, offer to build convenient compound tiles that otherwise would be hard to get"
  
  	| typeChoices typeChosen thePlayerThereNow slotChoices slotChosen getterTiles aCategoryViewer playerGetter |
  	typeChoices := Vocabulary typeChoices.
  	typeChosen := UIManager default 
  		chooseFrom: (typeChoices collect: [:t | t translated]) 
  		values: typeChoices
  		title: ('Choose the TYPE
  of data to get from
  {1}''s {2}' translated format: {self externalName. slotName translated}).
  	typeChosen isEmptyOrNil ifTrue: [^self].
  	thePlayerThereNow := self perform: slotName asGetterSelector.
  	thePlayerThereNow 
  		ifNil: [thePlayerThereNow := self presenter standardPlayer].
  	slotChoices := thePlayerThereNow slotNamesOfType: typeChosen.
  	slotChoices isEmpty 
  		ifTrue: [^self inform: 'sorry -- no slots of that type' translated].
+ 	slotChoices sort.
- 	slotChoices := slotChoices asSortedArray.
  	slotChosen := UIManager default 
  		chooseFrom: (slotChoices collect: [:t | t translated]) 
  		values: slotChoices
  		title: ('Choose the datum
  you want to extract from {1}''s {2}' translated format: {self externalName. slotName translated}).
  	slotChosen isEmptyOrNil ifTrue: [^self].
  	"Now we want to tear off tiles of the form
  		holder's valueAtCursor's foo"
  	getterTiles := nil.
  	aCategoryViewer := CategoryViewer new initializeFor: thePlayerThereNow
  				categoryChoice: 'basic'.
  	getterTiles := aCategoryViewer 
  				getterTilesFor: slotChosen asGetterSelector
  				type: typeChosen.
  	aCategoryViewer := CategoryViewer new initializeFor: self
  				categoryChoice: 'basic'.
  	playerGetter := aCategoryViewer 
  				getterTilesFor: slotName asGetterSelector
  				type: #Player.
  	getterTiles submorphs first acceptDroppingMorph: playerGetter event: nil.	"the pad"	"simulate a drop"
  	getterTiles makeAllTilesGreen.
  	getterTiles justGrabbedFromViewer: false.
  	(getterTiles firstSubmorph)
  		changeTableLayout;
  		hResizing: #shrinkWrap;
  		vResizing: #spaceFill.
  	ActiveHand attachMorph: getterTiles!

Item was changed:
  ----- Method: PreferencesPanel>>findPreferencesMatching: (in category 'initialization') -----
  findPreferencesMatching: incomingTextOrString
  	"find all preferences matching incomingTextOrString"
  
  	| result aList aPalette controlPage |
  	result := incomingTextOrString asString asLowercase.
  	result := result asLowercase withBlanksTrimmed.
  	result isEmptyOrNil ifTrue: [^ self].
  
  	aList := Preferences allPreferences select:
  		[:aPreference | 
  			(aPreference name includesSubstring: result caseSensitive: false) or:
  				[aPreference helpString includesSubstring: result caseSensitive: false]].
  	aPalette := (self containingWindow ifNil: [^ self]) findDeeplyA: TabbedPalette.
  	aPalette ifNil: [^ self].
  	aPalette selectTabNamed:  'search results'.
  	aPalette currentPage ifNil: [^ self].  "bkwd compat"
  	controlPage := aPalette currentPage.
  	controlPage removeAllMorphs.
  	controlPage addMorph: (StringMorph contents: ('Preferences matching "', self searchString, '"') font: Preferences standardEToysButtonFont).
+ 	aList sort: [:a :b | a name < b name].
- 	aList := aList asSortedCollection:
- 		[:a :b | a name < b name].
  	aList do:
  		[:aPreference | | button |
  			button := aPreference representativeButtonWithColor: Color white inPanel: self.
  			button ifNotNil: [controlPage addMorphBack: button]].
  	aPalette world startSteppingSubmorphsOf: aPalette!

Item was changed:
  ----- Method: QuickGuideHolderMorph>>load (in category 'file in/file out') -----
  load
  	"If 'guide.00x.pr' is present, take the one with the largest x.  If only '.sexp.data.gz', then use it"
  	| dir m fileName f unzipped zipped ours proj tm |
  	self submorphs size > 0 ifTrue: [^ self].
  	dir := FileDirectory on: QuickGuideMorph guidePath.
+ 	"#('xxx.001.pr' 'xxx.035.pr'  'xxx.sexp.data.gz') sort   ('xxx.001.pr' 'xxx.035.pr' 'xxx.sexp.data.gz')"
- 	"#('xxx.001.pr' 'xxx.035.pr'  'xxx.sexp.data.gz') asSortedCollection   ('xxx.001.pr' 'xxx.035.pr' 'xxx.sexp.data.gz')"
  	ours := dir fileNames select: [:fName | 
  		(fName beginsWith: guideName) and: [(fName endsWith: '.pr') or: [fName endsWith: '.sexp.data.gz']]].
+ 	ours := ours sort.
- 	ours := ours asSortedCollection.
  	ours size = 0 ifTrue: [
  		submorphs size = 0 ifTrue: [
  			tm := TextMorph new contents: 'guide is missing' translated.
  			tm topLeft: self topLeft + (4 at 4).
  			self width: (self width max: 200).
  			self addMorphFront: tm].
  		^ self].
  	fileName := ours size > 1 ifTrue: [ours at: (ours size - 1) "most recent .pr file"] ifFalse: [ours last "sexp"].
  	proj := fileName endsWith: '.pr'.
  	Cursor wait showWhile: [
  		proj ifFalse: [
  			unzipped := WriteStream on: ByteArray new.
  			f := dir readOnlyFileNamed: fileName.
  			zipped := GZipReadStream on: f.
  			unzipped nextPutAll: zipped contents.
  			m := BookMorph bookFromPagesInSISSFormat: (DataStream on: (ReadStream on: (unzipped contents))) next.
  			f close].
  		proj ifTrue: [
  			m := self loadPR: fileName dir: dir.
  			m ifNil: [^ self]].
  		m position: 0 at 0.
  		self position: 0 at 0.
  		self extent: m extent.
  		m setNamePropertyTo: guideName.
  		m beSticky.
  		self translateGuide: m.
  		self addMorph: m.
  	].
  !

Item was changed:
  ----- Method: QuickGuideHolderMorph>>loadPR:dir: (in category 'file in/file out') -----
  loadPR: fileName dir: dir
  	"load a guide from a .pr file"
  
  	| p book texts desc |
  	p := ProjectLoading loadName: fileName 
  			stream: (dir readOnlyFileNamed: fileName) 
  			fromDirectory: dir withProjectView: #none.	"don't create project view"
  	book := p world submorphs detect: [:b | b isMemberOf: BookMorph] ifNone: [nil].
  	book ifNotNil: [
  		texts := book currentPage submorphs select: [:e | e isKindOf: TextMorph].
  		desc := texts isEmpty
  			ifTrue: [^ nil]
+ 			ifFalse: [(texts detectMin: [ :each | each top]) contents asString].
- 			ifFalse: [(texts asSortedCollection: [:x :y | x top < y top]) first contents asString].
  "		Descriptions at: p name put: desc.
  		Thumbnails at: p name put: (book imageForm magnifyBy: 0.25).
  		Colors at: p name put: book color.
  "
  		book hidePageControls.
  		].
  	^ book!

Item was changed:
  ----- Method: SameGameBoard>>removeSelection (in category 'actions') -----
  removeSelection
  	selection
  		ifNil: [^ self].
  	self
  		rememberUndoableAction: [selection
  				do: [:loc | (self tileAt: loc) disabled: true;
  						 setSwitchState: false].
  			self collapseColumns: (selection
+ 					collect: [:loc | loc x] as: Set) sorted.
- 					collect: [:loc | loc x]) asSet asSortedCollection.
  			selection := nil.
  			flash := false.
  			(target notNil
  					and: [actionSelector notNil])
  				ifTrue: [target perform: actionSelector withArguments: arguments]]
  		named: 'remove selection' translated!

Item was changed:
  ----- Method: SearchingViewer>>doSearchFrom:interactive: (in category 'search') -----
  doSearchFrom: aSource interactive: isInteractive
  	"Perform the search operation.  If interactive is true, this actually happened because a search button was pressed; if false, it was triggered some other way for which an informer would be inappropriate."
  
  	| searchFor aVocab aList all anInterface useTranslations scriptNames addedMorphs |
  
  	searchString := aSource isString
  		ifTrue:
  			[aSource]
  		ifFalse:
  			[(aSource isKindOf: PluggableTextMorph) "old"
  				ifTrue:
  					[aSource text string]
  				ifFalse:
  					[aSource contents asString]].
  	searchFor := searchString asLowercaseAlphabetic.
  
  	aVocab := self outerViewer currentVocabulary.
  	(useTranslations := (scriptedPlayer isPlayerLike) and: [aVocab isEToyVocabulary])
  		ifTrue:
  			[all := scriptedPlayer costume selectorsForViewer.
  			all addAll: (scriptNames := scriptedPlayer class namedTileScriptSelectors)]
  		ifFalse:
  			[all := scriptNames := scriptedPlayer class allSelectors].
  	aList := all select:
  		[:aSelector | (aVocab includesSelector: aSelector forInstance: scriptedPlayer ofClass: scriptedPlayer class limitClass: ProtoObject) and:
  			[(useTranslations and: [(anInterface := aVocab methodInterfaceAt: aSelector ifAbsent: [nil]) notNil and: [anInterface wording asString asLowercaseAlphabetic includesSubstring: searchFor caseSensitive: true]])
  				or:
  					[((scriptNames includes: aSelector) or: [useTranslations not]) and:
  						[aSelector includesSubstring: searchFor caseSensitive: false]]]].
+ 	aList sort.
- 	aList := aList asSortedArray.
  
  	self removeAllButFirstSubmorph. "that being the header"
  	self addAllMorphs:
  		((addedMorphs := scriptedPlayer tilePhrasesForSelectorList: aList inViewer: self)).
  	self enforceTileColorPolicy.
  	self secreteCategorySymbol.
  	self world ifNotNil: [self world startSteppingSubmorphsOf: self].
  	self adjustColorsAndBordersWithin.
  
  	owner ifNotNil: [owner isStandardViewer ifTrue: [owner fitFlap].
  
  	(isInteractive and: [addedMorphs isEmpty]) ifTrue:
  		[searchFor ifNotEmpty:
  			[self inform: ('No matches found for "' translated), searchFor, '"']]]!

Item was changed:
  ----- Method: ServerDirectory class>>inImageServerNames (in category '*Etoys-Squeakland-available servers') -----
  inImageServerNames
+ 	^self inImageServers keys sort!
- 	^self inImageServers keys asSortedArray!

Item was changed:
  ----- Method: SoundLibraryTool>>listing (in category 'initialization') -----
  listing
  	| list newList format soundData selectorList formatList |
+ 	list := SampledSound soundLibrary keys sort.
- 	list := SampledSound soundLibrary keys asSortedArray.
  	selectorList := OrderedCollection new.
  	formatList := OrderedCollection new.
  	list
  		do: [:each | 
  			soundData := (SampledSound soundLibrary at: each) second.
  			soundData isNumber
  				ifTrue: [format := 'uncompressed']
  				ifFalse: [(soundData includesSubString: 'Vorbis')
  						ifTrue: [format := 'Vorbis']
  						ifFalse: [(soundData includesSubString: 'Speex')
  								ifTrue: [format := 'Speex']
  								ifFalse: [(soundData includesSubString: 'GSM')
  										ifTrue: [format := 'GSM']]]].
  			selectorList add: each.
  			formatList add:  format].
  	 newList := OrderedCollection new.
  	newList add: selectorList asArray.
  	showCompression
  		ifTrue:[newList add: formatList asArray]
  		ifFalse:[newList add:  (Array new: (formatList size) withAll:' ')].
  	^newList!

Item was changed:
  ----- Method: SoundLibraryTool>>soundList (in category 'accessing') -----
  soundList
  	"Answer the list of sound keys in the sound library."
  
+ 	^ SampledSound soundLibrary keys sort!
- 	^ SampledSound soundLibrary keys asSortedArray!

Item was changed:
  ----- Method: StackMorph>>sortByField: (in category 'background') -----
  sortByField: varName
  	"Perform a simple reordering of my cards, sorting by the given field name.  If there are multiple backgrounds, then sort the current one, placing all its cards first, followed by all others in unchanged order"
  
+ 	| holdCards thisClassesInstances |
- 	| holdCards thisClassesInstances sortedList |
  	holdCards := self privateCards copy.
  
  	thisClassesInstances := self privateCards select: [:c | c isKindOf: self currentCard class].
+ 	thisClassesInstances sort:
- 	sortedList := thisClassesInstances asSortedCollection:
  		[:a :b | (a instVarNamed: varName) asString <= (b instVarNamed: varName) asString].
+ 	holdCards removeAllFoundIn: thisClassesInstances.
+ 	self privateCards:  (thisClassesInstances asOrderedCollection
+ 		addAllLast: holdCards;
+ 		yourself).
- 	sortedList := sortedList asOrderedCollection.
- 	holdCards removeAllFoundIn: sortedList.
- 	self privateCards:  (sortedList asOrderedCollection, holdCards).
  	self goToFirstCardOfStack
  !

Item was changed:
  ----- Method: StandardScriptingSystem>>cleanUpFlapTabsOnLeft (in category '*Etoys-Squeakland-help in a flap') -----
  cleanUpFlapTabsOnLeft
  	"Make sure the flap tabs on the left of the screen line up nicely, making best use of realestate."
  
  	| tabsOnLeft current |
  	tabsOnLeft :=  ((ActiveWorld localFlapTabs, ActiveWorld extantGlobalFlapTabs) select: [:f | f edgeToAdhereTo = #left])
+ 		sort: [:a :b | a top <= b top].
- 		asSortedCollection: [:a :b | a top <= b top].
  	current := SugarNavigatorBar showSugarNavigator
  		ifTrue:
  			[75]
  		ifFalse:
  			[0].
  	tabsOnLeft do:
  		[:aTab |
  			aTab top: (current min: (ActiveWorld height - aTab height)).
  			current := aTab bottom + 2].
  "
  ScriptingSystem cleanUpFlapTabsOnLeft
  "!

Item was changed:
  ----- Method: StandardScriptingSystem>>customEventNamesAndHelpStringsFor: (in category '*Etoys-customevents-custom events') -----
  customEventNamesAndHelpStringsFor: aPlayer
  	| retval help helpStrings morph |
  	morph := aPlayer costume renderedMorph.
+ 	retval := OrderedCollection new.
- 	retval := SortedCollection sortBlock: [ :a :b | a first < b first ].
  	self customEventsRegistry
  		keysAndValuesDo: [ :k :v |
  			helpStrings := Array streamContents: [ :hsStream |
  				v keysAndValuesDo: [ :registrant :array |
  					(morph isKindOf: array second) ifTrue: [
  						help := String streamContents: [ :stream |
  										v size > 1
  											ifTrue: [ stream nextPut: $(;
  													nextPutAll: array second name translated;
  													nextPut: $);
  													space ].
  										stream nextPutAll: array first translated].
  						hsStream nextPut: help]]].
  			helpStrings isEmpty ifFalse: [retval add: { k. helpStrings } ]].
+ 	^ retval sort: [ :a :b | a first < b first ]!
- 	^ retval!

Item was changed:
  ----- Method: StandardScriptingSystem>>globalCustomEventNamesFor: (in category '*Etoys-customevents-custom events') -----
  globalCustomEventNamesFor: aPlayer
  	| morph names |
  	morph := aPlayer costume renderedMorph.
+ 	names := OrderedCollection new.
- 	names := SortedCollection new.
  	self customEventsRegistry keysAndValuesDo: [ :k :v |
  		(v anySatisfy: [ :array | morph isKindOf: array second ])
  			ifTrue: [ names add: k ]].
+ 	^names sort!
- 	^names asArray!

Item was changed:
  ----- Method: StaticChangeSetCategory>>reconstituteList (in category 'updating') -----
  reconstituteList
  	"Reformulate the list.  Here, since we have a manually-maintained list, at this juncture we only make sure change-set-names are still up to date, and we purge moribund elements"
  
  	|  survivors |
  	survivors := elementDictionary select: [:aChangeSet | aChangeSet isMoribund not].
  	self clear.
+ 	(survivors sorted: [:a :b | a name <= b name]) reverseDo:
- 	(survivors asSortedCollection: [:a :b | a name <= b name]) reverseDo:
  		[:aChangeSet | self addChangeSet: aChangeSet]!

Item was changed:
  ----- Method: SugarBuddy class>>fromMesh (in category 'instance creation') -----
  fromMesh
  	| menu item |
  	menu := MenuMorph new.
+ 	(SugarLauncher current buddies sorted: [:a :b | a nick < b nick]) do: [:each |
- 	(SugarLauncher current buddies asSortedCollection: [:a :b | a nick < b nick]) do: [:each |
  		each isOwner ifFalse: [
  		menu add: each nick target: each selector: #openBadge.
  		item := menu items last.
  		item icon: (each xoFormExtent: (item height + 5) asPoint background: menu color)]].
  	menu popUpInWorld
  !

Item was changed:
  ----- Method: SugarDatastoreDirectory>>realUrl (in category 'accessing') -----
  realUrl
  	"a fully expanded version of the url we represent, but without final slash"
  	^ String streamContents: [:stream |
  			stream nextPutAll: 'sugar:///'.
  			query ifNotNil: [
  				stream nextPutAll: '?'.
  				query isString
  					ifTrue: [stream nextPutAll: query encodeForHTTP]
+ 					ifFalse: [query associations sort
- 					ifFalse: [query associations asSortedCollection
  						do: [:each | stream
  							nextPutAll: each key encodeForHTTP;
  							nextPut: $=;
  							nextPutAll: each value encodeForHTTP]
  						separatedBy: [stream nextPut: $&]]]]!

Item was changed:
  ----- Method: TileMorph>>soundChoices (in category 'misc') -----
  soundChoices
  	"Answer a list of sound choices.  This applies only to tiles that have sound-names as their literals, viz. SoundTiles and SoundReadoutTiles."
  
  	| aList |
  	aList := SoundService default sampledSoundChoices asOrderedCollection.
  	aList removeAllFoundIn: (ScriptingSystem soundNamesToSuppress copyWithout: literal).
+ 	^aList asArray sort!
- 	^ aList asSortedArray!

Item was changed:
  ----- Method: TopologicalSorter>>sort (in category 'all') -----
  sort
  
  	| s |
  	collection do: [:e |
  		e outTime = 0 ifTrue: [firstGroup add: e] ifFalse: [secondGroup add: e].
  		e inTime < 0 ifTrue: [self visit: e]
  	].
+ 	s := secondGroup sorted: [:a :b | a outTime > b outTime].
- 	s := secondGroup asSortedCollection: [:a :b | a outTime > b outTime].
  	^ firstGroup asArray, s.
  
  !

Item was changed:
  ----- Method: Vocabulary class>>typeChoicesForUserVariables (in category '*Etoys-Squeakland-type vocabularies') -----
  typeChoicesForUserVariables
  	"Answer a list of all user-choosable value types for variables."
  
  	| aList |
+ 	aList := #(Boolean Color CustomEvents Graphic  Number Patch Player Point ScriptName Sound String) copy.
- 	aList := #(Boolean Color CustomEvents Graphic  Number Patch Player Point ScriptName Sound String) asOrderedCollection.
  	(ActiveWorld notNil and:  [ActiveWorld isKedamaPresent not]) ifTrue:
+ 		[^aList copyWithout: #Patch].
+ 	^ aList
- 		[aList remove: #Patch ifAbsent: []].
- 	^ aList asSortedArray
  
  "
  Vocabulary typeChoicesForUserVariables
  "!

Item was changed:
  ----- Method: Vocabulary>>allUntranslatedWordings (in category '*Etoys-Squeakland-queries') -----
  allUntranslatedWordings
+ 	^ methodInterfaces keys sort replace: [:sel |
- 	^ methodInterfaces keys asSortedCollection collect: [:sel |
  		(methodInterfaces at: sel) untranslatedWording]!

Item was changed:
  ----- Method: WeekMorph>>selectedDates (in category 'all') -----
  selectedDates
  	| answer |
+ 	answer :=OrderedCollection new.
- 	answer := SortedCollection new.
  	self submorphsDo:
  		[:each |
  		((each respondsTo: #onColor) and: [each color = each onColor])
  			ifTrue:
  				[answer add:
  					(Date
  						newDay: each label asNumber
  						month: week firstDate monthName
  						year: week firstDate year)]].
+ 	^ answer sort!
- 	^ answer!




More information about the Packages mailing list