care for conditions when generatong loadAll / Make.proto files.
authorClaus Gittinger <cg@exept.de>
Fri, 24 Sep 1999 14:27:07 +0200
changeset 4805 a7e6d2cb9b29
parent 4804 531640dcad3e
child 4806 1b48e7420cfe
care for conditions when generatong loadAll / Make.proto files.
Project.st
--- a/Project.st	Fri Sep 24 13:29:29 1999 +0200
+++ b/Project.st	Fri Sep 24 14:27:07 1999 +0200
@@ -867,54 +867,84 @@
 
 !Project methodsFor:'load & save'!
 
+conditionForAutoloadIsTrue:cond
+    "check condition ..."
+
+    ^ cond == #autoload 
+!
+
+conditionForInclusionIsTrue:cond
+    "check condition ..."
+
+    cond == #always ifTrue:[^ true].
+    cond == #autoload ifTrue:[^ true].
+    cond == #never ifTrue:[^ false].
+
+    cond == #unix ifTrue:[
+        ^ OperatingSystem isUNIXlike
+    ].
+    cond == #win32 ifTrue:[
+        ^ OperatingSystem isMSWINDOWSlike
+    ].
+    cond == #vms ifTrue:[
+        ^ OperatingSystem isVMSlike
+    ].
+    cond == #macos ifTrue:[
+        ^ OperatingSystem isMAClike
+    ].
+    self halt:'bad condition'
+!
+
 loadClassesFromProjectDirectory
     "load my classes into the system.
      The classes are loaded from the directory as defined by my
      directory insTvar"
 
-    |myDirectory|
+    |myDirectory firstTrip|
 
     myDirectory := self directory asFilename.
-
-    self classInfo do:[:clsInfo |
-        |clsName clsFileNameString cls clsFilename|
-
-        clsName := clsInfo className.
-        clsFileNameString := clsInfo classFileName.
-        clsFileNameString isNil ifTrue:[clsFileNameString := clsName , '.st'].
-
-        clsName isSymbol ifTrue:[
-            clsFilename := myDirectory construct:clsFileNameString.
-            cls := Smalltalk at:clsName.
-            cls isNil ifTrue:[
-                "/ ok - really not yet loaded.
-                Transcript showCR:'loading ' , clsFilename pathName , ' ...'.
+    firstTrip := true.
+
+    "/ read twice; if the load order was not correct,
+    "/ this will fix things (i.e. nil superclasses ...)
+
+    2 timesRepeat:[
+        self classInfo do:[:clsInfo |
+            |clsName clsFileNameString cls clsFilename 
+             cond include asAutoload|
+
+            clsName := clsInfo className.
+            clsFileNameString := clsInfo classFileName.
+            clsFileNameString isNil ifTrue:[clsFileNameString := clsName , '.st'].
+
+            clsName isSymbol ifTrue:[
+                clsFilename := myDirectory construct:clsFileNameString.
+                cls := Smalltalk at:clsName.
+                (cls isNil or:[firstTrip]) ifTrue:[
+                    "/ ok - really not yet loaded.
+                    Transcript showCR:'loading ' , clsFilename pathName , ' ...'.
+                ] ifFalse:[
+                    Transcript showCR:'reloading ' , clsFilename pathName , ' ...'.
+                ].
+                "/ check condition ...
+                cond := clsInfo conditionForInclusion.
+                (self conditionForInclusionIsTrue:cond) ifTrue:[
+                    (self conditionForAutoloadIsTrue:cond) ifTrue:[
+                        Smalltalk
+                            installAutoloadedClassNamed:clsName
+                            category:'autoloaded'
+                            package:self package    
+                            revision:nil
+                    ] ifFalse:[
+                        Smalltalk fileIn:clsFilename
+                    ]
+                ]
             ] ifFalse:[
-                Transcript showCR:'reloading ' , clsFilename pathName , ' ...'.
+                self halt
             ].
-            Smalltalk fileIn:clsFilename
-        ] ifFalse:[
-            self halt
         ].
-    ].
-
-    "/ read again; if the load order was not correct,
-    "/ this will fix things (i.e. nil superclasses ...)
-
-    self classInfo do:[:clsInfo |
-        |clsName clsFileNameString clsFilename|
-
-        clsName := clsInfo className.
-        clsFileNameString := clsInfo classFileName.
-        clsFileNameString isNil ifTrue:[clsFileNameString := clsName , '.st'].
-
-        clsName isSymbol ifTrue:[
-            clsFilename := myDirectory construct:clsFileNameString.
-            Transcript showCR:'reloading ' , clsFilename pathName , ' ...'.
-            Smalltalk fileIn:clsFilename
-        ] ifFalse:[
-            self halt
-        ].
+
+        firstTrip := false.
     ].
 
 !
@@ -985,7 +1015,11 @@
     ].
 
     "/ fetch class info
-
+    "/
+    "/ each entry consist of:
+    "/    full-name-of-class
+    "/    condition (optional)  - #unix / #win32 / #vms / #macos / #always / #never / #autoload
+    "/    fileName (optional)
     (pack at:'classes' default:#()) do:[:info |
         |condKey className optionalFileName|
 
@@ -1469,10 +1503,16 @@
 '.
 
     classes do:[:cls |
-         out nextPutAll:'  '''.
-         cls nameWithoutNameSpacePrefix printOn:out.
-         out nextPutAll:'.st'''.
-         out cr.
+        |clsInfo cond|
+
+        clsInfo := self classInfoFor:cls.
+        cond := clsInfo conditionForInclusion.
+        (cond == #always or:[cond == #autoload]) ifTrue:[
+            out nextPutAll:'  '''.
+            cls nameWithoutNameSpacePrefix printOn:out.
+            out nextPutAll:'.st'''.
+            out cr.
+        ]
     ].
     (methodsFile := self propertyAt:#methodsFile) size > 0 ifTrue:[
          out 
@@ -1764,11 +1804,25 @@
     s nextPutAll:'OBJS='.
 
     classes do:[:aClass |
-        |abbrev|
-
-        s nextPutAll:' \'. s cr.
-        abbrev := Smalltalk fileNameForClass:aClass name.
-        s nextPutAll:'  '; nextPutAll:abbrev; nextPutAll:'.$(O)'.
+        |abbrev clsInfo cond include|
+
+        clsInfo := self classInfoFor:aClass.
+        include := true.
+        clsInfo notNil ifTrue:[
+            cond := clsInfo conditionForInclusion.
+            (self conditionForInclusionIsTrue:cond) ifFalse:[
+                include := false.
+            ] ifTrue:[
+                (self conditionForAutoloadIsTrue:cond) ifTrue:[
+                    include := false
+                ]
+            ].
+        ].
+        include ifTrue:[
+            s nextPutAll:' \'. s cr.
+            abbrev := Smalltalk fileNameForClass:aClass name.
+            s nextPutAll:'  '; nextPutAll:abbrev; nextPutAll:'.$(O)'.
+        ]
     ].
     (methodsFile := self propertyAt:#methodsFile) size > 0 ifTrue:[
          s nextPutAll:' \'. s cr.
@@ -2684,6 +2738,6 @@
 !Project class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Project.st,v 1.107 1999-09-23 17:55:34 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Project.st,v 1.108 1999-09-24 12:27:07 cg Exp $'
 ! !
 Project initialize!