--- a/Project.st Fri May 19 15:33:11 1995 +0200
+++ b/Project.st Wed May 24 14:44:58 1995 +0200
@@ -23,7 +23,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Project.st,v 1.19 1995-05-06 04:26:35 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Project.st,v 1.20 1995-05-24 12:43:54 claus Exp $
'!
!Project class methodsFor:'documentation'!
@@ -44,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Project.st,v 1.19 1995-05-06 04:26:35 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Project.st,v 1.20 1995-05-24 12:43:54 claus Exp $
"
!
@@ -178,21 +178,6 @@
^ views asArray
!
-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
-
-!
-
name:aString
name := aString.
self == CurrentProject ifTrue:[
@@ -227,6 +212,55 @@
]
! !
+!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
+
+!
+
+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.
+
+ methods := IdentitySet new.
+ Smalltalk allBehaviorsDo:[:cls |
+ (classes isNil or:[(classes includes:cls) not]) ifTrue:[
+ cls methodArray do:[:m |
+ m package = packageName ifTrue:[
+ methods add:m
+ ]
+ ].
+ cls class methodArray do:[:m |
+ m package = packageName ifTrue:[
+ methods add:m
+ ]
+ ].
+ ]
+ ].
+ ^ methods asArray
+
+ "
+ Project current classes
+ Project current individualMethods
+ "
+! !
+
!Project methodsFor:'views'!
addView:aView
@@ -276,7 +310,7 @@
name := 'new Project-' , numString.
packageName := 'private-' , numString.
- changeSet := ChangeSet new.
+ "/ changeSet := ChangeSet new.
self directory:'.'
! !
@@ -315,12 +349,10 @@
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.
+ directoryName asFilename exists ifFalse:[
+ (self confirm:'create new projectDirectory: ' , directoryName)
+ ifFalse:[^ self].
+ OperatingSystem recursiveCreateDirectory:directoryName.
].
self createMakefile.
self createSourcefiles.
@@ -330,7 +362,7 @@
createSourcefiles
"creates all Smalltalk-source files in the project directory"
- |classes dir|
+ |classes methods methodClasses dir stream|
dir := FileDirectory directoryNamed:self directory.
Transcript showCr:'creating sources in ' , dir pathName , ' ...'; endEntry.
@@ -345,6 +377,44 @@
aClass fileOutIn:dir
]
].
+
+ methods := self individualMethods.
+ methods notNil ifTrue:[
+ methods := methods asIdentitySet.
+ "
+ get classes ...
+ "
+ methodClasses := IdentitySet new.
+ methods do:[:m |
+ |mCls|
+
+ mCls := m who at:1.
+ mCls isMeta ifTrue:[
+ mCls := mCls soleInstance.
+ ].
+ methodClasses add:mCls].
+ "
+ fileOut by class
+ "
+ methodClasses do:[:cls |
+ stream := self directory asFilename construct:(cls name , '.chg') writeStream.
+
+ methods do:[:m |
+ |mCls|
+
+ mCls := m who at:1.
+ (mCls == cls or:[mCls == cls class]) ifTrue:[
+ m fileOutOn:stream.
+ ]
+ ].
+ stream close.
+ ].
+
+ methods do:[:aClass |
+ Transcript show:' ... '; showCr:aClass name; endEntry.
+ aClass fileOutIn:dir
+ ]
+ ].
!
createMakefile
@@ -355,7 +425,7 @@
Transcript showCr:'creating Makefile'.
- d := (properties at:#directoryName) asFilename.
+ d := directoryName asFilename.
f := d construct:'Makefile'.
f exists ifTrue:[
f renameTo:(d construct:'Makefile.bak')
@@ -387,12 +457,12 @@
createProtoMakefile
"creates a Make.proto file"
- |d f s type appName|
+ |d f s type appName libName startUpClass startUpSelector|
Transcript showCr:'creating Make.proto'.
- d := (properties at:#directoryName) asFilename.
+ d := directoryName asFilename.
f := d construct:'Make.proto'.
f exists ifTrue:[
f renameTo:(d construct:'Make.proto.bak')
@@ -413,17 +483,27 @@
'.
- type := properties at:#projectType ifAbsent:[#executable].
+ type := #library.
+ appName := 'app'.
+ libName := 'lib'.
+ startUpClass := 'Smalltalk'.
+ startUpSelector := 'start'.
- appName := properties at:#applicationName ifAbsent:['app'].
+ 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:'LIBNAME=lib' , appName; cr.
type == #executable ifTrue:[
s nextPutAll:'PROGS = ' , appName; cr
].
- s nextPutAll:'STARTUP_CLASS=' , (properties at:#startupClass ifAbsent:['Smalltalk']).
+ s nextPutAll:'STARTUP_CLASS=' , startUpClass.
s cr.
- s nextPutAll:'STARTUP_SELECTOR="' , (properties at:#startupSelector ifAbsent:['start']).
+ s nextPutAll:'STARTUP_SELECTOR="' , startUpSelector.
s nextPutAll:'"'; cr.
s nextPutAll:'OBJS='.