Project.st
author Claus Gittinger <cg@exept.de>
Wed, 15 Sep 1999 09:04:48 +0200
changeset 4727 ec580e5f9b22
parent 4726 5c5e1c7f8933
child 4743 11f9e45976cb
permissions -rw-r--r--
checkin from browser

"
 COPYRIGHT (c) 1993 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"

Object subclass:#Project
	instanceVariableNames:'name changeSet views directoryName properties packageName
		repositoryDirectory repositoryModule overwrittenMethods
		subProjects prerequisites isLoaded'
	classVariableNames:'CurrentProject SystemProject NextSequential AllProjects
		LoadedProjects'
	poolDictionaries:''
	category:'System-Support'
!

Object subclass:#ClassInfo
	instanceVariableNames:'conditionForInclusion className classFileName'
	classVariableNames:''
	poolDictionaries:''
	privateIn:Project
!

Object subclass:#MethodInfo
	instanceVariableNames:'methodName className fileName'
	classVariableNames:''
	poolDictionaries:''
	privateIn:Project
!

!Project class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1993 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
!

documentation
"
    this class is still under construction (especially the build features are unfinished).
    Currently, all it does is keep track of per-project views 
    (to hide or show them), define the directory when filing-out,
    and define packageNames for new classes and methods.

    instance variables:
        name            <String>        the name of this project, as shown
                                        in a ProjectView

        changeSet       <ChangeSet>     changes done, while this was the active project

        views           <Collection>    views opened while this was the active project

        directoryName   <String>        directory name, where fileOuts are done

        properties 

        packageName     <String>        given to classes/methods which are created while
                                        this is the active project

        repositoryDirectory             (default) name of the repository, when a new source containers are
                                        created.

        repositoryModule                (default) name of the module, when new source containers are
                                        created.

    Future: 
        - keep track of per-project changes
        - allow speficiation of the type of the project (application or library)
        - allow building of whatever the target (as defined by the type) is
          (this will allow build of class libs and apps by clicking a button)
        - allow removal of project specific classes, methods etc.

    [author:]
        Claus Gittinger
"
! !

!Project class methodsFor:'initialization'!

initKnownProjects
    "this is a temporary experimental kludge -
     once the ProjectBrowser is finished, this info is read from
     '.prj' files ..."

    "/ collect project info while scanning all classes
    "/ and methods ...

    |packages anyUnloaded|

    packages := IdentitySet new.

    AllProjects isNil ifTrue:[
        AllProjects := OrderedCollection new.
    ] ifFalse:[
        AllProjects do:[:p | packages add:p package asSymbol].
    ].
    Smalltalk allClassesDo:[:aClass |
        |packageID prj classFilename pkgInfo revInfo 
         repositoryPath dir module lib nm|

        aClass isMeta ifFalse:[
            (aClass isNamespace not or:[aClass == Smalltalk]) ifTrue:[
                packageID := aClass package asSymbol.
                (packages includes:packageID) ifFalse:[
                    packages add:packageID.

                    "/ a new one ...

                    prj := self new.
                    prj package:packageID.
                    prj directory:'???'.
                    prj repositoryModule:'unknown'.
                    prj repositoryDirectory:'unknown'.

                    nm := 'unknown'.

                    pkgInfo := aClass packageSourceCodeInfo.
                    pkgInfo notNil ifTrue:[
                        module := pkgInfo at:#module ifAbsent:nil.
                        module notNil ifTrue:[
                            prj repositoryModule:module    
                        ].
                        dir := pkgInfo at:#directory ifAbsent:nil.
                        dir notNil ifTrue:[
                            prj directory:dir    
                        ].
                        lib := pkgInfo at:#library ifAbsent:nil.
                        lib notNil ifTrue:[
                            prj type:#library.
                        ].
                        prj isLoaded:true.
                    ].

                    nm := (module ? 'unknown')
                          , ':'
                          , (dir ? (lib ? 'unknown')).
                        
                    prj name:nm.
                    AllProjects add:prj.
                ].
            ].
        ].
    ].
    Method allSubInstancesDo:[:aMethod |
        |packageID prj who mthdClass|

        packageID := aMethod package asSymbol.
        (packages includes:packageID) ifFalse:[
            who := aMethod who.
            who notNil ifTrue:[ "/ skip unbound methods ...
                packages add:packageID.

                "/ a new one ...
                prj := self new.
        "/            prj name:libName.
                prj package:packageID.
                prj type:#library.
                prj directory:'???'.
                prj repositoryModule:'stx'.
                prj repositoryDirectory:'???'.
                prj isLoaded:true.
                AllProjects add:prj.
            ]
        ]
    ].
    self changed:#allProjects

"/    |stx p|
"/
"/    stx := self new name:'stx'.
"/    stx packageName:'noPackage'.
"/    stx changeSet:nil.
"/    stx type:#smalltalk.
"/    stx comment:'The ST/X project itself'.
"/
"/    AllProjects add:stx.
"/
"/    #(
"/        ('libbasic'      #'stx:libbasic'            'Basic (non-GUI) classes. Required for all applications')
"/        ('libbasic2'     #'stx:libbasic2'           'More basic (non-GUI) classes. Required for most applications')
"/        ('libbasic3'     #'stx:libbasic3'           'More basic (non-GUI) classes. Required for development')
"/        ('libcomp'       #'stx:libcomp'             'The bytecode compiler. Required for all applications')
"/        ('libview'       #'stx:libview'             'Low level GUI classes. Required for all GUI applications')
"/        ('libview2'      #'stx:libview2'            'Additional low level GUI classes. Required for most GUI applications')
"/        ('libwidg'       #'stx:libwidg'             'Basic widgets. Required for all GUI applications')
"/        ('libwidg2'      #'stx:libwidg2'            'More widgets. Required for most GUI applications')
"/        ('libwidg3'      #'stx:libwidg3'            'More (fun) widgets. Seldom required')
"/        ('libtool'       #'stx:libtool'             'Development applications. Required for program development')
"/        ('libtool2'      #'stx:libtool2'            'More development applications. Required for GUI development')
"/        ('libui'         #'stx:libui'               'UI spec classes. Required for UIPainter applications')
"/        ('libhtml'       #'stx:libhtml'             'HTML related classes. Required for Web applications and the HTML browser')
"/        ('libodbc'       #'stx:libodbc'             'ODBC interface classes.')
"/        ('libopengl'     #'stx:libopengl'           'OpenGL interface classes.')
"/        ('persistency'   #'stx:goodies/persistency' 'Simple DB interface')
"/        ('goodies'       #'stx:goodies'             'Misc goodies - not really maintained')
"/    ) do:[:entry |
"/        |libName package comment|
"/
"/        libName := entry at:1.
"/        package := entry at:2.
"/        comment := entry at:3.
"/
"/        p := self new name:libName.
"/        p packageName:package.
"/        p type:#library.
"/        p comment:comment.
"/        stx addSubProject:p.
"/    ].

    "
     AllProjects := nil.
     self initKnownProjects
    "

    "Modified: / 23.3.1999 / 14:20:12 / cg"
