more attributes; some preparations for the ProjectBrowser.
authorClaus Gittinger <cg@exept.de>
Tue, 09 Feb 1999 19:55:48 +0100
changeset 3972 efc25c2863e9
parent 3971 aad506cdc5d9
child 3973 7065a27b136b
more attributes; some preparations for the ProjectBrowser.
Project.st
--- a/Project.st	Tue Feb 09 12:26:23 1999 +0100
+++ b/Project.st	Tue Feb 09 19:55:48 1999 +0100
@@ -13,8 +13,9 @@
 Object subclass:#Project
 	instanceVariableNames:'name changeSet views directoryName properties packageName
 		repositoryDirectory repositoryModule defaultNameSpace
-		overwrittenMethods'
-	classVariableNames:'CurrentProject SystemProject NextSequential'
+		overwrittenMethods subProjects prerequisites bitmapFiles
+		documentFiles otherFiles'
+	classVariableNames:'CurrentProject SystemProject NextSequential AllProjects'
 	poolDictionaries:''
 	category:'System-Support'
 !
@@ -77,12 +78,62 @@
 
 !Project class methodsFor:'initialization'!
 
+initKnownProjects
+    "this is a temporary experimental kludge -
+     once the ProjectBrowser is finished, this info is read from
+     '.prj' files ..."
+
+    |stx p|
+
+    stx := self new name:'stx'.
+    stx packageName:'noPackage'.
+    stx changeSet:nil.
+    stx type:#smalltalk.
+    stx comment:'ST/X itself'.
+
+    AllProjects add:stx.
+
+    #(
+        ('libbasic'  'Basic (non-GUI) classes. Required for all applications')
+        ('libbasic2' 'More basic (non-GUI) classes. Required for most applications')
+        ('libbasic3' 'More basic (non-GUI) classes. Required for development')
+        ('libcomp'   'The bytecode compiler. Required for all applications')
+        ('libview'   'Low level GUI classes. Required for all GUI applications')
+        ('libview2'  'Additional low level GUI classes. Required for most GUI applications')
+        ('libwidg'   'Basic widgets. Required for all GUI applications')
+        ('libwidg2'  'More widgets. Required for most GUI applications')
+        ('libwidg3'  'More (fun) widgets. Seldom required')
+        ('libtool'   'Development applications. Required for program development')
+        ('libtool2'  'More development applications. Required for GUI development')
+        ('libui'     'UI spec classes. Required for UIPainter applications')
+        ('libhtml'   'HTML related classes. Required for Web applications and the HTML browser')
+    ) do:[:entry |
+        |libName comment|
+
+        libName := entry at:1.
+        comment := entry at:2.
+
+        p := self new name:libName.
+        p packageName:libName.
+        p type:#library.
+        p comment:comment.
+        stx addSubProject:p.
+    ].
+
+    "
+     self initKnownProjects
+    "
+!
+
 initialize
     SystemProject isNil ifTrue:[
         NextSequential := 1.
         SystemProject := self new name:'default'.
         SystemProject packageName:'private'.
         SystemProject defaultNameSpace:Smalltalk.
+        SystemProject comment:'A default (dummy) project. 
+Will be made the current project in case no real project is ever activated.'.
+
         "
          the SystemProject does not keep a record if changes,
          but instead depends on the changes file - recording anything there.
@@ -91,8 +142,11 @@
     ].
 
     CurrentProject := SystemProject.
+    AllProjects := OrderedCollection with:SystemProject.
+    self initKnownProjects.
 
     "
+     SystemProject := nil.
      Project initialize
     "
 ! !
@@ -139,6 +193,10 @@
     ^ SystemProject.
 !
 
+knownProjects
+    ^ AllProjects ? #()
+!
+
 setDefaultProject
     "set the currently active project to be the SystemDEfault project"
 
@@ -297,6 +355,13 @@
 
 !Project methodsFor:'accessing'!
 
+addSubProject:aProject
+    subProjects isNil ifTrue:[
+        subProjects := OrderedCollection new.
+    ].
+    subProjects add:aProject
+!
+
 changeSet
     "return the set of changes made in this project"
 
