The Inbox: EToys-ct.404.mcz

Christoph Thiede uploaded a new version of EToys to project The Inbox:
http://source.squeak.org/inbox/EToys-ct.404.mcz

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

Name: EToys-ct.404
Author: ct
Time: 17 September 2020, 12:08:06.252813 pm
UUID: d9eaf56f-8f92-314a-91b7-f15e0b463c55
Ancestors: EToys-eem.400

Refactors new parse node to tile conversion and revises editor menu intergration.

Minor refactorings: Method splitting, renaming, and some typo and layout fixes. Keeps depending on EToys-ct.366, EToys-ct.368, EToys-ct.369, EToys-ct.370, EToys-ct.389, EToys-ct.390. Sorry for the cluttered ancestry, for the next project, I will really use changesets!

=============== Diff against EToys-eem.400 ===============

Item was added:
+ ----- Method: MessageNode>>asTileForPlayer: (in category '*Etoys-tiles') -----
+ asTileForPlayer: aPlayer
+
+ | receiverType argumentType resultType phrase receiverTiles |
+ "Catch edge case: Color tile"
+ (self receiver isVariableNode and: [self receiver key = (Smalltalk bindingOf: #Color)])
+ ifTrue: [ | source result |
+ source := String streamContents: (MessageSend receiver: self selector: #shortPrintOn:).
+ result := [Compiler evaluate: source] ifError: [nil].
+ result isColor ifTrue: [^ result newTileMorphRepresentative]].
+
+ "Catch edge case: Test tile"
+ self ifConditionNormalizeAndDo: [:conditionNode :trueNode :falseNode | | compound |
+ compound := StandardScriptingSystem new yesNoComplexOfTiles.
+ compound testPart insertTileRow: (conditionNode asTileSetForPlayer: aPlayer) after: 0.
+ compound yesPart insertTileRow: (trueNode withoutImplicitReturns asTileSetForPlayer: aPlayer) after: 0.
+ compound noPart insertTileRow: (falseNode withoutImplicitReturns asTileSetForPlayer: aPlayer) after: 0.
+ compound enforceTileColorPolicy; layoutChanged; fullBounds.
+ ^ compound].
+
+ "Otherwise, try to build a phrase tile"
+ self arguments size < 2 ifFalse: [^ self convertToTileError].
+
+ receiverType := #unknown.
+ argumentType := self arguments ifEmpty: [nil] ifNotEmpty: [#unknown].
+ resultType := #unknown.
+ phrase := PhraseTileMorph new.
+ phrase
+ setOperator: self selector key
+ type: resultType
+ rcvrType: receiverType
+ argType: argumentType.
+ receiverTiles := self receiver asTileSetForPlayer: aPlayer.
+ receiverTiles size = 1 ifFalse: [^ self convertToTileError].
+ phrase firstSubmorph
+ addMorph: receiverTiles first;
+ hResizing: #shrinkWrap; vResizing: #shrinkWrap.
+ self arguments ifNotEmpty: [ | argumentTiles |
+ argumentTiles := self arguments first asTileSetForPlayer: aPlayer.
+ argumentTiles size = 1 ifFalse: [^ self convertToTileError].
+ phrase lastSubmorph
+ setType: argumentType;
+ changeTableLayout;
+ addMorph: argumentTiles first;
+ hResizing: #shrinkWrap; vResizing: #shrinkWrap].
+
+ ^ phrase
+ hResizing: #shrinkWrap; vResizing: #shrinkWrap;
+ yourself!

Item was added:
+ ----- Method: MethodNode>>asScriptEditorFor: (in category '*Etoys-tiles') -----
+ asScriptEditorFor: aPlayer
+
+ | editor |
+ editor := ScriptEditorMorph new.
+ editor
+ playerScripted: aPlayer;
+ setMorph: aPlayer costume scriptName: self selector.
+
+ (self asTileSetForPlayer: aPlayer)
+ withIndexDo: [:tile :index |
+ editor insertTileRow: {tile} after: index].
+ editor
+ removeSpaces;
+ enforceTileColorPolicy;
+ scriptEdited;
+ allMorphsDo: #layoutChanged.
+ ^ editor!

Item was added:
+ ----- Method: MethodWithInterface>>revertTileVersionFrom:for: (in category 'updating') -----
+ revertTileVersionFrom: anEditor for: playerScripted
+ "Only for universal tiles."
+
+ ^ self revertToLastSavedTileVersionFor: anEditor!

Item was added:
+ ----- Method: ScriptEditorMorph>>convertToTileVersion (in category 'save & revert') -----
+ convertToTileVersion
+ "The receiver, currently showing textual code, is asked to revert to the last-saved tile version"
+
+ | aUserScript |
+
+ self
+ hResizing: #shrinkWrap;
+ vResizing: #shrinkWrap.
+ aUserScript := playerScripted class userScriptForPlayer: playerScripted selector: scriptName.
+ aUserScript revertTileVersionFrom: self for: playerScripted.
+ self currentWorld startSteppingSubmorphsOf: self!

Item was changed:
  ----- Method: ScriptEditorMorph>>offerScriptorMenu (in category 'other') -----
  offerScriptorMenu
  "Put up a menu in response to the user's clicking in the menu-request area of the scriptor's heaer"
 
  | aMenu count |
-
  self modernize.
  ActiveHand showTemporaryCursor: nil.
+
-
  Preferences eToyFriendly ifTrue: [^ self offerSimplerScriptorMenu].
+
-
  aMenu := MenuMorph new defaultTarget: self.
  aMenu addTitle: scriptName asString.
  aMenu addStayUpItem.  "NB:  the kids version in #offerSimplerScriptorMenu does not deploy the stay-up item"
+
-
  aMenu addList: (self hasParameter
  ifTrue: [{
  {'remove parameter' translated. #ceaseHavingAParameter}}]
  ifFalse: [{
  {'add parameter' translated. #addParameter}}]).
 
  self hasParameter ifFalse:
  [aMenu addTranslatedList: {
  {'button to fire this script' translatedNoop. #tearOfButtonToFireScript}.
  {'fires per tick...' translatedNoop. #chooseFrequency}.
  #-
  }].
+
+ aMenu addUpdating: #showingCaretsString target: self action: #toggleShowingCarets.
-
- aMenu addUpdating: #showingCaretsString  target: self action: #toggleShowingCarets.
  aMenu addLine.
  aMenu addList: {
  {'edit balloon help for this script' translated. #editMethodDescription}.
  {'explain status alternatives' translated. #explainStatusAlternatives}.
  {'button to show/hide this script' translated. #buttonToOpenOrCloseThisScript}.
  #-
  }.
+
+ Preferences universalTiles ifFalse: [
+ count := self savedTileVersionsCount.
-
-
- Preferences universalTiles ifFalse:
- [count := self savedTileVersionsCount.
  self showingMethodPane
+ ifFalse: [ "currently showing tiles"
+ aMenu add: 'show code textually' translated action: #showSourceInScriptor.
+ count > 0 ifTrue: [
+ aMenu add: 'revert to tile version...' translated action: #revertScriptVersion].
+ aMenu add: 'save this version' translated action: #saveScriptVersion ]
+ ifTrue: [ "current showing textual source"
+ aMenu add: 'convert to tile version' translated action: #toggleWhetherShowingTiles.
+ count > 0 ifTrue:
+ [aMenu add: 'revert to tile version...' translated action: #revertScriptVersion]] ].
+
- ifFalse: "currently showing tiles"
- [aMenu add: 'show code textually' translated action: #toggleWhetherShowingTiles.
- count > 0 ifTrue:
- [aMenu add: 'revert to tile version...' translated action: #revertScriptVersion].
- aMenu add: 'save this version' translated action: #saveScriptVersion]
-
- ifTrue: "current showing textual source"
- [count >= 1 ifTrue:
- [aMenu add: 'revert to tile version' translated action: #toggleWhetherShowingTiles]]].
-
  "aMenu addLine.
  self addGoldBoxItemsTo: aMenu."
+
-
  aMenu addLine.
 
  aMenu add: 'grab this object' translated target: playerScripted selector: #grabPlayerIn: argument: ActiveWorld.
  aMenu balloonTextForLastItem: 'This will actually pick up the object bearing this script and hand it to you.  Click the (left) button to drop it' translated.
+
-
  aMenu add: 'reveal this object' translated target: playerScripted selector: #revealPlayerIn: argument: ActiveWorld.
  aMenu balloonTextForLastItem: 'If you have misplaced the object bearing this script, use this item to (try to) make it visible' translated.
+
-
  aMenu add: 'tile representing this object' translated target: playerScripted action: #tearOffTileForSelf.
  aMenu balloonTextForLastItem: 'choose this to obtain a tile which represents the object associated with this script' translated.
+
-
  aMenu addTranslatedList: {
  #-.
  {'open viewer' translatedNoop. #openObjectsViewer.  'open the viewer of the object to which this script belongs' translatedNoop}.
  {'detached method pane' translatedNoop. #makeIsolatedCodePane. 'open a little window that shows the Smalltalk code underlying this script.' translatedNoop}.
  #-.
  {'destroy this script' translatedNoop. #destroyScript}
  }.
+
+ aMenu popUpInWorld: self currentWorld.!
-
-
- aMenu popUpInWorld: self currentWorld.
- !

Item was removed:
- ----- Method: ScriptEditorMorph>>revertToTileVersion (in category 'save & revert') -----
- revertToTileVersion
- "The receiver, currently showing textual code,  is asked to revert to the last-saved tile version"
-
- | aUserScript |
-
- self
- hResizing: #shrinkWrap;
- vResizing: #shrinkWrap.
- aUserScript := playerScripted class userScriptForPlayer: playerScripted selector: scriptName.
- aUserScript revertToLastSavedTileVersionFor: self.
- self currentWorld startSteppingSubmorphsOf: self!

Item was changed:
  ----- Method: ScriptEditorMorph>>toggleWhetherShowingTiles (in category 'other') -----
  toggleWhetherShowingTiles
  "Toggle between showing the method pane and showing the tiles pane"
+
-
  self showingMethodPane
+ ifFalse: [ "currently showing tiles"
+ self showSourceInScriptor ]
+ ifTrue: [ "currently showing textual source"
+ self convertToTileVersion ].!
- ifFalse: "currently showing tiles"
- [self showSourceInScriptor]
-
- ifTrue: "current showing textual source"
- [Preferences universalTiles
- ifTrue: [^ self revertToTileVersion].
- self savedTileVersionsCount >= 1
- ifTrue:
- [(self userScriptObject lastSourceString = (playerScripted class sourceCodeAt: scriptName))
- ifFalse:
- [(self confirm:
- 'Caution -- this script was changed
- textually; if you revert to tiles at this
- point you will lose all the changes you
- may have made textually.  Do you
- really want to do this?' translated) ifFalse: [^ self]].
- self revertToTileVersion]
- ifFalse:
- [Beeper beep]]!

Item was added:
+ ----- Method: UserScript>>revertTileVersionFrom:for: (in category 'versions') -----
+ revertTileVersionFrom: anEditor for: playerScripted
+
+ anEditor removeAllButFirstSubmorph.
+ ((self playerClass >> self selector) decompile asTileSetForPlayer: playerScripted)
+ withIndexDo: [:tile :index |
+ anEditor insertTileRow: {tile} after: index].
+ anEditor allMorphsDo: #layoutChanged.
+ anEditor showingMethodPane: false.
+ self becomeTextuallyCoded.!