"
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'!

helpSpec
    "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 helpSpec 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 |
	    |fixesForMe editedMethod editedClass editedSelector resultMethod|

	    editedMethod := codeView editedMethod.

	    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>';
		    nextPutAll:'<P>'.

		(editedMethod notNil
		and:[ eachRule result includesSelector:editedMethod selector in:editedMethod mclass ]) ifTrue:[
		    stream nextPutLine:(eachRule rationaleWithAnchorForMethod:editedMethod)
		] ifFalse:[
		    stream nextPutLine: eachRule rationale.
		].
	    ].

	    "/ Generate fixes...
	    "/ BUG: because rules/transformations remember their result,
	    "/ after a run over a project, there might be changes for many many different classes
	    "/ in the rule's changes list.
	    "/ therefore, the fixer selects only those changes which affect the current method.
	    self breakPoint:#cg.

	    "/ was
	    "/  eachRule fixes: fixer
	    "/ changed to:
	    editedMethod notNil ifTrue:[
		editedClass := editedMethod mclass.
		editedSelector := editedMethod selector.
		(editedClass isNil or:[editedSelector isNil]) ifTrue:[
		    Transcript showCR:'CriticsWindow: code in editor is outdated'.
		    ^ self
		].
	    ] ifFalse:[
		self breakPoint:#cg.
		^ self.
	    ].
	    eachRule
		addFixesForClass:editedClass
		selector:editedSelector
		to:fixer.

	    fixesForMe := fixer fixesForRule: eachRule.
	    fixesForMe notEmptyOrNil ifTrue:[
		collectedFixes addAll:fixesForMe.
	    ].
	    previousRuleClass := eachRule class.
	].

    collectedFixes notEmpty ifTrue:[
	putCollectedFixes value.
    ].

    "Created: / 15-12-2014 / 16:49:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 15-12-2014 / 18:17:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 17-02-2017 / 10:14:23 / stefan"
    "Modified: / 26-02-2017 / 14:52:29 / cg"
!

update:something with:aParameter from:changedObject
    "Invoked when an object that I depend upon sends a change notification."

    changedObject == ruleHolder ifTrue:[
	 self updateRationaleAndFixes.
	 ^ self.
    ].
    super update:something with:aParameter from:changedObject

    "Modified: / 01-02-2012 / 10:56:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

updateRationaleAndFixes
    | rule html |

    rule := self ruleHolder value.
    rule isNil ifTrue:[
	fixer := nil.
	html :=  'No rule...'.
    ] ifFalse:[
	fixer := SmalltalkQuickFixer forView: codeView.

	html :=
	    String streamContents:[:s|
		self generateHTMLForRule: rule on: s.
	    ].
    ].

    self ruleRationaleAndFixesHTMLHolder value: html

    "Created: / 01-02-2012 / 10:56:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 15-12-2014 / 18:18:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!CriticsWindow methodsFor:'event processing'!

processEvent: anEvent
    "/ always stay on top
    (anEvent isPointerEnterLeaveEvent
    or:[ anEvent isFocusEvent
    or:[ anEvent view notNil and:[ anEvent view isComponentOf:codeView topView ]]]) ifTrue:[
	self window raise.
    ].

    anEvent isKeyReleaseEvent ifTrue:[
	anEvent key == #Escape ifTrue:[
	    self closeRequest. "/ closeDownViews.
	    ^true.
	].
    ].

    "/ cg: if this is a modal dialog - do not exit on leave.
    "/ if used as a flyBy, set the closeOnLeave flag.
    self closeOnLeave ifTrue:[
	anEvent isPointerLeaveEvent ifTrue:[
	    anEvent view == self window ifTrue:[
		self closeRequest. "/ closeDownViews.
		^true.
	    ]
	].
    ].

    ^false

    "Created: / 16-02-2012 / 14:09:33 / Jan Vrany"
    "Modified (format): / 31-03-2014 / 16:53:41 / Jan Vrany"
    "Modified (comment): / 18-03-2017 / 14:26:11 / cg"
! !

!CriticsWindow methodsFor:'hooks'!

postBuildWith: aBuilder
    |window|

    super postBuildWith:aBuilder.

    window := aBuilder window.
    window allViewBackground:(window viewBackground).

    entered := false.
    self updateRationaleAndFixes.

    window beSlave.

    "Created: / 03-04-2011 / 10:45:10 / Jan Vrany"
    "Modified: / 16-02-2012 / 14:14:07 / Jan Vrany"
    "Modified (comment): / 18-03-2017 / 14:24:50 / cg"
!

postOpenWith: bldr
    super postOpenWith: bldr.
    self windowGroup addPreEventHook: self.

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

!CriticsWindow methodsFor:'initialization'!

setupHTMLView:aView
    rationalView := aView.
    rationalView linkActionPerformer:self.
    aView painter
	leftMargin:20;
	topMargin:5.

    "Created: / 04-08-2011 / 18:00:36 / cg"
! !

!CriticsWindow class methodsFor:'documentation'!

version
    ^ '$Header$'
!

version_CVS
    ^ '$Header$'
!

version_HG

    ^ '$Changeset: <not expanded> $'
!

version_SVN
    ^ '$Id$'
! !