ProjectDefinition.st
changeset 13635 b07e00f94949
parent 13623 46625f58d8ee
child 13636 bed7798bd61f
--- a/ProjectDefinition.st	Mon Sep 05 23:18:49 2011 +0200
+++ b/ProjectDefinition.st	Tue Sep 06 08:36:30 2011 +0200
@@ -226,11 +226,10 @@
 !ProjectDefinition class methodsFor:'accessing'!
 
 allPreRequisites
-    "answer all (recursive) prerequisite project ids of myself - in random order.
-     If we exclude a project, but one of our prerequisite projects depends on it, "
+    "answer all (recursive) prerequisite project ids of myself - in random order."
 
     ^ self allPreRequisitesWithParentDo:[:parent :prereq |
-	prereq = self package ifTrue:[ Transcript showCR:('oops: %1 depends on itself' bindWith:prereq) ].
+        prereq = self package ifTrue:[ Transcript showCR:('oops: %1 depends on itself' bindWith:prereq) ].
       ]
 
     "
@@ -245,6 +244,7 @@
     "
 
     "Modified: / 13-04-2011 / 15:30:45 / sr"
+    "Modified (comment): / 06-09-2011 / 08:26:06 / cg"
 !
 
 allPreRequisitesSorted
@@ -302,7 +302,8 @@
 
 allPreRequisitesWithParentDo:aBlock
     "answer all (recursive) prerequisite project ids of myself - in random order.
-     If we exclude a project, but one of our prerequisite projects depends on it, "
+     If we exclude a project, but one of our prerequisite projects depends on it, 
+     then what ????"
 
     |setOfAllPreRequisites toAdd|
 
@@ -317,34 +318,34 @@
 "/    toAdd addAll:self effectiveSubProjects.
 
     [toAdd notEmpty] whileTrue:[
-	|aPreRequisiteProjectID def|
-
-	aPreRequisiteProjectID := toAdd removeFirst.
-	(setOfAllPreRequisites includes:aPreRequisiteProjectID) ifFalse:[
-	    setOfAllPreRequisites add:aPreRequisiteProjectID.
-
-	    def := self definitionClassForPackage:aPreRequisiteProjectID.
-	    def isNil ifTrue:[
-		Transcript showCR:'ProjectDefinition ', aPreRequisiteProjectID, ' is missing - cannot find its preRequisites.'.
-	    ] ifFalse:[
-		def effectivePreRequisites
-		    select:[:eachSubPreRequisite | (setOfAllPreRequisites includes:eachSubPreRequisite) not]
-		    thenDo:[:eachSubPreRequisite |
-				Transcript show:'ProjectDefinition preRequisites: '; showCR:(aPreRequisiteProjectID, ' requires ', eachSubPreRequisite).
-				aBlock value:def value:eachSubPreRequisite.
-				toAdd add:eachSubPreRequisite
-			   ].
-
-		"but subprojects of our prerequisites are also prerequisites"
-		def effectiveSubProjects
-		    select:[:eachSubSubRequisite | eachSubSubRequisite ~= self package and:[ (setOfAllPreRequisites includes:eachSubSubRequisite) not ]]
-		    thenDo:[:eachSubSubRequisite |
-				Transcript show:'ProjectDefinition preRequisites: '; showCR:(aPreRequisiteProjectID, ' hasSub ', eachSubSubRequisite).
-				aBlock value:def value:eachSubSubRequisite.
-				toAdd add:eachSubSubRequisite
-			   ].
-	    ].
-	]
+        |aPreRequisiteProjectID def|
+
+        aPreRequisiteProjectID := toAdd removeFirst.
+        (setOfAllPreRequisites includes:aPreRequisiteProjectID) ifFalse:[
+            setOfAllPreRequisites add:aPreRequisiteProjectID.
+
+            def := self definitionClassForPackage:aPreRequisiteProjectID.
+            def isNil ifTrue:[
+                Transcript showCR:'ProjectDefinition ', aPreRequisiteProjectID, ' is missing - cannot find its preRequisites.'.
+            ] ifFalse:[
+                def effectivePreRequisites
+                    select:[:eachSubPreRequisite | (setOfAllPreRequisites includes:eachSubPreRequisite) not]
+                    thenDo:[:eachSubPreRequisite |
+                                Transcript show:'ProjectDefinition preRequisites: '; showCR:(aPreRequisiteProjectID, ' requires ', eachSubPreRequisite).
+                                aBlock value:def value:eachSubPreRequisite.
+                                toAdd add:eachSubPreRequisite
+                           ].
+
+                "but subprojects of our prerequisites are also prerequisites"
+                def effectiveSubProjects
+                    select:[:eachSubSubRequisite | eachSubSubRequisite ~= self package and:[ (setOfAllPreRequisites includes:eachSubSubRequisite) not ]]
+                    thenDo:[:eachSubSubRequisite |
+                                Transcript show:'ProjectDefinition preRequisites: '; showCR:(aPreRequisiteProjectID, ' hasSub ', eachSubSubRequisite).
+                                aBlock value:def value:eachSubSubRequisite.
+                                toAdd add:eachSubSubRequisite
+                           ].
+            ].
+        ]
     ].
     ^ setOfAllPreRequisites.
 
