[squeak-dev] The Trunk: Morphic-ul.1326.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Mar 13 14:51:40 UTC 2017


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

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

Name: Morphic-ul.1326
Author: ul
Time: 13 March 2017, 2:41:34.314735 pm
UUID: 9421a504-8921-4b98-92ef-6e6bc66e9144
Ancestors: Morphic-jr.1325

SortedCollection Whack-a-mole

=============== Diff against Morphic-jr.1325 ===============

Item was changed:
  ----- Method: EventHandler>>messageList (in category 'access') -----
  messageList
  	"Return a list of 'Class selector' for each message I can send. tk 
  	9/13/97"
  	| list |
  	self flag: #mref.
  	"is this still needed? I replaced the one use that I could spot with 
  	#methodRefList "
+ 	list := OrderedCollection new.
- 	list := SortedCollection new.
  	mouseDownRecipient
  		ifNotNil: [list add: (mouseDownRecipient class whichClassIncludesSelector: mouseDownSelector) name , ' ' , mouseDownSelector].
  	mouseMoveRecipient
  		ifNotNil: [list add: (mouseMoveRecipient class whichClassIncludesSelector: mouseMoveSelector) name , ' ' , mouseMoveSelector].
  	mouseStillDownRecipient
  		ifNotNil: [list add: (mouseStillDownRecipient class whichClassIncludesSelector: mouseStillDownSelector) name , ' ' , mouseStillDownSelector].
  	mouseUpRecipient
  		ifNotNil: [list add: (mouseUpRecipient class whichClassIncludesSelector: mouseUpSelector) name , ' ' , mouseUpSelector].
  	mouseEnterRecipient
  		ifNotNil: [list add: (mouseEnterRecipient class whichClassIncludesSelector: mouseEnterSelector) name , ' ' , mouseEnterSelector].
  	mouseLeaveRecipient
  		ifNotNil: [list add: (mouseLeaveRecipient class whichClassIncludesSelector: mouseLeaveSelector) name , ' ' , mouseLeaveSelector].
  	mouseEnterDraggingRecipient
  		ifNotNil: [list add: (mouseEnterDraggingRecipient class whichClassIncludesSelector: mouseEnterDraggingSelector) name , ' ' , mouseEnterDraggingSelector].
  	mouseLeaveDraggingRecipient
  		ifNotNil: [list add: (mouseLeaveDraggingRecipient class whichClassIncludesSelector: mouseLeaveDraggingSelector) name , ' ' , mouseLeaveDraggingSelector].
  	doubleClickRecipient
  		ifNotNil: [list add: (doubleClickRecipient class whichClassIncludesSelector: doubleClickSelector) name , ' ' , doubleClickSelector].
  	keyStrokeRecipient
  		ifNotNil: [list add: (keyStrokeRecipient class whichClassIncludesSelector: keyStrokeSelector) name , ' ' , keyStrokeSelector].
+ 	^ list sort!
- 	^ list!

Item was changed:
  ----- Method: EventHandler>>methodRefList (in category 'access') -----
  methodRefList
  	"Return a MethodReference for each message I can send. tk 9/13/97, raa 
  	5/29/01 "
  	| list adder |
+ 	list := OrderedCollection new.
- 	list := SortedCollection new.
  	adder := [:recip :sel | recip
  				ifNotNil: [list
  						add: (MethodReference new
  								class: (recip class whichClassIncludesSelector: sel)
  								selector: sel)]].
  	adder value: mouseDownRecipient value: mouseDownSelector.
  	adder value: mouseMoveRecipient value: mouseMoveSelector.
  	adder value: mouseStillDownRecipient value: mouseStillDownSelector.
  	adder value: mouseUpRecipient value: mouseUpSelector.
  	adder value: mouseEnterRecipient value: mouseEnterSelector.
  	adder value: mouseLeaveRecipient value: mouseLeaveSelector.
  	adder value: mouseEnterDraggingRecipient value: mouseEnterDraggingSelector.
  	adder value: mouseLeaveDraggingRecipient value: mouseLeaveDraggingSelector.
  	adder value: doubleClickRecipient value: doubleClickSelector.
  	adder value: keyStrokeRecipient value: keyStrokeSelector.
+ 	^ list sort!
- 	^ list!

Item was changed:
  ----- Method: Morph>>showActions (in category 'meta-actions') -----
  showActions
  	"Put up a message list browser of all the code that this morph  
  	would run for mouseUp, mouseDown, mouseMove, mouseEnter,  
  	mouseLeave, and  
  	mouseLinger. tk 9/13/97"
  	| list cls selector adder |
