"

 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.

"

'From Smalltalk/X, Version:2.10.4 on 5-feb-1995 at 11:58:37 pm'!

Object subclass:#Project

	 instanceVariableNames:'name changeSet views directoryName properties packageName'

	 classVariableNames:'CurrentProject SystemProject NextSequential'

	 poolDictionaries:''

	 category:'System-Support'

!

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

"

!

version

    ^ '$Header: /cvs/stx/stx/libbasic/Project.st,v 1.28 1995-11-11 15:26:10 cg Exp $'

!

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 packageName for new classes and methods.

    Future: 

	- keep track of per-project changes

	- allow speficiation of the type of the project (application, library, etc)

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

"

! !

!Project class methodsFor:'initialization'!

initialize

    SystemProject isNil ifTrue:[

	NextSequential := 1.

	SystemProject := self new name:'default'.

	SystemProject packageName:'private'.

	"

	 the SystemProject does not keep a record if changes,

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

	"

	SystemProject changeSet:nil.

    ].

    CurrentProject := SystemProject.

    "

     Project initialize

    "

! !

!Project class methodsFor:'instance creation'!

new

    ^ self basicNew initialize

! !

!Project class methodsFor:'accessing'!

current

    "return the currently active project"

    ^ CurrentProject

    "

     Project current

    "

!

current:aProject

    "set the currently active project"

    CurrentProject := aProject.

    self changed:#currentProject

!

defaultProject

    "return the SystemDefault project"

    ^ SystemProject.

!

setDefaultProject

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

    self current:SystemProject.

!

currentPackageName

    CurrentProject notNil ifTrue:[

	^ CurrentProject packageName

    ].

    ^ 'no package' 

    "

     Project currentPackageName

    "

! !

!Project class methodsFor:'changes management'!

addMethodChange:aMethod in:aClass

    "add a change for a method to the current project"

    |p c|

    p := CurrentProject.

    (p notNil 

    and:[(c := p changeSet) notNil]) ifTrue:[

	c addMethodChange:aMethod in:aClass 

    ]

!

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

    ].

    ^ dirName , Filename separator asString

!

addMethodCategoryChange:aMethod category:newCategory in:aClass

    |p c|

    p := CurrentProject.

    (p notNil 

    and:[(c := p changeSet) notNil]) ifTrue:[

	c addMethodCategoryChange:aMethod category:newCategory in:aClass 

    ]

!

addMethodPrivacyChange:aMethod in:aClass

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

! !

!Project methodsFor:'accessing'!

packageName

    ^ packageName

!

changeSet

    ^ changeSet

!

name

    ^ name

!

views

    ^ views asArray

!

name:aString

    name := aString.

    self == CurrentProject ifTrue:[

	Project changed:#name

    ]

!

views:aSetOfViews

    views := WeakIdentitySet withAll:aSetOfViews

!

changeSet:aChangeSet

    changeSet := aChangeSet

!

packageName:aStringOrSymbol

    packageName := aStringOrSymbol asSymbol.

    self == CurrentProject ifTrue:[

	Project changed:#package

    ]

!

directory

    directoryName isNil ifTrue:[^ '.'].

    ^ directoryName

!

directory:aDirectoryName

    directoryName := aDirectoryName.

    self == CurrentProject ifTrue:[

	Project changed:#directory 

    ]

! !

!Project methodsFor:'queries'!

classes

    "return a collection of classes belonging to that project"

    |classes|

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

    classes isNil ifTrue:[

	classes := OrderedCollection new.

	Smalltalk allClassesDo:[:aClass | aClass package = packageName ifTrue:[classes add:aClass]].

	classes isEmpty ifTrue:[^ nil].

    ].

    ^ classes

!

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 |

	(classes isNil or:[(classes includes:cls) not]) ifTrue:[

	    cls methodArray do:[:m |

		m package = packageName ifTrue:[

		    methods add:m

		]

	    ].

	    cls class methodArray do:[:m |

		m package = packageName ifTrue:[

		    methods add:m

		]

	    ].

	]

    ].

    ^ methods asArray

    "

     Project current classes

     Project current individualMethods

    "

! !

!Project methodsFor:'views'!

addView:aView

    views notNil ifTrue:[views add:aView]

!

removeView:aView

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

!

showViews

    views notNil ifTrue:[

	views do:[:aView |

	    aView notNil ifTrue:[aView rerealize]

	]

    ].

!

hideViews

    "hide all views of this project"

    views notNil ifTrue:[

	views do:[:aView |

	    aView notNil ifTrue:[aView unrealize]

	]

    ].

!

destroyViews

    "destroy all views of this project"

    views notNil ifTrue:[

	views do:[:aView |

	    aView notNil ifTrue:[aView destroy]

	]

    ].

! !

!Project methodsFor:'initialization'!

initialize

    |numString|

    views := WeakIdentitySet new.

    numString := NextSequential printString.

    NextSequential := NextSequential + 1.

    name := 'new Project-' , numString.

    packageName := 'private-' , numString.

    "/ changeSet := ChangeSet new.

    self directory:'.'

! !

!Project methodsFor:'properties'!

properties

    ^ properties

!

properties:p

    properties := p

!

type

    "return the type of project"

    ^ properties at:#type ifAbsent:[#application]

!

type:aSymbol

    "set the projects type"

    (#(application library smalltalk) includes:aSymbol) ifFalse:[

	self warn:'invalid project type'.

	^ self

    ].

    properties at:#type put:aSymbol

! !

!Project methodsFor:'maintenance'!

buildProject

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

!

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.

!

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

!

createSourcefiles

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

    |classes methods methodClasses dir stream|

    dir := FileDirectory directoryNamed:self directory.

    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 who at:1.

			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 who at:1.

		(mCls == cls or:[mCls == cls class]) ifTrue:[

		    mCls fileOutMethod:m on:stream.

		].

		stream cr.

	    ].

	    stream 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')

    ].