class: ProjectProblem
authorClaus Gittinger <cg@exept.de>
Fri, 29 Mar 2013 22:27:21 +0100
changeset 3160 67e03d5fd83a
parent 3157 ad507c0fbd30
child 3161 3f9f36f40778
class: ProjectProblem nicer labels; added fix for projectDefinition problems
ProjectProblem.st
--- a/ProjectProblem.st	Thu Mar 28 16:32:07 2013 +0100
+++ b/ProjectProblem.st	Fri Mar 29 22:27:21 2013 +0100
@@ -25,35 +25,35 @@
 	privateIn:ProjectProblem
 !
 
-ProjectProblem::ClassProblem subclass:#ClassListedBeforeItsSuperclass
-	instanceVariableNames:'superClassName'
+ProjectProblem::ClassProblem subclass:#InconsistentProjectDefinition
+	instanceVariableNames:''
 	classVariableNames:''
 	poolDictionaries:''
 	privateIn:ProjectProblem
 !
 
-ProjectProblem::ClassProblem subclass:#ClassListedButDoesNotExist
+ProjectProblem::InconsistentProjectDefinition subclass:#ClassListedButDoesNotExist
 	instanceVariableNames:''
 	classVariableNames:''
 	poolDictionaries:''
 	privateIn:ProjectProblem
 !
 
-ProjectProblem::ClassProblem subclass:#ClassListedMultipleTimes
+ProjectProblem::InconsistentProjectDefinition subclass:#ClassListedMultipleTimes
 	instanceVariableNames:''
 	classVariableNames:''
 	poolDictionaries:''
 	privateIn:ProjectProblem
 !
 
-ProjectProblem::ClassProblem subclass:#ClassNotListed
+ProjectProblem::InconsistentProjectDefinition subclass:#ClassNotListed
 	instanceVariableNames:''
 	classVariableNames:''
 	poolDictionaries:''
 	privateIn:ProjectProblem
 !
 
-ProjectProblem::ClassProblem subclass:#ClassListedBeforeItsPool
+ProjectProblem::InconsistentProjectDefinition subclass:#ClassListedBeforeItsPool
 	instanceVariableNames:'poolName'
 	classVariableNames:''
 	poolDictionaries:''
@@ -102,6 +102,13 @@
 	privateIn:ProjectProblem
 !
 
+ProjectProblem::InconsistentProjectDefinition subclass:#ClassListedBeforeItsSuperclass
+	instanceVariableNames:'superClassName'
+	classVariableNames:''
+	poolDictionaries:''
+	privateIn:ProjectProblem
+!
+
 ProjectProblem::MethodProblem subclass:#MethodCompilabilityIssue
 	instanceVariableNames:'errors warnings'
 	classVariableNames:''
@@ -482,43 +489,45 @@
     "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."
+!ProjectProblem::InconsistentProjectDefinition methodsFor:'fixes'!
 
-    ^
-'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).
+fixes
 
-'
-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>"
+    ^Array
+        with: (Array with: 'Regenerate specs in ProjectDefinitions' with: [ self regenerateProjectDefinition ])
 !
 
-label
-    "Return the label (possibly instance if a Text) shortly describing the problem"
-
-    ^'Class %1 listed in project definition before its superclass' bindWith: className
+regenerateProjectDefinition
+    |defClass|
 
-    "Modified: / 13-09-2012 / 17:36:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-superClassName
-    ^ superClassName
-!
-
-superClassName:something
-    superClassName := something.
+    defClass := self packageDefinitionClass.
+    Class packageQuerySignal
+        answer:defClass package
+        do:[
+            defClass theNonMetaclass
+                forEachContentsMethodsCodeToCompileDo:
+                    [:code :category |
+                        Compiler
+                            compile:code
+                            forClass:defClass theMetaclass
+                            inCategory:category.
+                    ]
+                ignoreOldDefinition:false
+        ].
 ! !
 
 !ProjectProblem::ClassListedButDoesNotExist methodsFor:'accessing'!
 