!

initialize
    SystemProject isNil ifTrue:[
        NextSequential := 1.
        SystemProject := self new name:'default'.
        SystemProject package:'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.
        "
        SystemProject changeSet:nil.
    ].

    CurrentProject := SystemProject.
    AllProjects := nil.
"/ now done lazy ...
"/    self initKnownProjects.

    "
     SystemProject := nil.
     Project initialize
    "
! !

!Project class methodsFor:'instance creation'!

new
    ^ self basicNew initialize
! !

!Project class methodsFor:'accessing'!

addKnownProject:aProject
    |allProjects|

    allProjects := self knownProjects.
    (allProjects detect:[:p | p package = aProject package] ifNone:nil) notNil ifTrue:[
        self warn:'Project for ' , aProject package , ' is already present.'.
        ^ self.
    ].

    AllProjects add:aProject.
    self changed:#allProjects
!

addLoadedProject:aProject
    aProject isLoaded:true.
    self addKnownProject:aProject.
!

current
    "return the currently active project"

    ^ CurrentProject

    "
     Project current
    "
!

current:aProject
    "set the currently active project"

    CurrentProject := aProject.
    self changed:#currentProject
!

currentPackageName
    CurrentProject notNil ifTrue:[
        ^ CurrentProject package
    ].
    ^ nil

    "
     Project currentPackageName
    "
!

defaultProject
    "return the SystemDefault project"

    ^ SystemProject.
!

knownProjects
    AllProjects isNil ifTrue:[
        self initKnownProjects
    ].
    ^ AllProjects ? #()
!

loadedProjects
    ^ self knownProjects select:[:p | p isLoaded]
!

projectNamed:aProjectName
    "retrieve the named project; return nil if not known"

    ^ self knownProjects detect:[:p | p name = aProjectName] ifNone:nil.

    "
     Project projectNamed:'libbasic'
    "
!

projectWithId:aPackageId
    "retrieve the project with a particular id; return nil if not known"

    ^ self knownProjects detect:[:p | p package = aPackageId] ifNone:nil.

    "
     Project projectWithId:#'stx:libbasic'
    "
!

setDefaultProject
    "set the currently active project to be the SystemDEfault project"

    self current:SystemProject.
!

setProject:aProjectOrNil
    "set the currently active project without updating others"

    CurrentProject := aProjectOrNil.

    "Created: 7.2.1996 / 14:00:45 / cg"
    "Modified: 7.2.1996 / 14:01:16 / cg"
! !

!Project class methodsFor:'changes management'!

addClassDefinitionChangeFor:aClass
    "add a class-def-change for aClass to the current project"

    |p c|

    p := CurrentProject.
    (p notNil 
    and:[(c := p changeSet) notNil]) ifTrue:[
	c addClassDefinitionChangeFor:aClass 
    ]

    "Created: 3.12.1995 / 13:44:58 / cg"
    "Modified: 3.12.1995 / 13:58:04 / cg"
!

addMethodCategoryChange:aMethod category:newCategory in:aClass
    "add a method-category-change for aMethod in aClass to the current project"

    |p c|

    p := CurrentProject.
    (p notNil 
    and:[(c := p changeSet) notNil]) ifTrue:[
	c addMethodCategoryChange:aMethod category:newCategory in:aClass 
    ]
!

addMethodChange:aMethod in:aClass
    "add a method change in aClass to the current project"

    |p c|

    p := CurrentProject.
    (p notNil 
    and:[(c := p changeSet) notNil]) ifTrue:[
	c addMethodChange:aMethod in:aClass 
    ]
!

addMethodPrivacyChange:aMethod in:aClass
    "add a privacy change for aMethod in aClass to the current project"

    |p c|

    p := CurrentProject.
    (p notNil 
    and:[(c := p changeSet) notNil]) ifTrue:[
	c addMethodPrivacyChange:aMethod in:aClass 
    ]

    "Modified: 27.8.1995 / 22:48:17 / claus"
!

addPrimitiveDefinitionsChangeFor:aClass
    "add a primitiveDef change for aClass to the current project"

    |p c|

    p := CurrentProject.
    (p notNil 
    and:[(c := p changeSet) notNil]) ifTrue:[
	c addPrimitiveDefinitionsChangeFor:aClass 
    ]
!

addPrimitiveFunctionsChangeFor:aClass
    "add a primitiveFuncs change for aClass to the current project"

    |p c|

    p := CurrentProject.
    (p notNil 
    and:[(c := p changeSet) notNil]) ifTrue:[
	c addPrimitiveFunctionsChangeFor:aClass 
    ]
!

addPrimitiveVariablesChangeFor:aClass
    "add a primitiveVars change for aClass to the current project"

    |p c|

    p := CurrentProject.
    (p notNil 
    and:[(c := p changeSet) notNil]) ifTrue:[
	c addPrimitiveVariablesChangeFor:aClass 
    ]
!

addRemoveSelectorChange:aSelector in:aClass
    "add a method-remove change in aClass to the current project"

    |p c|

    p := CurrentProject.
    (p notNil 
    and:[(c := p changeSet) notNil]) ifTrue:[
        c addRemoveSelectorChange:aSelector in:aClass 
    ]

    "Created: / 16.2.1998 / 12:45:10 / cg"
!

currentProjectDirectory
    "return the name of the directory to use for fileOut.
     The returned name already includes a file-separator at the end, 
     so the filename can be concatenated to it."

    |p dirName|

    p := CurrentProject.
    p notNil ifTrue:[
        dirName := p directory  
    ] ifFalse:[
        dirName := Filename currentDirectory name
    ].
    ^ dirName

    "Modified: 7.9.1997 / 23:52:25 / cg"
!

rememberOverwrittenMethod:newMethod from:oldMethod
    "remember a method (from another package) being overwritten.
     This is only remembered, if the current project is not the
     system project (to avoid filling this remembered-table)"

    |p|

    p := CurrentProject.
    (p notNil 
    and:[p ~~ SystemProject]) ifTrue:[
        p rememberOverwrittenMethod:newMethod from:oldMethod
    ] ifFalse:[
"/        'Project [info]: DefaultProject does not remember overwritten methods' infoPrintCR
    ]

    "Modified: / 7.3.1998 / 13:38:39 / cg"
! !

