SystemOrganization addCategory: #'Slime-Core'! !ParseTreeEnvironment methodsFor: '*slime' stamp: 'lr 12/17/2007 10:48'! matcher ^ matcher ifNil: [ matcher := ParseTreeSearcher new ]! ! Object subclass: #Slime instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Slime-Core'! Slime class instanceVariableNames: 'allCallbackSelectors allBrushSelectors allCallAnswerSelectors'! Slime class instanceVariableNames: 'allCallbackSelectors allBrushSelectors allCallAnswerSelectors'! !Slime class methodsFor: 'accessing' stamp: 'lr 12/17/2007 11:19'! allBrushSelectors ^ allBrushSelectors! ! !Slime class methodsFor: 'accessing' stamp: 'lr 12/17/2007 11:29'! allCallAnswerSelectors ^ allCallAnswerSelectors! ! !Slime class methodsFor: 'accessing' stamp: 'lr 12/17/2007 11:09'! allCallbackSelectors ^ allCallbackSelectors! ! !Slime class methodsFor: 'initialization' stamp: 'lr 12/17/2007 11:26'! initialize self initializeAllBrushSelectors. self initializeAllCallbackSelectors. self initializeAllCallAnswerSelectors! ! !Slime class methodsFor: 'initialization' stamp: 'lr 12/17/2007 11:19'! initializeAllBrushSelectors | 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 ]. allBrushSelectors := Set new. WACanvas allSubclassesDo: [ :class | class methodDictionary keysAndValuesDo: [ :selector :method | (matcher executeTree: method parseTree initialAnswer: false) ifTrue: [ allBrushSelectors add: selector ] ] ]! ! !Slime class methodsFor: 'initialization' stamp: 'lr 12/17/2007 11:28'! initializeAllCallAnswerSelectors allCallAnswerSelectors := #( answer answer: call: show: show:onAnswer: show:onAnswer:delegation: lightbox: chooseFrom: chooseFrom:caption: confirm: inform: request: request:default: request:label: request:label:default: )! ! !Slime class methodsFor: 'initialization' stamp: 'lr 12/17/2007 10:38'! initializeAllCallbackSelectors allCallbackSelectors := #( callback: callback:value: defaultAction: triggerArgument:callback: triggerAutocompleter: triggerInPlaceEditor: triggerPassenger: triggerSliderCallback: triggerSortable:callback: triggerTree:callback: ) asSet! ! !Slime class methodsFor: 'testing' stamp: 'lr 12/15/2007 22:23'! isBrushSelector: aString Symbol hasInterned: aString ifTrue: [ :symbol | ^ allBrushSelectors includes: symbol ]. ^ false! ! !Slime class methodsFor: 'testing' stamp: 'lr 12/17/2007 10:14'! isCallbackSelector: aString Symbol hasInterned: aString ifTrue: [ :symbol | ^ allCallbackSelectors includes: symbol ]. ^ false! ! Object subclass: #SlimeExample instanceVariableNames: 'x' classVariableNames: '' poolDictionaries: '' category: 'Slime-Core'! !SlimeExample methodsFor: 'as yet unclassified' stamp: 'lr 12/17/2007 10:21'! renderChangeStateOn: html x := 1. html div: 'foo'! ! !SlimeExample methodsFor: 'as yet unclassified' stamp: 'lr 12/15/2007 23:05'! renderExternalizeCallbackCodeOn: html html anchor callback: [ 1 + 2. 2 + 3. 3 + 4 ]; with: 'Something'! ! !SlimeExample methodsFor: 'as yet unclassified' stamp: 'lr 12/17/2007 11:34'! renderFooBarOn: html html anchor callback: [ self call: self new]; with: 'foo'. self call: self new! ! !SlimeExample methodsFor: 'as yet unclassified' stamp: 'lr 12/15/2007 20:06'! renderUnnecessaryBlock1On: html html div: [ ]! ! !SlimeExample methodsFor: 'as yet unclassified' stamp: 'lr 12/15/2007 20:35'! renderUnnecessaryBlock2On: html html div class: 'example'; with: [ ]! ! !SlimeExample methodsFor: 'as yet unclassified' stamp: 'lr 12/15/2007 20:07'! renderUnnecessaryBlock3On: html html div: [ html text: 'foo' ]! ! !SlimeExample methodsFor: 'as yet unclassified' stamp: 'lr 12/15/2007 20:35'! renderUnnecessaryBlock4On: html html div class: 'example'; with: [ html text: 'foo' ]! ! !SlimeExample methodsFor: 'as yet unclassified' stamp: 'lr 12/15/2007 20:07'! renderUnnecessaryBlock5On: html html div: [ html render: 'foo' ]! ! !SlimeExample methodsFor: 'as yet unclassified' stamp: 'lr 12/15/2007 20:35'! renderUnnecessaryBlock6On: html html div class: 'example'; with: [ html render: 'foo' ]! ! !SlimeExample methodsFor: 'as yet unclassified' stamp: 'lr 12/15/2007 19:43'! renderUseShortRenderingFormOn: html html div with: [ html div ]! ! !SlimeExample methodsFor: 'as yet unclassified' stamp: 'lr 12/15/2007 22:47'! renderWithHasToBeLastMessageOn: html html div id: 'foo'; with: [ html div ]; class: 'bar'! ! !ParseTreeLintRule class methodsFor: '*slime' stamp: 'lr 12/17/2007 13:28'! extractCallbackCodeToMethod | matcher | matcher := ParseTreeSearcher new. matcher matchesAnyOf: (Slime allCallbackSelectors 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 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! ! !ParseTreeLintRule class methodsFor: '*slime' stamp: 'lr 12/17/2007 13:36'! unnecessaryBlock | matcher | matcher := ParseTreeSearcher new. matcher matchesAnyOf: #( '`html `msg: [ ]' '`html `msg: [ `html text: `@obj ]' '`html `msg: [ `html render: `@obj ]' ) do: [ :node :answer | (answer isNil and: [ Slime isBrushSelector: node selector ]) ifTrue: [ node arguments first ] ]. matcher matchesAnyOf: #( '`html `msg with: [ ]' '`html `msg with: [ `html text: `@obj ]' '`html `msg with: [ `html render: `@obj ]' ) do: [ :node :answer | (answer isNil and: [ Slime isBrushSelector: node receiver selector ]) ifTrue: [ node arguments first ] ]. ^ self new name: 'Unnecessary block'; rationale: 'Sending a block as argument to #with: is only needed when nesting brushes.'; matcher: matcher; yourself! ! !ParseTreeLintRule class methodsFor: '*slime' stamp: 'lr 12/17/2007 13:36'! unnecessaryWith | 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: 'Unnecessary #with:'; rationale: 'Sending #with: is only required if attributes are specified too.'; matcher: matcher; yourself! ! !ParseTreeLintRule class methodsFor: '*slime' stamp: 'lr 12/17/2007 13:35'! 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! ! !SmalllintContext methodsFor: '*slime' stamp: 'lr 12/17/2007 09:55'! 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! ! !BlockLintRule class methodsFor: '*slime' stamp: 'lr 12/17/2007 13:23'! callAnswerWhileRendering | matcher matches | matcher := ParseTreeSearcher new. matcher matchesAnyOf: (Slime allCallAnswerSelectors collect: [ :each | '`receiver' , (ParseTreeLintRule genericPatternForSelector: each) ]) do: [ :node :answer | (node parents noneSatisfy: [ :each | each isBlock and: [ each parent isMessage and: [ Slime isCallbackSelector: each parent selector ] ] ]) ifTrue: [ answer add: node ]. answer ]. ^ self new name: '#call:/#answer: while rendering'; rationale: '#call: and #answer: should only be used from callback code, not within the rendering 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 ] ] ]! ! !BlockLintRule class methodsFor: '*slime' stamp: 'lr 12/17/2007 13:25'! changesStateWhileRendering | matcher matches | matcher := ParseTreeSearcher new. matcher matches: '`var' do: [ :node :answer | (node isWrite and: [ node parents noneSatisfy: [ :each | each isBlock and: [ each parent isMessage and: [ Slime isCallbackSelector: each parent selector ] ] ] ]) 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 ] ] ] ] ] ] ]! ! !RBProgramNode methodsFor: '*slime' stamp: 'lr 12/17/2007 10:02'! parents ^ parent isNil ifTrue: [ OrderedCollection with: self ] ifFalse: [ parent parents addLast: self; yourself ]! ! Slime initialize!