more attributes; some preparations for the ProjectBrowser.
"
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.
"
Object subclass:#Project
instanceVariableNames:'name changeSet views directoryName properties packageName
repositoryDirectory repositoryModule defaultNameSpace
overwrittenMethods subProjects prerequisites bitmapFiles
documentFiles otherFiles'
classVariableNames:'CurrentProject SystemProject NextSequential AllProjects'
poolDictionaries:''
category:'System-Support'
!
!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.
"
!
documentation
"
this class is still under construction (especially the build features are unfinished).
Currently, all it does is keep track of per-project views
(to hide or show them), define the directory when filing-out,
and define packageNames for new classes and methods.
instance variables:
name <String> the name of this project, as shown
in a ProjectView
changeSet <ChangeSet> changes done, while this was the active project
views <Collection> views opened while this was the active project
directoryName <String> directory name, where fileOuts are done
properties
packageName <String> given to classes/methods which are created while
this is the active project
repositoryDirectory (default) name of the repository, when a new source containers are
created.
repositoryModule (default) name of the module, when new source containers are
created.
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.
[author:]
Claus Gittinger
"
! !
!Project class methodsFor:'initialization'!
initKnownProjects
"this is a temporary experimental kludge -
once the ProjectBrowser is finished, this info is read from
'.prj' files ..."
|stx p|
stx := self new name:'stx'.
stx packageName:'noPackage'.
stx changeSet:nil.
stx type:#smalltalk.
stx comment:'ST/X itself'.
AllProjects add:stx.
#(
('libbasic' 'Basic (non-GUI) classes. Required for all applications')
('libbasic2' 'More basic (non-GUI) classes. Required for most applications')
('libbasic3' 'More basic (non-GUI) classes. Required for development')
('libcomp' 'The bytecode compiler. Required for all applications')
('libview' 'Low level GUI classes. Required for all GUI applications')
('libview2' 'Additional low level GUI classes. Required for most GUI applications')
('libwidg' 'Basic widgets. Required for all GUI applications')
('libwidg2' 'More widgets. Required for most GUI applications')
('libwidg3' 'More (fun) widgets. Seldom required')
('libtool' 'Development applications. Required for program development')
('libtool2' 'More development applications. Required for GUI development')
('libui' 'UI spec classes. Required for UIPainter applications')
('libhtml' 'HTML related classes. Required for Web applications and the HTML browser')
) do:[:entry |
|libName comment|
libName := entry at:1.
comment := entry at:2.
p := self new name:libName.
p packageName:libName.
p type:#library.
p comment:comment.
stx addSubProject:p.
].
"
self initKnownProjects
"
!
initialize
SystemProject isNil ifTrue:[
NextSequential := 1.
SystemProject := self new name:'default'.
SystemProject packageName:'private'.
SystemProject defaultNameSpace:Smalltalk.
SystemProject comment:'A default (dummy) project.
Will be made the current project in case no real project is ever activated.'.
"
the SystemProject does not keep a record if changes,
but instead depends on the changes file - recording anything there.
"
SystemProject changeSet:nil.
].
CurrentProject := SystemProject.
AllProjects := OrderedCollection with:SystemProject.
self initKnownProjects.
"
SystemProject := nil.
Project initialize
"
! !
!Project class methodsFor:'instance creation'!
new
^ self basicNew initialize
! !
!Project class methodsFor:'accessing'!
current
"return the currently active project"
^ CurrentProject
"
Project current
"
!
current:aProject
"set the currently active project"
CurrentProject := aProject.
self changed:#currentProject
!
currentPackageName
CurrentProject notNil ifTrue:[
^ CurrentProject packageName
].
^ 'no package'
"
Project currentPackageName
"
!
defaultProject
"return the SystemDefault project"
^ SystemProject.
!
knownProjects
^ AllProjects ? #()
!
setDefaultProject
"set the currently active project to be the SystemDEfault project"
self current:SystemProject.
!
setProject:aProjectOrNil
"set the currently active project without updating others"
CurrentProject := aProjectOrNil.
"Created: 7.2.1996 / 14:00:45 / cg"
"Modified: 7.2.1996 / 14:01:16 / cg"
! !
!Project class methodsFor:'changes management'!
addClassDefinitionChangeFor:aClass
"add a class-def-change for aClass to the current project"
|p c|
p := CurrentProject.
(p notNil
and:[(c := p changeSet) notNil]) ifTrue:[
c addClassDefinitionChangeFor:aClass
]
"Created: 3.12.1995 / 13:44:58 / cg"
"Modified: 3.12.1995 / 13:58:04 / cg"
!
addMethodCategoryChange:aMethod category:newCategory in:aClass
"add a method-category-change for aMethod in aClass to the current project"
|p c|
p := CurrentProject.
(p notNil
and:[(c := p changeSet) notNil]) ifTrue:[
c addMethodCategoryChange:aMethod category:newCategory in:aClass
]
!
addMethodChange:aMethod in:aClass
"add a method change in aClass to the current project"
|p c|
p := CurrentProject.
(p notNil
and:[(c := p changeSet) notNil]) ifTrue:[
c addMethodChange:aMethod in:aClass
]
!
addMethodPrivacyChange:aMethod in:aClass
"add a privacy change for aMethod in aClass to the current project"
|p c|
p := CurrentProject.
(p notNil
and:[(c := p changeSet) notNil]) ifTrue:[
c addMethodPrivacyChange:aMethod in:aClass
]
"Modified: 27.8.1995 / 22:48:17 / claus"
!
addPrimitiveDefinitionsChangeFor:aClass
"add a primitiveDef change for aClass to the current project"
|p c|
p := CurrentProject.
(p notNil
and:[(c := p changeSet) notNil]) ifTrue:[
c addPrimitiveDefinitionsChangeFor:aClass
]
!
addPrimitiveFunctionsChangeFor:aClass
"add a primitiveFuncs change for aClass to the current project"
|p c|
p := CurrentProject.
(p notNil
and:[(c := p changeSet) notNil]) ifTrue:[
c addPrimitiveFunctionsChangeFor:aClass
]
!
addPrimitiveVariablesChangeFor:aClass
"add a primitiveVars change for aClass to the current project"
|p c|
p := CurrentProject.
(p notNil
and:[(c := p changeSet) notNil]) ifTrue:[
c addPrimitiveVariablesChangeFor:aClass
]
!
addRemoveSelectorChange:aSelector in:aClass
"add a method-remove change in aClass to the current project"
|p c|
p := CurrentProject.
(p notNil
and:[(c := p changeSet) notNil]) ifTrue:[
c addRemoveSelectorChange:aSelector in:aClass
]
"Created: / 16.2.1998 / 12:45:10 / cg"
!
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 := Filename currentDirectory name
].
^ dirName
"Modified: 7.9.1997 / 23:52:25 / cg"
!
rememberOverwrittenMethod:newMethod from:oldMethod
"remember a method (from another package) being overwritten.
This is only remembered, if the current project is not the
system project (to avoid filling this remembered-table)"
|p|
p := CurrentProject.
(p notNil
and:[p ~~ SystemProject]) ifTrue:[
p rememberOverwrittenMethod:newMethod from:oldMethod
] ifFalse:[
"/ 'Project [info]: DefaultProject does not remember overwritten methods' infoPrintCR
]
"Modified: / 7.3.1998 / 13:38:39 / cg"
! !
!Project methodsFor:'accessing'!
addSubProject:aProject
subProjects isNil ifTrue:[
subProjects := OrderedCollection new.
].
subProjects add:aProject
!
changeSet
"return the set of changes made in this project"
^ changeSet
"Modified: 27.1.1997 / 11:58:36 / cg"
!
changeSet:aChangeSet
"set the set of changes made in this project - dangerous, you may loose
the actual changeSet."
changeSet := aChangeSet
"Modified: 27.1.1997 / 11:59:02 / cg"
!
defaultNameSpace
"return the defaultNameSpace of this project.
New classes will (if not specified by a directive) be installed
in this nameSpace. Useful, when filing in ST-80 code, to avoid
overwriting of standard classes."
^ defaultNameSpace
"Created: 2.1.1997 / 19:54:42 / cg"
"Modified: 27.1.1997 / 11:59:53 / cg"
!
defaultNameSpace:aNamespace
"set the defaultNameSpace of this project.
New classes will (if not specified by a directive) be installed
in this nameSpace. Useful, when filing in ST-80 code, to avoid
overwriting of standard classes."
defaultNameSpace := aNamespace.
self == CurrentProject ifTrue:[
Project changed:#defaultNameSpace
]
"Created: 2.1.1997 / 19:54:37 / cg"
"Modified: 27.1.1997 / 12:00:01 / cg"
!
directory
"return the projects directory.
If not specified, a fileOut will be done into that directory"
directoryName isNil ifTrue:[^ '.'].
^ directoryName
"Modified: 27.1.1997 / 12:00:41 / cg"
!
directory:aDirectoryName
"set the projects directory.
If not specified, a fileOut will be done into that directory"
directoryName := aDirectoryName.
self == CurrentProject ifTrue:[
Project changed:#directory
]
"Modified: 27.1.1997 / 12:00:47 / cg"
!
name
"return the projects name.
This is for the user only - shown in the projectViews label"
^ name
"Modified: 27.1.1997 / 12:01:16 / cg"
!
name:aString
"set the projects name.
This is for the user only - shown in the projectViews label"
name := aString.
self == CurrentProject ifTrue:[
Project changed:#name
]
"Modified: 27.1.1997 / 12:01:09 / cg"
!
overwrittenMethods
"return the set of methods which were overwritten in this project.
This information allows uninstalling, by switching back to the
original methods."
^ overwrittenMethods
"Created: 27.1.1997 / 11:57:21 / cg"
"Modified: 27.1.1997 / 12:09:14 / cg"
!
packageName
"return the projects package identifier.
This identifier marks all methods and new classes which were created
in this project."
^ packageName
"Modified: 27.1.1997 / 12:10:00 / cg"
!
packageName:aStringOrSymbol
"set the projects package identifier.
This identifier marks all methods and new classes which were created
in this project."
packageName := aStringOrSymbol asSymbol.
self == CurrentProject ifTrue:[
Project changed:#package
]
"Modified: 27.1.1997 / 12:10:09 / cg"
!
prerequisites
^ prerequisites ? #()
!
repositoryDirectory
"return the projects default repository location.
This is offered initially, when classes are checked into the
source repository initially"
^ repositoryDirectory
"Created: 25.11.1995 / 18:04:51 / cg"
"Modified: 27.1.1997 / 12:13:35 / cg"
!
repositoryDirectory:aRelativePathName
"set the projects default repository location.
This will be offered initially, when classes are checked into the
source repository initially"
repositoryDirectory := aRelativePathName
"Created: 25.11.1995 / 18:05:06 / cg"
"Modified: 27.1.1997 / 12:13:28 / cg"
!
repositoryModule
"return the projects default repository module name.
This is offered initially, when classes are checked into the
source repository initially"
^ repositoryModule
"Created: 25.11.1995 / 18:04:51 / cg"
"Modified: 27.1.1997 / 12:13:50 / cg"
!
repositoryModule:aString
"set the projects default repository module name.
This is offered initially, when classes are checked into the
source repository initially"
repositoryModule := aString
"Created: 25.11.1995 / 18:05:06 / cg"
"Modified: 27.1.1997 / 12:13:57 / cg"
!
subProjects
^ subProjects ? #()
!
views
"return a collection of views which were opened in this project"
^ views asArray
"Modified: 27.1.1997 / 12:14:18 / cg"
!
views:aSetOfViews
"set the collection of views which were opened in this project"
views := WeakIdentitySet withAll:aSetOfViews
"Modified: 27.1.1997 / 12:14:26 / cg"
! !
!Project methodsFor:'changes'!
rememberOverwrittenMethod:newMethod from:oldMethod
"this is sent whenever a method is installed, which overwrites
an existing method from a different package.
Allows previous methods to be reconstructed."
overwrittenMethods isNil ifTrue:[
overwrittenMethods := IdentityDictionary new.
].
overwrittenMethods at:newMethod put:oldMethod
"Created: 27.1.1997 / 11:52:01 / cg"
"Modified: 30.1.1997 / 21:10:51 / cg"
! !
!Project methodsFor:'initialization'!
initialize
|numString|
views := WeakIdentitySet new.
numString := NextSequential printString.
NextSequential := NextSequential + 1.
name := 'new Project-' , numString.
packageName := 'private-' , numString.
defaultNameSpace := Smalltalk.
"/
"/ for tiny-configurations, allow ChangeSet to be absent
"/
ChangeSet notNil ifTrue:[
changeSet := ChangeSet new.
].
self directory:'.'.
self repositoryModule:(OperatingSystem getLoginName).
self repositoryDirectory:'private'
"Created: 25.11.1995 / 18:05:44 / cg"
"Modified: 3.1.1997 / 13:24:10 / cg"
! !
!Project methodsFor:'load & save'!
loadFromProjectFile:aFilename
|f s l|
f := aFilename asFilename.
self directory:(f directory pathName).
s := f readStream.
self loadFromProjectFileStream:s.
s close.
"
Project current saveAsProjectFile.
Project new loadFromProjectFile:'default.prj'
"
!
loadFromProjectFileStream:aStream
|s l|
s := aStream.
l := s nextLine.
[s atEnd] whileFalse:[
(l startsWith:';') ifTrue:[
l := s nextLine.
] ifFalse:[
l asLowercase = '[name]' ifTrue:[
l := s nextLine.
name := Object readFromString:l.
l := s nextLine.
] ifFalse:[l asLowercase = '[type]' ifTrue:[
l := s nextLine.
self type:(Object readFromString:l).
l := s nextLine.
] ifFalse:[l asLowercase = '[subprojects]' ifTrue:[
l := s nextLine.
[l notNil and:[(l startsWith:'[') not]] whileTrue:[
l := s nextLine.
].
] ifFalse:[l asLowercase = '[prerequisites]' ifTrue:[
l := s nextLine.
[l notNil and:[(l startsWith:'[') not]] whileTrue:[
l := s nextLine.
].
] ifFalse:[l asLowercase = '[classes]' ifTrue:[
l := s nextLine.
[l notNil and:[(l startsWith:'[') not]] whileTrue:[
l := s nextLine.
].
] ifFalse:[l asLowercase = '[package]' ifTrue:[
l := s nextLine.
self packageName:(Object readFromString:l).
l := s nextLine.
] ifFalse:[
self halt.
]]]]]]
]
].
"
Project current saveOn:Transcript
"
!
saveAsProjectFile
|fn s|
fn := self directory asFilename.
fn := fn construct:self name.
fn := fn withSuffix:'prj'.
s := fn writeStream.
self saveAsProjectFileOn:s.
s close.
"
Project current saveAsProjectFile
"
!
saveAsProjectFileOn:aStream
|s coll|
s := aStream.
s nextPutLine:'[name]'.
s tab. s nextPutLine:(name storeString).
s nextPutLine:'[type]'.
s tab. s nextPutLine:(self type storeString).
s nextPutLine:'[package]'.
s tab. s nextPutLine:(self packageName storeString).
coll := self subProjects.
coll size > 0 ifTrue:[
s nextPutLine:'[subprojects]'.
coll do:[:aSubProject |
s tab. s nextPutLine:(aSubProject name soreString).
].
].
coll := self prerequisites.
coll size > 0 ifTrue:[
s nextPutLine:'[prerequisites]'.
coll do:[:aProject |
s tab. s nextPutLine:(aProject name soreString).
].
].
coll := self classes.
coll size > 0 ifTrue:[
s nextPutLine:'[classes]'.
coll do:[:aClass |
s tab. s nextPutLine:(aClass name).
]
]
"
Project current saveOn:Transcript
"
! !
!Project methodsFor:'maintenance'!
buildProject
OperatingSystem executeCommand:('cd ' , self directory , ' ; make')
!
createMakefile
"creates an initial makefile, which will recreate a correct
Makefile, then compile all"
|d f out in topName|
Transcript showCR:'creating Makefile'.
d := 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.
topName := self findTopFrom:directoryName.
out nextPutAll:'#TOP=/usr/local/lib/smalltalk'; cr.
out nextPutAll:'TOP=' , topName; 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/COMMON/defines'.
out nextPutAll:in contents asString.
in close.
in := Smalltalk systemFileStreamFor:'configurations/vendorConf'.
out nextPutAll:in contents asString.
in close.
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
"Modified: 18.5.1996 / 15:44:25 / cg"
!
createProjectFiles
"actually, creates all files to do a make in the project directory"
directoryName asFilename exists ifFalse:[
(self confirm:'create new projectDirectory: ' , directoryName)
ifFalse:[^ self].
OperatingSystem recursiveCreateDirectory:directoryName.
].
self createMakefile.
self createSourcefiles.
self createProtoMakefile.
!
createProtoMakefile
"creates a Make.proto file"
|d f s type appName libName startUpClass startUpSelector
topName classes|
topName := self findTopFrom:directoryName.
Transcript showCR:'creating Make.proto'.
d := 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:'#
# ' , Smalltalk timeStamp , '
#
# created by Smalltalks Project support
#
# the next line defines the path to the TOP directory,
# (where the directories "configurations" and "include" are found)
#
#TOP=/usr/local/lib/smalltalk
TOP=' , topName ,'
#
# add any subdirectories that have to be visited by make
#
SUBDIRS=
#
# do not change
#
SHELL=/bin/sh
'.
s nextPutAll:'#
# set the stc options
#
STCOPT=$(DEFAULT_STCOPT)
# STCOPT=+optspace2
# STCOPT=+optspace2 -warnNonStandard
#
# and packageName option
#
STCLOCALOPT=''-Pprivate-classes-(libapp)''
'.
type := #library.
appName := 'app'.
libName := 'lib'.
startUpClass := 'Smalltalk'.
startUpSelector := 'start'.
properties notNil ifTrue:[
type := properties at:#projectType ifAbsent:type.
appName := properties at:#applicationName ifAbsent:appName.
startUpClass := properties at:#startupClass ifAbsent:startUpClass.
startUpSelector := properties at:#startupSelector ifAbsent:startUpSelector.
].
s nextPutAll:'#
# define the name of the library to create
#
'.
s nextPutAll:'LIBNAME=lib' , appName; cr; cr.
s nextPutAll:'#
# the target rule:
#
all:: abbrev.stc objs genClassList $(OBJTARGET)
'.
type == #executable ifTrue:[
s nextPutAll:'PROGS = ' , appName; cr.
s nextPutAll:('STARTUP_CLASS=' , startUpClass); cr.
s nextPutAll:'STARTUP_SELECTOR="' , startUpSelector; nextPutAll:'"'; cr.
].
s nextPutAll:'#
# define the object files that are to be created
#
'.
s nextPutAll:'OBJS='.
(classes := self classes) notNil ifTrue:[
classes do:[:aClass |
|abbrev|
s nextPutAll:' \'. s cr.
abbrev := Smalltalk fileNameForClass:aClass name.
s nextPutAll:' '; nextPutAll:abbrev; nextPutAll:'.o'.
].
].
s cr; cr.
s nextPutAll:'#
# dependencies:
#
I=$(TOP)/include
RT_STUFF=$(I)/Object.H $(I)/stc.h $(I)/stcIntern.h
'.
classes notNil ifTrue:[
classes do:[:aClass |
|abbrev|
abbrev := Smalltalk fileNameForClass:aClass name.
s nextPutAll:abbrev; nextPutAll:'.o: '.
s nextPutAll:abbrev; nextPutAll:'.st '.
aClass allSuperclassesDo:[:superClass|
s nextPutAll:'$(I)/'.
s nextPutAll:(Smalltalk fileNameForClass:superClass name) , '.H '.
].
s nextPutAll:'$(RT_STUFF)'; cr.
].
].
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
"Modified: 18.5.1996 / 15:44:28 / cg"
!
createSourcefiles
"creates all Smalltalk-source files in the project directory"
|classes methods methodClasses dir stream|
dir := self directory asFilename.
Transcript showCR:'creating sources in ' , dir pathName , ' ...'; endEntry.
classes := self classes.
classes isNil ifTrue:[
self warn:'no classes in current project'
].
classes notNil ifTrue:[
classes do:[:aClass |
aClass isLoaded ifFalse:[
aClass autoload.
].
].
classes := classes topologicalSort:[:a :b | a isSubclassOf:b].
classes do:[:aClass |
Transcript show:' ... '; showCR:aClass name, '.st'; endEntry.
aClass fileOutIn:dir
]
].
methods := self individualMethods.
methods notNil ifTrue:[
methods := methods asIdentitySet.
"
get classes ...
"
methodClasses := IdentitySet new.
methods do:[:m |
|mCls|
mCls := m containingClass.
mCls isMeta ifTrue:[
mCls := mCls soleInstance.
].
methodClasses add:mCls].
"
fileOut by class
"
methodClasses do:[:cls |
stream := (self directory asFilename construct:(cls name , '.chg')) writeStream.
Transcript show:' ... '; showCR:cls name, '.chg'; endEntry.
methods do:[:m |
|mCls|
mCls := m containingClass.
(mCls == cls or:[mCls == cls class]) ifTrue:[
mCls fileOutMethod:m on:stream.
].
stream cr.
].
stream close.
].
].
"Modified: 1.11.1996 / 16:37:15 / cg"
"Modified: 18.9.1997 / 18:50:34 / stefan"
!
findTopFrom:directoryName
"returns the relative path from directoryName to the TOP
directory."
|topName relParent foundTop|
"/ find TOP
relParent := '..'.
foundTop := false.
[foundTop] whileFalse:[
topName := directoryName , '/' , relParent.
topName asFilename pathName = '/' ifTrue:[
self warn:'could not find TOP; assume absoulte path to TOP'.
topName := '/usr/local/lib/smalltalk'.
foundTop := true.
] ifFalse:[
(topName , '/configurations') asFilename exists ifTrue:[
(topName , '/include') asFilename exists ifTrue:[
foundTop := true.
topName := relParent.
]
].
foundTop ifFalse:[
relParent := relParent , '/..'.
]
]
].
^ topName
! !
!Project methodsFor:'printing & storing'!
displayString
^ super displayString , '(''' , (name ? '<unnamed>') , ''')'
! !
!Project methodsFor:'properties'!
comment
"return the comment of the project"
properties isNil ifTrue:[^ ''].
^ properties at:#comment ifAbsent:''
!
comment:aString
"set the projects comment"
properties isNil ifTrue:[
properties := IdentityDictionary new
].
properties at:#comment put:aString
!
properties
^ properties
!
properties:p
properties := p
!
type
"return the type of project"
properties isNil ifTrue:[^ #application].
^ properties at:#type ifAbsent:#application
!
type:aSymbol
"set the projects type"
(#(application library smalltalk) includes:aSymbol) ifFalse:[
self warn:'invalid project type'.
^ self
].
properties isNil ifTrue:[
properties := IdentityDictionary new
].
properties at:#type put:aSymbol
! !
!Project methodsFor:'queries'!
classes
"return a collection of classes belonging to that project"
|classes|
properties notNil ifTrue:[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
"Modified: 4.1.1997 / 16:51:18 / cg"
!
individualMethods
"return a collection of individual methods belonging to that project,
only methods are returned which are not contained in the
projects class set."
|classes methods|
classes := self classes.
classes notNil ifTrue:[
classes := classes asIdentitySet.
] ifFalse:[
classes := #()
].
methods := IdentitySet new.
Smalltalk allBehaviorsDo:[:cls |
(classes isNil or:[(classes includes:cls) not]) ifTrue:[
cls methodDictionary do:[:m |
m package = packageName ifTrue:[
methods add:m
]
].
cls class methodDictionary do:[:m |
m package = packageName ifTrue:[
methods add:m
]
].
]
].
^ methods asArray
"
Project current classes
Project current individualMethods
"
"Modified: 7.6.1996 / 09:16:25 / stefan"
! !
!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 methodsFor:'views'!
addView:aView
"add a view to this projects set of views"
views notNil ifTrue:[views add:aView]
"Modified: 14.2.1997 / 15:36:51 / cg"
!
destroyViews
"destroy all views of this project"
views notNil ifTrue:[
views do:[:aView |
aView notNil ifTrue:[aView destroy]
]
].
!
hideViews
"hide all views of this project"
views notNil ifTrue:[
views do:[:aView |
aView notNil ifTrue:[aView unmap]
]
].
"Modified: 3.5.1996 / 23:48:51 / stefan"
!
removeView:aView
"remove a view from this projects set of views"
views notNil ifTrue:[views remove:aView ifAbsent:[]]
"Modified: 14.2.1997 / 15:37:20 / cg"
!
showViews
"show all views of this project"
views notNil ifTrue:[
views do:[:aView |
aView notNil ifTrue:[aView remap]
]
].
"Modified: 3.5.1996 / 23:59:10 / stefan"
"Modified: 14.2.1997 / 15:38:47 / cg"
! !
!Project class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic/Project.st,v 1.60 1999-02-09 18:55:48 cg Exp $'
! !
Project initialize!