'From Squeak3.1alpha [latest update: #''Squeak3.1alpha'' of 5 February 2001 update 3959] on 2 May 2001 at 9:54:23 pm'! "Change Set: ScriptorTweaks Date: 2 May 2001 Author: Dan Ingalls Adds a property #autoFitContents to ScriptEditorMorphs, changeable through the morph menu. If set (and this is the default), then scriptEditors grow and shrink to fit their contents. Many small changes to make this all work. "! !CodeHolder methodsFor: 'tiles' stamp: 'di 4/13/2001 10:56'! installTilesForSelection "Install universal tiles into the code pane." | source aSelector aClass tree syn tileScriptor aWindow codePane | (aWindow _ self containingWindow) ifNil: [self error: 'hamna dirisha']. tileScriptor _ (aSelector _ self selectedMessageName) ifNil: [PluggableTileScriptorMorph new] ifNotNil: [aClass _ self selectedClassOrMetaClass classThatUnderstands: aSelector. source _ aClass sourceCodeAt: aSelector. tree _ Compiler new parse: source in: aClass notifying: nil. (syn _ tree asMorphicSyntaxUsing: SyntaxMorph) parsedInClass: aClass. syn inAPluggableScrollPane]. codePane _ aWindow findDeepSubmorphThat: [:m | ((m isKindOf: PluggableTextMorph) and: [m getTextSelector == #contents]) or: [m isKindOf: PluggableTileScriptorMorph]] ifAbsent: [self error: 'no code pane']. tileScriptor color: aWindow paneColorToUse; setProperty: #hideUnneededScrollbars toValue: true. aWindow replacePane: codePane with: tileScriptor. currentCompiledMethod _ aClass ifNotNil: [aClass compiledMethodAt: aSelector]. tileScriptor owner clipSubmorphs: true. tileScriptor extent: codePane extent.! ! !Player methodsFor: 'scripts-kernel' stamp: 'di 4/13/2001 13:38'! newScriptorAround: aPhrase "Sprout a scriptor around aPhrase, thus making a new script. aPhrase may either be a PhraseTileMorph (classic tiles 1997-2001) or a SyntaxMorph (2001 onward)" | aScriptEditor aUniclassScript tw blk | aUniclassScript _ self class permanentUserScriptFor: self unusedScriptName player: self. aScriptEditor _ aUniclassScript instantiatedScriptEditorForPlayer: self. Preferences universalTiles ifTrue: [ aScriptEditor install. "aScriptEditor hResizing: #shrinkWrap; vResizing: #shrinkWrap; cellPositioning: #topLeft; setProperty: #autoFitContents toValue: true." aScriptEditor insertUniversalTiles. "Gets an empty SyntaxMorph for a MethodNode" tw _ aScriptEditor findA: TwoWayScrollPane. aPhrase ifNotNil: [blk _ tw scroller firstSubmorph "MethodNode" lastSubmorph "BlockNode". blk addMorphFront: aPhrase. aPhrase accept. ]. SyntaxMorph setSize: nil andMakeResizable: aScriptEditor. ] ifFalse: [ aPhrase ifNotNil: [aScriptEditor phrase: aPhrase] "does an install" ifNil: [aScriptEditor install] ]. self class allSubInstancesDo: [:anInst | anInst scriptInstantiationForSelector: aUniclassScript selector]. "The above assures the presence of a ScriptInstantiation for the new selector in all siblings" self updateAllViewersAndForceToShow: #scripts. ^ aScriptEditor! ! !ScriptEditorMorph methodsFor: 'initialization' stamp: 'di 4/13/2001 13:37'! initialize super initialize. color _ ScriptingSystem colorBehindTiles. self listDirection: #topToBottom; hResizing: #shrinkWrap; vResizing: #shrinkWrap; cellPositioning: #topLeft; setProperty: #autoFitContents toValue: true. self setDefaultBorderCharacteristics. firstTileRow _ 1. "index of first tile-carrying submorph" self addNewRow. showingMethodPane _ false.! ! !ScriptEditorMorph methodsFor: 'other' stamp: 'di 5/2/2001 21:51'! extent: x | newExtent tw | newExtent _ x max: self minWidth@self minHeight. (tw _ self findA: TwoWayScrollPane) ifNil: ["This was the old behavior" ^ super extent: newExtent]. (self hasProperty: #autoFitContents) ifTrue: [^ self]. "Allow the user to resize to any size" tw extent: ((newExtent x max: self firstSubmorph width) @ (newExtent y - self firstSubmorph height)) - (borderWidth*2) + (-4@-4). "inset?" ^ super extent: newExtent! ! !ScriptEditorMorph methodsFor: 'other' stamp: 'di 5/2/2001 21:32'! hibernate "Possibly delete the tiles, but only if using universal tiles." | tw | Preferences universalTiles ifFalse: [^ self]. (tw _ self findA: TwoWayScrollPane) == nil ifTrue: [self removeProperty: #sizeAtHibernate] ifFalse: [self setProperty: #sizeAtHibernate toValue: self extent + tw xScrollerHeight. submorphs size > 1 ifTrue: [submorphs second delete]]! ! !ScriptEditorMorph methodsFor: 'other' stamp: 'di 5/2/2001 21:03'! 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. aSelector numArgs = 0 ifTrue: [ "remove method header line" (header _ syn findA: SelectorNode) ifNotNil: [header delete]]. syn removeReturnNode. "if ^ self at end, remove it" widget _ syn inAScrollPane. widget hResizing: #spaceFill; vResizing: #spaceFill; color: Color transparent; setProperty: #hideUnneededScrollbars toValue: true. self addMorphBack: widget. (self hasProperty: #autoFitContents) ifFalse: [self valueOfProperty: #sizeAtHibernate ifPresentDo: [:oldExtent | self extent: oldExtent]]. syn finalAppearanceTweaks.! ! !ScriptEditorMorph methodsFor: 'other' stamp: 'di 4/13/2001 12:36'! unhibernate "Recreate my tiles from my method if I have new universal tiles." self world ifNil: [(playerScripted == nil or: [playerScripted isUniversalTiles not]) ifTrue: [^ self]] ifNotNil: [Preferences universalTiles ifFalse: [^ self]]. self topEditor == self ifFalse: [^ self]. "Part of a compound test" self insertUniversalTiles. self showingMethodPane: false. ! ! !ScriptEditorMorph methodsFor: 'menu' stamp: 'di 5/2/2001 16:54'! addCustomMenuItems: aCustomMenu hand: aHandMorph super addCustomMenuItems: aCustomMenu hand: aHandMorph. aCustomMenu addUpdating: #autoFitString target: self action: #toggleAutoFit. ! ! !ScriptEditorMorph methodsFor: 'menu' stamp: 'di 5/2/2001 16:58'! autoFitString "Answer the string to put in a menu that will invite the user to switch autoFit mode" ^ ((self hasProperty: #autoFitContents) ifTrue: [''] ifFalse: ['']) , 'auto fit' ! ! !ScriptEditorMorph methodsFor: 'menu' stamp: 'di 5/2/2001 21:52'! toggleAutoFit "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] ifFalse: [self setProperty: #autoFitContents toValue: true]. tw layoutChanged! ! !SyntaxMorph class methodsFor: 'as yet unclassified' stamp: 'di 5/2/2001 09:59'! setSize: oldExtent andMakeResizable: outerMorph | tw | (tw _ outerMorph findA: TwoWayScrollPane) ifNil: [^self]. tw hResizing: #spaceFill; vResizing: #spaceFill; color: Color transparent; setProperty: #hideUnneededScrollbars toValue: true. outerMorph hResizing: #shrinkWrap; vResizing: #shrinkWrap; cellPositioning: #topLeft. outerMorph fullBounds. ! ! !SyntaxMorph class methodsFor: 'as yet unclassified' stamp: 'di 4/13/2001 10:59'! testClass: aClass andMethod: aSelector | tree source syn widget outer | source _ (aClass compiledMethodAt: aSelector) getSourceFromFile. 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. (outer _ AlignmentMorph newRow) hResizing: #shrinkWrap; vResizing: #shrinkWrap; borderWidth: 4; color: (Color r: 0.935 g: 0.935 b: 0.935); borderColor: Color gray; useRoundedCorners; addMorphBack: widget. syn finalAppearanceTweaks. SyntaxMorph setSize: nil andMakeResizable: outer. outer openInWorld! ! !TwoWayScrollPane methodsFor: 'geometry' stamp: 'di 5/2/2001 20:54'! extent: newExtent super extent: (newExtent max: 36@32). self resizeScrollBar; resizeScroller; setScrollDeltas. ! ! !TwoWayScrollPane methodsFor: 'geometry' stamp: 'di 5/2/2001 21:44'! fitContents "Adjust my size to fit my contents reasonably snugly" self extent: scroller contentBounds extent + (yScrollBar width @ xScrollBar height) + (borderWidth*2) ! ! !TwoWayScrollPane methodsFor: 'geometry' stamp: 'di 5/2/2001 10:03'! setScrollDeltas | range scrollDelta totalRange innerBounds | totalRange _ self totalScrollRange ifNil: [^ self]. range _ self leftoverScrollRange. innerBounds _ self innerBounds. scrollDelta _ 10 @ 10. self hideOrShowScrollBar: xScrollBar forRange: totalRange x - (innerBounds width - yScrollBar width). range x <= 0 ifTrue: [xScrollBar scrollDelta: 0.02 pageDelta: 0.2. xScrollBar interval: 1.0] ifFalse: [xScrollBar scrollDelta: (scrollDelta x / range x) asFloat pageDelta: (innerBounds width - scrollDelta x / range x) asFloat. xScrollBar interval: (innerBounds width - scrollDelta x / totalRange x) asFloat]. self hideOrShowScrollBar: yScrollBar forRange: totalRange y - (innerBounds height - xScrollBar height). range y <= 0 ifTrue: [yScrollBar scrollDelta: 0.02 pageDelta: 0.2. yScrollBar interval: 1.0] ifFalse: [yScrollBar scrollDelta: (scrollDelta y / range y) asFloat pageDelta: (innerBounds height - scrollDelta y / range y) asFloat. yScrollBar interval: (innerBounds height - scrollDelta y / totalRange y) asFloat]! ! !TwoWayScrollPane methodsFor: 'retractable scroll bar' stamp: 'di 5/2/2001 08:23'! hideOrShowScrollBar: scrollBar forRange: range (self hasProperty: #hideUnneededScrollbars) ifFalse: [^ self]. (submorphs includes: scrollBar) ifTrue: [range <= 0 ifTrue: [scrollBar model: nil; delete]] ifFalse: [range > 0 ifTrue: [scrollBar model: self. self resizeScrollBar; addMorph: scrollBar]] ! ! !TwoWayScrollPane methodsFor: 'retractable scroll bar' stamp: 'di 5/2/2001 21:33'! xScrollerHeight (submorphs includes: xScrollBar) "Sorry the logic is reversed :( " ifTrue: [^ 0 @ 0] ifFalse: [^ 0 @ xScrollBar height] ! ! !TwoWayScrollPane methodsFor: 'layout' stamp: 'di 5/2/2001 10:01'! doLayoutIn: layoutBounds "layout has changed. update scroll deltas or whatever else" (owner notNil and: [owner hasProperty: #autoFitContents]) ifTrue: [self fitContents]. super doLayoutIn: layoutBounds.! ! PluggableTileScriptorMorph removeSelector: #extent:! TwoWayScrollPane removeSelector: #fitContentsUpTo:! TwoWayScrollPane removeSelector: #hasXscrollBar! ScriptEditorMorph removeSelector: #toggleShrinkWrap! ScriptEditorMorph removeSelector: #useNewTilesNow!