'From Squeak3.1alpha of 28 February 2001 [latest update: #4264] on 22 August 2001 at 10:51:47 am'! "Change Set: UniTile6-tk Date: 21 August 2001 Author: Ted Kaehler Further adjustment to ScriptEditor resizing. Make it rigid when not autoFit. Still is not completely right!! Reinstated Andreas' fix to xScrollerHeight. (What does Dan's comment mean?) Test for LiteralVariableNodes that Andreas introduced. (Symptoms -- could not open an existing script, up/down arrows not appear for true/false.) "! !ScriptEditorMorph methodsFor: 'menu' stamp: 'tk 8/22/2001 10:49'! autoFitOnOff "Toggle between auto fit to size of code and manual resize with scrolling" | tw | (tw _ self findA: TwoWayScrollPane) ifNil: [^ self]. (self hasProperty: #autoFitContents) ifTrue: [self removeProperty: #autoFitContents. self hResizing: #rigid; vResizing: #rigid] ifFalse: [self setProperty: #autoFitContents toValue: true. self hResizing: #shrinkWrap; vResizing: #shrinkWrap]. tw layoutChanged! ! !SyntaxMorph methodsFor: 'accessing' stamp: 'tk 8/21/2001 09:36'! actualObject | sub | "Who is self in these tiles? Usually a Player." (self nodeClassIs: LiteralVariableNode) ifTrue: [ (sub _ self findA: StringMorph) ifNil: [^ nil]. "Need to decompile here for odd synonyms of 'self' ?" ^ Compiler evaluate: sub contents for: Player logged: false]. (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: 'node types' stamp: 'tk 8/21/2001 09:45'! isAVariable "There are three kinds of variable nodes" ^ (parseNode class == TempVariableNode) or: [ (parseNode class == LiteralVariableNode) or: [parseNode class == VariableNode]]! ! !SyntaxMorph methodsFor: 'dropping/grabbing' stamp: 'tk 8/21/2001 09:46'! acceptDroppingMorph: aMorph event: evt | itNoun old | "Two cases: 1) a phrase being dropped into a block. Add a new line. 2) aMorph is replacing self by dropping on it. For the moment, you have to drop it the right place (the end of a tile if it is complex). We do not look at enclosing morphs" itNoun _ aMorph isNoun. self withAllOwnersDo: [:m | (m isSyntaxMorph and: [m isBlockNode]) ifTrue: [m stopStepping; removeDropZones]]. self isBlockNode & itNoun ifTrue: [(aMorph nodeClassIs: TempVariableNode) ifTrue: ["If I am a BlockNode, and it is a TempVariableNode, add it into list" ^ (self addBlockArg: aMorph) ifFalse: ["if already declared, start new line of code with it" self addToBlock: aMorph event: evt]] ifFalse: ["If I am a BlockNode and it is a noun add it as a new line" ^ self addToBlock: aMorph event: evt]]. self isBlockNode ifTrue: [ (aMorph nodeClassIs: ReturnNode) ifTrue: [^ self addToBlock: aMorph event: evt]]. "Later add args and keywords. later allow comments to be dropped" "Can't put statement, literal, assignment, or cascade into left side of assignment" (owner isSyntaxMorph) ifTrue: [(owner nodeClassIs: AssignmentNode) ifTrue: [(owner submorphIndexOf: self) = 1 ifTrue: [aMorph isAVariable ifFalse: [ ^ self]]]]. aMorph deselect. (old _ owner) replaceSubmorph: self by: aMorph. "do the normal replacement" (old isSyntaxMorph) ifTrue: [old cleanupAfterItDroppedOnMe]. "now owned by no one" ! ! !SyntaxMorph methodsFor: 'printing' stamp: 'tk 8/21/2001 09:51'! printOn: strm indent: level | nodeClass | (self hasProperty: #ignoreNodeWhenPrinting) ifFalse: [ nodeClass _ parseNode class. nodeClass == BlockNode ifTrue: [^self printBlockNodeOn: strm indent: level]. nodeClass == BlockArgsNode ifTrue: [^self printBlockArgsNodeOn: strm indent: level]. nodeClass == MethodNode ifTrue: [^self printMethodNodeOn: strm indent: level]. nodeClass == MethodTempsNode ifTrue: [^self printMethodTempsNodeOn: strm indent: level]. nodeClass == VariableNode ifTrue: [^self printVariableNodeOn: strm indent: level]. nodeClass == LiteralVariableNode ifTrue: [^self printVariableNodeOn: strm indent: level]. nodeClass == MessageNode ifTrue: [^self printMessageNodeOn: strm indent: level]. nodeClass == CascadeNode ifTrue: [^self printCascadeNodeOn: strm indent: level]. ]. self submorphsDoIfSyntax: [ :sub | sub printOn: strm indent: level. strm ensureASpace. ] ifString: [ :sub | self printSimpleStringMorph: sub on: strm ]. ! ! !SyntaxMorph methodsFor: 'pop ups' stamp: 'tk 8/21/2001 09:52'! upDown: delta event: evt arrow: arrowMorph | st | st _ submorphs detect: [:mm | mm isKindOf: StringMorph] ifNone: [^ self]. (self nodeClassIs: LiteralNode) ifTrue: [ "+/- 1" st contents: (self decompile asNumber + delta) printString. ^ self acceptUnlogged]. self isAVariable ifTrue: [ "true/false" st contents: (self decompile asString = 'true') not printString. ^ self acceptSilently. "maybe set parseNode's key"]. (self upDownArithOp: delta) ifTrue: [^ self]. "+ - // * < > <= = beep:" (self upDownAssignment: delta) ifTrue: [^ self]. "Handle assignment -- increaseBy: <- multiplyBy:" ! ! !SyntaxMorph methodsFor: 'pop ups' stamp: 'tk 8/21/2001 09:52'! 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 isAVariable) 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! ! !TwoWayScrollPane methodsFor: 'retractable scroll bar' stamp: 'tk 8/21/2001 18:11'! xScrollerHeight (submorphs includes: xScrollBar) "Sorry the logic is reversed :( " ifFalse: [^ 0 @ 0] "already included" ifTrue: [^ 0 @ xScrollBar height] "leave space for it" ! !