'From Squeak3.1alpha of 28 February 2001 [latest update: #4220] on 30 July 2001 at 6:48:03 pm'! "Change Set: UniTile3-tk Date: 30 July 2001 Author: Ted Kaehler First part of changes to install a menu icon in the popup panel of a tile. A small green box next to the up/down arrows brings up this menu. The menu offers selectors to replace the current one. Based on the type of the receiver. The new selector must have the same number of arguments. After picking the selector, drop new tiles on the argument to make it be the right type. Multipart messageNodes now have a gray border around them. Needed to reduce ambiguity. Fix bug in setting the property of text to 'doit'. "! !PasteUpMorph methodsFor: 'scripting' stamp: 'tk 7/28/2001 10:19'! currentVocabularyFor: aScriptableObject "Answer the Vocabulary object to be applied when scripting an object in the world." | vocabSymbol vocab | vocabSymbol _ self valueOfProperty: #currentVocabularySymbol ifAbsent: [nil]. vocabSymbol ifNil: [vocab _ self valueOfProperty: #currentVocabulary ifAbsent: [nil]. vocab ifNotNil: [vocabSymbol _ vocab vocabularyName. self removeProperty: #currentVocabulary. self setProperty: #currentVocabularySymbol toValue: vocabSymbol]]. vocabSymbol ifNotNil: [^ Vocabulary vocabularyNamed: vocabSymbol] ifNil: [(aScriptableObject isKindOf: Player) ifTrue: [^ Vocabulary eToyVocabulary]. (aScriptableObject isKindOf: Number) ifTrue: [^ Vocabulary numberVocabulary]. ^Vocabulary fullVocabulary]! ! !SyntaxMorph methodsFor: 'event handling' stamp: 'tk 7/19/2001 20:21'! mouseLeave: evt "Move grab highlight back out a level" "Transcript cr; print: self; show: ' leave'." self rootTile isMethodNode ifFalse: [^ self]. "not in a script" self unhighlightBorder. (owner ~~ nil and: [owner isSyntaxMorph]) ifTrue: [owner highlightForGrab: evt]. ! ! !SyntaxMorph methodsFor: 'event handling' stamp: 'tk 7/30/2001 14:23'! mouseLeaveDragging: evt "Transcript cr; print: self; show: ' leaveDragging'." self rootTile isMethodNode ifFalse: [^ self]. "not in a script" self isBlockNode ifTrue: [self stopStepping; removeDropZones. (self firstOwnerSuchThat: [:m | m isSyntaxMorph and: [m isBlockNode]]) ifNotNilDo: [:m | m startStepping]. "Activate outer block." self submorphs do: [:ss | "cancel drop color in line beside mouse" ss color = self dropColor ifTrue: [ss setDeselectedColor]]]. "Move drop highlight back out a level" self unhighlight. (owner ~~ nil and: [owner isSyntaxMorph]) ifTrue: [owner isBlockNode ifFalse: [owner highlightForDrop: evt]]. ! ! !SyntaxMorph methodsFor: 'highlighting' stamp: 'tk 7/30/2001 14:48'! compoundBorderColor ^ self valueOfProperty: #deselectedBorderColor ifAbsent: [Color veryLightGray] ! ! !SyntaxMorph methodsFor: 'pop ups' stamp: 'tk 7/28/2001 10:09'! chooseSelectorFrom: listOfLists "I represent a SelectorNode to be replaced by one of the selectors in one of the category lists. Each list has pre-built StringMorphs in it." | menu col | listOfLists isEmpty ifTrue: [^ nil]. listOfLists first addFirst: (self aSimpleStringMorphWith: ' '). "spacer" listOfLists first addFirst: (self aSimpleStringMorphWith: '( Cancel )'). listOfLists first first color: Color red. menu _ RectangleMorph new. menu listDirection: #leftToRight; layoutInset: 3; cellInset: -1@0. menu layoutPolicy: TableLayout new; hResizing: #shrinkWrap; vResizing: #shrinkWrap; color: (Color r: 0.767 g: 1.0 b: 0.767); useRoundedCorners. listOfLists do: [:ll | col _ Morph new. col listDirection: #topToBottom; layoutInset: 0; cellInset: -1@0. col layoutPolicy: TableLayout new; hResizing: #shrinkWrap. col color: Color transparent; vResizing: #shrinkWrap. menu addMorphBack: col. ll do: [:ss | col addMorphBack: ss. ss on: #mouseUp send: #replaceSel:menuItem: to: self] ]. self world addMorph: menu. menu setConstrainedPosition: (owner localPointToGlobal: self topRight) + (10@-30) hangOut: false. ! ! !SyntaxMorph methodsFor: 'pop ups' stamp: 'tk 7/25/2001 21:34'! offerPopUp "Put up a halo to allow user to change Literals (Integer, true), Selector (beep: sound, +,-,*,//,\\, r:g:b:, setX: incX: decX: for any X,), Variable (Color), not AssignmentNode (_ inc dec), Extend arrows on each literal, variable, and message, (block that is by itself). Retract arrows on each literal or variable, or message or block that is an argument. Any literal can be changed by Shift-clicking and typing." | panel any upDown retract extend colorPatch edge dismiss rr | (self hasProperty: #myPopup) ifTrue: [^ self]. "already has one" any _ false. (upDown _ self upDownArrows) ifNotNil: [any _ true]. (retract _ self retractArrow) ifNotNil: [any _ true]. (extend _ self extendArrow) ifNotNil: [any _ true]. (dismiss _ self dismisser) ifNotNil: [any _ true]. submorphs last class == ColorTileMorph ifFalse: [ (colorPatch _ self colorPatch) ifNotNil: [any _ true]]. any ifFalse: [^ self]. "Transcript cr; print: parseNode class; space; print: (self hasProperty: #myPopup); endEntry." panel _ RectangleMorph new color: Color transparent; borderWidth: 0. upDown ifNotNil: [ panel addMorphBack: upDown first. upDown first align: upDown first topLeft with: panel topLeft + (0@0). panel addMorphBack: upDown second. upDown second align: upDown second topLeft with: upDown first bottomLeft + (0@1). upDown size > 2 ifTrue: [ panel addMorphBack: upDown third. upDown third align: upDown third topLeft with: upDown first topRight + (2@3). ]]. rr _ self right. colorPatch ifNotNil: [ rr _ rr + colorPatch submorphs first width + 1. self addMorphBack: colorPatch. "always in tile" "colorPatch align: colorPatch topLeft with: panel topLeft + (1@1)"]. retract ifNotNil: [ edge _ panel submorphs size = 0 ifTrue: [panel left] ifFalse: [panel submorphs last right]. panel addMorphBack: retract. retract align: retract topLeft with: (edge+2) @ (panel top + 3)]. extend ifNotNil: [ edge _ panel submorphs size = 0 ifTrue: [panel left] ifFalse: [panel submorphs last right]. panel addMorphBack: extend. extend align: extend topLeft with: (edge+2) @ (panel top + 3)]. dismiss ifNotNil: [ edge _ panel submorphs size = 0 ifTrue: [panel left] ifFalse: [panel submorphs last right]. panel addMorphBack: dismiss. dismiss align: dismiss topLeft with: (edge+2) @ (panel top + 1)]. panel align: panel topLeft with: rr @ (self top -2). panel extent: panel submorphs last bottomRight - panel topLeft. self setProperty: #myPopup toValue: panel. (owner listDirection = #topToBottom and: [self listDirection = #leftToRight]) ifTrue: [self addMorphBack: panel] ifFalse: [owner addMorph: panel after: self] ! ! !SyntaxMorph methodsFor: 'pop ups' stamp: 'tk 7/28/2001 10:07'! replaceSel: evt menuItem: stringMorph "I rep a SelectorNode. Replace my selector with new one that was just chosen from a menu" | menu new old newSel ms | (menu _ stringMorph owner owner) class == RectangleMorph ifTrue: [ menu delete]. new _ stringMorph contents. new first = $( ifTrue: [^ self]. "Cancel" new first = $ ifTrue: [^ self]. "nothing" newSel _ stringMorph valueOfProperty: #syntacticallyCorrectContents. newSel ifNil: [newSel _ new]. old _ (ms _ self findA: StringMorph) valueOfProperty: #syntacticallyCorrectContents. old ifNil: [old _ (self findA: StringMorph) contents]. old numArgs = newSel numArgs ifTrue: [ ms contents: new. ms setProperty: #syntacticallyCorrectContents toValue: newSel. self acceptIfInScriptor].! ! !SyntaxMorph methodsFor: 'pop ups' stamp: 'tk 7/28/2001 22:22'! selectorMenu "Put up a menu of all selectors that my receiver could be sent. Replace me with the one chosen. (If fewer args, put the tiles for the extra arg to the side, in script's owner (world?).) Go ahead and eval receiver to find out its type. Later, mark selectors for side effects, and don't eval those. Put up a table. Each column is a viewer category." | rec cats value catNames cv interfaces list setter wording all words ind | rec _ owner receiverNode. rec ifNil: [rec _ owner owner receiverNode]. rec ifNil: [rec _ owner owner owner receiverNode]. cats _ #(). all _ Set new. rec ifNil: [^ self]. "Use types like (receiver resultType) instead?" "Global current Vocabulary must be set?" value _ rec try. value class == Error ifTrue: [^ nil]. (value isNumber and: [Vocabulary numberVocabulary == nil]) ifTrue: [ Vocabulary addVocabulary: Vocabulary newNumberVocabulary]. "someday we this will be in every system" catNames _ value categoriesForViewer: (cv _ CategoryViewer new scriptedPlayer: value). "Make this work for Number, Player, String" cats _ catNames collect: [:nn | list _ OrderedCollection new. interfaces _ value methodInterfacesForCategory: nn inViewer: cv. interfaces do: [:mi | (all includes: mi selector) ifFalse: [ "list add: (self aSimpleStringMorphWith: mi elementWording). Expensive" words _ self splitAtCapsAndDownshifted: mi selector. (words beginsWith: 'get ') ifTrue: [words _ words allButFirst: 4]. mi selector numArgs > 0 ifTrue: [words _ words, ' 5']. list add: (self anUpdatingStringMorphWith: words special: true). list last setProperty: #syntacticallyCorrectContents toValue: mi selector. all add: mi selector]. setter _ mi companionSetterSelector asString. (setter = 'nil') | (all includes: setter) ifFalse: ["need setters also" wording _ (self translateToWordySetter: setter). list add: (self aSimpleStringMorphWith: wording, ' 5'). list last setProperty: #syntacticallyCorrectContents toValue: setter. all add: setter]]. list]. (ind _ catNames indexOf: 'scripts') > 0 ifTrue: [ (cats at: ind) first contents = 'empty script' ifTrue: [ (cats at: ind) removeFirst]]. self chooseSelectorFrom: cats. "The method replaceSel:menuItem: does the work. Replaces the selector." ! ! !SyntaxMorph methodsFor: 'pop ups' stamp: 'tk 7/27/2001 17:40'! setSelector: stringLike in: stringMorph | aSymbol myType str | "store the new selector and accept method" aSymbol _ stringLike asSymbol. self setBalloonText: (ScriptingSystem helpStringForOperator: aSymbol). myType _ stringMorph valueOfProperty: #syntacticReformatting ifAbsent: [#none]. str _ aSymbol. (self isStandardSetterKeyword: str) ifTrue: [str _ self translateToWordySetter: str]. (self isStandardGetterSelector: str) ifTrue: [str _ self translateToWordyGetter: str]. (self shouldBeBrokenIntoWords: myType) ifTrue: [str _ self substituteKeywordFor: str]. stringMorph contents: str. "parseNode key: aSymbol code: nil." stringMorph setProperty: #syntacticallyCorrectContents toValue: aSymbol. self acceptSilently. ! ! !SyntaxMorph methodsFor: 'pop ups' stamp: 'tk 7/25/2001 21:43'! upDownArrows "Return an array of two up/down arrow buttons. It replaces the selector or arg with a new one. I am a number or boolean or a selector (beep:, +,-,*,//,\\, or setX: incX: decX: for any X." | patch any noMenu | any _ (self nodeClassIs: LiteralNode) and: [parseNode key isNumber]. any _ any or: [(self nodeClassIs: VariableNode) and: [(#('true' 'false') includes: self decompile asString)]]. noMenu _ any. any _ any or: [self nodeClassIs: SelectorNode]. "all of them" any ifFalse: [^ nil]. patch _ {(ImageMorph new image: TileMorph upPicture) on: #mouseDown send: #upDown:event:arrow: to: self withValue: 1; on: #mouseStillDown send: #upDownMore:event:arrow: to: self withValue: 1; on: #mouseUp send: #upDownDone to: self. (ImageMorph new image: TileMorph downPicture) on: #mouseDown send: #upDown:event:arrow: to: self withValue: -1; on: #mouseStillDown send: #upDownMore:event:arrow: to: self withValue: -1; on: #mouseUp send: #upDownDone to: self}. noMenu ifFalse: [patch _ patch, {(RectangleMorph new) extent: 6@10; borderWidth: 1; color: Color lightGreen; borderColor: Color gray; on: #mouseUp send: #selectorMenu to: self}]. ^ patch! ! !SyntaxMorph methodsFor: 'menus' stamp: 'tk 7/28/2001 09:51'! addToken: aString type: aColorOrSymbol on: aNode | sMorph modifiedString noiseWord col | col _ (self addRow: aColorOrSymbol on: aNode) layoutInset: 1. self alansTest1 ifFalse: [ sMorph _ self addString: aString special: false. col addMorphBack: sMorph. ^col ]. noiseWord _ [ :w | w ifNotNil: [ col addMorphBack: (self noiseStringMorph: w); addMorphBack: (self tokenVerticalSeparator) ]. ]. (self shouldBeBrokenIntoWords: aColorOrSymbol) ifTrue: [ modifiedString _ self substituteKeywordFor: aString. sMorph _ self addString: modifiedString special: (aColorOrSymbol ~= #assignmentArrow). "(#(unary keywordGetz keywordSetter unaryGetter) includes: aColorOrSymbol)" sMorph setProperty: #syntacticReformatting toValue: aColorOrSymbol; setProperty: #syntacticallyCorrectContents toValue: aString; contents: modifiedString. ] ifFalse: [ sMorph _ self addString: (modifiedString _ aString) special: false. ]. (#(keyword2 upArrow) includes: aColorOrSymbol) ifTrue: [ sMorph font: (self fontToUseForSpecialWord: modifiedString). ]. (#(keyword2 unary assignmentArrow methodHeader1 methodHeader2) includes: aColorOrSymbol) ifTrue: [ sMorph emphasis: 1. ]. aColorOrSymbol == #blockarg1 ifTrue: [ ]. (aColorOrSymbol == #variable or: [aColorOrSymbol == #tempVariable]) ifTrue: [ aString = 'self' ifTrue: [ sMorph setProperty: #wordyVariantOfSelf toValue: true. ]. noiseWord value: (self noiseWordBeforeVariableNode: aNode string: aString). ]. col addMorphBack: sMorph. ^col! ! !SyntaxMorph methodsFor: 'node to morph' stamp: 'tk 7/30/2001 14:52'! alanKeywordMessage: aNode isAConditional: template key: key args: args | nodeWithNilReceiver column keywords row onlyOne | (key == #collect: and: [args first isKindOf: BlockNode]) ifTrue: [ ^self alanKwdCollect: aNode isAConditional: template key: key args: args ]. key == #repeatFor:doing: ifTrue: [ ^self alanKwdRepeatForDoing: aNode isAConditional: template key: key args: args ]. key == #if:do: ifTrue: [ ^self alanKwdIfDo: aNode isAConditional: template key: key args: args ]. (args size = 1 and: [key endsWith: 'Getz:']) ifTrue: [ ^self alanKwdSetter: aNode isAConditional: 0 key: key args: args ]. (args size = 1 and: [self isStandardSetterKeyword: key]) ifTrue: [ ^self alanKwdSetter2: aNode isAConditional: 0 key: key args: args ]. nodeWithNilReceiver _ aNode copy receiver: nil. template = 1 ifTrue: [ self listDirection: #topToBottom. ]. column _ self addColumn: #keyword1 on: nodeWithNilReceiver. keywords _ key keywords. onlyOne _ args size = 1. onlyOne ifFalse: ["necessary for three keyword messages!!" column setProperty: #deselectedBorderColor toValue: column compoundBorderColor]. keywords with: (args first: keywords size) do: [:kwd :arg | template = 1 ifTrue: [ column addMorphBack: (column transparentSpacerOfSize: 3@3). ]. (row _ column addRow: #keyword2 on: nodeWithNilReceiver) parseNode: (nodeWithNilReceiver as: (onlyOne ifTrue: [MessageNode] ifFalse: [MessagePartNode])); borderColor: row stdBorderColor. template = 1 ifTrue: [row addMorphBack: (row transparentSpacerOfSize: 20@6)]. row addToken: kwd type: #keyword2 on: (onlyOne ifTrue: [SelectorNode new key: kwd code: nil "fill this in?"] ifFalse: [KeyWordNode new]). (arg asMorphicSyntaxIn: row) setConditionalPartStyle. ]. onlyOne ifTrue: [ self replaceSubmorph: column by: row. column _ row. ]. ! ! !SyntaxMorph methodsFor: 'node to morph' stamp: 'tk 7/30/2001 14:52'! alanKwdIfDo: aNode isAConditional: template key: key args: args "(know it has more than one arg)" | nodeWithNilReceiver column keywords row | nodeWithNilReceiver _ aNode copy receiver: nil. column _ self addColumn: #keyword1 on: nodeWithNilReceiver. "column borderColor: column compoundBorderColor." keywords _ key keywords. keywords with: (args first: keywords size) do: [:kwd :arg | (row _ column addRow: #keyword2 on: nodeWithNilReceiver) parseNode: (nodeWithNilReceiver as: MessagePartNode). kwd = 'do:' ifTrue: [ row addMorphBack: (row transparentSpacerOfSize: 26@6). ] ifFalse: [ row addMorphBack: (row transparentSpacerOfSize: 10@6). ]. row addTokenSpecialCase: kwd type: #keyword2 on: KeyWordNode new. (arg asMorphicSyntaxIn: row) setConditionalPartStyle. ]. ! ! !SyntaxMorph methodsFor: 'node to morph' stamp: 'tk 7/27/2001 17:31'! alanKwdSetter2: aNode isAConditional: template key: key args: args "translates foo setHeading: 0 to foo's heading _ 0 " | kwdHolder | kwdHolder _ self addToken: key type: #keywordSetter on: (SelectorNode new key: key code: nil "fill this in?"). kwdHolder firstSubmorph setProperty: #syntacticReformatting toValue: #keywordSetter; setProperty: #syntacticallyCorrectContents toValue: key asString; contents: (self translateToWordySetter: key); emphasis: 1. (args first asMorphicSyntaxIn: self) setConditionalPartStyle ! ! !SyntaxMorph methodsFor: 'node to morph' stamp: 'tk 7/27/2001 17:32'! alanUnaryGetter: aNode key: key "I am a MessageNode. Fill me with a SelectorNode {getX} whose string is {'s x}. All on one level." | selSyn usm | selSyn _ self addToken: key type: #unaryGetter on: (SelectorNode new key: key code: nil "fill this in?"). usm _ selSyn firstSubmorph. usm setProperty: #syntacticReformatting toValue: #unaryGetter; setProperty: #syntacticallyCorrectContents toValue: key asString. usm contents: (self translateToWordyGetter: key); emphasis: 1. ! ! !SyntaxMorph methodsFor: 'alans styles' stamp: 'tk 7/27/2001 16:53'! shouldBeBrokenIntoWords: aSymbol ^#(methodHeader1 methodHeader2 keyword2 upArrow tempVariable tempVariableDeclaration blockarg2 variable keywordGetz keywordSetter unaryGetter assignmentArrow) includes: aSymbol! ! !SyntaxMorph methodsFor: 'alans styles' stamp: 'tk 7/28/2001 09:05'! translateToWordyGetter: key " setBlob: becomes 's blob _ " ^ '''s ', (self splitAtCapsAndDownshifted: (key asString allButFirst: 3) withFirstCharacterDownshifted)! ! !SyntaxMorph methodsFor: 'alans styles' stamp: 'tk 7/27/2001 17:26'! translateToWordySetter: key " setBlob: becomes 's blob _ " ^ '''s ', (self splitAtCapsAndDownshifted: (key asString allButFirst: 3) allButLast withFirstCharacterDownshifted), ' _'! ! !SyntaxUpdatingStringMorph methodsFor: 'as yet unclassified' stamp: 'tk 7/28/2001 22:13'! drawOn: aCanvas | tempForm scanner strm where chars wid spaceWidth putLigature topOfLigature sizeOfLigature colorOfLigature dots noDot1 noDot2 | tempForm _ Form extent: self extent depth: aCanvas depth. scanner _ DisplayScanner quickPrintOn: tempForm box: tempForm boundingBox font: self fontToUse. spaceWidth _ scanner stringWidth: ' '. strm _ ReadStream on: contents. noDot1 _ noDot2 _ -1. contents first = $' ifTrue: [(contents beginsWith: '''s ') ifTrue: [noDot1 _ 3]]. contents last = $_ ifTrue: [(contents endsWith: ' _') ifTrue: [noDot2 _ contents size -1]]. contents last = $5 ifTrue: [(contents endsWith: ' 5') ifTrue: [noDot2 _ contents size -1]]. where _ 0@0. topOfLigature _ self height // 2 - 1. sizeOfLigature _ (spaceWidth-2)@(spaceWidth-2). colorOfLigature _ Color black alpha: 0.3 "veryLightGray". dots _ OrderedCollection new. putLigature _ [ (strm position ~= noDot1) & (strm position ~= noDot2) ifTrue: [ dots add: ((where x + 1) @ topOfLigature extent: sizeOfLigature)]. where _ where + (spaceWidth@0). ]. [strm atEnd] whileFalse: [ [strm peek = $ ] whileTrue: [ strm next. putLigature value. ]. chars _ strm upTo: $ . wid _ scanner stringWidth: chars. scanner drawString: chars at: where. where _ where + (wid@0). strm atEnd ifFalse: [putLigature value]. ]. aCanvas paintImage: tempForm at: self topLeft. dots do: [ :each | aCanvas fillRectangle: (each translateBy: self topLeft) fillStyle: colorOfLigature. ]. ! ! !Vocabulary class methodsFor: 'type vocabularies' stamp: 'tk 7/28/2001 21:23'! newNumberVocabulary "Answer a Vocabulary object representing the Number vocabulary to the list of AllVocabularies" | aVocabulary aMethodCategory aMethodInterface | "Vocabulary newNumberVocabulary" aVocabulary _ self new vocabularyName: #Number. aVocabulary documentation: 'Numbers are things that can do arithmetic, have their magnitudes compared, etc.'. #((arithmetic 'Basic numeric operation' (* + - / // \\ abs negated quo: rem:)) (comparing 'Determining which of two numbers is larger' (= < > <= >= ~= ~~)) (testing 'Testing a number' (even isDivisibleBy: negative odd positive sign)) (#'mathematical functions' 'Trigonometric and exponential functions' (cos exp ln log log: raisedTo: sin sqrt squared tan raisedToInteger:)) (converting 'Converting a number to another form' (@ asInteger asPoint degreesToRadians radiansToDegrees asSmallAngleDegrees asSmallPositiveDegrees)) (#'truncation and round off' 'Making a real number (with a decimal point) into an integer' (ceiling floor roundTo: roundUpTo: rounded truncateTo: truncated)) ) do: [:item | aMethodCategory _ ElementCategory new categoryName: item first. aMethodCategory documentation: item second. item third do: [:aSelector | aMethodInterface _ MethodInterface new initializeFor: aSelector. aVocabulary atKey: aSelector putMethodInterface: aMethodInterface. aMethodCategory elementAt: aSelector put: aMethodInterface]. aVocabulary addCategory: aMethodCategory]. ^ aVocabulary " (('truncation and round off' ceiling detentBy:atMultiplesOf:snap: floor roundTo: roundUpTo: rounded truncateTo: truncated) ('testing' basicType even isDivisibleBy: isInf isInfinite isNaN isNumber isZero negative odd positive sign strictlyPositive) ('converting' @ adaptToCollection:andSend: adaptToFloat:andSend: adaptToFraction:andSend: adaptToInteger:andSend: adaptToPoint:andSend: adaptToString:andSend: asInteger asNumber asPoint asSmallAngleDegrees asSmallPositiveDegrees degreesToRadians radiansToDegrees) ('intervals' to: to:by: to:by:do: to:do:) ('printing' defaultLabelForInspector isOrAreStringWith: newTileMorphRepresentative printOn: printStringBase: storeOn: storeOn:base: storeStringBase: stringForReadout) ('comparing' closeTo:) ('filter streaming' byteEncode:) ('as yet unclassified' reduce)" ! ! !Vocabulary class methodsFor: 'type vocabularies' stamp: 'tk 7/28/2001 10:29'! numberVocabulary "Answer the standard vocabulary representing numbers" ^ self allVocabularies detect: [:aVocabulary | aVocabulary vocabularyName == #Number] ifNone: [nil]! !