The Trunk: Protocols-ar.19.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view
|

The Trunk: Protocols-ar.19.mcz

commits-2
Andreas Raab uploaded a new version of Protocols to project The Trunk:
http://source.squeak.org/trunk/Protocols-ar.19.mcz

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

Name: Protocols-ar.19
Author: ar
Time: 4 January 2010, 12:47:59 pm
UUID: ae8a0ffe-fcc0-714f-980b-cc3cfdb231b5
Ancestors: Protocols-nice.15

Make Etoys unloadable: Move some methods to Etoys package.

=============== Diff against Protocols-nice.15 ===============

Item was added:
+ ----- Method: Vocabulary>>isEToyVocabulary (in category 'queries') -----
+ isEToyVocabulary
+ ^false!

Item was changed:
  ----- Method: Vocabulary class>>initializeStandardVocabularies (in category 'class initialization') -----
  initializeStandardVocabularies
  "Initialize a few standard vocabularies and place them in the AllStandardVocabularies list."
 
  AllStandardVocabularies _ nil.
+ Smalltalk at: #EToyVocabulary
+ ifPresent:[:aClass| self addStandardVocabulary: aClass new].
+ Smalltalk at: #EToyVectorVocabulary
+ ifPresent:[:aClass| self addStandardVocabulary: aClass new].
-
- self addStandardVocabulary: EToyVocabulary new.
- self addStandardVocabulary: EToyVectorVocabulary new.
 
  self addStandardVocabulary: self newPublicVocabulary.
  self addStandardVocabulary: FullVocabulary new.
 
  self addStandardVocabulary: self newQuadVocabulary.
 
  self addStandardVocabulary: ColorType new.
  self addStandardVocabulary: BooleanType new.
  self addStandardVocabulary: GraphicType new.
+ Smalltalk at: #PlayerType
+ ifPresent:[:aClass| self addStandardVocabulary: aClass new].
- self addStandardVocabulary: PlayerType new.
  self addStandardVocabulary: SoundType new.
  self addStandardVocabulary: StringType new.
  self addStandardVocabulary: MenuType new.
  self addStandardVocabulary: UnknownType new.
