more support for projectBrowser
authorClaus Gittinger <cg@exept.de>
Mon, 22 Feb 1999 22:06:24 +0100
changeset 3996 3183ccccabaa
parent 3995 777470826394
child 3997 2d127c83b65d
more support for projectBrowser
Project.st
--- a/Project.st	Mon Feb 22 21:40:34 1999 +0100
+++ b/Project.st	Mon Feb 22 22:06:24 1999 +0100
@@ -20,6 +20,13 @@
 	category:'System-Support'
 !
 
+Object subclass:#ClassInfo
+	instanceVariableNames:'conditionForInclusion className classFileName'
+	classVariableNames:''
+	poolDictionaries:''
+	privateIn:Project
+!
+
 !Project class methodsFor:'documentation'!
 
 copyright
@@ -601,66 +608,62 @@
 !Project methodsFor:'load & save'!
 
 loadFromProjectFile:aFilename
-    |f s l|
+    |f l pack targetConditions s|
 
     f := aFilename asFilename.
+    directoryName := f directory pathName.
     self directory:(f directory pathName).
-    s := f readStream.
-    self loadFromProjectFileStream:s.
-    s close.
+    pack := ResourcePack fromFile:f baseName directory:directoryName.
+
+    "/ convert the resourcePack ...
+
+    packageName := pack at:'package' ifAbsent:packageName.
+    name := pack at:'name' ifAbsent:name.
+    repositoryModule := pack at:'repository.module' ifAbsent:repositoryModule.
+    repositoryDirectory := pack at:'repository.directory' ifAbsent:repositoryDirectory.
+    subProjects := pack at:'subProjects' ifAbsent:subProjects.
+    (s := pack at:'comment' ifAbsent:nil) notNil ifTrue:[
+        self comment:s
+    ].
+
+    "/ first, all of the conditions ...
+    targetConditions := Dictionary new.
+    pack keysAndValuesDo:[:key :val |
+        |conditionKey|
 
+        (key startsWith:'target.condition.') ifTrue:[
+            conditionKey := key copyFrom:'target.condition.' size + 1.
+            targetConditions at:conditionKey put:val.
+        ]
+    ].
+
+    properties isNil ifTrue:[
+        properties := IdentityDictionary new
+    ].
+    properties at:'targetconditions' put:targetConditions.
+
+    "/ fetch class info
+
+    (pack at:'classes') do:[:info |
+        |condKey className optionalFileName|
+
+        condKey := info at:1.
+        className := info at:2.
+        info size > 2 ifTrue:[
+            optionalFileName := info at:3.
+        ].
+        self 
+            addClass:className 
+            conditionForInclusion:condKey 
+            classFileName:optionalFileName
+    ].
 
     "
      Project current saveAsProjectFile.
 
      Project new loadFromProjectFile:'default.prj'
-    "
-!
 
-loadFromProjectFileStream:aStream
-    |s l|
-
-    s := aStream.
-    l := s nextLine.
-    [s atEnd] whileFalse:[
-        (l startsWith:';') ifTrue:[
-            l := s nextLine.
-        ] ifFalse:[
-            l asLowercase = '[name]' ifTrue:[
-                l := s nextLine.
-                name := Object readFromString:l.
-                l := s nextLine.
-            ] ifFalse:[l asLowercase = '[type]' ifTrue:[
-                l := s nextLine.
-                self type:(Object readFromString:l).
-                l := s nextLine.
-            ] ifFalse:[l asLowercase = '[subprojects]' ifTrue:[
-                l := s nextLine.
-                [l notNil and:[(l startsWith:'[') not]] whileTrue:[
-                    l := s nextLine.
-                ].
-            ] ifFalse:[l asLowercase = '[prerequisites]' ifTrue:[
-                l := s nextLine.
-                [l notNil and:[(l startsWith:'[') not]] whileTrue:[
-                    l := s nextLine.
-                ].
-            ] ifFalse:[l asLowercase = '[classes]' ifTrue:[
-                l := s nextLine.
-                [l notNil and:[(l startsWith:'[') not]] whileTrue:[
-                    l := s nextLine.
-                ].
-            ] ifFalse:[l asLowercase = '[package]' ifTrue:[
-                l := s nextLine.
-                self packageName:(Object readFromString:l).
-                l := s nextLine.
-            ] ifFalse:[
-                self halt.
-            ]]]]]]
-        ]
-    ].
-
-    "
-     Project current saveOn:Transcript
+     Project new loadFromProjectFile:'../../libbasic/libbasic.prj'
     "
 !
 
