[Pkg] The Trunk: FlexibleVocabularies-ar.12.mcz
commits at source.squeak.org
commits at source.squeak.org
Sun Jan 3 23:37:51 UTC 2010
Andreas Raab uploaded a new version of FlexibleVocabularies to project The Trunk:
http://source.squeak.org/trunk/FlexibleVocabularies-ar.12.mcz
==================== Summary ====================
Name: FlexibleVocabularies-ar.12
Author: ar
Time: 4 January 2010, 12:37:49 pm
UUID: d0f56f5d-6893-2a44-9057-2b5a392cdb26
Ancestors: FlexibleVocabularies-nice.10
Make Etoys unloadable: Move FlexibleVocabularies to Etoys package.
=============== Diff against FlexibleVocabularies-nice.10 ===============
Item was removed:
- ----- Method: Player>>hasAnyBorderedCostumes (in category '*flexibleVocabularies-flexibleVocabularies-costume') -----
- hasAnyBorderedCostumes
- "Answer true if any costumes of the receiver are BorderedMorph descendents"
-
- self costumesDo:
- [:cost | (cost understandsBorderVocabulary) ifTrue: [^ true]].
- ^ false!
Item was removed:
- ----- Method: Morph class>>additionsToViewerCategory: (in category '*flexibleVocabularies-flexiblevocabularies-scripting') -----
- additionsToViewerCategory: aCategoryName
- "Answer a list of viewer specs for items to be added to the given category on behalf of the receiver. Each class in a morph's superclass chain is given the opportunity to add more things"
-
- aCategoryName == #vector ifTrue:
- [^ self vectorAdditions].
- ^self allAdditionsToViewerCategories at: aCategoryName ifAbsent: [ #() ].!
Item was removed:
- ----- Method: Morph class>>unfilteredCategoriesForViewer (in category '*flexibleVocabularies-flexiblevocabularies-scripting') -----
- unfilteredCategoriesForViewer
- "Answer a list of symbols representing the categories to offer in the viewer for one of my instances, in order of:
- - masterOrderingOfCategorySymbols first
- - others last in order by translated wording"
- "
- Morph unfilteredCategoriesForViewer
- "
-
- | aClass additions masterOrder |
- aClass := self.
- additions := OrderedCollection new.
- [aClass == Morph superclass ] whileFalse: [
- additions addAll: (aClass allAdditionsToViewerCategories keys asArray
- sort: [ :a :b | a translated < b translated ]).
- aClass := aClass superclass ].
-
- masterOrder := EToyVocabulary masterOrderingOfCategorySymbols.
-
- ^(masterOrder intersection: additions), (additions difference: masterOrder).!
Item was removed:
- PackageInfo subclass: #FlexibleVocabulariesInfo
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'FlexibleVocabularies-Info'!
-
- !FlexibleVocabulariesInfo commentStamp: 'nk 3/11/2004 16:38' prior: 0!
- Package: FlexibleVocabularies-nk
- Date: 12 October 2003
- Author: Ned Konz
-
- This makes it possible for packages to extend Morph class vocabularies.
- Previously, you'd have to edit #additionsToViewerCategories, which would result in potential conflicts between different packages that all wanted to (for instance) extend Morph's vocabulary.
-
- Subclasses that have additions can do one or both of:
- - override #additionsToViewerCategories (as before)
- - define one or more additionToViewerCategory* methods.
-
- The advantage of the latter technique is that class extensions may be added
- by external packages without having to re-define additionsToViewerCategories.
-
- So, for instance, package A could add a method named #additionsToViewerCategoryPackageABasic
- and its methods would be added to the vocabulary automatically.
-
- NOTE: this change set is hand-rearranged to avoid problems on file-in.
-
- Specifically, Morph>>hasAdditionsToViewerCategories must come before Morph class>>additionsToViewerCategories
- !
Item was removed:
- ----- Method: Morph>>selectorsForViewer (in category '*flexiblevocabularies-scripting') -----
- selectorsForViewer
- "Answer a list of symbols representing all the selectors available in all my viewer categories"
-
- | aClass aList itsAdditions added addBlock |
- aClass := self renderedMorph class.
- aList := OrderedCollection new.
- added := Set new.
- addBlock := [ :sym | (added includes: sym) ifFalse: [ added add: sym. aList add: sym ]].
-
- [aClass == Morph superclass] whileFalse:
- [(aClass hasAdditionsToViewerCategories)
- ifTrue:
- [itsAdditions := aClass allAdditionsToViewerCategories.
- itsAdditions do: [ :add | add do: [:aSpec |
- "the spec list"
-
- aSpec first == #command ifTrue: [ addBlock value: aSpec second].
- aSpec first == #slot
- ifTrue:
- [ addBlock value: (aSpec seventh).
- addBlock value: aSpec ninth]]]].
- aClass := aClass superclass].
-
- ^aList copyWithoutAll: #(#unused #dummy)
-
- "SimpleSliderMorph basicNew selectorsForViewer"!
Item was removed:
- ----- Method: Morph>>understandsBorderVocabulary (in category '*flexiblevocabularies-scripting') -----
- understandsBorderVocabulary
- "Replace the 'isKindOf: BorderedMorph' so that (for instance) Connectors can have their border vocabulary visible in viewers."
- ^false!
Item was removed:
- ----- Method: PasteUpMorph>>printVocabularySummary (in category '*flexiblevocabularies-scripting') -----
- printVocabularySummary
- "Put up a window with summaries of all Morph vocabularies."
-
-
- (StringHolder new contents: EToyVocabulary vocabularySummary)
- openLabel: 'EToy Vocabulary'
-
- "self currentWorld printVocabularySummary"!
Item was removed:
- ----- Method: BorderedMorph>>understandsBorderVocabulary (in category '*flexibleVocabularies-scripting') -----
- understandsBorderVocabulary
- "Replace the 'isKindOf: BorderedMorph' so that (for instance) Connectors can have their border vocabulary visible in viewers."
- ^true!
Item was removed:
- ----- Method: Morph class>>additionsToViewerCategories (in category '*flexibleVocabularies-flexiblevocabularies-scripting') -----
- additionsToViewerCategories
- "Answer a list of (<categoryName> <list of category specs>) pairs that characterize the
- phrases this kind of morph wishes to add to various Viewer categories.
-
- This version factors each category definition into a separate method.
-
- Subclasses that have additions can either:
- - override this method, or
- - (preferably) define one or more additionToViewerCategory* methods.
-
- The advantage of the latter technique is that class extensions may be added
- by external packages without having to re-define additionsToViewerCategories.
- "
- ^#()!
Item was removed:
- ----- Method: StandardScriptingSystem class>>noteAddedSelector:meta: (in category '*flexibleVocabularies-flexibleVocabularies') -----
- noteAddedSelector: aSelector meta: isMeta
- aSelector == #wordingForOperator: ifTrue:
- [Vocabulary changeMadeToViewerAdditions].
- super noteAddedSelector: aSelector meta: isMeta!
Item was removed:
- ----- Method: FlexibleVocabulariesInfo class>>initialize (in category 'class initialization') -----
- initialize
- [self new register] on: MessageNotUnderstood do: [].
- SyntaxMorph class removeSelector: #initialize.
- SyntaxMorph removeSelector: #allSpecs.
- EToyVocabulary removeSelector: #morphClassesDeclaringViewerAdditions.
- SyntaxMorph clearAllSpecs.
- Vocabulary initialize.
- !
Item was removed:
- ----- Method: SyntaxMorph class>>allSpecs (in category '*flexibleVocabularies-flexiblevocabularies-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 removed:
- ----- Method: Morph class>>noteAddedSelector:meta: (in category '*flexibleVocabularies-flexibleVocabularies') -----
- noteAddedSelector: aSelector meta: isMeta
- "Any change to an additionsToViewer... method can invalidate existing etoy vocabularies.
- The #respondsTo: test is to allow loading the FlexibleVocabularies change set without having to worry about method ordering."
- (isMeta
- and: [(aSelector beginsWith: 'additionsToViewer')
- and: [self respondsTo: #hasAdditionsToViewerCategories]])
- ifTrue: [Vocabulary changeMadeToViewerAdditions].
- super noteCompilationOf: aSelector meta: isMeta!
Item was removed:
- ----- Method: Morph>>categoriesForViewer (in category '*flexiblevocabularies-scripting') -----
- categoriesForViewer
- "Answer a list of symbols representing the categories to offer in the
- viewer, in order"
- | dict |
- dict := Dictionary new.
- self unfilteredCategoriesForViewer
- withIndexDo: [:cat :index | dict at: cat put: index].
- self filterViewerCategoryDictionary: dict.
- ^ dict keys asArray sort: [:a :b | (dict at: a)
- < (dict at: b)]!
Item was removed:
- ----- Method: Morph>>selectorsForViewerIn: (in category '*flexiblevocabularies-scripting') -----
- selectorsForViewerIn: aCollection
- "Answer a list of symbols representing all the selectors available in all my viewer categories, selecting only the ones in aCollection"
-
- | aClass aList itsAdditions added addBlock |
- aClass := self renderedMorph class.
- aList := OrderedCollection new.
- added := Set new.
- addBlock := [ :sym |
- (added includes: sym) ifFalse: [ (aCollection includes: sym)
- ifTrue: [ added add: sym. aList add: sym ]]].
-
- [aClass == Morph superclass] whileFalse:
- [(aClass hasAdditionsToViewerCategories)
- ifTrue:
- [itsAdditions := aClass allAdditionsToViewerCategories.
- itsAdditions do: [ :add | add do: [:aSpec |
- "the spec list"
-
- aSpec first == #command ifTrue: [ addBlock value: aSpec second].
- aSpec first == #slot
- ifTrue:
- [ addBlock value: (aSpec seventh).
- addBlock value: aSpec ninth]]]].
- aClass := aClass superclass].
-
- ^aList copyWithoutAll: #(#unused #dummy)
-
- "SimpleSliderMorph basicNew selectorsForViewerIn:
- #(setTruncate: getColor setColor: getKnobColor setKnobColor: getWidth setWidth: getHeight setHeight: getDropEnabled setDropEnabled:)
- "!
Item was removed:
- ----- Method: EToyVocabulary>>initialize (in category '*flexibleVocabularies-flexiblevocabularies-initialization') -----
- initialize
- "Initialize the receiver (automatically called when instances are created via 'new')"
-
- | classes categorySymbols |
- super initialize.
- self vocabularyName: #eToy.
- self documentation: '"EToy" is a vocabulary that provides the equivalent of the 1997-2000 etoy prototype'.
- categorySymbols := Set new.
- classes := self class morphClassesDeclaringViewerAdditions.
- classes do:
- [:aMorphClass | categorySymbols addAll: aMorphClass unfilteredCategoriesForViewer].
- self addCustomCategoriesTo: categorySymbols. "For benefit, e.g., of EToyVectorVocabulary"
-
- categorySymbols asOrderedCollection do:
- [:aCategorySymbol | | selectors aMethodCategory |
- aMethodCategory := ElementCategory new categoryName: aCategorySymbol.
- selectors := Set new.
- classes do:
- [:aMorphClass |
- (aMorphClass additionsToViewerCategory: aCategorySymbol) do:
- [:anElement | | selector aMethodInterface |
- aMethodInterface := self methodInterfaceFrom: anElement.
- selectors add: (selector := aMethodInterface selector).
- (methodInterfaces includesKey: selector) ifFalse:
- [methodInterfaces at: selector put: aMethodInterface].
- self flag: #deferred.
- "NB at present, the *setter* does not get its own method interface. Need to revisit"].
-
- (selectors copyWithout: #unused) asSortedArray do:
- [:aSelector |
- aMethodCategory elementAt: aSelector put: (methodInterfaces at: aSelector)]].
-
- self addCategory: aMethodCategory].
-
- self addCategoryNamed: ScriptingSystem nameForInstanceVariablesCategory.
- self addCategoryNamed: ScriptingSystem nameForScriptsCategory.
- self setCategoryDocumentationStrings.
- (self respondsTo: #applyMasterOrdering)
- ifTrue: [ self applyMasterOrdering ].!
Item was removed:
- ----- Method: Morph class>>allAdditionsToViewerCategories (in category '*flexibleVocabularies-flexiblevocabularies-scripting') -----
- allAdditionsToViewerCategories
- "Answer a Dictionary of (<categoryName> <list of category specs>) that
- defines the phrases this kind of morph wishes to add to various Viewer categories.
-
- This version allows each category definition to be defined in one or more separate methods.
-
- Subclasses that have additions can either:
- - override #additionsToViewerCategories, or
- - (preferably) define one or more additionToViewerCategory* methods.
-
- The advantage of the latter technique is that class extensions may be added by
- external packages without having to re-define additionsToViewerCategories."
-
- "
- Morph allAdditionsToViewerCategories
- "
- | dict |
- dict := IdentityDictionary new.
- (self class includesSelector: #additionsToViewerCategories)
- ifTrue: [self additionsToViewerCategories
- do: [:group | group
- pairsDo: [:key :list | (dict
- at: key
- ifAbsentPut: [OrderedCollection new])
- addAll: list]]].
- self class selectorsDo:
- [:aSelector | ((aSelector beginsWith: 'additionsToViewerCategory')
- and: [(aSelector at: 26 ifAbsent: []) ~= $:])
- ifTrue: [(self perform: aSelector)
- pairsDo: [:key :list | (dict
- at: key
- ifAbsentPut: [OrderedCollection new])
- addAll: list]]].
- ^ dict!
Item was removed:
- ----- Method: TheWorldMenu>>scriptingMenu (in category '*flexibleVocabularies-flexibleVocabularies-construction') -----
- scriptingMenu
- "Build the authoring-tools menu for the world."
-
- ^ self fillIn: (self menu: 'authoring tools...') from: {
- { 'objects (o)' . { #myWorld . #activateObjectsTool }. 'A searchable source of new objects.'}.
- nil. "----------"
- { 'view trash contents' . { #myWorld . #openScrapsBook:}. 'The place where all your trashed morphs go.'}.
- { 'empty trash can' . { Utilities . #emptyScrapsBook}. 'Empty out all the morphs that have accumulated in the trash can.'}.
- nil. "----------"
-
- { 'new scripting area' . { #myWorld . #detachableScriptingSpace}. 'A window set up for simple scripting.'}.
-
- nil. "----------"
-
- { 'status of scripts' . {#myWorld . #showStatusOfAllScripts}. 'Lets you view the status of all the scripts belonging to all the scripted objects of the project.'}.
- { 'summary of scripts' . {#myWorld . #printScriptSummary}. 'Produces a summary of scripted objects in the project, and all of their scripts.'}.
- { 'browser for scripts' . {#myWorld . #browseAllScriptsTextually}. 'Allows you to view all the scripts in the project in a traditional programmers'' "browser" format'}.
-
-
- nil.
-
- { 'gallery of players' . {#myWorld . #galleryOfPlayers}. 'A tool that lets you find out about all the players used in this project'}.
-
- " { 'gallery of scripts' . {#myWorld . #galleryOfScripts}. 'Allows you to view all the scripts in the project'}."
-
- { 'etoy vocabulary summary' . {#myWorld . #printVocabularySummary }. 'Displays a summary of all the pre-defined commands and properties in the pre-defined EToy vocabulary.'}.
-
- { 'attempt misc repairs' . {#myWorld . #attemptCleanup}. 'Take measures that may help fix up some things about a faulty or problematical project.'}.
-
- { 'remove all viewers' . {#myWorld . #removeAllViewers}. 'Remove all the Viewers from this project.'}.
-
- { 'refer to masters' . {#myWorld . #makeAllScriptEditorsReferToMasters }. 'Ensure that all script editors are referring to the first (alphabetically by external name) Player of their type' }.
-
- nil. "----------"
-
- { 'unlock locked objects' . { #myWorld . #unlockContents}. 'If any items on the world desktop are currently locked, unlock them.'}.
- { 'unhide hidden objects' . { #myWorld . #showHiders}. 'If any items on the world desktop are currently hidden, make them visible.'}.
- }!
Item was removed:
- ----- Method: SyntaxMorph class>>clearAllSpecs (in category '*flexibleVocabularies-flexiblevocabularies-accessing') -----
- clearAllSpecs
- "Clear the specs that the Viewer knows about."
- "SyntaxMorph clearAllSpecs"
-
- AllSpecs := nil.!
Item was removed:
- ----- Method: Morph>>unfilteredCategoriesForViewer (in category '*flexibleVocabularies-flexiblevocabularies-scripting') -----
- unfilteredCategoriesForViewer
- "Answer a list of symbols representing the categories to offer in the viewer, in order of:
- - masterOrderingOfCategorySymbols first
- - others last in order by translated wording"
- "
- Morph basicNew unfilteredCategoriesForViewer
- "
- ^self renderedMorph class unfilteredCategoriesForViewer.
- !
Item was removed:
- ----- Method: Morph class>>additionToViewerCategorySelectors (in category '*flexibleVocabularies-flexiblevocabularies-scripting') -----
- additionToViewerCategorySelectors
- "Answer the list of my selectors matching additionsToViewerCategory*"
- ^self class organization allMethodSelectors select: [ :ea |
- (ea beginsWith: 'additionsToViewerCategory')
- and: [ (ea at: 26 ifAbsent: []) ~= $: ]]!
Item was removed:
- ----- Method: Morph class>>noteCompilationOf:meta: (in category '*flexibleVocabularies-flexibleVocabularies') -----
- noteCompilationOf: aSelector meta: isMeta
- "This method does nothing and should be removed!!"
-
- ^ super noteCompilationOf: aSelector meta: isMeta!
Item was removed:
- ----- Method: EToyVocabulary class>>masterOrderingOfCategorySymbols (in category '*flexibleVocabularies-flexiblevocabularies-scripting') -----
- 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 removed:
- ----- Method: EToyVocabulary class>>morphClassesDeclaringViewerAdditions (in category '*flexibleVocabularies-flexiblevocabularies-scripting') -----
- morphClassesDeclaringViewerAdditions
- "Answer a list of actual morph classes that either implement #additionsToViewerCategories,
- or that have methods that match #additionToViewerCategory* ."
-
- ^(Morph class allSubInstances select: [ :ea | ea hasAdditionsToViewerCategories ])
- !
Item was removed:
- ----- Method: EToyVocabulary class>>vocabularySummary (in category '*flexibleVocabularies-flexiblevocabularies-scripting') -----
- vocabularySummary
- "Answer a string describing all the vocabulary defined anywhere in the
- system."
- "
- (StringHolder new contents: EToyVocabulary vocabularySummary)
- openLabel: 'EToy Vocabulary' translated
- "
- | etoyVocab |
- etoyVocab := Vocabulary eToyVocabulary.
- etoyVocab initialize. "just to make sure that it's unfiltered."
- ^ String streamContents: [:s |
- self morphClassesDeclaringViewerAdditions do: [:cl | | allAdditions |
- s nextPutAll: cl name; cr.
- allAdditions := cl allAdditionsToViewerCategories.
- cl unfilteredCategoriesForViewer do: [ :cat |
- allAdditions at: cat ifPresent: [ :additions | | interfaces |
- interfaces := ((etoyVocab categoryAt: cat) ifNil: [ ElementCategory new ]) elementsInOrder.
- interfaces := interfaces
- select: [:ea | additions
- anySatisfy: [:tuple | (tuple first = #slot
- ifTrue: [tuple at: 7]
- ifFalse: [tuple at: 2])
- = ea selector]].
- s tab; nextPutAll: cat translated; cr.
- interfaces
- do: [:if | | rt |
- s tab: 2.
- rt := if resultType.
- rt = #unknown
- ifTrue: [s nextPutAll: 'command' translated]
- ifFalse: [s nextPutAll: 'property' translated;
- nextPut: $(;
- nextPutAll: (if companionSetterSelector
- ifNil: ['RO']
- ifNotNil: ['RW']) translated;
- space;
- nextPutAll: rt translated;
- nextPutAll: ') '].
- s tab; print: if wording; space.
- if argumentVariables
- do: [:av | s nextPutAll: av variableName;
- nextPut: $(;
- nextPutAll: av variableType asString;
- nextPut: $)]
- separatedBy: [s space].
- s tab; nextPutAll: if helpMessage; cr]]]]]!
Item was removed:
- ----- Method: StandardScriptingSystem class>>noteCompilationOf:meta: (in category '*flexibleVocabularies-flexibleVocabularies') -----
- noteCompilationOf: aSelector meta: isMeta
- "This method does nothing and should be removed."
-
- ^ super noteCompilationOf: aSelector meta: isMeta!
Item was removed:
- ----- Method: Vocabulary>>isEToyVocabulary (in category '*flexibleVocabularies-flexibleVocabularies-testing') -----
- isEToyVocabulary
- ^false!
Item was removed:
- ----- Method: EToyVocabulary>>isEToyVocabulary (in category '*flexibleVocabularies-flexibleVocabularies-testing') -----
- isEToyVocabulary
- ^true!
More information about the Packages
mailing list