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