!Project methodsFor:'accessing'!

addSubProject:aProject
    "add a subproject - obsolete; we use prerequisites now"

    subProjects isNil ifTrue:[
        subProjects := OrderedCollection new.
    ].
    subProjects add:aProject
!

changeSet
    "return the set of changes made in this project"

    ^ changeSet

    "Modified: 27.1.1997 / 11:58:36 / cg"
!

changeSet:aChangeSet
    "set the set of changes made in this project - dangerous, you may loose
     the actual changeSet."

    changeSet := aChangeSet

    "Modified: 27.1.1997 / 11:59:02 / cg"
!

defaultNameSpace
    "return the defaultNameSpace of this project.
     New classes will (if not specified by a directive) be installed
     in this nameSpace. Useful, when filing in ST-80 code, to avoid
     overwriting of standard classes."

    ^ (self propertyAt:#defaultNameSpace) ? Smalltalk

!

defaultNameSpace:aNamespace
    "set the defaultNameSpace of this project.
     New classes will (if not specified by a directive) be installed
     in this nameSpace. Useful, when filing in ST-80 code, to avoid
     overwriting of standard classes."

    |prevDefault|

    prevDefault := self defaultNameSpace.
    aNamespace ~~ prevDefault ifTrue:[
        self propertyAt:#defaultNameSpace put:aNamespace.
        self changed:#defaultNameSpace.
        self == CurrentProject ifTrue:[
            Project changed:#defaultNameSpace 
        ]
    ]

    "Created: 2.1.1997 / 19:54:37 / cg"
    "Modified: 27.1.1997 / 12:00:01 / cg"
!

directory
    "return the projects directory.
     If not specified, a fileOut will be done into that directory"

    directoryName isNil ifTrue:[^ '.'].
    ^ directoryName

    "Modified: 27.1.1997 / 12:00:41 / cg"
!

directory:aDirectoryName
    "set the projects directory.
     If not specified, a fileOut will be done into that directory"

    directoryName := aDirectoryName.
    self changed:#directory.
    self == CurrentProject ifTrue:[
        Project changed:#directory 
    ]

    "Modified: 27.1.1997 / 12:00:47 / cg"
!

isLoaded:aBoolean
    isLoaded := aBoolean
!

name
    "return the projects name.
     This is for the user only - shown in the projectViews label"

    ^ name

    "Modified: 27.1.1997 / 12:01:16 / cg"
!

name:aString
    "set the projects name.
     This is for the user only - shown in the projectViews label"

    name := aString.
    self changed:#name.
    self == CurrentProject ifTrue:[
        Project changed:#name
    ]

    "Modified: 27.1.1997 / 12:01:09 / cg"
!

overwrittenMethods
    "return the set of methods which were overwritten in this project.
     This information allows uninstalling, by switching back to the
     original methods."

    ^ overwrittenMethods

    "Created: 27.1.1997 / 11:57:21 / cg"
    "Modified: 27.1.1997 / 12:09:14 / cg"
!

package
    "return the projects package identifier.
     This identifier marks all methods and new classes which were created
     in this project."

    ^ packageName

    "Modified: 27.1.1997 / 12:10:00 / cg"
!

package:aPackageId
    "set the projects package identifier.
     This identifier marks all methods and new classes which were created
     in this project."

    packageName := aPackageId

    "Modified: 27.1.1997 / 12:10:00 / cg"
!

packageName:aPackageId
    "set the projects package identifier.
     This identifier marks all methods and new classes which were created
     in this project."

    self package:aPackageId

    "Modified: 27.1.1997 / 12:10:00 / cg"
!

prerequisiteClasses
    "return the prerequisiteClasses of the project"

    ^ (self propertyAt:#prerequisiteClasses) ? #()
!

prerequisiteClasses:aCollectionOfClassesOrClassNames
    "set the prerequisiteClasses of the project"

    ^ self propertyAt:#prerequisiteClasses put:aCollectionOfClassesOrClassNames

    "Modified: / 26.4.1999 / 23:33:44 / cg"
!

prerequisitePackages
    "return the prerequisitePackages of the project"

    ^ self prerequisites

    "Created: / 26.4.1999 / 23:33:22 / cg"
!

prerequisitePackages:aCollectionOfPackagesOrPackageNames
    "set the prerequisitePackages of the project"

    ^ self prerequisites:aCollectionOfPackagesOrPackageNames

    "Modified: / 26.4.1999 / 23:34:40 / cg"
!

prerequisites
    "return the prerequisites of the project"

    ^ prerequisites ? #()
!

prerequisites:aCollectionOfProjects
    "set the prerequisites of the project"

    prerequisites := aCollectionOfProjects
!

repositoryDirectory
    "return the projects default repository location.
     This is offered initially, when classes are checked into the
     source repository initially"

    ^ repositoryDirectory

    "Created: 25.11.1995 / 18:04:51 / cg"
    "Modified: 27.1.1997 / 12:13:35 / cg"
!

repositoryDirectory:aRelativePathName
    "set the projects default repository location.
     This will be offered initially, when classes are checked into the
     source repository initially"

    repositoryDirectory := aRelativePathName

    "Created: 25.11.1995 / 18:05:06 / cg"
    "Modified: 27.1.1997 / 12:13:28 / cg"
!

repositoryModule
    "return the projects default repository module name.
     This is offered initially, when classes are checked into the
     source repository initially"

    ^ repositoryModule

    "Created: 25.11.1995 / 18:04:51 / cg"
    "Modified: 27.1.1997 / 12:13:50 / cg"
!

repositoryModule:aString
    "set the projects default repository module name.
     This is offered initially, when classes are checked into the
     source repository initially"

    repositoryModule := aString

    "Created: 25.11.1995 / 18:05:06 / cg"
    "Modified: 27.1.1997 / 12:13:57 / cg"
!

subProjects
    "return the subprojects - obsolete; we use prerequisites now"

    ^ subProjects ? #()
!

views
    "return a collection of views which were opened in this project"

    ^ views asArray

    "Modified: 27.1.1997 / 12:14:18 / cg"
!

views:aSetOfViews
    "set the collection of views which were opened in this project"

    views := WeakIdentitySet withAll:aSetOfViews

    "Modified: 27.1.1997 / 12:14:26 / cg"
! !

!Project methodsFor:'administration'!

removeClassesFromSystem
    "remove the all of my classes & patches from the system"

    self classInfo do:[:clsInfo |
        |clsName cls|

        clsName := clsInfo className.
        clsName isSymbol ifTrue:[
            cls := Smalltalk at:clsName.
            cls notNil ifTrue:[
                cls removeFromSystem.
            ].
        ] ifFalse:[
            self halt
        ].
    ].

!

removeFromSystem
    "remove the project and all of its classes & patches from the
     system"

    self removeClassesFromSystem.
    AllProjects remove:self ifAbsent:nil.
! !

!Project methodsFor:'changes'!

rememberOverwrittenMethod:newMethod from:oldMethod
    "this is sent whenever a method is installed, which overwrites
     an existing method from a different package.
     Allows previous methods to be reconstructed."

    overwrittenMethods isNil ifTrue:[
        overwrittenMethods := IdentityDictionary new.
    ].
    overwrittenMethods at:newMethod put:oldMethod

    "Created: 27.1.1997 / 11:52:01 / cg"
    "Modified: 30.1.1997 / 21:10:51 / cg"
! !

!Project methodsFor:'initialization'!

initialize
    |numString|

    views := WeakIdentitySet new.
    numString := NextSequential printString.
    NextSequential := NextSequential + 1.

    name := 'new Project-' , numString.
    packageName := 'private-' , numString.

    "/
    "/ for tiny-configurations, allow ChangeSet to be absent
    "/
    ChangeSet notNil ifTrue:[
        changeSet := ChangeSet new.
    ].
    self directory:'.'.
    self repositoryModule:(OperatingSystem getLoginName).
    self repositoryDirectory:'private'

    "Created: 25.11.1995 / 18:05:44 / cg"
    "Modified: 3.1.1997 / 13:24:10 / cg"
! !

!Project methodsFor:'load & save'!

loadClassesFromProjectDirectory
    "load my classes into the system.
     The classes are loaded from the directory as defined by my
     directory insTvar"

    |myDirectory|

    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 , ' ...'.
            ] ifFalse:[
                Transcript showCR:'reloading ' , clsFilename pathName , ' ...'.
            ].
            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
        ].
    ].