+ Smalltalk at: #ScriptNameType
+ ifPresent:[:aClass| self addStandardVocabulary: aClass new].
- self addStandardVocabulary: ScriptNameType new.
 
  self addStandardVocabulary: (SymbolListType new symbols: #(simple raised inset complexFramed complexRaised complexInset complexAltFramed complexAltRaised complexAltInset); vocabularyName: #BorderStyle; yourself).
  self addStandardVocabulary: (SymbolListType new symbols: #(lines arrows arrowheads dots); vocabularyName: #TrailStyle; yourself).
  self addStandardVocabulary: (SymbolListType new symbols: #(leftToRight rightToLeft topToBottom bottomToTop); vocabularyName: #ListDirection; yourself).
 
  self addStandardVocabulary: (SymbolListType new symbols: #(topLeft bottomRight center justified); vocabularyName: #ListCentering; yourself).
 
  self addStandardVocabulary: (SymbolListType new symbols: #(buttonDown whilePressed buttonUp); vocabularyName: #ButtonPhase; yourself).
 
  self addStandardVocabulary: (SymbolListType new symbols: #(rotate #'do not rotate' #'flip left right' #'flip up down'); vocabularyName: #RotationStyle; yourself).
 
  self addStandardVocabulary: (SymbolListType new symbols: #(rigid spaceFill shrinkWrap); vocabularyName: #Resizing; yourself).
 
  self addStandardVocabulary: self newSystemVocabulary.  "A custom vocabulary for Smalltalk -- still under development)"
 
  self numberVocabulary.   "creates and adds it"
  self wonderlandVocabulary.   "creates and adds it"
  self vocabularyForClass: Time.   "creates and adds it"
 
+ Smalltalk at: #KedamaPatchType ifPresent:[:aClass|
+ self addStandardVocabulary: (aClass new vocabularyName: #Patch; yourself).
+ ].
- self addStandardVocabulary: (KedamaPatchType new vocabularyName: #Patch; yourself).
  self addStandardVocabulary: (SymbolListType new symbols: #(wrap stick bouncing); vocabularyName: #EdgeMode; yourself).
  self addStandardVocabulary: (SymbolListType new symbols: #(logScale linear color); vocabularyName: #PatchDisplayMode; yourself).
 
  "Vocabulary initialize"!

Item was removed:
- ----- Method: MethodInterface>>initializeFromEToyCommandSpec:category: (in category 'initialization') -----
- initializeFromEToyCommandSpec: tuple category: aCategorySymbol
- "tuple holds an old etoy command-item spec, of the form found in #additionsToViewerCategories methods.   Initialize the receiver to hold the same information"
-
- selector := tuple second.
- receiverType := #Player.
- selector numArgs = 1 ifTrue:
- [argumentVariables := OrderedCollection with:
- (Variable new name: (Player formalHeaderPartsFor: selector) fourth type: tuple fourth)].
-
- aCategorySymbol ifNotNil: [self flagAttribute: aCategorySymbol].
- self
- wording: (ScriptingSystem wordingForOperator: selector);
- helpMessage:  tuple third!

Item was removed:
- ----- Method: ColorType>>wantsArrowsOnTiles (in category 'tiles') -----
- wantsArrowsOnTiles
- "Answer whether this data type wants up/down arrows on tiles representing its values"
-
- ^ false!

Item was removed:
- ----- Method: ColorType>>updatingTileForTarget:partName:getter:setter: (in category 'tiles') -----
- updatingTileForTarget: aTarget partName: partName getter: getter setter: setter
- "Answer, for classic tiles, an updating readout tile for a part with the receiver's type, with the given getter and setter"
-
- | readout |
- readout _ UpdatingRectangleMorph new.
- readout
- getSelector: getter;
- target: aTarget;
- borderWidth: 1;
- extent:  22@22.
- ((aTarget isKindOf: KedamaExamplerPlayer) and: [getter = #getColor]) ifTrue: [
- readout getSelector: #getColorOpaque.
- ].
- (setter isNil or: [#(unused none #nil) includes: setter]) ifFalse:
- [readout putSelector: setter].
- ^ readout
- !

Item was removed:
- ----- Method: Vocabulary class>>instanceWhoRespondsTo: (in category '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!

Item was removed:
- ----- Method: MethodInterface>>initializeFromEToySlotSpec: (in category 'initialization') -----
- initializeFromEToySlotSpec: tuple
- "tuple holds an old etoy slot-item spec, of the form found in #additionsToViewerCategories methods.   Initialize the receiver to hold the same information"
-
- | setter |
- selector _ tuple seventh.
- self
- wording: (ScriptingSystem wordingForOperator: tuple second);
- helpMessage: tuple third.
-
- receiverType _ #Player.
- resultSpecification _ ResultSpecification new.
- resultSpecification resultType: tuple fourth.
- (#(getNewClone getTurtleAt: getTurtleOf: "seesColor: isOverColor:") includes: selector)
- ifTrue:
- [self setNotToRefresh]  "actually should already be nil"
- ifFalse:
- [self setToRefetch].
-
- ((tuple fifth == #readWrite) and: [((tuple size >= 9) and: [(setter _ tuple at: 9) ~~ #unused])]) ifTrue:
- [resultSpecification companionSetterSelector: setter].
-
- "An example of an old slot-item spec:
- (slot numericValue 'A number representing the current position of the knob.' number readWrite Player getNumericValue Player setNumericValue:)
- 1 #slot
- 2 wording
- 3 balloon help
- 4 type
- 5 #readOnly or #readWrite
- 6 #Player (not used -- ignore)
- 7 getter selector
- 8 #Player (not used -- ignore)
- 9 setter selector
- "
- !