"

stx:goodies/smallsense - A productivity plugin for Smalltalk/X IDE

Copyright (C) 2013-2014 Jan Vrany

This library is free software; you can redistribute it and/or

modify it under the terms of the GNU Lesser General Public

License as published by the Free Software Foundation; either

version 2.1 of the License. 

This library is distributed in the hope that it will be useful,

but WITHOUT ANY WARRANTY; without even the implied warranty of

MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU

Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public

License along with this library; if not, write to the Free Software

Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA

"

"{ Package: 'stx:goodies/smallsense' }"

"{ NameSpace: SmallSense }"

SimpleDialog subclass:#CriticsWindow

	instanceVariableNames:'ruleHolder ruleRationaleAndFixesHTMLHolder rationalView fixer

		entered codeView closeOnLeave'

	classVariableNames:''

	poolDictionaries:''

	category:'SmallSense-Core-Interface'

!

!CriticsWindow class methodsFor:'documentation'!

copyright

"

stx:goodies/smallsense - A productivity plugin for Smalltalk/X IDE

Copyright (C) 2013-2014 Jan Vrany

This library is free software; you can redistribute it and/or

modify it under the terms of the GNU Lesser General Public

License as published by the Free Software Foundation; either

version 2.1 of the License. 

This library is distributed in the hope that it will be useful,

but WITHOUT ANY WARRANTY; without even the implied warranty of

MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU

Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public

License along with this library; if not, write to the Free Software

Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA

"

! !

!CriticsWindow class methodsFor:'help specs'!

flyByHelpSpec

    "This resource specification was automatically generated

     by the UIHelpTool of ST/X."

    "Do not manually edit this!! If it is corrupted,

     the UIHelpTool may not be able to read the specification."

    "

     UIHelpTool openOnClass:SmallSense::CriticsWindow

    "

    ^ super flyByHelpSpec addPairsFrom:#(

#applyRuleIn

'Apply this rule on more code.'

#disableRule

'Disable this rule in the future\(for the rest of this session, unless you save the ruleset)'

#browseRule

'Open a browser on the rule'

)

! !

!CriticsWindow 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:SmallSense::CriticsWindow andSelector:#windowSpec

     SmallSense::CriticsWindow new openInterface:#windowSpec

     SmallSense::CriticsWindow open

    "

    <resource: #canvas>

    ^ 

    #(FullSpec

       name: windowSpec

       window: 

      (WindowSpec

         label: 'SmalllintRuleDetail'

         name: 'SmalllintRuleDetail'

         min: (Point 10 10)

         bounds: (Rectangle 0 0 563 384)

         backgroundColor: (Color 100.0 100.0 75.0)

         forceRecursiveBackgroundOfDefaultBackground: true

       )

       component: 

      (SpecCollection

         collection: (

          (ActionButtonSpec

             label: 'closeIcon'

             name: 'Button4'

             layout: (AlignmentOrigin 0 1 0 0 1 0)

             visibilityChannel: notCloseOnLeave

             hasCharacterOrientedLabel: false

             translateLabel: true

             model: closeRequest

           )

          (HTMLViewSpec

             name: 'Rationale'

             layout: (LayoutFrame 0 0 20 0 0 1 -65 1)

             level: 0

             visibilityChannel: rationaleVisibleHolder

             hasHorizontalScrollBar: true

             hasVerticalScrollBar: true

             miniScrollerHorizontal: true

             miniScrollerVertical: true

             htmlText: ruleRationaleAndFixesHTMLHolder

             postBuildCallback: setupHTMLView:

           )

          (LinkButtonSpec

             label: 'Disable this Rule'

             name: 'Button3'

             layout: (LayoutFrame -1 0 -59 1 -16 1 -30 1)

             activeHelpKey: disableRule

             level: 0

             translateLabel: true

             labelChannel: disableRuleString

             adjust: left

             model: disableLintRule

             keepSpaceForOSXResizeHandleH: true

           )

          (LinkButtonSpec

             label: 'Apply this Rule In...'

             name: 'Button5'

             layout: (AlignmentOrigin 0 1 -59 1 1 0)

             activeHelpKey: applyRuleIn

             level: 0

             translateLabel: true

             labelChannel: applyRuleInString

             resizeForLabel: true

             adjust: left

             model: applyLintRuleIn

             keepSpaceForOSXResizeHandleH: true

           )

          (LinkButtonSpec

             name: 'Button1'

             layout: (LayoutFrame 0 0 -29 1 -16 1 0 1)

             activeHelpKey: browseRule

             level: 0

             translateLabel: true

             labelChannel: ruleNameAspect

             adjust: left

             model: browseLintRule

             keepSpaceForOSXResizeHandleH: true

           )

          )

       )

     )