@@ -1044,6 +1047,39 @@
 
 !Project methodsFor:'properties'!
 
+addClass:className conditionForInclusion:conditionBlock classFileName:fileName
+    "return the class info of the project"
+
+    |i|
+
+    i := ClassInfo new.
+    i className:className.
+    i classFileName:fileName.
+    i conditionForInclusion:conditionBlock.
+    self addClassInfo:i
+!
+
+addClassInfo:info
+    "add a class info to the project"
+
+    |infoCollection|
+
+    (infoCollection := self classInfo) isNil ifTrue:[
+        self classInfo:(infoCollection := OrderedCollection new).
+    ].
+    infoCollection add:info
+!
+
+classInfo:aClassInfoCollection
+    "set the class info of the project"
+
+    properties isNil ifTrue:[
+        properties := IdentityDictionary new
+    ].
+    properties at:#classInfo put:aClassInfoCollection
+
+!
+
 comment
     "return the comment of the project"
 
@@ -1060,6 +1096,22 @@
     properties at:#comment put:aString
 !
 
+documentationURL
+    "return the documentation-URL of the project"
+
+    properties isNil ifTrue:[^ nil].
+    ^ properties at:#documentationURL ifAbsent:nil
+!
+
+documentationURL:anURLString
+    "set the projects documentation-URL"
+
+    properties isNil ifTrue:[
+        properties := IdentityDictionary new
+    ].
+    properties at:#documentationURL put:anURLString
+!
+
 properties
     ^ properties
 !
@@ -1090,12 +1142,44 @@
 
 !Project methodsFor:'queries'!
 
+classInfo
+    "return a classInfo collection of classes belonging to that project"
+
+    |classes classInfo|
+
+    properties notNil ifTrue:[
+        classInfo := properties at:#classInfo ifAbsent:nil.
+        classInfo notNil ifTrue:[^ classInfo].
+    ].
+
+    ^ (self classes ? #()) collect:[:class |
+        |i fn|
+
+        i := ClassInfo new.
+        i conditionForInclusion:#always.
+        i className:class name.
+        fn := class classFilename ? ((Smalltalk fileNameForClass:class) , '.st').
+        i classFileName:fn.
+        i
+    ]
+
+    "Modified: 4.1.1997 / 16:51:18 / cg"
+!
+
 classes
     "return a collection of classes belonging to that project"
 
-    |classes|
+    |classes classInfo|
 
-    properties notNil ifTrue:[classes := properties at:#classes ifAbsent:nil].
+    properties notNil ifTrue:[
+        classInfo := properties at:#classInfo ifAbsent:nil.
+        classInfo notNil ifTrue:[
+            classes := classInfo collect:[:i | i className]
+        ] ifFalse:[
+            classes := properties at:#classes ifAbsent:nil
+        ]
+    ].
+
     classes isNil ifTrue:[
         classes := OrderedCollection new.
         Smalltalk 
@@ -1226,7 +1310,9 @@
 removeView:aView
     "remove a view from this projects set of views"
 
-    views notNil ifTrue:[views remove:aView ifAbsent:[]]
+    views notNil ifTrue:[
+        views remove:aView ifAbsent:nil
+    ]
 
     "Modified: 14.2.1997 / 15:37:20 / cg"
 !
@@ -1244,9 +1330,41 @@
     "Modified: 14.2.1997 / 15:38:47 / cg"
 ! !
 
+!Project::ClassInfo methodsFor:'accessing'!
+
+classFileName
+    "return the value of the instance variable 'classFileName' (automatically generated)"
+
+    ^ classFileName!
+
+classFileName:something
+    "set the value of the instance variable 'classFileName' (automatically generated)"
+
+    classFileName := something.!
+
+className
+    "return the value of the instance variable 'className' (automatically generated)"
+
+    ^ className!
+
+className:something
+    "set the value of the instance variable 'className' (automatically generated)"
+
+    className := something.!
+
+conditionForInclusion
+    "return the value of the instance variable 'conditionForInclusion' (automatically generated)"
+
+    ^ conditionForInclusion!
+
+conditionForInclusion:something
+    "set the value of the instance variable 'conditionForInclusion' (automatically generated)"
+
+    conditionForInclusion := something.! !
+
 !Project class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Project.st,v 1.62 1999-02-09 19:21:13 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Project.st,v 1.63 1999-02-22 21:06:24 cg Exp $'
 ! !
 Project initialize!