initial checkin
authorClaus Gittinger <cg@exept.de>
Fri, 01 Jul 2011 15:31:24 +0200
changeset 10000 8ed849da9927
parent 9999 34dc468e5d27
child 10001 f6cf395b6933
initial checkin
Tools__LintRuleList.st
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Tools__LintRuleList.st	Fri Jul 01 15:31:24 2011 +0200
@@ -0,0 +1,684 @@
+"
+ COPYRIGHT (c) 2006 by eXept Software AG
+	      All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice.   This software may not
+ be provided or otherwise made available to, or used by, any
+ other person.  No title to or ownership of the software is
+ hereby transferred.
+"
+"{ 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) 2006 by eXept Software AG
+	      All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice.   This software may not
+ be provided or otherwise made available to, or used by, any
+ other person.  No title to or ownership of the software is
+ hereby transferred.
+"
+! !
+
+!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::SmalllintRuleList andSelector:#menu
+     (Menu new fromLiteralArrayEncoding:(Tools::SmalllintRuleList menu)) startUp
+    "
+
+    <resource: #menu>
+
+    ^ 
+     #(Menu
+        (
+         (MenuItem
+            label: '-'
+          )
+         (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
+        #listSelection
+        #modeHolder
+        #outGeneratorHolder
+        #selectionHolder
+      ).
+
+! !
+
+!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
+    ].
+
+    super delayedUpdate:something with:aParameter from:changedObject
+
+    "Created: / 26-08-2010 / 11:43:33 / Jan Vrany <enter your email here>"
+! !
+
+!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
+
+    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 isNilOrEmptyCollection ifFalse:
+        [(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 isNilOrEmptyCollection 
+                or:[rule name matches: filterS])
+                ifTrue:
+                    [newList add: (self listEntryFor:rule)]]].
+    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>"
+! !
+
+!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 rationale
+
+    "Created: / 15-04-2010 / 19:10:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+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>"
+!
+
+displayString
+
+    ^rule displayString
+
+    "Created: / 15-04-2010 / 19:13:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!LintRuleList class methodsFor:'documentation'!
+
+version_CVS
+    ^ '$Header: /cvs/stx/stx/libtool/Tools__LintRuleList.st,v 1.1 2011-07-01 13:31:24 cg Exp $'
+!
+
+version_SVN
+    ^ '§Id: Tools__LintRuleList.st 7619 2010-08-26 10:15:15Z vranyj1 §'
+! !