!

loadFromProjectFile:aFilename
    "fill all of my attributes from a projects file (.prj-file)"

    |f l pack targetConditions s sourcesSubDir files module|

    f := aFilename asFilename.
    directoryName := f directory pathName.
    self directory:(f directory pathName).
    pack := ResourcePack fromFile:f baseName directory:directoryName.

    "/ convert the resourcePack ...

    packageName := pack at:'package' ifAbsent:packageName.
    name := pack at:'name' ifAbsent:name.

    module := pack at:'repository.module' ifAbsent:nil.
    module notNil ifTrue:[
        repositoryModule := module.
        repositoryDirectory := pack at:'repository.directory' ifAbsent:''.
    ].

    prerequisites := pack at:'prerequisites' ifAbsent:#().
    self prerequisiteClasses:(pack at:'prerequisiteClasses' ifAbsent:#()).

    s := pack at:'nameSpace' ifAbsent:nil.
    s notNil ifTrue:[
        self defaultNameSpace:(Namespace name:s).
    ].

    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.

    sourcesSubDir := pack at:'sources' ifAbsent:nil.
    sourcesSubDir notNil ifTrue:[
        properties at:#'sourcesDirectory' put:sourcesSubDir.
    ].
    files := pack at:'files' ifAbsent:nil.
    files notNil ifTrue:[
        properties at:#'files' put:files.
    ].

    "/ fetch class info

    (pack at:'classes' default:#()) do:[:info |
        |condKey className optionalFileName|

        condKey := #always.
        info isSymbol ifTrue:[
            className := info.
        ] ifFalse:[
            className := info at:1.
            info size > 1 ifTrue:[
                optionalFileName := info at:2.
                info size > 2 ifTrue:[
                    condKey := info at:3.
                ]
            ].
        ].
        self 
            addClass:className 
            conditionForInclusion:condKey 
            classFileName:optionalFileName
    ].

    self wasLoadedFromFile:true.

    "/ all remaining properties
    pack keysAndValuesDo:[:key :val |
        (key startsWith:'property.') ifTrue:[
            self propertyAt:(key copyFrom:'property.' size+1) asSymbol put:val.
        ]
    ].

    "
     Project current saveAsProjectFile.

     Project new loadFromProjectFile:'default.prj'

     Project new loadFromProjectFile:'../../libbasic/libbasic.prj'
    "

    "Modified: / 26.4.1999 / 23:21:33 / cg"
!

saveAsProjectFile
    "store all of my attributes into a projects file (.prj-file)
     (in the project-directory and named as <projectName>.prj)"

    |fn s|

    fn := self directory asFilename.
    fn := fn construct:self name.
    fn := fn withSuffix:'prj'.

    fn exists ifTrue:[
        fn copyTo:(fn pathName , '.bak')
    ].
    s := fn writeStream.
    self saveAsProjectFileOn:s.
    s close.

    "
     Project current saveAsProjectFile
    "

    "Modified: / 26.4.1999 / 22:53:38 / cg"
!

saveAsProjectFileOn:aStream
    "save the project info in a format which is both usable for reload
     and somehow readable for humans.
     Actually, the format is the same as used for resources (i.e. key - value pairs)
     and the code below could be much simpler - if there where no humans to read it ..."

    |s coll first maxLen t defNS|

    s := aStream.

    s nextPutLine:'; $Header' , '$'; nextPutLine:';'.
    s nextPutLine:'; Project saved ' , Smalltalk timeStamp; nextPutLine:';'.
    s nextPutLine:'; Be careful when editing - do not corrupt the files syntax.'.
    s nextPutLine:'; (Lines starting with a semicolon are comment lines)'.
    s nextPutLine:'; (Lines ending with a backslash are concatenated with the following line)'.

    s cr; nextPutLine:';'; nextPutLine:'; general:'; nextPutLine:';'.

    s nextPutAll:'comment'. 
    s tab. s nextPutLine:(self comment storeString).

    s nextPutAll:'name'. 
    s tab. s nextPutLine:(name storeString).

    s nextPutAll:'type'. 
    s tab. s nextPutLine:(self type storeString).

    s nextPutAll:'package'. 
    s tab. s nextPutLine:(self package storeString).

    defNS := self defaultNameSpace.
    (defNS ~~ Smalltalk) ifTrue:[
        s nextPutAll:'nameSpace'. 
        s tab. s nextPutLine:(defNS name storeString).
    ].

    s cr; nextPutLine:';'; nextPutLine:'; repository:'; nextPutLine:';'.
    s nextPutAll:'repository.module'. 
    s tab. s nextPutLine:(repositoryModule ? 'private') storeString.
    s nextPutAll:'repository.directory'. 
    s tab. s nextPutLine:(repositoryDirectory ? self package) storeString.
    s cr.

    (t := properties at:#'sourcesDirectory' ifAbsent:nil) notNil ifTrue:[
        s nextPutAll:'sources'. 
        s tab. s nextPutLine:(t storeString).
    ].

    first := true.
    properties keysAndValuesDo:[:key :val |
        (#(
            comment
            wasLoadedFromFile
            targetconditions
            classes
            classInfo
            prerequisiteClasses
            files
        ) includes:key) ifFalse:[
            first ifTrue:[
                first := false.
                s cr; nextPutLine:';'; nextPutLine:'; properties:'; nextPutLine:';'.
            ].    
            s nextPutAll:'property.'; nextPutAll:key. 
            s tab. s nextPutLine:val storeString.
        ]
    ].
        