+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::ClassListedButDoesNotExist methodsFor:'accessing-description'!
+
 description
     "Return a (HTML) describing the problem."
     ^
@@ -532,20 +541,12 @@
 !
 
 label
-    ^'Missing class ', className
+    ^'Missing class: ', className allBold
 
     "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'!
+!ProjectProblem::ClassListedMultipleTimes methodsFor:'accessing-description'!
 
 description
     "Return a (HTML) describing the problem."
@@ -566,12 +567,12 @@
 label
     "Return the label (possibly instance if a Text) shortly describing the problem"
 
-    ^'Missing pool (%1)' bindWith: className
+    ^'Class %1 listed multiple times in project definition "%2"' bindWith: className allBold with:self packageDefinitionClass
 
     "Modified: / 23-02-2012 / 13:34:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
-!ProjectProblem::ClassNotListed methodsFor:'accessing'!
+!ProjectProblem::ClassNotListed methodsFor:'accessing-description'!
 
 description
     "Return a (HTML) describing the problem."
@@ -589,7 +590,7 @@
 label
     "Return the label (possibly instance if a Text) shortly describing the problem"
 
-    ^'Class %1 not listed in project definition' bindWith: className
+    ^'Class %1 not listed in project definition "%2"' bindWith: className allBold with:self packageDefinitionClass 
 
     "Modified: / 23-02-2012 / 13:55:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
@@ -599,27 +600,32 @@
 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>"
+    ^ self doIncludeInProjectAsAutoloaded:false
 !
 
 doIncludeInProjectAsAutoloaded
     "Include subject class in project definition. Return false if
      fix fails, true otherwise"
+
+    ^ self doIncludeInProjectAsAutoloaded:true
+!
+
+doIncludeInProjectAsAutoloaded:asAutoloaded
+    "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.
+    asAutoloaded ifTrue:[
+        def makeClassesAutoloaded:(Array with: cls) usingCompiler: nil.
+    ] ifFalse:[
+        def includeClasses:(Array with: cls) usingCompiler: nil.
+    ].
     UserNotification notify: ('Class added. Do not forget to check in build support files!!' bindWith: className).
     ^true
 
@@ -637,6 +643,16 @@
 
 !ProjectProblem::ClassListedBeforeItsPool methodsFor:'accessing'!
 
+poolName
+    ^ poolName
+!
+
+poolName:something
+    poolName := something.
+! !
+
+!ProjectProblem::ClassListedBeforeItsPool methodsFor:'accessing-description'!
+
 description
     "Return a (HTML) describing the problem."
 
@@ -657,17 +673,9 @@
 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
+    ^'Class %1 listed in project definition "%2" before one of its pools' bindWith: className allBold with:self packageDefinitionClass
 
     "Modified: / 13-09-2012 / 17:36:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-poolName
-    ^ poolName
-!
-
-poolName:something
-    poolName := something.
 ! !
 
 !ProjectProblem::ClassUsesPoolProblem methodsFor:'accessing'!
@@ -680,7 +688,7 @@
     poolName := something.
 ! !
 
-!ProjectProblem::ClassUsesPoolButItIsNotASharedPool methodsFor:'accessing'!
+!ProjectProblem::ClassUsesPoolButItIsNotASharedPool methodsFor:'accessing-description'!
 
 description
     "Return a (HTML) describing the problem."
@@ -699,12 +707,12 @@
 label
     "Return the label (possibly instance if a Text) shortly describing the problem"
 
-    ^'Used pool is not a SharedPool (%1)' bindWith: className
+    ^'Used pool %1 is not a SharedPool' bindWith: className allBold
 
     "Modified: / 23-02-2012 / 13:40:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
-!ProjectProblem::ClassUsesPoolInNamespaceButNamespaceIsNotDefined methodsFor:'accessing'!
+!ProjectProblem::ClassUsesPoolInNamespaceButNamespaceIsNotDefined methodsFor:'accessing-description'!
 
 description
     "Return a (HTML) describing the problem."
