The Trunk: Morphic-ar.292.mcz

Andreas Raab uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-ar.292.mcz

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

Name: Morphic-ar.292
Author: ar
Time: 4 January 2010, 12:11:27 pm
UUID: d6a24b73-a996-e24c-829c-32301af15f48
Ancestors: Morphic-nice.284

Prepare for Etoys unloading:
- Move player and actorState accessors back to Morphic
- Move Presenter and StandardScriptingSystem to Morphic-Worlds since they represent some of the 'world globals'
- Make ScrollPane a subclass of MorphicModel instead of ComponentLikeModel

=============== Diff against Morphic-nice.284 ===============

Item was added:
+ ----- Method: Presenter>>cacheSpecs: (in category 'viewer') -----
+ cacheSpecs: aMorph
+ "For SyntaxMorph's type checking, cache the list of all viewer command specifications."
+
+ aMorph world ifNil: [^ true].
+ Preferences universalTiles ifFalse: [^ true].
+ Preferences eToyFriendly ifFalse: [^ true]. "not checking"
+ (Project current projectParameterAt: #fullCheck ifAbsent: [false])
+ ifFalse: [^ true]. "not checking"
+
+ SyntaxMorph initialize.!

Item was added:
+ ----- Method: Presenter>>tempCommand (in category 'misc') -----
+ tempCommand
+ Transcript cr; show: '#tempCommand invoked for Presenter'!

Item was added:
+ ----- Method: Presenter>>associatedMorph (in category 'access') -----
+ associatedMorph
+ ^ associatedMorph!

Item was added:
+ ----- Method: Presenter>>printOn: (in category 'printing') -----
+ printOn: aStream
+ super printOn: aStream.
+ aStream nextPutAll: ' (', self identityHash printString, ')'!

Item was added:
+ ----- Method: Presenter>>morph:droppedIntoPasteUpMorph: (in category 'misc') -----
+ morph: aMorph droppedIntoPasteUpMorph: aPasteUpMorph
+ aPasteUpMorph automaticViewing ifTrue:
+ [aMorph isCandidateForAutomaticViewing ifTrue:
+ [self viewMorph: aMorph]]!

Item was added:
+ ----- Method: Presenter>>stopRunningScripts (in category 'stop-step-go buttons') -----
+ stopRunningScripts
+ "Put all ticking scripts within my scope into paused mode.  Get any scripting-control buttons to show the correct state"
+
+ self stopButtonState: #on.
+ self stepButtonState: #off.
+ self goButtonState: #off.
+ associatedMorph stopRunningAll.
+
+ "associatedMorph borderColor: Preferences borderColorWhenStopped"!

Item was added:
+ ----- Method: Presenter>>stopRunningScriptsFrom: (in category 'stop-step-go buttons') -----
+ stopRunningScriptsFrom: ignored
+ "Stop running scripts; get all script-control buttons to reflect this"
+
+ self stopRunningScripts!

Item was added:
+ ----- Method: Presenter>>valueTiles (in category 'tile support') -----
+ valueTiles
+ "Answer some constant-valued tiles.  This dates back to very early etoy work in 1997, and presently has no senders"
+
+ | tiles |
+ tiles := OrderedCollection new.
+ tiles add: (5 newTileMorphRepresentative typeColor: (ScriptingSystem colorForType: #Number)).
+ tiles add: (ColorTileMorph new typeColor: (ScriptingSystem colorForType: #Color)).
+ tiles add: (TileMorph new typeColor: (ScriptingSystem colorForType: #Number);
+ setExpression: '(180 atRandom)'
+ label: 'random').
+ tiles add: RandomNumberTile new.
+ ^ tiles!

Item was added:
+ ----- Method: Presenter>>stepUp:with: (in category 'stop-step-go buttons') -----
+ stepUp: evt with: aMorph
+ "The step button came up; get things right"
+
+ self stepButtonState: #off!

Item was added:
+ ----- Method: Presenter>>stepButtonState: (in category 'stop-step-go buttons') -----
+ stepButtonState: newState
+ "Get all step buttons in my scope to show the correct state"
+
+ self allStepButtons do:
+ [:aButton | aButton state: newState]!

Item was added:
+ ----- Method: Presenter>>startRunningScripts (in category 'stop-step-go buttons') -----
+ startRunningScripts
+ "Start running scripts; get stop-step-go buttons to show the right thing"
+
+ self stopButtonState: #off.
+ self stepButtonState: #off.
+ self goButtonState: #on.
+ associatedMorph startRunningAll.
+
+ "associatedMorph borderColor: Preferences borderColorWhenRunning."
+
+ ThumbnailMorph recursionReset.  "needs to be done once in a while (<- tk note from 1997)"!

Item was added:
+ ----- Method: Presenter>>standardPlayer (in category 'standardPlayer etc') -----
+ standardPlayer
+ standardPlayer ifNil:
+ [self createStandardPlayer].
+ standardPlayer costume isInWorld ifFalse: [associatedMorph addMorphNearBack: standardPlayer costume].
+ ^ standardPlayer!

Item was added:
+ ----- Method: MorphExtension>>player: (in category 'accessing') -----
+ player: anObject
+ "change the receiver's player"
+ player := anObject !

Item was added:
+ ----- Method: Presenter>>goUp:with: (in category 'stop-step-go buttons') -----
+ goUp: evt with: aMorph
+ self startRunningScripts!

Item was added:
+ ----- Method: MorphExtension>>player (in category 'accessing') -----
+ player
+ "answer the receiver's player"
+ ^ player!

Item was added:
+ ----- Method: Presenter>>updateViewer:forceToShow: (in category 'viewer') -----
+ updateViewer: aViewer forceToShow: aCategorySymbol
+ "Update the given viewer to make sure it is in step with various possible changes in the outside world, and when reshowing it be sure it shows the given category"
+
+ | aPlayer aPosition newViewer oldOwner wasSticky barHeight itsVocabulary aCategory categoryInfo restrictedIndex |
+ aCategory := aCategorySymbol ifNotNil: [aViewer currentVocabulary translatedWordingFor: aCategorySymbol].
+ categoryInfo := aViewer categoryMorphs  asOrderedCollection collect:
+ [:aMorph | aMorph categoryRestorationInfo].
+
+ itsVocabulary := aViewer currentVocabulary.
+ aCategory ifNotNil: [(categoryInfo includes: aCategorySymbol) ifFalse: [categoryInfo addFirst: aCategorySymbol]].
+ aPlayer := aViewer scriptedPlayer.
+ aPosition := aViewer position.
+ wasSticky := aViewer isSticky.
+ newViewer := aViewer species new visible: false.
+ (aViewer isMemberOf: KedamaStandardViewer)
+ ifTrue: [restrictedIndex := aViewer restrictedIndex].
+ barHeight := aViewer submorphs first listDirection == #topToBottom
+ ifTrue:
+ [aViewer submorphs first submorphs first height]
+ ifFalse:
+ [0].
+ Preferences viewersInFlaps ifTrue:
+ [newViewer setProperty: #noInteriorThumbnail toValue: true].
+
+ newViewer rawVocabulary: itsVocabulary.
+ newViewer limitClass: aViewer limitClass.
+ newViewer initializeFor: aPlayer barHeight: barHeight includeDismissButton: aViewer hasDismissButton showCategories: categoryInfo.
+ (newViewer isMemberOf: KedamaStandardViewer)
+ ifTrue: [
+ newViewer providePossibleRestrictedView: 0.
+ newViewer providePossibleRestrictedView: restrictedIndex].
+ wasSticky ifTrue: [newViewer beSticky].
+ oldOwner := aViewer owner.
+ oldOwner ifNotNil:
+ [oldOwner replaceSubmorph: aViewer by: newViewer].
+
+ "It has happened that old readouts are still on steplist.  We may see again!!"
+
+ newViewer position: aPosition.
+ newViewer enforceTileColorPolicy.
+ newViewer visible: true.
+ newViewer world ifNotNil: [:aWorld | aWorld startSteppingSubmorphsOf: newViewer].
+ newViewer layoutChanged!

Item was added:
+ ----- Method: Presenter>>ownStandardPalette (in category 'palette & parts bin') -----
+ ownStandardPalette
+ ^ standardPalette!

Item was changed:
  Object subclass: #StandardScriptingSystem
  instanceVariableNames: ''
  classVariableNames: 'ClassVarNamesInUse FormDictionary HelpStrings StandardPartsBin'
  poolDictionaries: ''
+ category: 'Morphic-Worlds'!
- category: 'Morphic-Refactoring Candidates'!
 
  !StandardScriptingSystem commentStamp: '<historical>' prior: 0!
  An instance of this is installed as the value of the global variable "ScriptingSystem".  Client subclasses are invited, such as one used internally by squeak team for ongoing internal work.!

Item was added:
+ ----- Method: Presenter>>reinvigorateAllScriptsTool: (in category 'playerList') -----
+ reinvigorateAllScriptsTool: anAllScriptsTool
+ "Rebuild the contents of an All Scripts tool"
+
+ | showingOnlyActiveScripts candidateList firstTwo oldList allExtantPlayers newList morphList |
+ showingOnlyActiveScripts := anAllScriptsTool showingOnlyActiveScripts.
+ self flushPlayerListCache.
+ "needed? Probably to pick up on programmatical script-status control only"
+
+ firstTwo := {anAllScriptsTool submorphs first.  anAllScriptsTool submorphs second}.
+ oldList := (anAllScriptsTool submorphs copyFrom: 3 to: anAllScriptsTool submorphs size) collect:
+ [:aRow |
+ (aRow findA: UpdatingSimpleButtonMorph) target].
+
+ allExtantPlayers := self allExtantPlayers.
+ anAllScriptsTool showingAllInstances "take all instances of all classes"
+ ifTrue:
+ [candidateList := allExtantPlayers]  
+
+ ifFalse:  "include only one exemplar per uniclass.  Try to get one that has some qualifying scripts"
+ [candidateList := Set new.
+ allExtantPlayers do:
+ [:aPlayer |
+ (candidateList detect: [:plyr | plyr isMemberOf:  aPlayer class] ifNone: [nil]) ifNil:
+ [aPlayer instantiatedUserScriptsDo: [:aScriptInstantiation |
+ (showingOnlyActiveScripts not or: [aScriptInstantiation pausedOrTicking]) ifTrue:
+ [candidateList add: aPlayer]]]]].
+ newList := OrderedCollection new.
+ candidateList do:
+ [:aPlayer | aPlayer instantiatedUserScriptsDo:
+ [:aScriptInstantiation |
+ (showingOnlyActiveScripts not or: [aScriptInstantiation pausedOrTicking]) ifTrue:
+ [newList add: aScriptInstantiation]]].
+
+ oldList asSet = newList asSet
+ ifFalse:
+ [anAllScriptsTool removeAllMorphs; addAllMorphs: firstTwo.
+ morphList := newList collect:
+ [:aScriptInstantiation |  aScriptInstantiation statusControlRowIn: anAllScriptsTool].
+ anAllScriptsTool addAllMorphs: morphList.
+ newList do:
+ [:aScriptInstantiation | aScriptInstantiation updateAllStatusMorphs]]!

Item was added:
+ ----- Method: Presenter>>positionStandardPlayer (in category 'standardPlayer etc') -----
+ positionStandardPlayer
+ "Put the standard player slightly off-screen"
+
+ standardPlayer ifNotNil:
+ [standardPlayer costume position: (associatedMorph topLeft - (13@0))]!

Item was changed:
+ MorphicModel subclass: #ScrollPane
- ComponentLikeModel subclass: #ScrollPane
  instanceVariableNames: 'scrollBar scroller retractableScrollBar scrollBarOnLeft getMenuSelector getMenuTitleSelector scrollBarHidden hasFocus hScrollBar'
  classVariableNames: ''
  poolDictionaries: ''
  category: 'Morphic-Windows'!
 
  !ScrollPane commentStamp: 'mk 8/9/2005 10:34' prior: 0!
  The scroller (a transform) of a scrollPane is driven by the scrollBar.  The scroll values vary from 0.0, meaning zero offset to 1.0 meaning sufficient offset such that the bottom of the scrollable material appears 3/4 of the way down the pane.  The total distance to achieve this range is called the totalScrollRange.
 
  Basic clue about utilization of the ScrollPane class is given in:
  ScrollPane example1.
  ScrollPane example2.!

Item was added:
+ ----- Method: Presenter>>uniclassesAndCounts (in category 'playerList') -----
+ uniclassesAndCounts
+ "Answer a list of all players known to the receiver that have uniclasses"
+
+ ^ (self allPlayersWithUniclasses collect: [:aPlayer | aPlayer class]) asSet asArray collect:
+ [:aClass | Array
+ with: aClass
+ with: aClass instanceCount]
+
+
+ "self currentWorld presenter uniclassesAndCounts"!

Item was added:
+ ----- Method: Presenter>>updateViewer: (in category 'viewer') -----
+ updateViewer: aViewer
+ self updateViewer: aViewer forceToShow: nil!

Item was added:
+ ----- Method: Presenter class>>defaultPresenterClass: (in category 'accessing') -----
+ defaultPresenterClass: aPresenterClass
+ "The default presenter class to use"
+ DefaultPresenterClass := aPresenterClass!

Item was added:
+ ----- Method: Presenter>>goButtonState: (in category 'stop-step-go buttons') -----
+ goButtonState: newState
+ "Get all go buttons in my scope to show the correct state"
+
+ self allGoButtons do:
+ [:aButton | aButton state: newState]!

Item was added:
+ ----- Method: Presenter>>flushPlayerListCache (in category 'playerList') -----
+ flushPlayerListCache
+ playerList := nil!

Item was added:
+ ----- Method: Presenter>>allExtantPlayers (in category 'intialize') -----
+ allExtantPlayers
+ "The initial intent here was to produce a list of Player objects associated with any Morph in the tree beneath the receiver's associatedMorph.  whether it is the submorph tree or perhaps off on unseen bookPages.  We have for the moment moved away from that initial intent, and in the current version we only deliver up players associated with the submorph tree only.  <-- this note dates from 4/21/99
+
+ Call #flushPlayerListCache; to force recomputation."
+
+ | fullList |
+ playerList ifNotNil:
+ [^ playerList].
+
+ fullList := associatedMorph allMorphs select:
+ [:m | m player ~~ nil] thenCollect: [:m | m player].
+ fullList copy do:
+ [:aPlayer |
+ aPlayer class scripts do:
+ [:aScript |  aScript isTextuallyCoded ifFalse:
+ [aScript currentScriptEditor ifNotNil: [:ed |
+ | objectsReferredToByTiles |
+ objectsReferredToByTiles := ed allMorphs
+ select:
+ [:aMorph | (aMorph isKindOf: TileMorph) and: [aMorph type == #objRef]]
+ thenCollect:
+ [:aMorph | aMorph actualObject].
+ fullList addAll: objectsReferredToByTiles]]]].
+
+ ^ playerList := (fullList asSet asSortedCollection:
+ [:a :b | a externalName < b externalName]) asArray!

Item was added:
+ ----- Method: Presenter>>toolToViewScriptInstantiations (in category 'playerList') -----
+ toolToViewScriptInstantiations
+ "Open a tool which shows, and allows the user to change the status of, all the instantiations of all the user-written scripts in the world"
+
+ AllScriptsTool launchAllScriptsToolFor: self
+
+ "self currentWorld presenter toolToViewScriptInstantiations"!

Item was added:
+ ----- Method: Presenter>>standardPalette: (in category 'palette & parts bin') -----
+ standardPalette: aPalette
+ standardPalette := aPalette!

Item was added:
+ ----- Method: Presenter>>typeForConstant: (in category 'tile support') -----
+ typeForConstant: anObject
+ ^ anObject basicType!

Item was added:
+ ----- Method: Presenter>>allGoButtons (in category 'stop-step-go buttons') -----
+ allGoButtons
+ "Answer a list of all script-controlling Go buttons within my scope"
+
+ ^ associatedMorph allMorphs select:
+ [:aMorph | (aMorph isKindOf: ThreePhaseButtonMorph) and:
+ [aMorph actionSelector == #goUp:with:]]
+
+ "ActiveWorld presenter allGoButtons"!

Item was added:
+ ----- Method: Presenter>>stopButtonState: (in category 'stop-step-go buttons') -----
+ stopButtonState: newState
+ "Get all stop buttons in my scope to show the correct state"
+
+ self allStopButtons do:
+ [:aButton | aButton state: newState]!

Item was added:
+ ----- Method: Presenter>>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 asSortedArray
+
+ "ActiveWorld presenter allKnownScriptSelectors"
+ !

Item was added:
+ ----- Method: Presenter>>phraseForReceiver:op:arg:resultType: (in category 'tile support') -----
+ phraseForReceiver: rcvr op: op arg: arg resultType: resultType
+ "Answer a PhraseTileMorph affiliated with the given receiver, initialized to hold the given operator, argument, and result type"
+
+ | m argTile rcvrTile |
+ arg isNil
+ ifTrue:
+ [m := PhraseTileMorph new
+ setOperator: op
+ type: resultType
+ rcvrType: (self typeForConstant: rcvr)]
+ ifFalse:
+ [m := PhraseTileMorph new
+ setOperator: op
+ type: resultType
+ rcvrType: (self typeForConstant: rcvr)
+ argType: (self typeForConstant: arg).
+ argTile := self constantTile: arg.
+ argTile position: m lastSubmorph position.
+ m lastSubmorph addMorph: argTile].
+ rcvrTile := self constantTile: rcvr.
+ " TilePadMorph makeReceiverColorOfResultType ifTrue: [rcvrTile color: m color]."
+ rcvrTile position: m firstSubmorph position.
+ m firstSubmorph addMorph: rcvrTile.
+ m vResizing: #shrinkWrap.
+ ^m!

Item was added:
+ ----- Method: Presenter>>constantTile: (in category 'tile support') -----
+ constantTile: anObject
+ "Answer a constant tile that represents the object"
+
+ (anObject isColor)
+ ifTrue:
+ [^ColorTileMorph new typeColor: (ScriptingSystem colorForType: #Color)].
+ ^anObject newTileMorphRepresentative
+ typeColor: (ScriptingSystem colorForType: (self typeForConstant: anObject))!

Item was added:
+ ----- Method: Presenter>>standardPlayfield: (in category 'misc') -----
+ standardPlayfield: aPlayfield
+ standardPlayfield := aPlayfield!

Item was added:
+ ----- Method: Presenter>>systemQueryPhraseWithActionString:labelled: (in category 'palette & parts bin') -----
+ systemQueryPhraseWithActionString: anActionString labelled: aLabel
+ "Answer a SystemQueryPhrase with the given action string and label"
+
+ | aTile aPhrase |
+
+ aPhrase := SystemQueryPhrase new.
+ aTile := BooleanTile new.
+ aTile setExpression: anActionString label: aLabel.
+ aPhrase addMorph: aTile.
+ aPhrase enforceTileColorPolicy.
+ ^ aPhrase!

Item was added:
+ ----- Method: Presenter>>allStopButtons (in category 'stop-step-go buttons') -----
+ allStopButtons
+ "Answer a list of all script-controlling Stop buttons within my scope"
+
+ ^ associatedMorph allMorphs select:
+ [:aMorph | (aMorph isKindOf: ThreePhaseButtonMorph) and:
+ [aMorph actionSelector == #stopUp:with:]]
+
+ "ActiveWorld presenter allStopButtons"!

Item was added:
+ ----- Method: Presenter>>currentlyViewing: (in category 'misc') -----
+ currentlyViewing: aPlayer
+ "Only detects viewers in tabs"
+
+ aPlayer ifNil: [^false].
+ ^aPlayer viewerFlapTab notNil!

Item was added:
+ Object subclass: #Presenter
+ instanceVariableNames: 'associatedMorph standardPlayer standardPlayfield standardPalette playerList'
+ classVariableNames: 'DefaultPresenterClass'
+ poolDictionaries: ''
+ category: 'Morphic-Worlds'!
+
+ !Presenter commentStamp: '<historical>' prior: 0!
+ Optionally associated with a PasteUpMorph, provides a local scope for the running of scripts.
+
+ Once more valuable, may be again, but at present occupies primarily a historical niche.
+
+ Maintains a playerList cache.
+
+ Holds, optionally three 'standard items' -- standardPlayer standardPlayfield standardPalette -- originally providing idiomatic support of ongoing squeak-team internal work, but now extended to more general applicability.
+
+    !

Item was added:
+ ----- Method: Presenter>>nascentPartsViewer (in category 'viewer') -----
+ nascentPartsViewer
+ ^ StandardViewer new!

Item was added:
+ ----- Method: Presenter>>adaptedToWorld: (in category 'scripting') -----
+ adaptedToWorld: aWorld
+ "If I refer to a world or a hand, return the corresponding items in the new world."
+ ^aWorld presenter!

Item was added:
+ ----- Method: Presenter>>viewObjectDirectly: (in category 'viewer') -----
+ viewObjectDirectly: anObject
+ "Open up and return a viewer on the given object"
+
+ |  aViewer aRect aPoint nominalHeight aFlapTab flapLoc |
+
+ associatedMorph addMorph: (aViewer := self nascentPartsViewerFor: anObject).
+ flapLoc := associatedMorph "world".
+ Preferences viewersInFlaps ifTrue:
+ [aViewer setProperty: #noInteriorThumbnail toValue: true.
+ aViewer initializeFor: anObject barHeight: 0.
+ aViewer enforceTileColorPolicy.
+ flapLoc hideViewerFlapsOtherThanFor: anObject.
+ aFlapTab := flapLoc viewerFlapTabFor: anObject.
+ aFlapTab referent submorphs do:
+ [:m | (m isKindOf: Viewer) ifTrue: [m delete]].
+ aFlapTab referent addMorph: aViewer beSticky.
+ aViewer visible: true.
+ aFlapTab applyThickness: aViewer width + 25.
+ aFlapTab spanWorld.
+ aFlapTab showFlap.
+ aViewer position: aFlapTab referent position.
+ flapLoc startSteppingSubmorphsOf: aFlapTab.
+ flapLoc startSteppingSubmorphsOf: aViewer.
+ ^ aFlapTab].
+
+ "Caution: the branch below is historical and has not been used for a long time, though if you set the #viewersInFlaps preference to false you'd hit it.  Not at all recently maintained."
+ aViewer initializeFor: anObject barHeight: 6.
+ aViewer enforceTileColorPolicy.
+ Preferences automaticViewerPlacement ifTrue:
+ [aPoint := anObject bounds right @
+ (anObject center y - ((nominalHeight := aViewer initialHeightToAllow) // 2)).
+ aRect := (aPoint extent: (aViewer width @ nominalHeight)) translatedToBeWithin: flapLoc bounds.
+ aViewer position: aRect topLeft.
+ aViewer visible: true.
+ flapLoc startSteppingSubmorphsOf: aViewer.
+ "it's already in the world, somewhat coincidentally"
+ ^ aViewer].
+ anObject primaryHand attachMorph: (aViewer visible: true).
+ ^aViewer!

Item was added:
+ ----- Method: Presenter class>>defaultPresenterClass (in category 'accessing') -----
+ defaultPresenterClass
+ "The default presenter class to use"
+ ^DefaultPresenterClass ifNil:[self]!

Item was added:
+ ----- Method: Presenter>>reportPlayersAndScripts (in category 'playerList') -----
+ reportPlayersAndScripts
+ "Open a window which contains a report on players and their scripts"
+
+ | aList aString |
+ (aList := self uniclassesAndCounts) ifEmpty:  [^ self inform: 'there are no scripted players' translated].
+ aString := String streamContents:
+ [:aStream |
+ aList do:
+ [:aPair |
+ aStream nextPutAll: aPair first name, ' -- ', aPair second printString.
+ aStream nextPutAll: ' ', (aPair second > 1 ifTrue: ['instances'] ifFalse: ['instance']) translated, ', '.
+ aStream nextPutAll: 'named' translated.
+ aPair first allInstancesDo: [:inst | aStream space; nextPutAll: inst externalName].
+ aStream cr].
+ aStream cr.
+ aList do:
+ [:aPair |
+ aStream cr.
+ aStream nextPutAll:
+ '--------------------------------------------------------------------------------------------'.
+ aStream cr; nextPutAll: aPair first typicalInstanceName.
+ aStream nextPutAll: '''s' translated.
+ aStream nextPutAll: ' scripts:' translated.
+ aPair first addDocumentationForScriptsTo: aStream]].
+
+ (StringHolder new contents: aString)
+ openLabel: 'All scripts in this project' translated
+
+ "self currentWorld presenter reportPlayersAndScripts"!

Item was added:
+ ----- Method: Presenter>>startRunningScriptsFrom: (in category 'stop-step-go buttons') -----
+ startRunningScriptsFrom: ignored
+ "Start running all scripts.  Get all script-control buttons to show the right thing."
+
+ self startRunningScripts!

Item was added:
+ ----- Method: Presenter>>reinvigoratePlayersTool: (in category 'playerList') -----
+ reinvigoratePlayersTool: aPlayersTool
+ "Rebuild the contents of the Players tool"
+
+ | firstTwo oldList newList rowsForPlayers |
+ firstTwo := {aPlayersTool submorphs first.  aPlayersTool submorphs second}.
+ oldList := (aPlayersTool submorphs copyFrom: 3 to: aPlayersTool submorphs size) collect:
+ [:aRow |
+ aRow playerRepresented].
+ self flushPlayerListCache.
+ newList := self allExtantPlayers.
+ oldList asSet = newList asSet
+ ifFalse:
+ [aPlayersTool removeAllMorphs; addAllMorphs: firstTwo.
+ rowsForPlayers := newList collect:
+ [:aPlayer |  aPlayer entryForPlayersTool: aPlayersTool].
+ aPlayersTool addAllMorphs: rowsForPlayers ]!

Item was added:
+ ----- Method: MorphExtension>>actorState: (in category 'accessing') -----
+ actorState: anActorState
+ "change the receiver's actorState"
+ actorState := anActorState!

Item was added:
+ ----- Method: Presenter>>associatedMorph: (in category 'access') -----
+ associatedMorph: aMorph
+ associatedMorph := aMorph!

Item was added:
+ ----- Method: Presenter>>stepDown:with: (in category 'stop-step-go buttons') -----
+ stepDown: evt with: aMorph
+ self stopRunningScripts!

Item was added:
+ ----- Method: Presenter>>hasAnyTextuallyCodedScripts (in category 'playerList') -----
+ hasAnyTextuallyCodedScripts
+ "Answer whether any uniclasses in the receiver have any textually coded scripts"
+
+ self uniclassesAndCounts do:
+ [:classAndCount |
+ classAndCount first scripts do:
+ [:aScript | aScript isTextuallyCoded ifTrue: [^ true]]].
+ ^ false
+
+ "
+ ActiveWorld presenter hasAnyTextuallyCodedScripts
+ "!

Item was added:
+ ----- Method: Presenter>>booleanTiles (in category 'tile support') -----
+ booleanTiles
+ "Answer some boolean-valued tiles.  This dates back to very early etoy work in 1997, and presently has no sent senders"
+
+ | list |
+ list := #(#(0 #< 1) #(0 #<= 1) #(0 #= 1) #(0 #~= 1) #(0 #> 1) #(0 #>= 1)).
+ list := list asOrderedCollection collect:
+ [:entry |
+ | rcvr op arg |
+ rcvr := entry first.
+ op := (entry second) asSymbol.
+ arg := entry last.
+ self
+ phraseForReceiver: rcvr
+ op: op
+ arg: arg
+ resultType: #Boolean].
+ list add: (self
+ phraseForReceiver: Color red
+ op: #=
+ arg: Color red
+ resultType: #Boolean).
+ ^list "copyWith: CompoundTileMorph new"!

Item was added:
+ ----- Method: Presenter>>drawingJustCompleted: (in category 'misc') -----
+ drawingJustCompleted: aSketchMorph
+ "The user just finished drawing.  Now maybe put up a viewer"
+
+ | aWorld |
+ self flushPlayerListCache.  "Because a new drawing already created one, thus obviating #assuredPlayer kicking in with its invalidation"
+
+ aWorld := associatedMorph world.
+ (aWorld hasProperty: #automaticFlapViewing)
+ ifTrue:
+ [^ aWorld presenter viewMorph: aSketchMorph].
+
+ (aSketchMorph pasteUpMorph hasProperty: #automaticViewing)
+ ifTrue:
+ [self viewMorph: aSketchMorph]!

Item was added:
+ ----- Method: MorphExtension>>actorState (in category 'accessing') -----
+ actorState
+ "answer the redeiver's actorState"
+ ^ actorState !

Item was added:
+ ----- Method: Presenter>>allStepButtons (in category 'stop-step-go buttons') -----
+ allStepButtons
+ "Answer a list of all the script-controlling Step buttons within my scope"
+
+ ^ associatedMorph allMorphs select:
+ [:aMorph | (aMorph isKindOf: ThreePhaseButtonMorph) and:
+ [aMorph actionSelector == #stepStillDown:with:]]
+
+ "ActiveWorld presenter allStepButtons"!

Item was added:
+ ----- Method: Presenter>>viewObject: (in category 'viewer') -----
+ viewObject: anObject
+ "Open up and return a viewer on the given object.  If the object is a Morph, open a viewer on its associated Player"
+
+ anObject isMorph
+ ifTrue:
+ [self viewMorph: anObject]  "historic morph/player implementation"
+ ifFalse:
+ [self viewObjectDirectly: anObject]!

Item was added:
+ ----- Method: Presenter>>viewMorph: (in category 'viewer') -----
+ viewMorph: aMorph
+ | aPlayer openViewers aViewer aPalette aRect aPoint nominalHeight aFlapTab topItem flapLoc |
+ Sensor leftShiftDown
+ ifFalse:
+ [((aPalette := aMorph standardPalette) notNil and: [aPalette isInWorld])
+ ifTrue: [^aPalette viewMorph: aMorph]].
+ aPlayer := (topItem := aMorph topRendererOrSelf) assuredPlayer.
+ openViewers := aPlayer allOpenViewers.
+ aViewer := openViewers isEmpty ifFalse: [ openViewers first ] ifTrue: [ self nascentPartsViewer ].
+ self cacheSpecs: topItem. "redo the spec cache once in a while"
+
+ "19 sept 2000 - allow flaps in any paste up"
+ flapLoc := associatedMorph. "world"
+ Preferences viewersInFlaps  ifTrue:  [
+ aViewer owner ifNotNil: [ :f | ^f flapTab showFlap; yourself ].
+ aViewer setProperty: #noInteriorThumbnail toValue: true.
+ aViewer initializeFor: aPlayer barHeight: 0.
+ aViewer enforceTileColorPolicy.
+ aViewer fullBounds. "force layout"
+ "associatedMorph addMorph: aViewer." "why???"
+ flapLoc hideViewerFlapsOtherThanFor: aPlayer.
+ aFlapTab := flapLoc viewerFlapTabFor: topItem.
+ aFlapTab referent submorphs
+ do: [:m | (m isKindOf: Viewer) ifTrue: [m delete]].
+ aViewer visible: true.
+ aFlapTab applyThickness: aViewer width + 25.
+ aFlapTab spanWorld.
+ aFlapTab showFlap.
+ aViewer position: aFlapTab referent position.
+ aFlapTab referent addMorph: aViewer beSticky. "moved"
+ flapLoc startSteppingSubmorphsOf: aFlapTab.
+ flapLoc startSteppingSubmorphsOf: aViewer.
+ ^aFlapTab].
+ aViewer initializeFor: aPlayer barHeight: 6.
+ aViewer enforceTileColorPolicy.
+ aViewer fullBounds. "force layout"
+ Preferences automaticViewerPlacement
+ ifTrue:
+ [aPoint := aMorph bounds right
+ @ (aMorph center y - ((nominalHeight := aViewer initialHeightToAllow) // 2)).
+ aRect := (aPoint extent: aViewer width @ nominalHeight)
+ translatedToBeWithin: flapLoc bounds.
+ aViewer position: aRect topLeft.
+ aViewer visible: true.
+ associatedMorph addMorph: aViewer.
+ flapLoc startSteppingSubmorphsOf: aViewer.
+ "it's already in the world, somewhat coincidentally"
+ ^aViewer].
+ aMorph primaryHand attachMorph: (aViewer visible: true).
+ ^aViewer!

Item was added:
+ ----- Method: Presenter>>browseAllScriptsTextually (in category 'playerList') -----
+ browseAllScriptsTextually
+ "Open a method-list browser on all the scripts in the project"
+
+ | aList aMethodList |
+ (aList := self uniclassesAndCounts) size == 0 ifTrue: [^ self inform: 'there are no scripted players'].
+ aMethodList := OrderedCollection new.
+ aList do:
+ [:aPair | aPair first addMethodReferencesTo: aMethodList].
+ aMethodList size > 0 ifFalse: [^ self inform: 'there are no scripts in this project!!'].
+
+ SystemNavigation new
+ browseMessageList: aMethodList
+ name: 'All scripts in this project'
+ autoSelect: nil
+
+ "
+ ActiveWorld presenter browseAllScriptsTextually
+ "!

Item was added:
+ ----- Method: Presenter>>allCurrentlyTickingScriptInstantiations (in category 'playerList') -----
+ allCurrentlyTickingScriptInstantiations
+ "Answer a list of ScriptInstantiation objects representing all the scripts within the scope of the receiver which are currently ticking."
+
+ ^ Array streamContents:
+ [:aStream |
+ self allExtantPlayers do:
+ [:aPlayer | aPlayer instantiatedUserScriptsDo:
+ [:aScriptInstantiation |
+ aScriptInstantiation status == #ticking ifTrue:
+ [aStream nextPut: aScriptInstantiation]]]]!

Item was added:
+ ----- Method: Presenter>>stepStillDown:with: (in category 'stop-step-go buttons') -----
+ stepStillDown: dummy with: theButton
+ "The step button is still down; get temporary button feedback right and step all and then get all button feedback right again"
+
+ self stepButtonState: #pressed.
+ self stopButtonState: #off.
+ associatedMorph stepAll.
+ associatedMorph world displayWorld.
+ self stepButtonState: #off.
+ self stopButtonState: #on
+ !

Item was added:
+ ----- Method: Presenter>>addTrashCan (in category 'button creation') -----
+ addTrashCan
+ | aPosition aCan |
+ (aCan := associatedMorph findA: TrashCanMorph) ifNotNil: [^ aCan].
+ aCan := TrashCanMorph newSticky.
+ aPosition := associatedMorph positionNear: (associatedMorph bottomRight - aCan extent) forExtent: aCan extent adjustmentSuggestion:  (-10 @ 0).
+ aCan position: aPosition.
+ associatedMorph addMorph: aCan.
+ aCan startStepping.
+ aCan setToAdhereToEdge: #bottomRight.
+ ^ aCan
+ !

Item was added:
+ ----- Method: Presenter>>stopUp:with: (in category 'stop-step-go buttons') -----
+ stopUp: dummy with: theButton
+ self flushPlayerListCache.  "catch guys not in cache but who're running"
+ self stopRunningScripts!

Item was added:
+ ----- Method: Presenter>>nascentPartsViewerFor: (in category 'viewer') -----
+ nascentPartsViewerFor: aViewee
+ "Create a new, naked Viewer object for viewing aViewee.  Give it a vocabulary if either the viewee insists on one or if the project insists on one."
+
+ | aViewer aVocab |
+ (aViewee isKindOf: KedamaExamplerPlayer) ifTrue: [^ KedamaStandardViewer new].
+ aViewer := StandardViewer new.
+ (aVocab := aViewee vocabularyDemanded)
+ ifNotNil:
+ [aViewer useVocabulary: aVocab]
+ ifNil:
+ [(aVocab := associatedMorph currentVocabularyFor: aViewee) ifNotNil:
+ [aViewer useVocabulary: aVocab]].
+
+ "If the viewee does not *demand* a special kind of Viewer, and if the project has not specified a preferred vocabulary, then the system defaults will kick in later"
+ ^ aViewer!

Item was added:
+ ----- Method: Presenter>>createStandardPlayer (in category 'standardPlayer etc') -----
+ createStandardPlayer
+ | aMorph |
+
+ aMorph := ImageMorph new image: (ScriptingSystem formAtKey: 'standardPlayer').
+ associatedMorph addMorphFront: aMorph.
+ (standardPlayer := aMorph assuredPlayer) renameTo: 'dot' translated.
+ aMorph setBalloonText: '...'.
+ self positionStandardPlayer.
+ ^ standardPlayer!

Item was added:
+ ----- Method: Presenter>>world (in category 'access') -----
+ world
+ ^ associatedMorph world!

Item was added:
+ ----- Method: Presenter>>allPlayersWithUniclasses (in category 'playerList') -----
+ allPlayersWithUniclasses
+ "Answer a list of all players known to the receiver that have uniclasses"
+
+ ^ self allExtantPlayers select: [:p | p belongsToUniClass]!

Item was added:
+ ----- Method: Presenter>>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 asSortedArray
+
+ "ActiveWorld presenter allKnownUnaryScriptSelectors"
+ !