Added AbstractTestCase which saves/restores preferences in setUp/tearDown...
...so tests are not dependent on current settings. Required for some UI tests
"{ Package: 'stx:goodies/smallsense' }"!
!AssignmentNode methodsFor:'enumeration'!
childNamesAndValuesDo:aBlock
aBlock value: #variable value: variable.
aBlock value: #expression value: expression.
"Modified: / 26-11-2011 / 10:39:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!AssignmentNode methodsFor:'accessing-SmallSense'!
inferedType
^ expression inferedType
"Created: / 26-11-2011 / 12:38:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!AssignmentNode methodsFor:'accessing-SmallSense'!
inferedType: aSmallSenseType
^ self shouldNotImplement
"Created: / 26-11-2011 / 12:37:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!BlockNode methodsFor:'enumeration'!
childNamesAndValuesDo:aBlock
"Enumerates all direct children and evaluates a block
with its name (usually instVar name) and the node itself"
aBlock value:'statements' value: statements
"Created: / 20-09-2013 / 01:03:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ConfigurableFeatures class methodsFor:'queries-features'!
hasSmallSenseEnabled
^UserPreferences current smallSenseEnabled
"
ConfigurableFeatures hasSmallSenseEnabled
ConfigurableFeatures includesFeature:'SmallSenseEnabled'
"
"Created: / 27-11-2011 / 17:22:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!CustomTestCaseSetUpCodeGenerator methodsFor:'executing'!
buildForClass: class
| source category superHasSetup current |
current := class.
superHasSetup := false.
[ superHasSetup not and:[ current isNil not and:[current name ~~ #TestCase]] ] whileTrue:[
superHasSetup := current includesSelector: #setUp.
current := current superclass.
].
(superHasSetup and:[ current name ~~ #TestCase ]) ifTrue:[
source := 'setUp
super setUp.
"Add your own code here..."
'.
category := (current compiledMethodAt: #setUp) category.
] ifFalse:[
source := 'setUp
"Add your own code here..."
'.
category := (TestCase compiledMethodAt: #setUp) category.
].
builder createMethod
class: class;
source: source;
category: category.
"Created: / 05-08-2014 / 14:17:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 11-08-2014 / 14:20:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!DoWhatIMeanSupport methodsFor:'code completion - smallsense'!
smallSenseCodeCompletionForClass: classOrNilArg context: contextOrNil codeView: codeViewArg
<swizzle: #codeCompletionForClass:context:codeView:>
"SmallSense version of #codeCompletionForClass:context:codeView:.
When SmallSense is loaded, this method is swizzled as #codeCompletionForClass:context:codeView:.
into DoWhatIMeanSupport."
| p node text items mode |
codeView := codeViewArg.
"/ The respondsTo: hack is because CVS CodeView2 has no #mode method.
mode := (codeView respondsTo: #mode) ifTrue: [
codeView mode
] ifFalse: [ #method ].
contextOrNil notNil ifTrue: [
mode := #method.
].
items := SmallSense::SmalltalkCompletion
resultSetFor: mode
source: codeView contents
class: classOrNilArg
line: codeView cursorLine
column: codeView cursorCol.
items notEmptyOrNil ifTrue: [
(p := items position) notNil ifTrue: [
node := p node.
node notNil ifTrue: [
(node isVariable and: [ p isInNode ]) ifTrue: [
text := node name
] ifFalse: [
node isMessage ifTrue: [
text := node selector
]
].
].
].
].
SmallSense::CompletionWindow
openForView: codeView
text: text
items: items.
"Created: / 19-08-2013 / 15:01:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 02-09-2013 / 12:52:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!EditTextView methodsFor:'accessing-behavior'!
autoIndent
^ autoIndent
! !
!HTMLDocumentView methodsFor:'actions'!
doQuickFix: quickFixNo
| app |
app := self application.
app notNil ifTrue:[
app doQuickFix: quickFixNo
].
"Created: / 16-02-2012 / 14:18:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!MessageNode methodsFor:'enumeration'!
childNamesAndValuesDo:aBlock
aBlock value: #receiver value: receiver.
argArray notNil ifTrue:[
argArray withIndexDo:[:node :idx|
aBlock value: 'arg[' , idx printString , ']' value: node
]
]
"Modified: / 26-11-2011 / 12:10:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!MessageNode methodsFor:'navigation-SmallSense'!
navigateToUsing: navigator
navigator navigateToMessageNode: self.
"Created: / 24-09-2013 / 10:04:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Method methodsFor:'inspecting'!
inspector2TabParseTreeInspector
^ (self newInspector2Tab)
label:'Parse Tree';
priority:35;
application:
[
| src parser |
src := self source.
parser := self parserClass parseMethod: src.
SmallSense::ParseTreeInspector new node:parser tree source:src.
];
yourself
"Created: / 09-04-2014 / 09:31:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 10-04-2014 / 08:58:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Method methodsFor:'inspecting'!
inspector2Tabs
^ super inspector2Tabs , #(inspector2TabParseTreeInspector)
"Created: / 09-04-2014 / 09:32:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 10-04-2014 / 08:47:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ParseErrorNode methodsFor:'enumeration'!
childNamesAndValuesDo:aBlock
"superclass ParseNode says that I am responsible to implement this method"
^ children withIndexDo:[:child :index |
aBlock value:'child[' , index printString , ']' value: child
]
"Modified: / 20-09-2013 / 01:00:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ParseNode methodsFor:'enumeration'!
childNamesAndValuesDo:aBlock
"Enumerates all direct children and evaluates a block
with its name (usually instVar name) and the node itself"
self class allInstVarNames withIndexDo:[:n :i|
| v |
v := self instVarAt: i.
(v isKindOf: ParseNode) ifTrue:[
aBlock value: n value: v
] ifFalse:[
(v isSequenceable) ifTrue:[
v withIndexDo:[ :v2 :i2|
(v2 isKindOf: ParseNode) ifTrue:[
aBlock value: (n, '[' , i2 printString , ']') value: v2.
]
]
]
]
]
"Created: / 26-11-2011 / 10:38:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 19-09-2013 / 18:18:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ParseNode methodsFor:'accessing-SmallSense'!
inferedType
| t |
t := self objectAttributeAt:#inferedType.
t isNil ifTrue:[t := SmallSense::Type unknown].
^t
"Created: / 26-11-2011 / 12:38:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 24-08-2013 / 20:46:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ParseNode methodsFor:'accessing-SmallSense'!
inferedType: aSmallSenseType
^ self objectAttributeAt:#inferedType put: aSmallSenseType
"Created: / 26-11-2011 / 12:37:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ParseNode methodsFor:'testing'!
isSelector
"return true, if this is a node for an selctors"
^ false
"Created: / 22-02-2011 / 21:44:45 / Jakub <zelenja7@fel.cvut.cz>"
! !
!ParseNode methodsFor:'navigation-SmallSense'!
navigateToUsing:navigator
"Nothing by default, to overwritten by subclasses"
"Modified: / 24-09-2013 / 10:05:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!PrimaryNode methodsFor:'enumeration'!
childNamesAndValuesDo:aBlock
"Initionally left blank, primary nodes have no children"
"Modified: / 26-11-2011 / 11:49:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!PrimitiveNode methodsFor:'accessing-SmallSense'!
inferedType
^ SmallSense::Type withClass: UndefinedObject "/ Not really true, should be 'void'
"Created: / 08-12-2013 / 22:25:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!RBLintRule methodsFor:'accessing'!
fixes: aSmallSenseQuickFixer
"Adds all possible code fixes to given quick fixer.
Default is to do nothing, meaning that there are
no quickfixes available"
"Created: / 01-02-2012 / 12:09:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!RBTransformationRule methodsFor:'accessing'!
fixes: fixer
| changes |
changes := self changes.
changes notEmptyOrNil ifTrue:[
fixer fix
label:'Rewrite the code';
action: [ fixer apply:
((ChangeSet withAll:self changes) name: self name)
].
]
"Created: / 01-02-2012 / 12:11:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ReturnNode methodsFor:'enumeration'!
childNamesAndValuesDo:aBlock
aBlock value: 'expression' value: expression.
"Created: / 10-04-2014 / 08:15:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!StatementNode methodsFor:'enumeration'!
childNamesAndValuesDo:aBlock
| stmt index |
stmt := self.
index := 1.
[ stmt notNil ] whileTrue:[
| expr |
stmt isReturnNode ifTrue:[
expr := stmt.
] ifFalse:[
expr := stmt expression.
].
aBlock value: ('statement[%1]' bindWith: index) value: expr.
stmt := stmt nextStatement.
index := index + 1.
]
"Modified: / 10-04-2014 / 08:13:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!StatementNode methodsFor:'accessing-SmallSense'!
inferedType
^ expression inferedType
"Created: / 26-11-2011 / 12:38:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!StatementNode methodsFor:'accessing-SmallSense'!
inferedType: aSmallSenseType
^ self shouldNotImplement
"Created: / 26-11-2011 / 12:37:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Tools::CodeCompletionService class methodsFor:'testing'!
smallSenseIsUsefulFor:aCodeView
"No old completion once there's SmallSense :-)"
<swizzle: #isUsefulFor:>
^ false.
"Created: / 02-09-2013 / 12:58:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Tools::CodeHighlightingService class methodsFor:'instance creation'!
new
"return an initialized instance"
^ (SmallSense::CodeHighlightingService ? self) basicNew initialize.
"Created: / 27-07-2013 / 22:47:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 23-09-2013 / 14:32:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Tools::CodeNavigationService class methodsFor:'instance creation'!
new
"return an initialized instance"
^ (SmallSense::CodeNavigationService ? self) basicNew initialize.
"Created: / 27-07-2013 / 22:47:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 23-09-2013 / 14:32:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Tools::NavigationState methodsFor:'aspects - SmallSense'!
smallSenseSelectedClasses
<swizzle: #selectedClasses>
selectedClasses isNil ifTrue:[
selectedClasses := "SpecialValueHolder with:nil." nil asValue.
(ConfigurableFeatures includesFeature:'SmallSenseEnabled') ifTrue:[
selectedClasses onChangeEvaluate:[
selectedClasses value ? #() do:[:cls|
(Smalltalk at:#SmallSense::Manager) instance updateInfoForClass: cls.
].
]
]
].
^ selectedClasses
"Created: / 24-08-2013 / 21:53:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Tools::NewSystemBrowser methodsFor:'private-searching-smallsense'!
searchCompletionBlock_SmallSense
"This returns a class/selector name completion block that uses
standard DoWhatIMeanSupport"
^ [:patternString | self smallSenseSearchCompletion:patternString ]
"Created: / 25-11-2013 / 12:27:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Tools::NewSystemBrowser methodsFor:'private-searching-smallsense'!
smallSenseSearchCompletion:patternString
"/sorry, no method search yet"
^ self smallSenseSearchCompletionNewForClass:patternString
"Modified: / 04-08-2011 / 19:05:28 / cg"
"Created: / 04-12-2011 / 22:22:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Tools::NewSystemBrowser methodsFor:'private-searching-smallsense'!
smallSenseSearchCompletionBlock
"This returns a class/selector name completion block that uses
standard DoWhatIMeanSupport"
^ [:patternString | self smallSenseSearchCompletion:patternString ]
"Modified: / 04-08-2011 / 19:05:28 / cg"
"Created: / 04-12-2011 / 22:13:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Tools::NewSystemBrowser methodsFor:'private-searching-smallsense'!
smallSenseSearchCompletionEntryForClass:aClass showPrefix:showPrefix
^ (SmallSense::ClassPO new)
klass:aClass;
showPrefix:showPrefix.
"Created: / 06-04-2012 / 12:55:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 25-11-2013 / 12:16:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Tools::NewSystemBrowser methodsFor:'private-searching-smallsense'!
smallSenseSearchCompletionNewForClass:patternString
| env pattern matcher matches relax withPrefix |
patternString isEmptyOrNil ifTrue:[
^ #( '' #() )
].
env := self theSingleSelectedNamespace ? #Smalltalk.
env = NavigatorModel nameListEntryForALL ifTrue:[
env := #Smalltalk
].
env := Smalltalk at:env.
withPrefix := patternString includes:$:.
pattern := StringPattern readFrom:patternString onError:[ ^ #( '' #() ) ].
withPrefix ifTrue:[
matcher := [:cls | pattern match:cls name ]
] ifFalse:[
matcher := [:cls | pattern match:cls nameWithoutPrefix ]
].
relax := 1.
[
matches isEmptyOrNil and:[ relax <= 3 ]
] whileTrue:[
matches := OrderedCollection new.
env
keysDo:[:nm |
| cls |
cls := env at:nm.
(cls notNil and:[ cls isBehavior and:[ (matches includesIdentical:cls) not ] ])
ifTrue:[
"cls isJavaClass"false ifTrue:[
cls isAnonymous ifFalse:[
(matcher value:cls) ifTrue:[
matches add:cls
].
].
] ifFalse:[
(matcher value:cls) ifTrue:[
matches add:cls
].
]
].
].
relax := relax + 1.
].
matches isEmpty ifTrue:[
^ #( nil #() )
] ifFalse:[
matches := matches
collect:[:cls |
self smallSenseSearchCompletionEntryForClass:cls showPrefix:withPrefix
].
^ {
matches first.
matches
}
]
"Created: / 06-04-2012 / 12:56:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 07-08-2014 / 13:10:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!UserPreferences methodsFor:'accessing-SmallSense'!
smallSenseBackgroundLintEnabled
"Return true if SmallSense background source checking is enabled"
^self at:#smallSenseBackgroundLintEnabled ifAbsent:[false]
"Created: / 30-01-2012 / 19:59:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!UserPreferences methodsFor:'accessing-SmallSense'!
smallSenseBackgroundLintEnabled: aBoolean
"Return true if SmallSense background source checking is enabled"
^self at:#smallSenseBackgroundLintEnabled put: aBoolean
"
UserPreferences current smallSenseBackgroundLintEnabled
UserPreferences current smallSenseBackgroundLintEnabled: true
UserPreferences current smallSenseBackgroundLintEnabled: false
"
"Created: / 30-01-2012 / 20:00:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!UserPreferences methodsFor:'accessing-SmallSense'!
smallSenseBackgroundTypingEnabled
"Return true if SmallSense background source checking is enabled"
^self at:#smallSenseBackgroundTypingEnabled ifAbsent:[false]
"Created: / 04-02-2012 / 21:41:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!UserPreferences methodsFor:'accessing-SmallSense'!
smallSenseBackgroundTypingEnabled: aBoolean
"Return true if SmallSense background source checking is enabled"
^self at:#smallSenseBackgroundTypingEnabled put: aBoolean
"
UserPreferences current smallSenseBackgroundTypingEnabled
UserPreferences current smallSenseBackgroundTypingEnabled: true
UserPreferences current smallSenseBackgroundTypingEnabled: false
"
"Created: / 04-02-2012 / 21:41:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!UserPreferences methodsFor:'accessing-SmallSense'!
smallSenseCompleteIfUnambiguous
^self at:#smallSenseCompleteIfUnambiguous ifAbsent:[false]
"Created: / 18-01-2014 / 23:08:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!UserPreferences methodsFor:'accessing-SmallSense'!
smallSenseCompleteIfUnambiguous: aBoolean
^self at:#smallSenseCompleteIfUnambiguous put: aBoolean.
"
UserPreferences current smallSenseCompleteIfUnambiguous
UserPreferences current smallSenseCompleteIfUnambiguous: true.
UserPreferences current smallSenseCompleteIfUnambiguous: false.
"
"Created: / 18-01-2014 / 23:08:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!UserPreferences methodsFor:'accessing-SmallSense'!
smallSenseCompletionEnabled
^self at:#smallSenseCompletionEnabled ifAbsent:[self smallSenseEnabled]
"Created: / 27-02-2014 / 09:29:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!UserPreferences methodsFor:'accessing-SmallSense'!
smallSenseCompletionEnabled: aBoolean
^self at:#smallSenseCompletionEnabled put: aBoolean
"Created: / 27-02-2014 / 09:29:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!UserPreferences methodsFor:'accessing-SmallSense'!
smallSenseEnabled
"Return true if SmallSense is enabled"
^self at:#smallSenseEnabled ifAbsent:[false]
"Created: / 27-11-2011 / 17:20:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!UserPreferences methodsFor:'accessing-SmallSense'!
smallSenseEnabled: aBoolean
"enable/disable SmallSense"
^self at:#smallSenseEnabled put: aBoolean.
"
UserPreferences current smallSenseEnabled.
UserPreferences current smallSenseEnabled: true.
UserPreferences current smallSenseEnabled: false.
"
"Created: / 02-04-2012 / 11:37:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!UserPreferences methodsFor:'accessing-SmallSense-Smalltalk'!
smallSenseSmalltalkIndentOnPasteEnabled
"Return true if SmallSense indent-on-paste is enabled for Smalltalk language"
^self at:#smallSenseSmalltalkIndentOnPasteEnabled ifAbsent:[false]
"Created: / 19-07-2014 / 00:11:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!UserPreferences methodsFor:'accessing-SmallSense-Smalltalk'!
smallSenseSmalltalkIndentOnPasteEnabled: aBoolean
"Set SmallSense indent-on-paste feature for Smalltalk"
^ self at:#smallSenseSmalltalkIndentOnPasteEnabled put: aBoolean
"
UserPreferences current smallSenseSmalltalkIndentOnPasteEnabled
UserPreferences current smallSenseSmalltalkIndentOnPasteEnabled: true.
UserPreferences current smallSenseSmalltalkIndentOnPasteEnabled: false.
"
"Created: / 19-07-2014 / 00:11:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!VariableNode methodsFor:'queries'!
isGlobalOrPrivateClass
^ type == #GlobalVariable or:[type == #PrivateClass]
"Created: / 27-11-2011 / 16:31:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!VariableNode methodsFor:'navigation-SmallSense'!
navigateToUsing: navigator
navigator navigateToVariableNode: self.
"Created: / 24-09-2013 / 10:04:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Workspace class methodsFor:'defaults - smallsense'!
smallSenseCodeCompletionServiceClass
<swizzle: #codeCompletionServiceClass>
^ SmallSense::CodeCompletionService
"Created: / 24-09-2013 / 00:29:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!stx_goodies_smallsense class methodsFor:'documentation'!
extensionsVersion_HG
^ '$Changeset: <not expanded> $'
! !