"
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:libbasic3' }"
Object subclass:#ProjectProblem
instanceVariableNames:'package fixes'
classVariableNames:''
poolDictionaries:''
category:'System-Support-Projects'
!
ProjectProblem subclass:#ClassProblem
instanceVariableNames:'className'
classVariableNames:''
poolDictionaries:''
privateIn:ProjectProblem
!
ProjectProblem::ClassProblem subclass:#ClassListedBeforeItsSuperclass
instanceVariableNames:'superClassName'
classVariableNames:''
poolDictionaries:''
privateIn:ProjectProblem
!
ProjectProblem::ClassProblem subclass:#ClassListedButDoesNotExist
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
privateIn:ProjectProblem
!
ProjectProblem::ClassProblem subclass:#ClassListedMultipleTimes
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
privateIn:ProjectProblem
!
ProjectProblem::ClassProblem subclass:#ClassNotListed
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
privateIn:ProjectProblem
!
ProjectProblem::ClassProblem subclass:#ClassListedBeforeItsPool
instanceVariableNames:'poolName'
classVariableNames:''
poolDictionaries:''
privateIn:ProjectProblem
!
ProjectProblem::ClassProblem subclass:#ClassUsesPoolProblem
instanceVariableNames:'poolName'
classVariableNames:''
poolDictionaries:''
privateIn:ProjectProblem
!
ProjectProblem::ClassUsesPoolProblem subclass:#ClassUsesPoolButItIsNotASharedPool
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
privateIn:ProjectProblem
!
ProjectProblem::ClassUsesPoolProblem subclass:#ClassUsesPoolInNamespaceButNamespaceIsNotDefined
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
privateIn:ProjectProblem
!
ProjectProblem::ClassUsesPoolProblem subclass:#ClassUsesPoolButItDoesNotExist
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
privateIn:ProjectProblem
!
ProjectProblem::ClassProblem subclass:#MethodProblem
instanceVariableNames:'selector'
classVariableNames:''
poolDictionaries:''
privateIn:ProjectProblem
!
ProjectProblem::MethodProblem subclass:#ExtensionMethodNotListed
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
privateIn:ProjectProblem
!
ProjectProblem::MethodProblem subclass:#MethodCompilabilityIssue
instanceVariableNames:'errors warnings'
classVariableNames:''
poolDictionaries:''
privateIn:ProjectProblem
!
Object subclass:#Error
instanceVariableNames:'message startPosition endPosition'
classVariableNames:''
poolDictionaries:''
privateIn:ProjectProblem::MethodCompilabilityIssue
!
Object subclass:#Warning
instanceVariableNames:'message startPosition endPosition'
classVariableNames:''
poolDictionaries:''
privateIn:ProjectProblem::MethodCompilabilityIssue
!
ProjectProblem::MethodProblem subclass:#MethodInNoPackage
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
privateIn:ProjectProblem
!
ProjectProblem::MethodProblem subclass:#ExtensionMethodListedButDoesNotExist
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
privateIn:ProjectProblem
!
ProjectProblem::MethodProblem subclass:#MethodSourceCorrupted
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
privateIn:ProjectProblem
!
ProjectProblem::MethodProblem subclass:#MethodSourceNotAvailable
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
privateIn:ProjectProblem
!
ProjectProblem subclass:#ProjectDefinitionDoesNotExist
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
privateIn:ProjectProblem
!
!ProjectProblem 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.
"
! !
!ProjectProblem class methodsFor:'instance creation'!
newClassListedBeforeItsPool
^ClassListedBeforeItsPool new
"Created: / 13-09-2012 / 17:13:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
newClassListedBeforeItsSuperclass
^ClassListedBeforeItsSuperclass new
"Created: / 13-09-2012 / 17:13:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
newClassListedButDoesNotExist
^ClassListedButDoesNotExist new
"Created: / 23-02-2012 / 13:18:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
newClassListedMultipleTimes
^ClassListedMultipleTimes new
"Created: / 13-09-2012 / 17:40:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
newClassNotListed
^ClassNotListed new
"Created: / 23-02-2012 / 13:59:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
newClassUsesPoolButItDoesNotExist
^ClassUsesPoolButItDoesNotExist new
"Created: / 23-02-2012 / 13:37:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
newClassUsesPoolButItIsNotASharedPool
^ClassUsesPoolButItIsNotASharedPool new
"Created: / 23-02-2012 / 13:48:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
newClassUsesPoolInNamespaceButNamespaceIsNotDefined
^ClassUsesPoolInNamespaceButNamespaceIsNotDefined new
"Created: / 13-09-2012 / 16:40:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
newExtensionMethodListedButDoesNotExist
^ExtensionMethodListedButDoesNotExist new
"Created: / 23-02-2012 / 14:26:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
newExtensionMethodNotListed
^ExtensionMethodNotListed new
"Created: / 23-02-2012 / 14:27:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
newMethodCompilabilityIssue
^MethodCompilabilityIssue new
"Created: / 11-04-2012 / 15:34:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
newMethodInNoPackage
^MethodInNoPackage new
"Created: / 23-02-2012 / 14:27:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
newMethodSourceCorrupted
^MethodSourceCorrupted new
"Created: / 11-04-2012 / 12:35:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
newMethodSourceNotAvailable
^MethodSourceNotAvailable new
"Created: / 11-04-2012 / 12:31:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
newProjectDefinitionDoesNotExist
^ProjectDefinitionDoesNotExist new
"Created: / 23-02-2012 / 13:08:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProjectProblem methodsFor:'accessing'!
description
"Return a (HTML) describing the problem."
^self subclassResponsibility
"Created: / 23-02-2012 / 13:04:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
descriptionAndFixes
"Return a (HTML) describing the problem plus possible fixes."
self initializeFixes.
fixes isEmpty ifTrue:[ ^ self description ].
^String streamContents:[:html |
html nextPutAll: self description.
html nextPutAll: '<br><br>'.
fixes size == 1 ifTrue:[
html nextPutLine: 'Possible fix:'.
] ifFalse:[
html nextPutLine: 'Possible fixes:'.
].
html nextPutLine:'<ul>'.
fixes withIndexDo:[:fix :index|
html
nextPutAll:'<li><a action="doit: self application doFix: ';
nextPutAll: index printString;
nextPutAll:'">';
nextPutAll: fix first;
nextPutAll:'</a></li>'.
].
html nextPutLine:'</ul>'.
].
"Created: / 26-07-2012 / 09:46:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
fixes
"Return (possibly empty) list of actions that
the user may take to fix/investigate the problem.
Returned value should be list of pairs (label, action block).
To be overriden in subclasses.
The list should be an array of pairs ( fix label , fix block ).
Fix block should return true, if the fix was successful,
false otherwise"
^#()
"Created: / 26-07-2012 / 09:46:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
label
"Return the label (possibly instance if a Text) shortly describing the problem"
^self subclassResponsibility
"Created: / 23-02-2012 / 13:03:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
package
^ package
!
package:aSymbol
package := aSymbol asSymbol.
"Modified: / 11-04-2012 / 16:00:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
packageDefinitionClass
^ProjectDefinition definitionClassForPackage: package
"Created: / 23-02-2012 / 13:26:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
severity
"Return a severity - one of #error, #warning, #info"
^#warning "/by default
"Created: / 23-02-2012 / 13:09:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProjectProblem methodsFor:'fixing'!
doFix: index
self initializeFixes.
^(fixes at: index) second value
"Created: / 26-07-2012 / 10:07:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProjectProblem methodsFor:'initialization'!
initializeFixes
fixes isNil ifTrue:[
fixes := self fixes
].
"/ super initialize. -- commented since inherited method does nothing
"Created: / 26-07-2012 / 09:54:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProjectProblem methodsFor:'printing & storing'!
displayString
^self label
"Created: / 14-02-2012 / 17:02:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
printOn:aStream
"append a printed representation if the receiver to the argument, aStream"
super printOn:aStream.
aStream nextPut:$(.
self severity printOn:aStream.
aStream nextPut:$:; space.
self label printOn:aStream.
aStream nextPut:$).
"Modified: / 23-02-2012 / 16:49:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProjectProblem methodsFor:'utilities-HTML'!
linkToClass: classOrclassName
| className |
className := classOrclassName isBehavior
ifTrue: [classOrclassName storeString]
ifFalse:[classOrclassName].
^'<A INFO="Click to browse class" ACTION="doit: UserPreferences current systemBrowserClass openInClass:%1"><CODE>%1</CODE></A>'
bindWith: className
"Created: / 23-02-2012 / 13:44:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
linkToClass: classOrclassName selector: selector
^self linkToClass: classOrclassName selector: selector omitClassName: false
"Created: / 23-02-2012 / 13:45:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
linkToClass: classOrclassName selector: selector omitClassName: omitClassName
| className |
className := classOrclassName isBehavior
ifTrue: [classOrclassName name]
ifFalse:[classOrclassName].
^omitClassName ifTrue:[
'<A INFO="Click to browse method" ACTION="doit: UserPreferences current systemBrowserClass openInClass:%1 selector: %2"><CODE>#%3</CODE></A>'
bindWith: className
with: selector storeString
with: selector
] ifFalse:[
'<A INFO="Click to browse method" ACTION="doit: UserPreferences current systemBrowserClass openInClass:%1 selector: %2"><CODE>%1>>%3</CODE></A>'
bindWith: className
with: selector storeString
with: selector
]
"Created: / 26-07-2012 / 10:26:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProjectProblem::ClassProblem methodsFor:'accessing'!
className
^ className
!
className:something
className := something.
!
klass
"Return the class which is subject of the problem"
"/ | class |
"/
"/ (className endsWith: ' class') ifTrue:[
"/ class := Smalltalk at: (className copyTo: className size - 6) asSymbol.
"/ class := class theMetaclass.
"/ ] ifFalse:[
"/ class := Smalltalk at: className asSymbol
"/ ].
"/ ^class
"/ the above is exactly:
^ Smalltalk classNamed:className
"Created: / 26-07-2012 / 10:21:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProjectProblem::ClassListedBeforeItsSuperclass methodsFor:'accessing'!
description
"Return a (HTML) describing the problem."
^
'Class %2 is listed in project definition (%1) before its superclass.
<br>Such a class will fail to compile (if the package is being stc-compiled)
and load (if the package is being loaded from source).
<br>Make sure class (%3) is listed before (%2).
'
bindWith: (self linkToClass: self packageDefinitionClass class selector: #classNamesAndAttributes omitClassName: true)
with: (self linkToClass: className)
with: (self linkToClass: superClassName)
"Modified: / 13-09-2012 / 18:29:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
label
"Return the label (possibly instance if a Text) shortly describing the problem"
^'Class %1 listed in project definition before its superclass' bindWith: className
"Modified: / 13-09-2012 / 17:36:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
superClassName
^ superClassName
!
superClassName:something
superClassName := something.
! !
!ProjectProblem::ClassListedButDoesNotExist methodsFor:'accessing'!
description
"Return a (HTML) describing the problem."
^
'A class (<code>%1</code>) is listed in the project definition but
not present in the system.
You should either create it or remove it from %2.'
bindWith: className with: (self linkToClass: self packageDefinitionClass class selector: #classNamesAndAttributes)
"Modified: / 28-02-2012 / 22:23:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
label
^'Missing class ', className
"Modified: / 23-02-2012 / 13:20:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
severity
"Return a severity - one of #error, #warning, #info"
^#error
"Created: / 11-04-2012 / 12:48:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProjectProblem::ClassListedMultipleTimes methodsFor:'accessing'!
description
"Return a (HTML) describing the problem."
^
'A class %1 is listed more than once in %2.
Such package will fail to compile, as linker will complain
about multiple definitions of the same symbols. Make sure each
class is listed only once.
'
bindWith: (self linkToClass: className)
with: (self linkToClass: self packageDefinitionClass class selector: #extensionMethodNames)
"Modified: / 13-09-2012 / 17:40:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
label
"Return the label (possibly instance if a Text) shortly describing the problem"
^'Missing pool (%1)' bindWith: className
"Modified: / 23-02-2012 / 13:34:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProjectProblem::ClassNotListed methodsFor:'accessing'!
description
"Return a (HTML) describing the problem."
^
'Class %1 is not listed in project definition (%2).
<br>The class won''t be compiled and - if some other class dependents on it - the whole package will fail to compile
at all.'
bindWith: (self linkToClass: className)
with: (self linkToClass: self packageDefinitionClass class selector: #classNamesAndAttributes omitClassName: true)
"Modified: / 26-07-2012 / 10:27:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
label
"Return the label (possibly instance if a Text) shortly describing the problem"
^'Class %1 not listed in project definition' bindWith: className
"Modified: / 23-02-2012 / 13:55:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProjectProblem::ClassNotListed methodsFor:'fixing'!
doIncludeInProject
"Include subject class in project definition. Return false if
fix fails, true otherwise"
| def cls |
def := self packageDefinitionClass.
def isNil ifTrue:[ ^ false ].
cls := self klass.
cls isNil ifTrue:[ ^ false ].
def includeClasses:(Array with: cls) usingCompiler: nil.
UserNotification notify: ('Class added. Do not forget to check in build support files!!' bindWith: className).
^true
"Created: / 26-07-2012 / 10:41:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
doIncludeInProjectAsAutoloaded
"Include subject class in project definition. Return false if
fix fails, true otherwise"
| def cls |
def := self packageDefinitionClass.
def isNil ifTrue:[ ^ false ].
cls := self klass.
cls isNil ifTrue:[ ^ false ].
def makeClassesAutoloaded:(Array with: cls) usingCompiler: nil.
UserNotification notify: ('Class added. Do not forget to check in build support files!!' bindWith: className).
^true
"Created: / 26-07-2012 / 10:41:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
fixes
^Array
with: (Array with: 'Include in project' with: [ self doIncludeInProject ])
with: (Array with: 'Include in project as autoloaded' with: [ self doIncludeInProjectAsAutoloaded ])
"Created: / 26-07-2012 / 10:41:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProjectProblem::ClassListedBeforeItsPool methodsFor:'accessing'!
description
"Return a (HTML) describing the problem."
^
'Class %2 is listed in project definition (%1) before one of its pools (%3).
<br>Such class will fail to compile (if the package is being stc-compiled)
and load (if the package is being loaded from source).
<br>Make sure class (%3) is listed before (%2).
'
bindWith: (self linkToClass: self packageDefinitionClass class selector: #classNamesAndAttributes omitClassName: true)
with: (self linkToClass: className)
with: (self linkToClass: poolName)
"Modified: / 13-09-2012 / 18:29:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
label
"Return the label (possibly instance if a Text) shortly describing the problem"
^'Class %1 listed in project definition before one of its pools' bindWith: className
"Modified: / 13-09-2012 / 17:36:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
poolName
^ poolName
!
poolName:something
poolName := something.
! !
!ProjectProblem::ClassUsesPoolProblem methodsFor:'accessing'!
poolName
^ poolName
!
poolName:something
poolName := something.
! !
!ProjectProblem::ClassUsesPoolButItIsNotASharedPool methodsFor:'accessing'!
description
"Return a (HTML) describing the problem."
^
'A class %1 uses pool %2 but it does not exist.
The pool should be removed from the class definition;
otherwise the package won''t compile due to a missing class.'
bindWith: (self linkToClass: className)
with: (self linkToClass: poolName)
"Modified: / 23-02-2012 / 13:48:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
label
"Return the label (possibly instance if a Text) shortly describing the problem"
^'Used pool is not a SharedPool (%1)' bindWith: className
"Modified: / 23-02-2012 / 13:40:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProjectProblem::ClassUsesPoolInNamespaceButNamespaceIsNotDefined methodsFor:'accessing'!
description
"Return a (HTML) describing the problem."
^
'A class %1 uses pool %2 from same namespace as the class,
but the namespace is not explicitly named in the shared pools definition.
Due to a bug in stc, such code will fail to compile. A pool definition
must contain a fully qualified class name including namespace.'
bindWith: (self linkToClass: className)
with: (self linkToClass: poolName)
"Modified: / 13-09-2012 / 16:32:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
label
"Return the label (possibly instance if a Text) shortly describing the problem"
^ 'Missing namespace definition in shared pools definition' bindWith: className
"Modified: / 13-09-2012 / 16:28:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProjectProblem::ClassUsesPoolButItDoesNotExist methodsFor:'accessing'!
description
"Return a (HTML) describing the problem."
^
'A class %1 uses pool %2 but it does not exist.
The pool should be removed from the class definition;
otherwise the package won''t compile due to a missing class.'
bindWith: (self linkToClass: className) with: poolName
"Modified: / 13-09-2012 / 16:24:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
label
"Return the label (possibly instance if a Text) shortly describing the problem"
^'Missing pool (%1)' bindWith: className
"Modified: / 23-02-2012 / 13:34:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProjectProblem::MethodProblem methodsFor:'accessing'!
className:something selector: sel
className := something.
selector := sel
"Created: / 23-02-2012 / 14:17:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
method
| class |
class := self klass.
class isNil ifTrue:[ ^ self ].
^class compiledMethodAt: selector
"Created: / 26-07-2012 / 10:09:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
method: method
self className: method mclass name selector: method selector
"Created: / 11-04-2012 / 12:32:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
selector
^ selector
!
selector:something
selector := something.
! !
!ProjectProblem::MethodProblem methodsFor:'utilities-HTML'!
linkToMethod
^self linkToClass: className selector: selector
"Created: / 23-02-2012 / 14:21:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProjectProblem::ExtensionMethodNotListed methodsFor:'accessing'!
description
"Return a (HTML) describing the problem."
^'Method %1 is not listed in %2.
<br>It should either be listed in the project definition, or moved to the owning classes package'
bindWith: (self linkToMethod)
with: (self linkToClass: self packageDefinitionClass class selector: #extensionMethodNames)
"Modified: / 23-02-2012 / 14:34:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
label
"Return the label (possibly instance if a Text) shortly describing the problem"
^'Extension method %1>>%2 not listed' bindWith: className with: selector
"Modified: / 23-02-2012 / 14:22:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProjectProblem::ExtensionMethodNotListed methodsFor:'fixing'!
doMoveToClassesPackage
"move the extension method to the owning classes package.
Return false if fix fails, true otherwise"
| cls mthd |
cls := self klass.
cls isNil ifTrue:[ ^ false ].
mthd := cls compiledMethodAt:selector.
mthd package:(cls package).
UserNotification notify: ('Do not forget to check in the method''s package (or class) ("%1")!!' bindWith:cls package).
^true
!
doUpdateExtensionMethodsInProject
"update the extension method info in the project definition.
Return false if fix fails, true otherwise"
| def cls |
def := self packageDefinitionClass.
def isNil ifTrue:[ ^ false ].
cls := self klass.
cls isNil ifTrue:[ ^ false ].
def updateExtensionMethodNamesUsingCompiler:nil.
UserNotification notify: ('ProjectDefinition updated. Do not forget to check it in!!').
^true
!
fixes
^Array
with: (Array with: 'Update project definition' with: [ self doUpdateExtensionMethodsInProject ])
with: (Array with: 'Move to classes package' with: [ self doMoveToClassesPackage ])
! !
!ProjectProblem::MethodCompilabilityIssue methodsFor:'accessing'!
description
"Return a (HTML) describing the problem."
| issuePrinter |
issuePrinter := [:stream :issue|
stream nextPutAll:'<li>'.
issue descriptionOn: stream.
stream nextPutAll:'</li>'.
stream cr.
].
^ String streamContents:[:s|
s
nextPutAll: 'The following problems have been found in ';
nextPutAll: self linkToMethod;
nextPutAll: ':'; cr;
nextPutAll: '<ul>'.
errors ? #() do:[:issue|issuePrinter value: s value: issue].
warnings ? #() do:[:issue|issuePrinter value: s value: issue].
s
nextPutAll: '</ul>'.
errors notNil ifTrue:[
s nextPutAll:
'STC won''t compile such code, therefore you must fix it before committing'
].
]
"Modified: / 11-04-2012 / 15:51:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
label
"Return the label (possibly instance if a Text) shortly describing the problem"
^ errors notNil ifTrue:[
'Uncompilable method %1>>%2' bindWith: className with: selector
] ifFalse:[
'Warnings for method %1>>%2' bindWith: className with: selector
]
"Modified: / 11-04-2012 / 16:04:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
severity
^ errors notNil ifTrue:[#error] ifFalse:[#warning]
"Modified: / 11-04-2012 / 15:40:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProjectProblem::MethodCompilabilityIssue methodsFor:'error handling'!
correctableError:aMessage position:position to:endPos from:aCompiler
"error notification during fileIn.
This is sent by the compiler/evaluator if it detects errors."
self error:aMessage position:position to:endPos from:aCompiler.
^ false. "/ no correction
"Created: / 30-07-1999 / 18:11:15 / cg"
"Modified: / 02-11-2010 / 12:58:54 / cg"
!
correctableSelectorWarning:aMessage position:position to:endPos from:aCompiler
"warning notification during fileIn.
This is sent by the compiler/evaluator if it detects errors."
self warning:aMessage position:position to:endPos from:aCompiler.
^ false. "/ no correction
"Modified: / 02-11-2010 / 12:59:04 / cg"
!
correctableWarning:aMessage position:position to:endPos from:aCompiler
"error notification during fileIn.
This is sent by the compiler/evaluator if it detects errors."
self warning:aMessage position:position to:endPos from:aCompiler.
^ false
"Created: / 02-11-2010 / 13:29:40 / cg"
!
error:aMessage position:position to:endPos from:aCompiler
"error notification during fileIn.
This is sent by the compiler/evaluator if it detects errors."
"Argh!!!!!!!! If its an ignorable error, why signal error!!!!!! Bad design,
even worse workaround. Sigh."
thisContext sender sender sender sender selector == #ignorableParseError:
ifTrue:[ ^ self ].
errors isNil ifTrue:[ errors := OrderedCollection new].
errors add: (Error message: aMessage from: position to: endPos)
"Created: / 30-07-1999 / 18:10:30 / cg"
"Modified: / 10-09-2012 / 11:32:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
unusedVariableWarning:aMessage position:position to:endPos from:aCompiler
"warning notification during fileIn.
This is sent by the compiler/evaluator if it detects errors."
^ self warning:aMessage position:position to:endPos from:aCompiler
!
warning:aMessage position:position to:endPos from:aCompiler
"warning notification during fileIn - ignore it.
This is sent by the compiler/evaluator if it detects errors."
"/ No, do not show warnings now, too many false positives
"/ warnings isNil ifTrue:[ warnings := OrderedCollection new].
"/ warnings add: (Warning message: aMessage from: position to: endPos).
"Created: / 30-07-1999 / 18:11:05 / cg"
"Modified (comment): / 12-04-2012 / 18:19:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProjectProblem::MethodCompilabilityIssue methodsFor:'queries'!
hasIssue
^ (errors ? warnings) notNil
"Created: / 11-04-2012 / 15:43:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProjectProblem::MethodCompilabilityIssue::Error class methodsFor:'instance creation'!
message: message from: startPosition to: endPosition
^self new
message: message;
startPosition: startPosition;
endPosition: endPosition;
yourself.
"Created: / 11-04-2012 / 15:38:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProjectProblem::MethodCompilabilityIssue::Error methodsFor:'accessing'!
descriptionOn: stream
stream nextPutAll: message; space; nextPutAll:'(error)'
"Created: / 11-04-2012 / 15:52:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
endPosition
^ endPosition
!
endPosition:something
endPosition := something.
!
message
^ message
!
message:something
message := something.
!
startPosition
^ startPosition
!
startPosition:something
startPosition := something.
! !
!ProjectProblem::MethodCompilabilityIssue::Warning class methodsFor:'instance creation'!
message: message from: startPosition to: endPosition
^self new
message: message;
startPosition: startPosition;
endPosition: endPosition;
yourself.
"Created: / 11-04-2012 / 15:38:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProjectProblem::MethodCompilabilityIssue::Warning methodsFor:'accessing'!
descriptionOn: stream
stream nextPutAll: message; space"/; nextPutAll:'(warning)'
"Created: / 11-04-2012 / 15:52:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
endPosition
^ endPosition
!
endPosition:something
endPosition := something.
!
message
^ message
!
message:something
message := something.
!
startPosition
^ startPosition
!
startPosition:something
startPosition := something.
! !
!ProjectProblem::MethodInNoPackage methodsFor:'accessing'!
description
"Return a (HTML) describing the problem."
^
'Method %1 does not belong to any package. Such methods
are not committed and will be lost when you restart/recompile.
Method should be moved to some package, %2 maybe?'
bindWith: (self linkToMethod)
with: package
"Modified: / 23-02-2012 / 14:21:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
fixes
^Array with:
(Array with: 'Move method to package ', package
with: [
| m |
m := self method.
m notNil ifTrue:[
m package: package.
true
] ifFalse:[
false
]
])
"Created: / 26-07-2012 / 09:53:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
label
"Return the label (possibly instance if a Text) shortly describing the problem"
^'Unpackaged method %1>>%2' bindWith: className with: selector
"Modified: / 23-02-2012 / 14:19:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProjectProblem::ExtensionMethodListedButDoesNotExist methodsFor:'accessing'!
description
"Return a (HTML) describing the problem."
^'Method %1>>%2 listed in %3 but does not exist.
This does not hurt if you stc-compile all your code, but such a package will fail to
(auto)load from sources.
It is highly recommended to remove the method from the list (%3).'
bindWith: className with: selector
with: (self linkToClass: self packageDefinitionClass class selector: #extensionMethodNames)
"Modified: / 23-02-2012 / 15:18:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
label
"Return the label (possibly instance if a Text) shortly describing the problem"
^'Extension method %1>>%2 listed but not exist' bindWith: className with: selector
"Modified: / 23-02-2012 / 14:22:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProjectProblem::MethodSourceCorrupted methodsFor:'accessing'!
description
"Return a (HTML) describing the problem."
^
'Source code for %1 is <b>corrupted</b>. This is likely because
the binary class version does not match the source file. This may happen,
for instance, if you compile a class library and then edit the .st file,
or you have checked out from the SCM over the existing source code.
<BR>Be very careful with checkin or fileOut, and check for currupt source code.
<BR>It is recommended to leave ST/X, restore the old source or compile a system
based on the current source, restart ST/X, reapply the chages and commit then.'
bindWith: (self linkToMethod)
with: package
"Modified: / 11-04-2012 / 12:47:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
label
"Return the label (possibly instance if a Text) shortly describing the problem"
^ 'Corrupted source code for %1>>%2' bindWith: className with: selector
"Modified: / 11-04-2012 / 12:42:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
severity
"Return a severity - one of #error, #warning, #info"
^#error
"Created: / 11-04-2012 / 12:47:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProjectProblem::MethodSourceNotAvailable methodsFor:'accessing'!
description
"Return a (HTML) describing the problem."
^
'Source code for %1 is not available. Check your package path
and/or source code management settings.
'
bindWith: (self linkToMethod)
with: package
"Modified: / 11-04-2012 / 12:44:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
label
"Return the label (possibly instance if a Text) shortly describing the problem"
^ 'Unavailable source code for %1>>%2' bindWith: className with: selector
"Modified: / 11-04-2012 / 12:41:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
severity
"Return a severity - one of #error, #warning, #info"
^#error
"Created: / 11-04-2012 / 12:47:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProjectProblem::ProjectDefinitionDoesNotExist methodsFor:'accessing'!
description
"Return a (HTML) describing the problem."
package = 'stx' ifTrue:[
^
'Move your code to another package.
<br>The package named "stx" is reserveed for exept''s ST/X development.'
].
^
'A project definition class for package "%1" does not exist.
<br>Project definition classes keep the meta information of a package,
such as contents and build parameters.
You <b>must</b> create it, otherwise package management won''t work.'
bindWith: package
"Modified: / 23-02-2012 / 13:29:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
label
^'Project definition class for "%1" does not exist' bindWith: package
"Modified: / 23-02-2012 / 13:21:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
severity
"Return a severity - one of #error, #warning, #info"
^#error
"Created: / 11-04-2012 / 12:48:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProjectProblem::ProjectDefinitionDoesNotExist methodsFor:'fixing'!
doCreateAs:whatType
ProjectDefinition
definitionClassForPackage:package
projectType: whatType
createIfAbsent:true.
!
doCreateAsGUIApplication
self doCreateAs:ProjectDefinition guiApplicationType
!
doCreateAsLibrary
self doCreateAs:ProjectDefinition libraryType
!
doCreateAsNonGUIApplication
self doCreateAs:ProjectDefinition nonGuiApplicationType
!
fixes
package = 'stx' ifTrue:[ ^ #() ].
^ Array
with: (Array with:'Create as Library' with:[ self doCreateAsLibrary ] )
with: (Array with:'Create as GUI Application' with:[ self doCreateAsGUIApplication ] )
with: (Array with:'Create as non-GUI Application' with:[ self doCreateAsNonGUIApplication ] )
! !
!ProjectProblem class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic3/ProjectProblem.st,v 1.10 2013-03-27 19:51:41 cg Exp $'
!
version_CVS
^ '$Header: /cvs/stx/stx/libbasic3/ProjectProblem.st,v 1.10 2013-03-27 19:51:41 cg Exp $'
!
version_SVN
^ '§Id: ProjectProblem.st 1962 2012-09-10 10:34:08Z vranyj1 §'
! !