'From Squeak3.1alpha of 5 February 2001 [latest update: #3616] on 16 February 2001 at 3:25:36 pm'! "Change Set: syntaxAlan Date: 13 February 2001 Author: Bob Arning Initial hacking around with universal tile syntax including - user of different fonts and colors for text - use of different colors/borders for certain nodes - addition/replacement of more user friendly 'noise' words more to come"! AlignmentMorph subclass: #SyntaxMorph instanceVariableNames: 'parseNode markerMorph ' classVariableNames: 'AllSpecs ContrastFactor ' poolDictionaries: '' category: 'Morphic-Tile Scriptors'! !BlockNode methodsFor: 'tiles' stamp: 'RAA 2/16/2001 09:08'! asMorphicSyntaxIn: parent ^parent blockNode: self arguments: arguments statements: statements! ! !MessageNode methodsFor: 'printing' stamp: 'RAA 2/15/2001 19:25'! macroPrinter special > 0 ifTrue: [^MacroPrinters at: special]. ^nil ! ! !MessageNode methodsFor: 'printing' stamp: 'RAA 2/16/2001 15:12'! printIfOn: aStream indent: level aStream dialect = #SQ00 ifTrue: ["Convert to if-then-else" (arguments last isJust: NodeNil) ifTrue: [aStream withStyleFor: #prefixKeyword do: [aStream nextPutAll: 'Test ']. self printParenReceiver: receiver on: aStream indent: level + 1. ^ self printKeywords: #Yes: arguments: (Array with: arguments first) on: aStream indent: level prefix: true]. (arguments last isJust: NodeFalse) ifTrue: [self printReceiver: receiver on: aStream indent: level. ^ self printKeywords: #and: arguments: (Array with: arguments first) on: aStream indent: level]. (arguments first isJust: NodeNil) ifTrue: [aStream withStyleFor: #prefixKeyword do: [aStream nextPutAll: 'Test ']. self printParenReceiver: receiver on: aStream indent: level + 1. ^ self printKeywords: #No: arguments: (Array with: arguments last) on: aStream indent: level prefix: true]. (arguments first isJust: NodeTrue) ifTrue: [self printReceiver: receiver on: aStream indent: level. ^ self printKeywords: #or: arguments: (Array with: arguments last) on: aStream indent: level]. aStream withStyleFor: #prefixKeyword do: [aStream nextPutAll: 'Test ']. self printParenReceiver: receiver on: aStream indent: level + 1. ^ self printKeywords: #Yes:No: arguments: arguments on: aStream indent: level prefix: true]. receiver ifNotNil: [ receiver printOn: aStream indent: level + 1 precedence: precedence. ]. (arguments last isJust: NodeNil) ifTrue: [^ self printKeywords: #ifTrue: arguments: (Array with: arguments first) on: aStream indent: level]. (arguments last isJust: NodeFalse) ifTrue: [^ self printKeywords: #and: arguments: (Array with: arguments first) on: aStream indent: level]. (arguments first isJust: NodeNil) ifTrue: [^ self printKeywords: #ifFalse: arguments: (Array with: arguments last) on: aStream indent: level]. (arguments first isJust: NodeTrue) ifTrue: [^ self printKeywords: #or: arguments: (Array with: arguments last) on: aStream indent: level]. self printKeywords: #ifTrue:ifFalse: arguments: arguments on: aStream indent: level! ! !MessageNode methodsFor: 'printing' stamp: 'RAA 2/16/2001 15:12'! printOn: aStream indent: level | leadingKeyword | "may not need this check anymore - may be fixed by the #receiver: change" special ifNil: [^aStream nextPutAll: '** MessageNode with nil special **']. (special > 0) ifTrue: [self perform: self macroPrinter with: aStream with: level] ifFalse: [selector key first = $: ifTrue: [leadingKeyword _ selector key keywords first. aStream nextPutAll: leadingKeyword; space. self printReceiver: receiver on: aStream indent: level. self printKeywords: (selector key allButFirst: leadingKeyword size + 1) arguments: arguments on: aStream indent: level] ifFalse: [(aStream dialect = #SQ00 and: [selector key == #do:]) ifTrue: ["Add prefix keyword" aStream withStyleFor: #prefixKeyword do: [aStream nextPutAll: 'Repeat ']. self printParenReceiver: receiver on: aStream indent: level + 1. self printKeywords: selector key arguments: arguments on: aStream indent: level prefix: true] ifFalse: [self printReceiver: receiver on: aStream indent: level. self printKeywords: selector key arguments: arguments on: aStream indent: level]]]! ! !MessageNode methodsFor: 'equation translation' stamp: 'RAA 2/14/2001 14:07'! receiver: val "14 feb 2001 - removed return arrow" receiver _ val! ! !MessageNode methodsFor: 'tiles' stamp: 'RAA 2/15/2001 19:34'! asMorphicSyntaxIn: parent ^parent vanillaMessageNode: self receiver: receiver selector: selector arguments: arguments ! ! !MessageNode methodsFor: 'tiles' stamp: 'RAA 2/14/2001 22:26'! morphFromKeywords: key arguments: args on: parent indent: ignored ^parent messageNode: self receiver: receiver selector: selector keywords: key arguments: args ! ! !MethodNode methodsFor: 'tiles' stamp: 'RAA 2/16/2001 11:37'! asMorphicSyntaxUsing: aClass | morph contrastKnob | (morph _ aClass column: #method on: self) borderWidth: 0. (contrastKnob _ Morph new ) extent: 8@8; setBalloonText: 'Control the contrast'; on: #mouseUp send: #controlContrast: to: morph. morph addMorph: contrastKnob. self asMorphicSyntaxIn: morph. block _ morph submorphs last. block submorphs size = 1 ifTrue: [^ morph]. "keep '^ self' if that is the only thing in method" block submorphs last decompile string = '^ self ' ifTrue: [ block submorphs last delete]. ^ morph! ! !ScriptEditorMorph methodsFor: 'other' stamp: 'RAA 2/16/2001 10:37'! useNewTilesNow | mp source aSelector aClass tree syn widget | "First make it show source with a method pane, then substitute tiles!!" (mp _ self findA: MethodMorph) ifNil: [^ self]. "code pane must be present" aSelector _ mp model selectedMessageName. aClass _ mp model selectedClassOrMetaClass. source _ aClass sourceCodeAt: aSelector. tree _ Compiler new parse: source in: aClass notifying: nil. (syn _ tree asMorphicSyntaxUsing: SyntaxMorph) parsedInClass: aClass. widget _ syn inAScrollPane. widget color: Color transparent; setProperty: #hideUnneededScrollbars toValue: true; setProperty: #maxAutoFitSize toValue: 300@200. mp delete. self addMorphBack: widget. widget extent: (self width - 10 @ 150). syn finalAppearanceTweaks. ! ! !SyntaxMorph methodsFor: 'initialization' stamp: 'RAA 2/15/2001 19:43'! drawOn: aCanvas super drawOn: aCanvas. self isBlockNode ifFalse: [^self]. self immediatelyBelowTheMethodNode ifTrue: [ aCanvas fillRectangle: (self topLeft + (0@-1) extent: self width@1) color: Color gray ] ifFalse: [ self specialBlockFormatting ifFalse: [ aCanvas fillRectangle: (self topLeft + (1@1) extent: 2@(self height-2)) color: Color gray. aCanvas fillRectangle: (self topLeft + (1@1) extent: 4@1) color: Color gray. aCanvas fillRectangle: (self bottomLeft + (1@-1) extent: 4@1) color: Color gray ]. ]. ! ! !SyntaxMorph methodsFor: 'initialization' stamp: 'RAA 2/14/2001 20:34'! immediatelyBelowTheMethodNode ^(owner respondsTo: #isMethodNode) and: [owner isMethodNode]! ! !SyntaxMorph methodsFor: 'accessing' stamp: 'RAA 2/13/2001 11:19'! actualObject | sub | "Who is self in these tiles? Usually a Player." (self nodeClassIs: VariableNode) ifTrue: [ (sub _ self findA: StringMorph) ifNil: [^ nil]. ^ References at: (self cleanUpString: sub) asSymbol ifAbsent: [nil]]. (self nodeClassIs: LiteralNode) ifTrue: [ (sub _ self findA: StringMorph) ifNil: [^ nil]. ^ Compiler evaluate: sub contents for: nil logged: false]. (sub _ self findA: SyntaxMorph) ifNil: [^ nil]. ^ sub actualObject "receiver"! ! !SyntaxMorph methodsFor: 'accessing' stamp: 'RAA 2/13/2001 23:05'! cleanUpString: stringSubMorph ^ stringSubMorph valueOfProperty: #syntacticallyCorrectContents ifAbsent: [stringSubMorph contents] ! ! !SyntaxMorph methodsFor: 'accessing' stamp: 'RAA 2/16/2001 09:52'! specialColor: c1 andBorder: c2 self color: (self scaleColorByUserPref: c1). self setProperty: #deselectedColor toValue: c1. self borderColor: (self scaleColorByUserPref: c2). self setProperty: #deselectedBorderColor toValue: c2. ! ! !SyntaxMorph methodsFor: 'highlighting' stamp: 'RAA 2/14/2001 19:44'! stdBorderColor "several choices of how to do the border" self class noTileColor ifTrue: [^self valueOfProperty: #deselectedBorderColor ifAbsent: [Color transparent]] ifFalse: [^ self valueOfProperty: #deselectedBorderColor ifAbsent: [Color transparent]]! ! !SyntaxMorph methodsFor: 'highlighting' stamp: 'RAA 2/15/2001 19:48'! unhighlight self currentSelectionDo: [:innerMorph :mouseDownLoc :outerMorph | self borderColor: ( (self == outerMorph or: [owner notNil and: [owner isSyntaxMorph not]]) ifTrue: [self valueOfProperty: #deselectedBorderColor ifAbsent: [#raised]] ifFalse: [self stdBorderColor] ) ] ! ! !SyntaxMorph methodsFor: 'selection' stamp: 'RAA 2/14/2001 11:33'! deselect self allMorphsDo: [:m | m isSyntaxMorph ifTrue: [m setDeselectedColor]]. "Note following is wasteful because we do a deselect before each select, and it is often the same morph." self deletePopup! ! !SyntaxMorph methodsFor: 'selection' stamp: 'RAA 2/16/2001 10:41'! scaleColorByUserPref: aColor | myRoot underLyingColor | myRoot _ self rootTile. underLyingColor _ myRoot ifNil: [Color transparent] ifNotNil: [myRoot color]. [underLyingColor isTransparent and: [(myRoot _ myRoot owner) notNil]] whileTrue: [ underLyingColor _ myRoot color. ]. "rude hack to get the desired effect before we have an owner" underLyingColor isTransparent ifTrue: [underLyingColor _ Color r: 0.903 g: 1.0 b: 0.903]. ^aColor mixed: (ContrastFactor ifNil: [0.3]) with: underLyingColor ! ! !SyntaxMorph methodsFor: 'selection' stamp: 'RAA 2/16/2001 09:52'! setDeselectedColor | deselectedColor deselectedBorderColor | deselectedColor _ self valueOfProperty: #deselectedColor ifAbsent: [nil]. deselectedBorderColor _ self valueOfProperty: #deselectedBorderColor ifAbsent: [nil]. deselectedColor ifNotNil: [ deselectedColor _ self scaleColorByUserPref: deselectedColor ]. deselectedBorderColor ifNotNil: [ deselectedBorderColor _ self scaleColorByUserPref: deselectedBorderColor ]. self color: (deselectedColor ifNil: [Color transparent]); borderColor: (deselectedBorderColor ifNil: [Color transparent])! ! !SyntaxMorph methodsFor: 'layout' stamp: 'RAA 2/15/2001 19:37'! addBlockArg: aMorph "Add a temporary to a block or the method. Return true if succeed" "(aMorph nodeClassIs: TempVariableNode) is known to be true." "***NOTE: This method should be combined with addTempVar:" | tempHolder tt var nn | owner isMethodNode ifTrue: [ ^ (self addTempVar: aMorph)]. "Node for them is not inside the block" "If exists, drop the temp in this block and let use extend it." tt _ self firstSubmorph. tempHolder _ tt firstSubmorph isSyntaxMorph ifTrue: [(tt nodeClassIs: BlockArgsNode) ifTrue: [tt] ifFalse: [nil]] ifFalse: [nil]. nn _ aMorph parseNode key. "name" tempHolder ifNil: ["make whole row" tempHolder _ self addRow: #blockarg1 on: (BlockArgsNode new). self addMorphFront: tempHolder. tempHolder addNoiseString: 'Use'. aMorph parseNode name: nn key: nn code: nil. var _ tempHolder addColumn: #tempVariable on: aMorph parseNode. var layoutInset: 1. var addMorphBack: (self addString: nn). self cleanupAfterItDroppedOnMe. ^ true]. tempHolder submorphsDo: [:m | "if present. caller adds the temp as a new line of code to be extended" m isSyntaxMorph and: [m parseNode key = nn ifTrue: [^ false]]]. "If this variable is not present, add it" tempHolder addNoiseString: 'Use'. aMorph parseNode name: nn key: nn code: nil. tempHolder addMorphBack: (tempHolder transparentSpacerOfSize: 4@4). var _ tempHolder addColumn: #tempVariable on: aMorph parseNode. var layoutInset: 1. var addMorphBack: (StringMorph contents: nn). var cleanupAfterItDroppedOnMe. ^ true ! ! !SyntaxMorph methodsFor: 'layout' stamp: 'RAA 2/15/2001 19:39'! addNoiseString: aNoiseString | sMorph | self noiseWordsAdded ifFalse: [^self]. sMorph _ StringMorph contents: aNoiseString. sMorph font: (self fontToUseForSpecialWord: aNoiseString) emphasis: 1; color: (self colorForKeywords: aNoiseString and: aNoiseString); setProperty: #noiseWord toValue: true. ^(self addColumn: #keyword1 on: nil) layoutInset: 1; addMorphBack: sMorph. ! ! !SyntaxMorph methodsFor: 'layout' stamp: 'RAA 2/15/2001 19:22'! addRow: aColorOrSymbol on: aNode | row | self addMorphBack: (row _ self class row: aColorOrSymbol on: aNode). "row setProperty: #howCreated toValue: thisContext longStack." ^row ! ! !SyntaxMorph methodsFor: 'layout' stamp: 'RAA 2/14/2001 19:12'! addSingleKeywordRow: aStringLikeItem | row sMorph modifiedString fontToUse | (row _ self class row: #text on: nil) borderWidth: 1. modifiedString _ self substituteKeywordFor: aStringLikeItem. sMorph _ self addString: modifiedString. fontToUse _ self fontToUseForSpecialWord: modifiedString. sMorph font: fontToUse emphasis: 1; color: (self colorForKeywords: aStringLikeItem and: modifiedString); setProperty: #syntacticallyCorrectContents toValue: aStringLikeItem. row addMorph: sMorph. self addMorphBack: row. ^row! ! !SyntaxMorph methodsFor: 'layout' stamp: 'RAA 2/15/2001 19:38'! addTempVar: aMorph "know we are a block inside a MethodNode" "(aMorph nodeClassIs: TempVariableNode) is known to be true." | tempHolder ii tt var nn | tempHolder _ (ii _ owner submorphIndexOf: self) = 1 ifFalse: [tt _ owner submorphs at: ii - 1. (tt isSyntaxMorph and: [tt nodeClassIs: MethodTempsNode]) ifTrue: [tt] ifFalse: [nil]] ifTrue: [nil]. nn _ aMorph parseNode key. "name" tempHolder ifNil: [ tempHolder _ owner addRow: #tempVariable on: MethodTempsNode new. tempHolder addNoiseString: 'Use'. owner addMorph: tempHolder inFrontOf: self. aMorph parseNode name: nn key: nn code: nil. aMorph parseNode asMorphicSyntaxIn: tempHolder. tempHolder cleanupAfterItDroppedOnMe. ^ true]. tempHolder submorphsDo: [:m | m isSyntaxMorph and: [m parseNode key = nn ifTrue: [^ false]]]. aMorph parseNode name: nn key: nn code: nil. tempHolder addNoiseString: 'Use'. tempHolder addMorphBack: (tempHolder transparentSpacerOfSize: 4@4). var _ tempHolder addColumn: #tempVariable on: aMorph parseNode. var layoutInset: 1. var addMorphBack: (self addString: nn). var cleanupAfterItDroppedOnMe. ^ true! ! !SyntaxMorph methodsFor: 'layout' stamp: 'RAA 2/15/2001 19:41'! addToken: aString type: aColorOrSymbol on: aNode | sMorph modifiedString | sMorph _ self addString: aString. self specialBlockFormatting ifTrue: [ (aColorOrSymbol == #keyword2) ifTrue: [ modifiedString _ self substituteKeywordFor: aString. sMorph font: (self fontToUseForSpecialWord: modifiedString) emphasis: 1; color: (self colorForKeywords: aString and: modifiedString); setProperty: #syntacticallyCorrectContents toValue: aString; contents: modifiedString. ]. ]. ^(self addColumn: aColorOrSymbol on: aNode) layoutInset: 1; addMorphBack: sMorph! ! !SyntaxMorph methodsFor: 'layout' stamp: 'RAA 2/15/2001 19:42'! colorForKeywords: original and: modified (#('ifTrue:' 'ifFalse:' 'Test') includes: original asString) ifTrue: [ ^Color black ]. ^(Color r: 0.333 g: 0.333 b: 0.333)! ! !SyntaxMorph methodsFor: 'layout' stamp: 'RAA 2/15/2001 19:43'! foldMessage "I am a message whose receiver is wide, and whose message part is a column. Rearrange me so that the message part appears indented under the receiver part." | messageRow node2 | node2 _ parseNode copy receiver: nil. messageRow _ SyntaxMorph row: #keyword1 on: node2. messageRow addMorph: (self transparentSpacerOfSize: 20@10); addMorphBack: submorphs last. "< 2 ifTrue: [strm nextPutAll: '; ']]. nodeClass == BlockArgsNode ifTrue: [strm nextPut: $:]. sub printOn: strm indent: lev. "<<<<### install the subnode" (nodeClass == BlockNode) & (sub parseNode class == BlockArgsNode) not & (sub parseNode class == ReturnNode) not ifTrue: [strm nextPut: $.]. (nodeClass == BlockNode) & (sub parseNode class == BlockArgsNode) not ifTrue: [strm crtab: lev] ifFalse: [self isMethodNode ifTrue: [strm crtab: lev] ifFalse: [strm space]]. ]. ((sub isKindOf: StringMorph) and: [(sub hasProperty: #noiseWord) not]) ifTrue: [ trialContents _ self cleanUpString: sub. strm nextPutAll: trialContents ]. "return indent for ifTrue: ifFalse:"]. parens == true ifTrue: [strm nextPut: $) ]. "has a receiver" nodeClass == BlockNode ifTrue: [ owner isSyntaxMorph ifTrue: [ owner isMethodNode ifFalse: [strm nextPut: $] ]]]. "normal block has []" nodeClass == BlockArgsNode ifTrue: [strm nextPut: $|; crtab: lev]. nodeClass == MethodTempsNode ifTrue: [strm nextPut: $|; crtab: lev]. nodeClass == MethodNode ifTrue: [ strm contents last "ugh!!" == $. ifTrue: [strm skip: -1]]. "erase last period"! ! !SyntaxMorph methodsFor: 'printing' stamp: 'RAA 2/13/2001 23:10'! printStatementsOn: aStream indent: indent "seemed to be necessary to see top node in explorer" ^parseNode printStatementsOn: aStream indent: indent! ! !SyntaxMorph methodsFor: 'menus' stamp: 'RAA 2/14/2001 15:40'! acceptIgnoring: aString "If I am inside a ScriptEditorMorph, tell my root to accept the new changes. Ignore the argument, which is the string whose conents just changed." thisContext sender receiver removeProperty: #syntacticallyCorrectContents. self acceptIfInScriptor! ! !SyntaxMorph methodsFor: 'menus' stamp: 'RAA 2/15/2001 19:51'! addColumn: aColorOrSymbol on: aNode | col | self addMorphBack: (col _ self class column: aColorOrSymbol on: aNode). "col setProperty: #howCreated toValue: thisContext longStack." self specialBlockFormatting ifTrue: [ (aColorOrSymbol == #block and: [self isMethodNode not]) ifTrue: [ self setConditionalPartStyle: col. ]. ]. ^ col ! ! !SyntaxMorph methodsFor: 'menus' stamp: 'RAA 2/15/2001 19:22'! addMorphBack: m "m setProperty: #howAdded toValue: thisContext longStack." ^super addMorphBack: m! ! !SyntaxMorph methodsFor: 'menus' stamp: 'RAA 2/14/2001 22:37'! setConditionalPartStyle: aMorph aMorph specialColor: Color paleGreen andBorder: (Color r: 0.581 g: 0.774 b: 0.903). aMorph useRoundedCorners. aMorph borderWidth: 1. ! ! !SyntaxMorph methodsFor: 'node to morph' stamp: 'RAA 2/15/2001 19:41'! blockNode: aNode arguments: arguments statements: statements | row column | (column _ self addColumn: #block on: aNode) layoutInset: 2@-1. aNode addCommentToMorph: column. arguments size > 0 ifTrue: [ row _ column addRow: #blockarg1 on: (BlockArgsNode new). row addNoiseString: 'Use'. arguments do: [:arg | (arg asMorphicSyntaxIn: row) color: #blockarg2] ]. statements do: [ :each | (each asMorphicSyntaxIn: column) borderWidth: 1. each addCommentToMorph: column ]. ^ column! ! !SyntaxMorph methodsFor: 'node to morph' stamp: 'RAA 2/15/2001 19:52'! messageNode: aNode receiver: receiver selector: selector keywords: key arguments: args | keywords column row receiverMorph firstArgMorph receiverWidth messageWidth onlyOne nodeWithNilReceiver isAConditional testAndReceiver | isAConditional _ #(ifTrue: ifFalse: ifTrue:ifFalse: ifFalse:ifTrue:) includes: key. receiver ifNotNil: ["i.e. not a cascade" testAndReceiver _ self. self specialBlockFormatting ifTrue: [ isAConditional ifTrue: [ testAndReceiver _ self addRow: #keyword1 on: nil. self specialColor: (Color r: 1.0 g: 0.935 b: 0.774) andBorder: (Color r: 0.581 g: 0.774 b: 0.903). self useRoundedCorners. self layoutInset: 6. testAndReceiver addNoiseString: 'Test' ]. ]. receiverMorph _ receiver asMorphicSyntaxIn: testAndReceiver. self specialBlockFormatting ifTrue: [ isAConditional ifTrue: [self setConditionalPartStyle: receiverMorph]. ]. ]. keywords _ key keywords. args size = 0 ifTrue: [ row _ (self addSingleKeywordRow: key) layoutInset: 1. ^ row parseNode: selector ]. receiverWidth _ receiver ifNil: [0] ifNotNil: [receiverMorph fullBounds width]. onlyOne _ args size = 1. (receiverWidth <= 80 and: [onlyOne]) ifTrue: [ row _ (self addSingleKeywordRow: keywords first) layoutInset: 1. row parseNode: selector. firstArgMorph _ args first asMorphicSyntaxIn: self. receiver ifNil: [^ self]. (firstArgMorph fullBounds height > 100 or: [firstArgMorph fullBounds width > 250]) ifTrue: [self foldMessageOneArg]. ^ self ]. nodeWithNilReceiver _ aNode copy receiver: nil. isAConditional ifTrue: [ self listDirection: #topToBottom. ]. column _ self addColumn: #keyword1 on: nodeWithNilReceiver. messageWidth _ 0. keywords with: (args copyFrom: 1 to: keywords size) do: [:kwd :arg | isAConditional ifTrue: [ column addMorphBack: (column transparentSpacerOfSize: 3@3). ]. (row _ column addRow: #keyword2 on: nodeWithNilReceiver) borderWidth: 1; parseNode: (nodeWithNilReceiver as: (onlyOne ifTrue: [MessageNode] ifFalse: [MessagePartNode])); borderColor: row stdBorderColor. isAConditional 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. messageWidth _ messageWidth + row fullBounds width]. receiverMorph ifNil: [^self]. 1 = 1 ifTrue: [^self]. receiverWidth + messageWidth < 350 ifTrue: [ isAConditional ifFalse: [self unfoldMessage]. ^self ]. ((receiverWidth > 200 or: [receiverWidth > 80 and: [column fullBounds height > 20]]) or: [receiverMorph fullBounds width > 30 and: [column fullBounds height > 100 or: [column fullBounds width > 250]]]) ifTrue: [^ self foldMessage]! ! !SyntaxMorph methodsFor: 'node to morph' stamp: 'RAA 2/15/2001 19:49'! vanillaMessageNode: aNode receiver: receiver selector: selector arguments: arguments | substitute row sel | sel _ #message. ((self nodeClassIs: CascadeNode) and: [self parseNode receiver ~~ aNode]) ifTrue: [ sel _ #keyword2. receiver ifNotNil: [self inform: 'receiver should be nil']]. row _ self addRow: sel on: aNode. substitute _ aNode as: TileMessageNode. (aNode macroPrinter == #printCaseOn:indent:) ifTrue: [ aNode asMorphicCaseOn: row indent: nil. ^ self]. aNode macroPrinter ifNotNil: [substitute perform: aNode macroPrinter with: row with: nil] ifNil: [substitute printKeywords: selector key arguments: arguments on: row indent: nil]. ^ row addTransparentSpacerOfSize: 3@0. "horizontal spacing only" ! ! !SyntaxMorph methodsFor: 'formatting options' stamp: 'RAA 2/15/2001 19:53'! alansTest1 ^true! ! !SyntaxMorph methodsFor: 'formatting options' stamp: 'RAA 2/16/2001 11:35'! controlContrast: evt | handle origin scale startingContrastX | ContrastFactor ifNil: [ContrastFactor _ 0.5]. scale _ 200.0. startingContrastX _ ContrastFactor * scale. origin _ evt hand position. handle _ HandleMorph new forEachPointDo: [:newPoint | ContrastFactor _ (newPoint x - origin x + startingContrastX) / scale min: 1.0 max: 0.0. self finalAppearanceTweaks. ] lastPointDo: [:newPoint | handle deleteBalloon. self halo doIfNotNil: [:halo | halo addHandles]. ]. evt hand attachMorph: handle. handle setProperty: #helpAtCenter toValue: true. handle setBalloonText: 'Move cursor left or right to change contrast. Click when done.'. handle startStepping! ! !SyntaxMorph methodsFor: 'formatting options' stamp: 'RAA 2/16/2001 10:36'! finalAppearanceTweaks self allMorphsDo: [ :each | (each respondsTo: #setDeselectedColor) ifTrue: [each setDeselectedColor] ].! ! !SyntaxMorph methodsFor: 'formatting options' stamp: 'RAA 2/15/2001 19:49'! noiseWordsAdded ^self alansTest1! ! !SyntaxMorph methodsFor: 'formatting options' stamp: 'RAA 2/15/2001 19:49'! specialBlockFormatting ^self alansTest1! ! SyntaxMorph removeSelector: #colorForKeywords!