! !

!CriticsWindow 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)."

    ^ #(

        #ruleHolder

      ).

! !

!CriticsWindow methodsFor:'accessing'!

closeOnLeave

    "set if used as a flyBy tooltip, which should close automatically.

     false, if used as a modal dialog, which needs explicit close.

     The default is false."

    ^ closeOnLeave ? false

!

closeOnLeave:aBoolean

    "set this if used as a flyBy tooltip, which should close automatically.

     Leave false, if used as a modal dialog, which needs explicit close.

     The default is false."

    closeOnLeave := aBoolean

!

codeView

    ^ codeView

!

codeView:aCodeView2

    codeView := aCodeView2.

!

notCloseOnLeave:aBoolean

    ^ self closeOnLeave not

!

rule

    ^self ruleHolder value.

    "Created: / 30-01-2012 / 21:45:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

rule: anRBLintRule

    ^self ruleHolder value: anRBLintRule

    "Created: / 30-01-2012 / 21:45:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!CriticsWindow methodsFor:'actions'!

applyLintRuleIn

    |rule dialog cls pkg|

    rule := self ruleHolder value.

    rule isNil ifTrue:[^ self].

    cls := codeView textView editedClass.

    cls notNil ifTrue:[

        pkg := cls package

    ].    

    dialog := Tools::SearchDialog new

        currentClass:cls;

        currentPackage:pkg;

        setupToAskForMethodSearchTitle:(resources string:'Apply rule in:')

        forBrowser:nil

        searchWhat:nil searchArea:#everywhere

        withCaseIgnore:false withMatch:false

        withMethodList:false

        allowFind:false allowBuffer:false allowBrowser:true

        withTextEntry:false.

    [:restart|

        dialog askThenDo:[

            |classes methods keepResultList browser|

            classes := dialog classesToSearch.

            "/ methods := dialog methodsToSearch.

            browser := Tools::NewSystemBrowser new.

            browser allButOpen.

            browser

                smalllintRun:ruleHolder value

                onEnvironment:(ClassEnvironment new

                                classes:classes;

                                label:'Lint on more classes').

            browser openWindow.                

        ].    

    ] valueWithRestart.

    self hide.

!

browseLintRule

    self browseLintRule:self ruleHolder value

!

browseLintRule:rule

    |ruleClass|

    rule isNil ifTrue:[^ self].

    ruleClass := rule class.

    self close.

    SystemBrowser default openInClass:ruleClass selector:#rationale

    "Created: / 07-09-2011 / 04:09:38 / cg"

    "Modified: / 31-01-2012 / 11:30:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

disableLintRule

    |rule|

    rule := self ruleHolder value.

    rule isNil ifTrue:[^ self].

    "/ how do I disable the rule in the current smalllint checker service?

    "/ for now, a hack: keep a global disabledRules collection, and skip rules which are in it

    "/ if multiple rules complained, an anonymous composite rule is created;

    "/ then disable them all

    rule isComposite ifTrue:[

        rule rules do:[:each |

            SmalltalkChecker disableRule:each class.

        ].

    ] ifFalse:[

        SmalltalkChecker disableRule:rule class.

    ].

    self close.

!

doQuickFix: quickFixNo

    self closeDownViews.

    "/ cg: why fork here?

    "[" fixer performFix: quickFixNo "] fork".

    "Created: / 16-02-2012 / 14:19:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!CriticsWindow methodsFor:'aspects'!

applyRuleInString

    ^ 'Apply this Rule In...' asActionLinkTo:[ self applyLintRuleIn ]

!

closeIcon

    ^ ToolbarIconLibrary removeTab16x16Icon

!

disableRuleString

    ^ 'Disable this Rule' asActionLinkTo:[ self disableLintRule]

!

ruleHolder

    "return/create the 'ruleHolder' value holder (automatically generated)"

    ruleHolder isNil ifTrue:[

        ruleHolder := ValueHolder with: (RBDebuggingCodeLeftInMethodsRule new)

    ].

    ^ ruleHolder

    "Modified: / 30-01-2012 / 21:43:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

