'From Squeak3.1alpha of 4 February 2001 [latest update: #3680] on 20 February 2001 at 7:03:06 pm'! "Change Set: UnivTiles10-tk Date: 20 February 2001 Author: Ted Kaehler Universal tiles: Dan's beginnings of universal tiles that look exactly like old EToy tiles. Ted removed the method header when inside a script editor. When collecting the source code, it is restored. Also, fixes veryDeepInner: for EventHandler, TextMorph, and CRGesture. Defines fields to be copied only weakly."! !CRGesture methodsFor: 'copying' stamp: 'tk 2/20/2001 18:58'! veryDeepFixupWith: deepCopier "If fields were weakly copied, fix them here. If they were in the tree being copied, fix them up, otherwise point to the originals." super veryDeepFixupWith: deepCopier. dictionary _ deepCopier references at: dictionary ifAbsent: [nil]! ! !CRGesture methodsFor: 'copying' stamp: 'tk 2/20/2001 19:01'! veryDeepInner: deepCopier "Copy all of my instance variables. Some need to be not copied at all, but shared. Warning!!!! Every instance variable defined in this class must be handled. We must also implement veryDeepFixupWith:. See DeepCopier class comment." super veryDeepInner: deepCopier. coordinates _ coordinates veryDeepCopyWith: deepCopier. capturedFeature _ capturedFeature veryDeepCopyWith: deepCopier. lookupResult _ lookupResult veryDeepCopyWith: deepCopier. target _ target. "just because a gesture is copied, don't necessarily copy this" dictionary _ dictionary. "just because a gesture is copied, don't necessarily copy this" startEvent _ startEvent veryDeepCopyWith: deepCopier! ! !EventHandler methodsFor: 'copying' stamp: 'tk 2/20/2001 18:46'! veryDeepInner: deepCopier "ALL fields are weakly copied!! Can't duplicate an object by duplicating a button that activates it. See DeepCopier." super veryDeepInner: deepCopier. "just keep old pointers to all fields" gestureDictionaryOrName _ gestureDictionaryOrName.! ]style[(25 108 10 129)f1b,f1,f1LDeepCopier Comment;,f1! ! !ScriptEditorMorph methodsFor: 'other' stamp: 'tk 2/20/2001 14:31'! insertUniversalTilesForClass: aClass selector: aSelector "Add a submorph which holds the universal-tiles script for the given class and selector" | source tree syn widget header | source _ aClass sourceCodeAt: aSelector. tree _ Compiler new parse: source in: aClass notifying: nil. (syn _ tree asMorphicSyntaxUsing: SyntaxMorph) parsedInClass: aClass. syn usingClassicTiles ifTrue: ["the old EToy look, remove method header line" (header _ syn findA: SelectorNode) ifNotNil: [header delete]]. widget _ syn inAScrollPane. widget color: Color transparent; setProperty: #hideUnneededScrollbars toValue: true; setProperty: #maxAutoFitSize toValue: 300@200. self addMorphBack: widget. widget extent: (self width - 10 @ 150). ! ! !SyntaxMorph methodsFor: 'accessing' stamp: 'di 2/15/2001 09:29'! isLeafTile self hasSubmorphs ifFalse: [^ false]. (self firstSubmorph isKindOf: SyntaxMorph) ifTrue: [^ false]. (self firstSubmorph isMemberOf: Morph) ifTrue: [^ false]. ^ true! ! !SyntaxMorph methodsFor: 'printing' stamp: 'tk 2/20/2001 14:55'! 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; cr]. ^ true! ! !SyntaxMorph methodsFor: 'printing' stamp: 'tk 2/20/2001 14:50'! printOn: strm indent: level | lev nodeClass parens cnt | "Tree walk and produce text of the code. #ST80. Just do it in one big ugly method." lev _ level. (nodeClass _ parseNode class) == BlockNode ifTrue: [ owner isSyntaxMorph ifTrue: [ owner isMethodNode ifFalse: [strm nextPut: $[. lev _ lev+1]]]. "normal block has []" nodeClass == VariableNode ifTrue: ["nil out any old association" parseNode key class == Association ifTrue: [ parseNode name: (parseNode name) key: nil code: (parseNode code)]]. (nodeClass == MessageNode or: [nodeClass == CascadeNode]) ifTrue: [ parseNode receiver ifNotNil: [parens _ true. strm nextPut: $( ]]. "has a receiver" nodeClass == MethodTempsNode ifTrue: [strm nextPut: $|; space]. nodeClass == MethodNode ifTrue: [ (self findA: SelectorNode) ifNil: [ (self getHeader: strm) ifFalse: [^ self]]]. "might fail" cnt _ 0. submorphs do: [:sub | sub isSyntaxMorph ifTrue: [cnt _ cnt + 1. (nodeClass == CascadeNode "and: [sub isCascadePart]") ifTrue: [cnt > 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) ifTrue: [ self printSimpleStringMorph: sub on: strm ]. "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: 'menus' stamp: 'di 2/19/2001 22:54'! finalAppearanceTweaks | classic newInset | SizeScaleFactor ifNil: [SizeScaleFactor _ 1.0]. self allMorphsDo: [ :each | (each respondsTo: #setDeselectedColor) ifTrue: [each setDeselectedColor]. (each hasProperty: #variableInsetSize) ifTrue: [ each layoutInset: ((each valueOfProperty: #variableInsetSize) * SizeScaleFactor) rounded. ]. ]. (classic _ self usingClassicTiles) ifTrue: [self allMorphsDo: [:each | (each isKindOf: SyntaxMorph) ifTrue: [each isLeafTile ifTrue: [classic ifTrue: [newInset _ 2@4] ifFalse: [newInset _ 1@1]] ifFalse: [newInset _ -1@-1]. newInset = each layoutInset ifFalse: [each layoutInset: newInset]]]]. ! ! !SyntaxMorph methodsFor: 'formatting options' stamp: 'di 2/19/2001 22:28'! usingClassicTiles ^ Project current parameterAt: #largeTiles ifAbsent: [false]! ! !TextMorph methodsFor: 'copying' stamp: 'tk 2/20/2001 18:55'! veryDeepFixupWith: deepCopier "If target and arguments fields were weakly copied, fix them here. If they were in the tree being copied, fix them up, otherwise point to the originals!!" super veryDeepFixupWith: deepCopier. "It makes no sense to share pointers to an existing predecessor and successor" predecessor _ deepCopier references at: predecessor ifAbsent: [nil]. successor _ deepCopier references at: successor ifAbsent: [nil]! ! !TextMorph methodsFor: 'copying' stamp: 'tk 2/20/2001 18:53'! veryDeepInner: deepCopier "Copy all of my instance variables. Some need to be not copied at all, but shared. Warning!!!! Every instance variable defined in this class must be handled. We must also implement veryDeepFixupWith:. See DeepCopier class comment." super veryDeepInner: deepCopier. textStyle _ textStyle veryDeepCopyWith: deepCopier. text _ text veryDeepCopyWith: deepCopier. wrapFlag _ wrapFlag veryDeepCopyWith: deepCopier. paragraph _ paragraph veryDeepCopyWith: deepCopier. editor _ editor veryDeepCopyWith: deepCopier. container _ container veryDeepCopyWith: deepCopier. predecessor _ predecessor. successor _ successor. lastGesture _ lastGesture veryDeepCopyWith: deepCopier.! ! !TheWorldMenu methodsFor: 'action' stamp: 'di 2/19/2001 22:26'! largeTilesString ^ (myProject parameterAt: #largeTiles ifAbsent: [false]) ifTrue: ['large tiles'] ifFalse: ['large tiles']! ! SyntaxMorph removeSelector: #header!