"

	      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 properties packageName'

	 classVariableNames:'CurrentProject SystemProject'

	 poolDictionaries:''

	 category:'System-Support'

!

Project comment:'

COPYRIGHT (c) 1993 by Claus Gittinger

	      All Rights Reserved

'!

!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

"

"

!

documentation

"

    this class is still under construction.

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

current

    "return the currently active project"

    ^ CurrentProject

    "Project current"

!

current:aProject

    "set the currently active project"

    CurrentProject := aProject

! !

!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

! !

!Project methodsFor:'accessing'!

!

changeSet

    ^ changeSet

!

name

    ^ name

!

!

classes

    "return a collection of classes belonging to that project"

    |classes|

    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

!

!

!

!

! !

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

	]

    ].

! !

!Project methodsFor:'maintenance'!

buildProject

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

!

createProjectFiles

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

    |dirName|

    dirName := properties at:#directoryName.

    dirName asFilename exists ifFalse:[

	(self confirm:'create new projectDirectory: ' , dirName) ifFalse:[^ self].

	OperatingSystem recursiveCreateDirectory:dirName.

    ].

    self createMakefile.

    self createSourcefiles.

    self createProtoMakefile.

!

createSourcefiles

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

    classes := self classes.

    classes notNil ifTrue:[

    ].

!

createMakefile

    "creates an initial makefile, which will recreate a correct

     Makefile, then compile all"

    |d f out in|

    Transcript showCr:'creating Makefile'.

    d := (properties at:#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.

    out nextPutAll:'#TOP=/usr/local/lib/smalltalk'; cr.

    out nextPutAll:'TOP=../..'; 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/myConf'.

    out nextPutAll:in contents asString.

    in close.

    in := Smalltalk systemFileStreamFor:'rules/stdRules'.

    out nextPutAll:in contents asString.

    in close.

    out close

!

createProtoMakefile

    "creates a Make.proto file"

    |d f s type appName|

    Transcript showCr:'creating Make.proto'.

    d := (properties at:#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:'#

# created by Smalltalks Project support

#

SHELL=/bin/sh

SUBDIRS=

#TOP=/usr/local/lib/smalltalk

TOP=../..

'.

    type := properties at:#projectType ifAbsent:[#executable].

    appName := properties at:#applicationName ifAbsent:['app'].

    s nextPutAll:'LIBNAME=lib' , appName; cr.

    type == #executable ifTrue:[

	s nextPutAll:'PROGS = ' , appName; cr

    ].

    s nextPutAll:'STARTUP_CLASS=' , (properties at:#startupClass ifAbsent:['Smalltalk']).

    s cr.

    s nextPutAll:'STARTUP_SELECTOR="' , (properties at:#startupSelector ifAbsent:['start']).

    s nextPutAll:'"'; cr.

    s nextPutAll:'OBJS='.

    (properties at:#classes ifAbsent:[#()]) do:[:aClassName |

	|abbrev|

	s nextPutAll:' \'. s cr.

	abbrev := Smalltalk fileNameForClass:aClassName.

	s nextPutAll:'  '; nextPutAll:abbrev; nextPutAll:'.o'.

    ].

    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

! !

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

	^ 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 initialize!