"

 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:#MethodInfo

	instanceVariableNames:'conditionForInclusion methodName className fileName'

	classVariableNames:''

	poolDictionaries:''

	privateIn:Project

!

Object subclass:#ClassInfo

	instanceVariableNames:'conditionForInclusion className classFileName'

	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 := Dictionary new.

    AllProjects isNil ifTrue:[

        AllProjects := OrderedCollection new.

    ] ifFalse:[

        AllProjects do:[:p | packages at:p package asSymbol put:p].

    ].

"/    Smalltalk allClassesDo:[:aClass |

"/        |packageID prj classFilename pkgInfo revInfo 

"/         repositoryPath dir module lib nm|

"/

"/        aClass isMeta ifFalse:[

"/            (aClass isNamespace not or:[aClass == Smalltalk]) ifTrue:[

"/                (Smalltalk at:aClass name) == aClass ifFalse:[

"/                    Transcript showCR:'skipping obsolete/removed class: ' , aClass name.

"/                ] ifTrue:[

"/                    packageID := aClass package asSymbol.

"/                    (packages includesKey:packageID) ifFalse:[

"/

"/                        "/ 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 repositoryDirectory: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.

"/                        packages at:packageID put:prj.

"/                    ] ifTrue:[

"/                        prj := packages at:packageID.

"/                        prj addClass:aClass.

"/                    ].

"/                ].

"/            ].

"/        ].

"/    ].

"/

"/    Method allSubInstancesDo:[:aMethod |

"/        |packageID prj who mthdClass|

"/

"/        who := aMethod who.

"/        who notNil ifTrue:[ "/ skip unbound methods ...

"/            packageID := aMethod package asSymbol.

"/            (packages includesKey:packageID) ifFalse:[

"/                "/ 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.

"/                packages at:packageID put:prj.

"/            ] ifTrue:[

"/                "/ see if the methods class is in the project;

"/                "/ if so, remove any patch-entry for this method.

"/                prj := packages at:packageID.

"/                ((prj classes includes:who methodClass)

"/                or:[prj classes includes:who methodClass name]) ifTrue:[

"/                    prj removeMethod:aMethod.

"/                ]

"/            ]

"/        ]

"/    ].

"/

"/    "/ walk over binary modules, to find out directory names ...

"/

"/    ObjectFileLoader loadedObjectHandles do:[:h |

"/        |cls prj mDir|

"/

"/        cls := h classes firstIfEmpty:nil.

"/        cls notNil ifTrue:[

"/            prj := packages at:cls package ifAbsent:nil.

"/            prj notNil ifTrue:[

"/                mDir := h pathName asFilename directory pathName.

"/                prj directory = '???' ifTrue:[

"/                    prj directory:mDir

"/                ] ifFalse:[

"/                    prj directory ~= mDir ifTrue:[

"/                        ('Project [warning]: conflicting project directories for ' , cls package) infoPrintCR.

"/                    ]

"/                ]

"/            ]

"/        ].

"/    ].

"/

"/    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: / 16.10.1999 / 13:10:37 / 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

    "

!

reinitKnownProjects

    "rescan the image for projects"

    AllProjects := nil.

    self initKnownProjects

! !

!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