CypressClass.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Mon, 17 Sep 2012 21:34:55 +0000
changeset 15 31a33727c629
parent 14 d5b81c30785e
child 17 d387df3d4e46
permissions -rw-r--r--
- Getting rid of old Cypress implementation. - Reader does not work yet

"{ Package: 'stx:goodies/cypress' }"

CypressModel subclass:#CypressClass
	instanceVariableNames:'comment methods'
	classVariableNames:''
	poolDictionaries:''
	category:'Cypress-New-Model'
!


!CypressClass class methodsFor:'instance creation'!

fromClass: aClass
    "Returns a CypressPackage for given (real) class"

    ^self new initializeFromClass: aClass.

    "Created: / 10-09-2012 / 23:48:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

fromDirectory: directory
    "Reads a CypressClass from given directory"

    ^self new initializeFromDirectory: directory

    "Created: / 13-09-2012 / 15:34:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!CypressClass methodsFor:'accessing'!

comment
    ^ comment
!

comment:something
    comment := something.
!

methods

    methods isNil ifTrue:[
        methods := OrderedCollection new.
        (Smalltalk at: name asSymbol) instAndClassMethodsDo:[:mthd|
            methods add: (CypressMethod fromMethod: mthd)
        ]
    ].
    ^methods

    "Created: / 11-09-2012 / 00:03:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!CypressClass methodsFor:'initialization'!

initializeFromClass: aClass
    name := aClass name.
    properties := Dictionary new.

    properties 
        at:'name'           put: aClass nameWithoutPrefix;
        at:'super'          put: aClass superclass nameWithoutPrefix;
        at:'namespace'      put: aClass nameSpace nameWithoutPrefix;
        at:'superNamespace' put: aClass nameSpace nameSpace name;

        at:'instvars'       put: aClass instVarNames;
        at:'classinstvars'  put: aClass class instVarNames;
        at:'classvars'      put: aClass classVarNames;
        at:'pools'          put: aClass sharedPoolNames;

        at:'category'       put: aClass category.


    aClass definitionSelector ~~ Object definitionSelector ifTrue:[
        properties
        at:'_stx_type'      put: aClass definitionSelector
    ].

    "Created: / 10-09-2012 / 23:48:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

initializeFromDirectory: directory
    self readFrom: directory

    "Created: / 13-09-2012 / 15:35:09 / 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 - private'!

writeMethodsTo:directory notice:copyrightNotice
     "Writes methods into given 'directory' with copyrightNotice in each file"

    | obsolete instDir classDir |

    instDir := directory / 'instance'.
    classDir := directory / 'class'.

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

version_SVN
    ^ '$Id::                                                                                                                        $'
! !