- Package writing rewritten to use new model. Writes package according to recent spec.
--- a/CypressClass.st Mon Sep 10 23:52:10 2012 +0000
+++ b/CypressClass.st Tue Sep 11 10:56:07 2012 +0000
@@ -13,7 +13,7 @@
fromClass: aClass
"Returns a CypressPackage for given (real) class"
- ^self class initializeFromClass: aClass.
+ ^self new initializeFromClass: aClass.
"Created: / 10-09-2012 / 23:48:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
@@ -49,7 +49,7 @@
at:'name' put: aClass nameWithoutPrefix;
at:'super' put: aClass superclass nameWithoutPrefix;
at:'namespace' put: aClass nameSpace nameWithoutPrefix;
- at:'superNamespace' put: aClass nameSpace nameSpace;
+ at:'superNamespace' put: aClass nameSpace nameSpace name;
at:'instvars' put: aClass instVarNames;
at:'classinstvars' put: aClass class instVarNames;
@@ -65,6 +65,12 @@
].
"Created: / 10-09-2012 / 23:48:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+initializeWithMethods: aCollection
+ methods := aCollection
+
+ "Created: / 11-09-2012 / 11:15:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!CypressClass methodsFor:'reading & writing'!
@@ -75,11 +81,61 @@
^ self shouldImplement
!
-writeTo:filename notice:copyrightNotice
- "Writes the receiver into directory/file named 'filename'
- with given copyrightNotice"
+writeTo:directory notice:copyrightNotice
+ "Writes the receiver into given 'directory' with
+ copyrightNotice in each file"
+
+ | dir |
+
+ dir := directory asFilename.
+ dir exists ifFalse: [ dir recursiveMakeDirectory ].
+
+
+ self writePropertiesTo: directory notice: copyrightNotice.
+ self writeMethodsTo: directory notice: copyrightNotice.
+
+ "Modified (comment): / 11-09-2012 / 11:19:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!CypressClass methodsFor:'reading & writing - private'!
+
+writeMethodsTo:directory notice:copyrightNotice
+ "Writes methods into given 'directory' with copyrightNotice in each file"
+
+ | obsolete instDir classDir |
+
+ instDir := directory / 'instance'.
+ classDir := directory / 'class'.
- ^ self shouldImplement
+ " collect possibly obsolete directories/files "
+ obsolete := Set new.
+ instDir exists ifTrue:[
+ obsolete add: instDir.
+ obsolete add: instDir directoryContentsAsFilenames
+ ].
+ classDir exists ifTrue:[
+ obsolete add: classDir.
+ obsolete add: classDir directoryContentsAsFilenames
+ ].
+
+ self methods do:[:cpsMthd|
+ | dir dottedSel file |
+
+ dir := cpsMthd meta ifTrue:[classDir] ifFalse:[instDir].
+ dir exists ifFalse:[ dir makeDirectory ].
+ file := dir / ((dottedSel := cpsMthd selector copyReplaceAll:$: with: $.) , '.st').
+ cpsMthd writeTo: file notice:copyrightNotice.
+ obsolete := obsolete reject:[:each|
+ each withoutSuffix baseName = dottedSel
+ ].
+ ].
+
+ " wipe out obsolete directories / files "
+ obsolete do:[:each|
+ each exists ifTrue:[ each recursiveRemove ]
+ ].
+
+ "Created: / 11-09-2012 / 11:19:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!CypressClass class methodsFor:'documentation'!
--- a/CypressJsonParser.st Mon Sep 10 23:52:10 2012 +0000
+++ b/CypressJsonParser.st Tue Sep 11 10:56:07 2012 +0000
@@ -23,8 +23,10 @@
!CypressJsonParser class methodsFor:'accessing'!
-parse: aString
- ^ self parseStream: aString readStream
+parse: aStringOrFilename
+ ^ self parseStream: aStringOrFilename readStream
+
+ "Modified (format): / 11-09-2012 / 11:38:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
parseStream: aStream
--- a/CypressMethod.st Mon Sep 10 23:52:10 2012 +0000
+++ b/CypressMethod.st Tue Sep 11 10:56:07 2012 +0000
@@ -19,10 +19,24 @@
!CypressMethod methodsFor:'accessing'!
+klass
+ ^ klass
+!
+
+meta
+ ^ meta
+!
+
package
"Returns a CypressPackage which the receiver belongs to"
^ self shouldImplement
+!
+
+selector
+ ^self name
+
+ "Created: / 11-09-2012 / 11:18:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!CypressMethod methodsFor:'initialization'!
@@ -46,10 +60,18 @@
!
writeTo:filename notice:copyrightNotice
- "Writes the receiver into directory/file named 'filename'
- with given copyrightNotice"
+ "Writes the receiver into given 'directory' with
+ copyrightNotice in each file"
- ^ self shouldImplement
+ filename writingFileDo:[:s|
+ s nextPut:$"; cr.
+ s nextPutAll: 'notice: '; nextPutAll: copyrightNotice; cr.
+ s nextPutAll: 'category: '; nextPutAll: category ? '* as yet unclassified *'; cr.
+ s nextPut:$"; cr.
+ s nextPutAll: source.
+ ].
+
+ "Modified: / 11-09-2012 / 11:36:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!CypressMethod class methodsFor:'documentation'!
--- a/CypressModel.st Mon Sep 10 23:52:10 2012 +0000
+++ b/CypressModel.st Tue Sep 11 10:56:07 2012 +0000
@@ -57,9 +57,9 @@
"Created: / 11-09-2012 / 00:18:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-writeTo: filename notice: copyrightNotice
- "Writes the receiver into directory/file named 'filename'
- with given copyrightNotice"
+writeTo: directory notice: copyrightNotice
+ "Writes the receiver into given 'directory' with
+ copyrightNotice in each file"
self subclassResponsibility
@@ -71,13 +71,26 @@
writePropertiesTo: directory notice: copyrightNotice
| props propertyFile |
- props := self properties.
+ props := self properties copy.
props isEmpty ifTrue:[ ^ self ].
propertyFile := directory / 'properties.ston'.
+
+ " add notice "
+ props at: '_cypress_copyright' put: copyrightNotice.
+
+ " be nice and do not discard properties of others. Merge them"
+ propertyFile exists ifTrue:[
+ | existing |
+ existing := CypressJsonParser parse: propertyFile.
+ existing keysAndValuesDo:[:key :value|
+ (props includesKey: key) ifFalse:[
+ props at: key put: value
+ ]
+ ]
+ ].
+
propertyFile writingFileDo:[:s|
- props copy;
- at: '_cypress_copyright' put: copyrightNotice;
- writeCypressJsonOn: s forHtml: false indent: 0.
+ props writeCypressJsonOn: s forHtml: false indent: 0.
]
"Created: / 11-09-2012 / 00:24:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
--- a/CypressPackage.st Mon Sep 10 23:52:10 2012 +0000
+++ b/CypressPackage.st Tue Sep 11 10:56:07 2012 +0000
@@ -39,6 +39,18 @@
"Created: / 10-09-2012 / 23:45:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
+extensions
+
+ extensions isNil ifTrue:[
+ extensions := definition extensions collect:[:mthd|
+ CypressMethod fromMethod: mthd
+ ]
+ ].
+ ^extensions
+
+ "Created: / 11-09-2012 / 11:03:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
package
"Returns a CypressPackage which the receiver belongs to"
@@ -67,16 +79,111 @@
^ self shouldImplement
!
-writeTo:filename notice:copyrightNotice
+writeTo: directory
+ | notice |
+
+ notice := definition legalCopyright.
+ (self properties includesKey:'licenseFile') ifTrue:[
+ notice := notice , ' (for license, see file ' , (self properties at:'licenseFile') , ')'.
+ ].
+ self writeTo: directory asFilename notice: notice.
+
+ "Created: / 11-09-2012 / 11:45:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+writeTo: directory notice:copyrightNotice
"Writes the receiver into directory/file named 'filename'
with given copyrightNotice"
- self writePropertiesTo: filename notice: copyrightNotice.
- self classes do:[:cypressCls|
- self halt.
- ]
+ | dir |
+
+ dir := directory asFilename.
+ dir exists ifFalse: [ dir recursiveMakeDirectory ].
+
+ self writePropertiesTo: dir notice: copyrightNotice.
+ self writeClassesTo: dir notice: copyrightNotice.
+ self writeExtensionsTo: dir notice: copyrightNotice.
+
+ "Modified (format): / 11-09-2012 / 11:50:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!CypressPackage methodsFor:'reading & writing - private'!
+
+writeClassesTo: directory notice:copyrightNotice
+ "Writes my classes into 'directory' with given copyrightNotice"
+
+ | obsolete |
+
+ " collect possibly obsolete .class directories "
+ obsolete := Set new.
+ directory directoryContentsAsFilenamesDo:[:each|
+ | suffix |
+
+ each suffix = 'class' ifTrue:[
+ obsolete add: each.
+ ]
+ ].
+
+ " write classes... "
+ self classes do:[:cpsCls|
+ | cpsClsDir |
+
+ cpsClsDir := directory / ((cpsCls name copyReplaceAll: $: with: $_) , '.class').
+ obsolete remove: cpsClsDir ifAbsent:[].
+ cpsCls writeTo: cpsClsDir notice:copyrightNotice
+ ].
+
+ " wipe out obsolete .class directories "
+ obsolete do:[:each|
+ each recursiveRemove.
+ ].
- "Modified: / 11-09-2012 / 00:38:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 11-09-2012 / 11:10:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+writeExtensionsTo: directory notice:copyrightNotice
+ "Writes extensions into 'directory'/file with given copyrightNotice"
+
+ | obsolete extensionsPerClass |
+
+ " group extensions by class... "
+ extensionsPerClass := Dictionary new.
+ self extensions do:[:cpsMthd |
+ (extensionsPerClass at: cpsMthd klass ifAbsentPut: [ Set new ])
+ add: cpsMthd.
+ ].
+
+ " collect possibly obsolete .extension directories "
+ obsolete := Set new.
+ directory directoryContentsAsFilenamesDo:[:each|
+ | suffix |
+
+ each suffix = 'extension' ifTrue:[
+ obsolete add: each.
+ ]
+ ].
+
+ " write individual extensions... "
+ extensionsPerClass keysAndValuesDo:[:name :cpsMthds |
+ | cpsClsDir cpsCls |
+
+ cpsClsDir := directory / ((name copyReplaceAll: $: with: $_) , '.extension').
+ obsolete remove: cpsClsDir ifAbsent:[].
+ cpsClsDir exists ifFalse: [ cpsClsDir makeDirectory ].
+
+ " Here we create fake CypressClass with only extension methods - this
+ way I can reuse logic allready coded in CypressClass. "
+ cpsCls := CypressClass new.
+ cpsCls new initializeWithMethods: cpsMthds.
+ cpsCls writeMethodsTo: cpsClsDir notice:copyrightNotice.
+ ].
+
+ " wipe out obsolete .class directories "
+ obsolete do:[:each|
+ each recursiveRemove.
+ ].
+
+ "Created: / 11-09-2012 / 11:12:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!CypressPackage class methodsFor:'documentation'!
--- a/cypress.rc Mon Sep 10 23:52:10 2012 +0000
+++ b/cypress.rc Tue Sep 11 10:56:07 2012 +0000
@@ -3,7 +3,7 @@
// automagically generated from the projectDefinition: stx_goodies_cypress.
//
VS_VERSION_INFO VERSIONINFO
- FILEVERSION 6,2,11,11
+ FILEVERSION 6,2,12,12
PRODUCTVERSION 6,2,3,1
#if (__BORLANDC__)
FILEFLAGSMASK VS_FF_DEBUG | VS_FF_PRERELEASE
@@ -18,14 +18,14 @@
BEGIN
BLOCK "040904E4"
BEGIN
- VALUE "CompanyName", "eXept Software AG\0"
- VALUE "FileDescription", "Smalltalk/X Class library (LIB)\0"
- VALUE "FileVersion", "6.2.11.11\0"
+ VALUE "CompanyName", "Jan Vrany\0"
+ VALUE "FileDescription", "Cypress Package Format Reader/Writer (LIB)\0"
+ VALUE "FileVersion", "6.2.12.12\0"
VALUE "InternalName", "stx:goodies/cypress\0"
- VALUE "LegalCopyright", "Copyright Claus Gittinger 1988-2012\nCopyright eXept Software AG 1998-2012\0"
- VALUE "ProductName", "Smalltalk/X\0"
+ VALUE "LegalCopyright", "Copyright Jan Vrany & Dale Henrichs 2012\0"
+ VALUE "ProductName", "Cypress\0"
VALUE "ProductVersion", "6.2.3.1\0"
- VALUE "ProductDate", "Mon, 10 Sep 2012 23:52:23 GMT\0"
+ VALUE "ProductDate", "Tue, 11 Sep 2012 10:56:01 GMT\0"
END
END
--- a/stx_goodies_cypress.st Mon Sep 10 23:52:10 2012 +0000
+++ b/stx_goodies_cypress.st Tue Sep 11 10:56:07 2012 +0000
@@ -137,19 +137,25 @@
companyName
"Return a companyname which will appear in <lib>.rc"
- ^ 'eXept Software AG'
+ ^ 'Jan Vrany'
+
+ "Modified: / 11-09-2012 / 11:54:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
description
"Return a description string which will appear in vc.def / bc.def"
- ^ 'Smalltalk/X Class library'
+ ^ 'Cypress Package Format Reader/Writer'
+
+ "Modified: / 11-09-2012 / 11:54:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
legalCopyright
"Return a copyright string which will appear in <lib>.rc"
- ^ 'Copyright Claus Gittinger 1988-2012\nCopyright eXept Software AG 1998-2012'
+ ^ 'Copyright Jan Vrany & Dale Henrichs 2012'
+
+ "Modified: / 11-09-2012 / 11:54:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
productInstallDirBaseName
@@ -162,7 +168,9 @@
productName
"Return a product name which will appear in <lib>.rc"
- ^ 'Smalltalk/X'
+ ^ 'Cypress'
+
+ "Modified: / 11-09-2012 / 11:55:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!stx_goodies_cypress class methodsFor:'description - svn'!