@@ -724,12 +732,12 @@
 label
     "Return the label (possibly instance if a Text) shortly describing the problem"
 
-    ^ 'Missing namespace definition in shared pools definition' bindWith: className
+    ^ 'Missing namespace prefix in shared pools definition of %1' bindWith: className allBold
 
     "Modified: / 13-09-2012 / 16:28:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
-!ProjectProblem::ClassUsesPoolButItDoesNotExist methodsFor:'accessing'!
+!ProjectProblem::ClassUsesPoolButItDoesNotExist methodsFor:'accessing-description'!
 
 description
     "Return a (HTML) describing the problem."
@@ -747,7 +755,7 @@
 label
     "Return the label (possibly instance if a Text) shortly describing the problem"
 
-    ^'Missing pool (%1)' bindWith: className
+    ^'Missing pool: ' , className allBold
 
     "Modified: / 23-02-2012 / 13:34:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
@@ -795,7 +803,7 @@
     "Created: / 23-02-2012 / 14:21:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
-!ProjectProblem::ExtensionMethodNotListed methodsFor:'accessing'!
+!ProjectProblem::ExtensionMethodNotListed methodsFor:'accessing-description'!
 
 description
     "Return a (HTML) describing the problem."
@@ -811,7 +819,7 @@
 label
     "Return the label (possibly instance if a Text) shortly describing the problem"
 
-    ^'Extension method %1>>%2 not listed' bindWith: className with: selector
+    ^'Extension method %1 >> %2 not listed in project definition "%3"' bindWith: className allBold with: selector allBold with:self packageDefinitionClass
 
     "Modified: / 23-02-2012 / 14:22:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
@@ -853,8 +861,53 @@
 	with: (Array with: 'Move to classes package' with: [ self doMoveToClassesPackage ])
 ! !
 
+!ProjectProblem::ClassListedBeforeItsSuperclass methodsFor:'accessing'!
+
+superClassName
+    ^ superClassName
+!
+
+superClassName:something
+    superClassName := something.
+! !
+
+!ProjectProblem::ClassListedBeforeItsSuperclass methodsFor:'accessing-description'!
+
+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 %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 "%2" before its superclass' bindWith: className allBold with:self packageDefinitionClass 
+
+    "Modified: / 13-09-2012 / 17:36:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
 !ProjectProblem::MethodCompilabilityIssue methodsFor:'accessing'!
 
+severity
+    ^ errors notNil ifTrue:[#error] ifFalse:[#warning]
+
+    "Modified: / 11-04-2012 / 15:40:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!ProjectProblem::MethodCompilabilityIssue methodsFor:'accessing-description'!
+
 description
     "Return a (HTML) describing the problem."
 
@@ -890,19 +943,12 @@
 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
-    ]
+    ^ (errors notNil 
+        ifTrue:[ 'Uncompilable method %1 >> %2' ]
+        ifFalse:[ 'Warnings for method %1 >> %2' ]) bindWith: className allBold with: selector allBold
+
 
     "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'!
@@ -996,13 +1042,6 @@
 
 !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
 !
@@ -1027,6 +1066,15 @@
     startPosition := something.
 ! !
 
+!ProjectProblem::MethodCompilabilityIssue::Error methodsFor:'accessing-description'!
+
+descriptionOn: stream
+
+    stream nextPutAll: message; space; nextPutAll:'(error)'
+
+    "Created: / 11-04-2012 / 15:52:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
 !ProjectProblem::MethodCompilabilityIssue::Warning class methodsFor:'instance creation'!
 
 message: message from: startPosition to: endPosition
@@ -1042,13 +1090,6 @@
 
 !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
 !
@@ -1073,20 +1114,16 @@
     startPosition := something.
 ! !
 
-!ProjectProblem::MethodInNoPackage methodsFor:'accessing'!
+!ProjectProblem::MethodCompilabilityIssue::Warning methodsFor:'accessing-description'!
 
-description
-    "Return a (HTML) describing the problem."
+descriptionOn: stream
 
-    ^
-'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
+    stream nextPutAll: message; space"/; nextPutAll:'(warning)'
 