@@ -360,6 +361,7 @@
     "
 
     "Created: / 13-04-2011 / 15:23:21 / sr"
+    "Modified (comment): / 06-09-2011 / 08:25:53 / cg"
 !
 
 directory
@@ -1315,74 +1317,76 @@
     newSpec := OrderedCollection new.
 
     ignoreOldEntries ifFalse:[
-	oldSpec do:[:oldEntry |
-	    |newEntry className cls |
-
-	    newEntry := oldEntry copy.
-	    className := newEntry first.
-
-	    (ignored includes:className) ifFalse:[
-		cls := Smalltalk classNamed:className.
-		ignoreOldDefinition ifTrue:[
-		    (cls notNil and:[cls isLoaded not]) ifTrue:[
-			(newEntry includes:#autoload) ifFalse:[
-			    newEntry := newEntry copyWith:#autoload.
-			].
-		    ].
-		].
-		"JV @ 2010-06-19
-		 Force merge default class attributes with existing ones"
-		newEntry := self mergeDefaultClassAttributesFor: cls with: newEntry.
-		newSpec add:newEntry.
-	    ].
-	].
+        oldSpec do:[:oldEntry |
+            |newEntry className cls |
+
+            newEntry := oldEntry copy.
+            className := newEntry first.
+
+            (ignored includes:className) ifFalse:[
+                cls := Smalltalk classNamed:className.
+                ignoreOldDefinition ifTrue:[
+                    (cls notNil and:[cls isLoaded not]) ifTrue:[
+                        (newEntry includes:#autoload) ifFalse:[
+                            newEntry := newEntry copyWith:#autoload.
+                        ].
+                    ].
+                ].
+                cls notNil ifTrue:[
+                    "JV @ 2010-06-19
+                     Force merge default class attributes with existing ones"
+                    newEntry := self mergeDefaultClassAttributesFor: cls with: newEntry.
+                    newSpec add:newEntry.
+                ]
+            ].
+        ].
     ].
 
     self searchForClasses do:[:eachClass |
-	|className attributes oldSpecEntry oldAttributes newEntry|
-
-	className := eachClass name.
-	(ignored includes:className) ifFalse:[
-	    oldSpecEntry := oldSpec detect:[:entry | entry first = className] ifNone:nil.
-
-	    (ignoreOldEntries or:[ oldSpecEntry isNil]) ifTrue:[
-		(eachClass isLoaded not or:[eachClass isPrivate not]) ifTrue:[
-		    (self additionalClassNamesAndAttributes includes:className) ifFalse:[
-			(oldSpecEntry size > 1) ifTrue:[
-			    oldAttributes := oldSpecEntry copyFrom:2.
-			].
-
-			ignoreOldDefinition ifTrue:[
-			    "take autoload attribute from classes state in the image"
-			    oldAttributes notNil ifTrue:[
-				attributes := oldAttributes copyWithout:#autoload.
-			    ] ifFalse:[
-				attributes := #()
-			    ].
-			    eachClass isLoaded ifFalse:[
-				attributes := attributes copyWith:#autoload.
-			    ].
-			] ifFalse:[
-			    "keep any existing attribute"
-			    oldAttributes notNil ifTrue:[
-				attributes := oldAttributes.
-			    ] ifFalse:[
-				attributes := eachClass isLoaded ifTrue:[ #() ] ifFalse:[ #(autoload) ].
-			    ].
-			].
-			"JV @ 2010-06-19
-			 Support fo additional class attributes and programming language attribute"
-			attributes := self mergeDefaultClassAttributesFor: eachClass with: attributes.
-
-			newEntry := Array with:className.
-			attributes notEmptyOrNil ifTrue:[
-			    newEntry := newEntry , attributes.
-			].
-			newSpec add:newEntry
-		    ]
-		]
-	    ]
-	]
+        |className attributes oldSpecEntry oldAttributes newEntry|
+
+        className := eachClass name.
+        (ignored includes:className) ifFalse:[
+            oldSpecEntry := oldSpec detect:[:entry | entry first = className] ifNone:nil.
+
+            (ignoreOldEntries or:[ oldSpecEntry isNil]) ifTrue:[
+                (eachClass isLoaded not or:[eachClass isPrivate not]) ifTrue:[
+                    (self additionalClassNamesAndAttributes includes:className) ifFalse:[
+                        (oldSpecEntry size > 1) ifTrue:[
+                            oldAttributes := oldSpecEntry copyFrom:2.
+                        ].
+
+                        ignoreOldDefinition ifTrue:[
+                            "take autoload attribute from classes state in the image"
+                            oldAttributes notNil ifTrue:[
+                                attributes := oldAttributes copyWithout:#autoload.
+                            ] ifFalse:[
+                                attributes := #()
+                            ].
+                            eachClass isLoaded ifFalse:[
+                                attributes := attributes copyWith:#autoload.
+                            ].
+                        ] ifFalse:[
+                            "keep any existing attribute"
+                            oldAttributes notNil ifTrue:[
+                                attributes := oldAttributes.
+                            ] ifFalse:[
+                                attributes := eachClass isLoaded ifTrue:[ #() ] ifFalse:[ #(autoload) ].
+                            ].
+                        ].
+                        "JV @ 2010-06-19
+                         Support fo additional class attributes and programming language attribute"
+                        attributes := self mergeDefaultClassAttributesFor: eachClass with: attributes.
+
+                        newEntry := Array with:className.
+                        attributes notEmptyOrNil ifTrue:[
+                            newEntry := newEntry , attributes.
+                        ].
+                        newSpec add:newEntry
+                    ]
+                ]
+            ]
+        ]
     ].
     ^ self classNamesAndAttributes_codeFor:newSpec
 
@@ -1393,8 +1397,8 @@
 
     "Modified: / 08-08-2006 / 19:24:34 / fm"
     "Created: / 10-10-2006 / 22:00:50 / cg"
-    "Modified: / 22-02-2007 / 15:06:37 / cg"
     "Modified: / 19-06-2010 / 10:56:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 06-09-2011 / 07:48:52 / cg"
 !
 
 companyName_code
@@ -5838,53 +5842,7 @@
     "answer a Dictionary where the keys are the prerequisite package for this package
      and the values are a Set of reasons, why each package is required"
 
-    |requiredClasses requiredPackageReasons usedClassesWithReasons ignoredPackages|
-
-    usedClassesWithReasons := Dictionary new.
-
-    "my classes are required"
-    requiredClasses := (self searchForClassesWithProject:self package) asSet.
-
-    "my subproject's classes are required"
-    self subProjects do:[:eachProjectName |
-	requiredClasses addAll: (self searchForClassesWithProject:eachProjectName asSymbol)
-    ].
-
-    "all superclasses of my classes and my subProject's classes are required"
-    requiredClasses do:[:cls |
-	cls allSuperclassesDo:[:eachSuperclass |
-	    (usedClassesWithReasons at: eachSuperclass ifAbsentPut:[Set new])
-		add: (eachSuperclass name, ' - superclass of ', cls name).
-	]
-    ].
-
-    "all classes referenced by my classes or my subproject's classes
-     are required. But:
-	 only search for locals refered to by my methods (assuming that superclasses'
-	 prerequisites are specified in their package)."
-
-    self addReferencesToClassesFromGlobalsIn:requiredClasses to:usedClassesWithReasons.
-    self addReferencesToClassesFromGlobalsInMethods:(self searchForExtensionsWithProject:self package) to:usedClassesWithReasons.
-
-    "don't put classes from subProjects into the required list"
-    ignoredPackages := (self siblingsAreSubProjects
-				ifTrue:[ self searchForSiblingProjects ]
-				ifFalse:[ self searchForSubProjects ]) asSet.
-
-    ignoredPackages add:self package.
-    ignoredPackages add:PackageId noProjectID.
-
-    "now map classes to packages and collect the reasons"
-    requiredPackageReasons := Dictionary new.
-    usedClassesWithReasons keysAndValuesDo:[:usedClass :reasonsPerClass | |usedClassPackage|
-	usedClassPackage := usedClass package.
-	(ignoredPackages includes:usedClassPackage) ifFalse:[
-	    (requiredPackageReasons at:usedClassPackage ifAbsentPut:[Set new])
-			    addAll:reasonsPerClass.
-	].
-    ].
-
-    ^ requiredPackageReasons
+    ^ self searchForPreRequisites:self package withSubProjects:true
 
     "
      self searchForPreRequisites
@@ -5895,13 +5853,31 @@
 
     "Created: / 07-08-2006 / 20:42:39 / fm"
     "Modified: / 07-08-2006 / 21:56:25 / fm"
-    "Modified: / 20-09-2006 / 17:29:59 / cg"
+    "Modified: / 06-09-2011 / 08:30:43 / cg"
 !
 
 searchForPreRequisites: packageId
     "answer a Dictionary where the keys are the prerequisite package for this package
      and the values are a Set of reasons, why each package is required"
 
+    ^ self searchForPreRequisites: packageId withSubProjects:false
+
+    "
+     self searchForPreRequisites
+     self searchForPreRequisites:#'stx:libwidg3'
+     bosch_dapasx_Application searchForPreRequisites
+     bosch_dapasx_pav_browser searchForPreRequisites
+    "
+
+    "Modified: / 07-08-2006 / 21:56:25 / fm"
+    "Created: / 17-11-2010 / 18:27:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 06-09-2011 / 08:30:20 / cg"
+!
+
+searchForPreRequisites:packageId withSubProjects:withSubProjectsBoolean
+    "answer a Dictionary where the keys are the prerequisite package for this package
+     and the values are a Set of reasons, why each package is required"
+
     |requiredClasses requiredPackageReasons usedClassesWithReasons ignoredPackages|
 
     usedClassesWithReasons := Dictionary new.
@@ -5909,31 +5885,43 @@
     "my classes are required"
     requiredClasses := (self searchForClassesWithProject: packageId) asSet.
 
-    "my subproject's classes are required"
-    "self subProjects do:[:eachProjectName |
-	requiredClasses addAll: (self searchForClassesWithProject:eachProjectName asSymbol)
-    ]."
+    withSubProjectsBoolean ifTrue:[
+        "my subproject's classes are required"
+        self subProjects do:[:eachProjectName |
+            requiredClasses addAll: (self searchForClassesWithProject:eachProjectName asSymbol)
+        ].
+    ].
 
     "all superclasses of my classes and my subProject's classes are required"
     requiredClasses do:[:cls |
-	cls allSuperclassesDo:[:eachSuperclass |
-	    (usedClassesWithReasons at: eachSuperclass ifAbsentPut:[Set new])
-		add: (eachSuperclass name, ' - superclass of ', cls name).
-	]
+        cls allSuperclassesDo:[:eachSuperclass |
+            (usedClassesWithReasons at: eachSuperclass ifAbsentPut:[Set new])
+                add: (eachSuperclass name, ' - superclass of ', cls name).
+        ]
     ].
 
     "all classes referenced by my classes or my subproject's classes
      are required. But:
-	 only search for locals refered to by my methods (assuming that superclasses'
-	 prerequisites are specified in their package)."
+         only search for locals refered to by my methods (assuming that superclasses'
+         prerequisites are specified in their package)."
 
     self addReferencesToClassesFromGlobalsIn:requiredClasses to:usedClassesWithReasons.
     self addReferencesToClassesFromGlobalsInMethods:(self searchForExtensionsWithProject:self package) to:usedClassesWithReasons.
 
+    "all classes for which I define extensions are required"
+    self extensionClasses do:[:eachExtendedClass |
+        (usedClassesWithReasons at:eachExtendedClass ifAbsentPut:[Set new])
+            add: (eachExtendedClass name, ' - is extended').
+        eachExtendedClass allSuperclassesDo:[:eachSuperclass |
+            (usedClassesWithReasons at: eachSuperclass ifAbsentPut:[Set new])
+                add: (eachSuperclass name, ' - superclass of extended ', eachExtendedClass name).
+        ]
+    ].
+
     "don't put classes from subProjects into the required list"
     ignoredPackages := (self siblingsAreSubProjects
-				ifTrue:[ self searchForSiblingProjects ]
-				ifFalse:[ self searchForSubProjects ]) asSet.
+                                ifTrue:[ self searchForSiblingProjects ]
+                                ifFalse:[ self searchForSubProjects ]) asSet.
 
     ignoredPackages add:self package.
     ignoredPackages add:PackageId noProjectID.
