SystemOrganization addCategory: #'Slime-Core'! SystemOrganization addCategory: #'Slime-Tests'! !ParseTreeEnvironment methodsFor: '*slime' stamp: 'lr 12/17/2007 10:48'! matcher ^ matcher ifNil: [ matcher := ParseTreeSearcher new ]! ! TransformationRule subclass: #SlimeTransformationRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Slime-Core'! !SlimeTransformationRule class methodsFor: 'transformations' stamp: 'lr 2/21/2008 10:34'! ansiCompatibility ^self rewrite: #( ('``@expr1 and: [ ``@expr2 ] and: [ ``@expr3 ]' '``@expr1 and: [ ``@expr2 and: [ ``@expr3 ] ]') ('``@expr1 and: [ ``@expr2 ] and: [ ``@expr3 ] and: [ ``@expr4 ]' '``@expr1 and: [ ``@expr2 and: [ ``@expr3 and: [ ``@expr4 ] ] ]') ('``@expr1 and: [ ``@expr2 ] and: [ ``@expr3 ] and: [ ``@expr4 ] and: [ ``@expr5 ]' '``@expr1 and: [ ``@expr2 and: [ ``@expr3 and: [ ``@expr4 and: [ ``@expr5 ] ] ] ]') ('``@collection withIndexDo: [ :`each :`index | ``@body ]' '``@collection keysAndValuesDo: [ :`index :`each | ``@body ]') ('``@collection collect: ``@block1 thenDo: ``@block2' '(``@collection collect: ``@block1) do: ``@block2') ('``@collection collect: ``@block1 thenSelect: ``@block2' '(``@collection collect: ``@block1) select: ``@block2') ('``@expr1 or: [ ``@expr2 ] or: [ ``@expr3 ]' '``@expr1 or: [ ``@expr2 or: [ ``@expr3 ] ]') ('``@expr1 or: [ ``@expr2 ] or: [ ``@expr3 ] or: [ ``@expr4 ]' '``@expr1 or: [ ``@expr2 or: [ ``@expr3 or: [ ``@expr4 ] ] ]') ('``@expr1 or: [ ``@expr2 ] or: [ ``@expr3 ] or: [ ``@expr4 ] or: [ ``@expr5 ]' '``@expr1 or: [ ``@expr2 or: [ ``@expr3 or: [ ``@expr4 or: [ ``@expr5 ] ] ] ]') ('``@collection pairsDo: [ :`t1 :`t2 | ``@statements ]' '1 to: ``@collection size by: 2 do: [ :index | | `t1 `t2 | t1 := ``@collection at: index. t2 := ``@collection at: index + 1. ``@statements ]') ('``@collection reject: ``@block1 thenDo: ``@block2' '(``@collection reject: ``@block1) do: ``@block2') ('``@collection select: ``@block1 thenCollect: ``@block2' '(``@collection select: ``@block1) collect: ``@block2') ('``@collection select: ``@block1 thenDo: ``@block2' '(``@collection select: ``@block1) do: ``@block2')) methods: false name: 'Ensure ANSI compatiblity'! ! !SmalllintContext methodsFor: '*slime' stamp: 'lr 7/15/2008 23:02'! isRenderingMethod (self selector numArgs > 0 and: [ self selector beginsWith: #render ]) ifFalse: [ ^ false ]. self compiledMethod literalsDo: [ :each | (each isSymbol and: [ Slime isBrushSelector: each ]) ifTrue: [ ^ true ] ]. ^ false! ! !RBProgramNode methodsFor: '*slime' stamp: 'lr 12/17/2007 10:02'! parents ^ parent isNil ifTrue: [ OrderedCollection with: self ] ifFalse: [ parent parents addLast: self; yourself ]! ! TestCase subclass: #SlimeTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Slime-Tests'! !SlimeTest methodsFor: 'actions' stamp: 'lr 7/15/2008 22:55'! run: aRule selectors: aSelectorCollection self run: aRule selectors: aSelectorCollection in: (Array with: SlimeMockComponent with: SlimeMockObject)! ! !SlimeTest methodsFor: 'actions' stamp: 'lr 7/15/2008 23:41'! run: aRule selectors: aSelectorCollection in: aClassCollection | searchEnvironment resultEnvironment | searchEnvironment := ClassEnvironment onEnvironment: BrowserEnvironment new classes: aClassCollection. SmalllintChecker runRule: aRule onEnvironment: searchEnvironment. resultEnvironment := aRule result. self assert: resultEnvironment problemCount = aSelectorCollection size. aSelectorCollection do: [ :selector | self assert: (resultEnvironment classes anySatisfy: [ :class | resultEnvironment includesSelector: selector in: class ]) ]! ! !SlimeTest methodsFor: 'testing-misc' stamp: 'lr 7/15/2008 23:19'! testAvoidUnnecessaryWith self run: SlimeParseTreeLintRule avoidUnnecessaryWith selectors: #(renderAvoidUnnecessaryWithOn:)! ! !SlimeTest methodsFor: 'testing-misc' stamp: 'lr 7/15/2008 23:10'! testBasicNewInitializeMissing self run: SlimeBlockLintRule basicNewInitializeMissing selectors: #(initialize)! ! !SlimeTest methodsFor: 'testing-possible' stamp: 'lr 7/15/2008 23:36'! testChangesStateWhileRendering self run: SlimeBlockLintRule changesStateWhileRendering selectors: #(renderChangesStateWhileRenderingOn:)! ! !SlimeTest methodsFor: 'testing-bugs' stamp: 'lr 7/15/2008 22:53'! testDoNotUseWhileRendering self run: SlimeBlockLintRule doNotUseWhileRendering selectors: #(renderDoNotUseWhileRenderingOn:)! ! !SlimeTest methodsFor: 'testing-bugs' stamp: 'lr 7/15/2008 22:53'! testDoNotUseWithinCallback self run: SlimeBlockLintRule doNotUseWithinCallback selectors: #(renderDoNotUseWithinCallbackOn:)! ! !SlimeTest methodsFor: 'testing-bugs' stamp: 'lr 7/15/2008 22:54'! testDoesNotSendSuperInitialize self run: SlimeBlockLintRule doesNotSendSuperInitialize selectors: #(initialize)! ! !SlimeTest methodsFor: 'testing-misc' stamp: 'lr 7/15/2008 23:11'! testDontCallSuperInitialize self run: SlimeBlockLintRule dontCallSuperInitialize selectors: #(initialize)! ! !SlimeTest methodsFor: 'testing-misc' stamp: 'lr 7/15/2008 23:21'! testExtractCallbackCodeToMethod self run: SlimeParseTreeLintRule extractCallbackCodeToMethod selectors: #(renderExtractCallbackCodeToMethodOn:)! ! !SlimeTest methodsFor: 'testing-possible' stamp: 'lr 7/15/2008 23:40'! testFixCallbackTempsMissing self run: SlimeParseTreeLintRule fixCallbackTempsMissing selectors: #(callbackTemps)! ! !SlimeTest methodsFor: 'testing-bugs' stamp: 'lr 7/15/2008 22:57'! testInstantiatesComponentWhileRendering self run: SlimeBlockLintRule instantiatesComponentWhileRendering selectors: #(renderInstantiatesComponentWhileRenderingOn:)! ! !SlimeTest methodsFor: 'testing-possible' stamp: 'lr 7/15/2008 23:38'! testSendsDeprecatedMessage self run: SlimeBlockLintRule sendsDeprecatedMessage selectors: #(renderSendsDeprecatedMessageOn:)! ! !SlimeTest methodsFor: 'testing-misc' stamp: 'lr 7/15/2008 23:23'! testSendsNotPortableMessage self run: SlimeParseTreeLintRule sendsNotPortableMessage selectors: #(someMessage)! ! !SlimeTest methodsFor: 'testing-misc' stamp: 'lr 7/15/2008 23:24'! testSendsRenderContentOn self run: SlimeParseTreeLintRule sendsRenderContentOn selectors: #(sendsRenderContentOn)! ! !SlimeTest methodsFor: 'testing-misc' stamp: 'lr 7/15/2008 23:35'! testUnnecessaryBlockPassedToBrush self run: SlimeParseTreeLintRule unnecessaryBlockPassedToBrush selectors: #(renderUnnecessaryBlockPassedToBrushOn:)! ! !SlimeTest methodsFor: 'testing-misc' stamp: 'lr 7/15/2008 23:18'! testUsesCurlyBraceArrays self run: SlimeBlockLintRule usesCurlyBraceArrays selectors: #()! ! !SlimeTest methodsFor: 'testing-misc' stamp: 'lr 7/15/2008 23:18'! testUsesLiteralByteArrays self run: SlimeBlockLintRule usesLiteralByteArrays selectors: #()! ! !SlimeTest methodsFor: 'testing-misc' stamp: 'lr 7/15/2008 23:13'! testUsesNotPortableClass self run: SlimeBlockLintRule usesNotPortableClass selectors: #(someClass)! ! !SlimeTest methodsFor: 'testing-bugs' stamp: 'lr 7/15/2008 23:06'! testUsesWrongRenderer self run: SlimeParseTreeLintRule usesWrongRenderer selectors: #(renderUsesWrongRendererOn:)! ! !SlimeTest methodsFor: 'testing-bugs' stamp: 'lr 7/15/2008 23:08'! testWithHasToBeLastMessageInCascade self run: SlimeParseTreeLintRule withHasToBeLastMessageInCascade selectors: #(renderWithHasToBeLastMessageInCascadeOn:)! ! Object subclass: #Slime instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Slime-Core'! Slime class instanceVariableNames: 'forbiddenCallbackSelectors attributeSelectors callbackSelectors brushSelectors notPortableClasses superSelectors deprecatedSelectors notPortableSelectors braceSelectors forbiddenRenderingSelectors deprecatedClasses'! Slime class instanceVariableNames: 'forbiddenCallbackSelectors attributeSelectors callbackSelectors brushSelectors notPortableClasses superSelectors deprecatedSelectors notPortableSelectors braceSelectors forbiddenRenderingSelectors deprecatedClasses'! !Slime class methodsFor: 'accessing' stamp: 'lr 1/25/2008 23:35'! attributeSelectors ^ attributeSelectors! ! !Slime class methodsFor: 'accessing' stamp: 'lr 1/25/2008 21:42'! braceSelectors ^ braceSelectors! ! !Slime class methodsFor: 'accessing' stamp: 'lr 1/25/2008 23:21'! brushSelectors ^ brushSelectors! ! !Slime class methodsFor: 'accessing' stamp: 'lr 1/25/2008 23:21'! callbackSelectors ^ callbackSelectors! ! !Slime class methodsFor: 'accessing' stamp: 'lr 7/15/2008 23:49'! deprecatedClasses ^ deprecatedClasses! ! !Slime class methodsFor: 'accessing' stamp: 'lr 12/17/2007 23:04'! deprecatedSelectors ^ deprecatedSelectors! ! !Slime class methodsFor: 'accessing' stamp: 'lr 7/15/2008 21:44'! forbiddenCallbackSelectors ^ forbiddenCallbackSelectors! ! !Slime class methodsFor: 'accessing' stamp: 'lr 7/15/2008 21:44'! forbiddenRenderingSelectors ^ forbiddenRenderingSelectors! ! !Slime class methodsFor: 'initialization' stamp: 'lr 7/15/2008 23:49'! initialize self initializeAttributeSelectors. self initializeBraceSelectors. self initializeBrushSelectors. self initializeDeprecatedClasses. self initializeDeprecatedSelectors. self initializeCallbackSelectors. self initializeForbiddenCallbackSelectors. self initializeForbiddenRenderingSelectors. self initializeNotPortableSelectors. self initializeNotPortableClasses. self initializeSuperSelectors! ! !Slime class methodsFor: 'initialization' stamp: 'lr 1/25/2008 23:49'! initializeAttributeSelectors | matcher | matcher := ParseTreeSearcher new. matcher matchesAnyOf: #( 'self addClass: `@value' 'self addStyle: `@value' 'self attributeAt: `@key put: `@value' 'self attributeAt: `@key ifAbsentPut: `@block' 'self attributes at: `@key put: `@value' 'self attributes at: `@key ifAbsentPut: `@block' 'self attributes at: `@key append: `@value' 'self attributes at: `@key append: `@value separator: `@separator' ) do: [ :context :node | true ]. attributeSelectors := Set new. WABrush allSubclassesDo: [ :class | class methodDictionary keysAndValuesDo: [ :selector :method | (matcher executeTree: method parseTree initialAnswer: false) ifTrue: [ attributeSelectors add: selector ] ] ]. #( callback: enabled: labels: value: ) do: [ :each | attributeSelectors add: each ]! ! !Slime class methodsFor: 'initialization' stamp: 'lr 1/25/2008 21:42'! initializeBraceSelectors braceSelectors := #( braceStream: braceWith: braceWith:with: braceWith:with:with: braceWith:with:with:with: braceWithNone ) asSet! ! !Slime class methodsFor: 'initialization' stamp: 'lr 1/25/2008 23:22'! initializeBrushSelectors | matcher | matcher := ParseTreeSearcher new. matcher matchesAnyMethodOf: #( '`selector ^ self tag: `#tag' '`selector ^ self brush: `@obj' '`selector: `aBlock self `selector with: `aBlock' '`selector ^ `class on: self' ) do: [ :context :node | true ]. brushSelectors := Set new. WACanvas allSubclassesDo: [ :class | class methodDictionary keysAndValuesDo: [ :selector :method | (matcher executeTree: method parseTree initialAnswer: false) ifTrue: [ brushSelectors add: selector ] ] ]! ! !Slime class methodsFor: 'initialization' stamp: 'lr 1/25/2008 23:38'! initializeCallbackSelectors callbackSelectors := #( callback: callback:value: defaultAction: triggerArgument:callback: triggerAutocompleter: triggerInPlaceEditor: triggerPassenger: triggerSliderCallback: triggerSortable:callback: triggerTree:callback: ) asSet! ! !Slime class methodsFor: 'initialization' stamp: 'lr 7/15/2008 23:57'! initializeDeprecatedClasses deprecatedClasses := #( WAStandardScripts WAStandardStyles WAModelProxy WAStateHolder ) asSet! ! !Slime class methodsFor: 'initialization' stamp: 'lr 7/15/2008 23:48'! initializeDeprecatedSelectors | selectors | selectors := #( deprecatedApi deprecatedApi: ). deprecatedSelectors := Set new. Object allSubclassesDo: [ :class | class methodDictionary keysAndValuesDo: [ :selector :method | method literalsDo: [ :each | (selectors includes: each) ifTrue: [ deprecatedSelectors add: selector ] ] ] ]. #( registerObjectForBacktracking: registerForBacktracking beSingle beMultiple beDependent beResizable showScrollbars showToolbar layout ) do: [ :each | deprecatedSelectors add: each ]. #( new text: renderDeprecatedOn: addLoadScript: ) do: [ :each | deprecatedSelectors remove: each ifAbsent: [ ] ]! ! !Slime class methodsFor: 'initialization' stamp: 'lr 7/15/2008 21:44'! initializeForbiddenCallbackSelectors forbiddenCallbackSelectors := #( addLoadScript: ) asSet! ! !Slime class methodsFor: 'initialization' stamp: 'lr 7/15/2008 21:43'! initializeForbiddenRenderingSelectors forbiddenRenderingSelectors := #( answer answer: call: show: show:onAnswer: show:onAnswer:delegation: lightbox: chooseFrom: chooseFrom:caption: confirm: inform: request: request:default: request:label: request:label:default: ) asSet! ! !Slime class methodsFor: 'initialization' stamp: 'lr 1/25/2008 21:15'! initializeNotPortableClasses notPortableClasses := #( Semaphore MIMEDocument Random ) asSet! ! !Slime class methodsFor: 'initialization' stamp: 'lr 2/12/2008 08:06'! initializeNotPortableSelectors notPortableSelectors := #( and:and: and:and:and: and:and:and:and: collect:thenDo: collect:thenSelect: doIfNotNil: fixTemps ifNil:ifNotNil: ifNil:ifNotNilDo: ifNotNil: ifNotNil:ifNil: ifNotNilDo: ifNotNilDo:ifNil: match: or:or:or: or:or:or:or: or:or:or:or:or: pairsDo: reject:thenDo: select:thenCollect: select:thenDo: signal signal: with:collect: ) asSet! ! !Slime class methodsFor: 'initialization' stamp: 'lr 7/15/2008 21:41'! initializeSuperSelectors superSelectors := Dictionary new. superSelectors at: WAPresenter name put: #( initialize updateRoot: updateStates: updateUrl: initialRequest: ) asSet; at: WATagBrush name put: #( initialize setParent:canvas: #with: ) asSet! ! !Slime class methodsFor: 'testing' stamp: 'lr 7/15/2008 21:41'! isBrushSelector: aString Symbol hasInterned: aString ifTrue: [ :symbol | ^ brushSelectors includes: symbol ]. ^ false! ! !Slime class methodsFor: 'testing' stamp: 'lr 7/15/2008 21:41'! isCallbackSelector: aString Symbol hasInterned: aString ifTrue: [ :symbol | ^ callbackSelectors includes: symbol ]. ^ false! ! !Slime class methodsFor: 'testing' stamp: 'lr 7/15/2008 23:49'! isWithinCallback: aNode | parent | parent := aNode parent ifNil: [ ^ false ]. (aNode isBlock and: [ parent isMessage and: [ callbackSelectors includes: parent selector ] ]) ifTrue: [ ^ true ]. ^ self isWithinCallback: parent! ! !Slime class methodsFor: 'accessing' stamp: 'lr 1/25/2008 21:14'! notPortableClasses. ^ notPortableClasses! ! !Slime class methodsFor: 'accessing' stamp: 'lr 1/25/2008 21:08'! notPortableSelectors ^ notPortableSelectors! ! !Slime class methodsFor: 'accessing' stamp: 'lr 12/17/2007 15:57'! superSelectors ^ superSelectors! ! Object subclass: #SlimeMockObject instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Slime-Tests'! !SlimeMockObject methodsFor: 'accessing' stamp: 'lr 7/15/2008 23:44'! callbackTemps | r | r := OrderedCollection new. (1 to: 10) do: [ :e | r add: [ e ] ]! ! !SlimeMockObject methodsFor: 'initialize-release' stamp: 'lr 7/15/2008 23:10'! initialize super initialize! ! !SlimeMockObject methodsFor: 'accessing' stamp: 'lr 7/15/2008 23:13'! someClass Semaphore new! ! !SlimeMockObject methodsFor: 'accessing' stamp: 'lr 7/15/2008 23:26'! someMessage ^ true and: [ false ] and: [ nil ]! ! WAComponent subclass: #SlimeMockComponent instanceVariableNames: 'foo maybe' classVariableNames: '' poolDictionaries: '' category: 'Slime-Tests'! !SlimeMockComponent methodsFor: 'initialize-release' stamp: 'lr 7/15/2008 22:16'! initialize "Does not send super"! ! !SlimeMockComponent methodsFor: 'rendering' stamp: 'lr 7/15/2008 23:21'! renderAvoidUnnecessaryWithOn: html html div with: 'foo'! ! !SlimeMockComponent methodsFor: 'rendering' stamp: 'lr 7/15/2008 23:36'! renderChangesStateWhileRenderingOn: html html div: [ foo := nil ]! ! !SlimeMockComponent methodsFor: 'rendering' stamp: 'lr 7/15/2008 23:24'! renderContentOn: html super renderContentOn: html! ! !SlimeMockComponent methodsFor: 'rendering' stamp: 'lr 7/15/2008 22:17'! renderDoNotUseWhileRenderingOn: html html div: [ self call: foo ]! ! !SlimeMockComponent methodsFor: 'rendering' stamp: 'lr 7/15/2008 22:17'! renderDoNotUseWithinCallbackOn: html html anchor callback: [ self session addLoadScript: nil ]; with: 'foo'! ! !SlimeMockComponent methodsFor: 'rendering' stamp: 'lr 7/15/2008 23:22'! renderExtractCallbackCodeToMethodOn: html html anchor callback: [ self foo. self bar ]; with: 'foo'! ! !SlimeMockComponent methodsFor: 'rendering' stamp: 'lr 7/15/2008 23:03'! renderInstantiatesComponentWhileRenderingOn: html html div: WABrowser new! ! !SlimeMockComponent methodsFor: 'rendering' stamp: 'lr 7/15/2008 23:38'! renderSendsDeprecatedMessageOn: html html anchor src: 'http://www.foo.com'; with: 'Foo'! ! !SlimeMockComponent methodsFor: 'rendering' stamp: 'lr 7/15/2008 23:35'! renderUnnecessaryBlockPassedToBrushOn: html html div: [ html render: 'foo' ]! ! !SlimeMockComponent methodsFor: 'rendering' stamp: 'lr 7/15/2008 23:08'! renderUsesWrongRendererOn: html html updater callback: [ :r | html div ]! ! !SlimeMockComponent methodsFor: 'rendering' stamp: 'lr 7/15/2008 22:27'! renderWithHasToBeLastMessageInCascadeOn: html html div with: 'foo'; class: 'bar'! ! !SlimeMockComponent methodsFor: 'actions' stamp: 'lr 7/15/2008 23:26'! sendsRenderContentOn self renderContentOn: nil! ! BlockLintRule subclass: #SlimeBlockLintRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Slime-Core'! !SlimeBlockLintRule class methodsFor: 'miscellaneous' stamp: 'lr 2/21/2008 10:19'! basicNewInitializeMissing | matcher | matcher := ParseTreeSearcher new. matcher matches: 'self basicNew initialize' do: [ :node :answer | true ]. ^ self new name: '#basicNew initialize is missing'; rationale: '#initialize is not called implicitely when sending #new to an object in other Smalltalk dialects.'; classBlock: [ :context :result | (context selectedClass superclass = Object and: [ (context selectedClass includesSelector: #initialize) and: [ context selectedClass class methodDict noneSatisfy: [ :each | matcher executeTree: each parseTree initialAnswer: false ] ] ]) ifTrue: [ result addClass: context selectedClass selector: #initialize ] ]! ! !SlimeBlockLintRule class methodsFor: 'possible bugs' stamp: 'lr 7/15/2008 23:55'! changesStateWhileRendering | matcher matches | matcher := ParseTreeSearcher new. matcher matches: '`var' do: [ :node :answer | (node isWrite and: [ (Slime isWithinCallback: node) not ]) ifTrue: [ answer add: node ]. answer ]. ^ self new name: 'Changes state while rendering'; rationale: 'Application state should not be changed in the rendering code, use a callback to define state.'; resultClass: ParseTreeEnvironment; methodBlock: [ :context :result | | vars | context isRenderingMethod ifTrue: [ matches := matcher executeTree: context parseTree initialAnswer: OrderedCollection new. matches isEmpty ifFalse: [ vars := context instVarNames. matches do: [ :each | (vars includes: each name) ifTrue: [ result addClass: context selectedClass selector: context selector. result matcher matches: each name , ' := ``@obj' do: [ :node :answer | answer isNil ifTrue: [ node ] ifFalse: [ answer ] ] ] ] ] ] ]! ! !SlimeBlockLintRule class methodsFor: 'bugs' stamp: 'lr 7/15/2008 23:04'! doNotUseWhileRendering | matcher matches | matcher := ParseTreeSearcher new. matcher matchesAnyOf: (Slime forbiddenRenderingSelectors collect: [ :each | '``@receiver' , (ParseTreeLintRule genericPatternForSelector: each) ]) do: [ :node :answer | (Slime isWithinCallback: node) ifFalse: [ answer add: node ]. answer ]. ^ self new name: 'Do not use while rendering'; rationale: 'Certain functionaly should not be used while rendering. For example: #call: and #answer: should only be used from within callback code.'; methodBlock: [ :context :result | context isRenderingMethod ifTrue: [ matches := matcher executeTree: context parseTree initialAnswer: OrderedCollection new. matches do: [ :each | result addClass: context selectedClass selector: context selector. result addSearchString: each selector ] ] ]! ! !SlimeBlockLintRule class methodsFor: 'bugs' stamp: 'lr 7/15/2008 23:04'! doNotUseWithinCallback | matcher matches | matcher := ParseTreeSearcher new. matcher matchesAnyOf: (Slime forbiddenCallbackSelectors collect: [ :each | '``@receiver' , (ParseTreeLintRule genericPatternForSelector: each) ]) do: [ :node :answer | (Slime isWithinCallback: node) ifTrue: [ answer add: node ]. answer ]. ^ self new name: 'Do not use within callback'; rationale: 'Certain functionaly should not be used within callbacks. For example: #addLoadScript: should only be used while rendering.'; methodBlock: [ :context :result | context isRenderingMethod ifTrue: [ matches := matcher executeTree: context parseTree initialAnswer: OrderedCollection new. matches do: [ :each | result addClass: context selectedClass selector: context selector. result addSearchString: each selector ] ] ]! ! !SlimeBlockLintRule class methodsFor: 'bugs' stamp: 'lr 2/21/2008 10:19'! doesNotSendSuperInitialize ^ self new name: 'Does not send super'; rationale: 'Always send super when overriding specific hook methods.'; methodBlock: [ :context :result | | class selectors | class := context selectedClass allSuperclasses detect: [ :each | Slime superSelectors includesKey: each name ] ifNone: [ Object ]. selectors := Slime superSelectors at: class name ifAbsent: [ #() ]. ((selectors includes: context selector) and: [ (context parseTree superMessages includes: context selector) not ]) ifTrue: [ result addClass: context selectedClass selector: context selector ] ]! ! !SlimeBlockLintRule class methodsFor: 'miscellaneous' stamp: 'lr 2/21/2008 10:19'! dontCallSuperInitialize ^ self new name: 'Don''t call super initialize'; rationale: 'super initialize should not be called for direct subclasses of Object, as Object does not implement #initialize in other Smalltalk dialects.'; methodBlock: [ :context :result | (context selectedClass superclass = Object and: [ context selector = #initialize and: [ context superMessages includes: #initialize ] ]) ifTrue: [ result addClass: context selectedClass selector: #initialize ] ]! ! !SlimeBlockLintRule class methodsFor: 'bugs' stamp: 'lr 7/16/2008 00:58'! instantiatesComponentWhileRendering | matcher matches class | matcher := ParseTreeSearcher new. matcher matches: '``@receiver `@message: ``@args' do: [ :node :answer | (node receiver isVariable and: [ (class := Smalltalk classNamed: node receiver name) notNil and: [ (class isBehavior) and: [ (class includesBehavior: WAPresenter) and: [ (Slime isWithinCallback: node) not ] ] ] ]) ifTrue: [ answer add: node ]. answer ]. ^ self new name: 'Instantiates component while rendering'; rationale: 'Components should only be instanciated in initialization-code, callbacks or through lazy initialization.'; methodBlock: [ :context :result | context isRenderingMethod ifTrue: [ matches := matcher executeTree: context parseTree initialAnswer: OrderedCollection new. matches do: [ :each | result addClass: context selectedClass selector: context selector. result addSearchString: each receiver name ] ] ] ! ! !SlimeBlockLintRule class methodsFor: 'possible bugs' stamp: 'lr 2/21/2008 10:19'! sendsDeprecatedMessage ^ self new name: 'Sends deprecated message'; rationale: 'Deprecated selectors will be removed with the next release of Seaside.'; methodBlock: [ :context :result | context messages do: [ :each | (Slime deprecatedSelectors includes: each) ifTrue: [ result addClass: context selectedClass selector: context selector. result addSearchString: each ] ] ]! ! !SlimeBlockLintRule class methodsFor: 'miscellaneous' stamp: 'lr 7/15/2008 23:16'! usesCurlyBraceArrays ^ self new name: 'Uses curly brace arrays'; rationale: 'Curly brace expressions are not portable accross different Smalltalk dialects.'; methodBlock: [ :context :result | context compiledMethod literals do: [ :each | (each isSymbol and: [ Slime braceSelectors includes: each ]) ifTrue: [ result addClass: context selectedClass selector: context selector. result addSearchString: '{' ] ] ]! ! !SlimeBlockLintRule class methodsFor: 'possible bugs' stamp: 'lr 7/16/2008 00:10'! usesDeprecatedClass ^ self new name: 'Uses deprecated class'; rationale: 'Deprecated classes will be removed with the next release of Seaside.'; classBlock: [ :context :result | (context selectedClass allSuperclasses anySatisfy: [ :each | Slime deprecatedClasses includes: each name ]) ifTrue: [ result addClass: context selectedClass ] ]; methodBlock: [ :context :result | context compiledMethod literalsDo: [ :each | (each isVariableBinding and: [ Slime deprecatedClasses includes: each key ]) ifTrue: [ result addClass: context selectedClass selector: context selector. result addSearchString: each key ] ] ]! ! !SlimeBlockLintRule class methodsFor: 'miscellaneous' stamp: 'lr 2/21/2008 10:19'! usesLiteralByteArrays ^ self new name: 'Uses literal byte arrays'; rationale: 'Literal byte arrays are not portable accross different Smalltalk dialects.'; methodBlock: [ :context :result | context compiledMethod literals do: [ :each | (each isLiteral and: [ each isKindOf: ByteArray ]) ifTrue: [ result addClass: context selectedClass selector: context selector. result addSearchString: '#[' ] ] ]! ! !SlimeBlockLintRule class methodsFor: 'miscellaneous' stamp: 'lr 7/15/2008 23:18'! usesNotPortableClass ^ self new name: 'Uses not portable class'; rationale: 'Some classes are not portable accross different Smalltalk dialects.'; methodBlock: [ :context :result | context compiledMethod literalsDo: [ :each | (each isVariableBinding and: [ Slime notPortableClasses includes: each key ]) ifTrue: [ result addClass: context selectedClass selector: context selector. result addSearchString: each key ] ] ]! ! ParseTreeLintRule subclass: #SlimeParseTreeLintRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Slime-Core'! !SlimeParseTreeLintRule class methodsFor: 'miscellaneous' stamp: 'lr 2/21/2008 10:19'! avoidUnnecessaryWith | matcher | matcher := ParseTreeSearcher new. matcher matches: '`html `msg with: ``@arg' do: [ :node :answer | (answer isNil and: [ node parent isCascade not and: [ (Slime isBrushSelector: node receiver selector) and: [ (Slime isBrushSelector: node receiver selector , ':') and: [ (Slime isBrushSelector: node methodNode selector) not ] ] ] ]) ifTrue: [ node ] ]. ^ self new name: 'Avoid unnecessary #with:'; rationale: 'Sending #with: is only required if attributes are specified too.'; matcher: matcher; yourself! ! !SlimeParseTreeLintRule class methodsFor: 'miscellaneous' stamp: 'lr 2/21/2008 10:19'! extractCallbackCodeToMethod | matcher | matcher := ParseTreeSearcher new. matcher matchesAnyOf: (Slime callbackSelectors collect: [ :each | '`html `msg' , (self genericPatternForSelector: each) ]) do: [ :node :answer | (answer isNil and: [ Slime isBrushSelector: node receiver selector ]) ifTrue: [ node arguments detect: [ :each | each isBlock and: [ each body statements size > 1 ] ] ifNone: [ nil ] ] ]. ^ self new name: 'Extract callback code to separate method'; rationale: 'For clarity rendering code and callback code should not be mixed, extract the contents of the callback block to a separate method.'; matcher: matcher; yourself! ! !SlimeParseTreeLintRule class methodsFor: 'possible bugs' stamp: 'lr 7/15/2008 23:42'! fixCallbackTempsMissing | saveSelectors matcher | saveSelectors := #( allSatisfy: anySatisfy: at:ifAbsent: at:ifAbsentPut: at:ifPresent: count: critical: detect:ifNone: do: do:separatedBy: ensure: fixCallbackTemps fixTemps ifCurtailed: inject:into: noneSatisfy: on:do: reject: render: select: should: should:description: should:raise: should:raise:description: should:raise:whoseDescriptionDoesNotInclude:description: should:raise:whoseDescriptionIncludes:description: shouldnt: shouldnt:description: shouldnt:raise: shouldnt:raise:description: shouldnt:raise:whoseDescriptionDoesNotInclude:description: shouldnt:raise:whoseDescriptionIncludes:description: timesRepeat: use:during: with: ) asSet. matcher := ParseTreeSearcher new. matcher matches: '[ | `@temps | `@.statements ]' do: [ :node :answer | | found | found := false. (answer isNil and: [ node isInlined not and: [ node parent isMessage ] ]) ifTrue: [ ((saveSelectors includes: node parent selector) or: [ (Slime brushSelectors includes: node parent selector) or: [ (Slime attributeSelectors includes: node parent selector) or: [ (Slime callbackSelectors includes: node parent selector) ] ] ]) ifFalse: [ | dangerousNames | dangerousNames := Set new. node parent parents do: [ :parent | parent isBlock ifTrue: [ dangerousNames addAll: parent argumentNames ]. parent isSequence ifTrue: [ dangerousNames addAll: parent temporaryNames ] ]. (dangerousNames anySatisfy: [ :each | node references: each ]) ifTrue: [ found := true ] ] ]. found ifTrue: [ node ] ]. ^ self new name: '#fixCallbackTemps possibly missing'; rationale: 'I don''t feel like explaining that here.'; matcher: matcher; yourself! ! !SlimeParseTreeLintRule class methodsFor: 'miscellaneous' stamp: 'lr 7/15/2008 23:33'! sendsNotPortableMessage | matcher | matcher := ParseTreeSearcher new. matcher matchesAnyOf: (Slime notPortableSelectors collect: [ :each | '`@object' , (self genericPatternForSelector: each) ]) , #('Dictionary withAll: `@args') do: [ :node :answer | node ]. ^ self new matcher: matcher; name: 'Sends not portable message'; rationale: 'Some methods are not portable accross different Smalltalk dialects.'! ! !SlimeParseTreeLintRule class methodsFor: 'miscellaneous' stamp: 'lr 7/15/2008 23:34'! sendsRenderContentOn | matcher | matcher := ParseTreeSearcher new. matcher matches: '`@object renderContentOn: `@html' do: [ :node :answer | (answer isNil and: [ (node receiver isVariable and: [ node receiver name = 'super' ]) not and: [ (#( render: renderWithContext: ) includes: node methodNode selector) not ] ]) ifTrue: [ node ] ]. ^ self new name: 'Sends #renderContentOn:'; rationale: 'Client code should never send #renderContentOn: directly but only #render:'; matcher: matcher; yourself! ! !SlimeParseTreeLintRule class methodsFor: 'miscellaneous' stamp: 'lr 2/21/2008 10:19'! unnecessaryBlockPassedToBrush | matcher | matcher := ParseTreeSearcher new. matcher matchesAnyOf: #( '`html `msg: [ ]' '`html `msg: [ `html text: ``@arg ]' '`html `msg: [ `html render: ``@arg ]' ) do: [ :node :answer | (answer isNil and: [ Slime isBrushSelector: node selector ]) ifTrue: [ node arguments first ] ]. matcher matchesAnyOf: #( '`html `msg with: [ ]' '`html `msg with: [ `html text: ``@arg ]' '`html `msg with: [ `html render: ``@arg ]' ) do: [ :node :answer | (answer isNil and: [ Slime isBrushSelector: node receiver selector ]) ifTrue: [ node arguments first ] ]. ^ self new name: 'Unnecessary block passed to brush'; rationale: 'Sending a block as argument to #with: is only needed when nesting brushes.'; matcher: matcher; yourself! ! !SlimeParseTreeLintRule class methodsFor: 'bugs' stamp: 'lr 2/21/2008 10:19'! usesWrongRenderer | matcher | matcher := ParseTreeSearcher new. matcher matchesAnyOf: #( '`html updater callback: [ :`r | | `@temps | `@.statements ]' '`html evaluator callback: [ :`r | | `@temps | `@.statements ]' '`html periodical callback: [ :`r | | `@temps | `@.statements ]' '`html autocompleter callback: [ :`r | | `@temps | `@.statements ]' '`html inPlaceEditor callback: [ :`r | | `@temps | `@.statements ]' '`html inPlaceCollectionEditor callback: [ :`r | | `@temps | `@.statements ]' ) do: [ :node :answer | (answer isNil and: [ node arguments first references: node receiver receiver name ]) ifTrue: [ node arguments first ] ifFalse: [ answer ] ]. ^ self new name: 'Uses the wrong renderer'; rationale: 'Within AJAX callbacks you need to use the renderer that is passed into the block, the renderer from the outer context is only valid during the rendering of the outer context.'; matcher: matcher; yourself! ! !SlimeParseTreeLintRule class methodsFor: 'bugs' stamp: 'lr 2/21/2008 10:19'! withHasToBeLastMessageInCascade | matcher | matcher := ParseTreeSearcher new. matcher matches: '`html `msg with: ``@arg' do: [ :node :answer | (answer isNil and: [ node parent isCascade and: [ (node parent messages last = node) not and: [ (Slime isBrushSelector: node receiver selector) ] ] ]) ifTrue: [ node ] ]. ^ self new name: '#with: has to be last message in cascade'; rationale: 'Sending #with: triggers serialization of the brush attributes, any attribute being specified afterwards has no effect.'; matcher: matcher; yourself! ! Slime initialize!