[Pkg] Squeak3.10bc: FlexibleVocabularies-kph.6.mcz
squeak-dev-noreply at lists.squeakfoundation.org
squeak-dev-noreply at lists.squeakfoundation.org
Sat Dec 13 04:47:32 UTC 2008
A new version of FlexibleVocabularies was added to project Squeak3.10bc:
http://www.squeaksource.com/310bc/FlexibleVocabularies-kph.6.mcz
==================== Summary ====================
Name: FlexibleVocabularies-kph.6
Author: kph
Time: 13 December 2008, 4:47:31 am
UUID: c3be33b0-fe40-4e09-b197-600a0da9e583
Ancestors: FlexibleVocabularies-al.5
Saved from SystemVersion
==================== Snapshot ====================
SystemOrganization addCategory: #'FlexibleVocabularies-Info'!
----- 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.'}.
}!
----- Method: Vocabulary>>isEToyVocabulary (in category '*flexibleVocabularies-flexibleVocabularies-testing') -----
isEToyVocabulary
^false!
----- 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!
----- Method: StandardScriptingSystem class>>noteAddedSelector:meta: (in category '*flexibleVocabularies-flexibleVocabularies') -----
noteAddedSelector: aSelector meta: isMeta
aSelector == #wordingForOperator: ifTrue:
[Vocabulary changeMadeToViewerAdditions].
super noteAddedSelector: aSelector meta: isMeta!
----- 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!
----- 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: []) ~= $: ]]!
----- 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.
"
^#()!
----- 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: [ #() ].!
----- 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 selectors
do: [: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!
----- 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!
----- 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!
----- 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
asSortedCollection: [ :a :b | a translated < b translated ]).
aClass := aClass superclass ].
masterOrder := EToyVocabulary masterOrderingOfCategorySymbols.
^(masterOrder intersection: additions), (additions difference: masterOrder).!
----- Method: Morph>>categoriesForViewer (in category '*flexiblevocabularies-scripting') -----
categoriesForViewer
"Answer a list of symbols representing the categories to offer in the
viewer, in order"
| dict aList |
dict := Dictionary new.
self unfilteredCategoriesForViewer
withIndexDo: [:cat :index | dict at: cat put: index].
self filterViewerCategoryDictionary: dict.
aList := SortedCollection
sortBlock: [:a :b | (dict at: a)
< (dict at: b)].
aList addAll: dict keys.
^ aList asArray!
----- 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"!
----- 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:)
"!
----- 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!
----- 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.
!
----- 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!
----- 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)!
----- 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 ])
!
----- 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 rt interfaces allAdditions |
etoyVocab := Vocabulary eToyVocabulary.
etoyVocab initialize. "just to make sure that it's unfiltered."
^ String streamContents: [:s |
self morphClassesDeclaringViewerAdditions do: [:cl |
s nextPutAll: cl name; cr.
allAdditions := cl allAdditionsToViewerCategories.
cl unfilteredCategoriesForViewer do: [ :cat |
allAdditions at: cat ifPresent: [ :additions |
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 |
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]]]]]!
----- Method: EToyVocabulary>>initialize (in category '*flexibleVocabularies-flexiblevocabularies-initialization') -----
initialize
"Initialize the receiver (automatically called when instances are created via 'new')"
| classes aMethodCategory selector selectors categorySymbols aMethodInterface |
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 |
aMethodCategory := ElementCategory new categoryName: aCategorySymbol.
selectors := Set new.
classes do:
[:aMorphClass |
(aMorphClass additionsToViewerCategory: aCategorySymbol) do:
[:anElement |
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 ].!
----- Method: EToyVocabulary>>isEToyVocabulary (in category '*flexibleVocabularies-flexibleVocabularies-testing') -----
isEToyVocabulary
^true!
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
!
----- 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.
!
----- 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
]!
----- Method: SyntaxMorph class>>clearAllSpecs (in category '*flexibleVocabularies-flexiblevocabularies-accessing') -----
clearAllSpecs
"Clear the specs that the Viewer knows about."
"SyntaxMorph clearAllSpecs"
AllSpecs := nil.!
----- 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"!
More information about the Packages
mailing list