'From Squeak3.1alpha of 28 February 2001 [latest update: #4343] on 23 September 2001 at 2:31:10 am'! "Change Set: UniTiles9-tk Date: 23 September 2001 Author: Ted Kaehler Further civilizing of Universal Tiles. Rewrote the popUp that allows a selector tile to be replaced. Extended it to work on keyWords. Adds additional args as needed. Saves tiles of any args removed. Defined Variable>>sample that attempts to return the closest thing to the object represented by this variable. The actual object, or a new instance of that class. Started adding type specs for arguments to the vocabulry of Time, (later others). Default method template in tiles. Make sure classes Date and Time respond to #new with an object that can print. (Should check entire system for this...) Removed inst var syntaxMorph from PluggableTileScriptorMorph. It can be found dynamically. Repaired PositionableStream>>last. Repaired several bugs that I just introduced to creating code from Universal tiles. (Scott found these.) Use ensureNoSpace instead of blindly doing skip: -1. "! TwoWayScrollPane subclass: #PluggableTileScriptorMorph instanceVariableNames: 'syntaxMorph ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Tile Scriptors'! !Date class methodsFor: 'instance creation' stamp: 'tk 9/19/2001 10:16'! fromJulianDayNumber: aJulianDayNumber ^self basicNew julianDayNumber: aJulianDayNumber.! ! !Date class methodsFor: 'instance creation' stamp: 'tk 9/19/2001 10:18'! new "Return a constant, or date today?" ^ self fromDays: 0 ! ! !PluggableTileScriptorMorph methodsFor: 'pane events' stamp: 'tk 9/23/2001 02:28'! keyStroke: evt "A keystroke was hit while the receiver had keyboard focus. Pass the keystroke on to my syntaxMorph, and also, if I have an event handler, pass it on to that handler" | sm | (sm _ self syntaxMorph) ifNotNil: [sm keyStroke: evt]. super keyStroke: evt! ! !PluggableTileScriptorMorph methodsFor: 'as yet unclassified' stamp: 'tk 9/23/2001 02:27'! syntaxMorph "Return the SyntaxMorph(MethodNode) that is inside me." | tm | ^ (tm _ self findA: TransformMorph) ifNotNil: [tm findA: SyntaxMorph]! ! !PositionableStream methodsFor: 'accessing' stamp: 'tk 9/23/2001 01:14'! last "Return the final element in the receiver" ^ collection at: position! ! !SyntaxMorph methodsFor: 'accessing' stamp: 'tk 9/20/2001 13:21'! argumentNodes "Return a collection of this message's argument nodes. " | cls coll rec | parseNode ifNil: [^ #()]. cls _ parseNode class. cls == SelectorNode ifTrue: [^ #()]. cls == KeyWordNode ifTrue: [^ #()]. coll _ OrderedCollection new. rec _ self receiverNode. submorphs do: [:sub | (sub isSyntaxMorph and: [sub ~~ rec]) ifTrue: [ sub isNoun ifTrue: [coll addLast: sub] "complete arg" ifFalse: [coll _ coll, sub argumentNodes]]]. "MessagePartNode, MessageNode with no receiver" ^ coll! ! !SyntaxMorph methodsFor: 'accessing' stamp: 'tk 9/20/2001 12:43'! dissectMessage "I am a MessageNode. Return {receiverNode or nil, selector, (keyword nodes), (argument nodes)}. Ignore all spacing morphs." ! ! !SyntaxMorph methodsFor: 'accessing' stamp: 'tk 9/19/2001 15:39'! enclosingPane "The object that owns this script layout" | oo higher | oo _ self owner. [higher _ oo isSyntaxMorph. higher _ higher or: [oo class == TransformMorph]. higher _ higher or: [oo class == TwoWayScrollPane]. higher ifFalse: [^ oo]. higher] whileTrue: [oo _ oo owner]. ! ! !SyntaxMorph methodsFor: 'accessing' stamp: 'tk 9/20/2001 12:59'! messageNode "Return the enclosing messageNode that is the full message. It has a receiver." ^ self orOwnerSuchThat: [:oo | oo receiverNode ~~ nil]! ! !SyntaxMorph methodsFor: 'accessing' stamp: 'tk 9/23/2001 00:27'! receiverObject "Return some object that could be the receiver to me (a selector). Either the actual object who is the receiver in this message, or a guy of the right class." | rec value mm | (rec _ owner) isSyntaxMorph ifFalse: [^ nil]. rec _ rec receiverNode. rec ifNil: [(rec _ owner owner) isSyntaxMorph ifFalse: [^ nil]. rec _ rec receiverNode]. rec ifNil: [(rec _ owner owner owner) isSyntaxMorph ifFalse: [^ nil]. rec _ rec receiverNode]. rec isSelfTile ifTrue: [ ^ ((mm _ self containingWindow model) respondsTo: #targetObject) ifTrue: [mm targetObject] ifFalse: [mm selectedClassOrMetaClass new]]. value _ rec ifNotNil: [rec try]. value class == Error ifTrue: [ value _ Vocabulary instanceWhoRespondsTo: self selector]. ^ value! ! !SyntaxMorph methodsFor: 'node types' stamp: 'tk 9/23/2001 00:17'! isSelfTile ^ parseNode class == VariableNode and: [self decompile asString = 'self '] ! ! !SyntaxMorph methodsFor: 'printing' stamp: 'tk 9/23/2001 01:33'! getHeader: strm | se | "We are in an EToy scriptor and the method header line has been removed. Try to recover the method name. Fail if method has args (deal with this later)." (se _ self ownerThatIsA: ScriptEditorMorph) ifNotNil: [ se scriptName numArgs > 0 ifTrue: [^ false]. "abort" strm nextPutAll: se scriptName]. ^ true! ! !SyntaxMorph methodsFor: 'printing' stamp: 'tk 9/23/2001 02:11'! printAssignmentNodeOn: strm indent: level "sometimes an assignment is in parens" | parens above | parens _ submorphs size >= 3. parens ifTrue: [ above _ self ownerPrecedence. "high if not in an expression" parens _ above <= 3]. "assignment is a noun inside a message" parens ifTrue: [strm nextPut: $( ]. self submorphsDoIfSyntax: [ :sub | sub printOn: strm indent: level. strm ensureASpace. ] ifString: [ :sub | strm ensureNoSpace. "_ will have a leading space" self printSimpleStringMorph: sub on: strm ]. parens ifTrue: [strm ensureNoSpace; nextPut: $) ]. ! ! !SyntaxMorph methodsFor: 'printing' stamp: 'tk 9/23/2001 01:17'! printBlockNodeOn: strm indent: level | lev inASyntaxButNotOutermost subNodeClass | lev _ level. inASyntaxButNotOutermost _ owner isSyntaxMorph and: [ owner isMethodNode not]. inASyntaxButNotOutermost ifTrue: [strm nextPut: $[. lev _ lev+1]. self submorphsDoIfSyntax: [ :sub | sub printOn: strm indent: lev. subNodeClass _ sub parseNode class. (#(BlockArgsNode ReturnNode CommentNode) includes: subNodeClass name) ifFalse: [ strm ensureNoSpace; nextPut: $.]. subNodeClass == BlockArgsNode ifTrue: [strm space] ifFalse: [strm crtab: lev]. ] ifString: [ :sub | self printSimpleStringMorph: sub on: strm ]. inASyntaxButNotOutermost ifTrue: [strm nextPut: $] ]. ! ! !SyntaxMorph methodsFor: 'printing' stamp: 'tk 9/23/2001 01:19'! printCascadeNodeOn: strm indent: level | parens cnt me above | parens _ parseNode receiver notNil. parens ifTrue: [me _ self selector precedence. above _ self ownerPrecedence. "high if not in an expression" parens _ me > above]. parens ifTrue: [strm nextPut: $( ]. cnt _ 0. self submorphsDoIfSyntax: [ :sub | cnt _ cnt + 1. "maybe we want to test sub isCascadePart for the following???" cnt > 2 ifTrue: [strm nextPutAll: '; ']. sub printOn: strm indent: level. strm ensureASpace. ] ifString: [ :sub | self printSimpleStringMorph: sub on: strm ]. parens ifTrue: [strm ensureNoSpace; nextPut: $) ]. ! ! !SyntaxMorph methodsFor: 'printing' stamp: 'tk 9/23/2001 01:17'! printMessageNodeOn: strm indent: level | parens me above | parens _ parseNode receiver notNil. parens ifTrue: [me _ self selector precedence. above _ self ownerPrecedence. "high if not in an expression" parens _ me > above]. parens ifTrue: [strm nextPut: $( ]. self submorphsDoIfSyntax: [ :sub | sub printOn: strm indent: level. strm ensureASpace. ] ifString: [ :sub | self printSimpleStringMorph: sub on: strm ]. parens ifTrue: [strm ensureNoSpace; nextPut: $) ]. ! ! !SyntaxMorph methodsFor: 'printing' stamp: 'tk 9/23/2001 02:12'! printMethodNodeOn: strm indent: level (self findA: SelectorNode) ifNil: [ (self getHeader: strm) ifFalse: [^ self]. "might fail" strm crtab: level]. self submorphsDoIfSyntax: [ :sub | sub printOn: strm indent: level. strm crtab: level. ] ifString: [ :sub | self printSimpleStringMorph: sub on: strm ]. strm last == $. ifTrue: [strm skip: -1]. "ugh!! erase duplicate final period"! ! !SyntaxMorph methodsFor: 'pop ups' stamp: 'tk 9/19/2001 10:26'! addArg: index "I rep a SelectorNode. My string has been replaced. Append an argument to my owner." "See if any sample args are recorded" | sel rec aVocabulary mi sample descrip mthNode tiles | sel _ self decompile asString asSymbol. rec _ self receiverObject. rec class == Error ifFalse: [ aVocabulary _ self vocabularyToUseWith: rec. mi _ aVocabulary methodInterfaceAt: sel ifAbsent: [nil]. sample _ mi ifNil: [5] ifNotNil: [descrip _ mi argumentVariables at: index. descrip sample]] ifTrue: [sample _ 5]. mthNode _ self string: sample storeString toTilesIn: sample class. tiles _ mthNode submorphs at: mthNode submorphs size - 1. "before the ^ self" self owner addMorphBack: tiles.! ! !SyntaxMorph methodsFor: 'pop ups' stamp: 'tk 9/20/2001 16:33'! 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]. "includes menu of selectors" (retract _ self retractArrow) ifNotNil: [any _ true]. (extend _ self extendArrow) ifNotNil: [any _ true]. (dismiss _ self dismisser) ifNotNil: [any _ true]. "(assign _ self assignmentArrow) ifNotNil: [any _ true]. get from menu or any other assignment" 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)]. " assign ifNotNil: [ edge _ panel submorphs size = 0 ifTrue: [panel left] ifFalse: [panel submorphs last right]. panel addMorphBack: assign. assign align: assign topLeft with: (edge+2) @ (panel top + 2)]. " panel align: panel topLeft with: rr @ (self top -2). panel extent: panel submorphs last bottomRight - panel topLeft. self setProperty: #myPopup toValue: panel. self addMorphBack: panel. "Any reason ever to have panel below?" "(owner listDirection = #topToBottom and: [self listDirection = #leftToRight]) ifTrue: [self addMorphBack: panel] ifFalse: [owner addMorph: panel after: self]." ! ! !SyntaxMorph methodsFor: 'pop ups' stamp: 'tk 9/23/2001 00:41'! replaceKeyWord: evt menuItem: stringMorph "Replace my entire message (which may be multi-part) with the one specified. Preserve all argument tiles, either in the new message or in the world outside the scriptor. I am a SelectorNode or KeyWordNode." | menu new news newSel mm newTree newRec newArgs top oldArgNodes share ctrY | (menu _ stringMorph owner owner) class == RectangleMorph ifTrue: [ menu delete]. new _ stringMorph contents. new first = $( ifTrue: [^ self]. "Cancel" new first = $ ifTrue: [^ self]. "nothing" news _ String streamContents: [:strm | "remove fake args" (new findBetweenSubStrs: #(' 5' $ )) do: [:part | strm nextPutAll: part]]. newSel _ stringMorph valueOfProperty: #syntacticallyCorrectContents. newSel ifNil: [newSel _ news]. mm _ MessageSend receiver: 5 selector: newSel arguments: ((Array new: newSel numArgs) atAllPut: 5). newTree _ mm asTilesIn: Object. newRec _ newTree receiverNode. newArgs _ newTree argumentNodes. ctrY _ self fullBoundsInWorld center y. top _ self messageNode. newRec owner replaceSubmorph: newRec by: top receiverNode. oldArgNodes _ top argumentNodes. share _ newArgs size min: oldArgNodes size. (newArgs first: share) with: (oldArgNodes first: share) do: [:newNode :oldNode | newNode owner replaceSubmorph: newNode by: oldNode]. "later get nodes for objects of the right type for new extra args" top owner replaceSubmorph: top by: newTree. "Deposit extra args in the World" (oldArgNodes copyFrom: share+1 to: oldArgNodes size) do: [:leftOver | (leftOver parseNode class == LiteralNode and: [leftOver decompile asString = '5']) ifFalse: [newTree pasteUpMorph addMorphFront: leftOver. leftOver position: newTree enclosingPane fullBoundsInWorld right - 20 @ ctrY. ctrY _ ctrY + 26] ifTrue: [leftOver delete]]. newTree acceptIfInScriptor.! ! !SyntaxMorph methodsFor: 'pop ups' stamp: 'tk 9/19/2001 21:32'! 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 oa na case news | (menu _ stringMorph owner owner) class == RectangleMorph ifTrue: [ menu delete]. new _ stringMorph contents. new first = $( ifTrue: [^ self]. "Cancel" new first = $ ifTrue: [^ self]. "nothing" news _ String streamContents: [:strm | "remove fake args" (new findBetweenSubStrs: #(' 5' $ )) do: [:part | strm nextPutAll: part]]. newSel _ stringMorph valueOfProperty: #syntacticallyCorrectContents. newSel ifNil: [newSel _ news]. old _ (ms _ self findA: StringMorph) valueOfProperty: #syntacticallyCorrectContents. old ifNil: [old _ (self findA: StringMorph) contents]. oa _ old numArgs. na _ newSel numArgs. case _ 5. (oa = 1) & (na = 1) ifTrue: [case _ 1]. (oa = 0) & (na = 0) ifTrue: [case _ 2]. (oa = 1) & (na = 0) ifTrue: [case _ 3]. (oa = 0) & (na = 1) ifTrue: [case _ 4]. case <= 4 ifTrue: ["replace the selector" ms contents: news. "not multi-part" ms setProperty: #syntacticallyCorrectContents toValue: newSel]. case = 3 ifTrue: [owner tossOutArg: 1]. case = 4 ifTrue: [self addArg: 1]. "more cases here. Rebuild the entire MessageNode" self acceptIfInScriptor.! ! !SyntaxMorph methodsFor: 'pop ups' stamp: 'tk 9/18/2001 16:27'! 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." | cats value catNames interfaces list setter wording all words ind aVocabulary limitClass | cats _ #(). all _ Set new. value _ self receiverObject. value class == Error ifTrue: [^ nil]. aVocabulary _ self vocabularyToUseWith: value. limitClass _ self limitClassToUseWith: value vocabulary: aVocabulary. catNames _ value categoriesForVocabulary: aVocabulary limitClass: limitClass. cats _ catNames collect: [:nn | list _ OrderedCollection new. interfaces _ value methodInterfacesForCategory: nn inVocabulary: aVocabulary limitClass: limitClass. interfaces do: [:mi | (all includes: mi selector) ifFalse: [ "list add: (self aSimpleStringMorphWith: mi elementWording). Expensive" words _ mi selector. (words beginsWith: 'get ') ifTrue: [words _ words allButFirst: 4]. mi selector last == $: ifTrue: [ words _ String streamContents: [:strm | "add fake args" (words findTokens: $:) do: [:part | strm nextPutAll: part; nextPutAll: ' 5 ']]. words _ words allButLast]. mi selector isInfix ifTrue: [words _ words, ' 5']. words _ self splitAtCapsAndDownshifted: words. list add: (self anUpdatingStringMorphWith: words special: true). words = mi selector ifFalse: [ 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'). wording = setter ifFalse: [ 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]]. cats first addFirst: (self aSimpleStringMorphWith: ' '). "spacer" cats first addFirst: (self aSimpleStringMorphWith: '( from ', value class name, ' )'). cats first first color: (Color green mixed: 0.25 with: Color black). self selectorMenuAsk: cats. "The method replaceSel:menuItem: does the work. and replaces the selector." ! ! !SyntaxMorph methodsFor: 'pop ups' stamp: 'tk 9/20/2001 16:04'! selectorMenuAsk: 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: '( 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; cellPositioning: #topLeft. listOfLists do: [:ll | col _ Morph new. col listDirection: #topToBottom; layoutInset: 0; cellInset: 0@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: #replaceKeyWord:menuItem: to: self] ]. self world addMorph: menu. menu setConstrainedPosition: (owner localPointToGlobal: self topRight) + (10@-30) hangOut: false. ! ! !SyntaxMorph methodsFor: 'pop ups' stamp: 'tk 9/19/2001 15:47'! tossOutArg: extras "Remove the tiles for the last N keywords and arguments. Place the tiles beside the current window. I am a SyntaxMorph for a MessageNode." | cnt ctr | cnt _ 0. submorphs copy reverseDo: [:sub | ctr _ sub fullBoundsInWorld center. sub delete. (sub isSyntaxMorph and: [sub parseNode notNil]) ifTrue: [ sub isNoun ifTrue: [ self pasteUpMorph addMorphFront: sub. sub position: self enclosingPane fullBoundsInWorld right - 20 @ ctr y]. (cnt _ cnt + 1) >= extras ifTrue: [^ self]]].! ! !SyntaxMorph methodsFor: 'pop ups' stamp: 'tk 9/20/2001 16:33'! 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]. "arrows and menu of selectors" any _ any or: [self nodeClassIs: KeyWordNode]. 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; borderColor: Color gray; on: #mouseUp send: #selectorMenu to: self}. patch last color: ((self nodeClassIs: SelectorNode) ifTrue: [Color lightGreen] ifFalse: [Color red darker])]. ^ patch! ! !SyntaxMorph methodsFor: 'menus' stamp: 'tk 9/23/2001 02:05'! 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: {''. aReceiver}. menu add: 'self' target: self selector: #attachTileForCode:nodeType: argumentList: {'self'. VariableNode}. menu add: '_ (assignment)' target: self selector: #attachTileForCode:nodeType: argumentList: {''. 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. ! ! !SyntaxMorph methodsFor: 'type checking' stamp: 'tk 9/23/2001 01:27'! selector | sel cnt | "Find the selector I represent, or have inside of me. My parseNode is a SelectorNode or a MessageNode." parseNode class == SelectorNode ifTrue: [ ^ self decompile asString asSymbol]. parseNode class == KeyWordNode ifTrue: [ ^ self decompile asString asSymbol]. parseNode class == BlockNode ifTrue: [^ nil]. "Beware of messageParts. If MessagePartNode, only returns this part." sel _ ''. cnt _ 0. submorphs do: [:mm | mm isSyntaxMorph ifTrue: [ cnt _ cnt + 1. (mm nodeClassIs: SelectorNode) ifTrue: [^ mm selector]. (mm nodeClassIs: MessagePartNode) ifTrue: [ sel _ sel, mm selector]. (mm nodeClassIs: KeyWordNode) ifTrue: [ sel _ sel, mm decompile asString]. cnt = 2 & (sel size = 0) ifTrue: ["not the receiver. Selector and arg" (mm nodeClassIs: MessageNode) ifTrue: [ sel _ mm selector]]]]. sel ifNil: [^ nil]. sel size > 0 ifTrue: [^ sel asSymbol]. ^ nil! ! !SyntaxMorph class methodsFor: 'as yet unclassified' stamp: 'tk 9/18/2001 16:10'! sourceCodeTemplate "Return the default tile method template" ^ 'anEmpty: input1 method: input2 "Edit the name above and the code below to make your own method" 3 + 4. "Drag tiles in here. Use the ''tiles'' and ''vars'' menus to get new tiles" ^ ''this is a statement'' sort' ! ! !Time class methodsFor: 'instance creation' stamp: 'tk 9/19/2001 10:13'! fromSeconds: secondCount "Answer an instance of me that is secondCount number of seconds since midnight." ^self basicNew setSeconds: secondCount; yourself.! ! !Time class methodsFor: 'instance creation' stamp: 'tk 9/19/2001 10:15'! new "Return a constant, or Time now?" ^ self fromSeconds: 0! ! !Variable methodsFor: 'value' stamp: 'tk 9/19/2001 09:09'! sample "The closest we can come to an object for our type" | ty clsName | self defaultValue ifNotNil: [^ self defaultValue]. ty _ self variableType. "How translate a type like #player into a class?" clsName _ ty asString. clsName at: 1 put: (clsName first asUppercase). clsName _ clsName asSymbol. (Smalltalk includesKey: clsName) ifFalse: [self error: 'What type is this?'. ^ 5]. ^ (Smalltalk at: clsName) initializedInstance! ! !Vocabulary class methodsFor: 'standard vocabulary access' stamp: 'tk 9/19/2001 09:59'! newTimeVocabulary "Answer a Vocabulary object representing me" | aVocabulary aMethodCategory aMethodInterface | "Vocabulary newTimeVocabulary" "Vocabulary addStandardVocabulary: Vocabulary newTimeVocabulary" aVocabulary _ self new vocabularyName: #Time. aVocabulary documentation: 'Time knows about hours, minutes, and seconds. For long time periods, use Date'. #((accessing 'The basic info' (hours minutes seconds)) (arithmetic 'Basic numeric operations' (addTime: subtractTime: max: min: min:max:)) (comparing 'Determining which is larger' (= < > <= >= ~= between:and:)) (testing 'Testing' (ifNil: ifNotNil:)) (printing 'Return a string for this Time' (hhmm24 print24 intervalString printMinutes printOn:)) (converting 'Converting it to another form' (asSeconds asString)) (copying 'Make another one like me' (copy)) ) 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]. #(#addTime: subtractTime: max: min: = < > <= >= ~= ) do: [:sel | (aVocabulary methodInterfaceAt: sel ifAbsent: [self error: 'fix this method']) argumentVariables: (OrderedCollection with: (Variable new name: nil type: aVocabulary vocabularyName))]. ^ aVocabulary! ! !WriteStream methodsFor: 'character writing' stamp: 'tk 9/23/2001 01:16'! ensureNoSpace "If there is not one on the end, remove it." (position > 0 and: [(collection at: position) = Character space]) ifTrue: [self skip: -1].! ! Time class removeSelector: #initializedInstance! SyntaxMorph removeSelector: #addArgs:! SyntaxMorph removeSelector: #tossOutArgs:! !SyntaxMorph reorganize! ('initialization' inAPluggableScrollPane inAScrollPane openInWindow returnNode:expression: sample:) ('accessing' actualObject argumentNodes cleanUpString: color: dissectMessage editor enclosingPane externalName fillStyle: getCurrentValue messageNode parseNode parseNode: parsedInClass parsedInClass: receiverNode receiverObject rename: unSpaceAndUpShift:appending: userScriptSelector userScriptSelector:) ('node types' findA: immediatelyBelowTheMethodNode isAVariable isBlockNode isCascadePart isDeclaration isLeafTile isMethodNode isNoun isSelfTile isSyntaxMorph nodeClassIs: rootTile) ('event handling' cursorBaseOffset handlesKeyboard: handlesMouseDown: handlesMouseOver: handlesMouseOverDragging: keyStroke: mouseDown: mouseEnter: mouseEnterDragging: mouseLeave: mouseLeaveDragging: mouseMove: mouseUp: step stepTime wantsSteps) ('dropping/grabbing' acceptDroppingMorph:event: cleanupAfterItDroppedOnMe justDroppedInto:event: morphToDropInPasteUp: structureMatchWith: wantsDroppedMorph:event:) ('drawing' drawOn: lookTranslucent) ('highlighting' borderColor: compoundBorderColor dropColor grabColor highlightForDrop: highlightForGrab: stdBorderColor unhighlight unhighlightBorder unhighlightOwner unhighlightOwnerBorder) ('selection' currentSelectionDo: deselect isSelectable scaleColorByUserPref: select setDeselectedColor setSelection: wantsKeyboardFocusFor:) ('insertion drop zones' removeDropZones trackDropZones) ('layout' addBlockArg: addColumn:on: addMorphBack: addNoiseString: addNoiseString:emphasis: addRow:on: addSingleKeywordRow: addString:special: addTempVar: addTextRow: addToBlock:event: addToken:type:on: addTokenSpecialCase:type:on: addUnaryRow:style: foldMessage foldMessageOneArg isKnownVarName: removeReturnNode tempVarNodesDo: try unfoldMessage) ('printing' getHeader: ownerPrecedence printAssignmentNodeOn:indent: printBlockArgsNodeOn:indent: printBlockNodeOn:indent: printCascadeNodeOn:indent: printMessageNodeOn:indent: printMethodNodeOn:indent: printMethodTempsNodeOn:indent: printOn: printOn:indent: printSimpleStringMorph:on: printStatementsOn:indent: printVariableNodeOn:indent: structure submorphsDoIfSyntax:ifString: submorphsDoIfSyntax:ifString:otherwise:) ('pop ups' addArg: assignmentArrow changeSound: colorChangedForSubmorph: colorPatch deleteLine deletePopup dismisser event:arrow:upDown: extend extendArrow newAssignment offerPopUp replaceKeyWord:menuItem: replaceSel:menuItem: retract retractArrow selectorMenu selectorMenuAsk: setSelector:in: tossOutArg: upDown:event:arrow: upDownArithOp: upDownArrows upDownAssignment: upDownDone upDownMore:event:arrow:) ('new tiles' attachTileForCode:nodeType: attachToHand instVarTile: string:toTilesIn:) ('menus' accept acceptIfInScriptor acceptIgnoring: acceptSilently acceptUnlogged decompile getMenuBlock offerTilesMenuFor:in: offerVarsMenuFor:in: showCode showMenu:) ('debugging' balloonText debugger debugger: hostContext update:) ('tests' changed test testForNode:andDo: toDo) ('type checking' allSpecs argTypeFor: currentVocabulary okToBeReplacedBy: receiverOrArgType receiverOrArgTypeAbove receiverTypeFor: resultType resultTypeFor: selector) ('node to morph' addTemporaries: addTemporaryControls alanBinaryPostRcvr:key:args: alanKeywordMessage:isAConditional:key:args: alanKwdCollect:isAConditional:key:args: alanKwdIfDo:isAConditional:key:args: alanKwdRepeatForDoing:isAConditional:key:args: alanKwdSetter2:isAConditional:key:args: alanKwdSetter:isAConditional:key:args: alanUnaryGetter:key: alanUnaryPostRcvr:key:selector: alansMessageNode:receiver:selector:keywords:arguments: assignmentNode:variable:value: blockNode:arguments:statements: blockNodeCollect:arguments:statements: cascadeNode:receiver:messages: changeBasicStyle finalAppearanceTweaks isStandardGetterSelector: isStandardSetterKeyword: messageNode:receiver:selector:keywords:arguments: messageOneArg:receiver:selector:args: methodNodeInner:selectorOrFalse:precedence:arguments:temporaries:primitive:block: methodNodeOuter: vanillaMessageNode:receiver:selector:arguments:) ('formatting options' alansTest1 controlContrast2: controlContrast: controlSpacing2: controlSpacing: lookClassic usingClassicTiles) ('alans styles' aSimpleStringMorphWith: alansCurrentFontPreference alansTemplateStyleFor: anUpdatingStringMorphWith:special: constructSelfVariant:and: darkerColor fontToUseForSpecialWord: lighterColor noiseBeforeBlockArg noiseStringMorph: noiseWordBeforeVariableNode:string: setConditionalPartStyle setSpecialOuterTestFormat setSpecialTempDeclarationFormat1 setSpecialTempDeclarationFormat2 shouldBeBrokenIntoWords: specialColor:andBorder: splitAtCapsAndDownshifted: standardCellPositioning standardInset substituteKeywordFor: tokenVerticalSeparator translateFromWordySelfVariant: translateToWordyGetter: translateToWordySelfVariant: translateToWordySetter:) ('vocabulary' limitClassToUseWith:vocabulary: vocabularyToUseWith:) ! TwoWayScrollPane subclass: #PluggableTileScriptorMorph instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Tile Scriptors'!