Replaced all references to Smalltalk by instvar `environment` in new system browser.
"
Copyright (c) 2007-2010 Jan Vrany, SWING Research Group, Czech Technical University in Prague
Copyright (c) 2009-2010 eXept Software AG
Permission is hereby granted, free of charge, to any person
obtaining a copy of this software and associated documentation
files (the 'Software'), to deal in the Software without
restriction, including without limitation the rights to use,
copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the
Software is furnished to do so, subject to the following
conditions:
The above copyright notice and this permission notice shall be
included in all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND,
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
OTHER DEALINGS IN THE SOFTWARE.
"
"{ Package: 'stx:libtool' }"
"{ NameSpace: Tools }"
BrowserList subclass:#LintRuleList
instanceVariableNames:'listHolder filterHolder modeHolder listSelection listView
initialSelectionHolder'
classVariableNames:''
poolDictionaries:''
category:'Interface-Lint'
!
HierarchicalItem subclass:#ListEntry
instanceVariableNames:'x rule application'
classVariableNames:''
poolDictionaries:''
privateIn:LintRuleList
!
!LintRuleList class methodsFor:'documentation'!
copyright
"
Copyright (c) 2007-2010 Jan Vrany, SWING Research Group, Czech Technical University in Prague
Copyright (c) 2009-2010 eXept Software AG
Permission is hereby granted, free of charge, to any person
obtaining a copy of this software and associated documentation
files (the 'Software'), to deal in the Software without
restriction, including without limitation the rights to use,
copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the
Software is furnished to do so, subject to the following
conditions:
The above copyright notice and this permission notice shall be
included in all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND,
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
OTHER DEALINGS IN THE SOFTWARE.
"
! !
!LintRuleList class methodsFor:'interface specs'!
windowSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:Tools::LintRuleList andSelector:#windowSpec
Tools::LintRuleList new openInterface:#windowSpec
Tools::LintRuleList open
"
<resource: #canvas>
^
#(FullSpec
name: windowSpec
window:
(WindowSpec
label: 'SmallLintRuleList'
name: 'SmallLintRuleList'
min: (Point 10 10)
bounds: (Rectangle 0 0 300 300)
)
component:
(SpecCollection
collection: (
(InputFieldSpec
name: 'RuleFilter'
layout: (LayoutFrame 0 0 0 0 0 1 22 0)
model: filterHolder
immediateAccept: true
acceptOnReturn: true
acceptOnTab: true
acceptOnPointerLeave: true
emptyFieldReplacementText: 'Rule Search'
)
(SelectionInListModelViewSpec
name: 'RuleList'
layout: (LayoutFrame 0 0 23 0 0 1 0 1)
model: listSelection
menu: menuHolder
hasHorizontalScrollBar: true
hasVerticalScrollBar: true
listModel: listHolder
multipleSelectOk: true
useIndex: false
highlightMode: line
postBuildCallback: postBuildList:
)
)
)
)
! !
!LintRuleList class methodsFor:'menu specs'!
menu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::LintRuleList andSelector:#menu
(Menu new fromLiteralArrayEncoding:(Tools::LintRuleList menu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: '-'
isVisible: false
)
(MenuItem
label: 'Inspect'
itemValue: menuInspect
translateLabel: true
)
)
nil
nil
)
! !
!LintRuleList class methodsFor:'plugIn spec'!
aspectSelectors
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this. If it is corrupted,
the UIPainter may not be able to read the specification."
"Return a description of exported aspects;
these can be connected to aspects of an embedding application
(if this app is embedded in a subCanvas)."
^ #(
#inGeneratorHolder
#modeHolder
#outGeneratorHolder
#selectionHolder
#listSelection
).
"Modified: / 05-08-2011 / 00:09:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 01-03-2012 / 10:48:43 / cg"
! !
!LintRuleList methodsFor:'accessing'!
mode
^self modeHolder value
"Created: / 25-08-2010 / 11:33:51 / Jan Vrany <enter your email here>"
!
selection
| sel |
sel := self selectionHolder value.
sel ifNil:[sel := Set new].
^sel
"Created: / 25-08-2010 / 13:26:58 / Jan Vrany <enter your email here>"
!
selection: aCollectionOrNil
| sel |
sel := aCollectionOrNil
ifNil:[Set new]
ifNotNil:[aCollectionOrNil asSet].
self selectionHolder value: sel
"Created: / 25-08-2010 / 13:28:43 / Jan Vrany <enter your email here>"
"Modified: / 25-08-2010 / 15:29:35 / Jan Vrany <enter your email here>"
!
showCheckbox
"return the value in 'showCheckboxHolder'"
^ self modeHolder value == #select
"Modified: / 15-04-2010 / 20:56:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!LintRuleList methodsFor:'aspects'!
filterHolder
"return/create the 'filterHolder' value holder (automatically generated)"
filterHolder isNil ifTrue:[
filterHolder := ValueHolder new.
filterHolder addDependent:self.
].
^ filterHolder
!
filterHolder:something
"set the 'filterHolder' value holder (automatically generated)"
|oldValue newValue|
filterHolder notNil ifTrue:[
oldValue := filterHolder value.
filterHolder removeDependent:self.
].
filterHolder := something.
filterHolder notNil ifTrue:[
filterHolder addDependent:self.
].
newValue := filterHolder value.
oldValue ~~ newValue ifTrue:[
self update:#value with:newValue from:filterHolder.
].
!
listHolder
"return/create the 'ruleList' value holder (automatically generated)"
listHolder isNil ifTrue:[
listHolder := ValueHolder new.
].
^ listHolder
!
listSelection
"return/create the 'listSelection' value holder (automatically generated)"
listSelection isNil ifTrue:[
listSelection := ValueHolder new.
listSelection addDependent:self.
].
^ listSelection
!
listSelection:something
"set the 'listSelection' value holder (automatically generated)"
|oldValue newValue|
listSelection notNil ifTrue:[
oldValue := listSelection value.
listSelection removeDependent:self.
].
listSelection := something.
listSelection notNil ifTrue:[
listSelection addDependent:self.
].
newValue := listSelection value.
oldValue ~~ newValue ifTrue:[
self update:#value with:newValue from:listSelection.
].
!
modeHolder
modeHolder ifNil:
[modeHolder := ValueHolder with: #display].
^modeHolder
"Modified: / 15-04-2010 / 20:56:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
modeHolder:aValueModel
modeHolder := aValueModel.
!
selectedLintRules
^ self selectionHolder
"Created: / 02-02-2010 / 20:43:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
selectedLintRules: anObject
^ self selectionHolder: anObject
"Created: / 02-02-2010 / 20:43:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!LintRuleList methodsFor:'change & update'!
delayedUpdate:something with:aParameter from:changedObject
"Invoked when an object that I depend upon sends a change notification."
changedObject == filterHolder ifTrue:[
self updateList.
^ self.
].
(changedObject == listSelection) ifTrue:[
listValid ifFalse:[
self updateList.
].
^ self selectionChanged
].
(changedObject == selectionHolder) ifTrue:[
^self.
].
super delayedUpdate:something with:aParameter from:changedObject
"Created: / 26-08-2010 / 11:43:33 / Jan Vrany <enter your email here>"
"Modified: / 05-08-2011 / 00:17:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
selectionChanged
| selection |
super selectionChanged.
selection := self listSelection value.
selection isEmptyOrNil ifTrue:[
self selectionHolder value: selection
] ifFalse:[
self selectionHolder value: (selection collect:[:entry|entry rule])
]
"Created: / 05-08-2011 / 00:10:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!LintRuleList methodsFor:'event processing'!
buttonPress:button x:x y:y view:aView
| itemIndex item |
button ~= 1 ifTrue:[^aView buttonPress:button x:x y:y].
self modeHolder value == #display ifTrue:[^aView buttonPress:button x:x y:y].
itemIndex := aView yVisibleToLineNr:y.
itemIndex ifNil:[^self].
itemIndex == 0 ifTrue:[^self].
itemIndex > aView list size ifTrue:[^self].
item := aView list at: itemIndex.
((aView left + x) between: (item x) and: (item x + 16))
ifFalse:[^aView buttonPress:button x:x y:y].
item checked: item checked not.
aView invalidate
"Created: / 08-12-2009 / 14:12:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 15-04-2010 / 21:05:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
handlesButtonPress:button inView:aView
^listView == aView
"Created: / 08-12-2009 / 14:08:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 15-04-2010 / 20:19:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!LintRuleList methodsFor:'generators'!
makeGenerator
^self modeHolder value == #display
ifTrue:
[Iterator on:
[:whatToDo|
self listSelection value ? #() do:
[:each|each failedClasses do:whatToDo]]]
ifFalse:
[Iterator on:
[:whatToDo|
self selection do:[:rule| whatToDo value: rule]]].
"Modified: / 16-04-2010 / 12:13:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 25-08-2010 / 13:39:51 / Jan Vrany <enter your email here>"
! !
!LintRuleList methodsFor:'hooks'!
commonPostOpen
super commonPostOpen.
self updateOutputGenerator.
"Created: / 16-04-2010 / 11:53:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
postBuildList: aView
listView := aView scrolledView.
listView delegate: self.
"Created: / 08-12-2009 / 14:10:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!LintRuleList methodsFor:'initialization'!
initialize
super initialize.
menuHolder := ValueHolder with: (Menu decodeFromLiteralArray: (self menuFor: #menu)).
self selection: Set new.
"Modified: / 25-08-2010 / 15:24:45 / Jan Vrany <enter your email here>"
! !
!LintRuleList methodsFor:'menu actions'!
menuInspect
| selection |
selection := self listSelection value.
selection size = 1 ifTrue:[selection anyOne rule inspect].
selection size > 1 ifTrue:[(selection collect:[:e|e rule]) inspect].
"Modified: / 25-08-2010 / 14:25:24 / Jan Vrany <enter your email here>"
! !
!LintRuleList methodsFor:'private'!
listEntryFor: anRBLintRule
| entry |
entry := ListEntry new
rule: anRBLintRule;
application: self;
expand;
yourself.
^entry
"Created: / 15-04-2010 / 18:59:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 25-08-2010 / 14:15:46 / Jan Vrany <enter your email here>"
!
makeDependent
"nothing to do"
"Created: / 02-02-2010 / 20:23:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
makeIndependent
"nothing to do"
"Created: / 02-02-2010 / 20:23:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
rules: rules includes: rule
^rules contains:
[:each|
each class == rule class and:
[each name = rule name]]
"Created: / 26-08-2010 / 12:04:04 / Jan Vrany <enter your email here>"
!
updateList
|generator filterS newList|
generator := self inGeneratorHolder value.
filterS := self filterHolder value.
filterS notEmptyOrNil ifTrue:[
(filterS startsWith: $*) ifFalse:[filterS := '*' , filterS].
(filterS endsWith: $*) ifFalse:[filterS := filterS , '*']
].
(generator isNil and:[self mode == #display]) ifTrue:[
generator := RBCompositeLintRule allRules flattened
].
newList := OrderedCollection new.
generator do:[:rule |
rule flattened do: [:rule|
(filterS isEmptyOrNil or:[rule name matches: filterS])
ifTrue:[
newList add: (self listEntryFor:rule)
]
]
].
newList sort:[:a :b | a name < b name].
self listHolder value:newList.
listValid := true.
"Modified: / 22-07-2009 / 15:58:39 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 16-04-2010 / 11:38:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 25-08-2010 / 13:35:58 / Jan Vrany <enter your email here>"
"Modified: / 07-03-2012 / 18:06:50 / cg"
! !
!LintRuleList methodsFor:'queries'!
supportsSearch
^false
"Created: / 04-08-2011 / 23:04:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!LintRuleList methodsFor:'selection'!
selectionAdd: rule
self selection:
(self selection addAll: rule flattened; yourself)
"Created: / 25-08-2010 / 13:34:57 / Jan Vrany <enter your email here>"
!
selectionIncludes: rule
^self rules: self selection includes: rule
"Created: / 25-08-2010 / 13:30:14 / Jan Vrany <enter your email here>"
"Modified: / 26-08-2010 / 12:04:19 / Jan Vrany <enter your email here>"
!
selectionRemove: rule
| sel rules |
sel := self selection.
rules := rule flattened.
sel := sel reject:
[:each|self rules: rules includes: each].
self selection: sel
"Created: / 25-08-2010 / 13:35:08 / Jan Vrany <enter your email here>"
"Modified: / 26-08-2010 / 12:05:06 / Jan Vrany <enter your email here>"
! !
!LintRuleList::ListEntry class methodsFor:'instance creation'!
change: aChange
^self new change: aChange
"Created: / 24-07-2009 / 22:43:41 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
change: aChange application: anApplicationModel
^self new change: aChange; application: anApplicationModel
"Created: / 05-12-2009 / 14:16:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
change: aChange parent: aChangeList
^self new change: aChange; parent: aChangeList
"Created: / 25-07-2009 / 23:33:00 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!LintRuleList::ListEntry methodsFor:'accessing'!
application
^ application ifNil:[super application]
"Modified: / 15-04-2010 / 19:09:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
application:anApplicationModel
application := anApplicationModel.
!
checked
^rule isComposite
ifTrue:[self children anySatisfy:[:each|each checked]]
ifFalse:[self application selectionIncludes: rule]
"Modified: / 15-04-2010 / 20:59:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 25-08-2010 / 13:29:33 / Jan Vrany <enter your email here>"
!
checked:aBoolean
| app |
app := self application.
aBoolean
ifTrue: [app selectionAdd: rule]
ifFalse:[app selectionRemove: rule]
"Modified: / 15-04-2010 / 19:06:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 25-08-2010 / 13:35:29 / Jan Vrany <enter your email here>"
!
checkedRule
self checked ifFalse:[^nil].
rule isComposite
ifTrue:
[^rule copy
rules: (self children
collect:[:entry|entry checkedRule]
thenReject:[:rule|rule isNil]);
yourself]
ifFalse:
[^rule]
"Created: / 16-04-2010 / 12:06:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
children
children ifNil:
[| app |
rule isComposite
ifTrue:
[app := self application.
children := rule rules collect:[:rule | (app listEntryFor:rule) parent:self]]
ifFalse:
[children := #()]].
^ children
"Created: / 25-07-2009 / 23:32:39 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 15-04-2010 / 20:40:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
failedClasses
^rule failedClasses
"Created: / 15-04-2010 / 19:10:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
failedMethods
^rule failedMethods
"Created: / 15-04-2010 / 19:10:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
failedMethodsInAnyOf: classes meta: meta
^rule failedMethodsInAnyOf: classes meta: meta
"Created: / 15-04-2010 / 19:11:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
label
^rule displayString.
"Modified: / 15-04-2010 / 18:44:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
name
^rule name
"Created: / 15-04-2010 / 19:12:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
rationale
^ rule rationaleWithAnchor
"Created: / 15-04-2010 / 19:10:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 01-03-2012 / 20:58:50 / cg"
!
rationaleWithAnchor
^ rule rationaleWithAnchor
"Created: / 15-04-2010 / 19:10:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 01-03-2012 / 20:58:50 / cg"
"Created: / 02-03-2012 / 01:04:40 / cg"
!
rule
^ rule
!
rule:anRBLintRule
rule := anRBLintRule.
!
x
^ x ? 0
"Modified: / 15-04-2010 / 20:48:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!LintRuleList::ListEntry methodsFor:'displaying'!
displayLabel:aLabel h:lH on:aGC x:newX y:y h:h
| cx icon app |
cx := x := newX.
(app := self application) showCheckbox ifTrue:[
icon := self checked
ifTrue:[app class checkedIcon]
ifFalse:[app class uncheckedIcon].
icon displayOn: aGC x: cx y: y + (h / 2) - (icon height / 2).
cx := cx + 22."experimental value - this looks good"
].
super displayLabel:aLabel h:lH on:aGC x:cx y:y h:h
"Modified: / 15-04-2010 / 20:14:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified (format): / 07-03-2012 / 20:08:02 / cg"
!
displayOn:aGCOrStream
"/ what a kludge - Dolphin and Squeak mean: printOn: a stream;
"/ ST/X (and some old ST80's) mean: draw-yourself on a GC.
(aGCOrStream isStream) ifFalse:[
^ super displayOn:aGCOrStream
].
rule diplayOn:aGCOrStream
"Created: / 15-04-2010 / 19:13:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!LintRuleList class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libtool/Tools__LintRuleList.st,v 1.14 2013-08-19 16:01:13 stefan Exp $'
!
version_CVS
^ '$Header: /cvs/stx/stx/libtool/Tools__LintRuleList.st,v 1.14 2013-08-19 16:01:13 stefan Exp $'
!
version_SVN
^ '$Id: Tools__LintRuleList.st,v 1.14 2013-08-19 16:01:13 stefan Exp $'
! !