"/    coll := self subProjects.
"/    coll size > 0 ifTrue:[
"/        s nextPutLine:'[subprojects]'. 
"/        coll do:[:aSubProject |
"/            s tab. s nextPutLine:(aSubProject name soreString).
"/        ].
"/    ].

    s cr; nextPutLine:';'; nextPutLine:'; required packages:'; nextPutLine:';'.
    s nextPutAll:'prerequisites'; tab.
    coll := self prerequisites.
    coll size = 0 ifTrue:[
        s nextPutLine:'#()'. 
    ] ifFalse:[    
        s nextPutLine:'#( \'. 
        coll do:[:aProjectOrProjectNameList |
            |pName pPath|

            aProjectOrProjectNameList isString ifTrue:[
                pName := aProjectOrProjectNameList.
            ] ifFalse:[
                aProjectOrProjectNameList isArray ifTrue:[
                    pName := aProjectOrProjectNameList at:1.
                    pPath := aProjectOrProjectNameList at:2.
                ] ifFalse:[
                    pName := aProjectOrProjectNameList name.
                    pPath := aProjectOrProjectNameList repositoryPath.    
                ]
            ].

            pPath isNil ifTrue:[
                s tab. s nextPutAll:(pName storeString); nextPutLine:' \'.
            ] ifFalse:[
                s tab. s nextPutAll:'( '.
                s nextPutAll:(pName storeString); space;
                  nextPutAll:(pPath storeString); nextPutLine:') \'.
            ]
        ].
        s nextPutLine:')'.
    ].

    s cr; nextPutLine:';'; nextPutLine:'; required classes:'; nextPutLine:';'.
    s nextPutAll:'prerequisiteClasses'; tab.
    coll := self prerequisiteClasses.
    s nextPutLine:'#( \'. 
    coll do:[:aClassOrSymbol | |className|

        (className := aClassOrSymbol) isSymbol ifFalse:[
            className := aClassOrSymbol name
        ].
        s tab. s nextPutAll:(className storeString); nextPutLine:' \'.
    ].
    s nextPutLine:')'.

    s cr; nextPutLine:';'; nextPutLine:'; classes:'; nextPutLine:';'.
    s nextPutLine:'; (for each class, one line of the form: ( #''className'' [fileName [condition]] )'.
    s nextPutLine:'; (where fileName and condition are optional)'.
    s nextPutLine:';'.

    coll := self classInfo.
    s nextPutAll:'classes'; tab; nextPutLine:'#( \'.
    "/ find the longest className (for layout only)
    
    maxLen := coll inject:0 into:[:maxSoFar :aClassInfo |
                                    |clsName|

                                    clsName := aClassInfo className.
                                    maxSoFar max:clsName storeString size
                                 ].

    coll do:[:aClassInfo |
        |clsName fileName cond|

        clsName := aClassInfo className.
        fileName := aClassInfo classFileName.
        fileName isNil ifTrue:[
            fileName := clsName , '.st'
        ].
        cond := aClassInfo conditionForInclusion.
        s tab. s nextPutAll:'( '; 
                 nextPutAll:(clsName storeString paddedTo:maxLen); 
                 tab; nextPutAll:fileName storeString.
        cond == #always ifFalse:[
            s tab; nextPutAll:cond storeString.
        ].
        s nextPutLine:') \'.
    ].
    s nextPutLine:')'.

    s cr; nextPutLine:';'; nextPutLine:'; files (for deployment):'; nextPutLine:';'.
"/
"/ already in properties
"/
"/    s nextPutAll:'installDirectoryUnix'; tab.
"/    s nextPutLine:self installDirectoryUnix.
"/    s nextPutAll:'installDirectoryWin32'; tab.
"/    s nextPutLine:self installDirectoryWin32.
"/    s nextPutAll:'installDirectoryVMS'; tab.
"/    s nextPutLine:self installDirectoryVMS.
"/    s nextPutAll:'installDirectoryMacOS'; tab.
"/    s nextPutLine:self installDirectoryMacOS.

    s nextPutAll:'files'; tab.
    coll := properties at:#'files' ifAbsent:#().
    s nextPutLine:'#( \'. 
    coll do:[:aFileEntry |
        s tab. s nextPutAll:(aFileEntry storeString); nextPutLine:' \'.
    ].
    s nextPutLine:')'.

    "
     Project current saveOn:Transcript
    "

    "Modified: / 26.4.1999 / 23:24:12 / cg"
! !

!Project methodsFor:'maintenance'!

buildProject
    "invoke 'make' in the project directory"

    OperatingSystem executeCommand:('cd ' , self directory , ' ; make')
!

createLoadAllFile
    "creates a 'loadAll' file, which will load all classes
     of the project - this loadAll file is supposed to be located
     in the projects source directory."

    |d f out in topName classes classInfo numBad firstBad msg|

    classes := self classes.
    numBad := 0.
    firstBad := nil.

    classes := classes collect:[:clsOrSymbol |  |cls|
                                        clsOrSymbol isSymbol ifTrue:[
                                            cls := Smalltalk at:clsOrSymbol.
                                            cls isNil ifTrue:[
                                                numBad := numBad + 1.
                                                firstBad := firstBad ? clsOrSymbol.
                                            ] ifFalse:[
                                                cls isLoaded ifFalse:[
                                                    cls autoLoad.
                                                    cls isLoaded ifFalse:[
                                                        cls := nil
                                                    ]
                                                ].
                                            ].
                                            cls.
                                        ] ifFalse:[
                                            clsOrSymbol
                                        ]
                              ].
    numBad ~~ 0 ifTrue:[
        msg := 'Cannot generate ''loadAll''-file.\\'.
        msg := msg , 'Reason: Class ''' , firstBad asText allBold
                   , ''' is not loaded.'.
        numBad ~~ 1 ifTrue:[
            msg := msg , '\(' , (numBad-1) printString , ' more unloaded classes were found)'
        ].
        self warn:msg withCRs.
        ^ self.
    ].

    classes := classes copy topologicalSort:[:a :b | b isSubclassOf:a].

    Transcript showCR:'creating loadAll file'.

    d := directoryName asFilename.
    f := d construct:'loadAll'.
    f exists ifTrue:[
        f renameTo:(d construct:'loadAll.bak')
    ].
    out := f writeStream.
    out isNil ifTrue:[
        self warn:'cannot create loadAll'.
        (d construct:'loadAll.bak') renameTo:f.
        ^ self
    ].

    out nextPutAll:'
|files|

files := #(
'.

    classes do:[:cls |
         out nextPut:$'.
         cls nameWithoutNameSpacePrefix printOn:out.
         out nextPutAll:'.st'''.
         out cr.
    ].

    out nextPutAll:').

