- Package writing rewritten to use new model. Writes package according to recent spec.
authorJan Vrany <jan.vrany@fit.cvut.cz>
Tue, 11 Sep 2012 10:56:07 +0000
changeset 12 ec118792047a
parent 11 333528cd629a
child 13 f90704544ca0
- Package writing rewritten to use new model. Writes package according to recent spec.
CypressClass.st
CypressJsonParser.st
CypressMethod.st
CypressModel.st
CypressPackage.st
cypress.rc
stx_goodies_cypress.st
--- 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'!