'From Smalltalk/X, Version:2.6.4 on 27-Apr-1993 at 20:02:37'!

Object subclass:#Project

         instanceVariableNames:'name changeSet views properties'

         classVariableNames:'CurrentProject'

         poolDictionaries:''

         category:'System-Support'

!

!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:'instance creation'!

new

    ^ self basicNew initialize

! !

!Project class methodsFor:'initialization'!

initialize

    CurrentProject isNil ifTrue:[

        CurrentProject := self new name:'System'

    ]

    "Project initialize"

! !

!Project methodsFor:'initialization'!

initialize

    self views:(OrderedCollection new).

    self name:'a new Project'.

    self changeSet:(ChangeSet new).

    self directory:'.'

! !

!Project methodsFor:'accessing'!

properties

    ^ properties

!

properties:p

    properties := p

!

views

    ^ views

!

views:aSetOfViews

    views := aSetOfViews

!

changeSet

    ^ changeSet

!

changeSet:aChangeSet

    changeSet := aChangeSet

!

name

    ^ name

!

name:aString

    name := aString

!

directory

    ^ properties at:#directoryName

!

directory:aDirectoryName

    properties isNil ifTrue:[

        properties := Dictionary new

    ].

    properties at:#directoryName put:aDirectoryName

! !

!Project methodsFor:'views'!

addView:aView

    views add:aView

!

removeView:aView

    views remove:aView ifAbsent:[]

!

showViews

    self views notNil ifTrue:[

        self views do:[:aView |

            aView rerealize

        ]

    ].

!

hideViews

    self views notNil ifTrue:[

        self views do:[:aView |

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

    self createAbbreviationFile.

    self createProtoMakefile.

!

createSourcefiles

    "creates all st-source files"

    |d f s abbrev classSymbol|

    Transcript showCr:'creating sources'.

    d := (properties at:#directoryName) asFilename.

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

        classSymbol := aClassName asSymbol.

        (Smalltalk includesKey:classSymbol) ifFalse:[

            Transcript showCr:('no class named ' , aClassName)

        ] ifTrue:[

            (Smalltalk at:classSymbol) autoload.

            abbrev := Smalltalk fileNameForClass:aClassName.

            f := d construct:(abbrev , '.st').

            s := f writeStream.

            s isNil ifTrue:[

                self warn:'cannot create source file(s)'.

                ^ self

            ].

            (Smalltalk at:classSymbol) fileOutOn:s.

            s close

        ]

    ].

!

createClassListFile

    "creates classList.stc - assume all loaded now should go into executable"

    |d f in out|

    Transcript showCr:'creating classList.stc'.

    d := (properties at:#directoryName) asFilename.

    f := d construct:'classList.stc'.

    out := f writeStream.

    out isNil ifTrue:[

        self warn:'cannot create classList file'.

        ^ self

    ].

    in := './classList.stc' asFilename readStream.

    out nextPutAll:in contents asString.

    in close.

    (properties at:#classes ifAbsent:[Smalltalk allClasses collect:[:aClass| aClass name asSymbol]]) do:[:aClassSymbol |

        (Smalltalk includesKey:aClassSymbol) ifFalse:[

            Transcript showCr:('no class named ' , aClassSymbol)

        ] ifTrue:[

"

            (Smalltalk at:aClassSymbol) autoload.

"

            (Smalltalk at:aClassSymbol) isLoaded ifTrue:[

                out nextPutAll:aClassSymbol; cr

            ]

        ]

    ].

    out close.

!

createAbbreviationFile

    "creates abbrev.stc"

    |d f s abbrev|

    Transcript showCr:'creating abbrev.stc'.

    d := (properties at:#directoryName) asFilename.

    f := d construct:'abbrev.stc'.

    s := f writeStream.

    s isNil ifTrue:[

        self warn:'cannot create abbreviation file'.

        ^ self

    ].

    Smalltalk allClassesDo:[:aClass |

        (aClass isSubclassOf:Autoload) ifFalse:[

            abbrev := Smalltalk fileNameForClass:aClass name.

            abbrev ~= aClass name ifTrue:[

                s nextPutAll:aClass name; tab; nextPutAll:abbrev; cr

            ]

        ].

    ].

    s close.

!

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 Smalltalk

#

SHELL=/bin/sh

SUBDIRS=

#TOP=/usr/local/lib/smalltalk

#LIBRUNDIR=$(TOP)/lib

#LIBBASICDIR=$(TOP)/lib

#LIBVIEWDIR=$(TOP)/lib

#LIBWIDGDIR=$(TOP)/lib

#LIBCOMPDIR=$(TOP)/lib

TOP=../..

LIBRUNDIR=$(TOP)/librun

LIBBASICDIR=$(TOP)/libbasic

LIBVIEWDIR=$(TOP)/libview

LIBWIDGDIR=$(TOP)/libwidg

LIBCOMPDIR=$(TOP)/libcomp

LIBRUN=$(LIBRUNDIR)/librun.$(A)

LIBBASICOBJ=$(LIBBASICDIR)/libbasic$(OBJNAME)

LIBVIEWOBJ=$(LIBVIEWDIR)/libview$(OBJNAME)

LIBWIDGOBJ=$(LIBWIDGDIR)/libwidg$(OBJNAME)

LIBCOMPOBJ=$(LIBCOMPDIR)/libcomp$(OBJNAME)

I=$(TOP)/include

SYSLIBS = -lX11

STC=stc

CFLAGS  = -I$(INCLUDE) $(OS) $(OPT) $(DBG) $(DEFS)

STCFLAGS= -H. -I. -I$(INCLUDE) $(STCOPT)

'.

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

    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!