@@ -418,6 +483,10 @@
     "Modified: 27.1.1997 / 12:10:09 / cg"
 !
 
+prerequisites
+    ^ prerequisites ? #()
+!
+
 repositoryDirectory
     "return the projects default repository location.
      This is offered initially, when classes are checked into the
@@ -462,6 +531,10 @@
     "Modified: 27.1.1997 / 12:13:57 / cg"
 !
 
+subProjects
+    ^ subProjects ? #()
+!
+
 views
     "return a collection of views which were opened in this project"
 
@@ -521,6 +594,129 @@
     "Modified: 3.1.1997 / 13:24:10 / cg"
 ! !
 
+!Project methodsFor:'load & save'!
+
+loadFromProjectFile:aFilename
+    |f s l|
+
+    f := aFilename asFilename.
+    self directory:(f directory pathName).
+    s := f readStream.
+    self loadFromProjectFileStream:s.
+    s close.
+
+
+    "
+     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
+    "
+!
+
+saveAsProjectFile
+    |fn s|
+
+    fn := self directory asFilename.
+    fn := fn construct:self name.
+    fn := fn withSuffix:'prj'.
+
+    s := fn writeStream.
+    self saveAsProjectFileOn:s.
+    s close.
+
+    "
+     Project current saveAsProjectFile
+    "
+!
+
+saveAsProjectFileOn:aStream
+    |s coll|
+
+    s := aStream.
+
+    s nextPutLine:'[name]'. 
+    s tab. s nextPutLine:(name storeString).
+    s nextPutLine:'[type]'. 
+    s tab. s nextPutLine:(self type storeString).
+    s nextPutLine:'[package]'. 
+    s tab. s nextPutLine:(self packageName storeString).
+
+    coll := self subProjects.
+    coll size > 0 ifTrue:[
+        s nextPutLine:'[subprojects]'. 
+        coll do:[:aSubProject |
+            s tab. s nextPutLine:(aSubProject name soreString).
+        ].
+    ].
+
+    coll := self prerequisites.
+    coll size > 0 ifTrue:[
+        s nextPutLine:'[prerequisites]'. 
+        coll do:[:aProject |
+            s tab. s nextPutLine:(aProject name soreString).
+        ].
+    ].
+
+    coll := self classes.
+    coll size > 0 ifTrue:[
+        s nextPutLine:'[classes]'. 
+        coll do:[:aClass |
+            s tab. s nextPutLine:(aClass name).
+       ]
+    ]
+
+    "
+     Project current saveOn:Transcript
+    "
+! !
+
 !Project methodsFor:'maintenance'!
 
 buildProject
@@ -836,8 +1032,30 @@
     ^ topName
 ! !
 
+!Project methodsFor:'printing & storing'!
+
+displayString
+    ^ super displayString , '(''' , (name ? '<unnamed>') , ''')'
+! !
+
 !Project methodsFor:'properties'!
 
+comment
+    "return the comment of the project"
+
+    properties isNil ifTrue:[^ ''].
+    ^ properties at:#comment ifAbsent:''
+!
+
+comment:aString
+    "set the projects comment"
+
+    properties isNil ifTrue:[
+        properties := IdentityDictionary new
+    ].
+    properties at:#comment put:aString
+!
+
 properties
     ^ properties
 !
@@ -849,15 +1067,19 @@
 type
     "return the type of project"
 
-    ^ properties at:#type ifAbsent:[#application]
+    properties isNil ifTrue:[^ #application].
+    ^ properties at:#type ifAbsent:#application
 !
 
 type:aSymbol
     "set the projects type"
 
     (#(application library smalltalk) includes:aSymbol) ifFalse:[
-	self warn:'invalid project type'.
-	^ self
+        self warn:'invalid project type'.
+        ^ self
+    ].
+    properties isNil ifTrue:[
+        properties := IdentityDictionary new
     ].
     properties at:#type put:aSymbol
 ! !
@@ -1021,6 +1243,6 @@
 !Project class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Project.st,v 1.59 1998-03-07 13:39:10 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Project.st,v 1.60 1999-02-09 18:55:48 cg Exp $'
 ! !
 Project initialize!