!AColorSelectorMorph commentStamp: 'gvc 5/18/2007 13:52'! ColorComponentSelector showing an alpha gradient over a hatched background.! !AColorSelectorMorph methodsFor: 'protocol' stamp: 'gvc 9/3/2009 13:43'! defaultFillStyle "Answer the hue gradient." ^(GradientFillStyle colors: {self color alpha: 0. self color}) origin: self topLeft; direction: (self bounds isWide ifTrue: [self width@0] ifFalse: [0@self height])! ! !AColorSelectorMorph methodsFor: 'initialization' stamp: 'gvc 9/26/2006 11:54'! initialize "Initialize the receiver." super initialize. self value: 1.0; color: Color black! ! !AColorSelectorMorph methodsFor: 'drawing' stamp: 'gvc 9/19/2006 14:28'! drawOn: aCanvas "Draw a hatch pattern first." aCanvas fillRectangle: self innerBounds fillStyle: (InfiniteForm with: self hatchForm). super drawOn: aCanvas ! ! !AColorSelectorMorph methodsFor: 'visual properties' stamp: 'gvc 9/19/2006 15:46'! fillStyle: fillStyle "If it is a color then override with gradient." fillStyle isColor ifTrue: [self color: fillStyle] ifFalse: [super fillStyle: fillStyle]! ! !AColorSelectorMorph methodsFor: 'accessing' stamp: 'gvc 9/3/2009 13:43'! color: aColor "Set the gradient colors." super color: aColor asNontranslucentColor. self fillStyle: self defaultFillStyle! ! !AColorSelectorMorph methodsFor: 'private' stamp: 'gvc 9/22/2006 09:17'! hatchForm "Answer a form showing a grid hatch pattern." ^ColorPresenterMorph hatchForm! ! !AColorSelectorMorph methodsFor: '*Athens-Morphic' stamp: 'NicolaiHess 1/6/2015 18:11'! drawOnAthensCanvas: anAthensCanvas anAthensCanvas setPaint: (InfiniteForm with: self hatchForm). anAthensCanvas drawShape: self innerBounds. super drawOnAthensCanvas: anAthensCanvas! ! !AGroupContentHasBeenModified commentStamp: 'FranckWarlouzet 7/9/2015 14:13'! Notify that a group content has been modified! !AGroupHasBeenAdded commentStamp: 'TorstenBergmann 2/4/2014 21:09'! Notify that a group has been added! !AGroupHasBeenAdded class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 4/14/2011 16:32'! group: aGroup into: anHolder ^ self group: aGroup from: anHolder! ! !AGroupHasBeenCreated commentStamp: 'TorstenBergmann 2/4/2014 21:09'! Notify that a group has been created! !AGroupHasBeenRegistered commentStamp: 'TorstenBergmann 2/4/2014 21:09'! Notify that a group has been registered! !AGroupHasBeenRegistered class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 4/14/2011 13:40'! with: aGroup ^ self new group: aGroup! ! !AGroupHasBeenRemoved commentStamp: 'TorstenBergmann 2/4/2014 21:10'! Notify that a group has been removed! !AGroupHasBeenRenamed commentStamp: 'TorstenBergmann 2/4/2014 21:10'! Notify that a group has been renamed! !AGroupHasBeenUnregistered commentStamp: 'TorstenBergmann 2/4/2014 21:10'! Notify that a group has been unregistered! !AGroupHasBeenUnregistered class methodsFor: 'instance creation' stamp: 'BenjaminVanRyseghem 4/14/2011 13:40'! with: aGroup ^ self new group: aGroup! ! !ASTCache commentStamp: ''! I am a simple cache for AST nodes corresponding to CompiledMethods in the image. The cache is emptied when the image is saved.! !ASTCache methodsFor: 'accessing' stamp: 'GuillermoPolito 5/14/2013 10:52'! at: aCompiledMethod ^ self at: aCompiledMethod ifAbsentPut: [ aCompiledMethod parseTree doSemanticAnalysisIn: aCompiledMethod methodClass ]! ! !ASTCache methodsFor: 'accessing' stamp: 'CamilloBruni 2/17/2012 14:29'! reset self removeAll! ! !ASTCache class methodsFor: 'accessing' stamp: 'ChristopheDemarey 8/14/2015 11:09'! reset default reset. SystemAnnouncer uniqueInstance announce: ASTCacheReset new ! ! !ASTCache class methodsFor: 'accessing' stamp: 'CamilloBruni 2/17/2012 14:22'! at: aCompiledMethod ^ default at: aCompiledMethod! ! !ASTCache class methodsFor: 'accessing' stamp: 'CamilloBruni 2/17/2012 14:30'! default ^ default! ! !ASTCache class methodsFor: 'accessing' stamp: 'CamilloBruni 2/17/2012 14:30'! default: anASTCache default := anASTCache.! ! !ASTCache class methodsFor: 'system startup' stamp: 'ChristopheDemarey 8/14/2015 11:10'! shutDown self reset! ! !ASTCache class methodsFor: 'class initialization' stamp: 'ChristopheDemarey 2/1/2016 16:37'! initialize default := self new. SessionManager default registerSystemClassNamed: self name! ! !ASTCacheReset commentStamp: 'ChristopheDemarey 8/14/2015 11:16'! Announcement signaled to tell that the default AST Cache has been reset. Tools that want persistant AST annotations can subscribe to this announcement to reinstall annotations.! !ASTCacheResetTest methodsFor: 'running' stamp: 'ChristopheDemarey 8/14/2015 14:06'! tearDown ASTCache default: cache. node removeLink: link! ! !ASTCacheResetTest methodsFor: 'running' stamp: 'ChristopheDemarey 8/14/2015 14:06'! setUp cache := ASTCache default copy. counter := 0. link := MetaLink new metaObject: self; selector: #increment. node := (self class >> #annotatedMethod) ast statements last value. node link: link! ! !ASTCacheResetTest methodsFor: 'test material' stamp: 'ChristopheDemarey 8/14/2015 12:12'! increment counter := counter + 1! ! !ASTCacheResetTest methodsFor: 'test material' stamp: 'ChristopheDemarey 8/14/2015 12:09'! annotatedMethod ^ 42! ! !ASTCacheResetTest methodsFor: 'tests' stamp: 'ChristopheDemarey 8/14/2015 13:21'! testCacheResetPreserveLinks self annotatedMethod. self assert: counter equals: 1. ASTCache reset. self assert: (self class >> #annotatedMethod) ast statements last value links anyOne == link. self annotatedMethod. self assert: counter equals: 2! ! !ASTPluginMeaningOfLife commentStamp: 'MarcusDenker 2/28/2015 15:54'! A simple example for a AST transforming compiler plugin. I replace 42 with a 'meaning of life'.! !ASTPluginMeaningOfLife methodsFor: 'transformation' stamp: 'MarcusDenker 2/28/2015 15:56'! transform | rule | rule := RBParseTreeRewriter replaceLiteral: 42 with: 'meaning of life'. rule executeTree: ast. ^ast! ! !ASTTransformExamplePluginActive commentStamp: 'MarcusDenker 2/28/2015 16:02'! This class changes the default compiler used to compile itself to include the AST transforming plugin ASTPluginMeaningOfLife. #example42 does not mean what you think it means (see bytecode)! !ASTTransformExamplePluginActive methodsFor: 'example' stamp: 'MarcusDenker 2/28/2015 15:53'! example42 ^42! ! !ASTTransformExamplePluginActive class methodsFor: 'compiler' stamp: 'MarcusDenker 2/28/2015 15:17'! compiler "the example plugin is active for this class" ^super compiler addPlugin: ASTPluginMeaningOfLife.! ! !ASTTransformationPluginTest methodsFor: 'tests' stamp: 'MarcusDenker 2/28/2015 15:19'! testClassWithPluginEnabled self assert: ASTTransformExamplePluginActive new example42 = 'meaning of life'! ! !ASTTransformationPluginTest methodsFor: 'tests' stamp: 'MarcusDenker 2/28/2015 15:53'! testTransform | ast | ast := (OCOpalExamples>>#exampleReturn42) ast copy. self assert: ast body statements first value value = 42. ast := ASTPluginMeaningOfLife transform: ast. self assert: ast body statements first value value = 'meaning of life'.! ! !Abort commentStamp: 'TorstenBergmann 2/4/2014 21:42'! Notify to abort a task! !Abort methodsFor: 'accessing' stamp: 'ajh 3/24/2003 00:55'! defaultAction "No one has handled this error, but now give them a chance to decide how to debug it. If none handle this either then open debugger (see UnhandedError-defaultAction)" UnhandledError signalForException: self! ! !AboutDialogWindow commentStamp: 'gvc 5/18/2007 13:53'! Default superclass for application about dialogs.! !AboutDialogWindow methodsFor: 'defaults' stamp: 'TorstenBergmann 10/21/2015 14:19'! defaultLabel "Answer the default label for the receiver." ^'About' translated! ! !AboutDialogWindow class methodsFor: 'instance creation' stamp: 'TorstenBergmann 10/21/2015 14:20'! open