+ 	list := OrderedCollection new.
- 	list := SortedCollection new.
  	adder := [:mrClass :mrSel | list
  				add: (MethodReference class: mrClass selector: mrSel)].
  	"the eventHandler"
  	self eventHandler
  		ifNotNil: [list := self eventHandler methodRefList.
  			(self eventHandler handlesMouseDown: nil)
  				ifFalse: [adder value: HandMorph value: #grabMorph:]].
  	"If not those, then non-default raw events"
  	#(#keyStroke: #mouseDown: #mouseEnter: #mouseLeave: #mouseMove: #mouseUp: #doButtonAction )
  		do: [:sel | 
  			cls := self class whichClassIncludesSelector: sel.
  			cls
  				ifNotNil: ["want more than default behavior"
  					cls == Morph
  						ifFalse: [adder value: cls value: sel]]].
  	"The mechanism on a Button"
  	(self respondsTo: #actionSelector)
  		ifTrue: ["A button"
  			selector := self actionSelector.
  			cls := self target class whichClassIncludesSelector: selector.
  			cls
  				ifNotNil: ["want more than default behavior"
  					cls == Morph
  						ifFalse: [adder value: cls value: selector]]].
+ 	MessageSet openMessageList: list sort name: 'Actions
- 	MessageSet openMessageList: list name: 'Actions
  of ' , self printString autoSelect: nil!

Item was changed:
  ----- Method: MorphicProject>>chooseNaturalLanguage (in category 'language') -----
  chooseNaturalLanguage
  	"Put up a menu allowing the user to choose the natural language for the project"
  
  	| aMenu availableLanguages |
  	aMenu := MenuMorph new defaultTarget: self.
  	aMenu addTitle: 'choose language' translated.
  	aMenu lastItem setBalloonText: 'This controls the human language in which tiles should be viewed.  It is potentially extensible to be a true localization mechanism, but initially it only works in the classic tile scripting system.  Each project has its own private language choice' translated.
  	Preferences noviceMode
  		ifFalse:[aMenu addStayUpItem].
  
  	availableLanguages := NaturalLanguageTranslator availableLanguageLocaleIDs
+ 										sorted:[:x :y | x displayName < y displayName].
- 										asSortedCollection:[:x :y | x displayName < y displayName].
  
  	availableLanguages do:
  		[:localeID |
  			aMenu addUpdating: #stringForLanguageNameIs: target: Locale selector:  #switchAndInstallFontToID: argumentList: {localeID}].
  	aMenu popUpInWorld
  
  "Project current chooseNaturalLanguage"!

Item was changed:
  ----- Method: PasteUpMorph>>findWindow: (in category 'world menu') -----
  findWindow: evt
  	"Present a menu names of windows and naked morphs, and activate the one that gets chosen.  Collapsed windows appear below line, expand if chosen; naked morphs appear below second line; if any of them has been given an explicit name, that is what's shown, else the class-name of the morph shows; if a naked morph is chosen, bring it to front and have it don a halo."
  	| menu expanded collapsed nakedMorphs |
  	menu := MenuMorph new.
  	expanded := SystemWindow windowsIn: self satisfying: [:w | w isCollapsed not].
  	collapsed := SystemWindow windowsIn: self satisfying: [:w | w isCollapsed].
  	nakedMorphs := self submorphsSatisfying:
  		[:m | (m isSystemWindow not and: [(m isStickySketchMorph) not]) and:
  			[(m isFlapTab) not]].
  	(expanded isEmpty & (collapsed isEmpty & nakedMorphs isEmpty)) ifTrue: [^ Beeper beep].
+ 	(expanded sort: [:w1 :w2 | w1 label caseInsensitiveLessOrEqual: w2 label]) do:
- 	(expanded asSortedCollection: [:w1 :w2 | w1 label caseInsensitiveLessOrEqual: w2 label]) do:
  		[:w | menu add: w label target: w action: #beKeyWindow.
  			w model canDiscardEdits ifFalse: [menu lastItem color: Color red]].
  	(expanded isEmpty | (collapsed isEmpty & nakedMorphs isEmpty)) ifFalse: [menu addLine].
+ 	(collapsed sort: [:w1 :w2 | w1 label caseInsensitiveLessOrEqual: w2 label]) do: 
- 	(collapsed asSortedCollection: [:w1 :w2 | w1 label caseInsensitiveLessOrEqual: w2 label]) do: 
  		[:w | menu add: w label target: w action: #collapseOrExpand.
  		w model canDiscardEdits ifFalse: [menu lastItem color: Color red]].
  	nakedMorphs isEmpty ifFalse: [menu addLine].
+ 	(nakedMorphs sort: [:w1 :w2 | w1 nameForFindWindowFeature caseInsensitiveLessOrEqual: w2 nameForFindWindowFeature]) do:
- 	(nakedMorphs asSortedCollection: [:w1 :w2 | w1 nameForFindWindowFeature caseInsensitiveLessOrEqual: w2 nameForFindWindowFeature]) do:
  		[:w | menu add: w nameForFindWindowFeature target: w action: #comeToFrontAndAddHalo].
  	menu addTitle: 'find window' translated.
  	
  	menu popUpEvent: evt in: self.!

Item was changed:
  ----- Method: SelectionMorph>>distributeHorizontally (in category 'halo commands') -----
  distributeHorizontally
  	"Distribute the empty vertical space in a democratic way."
  	| minLeft maxRight totalWidth currentLeft space |
  
  	self selectedItems size > 2
  		ifFalse: [^ self].
  
  	minLeft := self selectedItems anyOne left.
  	maxRight := self selectedItems anyOne right.
  	totalWidth := 0.
  	self selectedItems
  		do: [:each | 
  			minLeft := minLeft min: each left.
  			maxRight := maxRight max: each right.
  			totalWidth := totalWidth + each width].
  
  	currentLeft := minLeft.
  	space := (maxRight - minLeft - totalWidth / (self selectedItems size - 1)) rounded.
  	(self selectedItems
+ 		sorted: [:x :y | x left <= y left])
- 		asSortedCollection: [:x :y | x left <= y left])
  		do: [:each | 
  			each left: currentLeft.
  			currentLeft := currentLeft + each width + space].
  
  	self changed
  !

Item was changed:
  ----- Method: SelectionMorph>>distributeVertically (in category 'halo commands') -----
  distributeVertically
  	"Distribute the empty vertical space in a democratic way."
  	| minTop maxBottom totalHeight currentTop space |
  	self selectedItems size > 2
  		ifFalse: [^ self].
  
  	minTop := self selectedItems anyOne top.
  	maxBottom := self selectedItems anyOne bottom.
  	totalHeight := 0.
  	self selectedItems
  		do: [:each | 
  			minTop := minTop min: each top.
  			maxBottom := maxBottom max: each bottom.
  			totalHeight := totalHeight + each height].
  
  	currentTop := minTop.
  	space := (maxBottom - minTop - totalHeight / (self selectedItems size - 1)) rounded.
+ 	(self selectedItems sorted:[:x :y | x top <= y top])
- 	(self selectedItems asSortedCollection:[:x :y | x top <= y top])
  		do: [:each | 
  			each top: currentTop.
  			currentTop := currentTop + each height + space].
  
  	self changed
  !

Item was changed:
  ----- Method: SelectionMorph>>organizeIntoColumn (in category 'halo commands') -----
  organizeIntoColumn
  	"Place my objects in a column-enforcing container"
  
+ 	((AlignmentMorph inAColumn: (selectedItems sorted: [:x :y | x top < y top])) setNameTo: 'Column'; color: Color orange muchLighter; enableDragNDrop: true; yourself) openInHand
- 	((AlignmentMorph inAColumn: (selectedItems asSortedCollection: [:x :y | x top < y top])) setNameTo: 'Column'; color: Color orange muchLighter; enableDragNDrop: true; yourself) openInHand
  !

Item was changed:
  ----- Method: SelectionMorph>>organizeIntoRow (in category 'halo commands') -----
  organizeIntoRow
  	"Place my objects in a row-enforcing container"
  
+ 	((AlignmentMorph inARow: (selectedItems sorted: [:x :y | x left < y left])) setNameTo: 'Row'; color: Color orange muchLighter; enableDragNDrop: true; yourself) openInHand
- 	((AlignmentMorph inARow: (selectedItems asSortedCollection: [:x :y | x left < y left])) setNameTo: 'Row'; color: Color orange muchLighter; enableDragNDrop: true; yourself) openInHand
  !

Item was changed:
  ----- Method: SimpleHierarchicalListMorph>>addMorphsTo:from:allowSorting:withExpandedItems:atLevel: (in category 'private') -----
  addMorphsTo: morphList from: aCollection allowSorting: sortBoolean withExpandedItems: expandedItems atLevel: newIndent
  
  	| priorMorph newCollection firstAddition |
  	priorMorph := nil.
  	newCollection := (sortBoolean and: [sortingSelector notNil]) ifTrue: [
+ 		aCollection sorted: [ :a :b | 
+ 			(a perform: sortingSelector) <= (b perform: sortingSelector)]
- 		(aCollection asSortedCollection: [ :a :b | 
- 			(a perform: sortingSelector) <= (b perform: sortingSelector)]) asOrderedCollection
  	] ifFalse: [
  		aCollection
  	].
  	firstAddition := nil.
  	newCollection do: [:item | 
  		priorMorph := self indentingItemClass basicNew 
  			initWithContents: item 
  			prior: priorMorph 
  			forList: self
  			indentLevel: newIndent.
  		priorMorph
  			color: self textColor;
  			font: self font;
  			selectionColor: self selectionColor;
  			selectionTextColor: self selectionTextColor;
  			hoverColor: self hoverColor;
  			highlightTextColor: self highlightTextColor;
  			filterColor: self filterColor;
  			filterTextColor: self filterTextColor.
  		firstAddition ifNil: [firstAddition := priorMorph].
  		morphList add: priorMorph.
  		((item hasEquivalentIn: expandedItems) or: [priorMorph isExpanded]) ifTrue: [
  			priorMorph isExpanded: true.
  			priorMorph 
  				addChildrenForList: self 
  				addingTo: morphList
  				withExpandedItems: expandedItems.
  		].
  	].
  	^firstAddition
  	
  !

Item was changed:
  ----- Method: SimpleHierarchicalListMorph>>addSubmorphsAfter:fromCollection:allowSorting: (in category 'private') -----
  addSubmorphsAfter: parentMorph fromCollection: aCollection allowSorting: sortBoolean
  
  	| priorMorph morphList newCollection |
  	priorMorph := nil.
  	newCollection := (sortBoolean and: [sortingSelector notNil]) ifTrue: [
+ 		aCollection sorted: [ :a :b | 
+ 			(a perform: sortingSelector) <= (b perform: sortingSelector)]
- 		(aCollection asSortedCollection: [ :a :b | 
- 			(a perform: sortingSelector) <= (b perform: sortingSelector)]) asOrderedCollection
  	] ifFalse: [
  		aCollection
  	].
  	morphList := OrderedCollection new.
  	newCollection do: [:item | 
  		priorMorph := self indentingItemClass basicNew 
  			initWithContents: item 
  			prior: priorMorph 
  			forList: self
  			indentLevel: parentMorph indentLevel + 1.
  		priorMorph
  			color: self textColor;
  			font: self font;
  			selectionColor: self selectionColor;
  			selectionTextColor: self selectionTextColor;
  			hoverColor: self hoverColor;
  			highlightTextColor: self highlightTextColor;
  			filterColor: self filterColor;
  			filterTextColor: self filterTextColor.
  		morphList add: priorMorph.
  	].
  	scroller addAllMorphs: morphList after: parentMorph.
  	^morphList
  	
  !

Item was changed:
  ----- Method: SketchMorph>>firstIntersectionWithLineFrom:to: (in category 'geometry') -----
  firstIntersectionWithLineFrom: start to: end
  	| intersections last |
  	intersections := self fullBounds extrapolatedIntersectionsWithLineFrom: start to: end.
  	intersections size = 1 ifTrue: [ ^intersections anyOne ].
  	intersections isEmpty ifTrue: [ ^nil ].
+ 	intersections := intersections sorted: [ :a :b | (start dist: a) < (start dist: b) ].
- 	intersections := intersections asSortedCollection: [ :a :b | (start dist: a) < (start dist: b) ].
  	last := intersections first rounded.
  	last pointsTo: intersections last rounded do: [ :pt |
  		(self rotatedForm isTransparentAt: (pt - bounds origin)) ifFalse: [ ^last ].
  		last := pt.
  	].
  	^intersections first rounded!

Item was changed:
  ----- Method: TheWorldMenu>>worldMenuHelp (in category 'commands') -----
  worldMenuHelp
  	| explanation aList |
  	"self currentWorld primaryHand worldMenuHelp"
  
  	aList := OrderedCollection new.
  	#(helpMenu changesMenu openMenu debugMenu projectMenu scriptingMenu windowsMenu playfieldMenu appearanceMenu flapsMenu) 
  		with:
  	#('help' 'changes' 'open' 'debug' 'projects' 'authoring tools' 'windows' 'playfield options' 'appearance' 'flaps') do:
  		[:sel :title | | aMenu |
  		aMenu := self perform: sel.
  			aMenu items do:
  				[:it | | cnts |
  				(((cnts := it contents) = 'keep this menu up') or: [cnts isEmpty])
  					ifFalse: [aList add: (cnts, ' - ', title translated)]]].
+ 	aList sort: [:a :b | a caseInsensitiveLessOrEqual: b ].
- 	aList := aList asSortedCollection: [:a :b | a asLowercase < b asLowercase].
  
  	explanation := String streamContents: [:aStream | aList do:
  		[:anItem | aStream nextPutAll: anItem; cr]].
  
  	(StringHolder new contents: explanation)
  		openLabel: 'Where in the world menu is...' translated!



More information about the Squeak-dev mailing list