files do:[:s |
    ''.'' print.
    Smalltalk fileIn:s.
].
'' done'' printCR.
'.

    out close
!

createMakefile
    "creates an initial makefile, which will recreate a correct
     Makefile, then compile all"

    |d f out in topName|

    Transcript showCR:'creating Makefile'.

    d := directoryName asFilename.
    f := d construct:'Makefile'.
    f exists ifTrue:[
        f renameTo:(d construct:'Makefile.bak')
    ].
    out := f writeStream.
    out isNil ifTrue:[
        self warn:'cannot create Makefile'.
        ^ self
    ].
    in := Smalltalk systemFileStreamFor:'rules/stdHeader'.
    out nextPutAll:in contents asString.
    in close.

    topName := self findTopFrom:directoryName.

    out nextPutAll:'#TOP=/usr/local/lib/smalltalk'; cr.
    out nextPutAll:'TOP=' , topName; cr.
    out nextPutAll:'target:'; cr.
    out tab; nextPutAll:'touch Make.proto'; cr.
    out tab; nextPutAll:'$(MAKE) Makefile'; cr.
    out tab; nextPutAll:'make'; cr; cr.

    in := Smalltalk systemFileStreamFor:'configurations/COMMON/defines'.
    out nextPutAll:in contents asString.
    in close.

    in := Smalltalk systemFileStreamFor:'configurations/vendorConf'.
    out nextPutAll:in contents asString.
    in close.

    in := Smalltalk systemFileStreamFor:'configurations/myConf'.
    out nextPutAll:in contents asString.
    in close.

    in := Smalltalk systemFileStreamFor:'rules/stdRules'.
    out nextPutAll:in contents asString.
    in close.
    out close

    "Modified: 18.5.1996 / 15:44:25 / cg"
!

createProjectFiles
    "actually, creates all files to do a make in the project directory"

    directoryName asFilename exists ifFalse:[
        (self confirm:'create new projectDirectory: ' , directoryName) 
            ifFalse:[^ self].
        OperatingSystem recursiveCreateDirectory:directoryName.
    ].
    self createMakefile.
    self createSourcefiles.
    self createProtoMakefile.
    (self propertyAt:#deliverLoadAllFile) == true ifTrue:[
        self createLoadAllFile
    ].
!

createProtoMakefile
    "creates a Make.proto file"

    |d f s type appName libName startUpClass startUpSelector
     topName classes|

    topName := self findTopFrom:directoryName.

    Transcript showCR:'creating Make.proto'.

    d := directoryName asFilename.
    f := d construct:'Make.proto'.
    f exists ifTrue:[
        f renameTo:(d construct:'Make.proto.bak')
    ].
    s := f writeStream.
    s isNil ifTrue:[
        self warn:'cannot create prototype Makefile'.
        ^ self
    ].
    s nextPutAll:'#
# ' , Smalltalk timeStamp , '
#
# created by Smalltalks Project support
#


# the next line defines the path to the TOP directory,
# (where the directories "configurations" and "include" are found)
#
#TOP=/usr/local/lib/smalltalk
TOP=' , topName ,'

#
# add any subdirectories that have to be visited by make
#
SUBDIRS=

#
# do not change
#
SHELL=/bin/sh

'.

    s nextPutAll:'#
# set the stc options
#
STCOPT=$(DEFAULT_STCOPT)
# STCOPT=+optspace2
# STCOPT=+optspace2 -warnNonStandard

#
# and packageName option
#
STCLOCALOPT=''-Pprivate-classes-(libapp)''

'.

    type := #library.
    appName := 'app'.
    libName := 'lib'.
    startUpClass := 'Smalltalk'.
    startUpSelector := 'start'.

    properties notNil ifTrue:[
        type := properties at:#projectType ifAbsent:type.
        appName := properties at:#applicationName ifAbsent:appName.
        startUpClass := properties at:#startupClass ifAbsent:startUpClass.
        startUpSelector := properties at:#startupSelector ifAbsent:startUpSelector.
    ].

    s nextPutAll:'#
# define the name of the library to create
#
'.
    s nextPutAll:'LIBNAME=lib' , appName; cr; cr.

    s nextPutAll:'#
# the target rule:
#
all::   abbrev.stc objs genClassList $(OBJTARGET)

'.

    type == #executable ifTrue:[
        s nextPutAll:'PROGS = ' , appName; cr.
        s nextPutAll:('STARTUP_CLASS=' , startUpClass); cr.
        s nextPutAll:'STARTUP_SELECTOR="' , startUpSelector; nextPutAll:'"'; cr.
    ].

    s nextPutAll:'#
# define the object files that are to be created
#
'.
    s nextPutAll:'OBJS='.

    (classes := self classes) notNil ifTrue:[
        classes do:[:aClass |
            |abbrev|

            s nextPutAll:' \'. s cr.
            abbrev := Smalltalk fileNameForClass:aClass name.
            s nextPutAll:'  '; nextPutAll:abbrev; nextPutAll:'.o'.
        ].
    ].
    s cr; cr.

    s nextPutAll:'#
# dependencies:
#
I=$(TOP)/include
RT_STUFF=$(I)/Object.H $(I)/stc.h $(I)/stcIntern.h

'.
    classes notNil ifTrue:[
        classes do:[:aClass |
            |abbrev|

            abbrev := Smalltalk fileNameForClass:aClass name.
            s nextPutAll:abbrev; nextPutAll:'.o: '.
            s nextPutAll:abbrev; nextPutAll:'.st '.
            aClass allSuperclassesDo:[:superClass|
                s nextPutAll:'$(I)/'.
                s nextPutAll:(Smalltalk fileNameForClass:superClass name) , '.H '.
            ].
            s nextPutAll:'$(RT_STUFF)';  cr.
        ].
    ].
    s cr; cr.

    type == #executable ifTrue:[
        s nextPutAll:'all:: $(PROGS)'; cr.

        s nextPutAll:appName.
        s nextPutAll:':: main.o classList.o $(OBJS)'; cr.
        s tab;      nextPutAll:'$(LD) $(ST_LDFLAG) $(LDFLAGS) -o ';
                    nextPutAll:appName;
                    nextPutAll:' \'; cr.
        s tab; tab; nextPutAll:'$(CRT0) main.$(O) classList.$(O) $(OBJS) $(EXTRA_OBJ) $(LIBOBJS) \'; cr.
        s tab; tab; nextPutAll:'$(LIBRUNDIR)/hidata.o $(LIBRUN) \'; cr.
        s tab; tab; nextPutAll:'$(MATHLIB) $(EXTRALIBS) -lXext $(SYSLIBS) $(OTHERLIBS) $(CRTN)'; cr.
    ].

    s close

    "Modified: / 23.3.1999 / 14:20:09 / cg"
