Project.st
author claus
Mon, 08 Nov 1993 03:32:43 +0100
changeset 10 4f1f9a91e406
parent 2 6526dde5f3ac
child 13 62303f84ff5f
permissions -rw-r--r--
2.8.1

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

    newProject := self basicNew.
    newProject views:(OrderedCollection new).
    newProject name:'a new Project'.
    newProject changeSet:(ChangeSet new).
    ^ newProject
! !

!Project class methodsFor:'initialization'!

initialize
    CurrentProject isNil ifTrue:[
        CurrentProject := self new name:'System'
    ]

    "Project initialize"
! !

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

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

    self createMakefile.
    self createProtoMakefile.
    self createSourcefiles.
    self createClassListFile.
    self createAbbreviationFile
!

createSourcefiles
    "creates all st-source files"

    |d f s abbrev classSymbol|

    d := (properties at:#directoryName) asFilename.
    (properties at:#classes) 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.
            (Smalltalk at:classSymbol) fileOutOn:s.
            s close
        ]
    ].
!

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

    |d f in out|

    d := (properties at:#directoryName) asFilename.
    f := d construct:'classList.stc'.
    out := f writeStream.

    in := './classList.stc' asFilename readStream.
    out nextPutAll:in contents asString.
    in close.

    (properties at:#classes) do:[:aClassSymbol |
        (Smalltalk includesKey:aClassSymbol) ifFalse:[
            Transcript showCr:('no class named ' , aClassSymbol)
        ] ifTrue:[
            (Smalltalk at:aClassSymbol) autoload.
            out nextPutAll:aClassSymbol; cr
        ]
    ].
    out close.
!

createAbbreviationFile
    "creates abbrev.stc"

    |d f s abbrev|

    d := (properties at:#directoryName) asFilename.
    f := d construct:'abbrev.stc'.
    s := f writeStream.
    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|

    d := (properties at:#directoryName) asFilename.
    f := d construct:'Makefile'.
    out := f writeStream.
    in := '/usr/local/lib/smalltalk/rules/stdHeader' asFilename readStream.
    out nextPutAll:in contents asString.
    in close.
    out nextPutAll:'TOP=/usr/local/lib/smalltalk'; 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 := '/usr/local/lib/smalltalk/configurations/myConf' asFilename readStream.
    out nextPutAll:in contents asString.
    in close.
    in := '/usr/local/lib/smalltalk/rules/stdRules' asFilename readStream.
    out nextPutAll:in contents asString.
    in close.
    out close
!

createProtoMakefile
    "creates a Make.proto file"

    |d f s type|


    d := (properties at:#directoryName) asFilename.
    f := d construct:'Make.proto'.
    f exists ifTrue:[
        f renameTo:(d construct:'Make.proto.bak')
    ].
    s := f writeStream.
    s nextPutAll:'#
# created by Smalltalk
#
SHELL=/bin/sh

SUBDIRS=
TOP=/usr/local/lib/smalltalk
LIBRUN=$(TOP)/librun.$(A)
LIBBASIC=$(TOP)/libbasic.$(A)
LIBVIEW=$(TOP)/libview.$(A)
LIBWIDG=$(TOP)/libwidg.$(A)
LIBCOMP=$(TOP)/libcomp.$(A)
LIBBASICOBJ=$(TOP)/libbasic$(OBJNAME)
LIBVIEWOBJ=$(TOP)/libview$(OBJNAME)
LIBWIDGOBJ=$(TOP)/libwidg$(OBJNAME)
LIBCOMPOBJ=$(TOP)/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].
    s nextPutAll:'LIBNAME=lib' , (properties at:#applicationName); cr.

    type == #executable ifTrue:[
        s nextPutAll:'PROGS = ' , (properties at:#applicationName); cr
    ].
    (properties includesKey:#startupClass) ifTrue:[
        s nextPutAll:'STARTUP_CLASS=' , (properties at:#startupClass).
        s cr.
    ].
    (properties includesKey:#startupSelector) ifTrue:[
        s nextPutAll:'STARTUP_SELECTOR="' , (properties at:#startupSelector).
        s nextPutAll:'"'; cr.
    ].

    s nextPutAll:'OBJS='.
    (properties at:#classes) 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:(properties at:#applicationName).
        s nextPutAll:':: main.o classList.o $(OBJS)'; cr.
        s tab;      nextPutAll:'$(LD) $(LDFLAGS) -o ';
                    nextPutAll:(properties at:#applicationName);
                    nextPutAll:' \'; cr.
        s tab; tab; nextPutAll:'$(CRT0) main.o classList.o $(OBJS) $(LIBOBJS) \'; cr.
        s tab; tab; nextPutAll:'$(LIBRUNDIR)/hidata.o $(LIBRUN) \'; cr.
        s tab; tab; nextPutAll:'$(MATHLIB) $(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!