[squeak-dev] The Trunk: EToys-bf.119.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Dec 8 00:39:47 UTC 2014


Bert Freudenberg uploaded a new version of EToys to project The Trunk:
http://source.squeak.org/trunk/EToys-bf.119.mcz

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

Name: EToys-bf.119
Author: bf
Time: 8 December 2014, 1:39:03.772 am
UUID: 5b17be15-da78-4207-88e4-f2c78f0e75b9
Ancestors: EToys-dtl.118

Restore timestamps lost in assignment conversion.

=============== Diff against EToys-dtl.118 ===============

Item was changed:
  ----- Method: CardPlayer class>>compileAccessorsFor: (in category 'slots') -----
  compileAccessorsFor: varName
  	"Compile instance-variable accessor methods for the given variable name"
  
  	| nameString |
  	nameString := varName asString capitalized.
  	self compileSilently: ('get', nameString, '
  	^ ', varName)
  		classified: 'access'.
  	self compileSilently: ('set', nameString, ': val
  	', varName, ' := val')
  		classified: 'access'!

Item was changed:
  ----- Method: EToyVocabulary class>>masterOrderingOfCategorySymbols (in category 'accessing') -----
  masterOrderingOfCategorySymbols
  	"Answer a dictatorially-imposed presentation list of category symbols.
  	This governs the order in which available vocabulary categories are presented in etoy viewers using the etoy vocabulary.
  	The default implementation is that any items that are in this list will occur first, in the order specified here; after that, all other items will come, in alphabetic order by their translated wording."
  
  	^#(basic #'color & border' geometry motion #'pen use' tests layout #'drag & drop' scripting observation button search miscellaneous)!

Item was changed:
  ----- Method: EToyVocabulary>>isEToyVocabulary (in category 'testing') -----
  isEToyVocabulary
  	^true!

Item was changed:
  ----- Method: FileDirectory>>eToyUserList (in category '*Etoys') -----
  eToyUserList
  	| spec index fd list match |
  	spec := self eToyBaseFolderSpec. "something like 'U:\Squeak\users\*-Squeak'."
  	spec ifNil:[^ServerDirectory eToyUserListForFileDirectory: self].
  	"Compute list of users based on base folder spec"
  	index := spec indexOf: $*. "we really need one"
  	index = 0 ifTrue:[^ServerDirectory eToyUserListForFileDirectory: self].
  	fd := FileDirectory on: (FileDirectory dirPathFor: (spec copyFrom: 1 to: index)).
  	"reject all non-directories"
  	list := fd entries select:[:each| each isDirectory].
  	"reject all non-matching entries"
  	match := spec copyFrom: fd pathName size + 2 to: spec size.
  	list := list collect:[:each| each name].
  	list := list select:[:each| match match: each].
  	"extract the names (e.g., those positions that match '*')"
  	index := match indexOf: $*.
  	list := list collect:[:each|
  		each copyFrom: index to: each size - (match size - index)].
  	^list!

Item was changed:
  ----- Method: FileDirectory>>eToyUserName: (in category '*Etoys') -----
  eToyUserName: aString
  	"Set the default directory from the given user name"
  	| dirName |
  	dirName := self eToyBaseFolderSpec. "something like 'U:\Squeak\users\*-Squeak'"
  	dirName ifNil:[^self].
  	dirName := dirName copyReplaceAll:'*' with: aString.
  "	dirName last = self class pathNameDelimiter ifFalse:[dirName := dirName, self slash].
  	FileDirectory setDefaultDirectoryFrom: dirName.
  	dirName := dirName copyFrom: 1 to: dirName size - 1.
  
  "	pathName := FilePath pathName: dirName!

Item was changed:
  ----- Method: MethodHolder class>>isolatedCodePaneForClass:selector: (in category '*Etoys') -----
  isolatedCodePaneForClass: aClass selector: aSelector
  	"Answer a MethodMorph on the given class and selector"
  
  	| aCodePane aMethodHolder |
  
  	aMethodHolder := self new.
  	aMethodHolder methodClass: aClass methodSelector: aSelector.
  
  	aCodePane := MethodMorph on: aMethodHolder text: #contents accept: #contents:notifying:
  			readSelection: #contentsSelection menu: #codePaneMenu:shifted:.
  	aMethodHolder addDependent: aCodePane.
  	aCodePane borderWidth: 2; color: Color white.
  	aCodePane scrollBarOnLeft: false.
  	aCodePane width: 300.
  	^ aCodePane!

Item was changed:
  ----- Method: MethodHolder class>>makeIsolatedCodePaneForClass:selector: (in category '*Etoys') -----
  makeIsolatedCodePaneForClass: aClass selector: aSelector
  	"Create, and place in the morphic Hand, an isolated code pane bearing source code for the given class and selector"
  
  	(self isolatedCodePaneForClass: aClass selector: aSelector) openInHand!

Item was changed:
  ----- Method: Player class>>compileInstVarAccessorsFor: (in category 'slots') -----
  compileInstVarAccessorsFor: varName
  	"Compile getters and setteres for the given instance variable name"
  
  	| nameString |
  	nameString := varName asString capitalized.
  	self compileSilently: ('get', nameString, '
  	^ ', varName)
  		classified: 'access'.
  	self compileSilently: ('set', nameString, ': val
  	', varName, ' := val')
  		classified: 'access'!

Item was changed:
  ----- Method: Player>>getConePosition (in category 'sound') -----
  getConePosition
  	"Note: Performance hacked to allow real-time sound. Assumes costume is a SpeakerMorph."
  
  	^ costume renderedMorph conePosition!

Item was changed:
  ----- Method: Player>>setConePosition: (in category 'sound') -----
  setConePosition: aNumber
  	"Note: Performance hacked to allow real-time sound. Assumes costume is a SpeakerMorph."
  
  	costume renderedMorph conePosition: aNumber.!

Item was changed:
  ----- Method: Point>>basicType (in category '*Etoys-tiles') -----
  basicType
  	"Answer a symbol representing the inherent type of the receiver"
  
  	^ #Point!

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:				"current showing textual source"
  			[Preferences universalTiles
  				ifTrue: [^ self revertToTileVersion].
  			self savedTileVersionsCount >= 1
  				ifTrue:
  					[(self userScriptObject lastSourceString = (playerScripted class compiledMethodAt: scriptName) decompileString)
  						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 changed:
  ----- Method: String>>newTileMorphRepresentative (in category '*Etoys-tiles') -----
  newTileMorphRepresentative
  	^ TileMorph new setLiteral: self;addSuffixIfCan!

Item was changed:
  ----- Method: SyntaxMorph class>>allSpecs (in category 'accessing') -----
  allSpecs
  	"Return all specs that the Viewer knows about. Cache them."
  	"SyntaxMorph allSpecs"
  
  	^AllSpecs ifNil: [
  		AllSpecs := Dictionary new.
  		(EToyVocabulary morphClassesDeclaringViewerAdditions)
  			do: [:cls | cls allAdditionsToViewerCategories keysAndValuesDo: [ :k :v | 
  				(AllSpecs at: k ifAbsentPut: [ OrderedCollection new ]) addAll: v ] ].
  		AllSpecs
  	]!

Item was changed:
  ----- Method: SyntaxMorph class>>clearAllSpecs (in category 'accessing') -----
  clearAllSpecs
  	"Clear the specs that the Viewer knows about."
  	"SyntaxMorph clearAllSpecs"
  
  	AllSpecs := nil.!

Item was changed:
  ----- Method: SyntaxMorph>>assignmentArrow (in category 'pop ups') -----
  assignmentArrow
  	"Offer to embed this variable in a new assignment statement.  (Don't confuse this with upDownAssignment:, which runs the up and down arrows that rotate among assignment types.)"
  	| rr |
  
  	self isAVariable ifFalse: [^ nil].
  	self isDeclaration ifTrue: [^ nil].
  	^ (rr := RectangleMorph new)
  		extent: 11 at 13; borderWidth: 1; color: Color lightGreen;
  		borderColor: Color gray;
  		addMorph: ((self noiseStringMorph: '_') topLeft: rr topLeft + (3 at 0));
  		on: #mouseUp send: #newAssignment to: self
  !

Item was changed:
  ----- Method: SyntaxMorph>>assignmentNode:variable:value: (in category 'node to morph') -----
  assignmentNode: aNode variable: variable value: value
  
  	| row v expMorph |
  
  	row := self addRow: #assignment on: aNode.
  	v := variable asMorphicSyntaxIn: row.
  	self alansTest1 ifTrue: [v setConditionalPartStyle; layoutInset: 2].
  	row addToken: ' := ' type: #assignmentArrow on: aNode.
  	expMorph := value asMorphicSyntaxIn: row.
  	self alansTest1 ifTrue: [
  		row setSpecialOuterTestFormat.
  		(expMorph hasProperty: #deselectedColor) ifFalse: [expMorph setConditionalPartStyle].
  	].
  	^row
  !

Item was changed:
  ----- Method: SyntaxMorph>>offerTilesMenuFor:in: (in category 'menus') -----
  offerTilesMenuFor: aReceiver in: aLexiconModel
  	"Offer a menu of tiles for assignment and constants"
  
  	| menu |
  	menu := MenuMorph new addTitle: 'Hand me a tile for...'.
  	menu addLine.
  	menu add: '(accept method now)' target: aLexiconModel selector: #acceptTiles.
  	menu submorphs last color: Color red darker.
  	menu addLine.
  
  	menu add: 'me, by name' target: self  selector: #attachTileForCode:nodeType: 
  				argumentList: {'<me by name>'. aReceiver}.
  	menu add: 'self' target: self  selector: #attachTileForCode:nodeType: 
  				argumentList: {'self'. VariableNode}.
  	menu add: '_   (assignment)' target: self  selector: #attachTileForCode:nodeType: 
  				argumentList: {'<assignment>'. nil}.
  	menu add: '"a Comment"' target: self  selector: #attachTileForCode:nodeType: 
  				argumentList: {'"a comment"\' withCRs. CommentNode}.
  	menu submorphs last color: Color blue.
  	menu add: 'a Number' target: self  selector: #attachTileForCode:nodeType: 
  				argumentList: {'5'. LiteralNode}.
  	menu add: 'a Character' target: self  selector: #attachTileForCode:nodeType: 
  				argumentList: {'$z'. LiteralNode}.
  	menu add: '''abc''' target: self selector: #attachTileForCode:nodeType: 
  				argumentList: {'''abc'''. LiteralNode}.
  	menu add: 'a Symbol constant' target: self selector: #attachTileForCode:nodeType: 
  				argumentList: {'#next'. LiteralNode}.
  	menu add: 'true' target: self selector: #attachTileForCode:nodeType: 
  				argumentList: {'true'. VariableNode}.
  	menu add: 'a Test' target: self  selector: #attachTileForCode:nodeType: 
  				argumentList: {'true ifTrue: [self] ifFalse: [self]'. MessageNode}.
  	menu add: 'a Loop' target: self selector: #attachTileForCode:nodeType: 
  				argumentList: {'1 to: 10 do: [:index | self]'. MessageNode}.
  	menu add: 'a Block' target: self selector: #attachTileForCode:nodeType: 
  				argumentList: {'[self]'. BlockNode}.
  	menu add: 'a Class or Global' target: self selector: #attachTileForCode:nodeType: 
  				argumentList: {'Character'. LiteralVariableNode}.
  	menu add: 'a Reply' target: self selector: #attachTileForCode:nodeType: 
  				argumentList: {'| temp | temp'. ReturnNode}.
  	menu popUpAt: ActiveHand position forHand: ActiveHand in: World.
  !

Item was changed:
  ----- Method: TileMorph>>mouseMove: (in category 'event handling') -----
  mouseMove: evt 
  	self options
  		ifNotNil: [^ self showOptions].
  	(self hasProperty: #previousLiteral)
  		ifFalse: [^ self].
  	self currentHand releaseKeyboardFocus.
  	"Once reviving the value at drag start"
  	literal := self valueOfProperty: #previousLiteral.
  	"Then applying delta"
  	self arrowAction: (self valueOfProperty: #previousPoint) y - evt position y * self arrowDelta abs.
  	^ super mouseMove: evt!

Item was changed:
  ----- Method: TypeListTile>>addMenuIcon (in category 'arrows') -----
  addMenuIcon
  	"Add a little menu icon; store it in my suffixArrow slot"
  
  	suffixArrow := ImageMorph new image: (ScriptingSystem formAtKey: #MenuTriangle).
  	suffixArrow setBalloonText: 'click here to choose a new type for this parameter' translated.
  	self addMorphBack: suffixArrow!

Item was changed:
  ----- Method: Vocabulary class>>instanceWhoRespondsTo: (in category '*Etoys-queries') -----
  instanceWhoRespondsTo: aSelector 
  	"Find the most likely class that responds to aSelector. Return an instance 
  	of it. Look in vocabularies to match the selector."
  	"Most eToy selectors are for Players"
  	| mthRefs |
  	((self vocabularyNamed: #eToy)
  			includesSelector: aSelector)
  		ifTrue: [aSelector == #+
  				ifFalse: [^ Player new costume: Morph new]].
  	"Numbers are a problem"
  	((self vocabularyNamed: #Number)
  			includesSelector: aSelector)
  		ifTrue: [^ 1].
  	"Is a Float any different?"
  	"String Point Time Date"
  	#()
  		do: [:nn | ((self vocabularyNamed: nn)
  					includesSelector: aSelector)
  				ifTrue: ["Ask Scott how to get a prototypical instance"
  					^ (Smalltalk at: nn) new]].
  	mthRefs := self systemNavigation allImplementorsOf: aSelector.
  	"every one who implements the selector"
  	mthRefs
  		sortBlock: [:a :b | (Smalltalk at: a classSymbol) allSuperclasses size < (Smalltalk at: b classSymbol) allSuperclasses size].
  	mthRefs size > 0
  		ifTrue: [^ (Smalltalk at: mthRefs first classSymbol) new].
  	^ Error new!



More information about the Squeak-dev mailing list