!

createSourcefiles
    "creates all Smalltalk-source files in the project directory"

    |classes methods methodClasses dir stream|

    dir := self directory asFilename.
    Transcript showCR:'creating sources in ' , dir pathName , ' ...'; endEntry.

    classes := self classes.
    classes isNil ifTrue:[
        self warn:'no classes in current project'
    ].

    classes notNil ifTrue:[
        classes do:[:aClass |
            aClass isLoaded ifFalse:[
                aClass autoload.
            ].
        ].
        classes := classes topologicalSort:[:a :b | a isSubclassOf:b].

        classes do:[:aClass |
            Transcript show:' ... '; showCR:aClass name, '.st'; endEntry.
            aClass fileOutIn:dir
        ]
    ].

    methods := self individualMethods.
    methods notNil ifTrue:[
        methods := methods asIdentitySet.
        "
         get classes ...
        "
        methodClasses := IdentitySet new.
        methods do:[:m | 
                        |mCls|

                        mCls := m containingClass.
                        mCls isMeta ifTrue:[
                            mCls := mCls soleInstance.
                        ].
                        methodClasses add:mCls].
        "
         fileOut by class
        "
        methodClasses do:[:cls |
            stream := (self directory asFilename construct:(cls name , '.chg')) writeStream.

            Transcript show:' ... '; showCR:cls name, '.chg'; endEntry.
            methods do:[:m |
                |mCls|

                mCls := m containingClass.
                (mCls == cls or:[mCls == cls class]) ifTrue:[
                    mCls fileOutMethod:m on:stream.
                ].
                stream cr.
            ].
            stream close.
        ].
    ].

    "Modified: 1.11.1996 / 16:37:15 / cg"
    "Modified: 18.9.1997 / 18:50:34 / stefan"
!

findTopFrom:directoryName
    "returns the relative path from directoryName to the TOP
     directory."

    |topName relParent foundTop|

    "/ find TOP
    relParent := '..'.
    foundTop := false.
    [foundTop] whileFalse:[
	topName := directoryName , '/' , relParent.
	topName asFilename pathName = '/' ifTrue:[
	    self warn:'could not find TOP; assume absoulte path to TOP'.
	    topName := '/usr/local/lib/smalltalk'.
	    foundTop := true.
	] ifFalse:[
	    (topName , '/configurations') asFilename exists ifTrue:[
		(topName , '/include') asFilename exists ifTrue:[
		    foundTop := true.
		    topName := relParent.
		]
	    ].
	    foundTop ifFalse:[
		relParent := relParent , '/..'.
	    ]        
	]
    ].
    ^ topName
! !

!Project methodsFor:'printing & storing'!

