--- 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> $'
! !