BeeProjectWriter.st
branchjv
changeset 4396 5333bef41730
parent 4380 d245eab75d0c
--- a/BeeProjectWriter.st	Thu Jun 21 14:57:24 2018 +0000
+++ b/BeeProjectWriter.st	Fri Feb 01 23:46:31 2019 +0000
@@ -14,7 +14,8 @@
 "{ NameSpace: Smalltalk }"
 
 Object subclass:#BeeProjectWriter
-	instanceVariableNames:'name version author timestamp description classesToBeInitialized'
+	instanceVariableNames:'name version author timestamp description classesToBeInitialized
+		writer'
 	classVariableNames:''
 	poolDictionaries:''
 	category:'Kernel-Classes-Support'
@@ -160,10 +161,12 @@
     version := timestamp := Timestamp now.
     description := 'Not yet described'.
     classesToBeInitialized := Dictionary new.
+    writer := BeeSourceWriter new.
+
 
     "/ super initialize.   -- commented since inherited method does nothing
 
-    "Modified: / 07-09-2016 / 14:39:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 26-10-2018 / 11:46:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !BeeProjectWriter methodsFor:'private'!
@@ -181,22 +184,49 @@
 
     "Created: / 02-11-2015 / 16:59:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
     "Modified: / 07-09-2016 / 14:21:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+selectClassesFrom: aCollection 
+    ^ aCollection reject:[:class | class isProjectDefinition or:[ class isSharedPool ] ]
+
+    "Created: / 29-10-2018 / 15:45:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+selectExtensionsFrom: aCollection 
+    ^ aCollection
+
+    "Created: / 29-10-2018 / 15:45:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+selectPoolsFrom: aCollection
+    ^ aCollection select:[:class | class isSharedPool ]
+
+    "Created: / 29-10-2018 / 15:45:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !BeeProjectWriter methodsFor:'source writing'!
 
 fileOut:packageID on:aStream
-    | projectDefinitionClass revinfo classesToFileout methodsToFileOut |
+    | projectDefinitionClass revinfo classes extensions |
 
     projectDefinitionClass := packageID asPackageId projectDefinitionClass.
     classesToBeInitialized := OrderedCollection new.
 
+    name := projectDefinitionClass name.
+    writer project: name.
+    description := projectDefinitionClass description.  
+
     revinfo := projectDefinitionClass revisionInfo.
-    name := projectDefinitionClass name.
-    version := revinfo revision.
-    author := revinfo author asString.
-    timestamp := Timestamp fromDate: revinfo date andTime: revinfo time.
-    description := projectDefinitionClass description.  
+    revinfo notNil ifTrue:[ 
+        version := revinfo revision.
+        author := revinfo author asString.
+        timestamp := Timestamp fromDate: (Date readFrom: revinfo date) andTime: (Time readFrom: revinfo time).
+    ] ifFalse:[ 
+        version := Timestamp now printString.
+        author := UserPreferences current historyManagerSignature.
+        timestamp := Timestamp now.
+    ].
+
 
     aStream lineEndCRLF.
 
@@ -204,23 +234,22 @@
     projectDefinitionClass notNil ifTrue:[
         projectDefinitionClass autoload.
         projectDefinitionClass ensureFullyLoaded.
-        classesToFileout := Smalltalk allClassesInPackage:packageID.
+        classes := Smalltalk allClassesInPackage:packageID.
     ] ifFalse:[
-        classesToFileout := Smalltalk allClassesInPackage:packageID.
-        classesToFileout := classesToFileout collect:[:each | each autoload].
+        classes := Smalltalk allClassesInPackage:packageID.
+        classes := classes collect:[:each | each autoload].
     ].
 
-    methodsToFileOut := projectDefinitionClass extensions.
-
-    self activityNotification:'checking for unportable unicode...'.
+    extensions := projectDefinitionClass extensionMethods.
 
     self fileOutHeaderOn:aStream.
-    self fileOutClasses: classesToFileout on: aStream.
-    self fileOutExtensions: methodsToFileOut on: aStream.
+    self fileOutPools: (self selectPoolsFrom:classes) on:  aStream. 
+    self fileOutClasses: (self selectClassesFrom:classes) on: aStream.
+    self fileOutExtensions: (self selectExtensionsFrom:extensions) on: aStream.
     self fileOutFooterOn: aStream.
 
     "Created: / 14-04-2015 / 13:42:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-    "Modified: / 07-09-2016 / 14:34:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 30-10-2018 / 14:43:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 fileOutClasses:arg1 on:arg2
@@ -244,6 +273,19 @@
     "raise an error: must be redefined in concrete subclass(es)"
 
     ^ self subclassResponsibility
+!
+
+fileOutPools: pools on: stream
+    ^ self subclassResponsibility
+
+    "Created: / 29-10-2018 / 15:40:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!BeeProjectWriter class methodsFor:'documentation'!
+
+version_HG
+
+    ^ '$Changeset: <not expanded> $'
 ! !