@@ -5941,11 +5929,11 @@
     "now map classes to packages and collect the reasons"
     requiredPackageReasons := Dictionary new.
     usedClassesWithReasons keysAndValuesDo:[:usedClass :reasonsPerClass | |usedClassPackage|
-	usedClassPackage := usedClass package.
-	(ignoredPackages includes:usedClassPackage) ifFalse:[
-	    (requiredPackageReasons at:usedClassPackage ifAbsentPut:[Set new])
-			    addAll:reasonsPerClass.
-	].
+        usedClassPackage := usedClass package.
+        (ignoredPackages includes:usedClassPackage) ifFalse:[
+            (requiredPackageReasons at:usedClassPackage ifAbsentPut:[Set new])
+                            addAll:reasonsPerClass.
+        ].
     ].
 
     ^ requiredPackageReasons
@@ -5958,8 +5946,8 @@
     "
 
     "Modified: / 07-08-2006 / 21:56:25 / fm"
-    "Modified: / 20-09-2006 / 17:29:59 / cg"
     "Created: / 17-11-2010 / 18:27:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Created: / 06-09-2011 / 08:29:37 / cg"
 ! !
 
 !ProjectDefinition class methodsFor:'queries'!
@@ -6393,11 +6381,11 @@
 !ProjectDefinition class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.347 2011-09-04 09:15:48 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.348 2011-09-06 06:36:30 cg Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.347 2011-09-04 09:15:48 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.348 2011-09-06 06:36:30 cg Exp $'
 !
 
 version_SVN