Project.st
changeset 356 6c5ce0e1e7a8
parent 338 20376737bdaf
child 362 4131e87e79ec
--- 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='.