"

 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.

"

"{ Package: 'stx:libbasic' }"

Object subclass:#Project

	instanceVariableNames:'name changeSet views directoryName properties packageName

		repositoryDirectory repositoryModule overwrittenMethods

		subProjects prerequisites isLoaded changedClasses'

	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:'conditionForInclusion 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 ...

    AllProjects isNil ifTrue:[

        AllProjects := IdentitySet new.

    ].

    AllProjects add:SystemProject.

    AllProjects add:CurrentProject.

"/    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:[

        self initializeSystemProject.

    ].

    CurrentProject := SystemProject.

    AllProjects := nil.

    self initKnownProjects.

    "

     SystemProject := nil.

     Project initialize

    "

!

initializeSystemProject

    NextSequential := 1.

    SystemProject := self new name:'default'.

    "/ SystemProject package:(OperatingSystem getLoginName , ':NoProject') asSymbol.

    SystemProject package:(self noProjectID).

    SystemProject defaultNameSpace:Smalltalk.

    SystemProject comment:'A default (dummy) project. 

Is used as the current project in case no real project is ever activated.

Please do never save/checkin this project; instead, move classes & methods

into a concrete, real project and save that one in regular intervals.

Use this as a `scratch project''.

'.

    "/ no longer - changes are always remembered in some project

    false ifTrue:[

        "

         the SystemProject does not keep a record if changes,

         but instead depends on the changes file - recording anything there.

        "

        SystemProject changeSet:nil.

    ].

    ChangeSet notNil ifTrue:[

        SystemProject changeSet:ChangeSet new

    ].

    self changed:#defaultProject

!

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 contains:[:p | p package = aProject package])  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 isNil ifTrue:[CurrentProject := SystemProject ].

    ^ CurrentProject

    "

     Project current

    "

!

current:aProject

    "set the currently active project"

    |prevProject|

    prevProject := CurrentProject.

    CurrentProject := aProject.

    prevProject notNil ifTrue:[

        self changed:#currentProject

    ].

!

currentPackageName

    CurrentProject notNil ifTrue:[

	^ CurrentProject package

    ].

    ^ nil

    "

     Project currentPackageName

    "

!

defaultProject

    "return the SystemDefault project"

    ^ SystemProject.

    "

     Project defaultProject package

    "

!

knownProjects

    AllProjects isNil ifTrue:[

	self initKnownProjects

    ].

    ^ AllProjects ? #()

!

loadedProjects

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

!

noProjectID

    ^ #'__NoProject__'.

!

projectNamed:aProjectName

    "retrieve the named project; return nil if not known"

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

    "

     Project projectNamed:'stx'

     Project projectNamed:'default'

    "

!

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'

     Project projectWithId:'__NoProject__'

    "

!

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

addClassCommentChangeFor:aClass

    "add a comment-change for aClass to the current project"

    |p|

    p := CurrentProject.

    p notNil ifTrue:[

        p addClassCommentChangeFor:aClass 

    ]

!

addClassDefinitionChangeFor:aClass

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

    |p|

    p := CurrentProject.

    p notNil ifTrue:[

        p addClassDefinitionChangeFor:aClass 

    ]

    "Created: 3.12.1995 / 13:44:58 / cg"

    "Modified: 3.12.1995 / 13:58:04 / cg"

!

addClassRemoveChange:oldClass

    "add a class-remove-change to the current project"

    |p|

    p := CurrentProject.

    p notNil ifTrue:[

        p addClassRemoveChange:oldClass

    ]

!

addClassRenameChangeFrom:oldName to:newName

    "add a class-rename-change to the current project"

    |p|

    p := CurrentProject.

    p notNil ifTrue:[