ruleHolder:something

    "set the 'ruleHolder' value holder (automatically generated)"

    |oldValue newValue|

    ruleHolder notNil ifTrue:[

        oldValue := ruleHolder value.

        ruleHolder removeDependent:self.

    ].

    ruleHolder := something.

    ruleHolder notNil ifTrue:[

        ruleHolder addDependent:self.

    ].

    newValue := ruleHolder value.

    oldValue ~~ newValue ifTrue:[

        self update:#value with:newValue from:ruleHolder.

    ].

!

ruleNameAspect

    |holder|

    (holder := builder bindingAt:#ruleNameAspect) isNil ifTrue:[

        holder := BlockValue

                    with:[:h |

                        |text rules|

                        text := ''.

                        rules := h isComposite ifTrue:[ h rules ] ifFalse:[ { h } ].

                        rules 

                            do:[:each |

                                |anchor|

                                "/ h displayString , ' ' , (('[browse]' actionForAll:[ self browseLintRule]) colorizeAllWith:Color blue)

                                anchor := ('Browse Rule Class (%1)' 

                                            bindWith:each class name)

                                                asActionLinkTo:[ self browseLintRule:each ].

                                text := text , anchor.

                            ]

                            separatedBy:[

                                text := text , '<br>'

                            ].

                        text.

                    ]

                    argument: self ruleHolder.

        builder aspectAt:#ruleNameAspect put:holder.

    ].

    ^ holder.

    "Modified: / 05-02-2010 / 12:51:30 / Jan Vrany "

    "Modified: / 07-09-2011 / 04:54:24 / cg"

!

ruleRationaleAndFixesHTMLHolder

    "return/create the 'ruleRationaleAndFixesHTMLHolder' value holder (automatically generated)"

    ruleRationaleAndFixesHTMLHolder isNil ifTrue:[

        ruleRationaleAndFixesHTMLHolder := ValueHolder new.

    ].

    ^ ruleRationaleAndFixesHTMLHolder

    "Modified (format): / 01-02-2012 / 10:57:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!CriticsWindow methodsFor:'change & update'!

generateHTMLForRule: rule on: stream

    | flattenedRules collectedFixes putCollectedFixes

      previousRuleClass already|    

    rule isComposite ifTrue:[

        already := Set new.

        flattenedRules := OrderedCollection new.

        rule flatten do:[:each | 

            (already includes:each) ifFalse:[

                already add:each.

                flattenedRules add:each

            ].

        ].

        "/ often, multiple instances of the same rule match in a line.

        "/ avoid, generating long lists, which all look the same.

        "/ so first, sort them by name.

        flattenedRules sort:[:a :b | a name < b name].

        "/ then in the code below, skip over repeated descriptions

    ] ifFalse:[

        flattenedRules := { rule }.

    ].    

    putCollectedFixes := 

        [

            collectedFixes notEmptyOrNil ifTrue:[

                stream nextPutAll: '<p>'.

                collectedFixes size > 1 ifTrue:[

                    stream nextPutAll: '<br>'.

                    stream nextPutLine: 'Possible fixes:'.

                ].

                stream nextPutLine:'<ul indent="0">'.

                collectedFixes withIndexDo:[:fix :index|

                    stream

                        nextPutAll:'<li>';

                        nextPutAll:'<a action="doit: linkActionPerformer doQuickFix:';

                        nextPutAll: index printString;

                        nextPut:$";

                        "/ nextPutAll:' info="',(fix rule class name),'"';

                        nextPut:$>;

                        nextPutAll: fix label;

                        nextPutAll:'</a>';

                        nextPutAll:' (',(fix rule class name),')';

                        nextPutAll:'</li>'.

                ].

                stream nextPutLine:'</ul>'.

            ].

        ].

    previousRuleClass := nil.

    collectedFixes := OrderedCollection new.

    flattenedRules 

        do:[:eachRule |

            eachRule class == previousRuleClass ifFalse:[

                collectedFixes notEmpty ifTrue:[

                    putCollectedFixes value.

                    collectedFixes := OrderedCollection new

                ].

                previousRuleClass notNil ifTrue:[

                    stream nextPutLine: '<hr>'

                ].    

                stream 

                    "/ nextPutAll:'<I>',eachRule class name,':</I><BR>'; 

                    nextPutAll:'<B>',eachRule name,'</B>';