-    "Modified: / 23-02-2012 / 14:21:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
+    "Created: / 11-04-2012 / 15:52:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!ProjectProblem::MethodInNoPackage methodsFor:'accessing'!
 
 fixes
 
@@ -1105,17 +1142,32 @@
 		])
 
     "Created: / 26-07-2012 / 09:53:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!ProjectProblem::MethodInNoPackage methodsFor:'accessing-description'!
+
+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>"
 !
 
 label
     "Return the label (possibly instance if a Text) shortly describing the problem"
 
-    ^'Unpackaged method %1>>%2' bindWith: className with: selector
+    ^'Unpackaged method %1 >> %2' bindWith: className allBold with: selector allBold
 
     "Modified: / 23-02-2012 / 14:19:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
-!ProjectProblem::ExtensionMethodListedButDoesNotExist methodsFor:'accessing'!
+!ProjectProblem::ExtensionMethodListedButDoesNotExist methodsFor:'accessing-description'!
 
 description
     "Return a (HTML) describing the problem."
@@ -1134,13 +1186,23 @@
 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
+    ^'Extension method %1 >> %2 listed but not existing' bindWith: className allBold with: selector allBold
 
     "Modified: / 23-02-2012 / 14:22:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !ProjectProblem::MethodSourceCorrupted methodsFor:'accessing'!
 
+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::MethodSourceCorrupted methodsFor:'accessing-description'!
+
 description
     "Return a (HTML) describing the problem."
 
@@ -1161,20 +1223,22 @@
 label
     "Return the label (possibly instance if a Text) shortly describing the problem"
 
-    ^ 'Corrupted source code for %1>>%2' bindWith: className with: selector
+    ^ 'Corrupted source code for %1 >> %2' bindWith: className allBold with: selector allBold
 
     "Modified: / 11-04-2012 / 12:42:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
+! !
+
+!ProjectProblem::MethodSourceNotAvailable methodsFor:'accessing'!
 
 severity
     "Return a severity - one of #error, #warning, #info"
 
     ^#error
 
-    "Created: / 11-04-2012 / 12:47:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Created: / 11-04-2012 / 12:47:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
-!ProjectProblem::MethodSourceNotAvailable methodsFor:'accessing'!
+!ProjectProblem::MethodSourceNotAvailable methodsFor:'accessing-description'!
 
 description
     "Return a (HTML) describing the problem."
@@ -1192,20 +1256,22 @@
 label
     "Return the label (possibly instance if a Text) shortly describing the problem"
 
-    ^ 'Unavailable source code for %1>>%2' bindWith: className with: selector
+    ^ 'Unavailable source code for %1 >> %2' bindWith: className allBold with: selector allBold
 
     "Modified: / 11-04-2012 / 12:41:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
+! !
+
+!ProjectProblem::ProjectDefinitionDoesNotExist methodsFor:'accessing'!
 
 severity
     "Return a severity - one of #error, #warning, #info"
 
     ^#error
 
-    "Created: / 11-04-2012 / 12:47:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Created: / 11-04-2012 / 12:48:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
-!ProjectProblem::ProjectDefinitionDoesNotExist methodsFor:'accessing'!
+!ProjectProblem::ProjectDefinitionDoesNotExist methodsFor:'accessing-description'!
 
 description
     "Return a (HTML) describing the problem."
@@ -1230,14 +1296,6 @@
     ^'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'!
@@ -1273,13 +1331,14 @@
 !ProjectProblem class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic3/ProjectProblem.st,v 1.10 2013-03-27 19:51:41 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic3/ProjectProblem.st,v 1.11 2013-03-29 21:27:21 cg Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libbasic3/ProjectProblem.st,v 1.10 2013-03-27 19:51:41 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic3/ProjectProblem.st,v 1.11 2013-03-29 21:27:21 cg Exp $'
 !
 
 version_SVN
     ^ '§Id: ProjectProblem.st 1962 2012-09-10 10:34:08Z vranyj1 §'
 ! !
+