"
COPYRIGHT (c) 1990 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.
"
Object subclass:#Project
instanceVariableNames:'name changeSet views properties'
classVariableNames:'CurrentProject'
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
"
$Header: /cvs/stx/stx/libbasic/Project.st,v 1.7 1994-06-02 17:20:03 claus Exp $
"
!
documentation
"
this class is still under construction.
"
! !
!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'!
views
^ views
!
views:aSetOfViews
views := aSetOfViews
!
changeSet
^ changeSet
!
changeSet:aChangeSet
changeSet := aChangeSet
!
name
^ name
!
name:aString
name := aString
! !
!Project methodsFor:'proerties'!
properties
^ properties
!
properties:p
properties := p
!
directory
^ properties at:#directoryName ifAbsent:['.']
!
directory:aDirectoryName
properties isNil ifTrue:[
properties := Dictionary new
].
properties at:#directoryName put:aDirectoryName
!
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:'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!