ProjectDefinition.st
changeset 10005 407485f2a6e0
parent 9998 49e54dc8ecc0
child 10007 93f73465ef11
--- a/ProjectDefinition.st	Thu Sep 21 18:32:25 2006 +0200
+++ b/ProjectDefinition.st	Fri Sep 22 17:45:29 2006 +0200
@@ -1008,13 +1008,6 @@
     "Modified: / 17-08-2006 / 20:47:20 / cg"
 !
 
-common_compiled_classNames          
-    ^ self classNamesForWhich:[:nm :attr | attr isEmptyOrNil].
-
-    "Modified: / 07-08-2006 / 21:25:25 / fm"
-    "Created: / 21-08-2006 / 18:47:12 / cg"
-!
-
 compiled_classNames          
     ^ self classNamesForWhich:[:nm :attr | attr isEmptyOrNil or:[(attr includes:#autoload) not]].
 
@@ -1023,11 +1016,13 @@
     "Modified: / 21-08-2006 / 18:48:31 / cg"
 !
 
-compiled_classNamesForArchitecture:architectureID          
+compiled_classNamesForPlatform:platformName
+    "answer the classes to be compiled only for platformName
+     platformName is one of #unix, #win32 (OperatingSystem platformName)"
+
     ^ self 
-        classNamesForWhich:[:nm :attr |
-            (attr includes:#autoload) not
-            and:[(attr includes:architectureID)]
+        classNamesForWhich:[:nm :attr | 
+            (attr includes:#autoload) not and:[ (attr includes:platformName) ]
         ].
 
     "Created: / 07-08-2006 / 19:02:57 / fm"
@@ -1035,8 +1030,8 @@
     "Modified: / 17-08-2006 / 20:47:20 / cg"
 !
 
-compiled_classNames_common          
-    "class, only to be compiled under unix"
+compiled_classNames_common
+    "classes to be compiled for any platform"
 
     ^ self 
         classNamesForWhich:[:nm :attr |
@@ -1046,24 +1041,18 @@
     "Created: / 18-08-2006 / 13:37:51 / cg"
 !
 
-compiled_classNames_unix          
+compiled_classNames_unix
     "class, only to be compiled under unix"
-
-    ^ self 
-        classNamesForWhich:[:nm :attr |
-            attr includes:#unix
-        ].
+    
+    ^ self compiled_classNamesForPlatform:#unix.
 
     "Created: / 18-08-2006 / 13:37:51 / cg"
 !
 
-compiled_classNames_windows          
+compiled_classNames_windows
     "class, only to be compiled under windows"
-
-    ^ self 
-        classNamesForWhich:[:nm :attr |
-            attr includes:#win32
-        ].
+    
+    ^ self compiled_classNamesForPlatform:#win32.
 
     "Created: / 18-08-2006 / 13:37:56 / cg"
 !
@@ -1662,7 +1651,7 @@
         streamContents:[:s |
             |classNames classesLoaded classNamesUnloaded classesSorted classNamesSorted|
 
-            classNames := self common_compiled_classNames.
+            classNames := self compiled_classNames_common.
             classesLoaded := classNames 
                         collect:[:nm | |cls| cls := Smalltalk classNamed:nm]
                         thenSelect:[:cls |  cls notNil and:[cls isLoaded] ].
@@ -2017,41 +2006,68 @@
 !
 
 loadAllClasses
-    |loadedClasses loadClass|
-
-    loadedClasses := OrderedCollection new.
-
-    loadClass := [:className |
+    "load (fileIn) classes that should be present -
+     install as autoloaded classes marked to be autoloaded"
+    
+    |classNamesToLoad classNamesToAutoload hasClassesToLoad loadedClasses platformName|
+
+    platformName := OperatingSystem platformName.
+    classNamesToLoad := OrderedCollection new.
+    classNamesToAutoload := OrderedCollection new.
+
+    self classNamesAndAttributesDo:[:eachClassname :eachAttributes | |isAutoload|
+        isAutoload := eachAttributes includes:#autoload.
+
+        (eachAttributes isEmpty 
+         or:[(eachAttributes size == 1 and:[isAutoload])
+         or:[eachAttributes includes:platformName]]) ifTrue:[
+            hasClassesToLoad := true.
+            isAutoload ifTrue:[
+                classNamesToAutoload add:eachClassname.
+            ] ifFalse:[
+                classNamesToLoad add:eachClassname.
+            ].
+        ]
+    ].
+
+    hasClassesToLoad ifTrue:[
+        loadedClasses := OrderedCollection new.
+
+        "we need the abbreviations, since sometimes there is no 1-to-1 mapping
+         of class name to file name"
+
+        Smalltalk recursiveReadAllAbbreviationsFrom:self packageDirectory maxLevels:1.
+
+        "install autoloaded classes first,
+         some others may depend on them"
+
+        classNamesToAutoload do:[:eachClassName |
+            Smalltalk
+                installAutoloadedClassNamed:eachClassName 
+                category:#autoloaded    "FIXME"
+                package:self package 
+                revision:nil 
+                numClassInstVars:0.     "FIXME"
+        ].
+
+        classNamesToLoad do:[:eachClassName | 
             |cls|
 
-            cls := Smalltalk at:className asSymbol.
-            (cls isNil or:[cls isLoaded not]) ifTrue:[
-                cls := Smalltalk
-                    fileInClass:className 
-                    package:self package 
-                    initialize:false 
-                    lazy:false 
-                    silent:false.
-                cls notNil ifTrue:[
-                    loadedClasses add:cls
-                ].
+            cls := Smalltalk 
+                        fileInClass:eachClassName
+                        package:self package
+                        initialize:false
+                        lazy:false
+                        silent:false.
+            cls notNil ifTrue:[
+                loadedClasses add:cls
             ].
         ].
-
-    self allClassNames do:loadClass.
-    OperatingSystem isUNIXlike ifTrue:[
-        self compiled_classNames_unix do:loadClass.
-    ] ifFalse:[
-        OperatingSystem isMSWINDOWSlike ifTrue:[
-            self compiled_classNames_windows do:loadClass.
-        ] ifFalse:[
-            self error:'unknown OS'
-        ].
-    ].
-
-    loadedClasses do:[:each |
-        (each theMetaclass implements:#initialize) ifTrue:[
-            each initialize
+        loadedClasses do:[:eachLoadedClass | 
+            "do not initialize, if initialize method is inherited"
+            (eachLoadedClass theMetaclass implements:#initialize) ifTrue:[
+                eachLoadedClass initialize
+            ].
         ].
     ].
 
@@ -2225,59 +2241,65 @@
 
 !ProjectDefinition class methodsFor:'mappings support'!
 
-generateClassLines:classLineTemplate
-    ^ String streamContents:[:s |
-        |classNames classesLoaded classNamesUnloaded classNamesSorted putLineForClassName|
-
-        putLineForClassName := [:className | 
-                |newClassLine mappings|
-
-                mappings := self classLine_mappings: className.
-                newClassLine := self replaceMappings:mappings in:classLineTemplate.
-                s nextPutLine: newClassLine 
-            ].
-
-        classNames := self common_compiled_classNames.
-        classesLoaded := classNames 
-                    collect:[:nm | |cls| cls := Smalltalk classNamed:nm]
-                    thenSelect:[:cls |  cls notNil and:[cls isLoaded] ].
-        classNamesUnloaded := classNames 
-                    select:[:nm | |cls| cls := Smalltalk classNamed:nm. cls isNil or:[cls isLoaded not]].
-
-        classNamesSorted := (Class classesSortedByLoadOrder:classesLoaded) collect:[:cls |cls name].
-        
-        classNamesSorted do:putLineForClassName.
-        classNamesUnloaded do:putLineForClassName.
-
-        self namesAndAttributesIn:(self additionalClassNamesAndAttributes) do:[:nm :attr |
-            (attr isEmptyOrNil or:[(attr includes:#autoload) not]) ifTrue:[
-                putLineForClassName value:nm.
-            ].
-        ].
-
-        #(
-                ('UNIX'  #unix)
-                ('WIN32' #win32)
-                ('VMS'   #vms)
-                ('BEOS'  #beos)
-        ) pairsDo:[:ifdef :id|
-            |archClassNames archClassesLoaded|
-
-            archClassNames := self compiled_classNamesForArchitecture:id.    
-            archClassNames notEmpty ifTrue:[
-                s nextPutLine: '#ifdef ',ifdef.
-                archClassNames do:[:clsName | putLineForClassName value:clsName].
-                s nextPutLine: '#endif /* ',ifdef,' */'.
-            ].
-        ].
-    ]
+generateClassLines:classLineTemplate 
+    ^ String 
+        streamContents:[:s | 
+            |classNames classesLoaded classNamesUnloaded classNamesSorted putLineForClassName|
+
+            putLineForClassName := [:className | 
+                    |newClassLine mappings|
+
+                    mappings := self classLine_mappings:className.
+                    newClassLine := self replaceMappings:mappings in:classLineTemplate.
+                    s nextPutLine:newClassLine
+                ].
+            classNames := self compiled_classNames_common.
+            classesLoaded := classNames 
+                        collect:[:nm | 
+                            |cls|
+
+                            cls := Smalltalk classNamed:nm
+                        ]
+                        thenSelect:[:cls | cls notNil and:[ cls isLoaded ] ].
+            classNamesUnloaded := classNames 
+                        select:[:nm | 
+                            |cls|
+
+                            cls := Smalltalk classNamed:nm.
+                            cls isNil or:[ cls isLoaded not ]
+                        ].
+            classNamesSorted := (Class classesSortedByLoadOrder:classesLoaded) 
+                        collect:[:cls | cls name ].
+            classNamesSorted do:putLineForClassName.
+            classNamesUnloaded do:putLineForClassName.
+            self namesAndAttributesIn:(self additionalClassNamesAndAttributes)
+                do:[:nm :attr | 
+                    (attr isEmptyOrNil or:[ (attr includes:#autoload) not ]) ifTrue:[
+                        putLineForClassName value:nm.
+                    ].
+                ].
+            #( #('UNIX' unix)
+             #('WIN32' win32)
+             #('VMS' vms)
+             #('BEOS' beos) ) 
+                    pairsDo:[:ifdef :id | 
+                        |archClassNames archClassesLoaded|
+
+                        archClassNames := self compiled_classNamesForPlatform:id.
+                        archClassNames notEmpty ifTrue:[
+                            s nextPutLine:'#ifdef ' , ifdef.
+                            archClassNames do:[:clsName | 
+                                putLineForClassName value:clsName
+                            ].
+                            s nextPutLine:'#endif /* ' , ifdef , ' */'.
+                        ].
+                    ].
+        ]
 
     "
      bosch_dapasx_datenbasis  generateClassLines_libInit_dot_cc
      bosch_dapasx_kernel  generateClassLines_libInit_dot_cc
-     stx_libbasic3 generateClassLines_libInit_dot_cc
-    "
-
+     stx_libbasic3 generateClassLines_libInit_dot_cc"
     "Modified: / 16-08-2006 / 18:52:10 / User"
     "Created: / 19-09-2006 / 22:47:50 / cg"
     "Modified: / 20-09-2006 / 11:47:25 / cg"
@@ -2297,120 +2319,126 @@
     "Modified: / 19-09-2006 / 22:48:14 / cg"
 !
 
-generateDependencies:whichArchitecture
-    ^ String streamContents:[:s |
-        |classNames classesLoaded classesSorted classNamesSorted putDependencyForClass
-         archClassNames archClassesLoaded putSingleClassDependencyEntry putDependencyForExtensions|
-
-        putSingleClassDependencyEntry :=
-            [:cls | |sclsBaseName|
-                s nextPutAll:' $(INCLUDE_TOP)'.                 
-                s nextPutAll:(self pathSeparator:whichArchitecture) asString.
-                sclsBaseName := cls classFilename asFilename withoutSuffix baseName.
-                s nextPutAll:(self topRelativePathTo:sclsBaseName inPackage:cls package architecture:whichArchitecture).
-                s nextPutAll:'.$(H)'.
-            ].
-
-        putDependencyForClass :=
-            [:cls |
-                |clsBaseName already|
-
-                clsBaseName := cls classFilename asFilename withoutSuffix baseName.
-                s nextPutAll:'$(OUTDIR)'.
-                s nextPutAll:clsBaseName.
-                s nextPutAll:'.$(O)'.
-
-                s nextPutAll:' '.
-                s nextPutAll:clsBaseName.
-                s nextPutAll:'.$(H)'.
-
-                s nextPutAll:': '.
-                s nextPutAll:clsBaseName.
-                s nextPutAll:'.st'.
-                already := Set new.
-                cls allSuperclassesDo:[:scls |
-                    putSingleClassDependencyEntry value:scls.
-                    already add:scls.
+generateDependencies:whichArchitecture 
+    ^ String 
+        streamContents:[:s | 
+            |classNames classesLoaded classesSorted classNamesSorted putDependencyForClass archClassNames archClassesLoaded putSingleClassDependencyEntry putDependencyForExtensions|
+
+            putSingleClassDependencyEntry := [:cls | 
+                    |sclsBaseName|
+
+                    s nextPutAll:' $(INCLUDE_TOP)'.
+                    s nextPutAll:(self pathSeparator:whichArchitecture) asString.
+                    sclsBaseName := cls classFilename asFilename withoutSuffix baseName.
+                    s nextPutAll:(self 
+                                topRelativePathTo:sclsBaseName
+                                inPackage:cls package
+                                architecture:whichArchitecture).
+                    s nextPutAll:'.$(H)'.
                 ].
-                cls privateClassesDo:[:eachPrivateClass |
-                    eachPrivateClass allSuperclassesDo:[:scls | |sclsBaseName|
-                        scls ~~ cls ifTrue:[
-                            scls isPrivate ifFalse:[
-                                (already includes:scls) ifFalse:[
-                                    putSingleClassDependencyEntry value:scls.
-                                    already add:scls.
-                                ].
-                            ].
+            putDependencyForClass := [:cls | 
+                    |clsBaseName already|
+
+                    clsBaseName := cls classFilename asFilename withoutSuffix baseName.
+                    s nextPutAll:'$(OUTDIR)'.
+                    s nextPutAll:clsBaseName.
+                    s nextPutAll:'.$(O)'.
+                    s nextPutAll:' '.
+                    s nextPutAll:clsBaseName.
+                    s nextPutAll:'.$(H)'.
+                    s nextPutAll:': '.
+                    s nextPutAll:clsBaseName.
+                    s nextPutAll:'.st'.
+                    already := Set new.
+                    cls 
+                        allSuperclassesDo:[:scls | 
+                            putSingleClassDependencyEntry value:scls.
+                            already add:scls.
                         ].
-                    ]
+                    cls 
+                        privateClassesDo:[:eachPrivateClass | 
+                            eachPrivateClass 
+                                allSuperclassesDo:[:scls | 
+                                    |sclsBaseName|
+
+                                    scls ~~ cls ifTrue:[
+                                        scls isPrivate ifFalse:[
+                                            (already includes:scls) ifFalse:[
+                                                putSingleClassDependencyEntry value:scls.
+                                                already add:scls.
+                                            ].
+                                        ].
+                                    ].
+                                ]
+                        ].
+                    s nextPutAll:' $(STCHDR)'.
+                    s cr.
                 ].
-
-                s nextPutAll:' $(STCHDR)'.                 
-                s cr.
-            ].
-
-        putDependencyForExtensions :=
-            [
-                |already|
-
-                s nextPutAll:'$(OUTDIR)extensions.$(O): extensions.st'.
-
-                already := Set new.
-                self extensionMethodNames pairWiseDo:[:className :selector |
-                    |mthdCls cls|
-
-                    ((mthdCls := Smalltalk classNamed:className) notNil and:[mthdCls isLoaded]) ifTrue:[
-                        cls := mthdCls theNonMetaclass.
-                        (already includes:cls) ifFalse:[
-                            cls allSuperclassesDo:[:scls |
-                                (already includes:scls) ifFalse:[
-                                    putSingleClassDependencyEntry value:scls.
-                                    already add:scls.
-                                ].
-                            ].
+            putDependencyForExtensions := [
+                    |already|
+
+                    s nextPutAll:'$(OUTDIR)extensions.$(O): extensions.st'.
+                    already := Set new.
+                    self extensionMethodNames 
+                        pairWiseDo:[:className :selector | 
+                            |mthdCls cls|
+
+                            ((mthdCls := Smalltalk classNamed:className) notNil 
+                                and:[ mthdCls isLoaded ]) 
+                                    ifTrue:[
+                                        cls := mthdCls theNonMetaclass.
+                                        (already includes:cls) ifFalse:[
+                                            cls 
+                                                allSuperclassesDo:[:scls | 
+                                                    (already includes:scls) ifFalse:[
+                                                        putSingleClassDependencyEntry value:scls.
+                                                        already add:scls.
+                                                    ].
+                                                ].
+                                        ].
+                                    ].
                         ].
+                    s nextPutAll:' $(STCHDR)'.
+                    s cr.
+                ].
+            classNames := self compiled_classNames_common.
+            classesLoaded := classNames 
+                        collect:[:className | 
+                            |cls|
+
+                            cls := Smalltalk classNamed:className
+                        ]
+                        thenSelect:[:cls | cls notNil and:[ cls isLoaded ] ].
+            classesSorted := Class classesSortedByLoadOrder:classesLoaded.
+            classesSorted do:putDependencyForClass.
+            self namesAndAttributesIn:(self additionalClassNamesAndAttributes)
+                do:[:className :attr | 
+                    |cls|
+
+                    (attr isEmptyOrNil or:[ (attr includes:#autoload) not ]) ifTrue:[
+                        ((cls := Smalltalk classNamed:className) notNil and:[ cls isLoaded ]) ifTrue:[
+                            putDependencyForClass value:cls.
+                        ]
                     ].
                 ].
-
-                s nextPutAll:' $(STCHDR)'.                 
-                s cr.
+            archClassNames := self compiled_classNamesForPlatform:whichArchitecture.
+            archClassesLoaded := archClassNames 
+                        collect:[:className | 
+                            |cls|
+
+                            cls := Smalltalk classNamed:className
+                        ]
+                        thenSelect:[:cls | cls notNil and:[ cls isLoaded ] ].
+            archClassesLoaded notEmpty ifTrue:[
+                (Class classesSortedByLoadOrder:archClassesLoaded) 
+                    do:putDependencyForClass.
             ].
-
-        classNames := self common_compiled_classNames.
-        classesLoaded := classNames 
-                    collect:[:className | |cls| cls := Smalltalk classNamed:className]
-                    thenSelect:[:cls |  cls notNil and:[cls isLoaded] ].
-
-        classesSorted := Class classesSortedByLoadOrder:classesLoaded.
-        classesSorted do:putDependencyForClass.
-
-        self namesAndAttributesIn:(self additionalClassNamesAndAttributes) do:[:className :attr |
-            |cls|
-
-            (attr isEmptyOrNil or:[(attr includes:#autoload) not]) ifTrue:[
-                ((cls := Smalltalk classNamed:className) notNil and:[cls isLoaded]) ifTrue:[
-                    putDependencyForClass value:cls.
-                ]
-            ].
-        ].
-
-        archClassNames := self compiled_classNamesForArchitecture:whichArchitecture.    
-        archClassesLoaded := archClassNames 
-                    collect:[:className | |cls| cls := Smalltalk classNamed:className]
-                    thenSelect:[:cls |  cls notNil and:[cls isLoaded] ].
-
-        archClassesLoaded notEmpty ifTrue:[
-            (Class classesSortedByLoadOrder:archClassesLoaded) do:putDependencyForClass.
-        ].
-
-        self hasExtensionMethods ifTrue:putDependencyForExtensions.
-    ]
+            self hasExtensionMethods ifTrue:putDependencyForExtensions.
+        ]
 
     "
      stx_libbasic3 generateDependencies:#unix
-     stx_libbasic3 generateDependencies:#win32
-    "
-
+     stx_libbasic3 generateDependencies:#win32"
     "Modified: / 16-08-2006 / 18:52:10 / User"
     "Created: / 14-09-2006 / 12:38:57 / cg"
     "Modified: / 14-09-2006 / 17:04:21 / cg"
@@ -2629,8 +2657,9 @@
     "Modified: / 09-08-2006 / 18:02:28 / fm"
 !
 
-compiled_classesForArchitecture:arch
-    ^ (self compiled_classNamesForArchitecture:arch) collect:[:eachName| (Smalltalk at:eachName asSymbol)]
+compiled_classesForArchitecture:arch 
+    ^ (self compiled_classNamesForPlatform:arch) 
+        collect:[:eachName | (Smalltalk at:eachName asSymbol) ]
 
     "Created: / 09-08-2006 / 16:28:15 / fm"
     "Modified: / 09-08-2006 / 18:02:28 / fm"
@@ -2713,9 +2742,10 @@
 !
 
 searchForClasses
-
-    ^ (self searchForClassesWithProject: self package) 
-        asOrderedCollection sort:[:a :b | a name < b name]
+    "answer all classes that belong to this project.
+     They are sorted in load order"
+
+    ^ Class classesSortedByLoadOrder:(self searchForClassesWithProject: self package) 
 
     "
      self searchForClasses
@@ -3055,22 +3085,15 @@
 hasAllClassesLoaded
     |checkLoaded|
 
-    checkLoaded := [:nm |
+    checkLoaded := [:eachClassName |
             |cls|
 
-            cls := Smalltalk classNamed:nm.
+            cls := Smalltalk loadedClassNamed:eachClassName.
             (cls isNil or:[cls isLoaded not]) ifTrue:[^ false ].
         ].
+
     self allClassNames do:checkLoaded.
-    OperatingSystem isUNIXlike ifTrue:[
-        self compiled_classNames_unix do:checkLoaded.
-    ] ifFalse:[
-        OperatingSystem isMSWINDOWSlike ifTrue:[
-            self compiled_classNames_windows do:checkLoaded.
-        ] ifFalse:[
-            self error:'unknown OS'
-        ].
-    ].
+    (self compiled_classNamesForPlatform:OperatingSystem platformName) do:checkLoaded.
 
     ^ true.
 
@@ -3095,6 +3118,15 @@
     ^ self extensionMethodNames notEmpty
 
     "Created: / 14-09-2006 / 14:19:35 / cg"
+!
+
+packageDirectory
+    ^ Smalltalk getPackageDirectoryForPackage:self package.
+
+    "
+      self packageDirectory
+      stx_libbasic3 packageDirectory
+    "
 ! !
 
 !ProjectDefinition class methodsFor:'sanity checks'!
@@ -3164,7 +3196,7 @@
 !ProjectDefinition class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.79 2006-09-21 15:36:28 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.80 2006-09-22 15:45:29 stefan Exp $'
 ! !
 
 ProjectDefinition initialize!