The Trunk: Morphic-ul.1326.mcz

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!