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: 'braceSelectors notPortableSelectors deprecatedSelectors superSelectors notPortableClasses brushSelectors callAnswerSelectors callbackSelectors attributeSelectors'! Slime class instanceVariableNames: 'braceSelectors notPortableSelectors deprecatedSelectors superSelectors notPortableClasses brushSelectors callAnswerSelectors callbackSelectors attributeSelectors'! !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'! callAnswerSelectors ^ callAnswerSelectors! ! !Slime class methodsFor: 'accessing' stamp: 'lr 1/25/2008 23:21'! callbackSelectors ^ callbackSelectors! ! !Slime class methodsFor: 'accessing' stamp: 'lr 12/17/2007 23:04'! deprecatedSelectors ^ deprecatedSelectors! ! !Slime class methodsFor: 'initialization' stamp: 'lr 1/26/2008 09:51'! initialize self initializeAttributeSelectors. self initializeBrushSelectors. self initializeCallbackSelectors. self initializeCallAnswerSelectors. self initializeNotPortableSelectors. self initializeNotPortableClasses. self initializeDeprecatedSelectors. self initializeBraceSelectors. 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:41'! initializeCallAnswerSelectors callAnswerSelectors := #( 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 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 1/25/2008 21:53'! 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 ] ] ] ]. #( new text: renderDeprecatedOn: ) do: [ :each | deprecatedSelectors remove: each ifAbsent: [ ] ]! ! !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 1/25/2008 23:39'! initializeSuperSelectors superSelectors := Dictionary new. superSelectors at: WAComponent name put: #( initialize updateRoot: updateStates: updateUrl: initialRequest: ) asSet; at: WATagBrush name put: #( initialize setParent:canvas: #with: ) asSet! ! !Slime class methodsFor: 'testing' stamp: 'lr 1/25/2008 23:35'! isBrushSelector: aString Symbol hasInterned: aString ifTrue: [:symbol | ^ brushSelectors includes: symbol]. ^ false! ! !Slime class methodsFor: 'testing' stamp: 'lr 1/25/2008 23:21'! isCallbackSelector: aString Symbol hasInterned: aString ifTrue: [:symbol | ^ callbackSelectors includes: symbol]. ^ false! ! !Slime class methodsFor: 'accessing' stamp: 'lr 1/25/2008 21:06'! nonportableSelectors ^ nonportableSelectors! ! !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! ! !BlockLintRule class methodsFor: '*slime-portability' stamp: 'lr 1/26/2008 10:22'! 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 ] ]! ! !BlockLintRule class methodsFor: '*slime-bugs' stamp: 'lr 1/25/2008 23:19'! callAnswerWhileRendering | matcher matches | matcher := ParseTreeSearcher new. matcher matchesAnyOf: (Slime callAnswerSelectors 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-possible bugs' 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 ] ] ] ] ] ] ]! ! !BlockLintRule class methodsFor: '*slime-bugs' stamp: 'lr 1/25/2008 20:30'! 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 ] ]! ! !BlockLintRule class methodsFor: '*slime-portability' stamp: 'lr 1/26/2008 10:52'! 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 ] ]! ! !BlockLintRule class methodsFor: '*slime-bugs' stamp: 'lr 1/26/2008 00:09'! instantiatesComponentWhileRendering | matcher matches | matcher := ParseTreeSearcher new. matcher matches: '`receiver `@message: `@args' do: [ :node :answer | | class | (node receiver isVariable and: [ (class := Smalltalk classNamed: node receiver token name) notNil and: [ class includesBehavior: WAComponent ] ]) ifTrue: [ (node parents noneSatisfy: [ :each | each isBlock and: [ each parent isMessage and: [ Slime isCallbackSelector: each parent selector ] ] ]) 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 ] ] ] ! ! !BlockLintRule class methodsFor: '*slime-possible bugs' stamp: 'lr 1/25/2008 20:50'! 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 ] ] ]! ! !BlockLintRule class methodsFor: '*slime-portability' stamp: 'lr 1/25/2008 21:55'! 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: '{' ] ] ]! ! !BlockLintRule class methodsFor: '*slime-portability' stamp: 'lr 1/25/2008 21:50'! 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: '#[' ] ] ]! ! !BlockLintRule class methodsFor: '*slime-portability' stamp: 'lr 1/25/2008 21: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 class methodsFor: '*slime-miscellaneous' stamp: 'lr 12/17/2007 22:53'! 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! ! !ParseTreeLintRule class methodsFor: '*slime-miscellaneous' stamp: 'lr 1/25/2008 23: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! ! !ParseTreeLintRule class methodsFor: '*slime-possible bugs' stamp: 'lr 1/26/2008 00:06'! fixCallbackTempsMissing | saveSelectors matcher | saveSelectors := #( allSatisfy: anySatisfy: at:ifAbsent: at:ifAbsentPut: at:ifPresent: collect: 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! ! !ParseTreeLintRule class methodsFor: '*slime-portability' stamp: 'lr 2/12/2008 07:58'! 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.'! ! !ParseTreeLintRule class methodsFor: '*slime-miscellaneous' stamp: 'lr 12/17/2007 22:51'! 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! ! !ParseTreeLintRule class methodsFor: '*slime-bugs' stamp: 'lr 2/9/2008 00:21'! 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! ! !ParseTreeLintRule class methodsFor: '*slime-bugs' stamp: 'lr 12/17/2007 13:38'! 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! ! !RBProgramNode methodsFor: '*slime' stamp: 'lr 12/17/2007 10:02'! parents ^ parent isNil ifTrue: [ OrderedCollection with: self ] ifFalse: [ parent parents addLast: self; 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! ! Slime initialize!