displayString
    ^ super displayString , '(''' , (name ? '<unnamed>') , ''')'
! !

!Project methodsFor:'properties'!

addClass:classOrClassName classFileName:fileName
    "add a class to the project"

    self
        addClass:classOrClassName 
        conditionForInclusion:#always 
        classFileName:fileName

!

addClass:classOrClassName conditionForInclusion:conditionBlock classFileName:fileName
    "add a class to the project"

    |i|

    i := ClassInfo new.
    i className:classOrClassName.
    i classFileName:fileName.
    i conditionForInclusion:conditionBlock.
    self addClassInfo:i
!

addClassInfo:newInfo
    "add a class info to the project"

    |infoCollection index nm prefix|

    (infoCollection := self classInfo) isNil ifTrue:[
        self classInfo:(infoCollection := OrderedCollection new).
    ].

    index := infoCollection findFirst:[:i | |nm1 nm2|
                                        nm1 := i className.
                                        nm2 := newInfo className.
                                        (nm1 includes:$:) ifFalse:[
                                            nm1 := self defaultNameSpace name , '::' , nm1
                                        ].
                                        (nm2 includes:$:) ifFalse:[
                                            nm2 := self defaultNameSpace name , '::' , nm2
                                        ].
                                        nm1 = nm2
                                      ].
    "/ strip off nameSpace prefix, if its the same as
    "/ the default ...

    nm := newInfo className.
    prefix := self defaultNameSpace name , '::'.
    (nm startsWith:prefix) ifTrue:[
        nm := nm copyFrom:(prefix size + 1).
        newInfo className:nm asSymbol.
    ].
    index ~~ 0 ifTrue:[
        infoCollection at:index put:newInfo
    ] ifFalse:[
        infoCollection add:newInfo
    ]
!

addMethod:methodOrSelector inClass:aClassOrClassName fileName:fileName
    "add an individual method to the project"

    |i|

    i := MethodInfo new.
    i methodName:methodOrSelector.
    i className:aClassOrClassName.
    i fileName:fileName.
    self addMethodInfo:i
!

classInfo:aClassInfoCollection
    "set the class info of the project"

    self propertyAt:#classInfo put:aClassInfoCollection

!

comment
    "return the comment of the project"

    properties isNil ifTrue:[^ ''].
    ^ properties at:#comment ifAbsent:''
!

comment:aString
    "set the projects comment"

    self propertyAt:#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"

    self propertyAt:#documentationURL put:anURLString

!

properties
    "return the property dictionary"

    ^ properties
!

properties:p
    "set the property dictionary"

    properties := p
!

propertyAt:aKey
    "return a property; the key is a symbol"

    properties isNil ifTrue:[^ nil].
    ^ properties at:aKey ifAbsent:nil.
!

propertyAt:aKey put:aValue
    "set a property; the key is a symbol"

    |oldValue|

    oldValue := self propertyAt:aKey.

    properties isNil ifTrue:[
        properties := IdentityDictionary new
    ].
    properties at:aKey put:aValue.

    oldValue ~~ aValue ifTrue:[
        self changed:aKey.
    ].

    "Created: / 23.3.1999 / 14:21:11 / cg"
!

type
    "return the type of project (one of #application, #library, #smalltalk)"

    properties isNil ifTrue:[^ #application].
    ^ properties at:#type ifAbsent:#application
!

type:aSymbol
    "set the projects type (one of #application, #library, #smalltalk)"

    (#(application library smalltalk) includes:aSymbol) ifFalse:[
        self warn:'invalid project type'.
        ^ self
    ].
    self propertyAt:#type put:aSymbol
!

wasLoadedFromFile
    "return true, if the project was loaded from a file"

    properties isNil ifTrue:[^ nil].
    ^ properties at:#wasLoadedFromFile ifAbsent:false

    "Modified: / 23.3.1999 / 13:59:32 / cg"
    "Created: / 23.3.1999 / 14:21:06 / cg"
!

wasLoadedFromFile:aBoolean
    "set/clear the flag stating that the project was loaded from a file"

    self propertyAt:#wasLoadedFromFile put:aBoolean
! !

!Project methodsFor:'queries'!

areAllClassesLoaded
    "return true, if all classes of the package are loaded
     (i.e. there are no autoloaded stubs present)"

    |classes|

    classes := self classes.
    classes isNil ifTrue:[^ isLoaded ? false].
    classes do:[:aClass |
        aClass isLoaded ifFalse:[^ false].
    ].
    ^ true

!

classInfo
    "return a classInfo collection of classes belonging to that project"

    |classInfo classes|

    properties notNil ifTrue:[
        classInfo := properties at:#classInfo ifAbsent:nil.
        classInfo notNil ifTrue:[^ classInfo].
    ].

    classes := self classes.
    classes size == 0 ifTrue:[
        classInfo := OrderedCollection new
    ] ifFalse:[
        classInfo := classes asOrderedCollection
                        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
                        ]
    ].
    self propertyAt:#classInfo put:classInfo.
    ^ classInfo

    "Modified: 4.1.1997 / 16:51:18 / cg"
!

classes
    "return a collection of classes belonging to that project.
     This excludes any private classes."

    |classes classInfo|

    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 
            allClassesDo:[:aClass |
                (true "aClass owningClass isNil"
                and:[aClass isMeta not
                and:[aClass package = packageName
                and:[aClass isNamespace not or:[aClass == Smalltalk]]]]) ifTrue:[
                    classes add:aClass
                ]
            ].
        classes isEmpty ifTrue:[^ nil].
    ].
    ^ classes

    "Modified: 4.1.1997 / 16:51:18 / cg"
!

individualMethods
    "return a collection of individual methods belonging to that project,
     only methods are returned which are not contained in the
     projects class set."

    |classes methods|

    classes := self classes.
    classes notNil ifTrue:[
        classes := classes asIdentitySet.
    ] ifFalse:[
        classes := #()
    ].

    methods := IdentitySet new.
    Smalltalk allBehaviorsDo:[:cls |
        |classToCheck|

        classToCheck := cls.
"/        cls isPrivate ifTrue:[
"/            classToCheck := cls topOwningClass
"/        ].
        (classes isNil 
        or:[((classes includes:classToCheck) 
            or:[classes includes:classToCheck name]) not]) ifTrue:[
            cls methodDictionary do:[:m |
                m package = packageName ifTrue:[
                    methods add:m
                ]
            ].
            cls class methodDictionary do:[:m |
                m package = packageName ifTrue:[
                    methods add:m
                ]
            ].
        ]
    ].
    ^ methods asArray

    "
     Project current classes
     Project current individualMethods
    "

    "Modified: 7.6.1996 / 09:16:25 / stefan"
!

isLoaded
    "return true, if all of this project-package has been loaded
     into the system"

    |binaryModule|

    isLoaded notNil ifTrue:[^ isLoaded].

    "/ check for loaded class-libraries.
    binaryModule := ObjectMemory binaryModuleInfo detect:[:i | i package = self package] ifNone:nil.
    binaryModule notNil ifTrue:[
        ^ true
    ].

    self halt.

    "
     (Project projectWithId:#'stx:libbasic') isLoaded
     (Project projectWithId:#'stx:goodies/persistency') isLoaded 
    "

! !

!Project methodsFor:'specifications'!

readSpec
    |s chunk fileName|

    fileName := (properties at:#directoryName) asFilename construct:'.project'.
    s := fileName readStream.
    s isNil ifTrue:[^ self].
    [s atEnd] whileFalse:[
	chunk := s nextChunk.
	Compiler evaluate:chunk receiver:properties notifying:nil
    ].
    s close.

    "(Project new directory:'../projects/Clock') readSpec"
!

saveSpec
    |f d s|

    d := (properties at:#directoryName) asFilename.
    d exists ifFalse:[
        self error:'directory does not exist' mayProceed:true.
        ^ self
    ].
    f := d construct:'.project'.
    s := f writeStream.
    s isNil ifTrue:[^ self].
    properties associationsDo:[:aProp |
        (aProp == #directoryName) ifFalse:[
            s nextChunkPut:('self at:' , aProp key storeString, 
                               ' put:' , aProp value storeString).
            s cr
        ]
    ].
    s close

    "((Project new directory:'../projects/Clock') readSpec
         directory:'../projects/xxx') saveSpec"
! !

!Project methodsFor:'views'!

addView:aView
    "add a view to this projects set of views"

    views notNil ifTrue:[views add:aView]

    "Modified: 14.2.1997 / 15:36:51 / cg"
!

destroyViews
    "destroy all views of this project"

    views notNil ifTrue:[
	views do:[:aView |
	    aView notNil ifTrue:[aView destroy]
	]
    ].
!

hideViews
    "hide all views of this project"

    views notNil ifTrue:[
        views do:[:aView |
            aView notNil ifTrue:[aView unmap]
        ]
    ].

    "Modified: 3.5.1996 / 23:48:51 / stefan"
!

removeView:aView
    "remove a view from this projects set of views"

    views notNil ifTrue:[
        views remove:aView ifAbsent:nil
    ]

    "Modified: 14.2.1997 / 15:37:20 / cg"
!

showViews
    "show all views of this project"

    views notNil ifTrue:[
        views do:[:aView |
            aView notNil ifTrue:[aView remap]
        ]
    ].

    "Modified: 3.5.1996 / 23:59:10 / stefan"
    "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::MethodInfo methodsFor:'accessing'!

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.!

fileName
    "return the value of the instance variable 'fileName' (automatically generated)"

    ^ fileName!

fileName:something
    "set the value of the instance variable 'fileName' (automatically generated)"

    fileName := something.!

methodName
    "return the value of the instance variable 'methodName' (automatically generated)"

    ^ methodName!

methodName:something
    "set the value of the instance variable 'methodName' (automatically generated)"

    methodName := something.! !

!Project class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic/Project.st,v 1.92 1999-09-15 07:04:48 cg Exp $'
! !
Project initialize!