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

"{ NameSpace: Smalltalk }"

RGDefinition subclass:#RGElementDefinition

	instanceVariableNames:'parent'

	classVariableNames:''

	poolDictionaries:''

	category:'Ring-Core-Kernel'

!

RGElementDefinition comment:'RGElementDefinition is the abstract class for representing elements of a class-alike definition (i.e., methods, variables, comment).

parent holds the RGClassDefinition or RGMetaclassDefinition defining this element.
	
	
Now a RingEntityDefinition offers two APIs: one that is generic and works for all the source code entities and this is the one we just 
presented: parent, parentName and realParent. Having such interface is important to build generic tools that could manipulate 
any entities in a polymorphic way (yes no isKindOf: everywhere).

In addition, a ring method definition offers a specific interface that should only be used when you know that you are solely manipulate
specific entity such as class element: method definition, class comment, and variables. 

Here is the equivalence table

	realParent 				realClass
	parent					ringClass
	parentName			className
	
For example for a methodDefinition we will have the following:

GENERIC API
------------------
* To access the ring class definition name, use parentName
	aRGMethodDefinition parentName
	
Example:
	(Point>>#dist:) asRingDefinition parentName
		->  #Point
		
* If you have a complete model where classes and methods are ring definition, to access the ring class definition , use parent
	aRGMethodDefinition parent
	
Example:
	aRGMethodDefinition(Point>>#dist:) parent
		->  aRGClassDefinition(Point)
		
* If you want to access the smalltalk class that contains the compiledMethod that is represented by a ringMethodDefinition, use realParent
	aRGMethodDefinition realParent
	
Example:
	(Point>>#dist:) asRingDefinition realParent
		->  Point
		


CLASS Element specific API
------------------------------------------
* The message class returns the class of the object :). Yes as you see we could not use class and className because class is already used to refer to the class of the object.

Example:
	(Point>>#dist:) asRingDefinition class
		->  RingMethodDefinition
		
* The message className returns the name of the ring class defining the reingMethodDefinition.

Example:
	(Point>>#dist:) asRingDefinition className
		->  #Point		
		
* If you have a complete model where classes and methods are ring definition, to access the ring class definition , use parent
	aRGMethodDefinition ringClass
	
Example:
	aRGMethodDefinition(Point>>#dist:) ringClass
		->  aRGClassDefinition(Point)
		
		
* If you want to access the smalltalk class that contains the compiledMethod that is represented by a ringMethodDefinition, use realClass
	aRGMethodDefinition realClass
	
Example:
	(Point>>#dist:) asRingDefinition realClass
		->  Point

'

!

!RGElementDefinition class methodsFor:'class initialization'!

class: aRGBehaviorDefinition

    "The argument is a ring object and serves as the parent of a method, variable or class comment"

    ^self new

        parent: aRGBehaviorDefinition;

        yourself

!

realClass: aClass

    "The argument is a Smalltalk class and the parent of a method, variable, class comment.

    However it is not set as parent but only its name and scope (instance/class)"

    ^self new

        parent: aClass asRingDefinition;

        yourself

! !

!RGElementDefinition class methodsFor:'elements-annotations'!

classNameKey

    ^#className

!

isMetaSideKey

    ^#isMetaSide

!

sourcePointerKey 

    ^#sourcePointer

!

statusKey

    ^#statusKey

! !

!RGElementDefinition class methodsFor:'parsing stamp'!

basicParseAuthorAliasFrom: aString

    "Parse an alias/name of the author from a string that is extracted from a source file. If there is no alias/name we return emtpy string."

    | tokens dateStartIndex unknown |

    "The following timestamp strings are supported (source: squeak sources archeological survey):

        <authorname><date><time>. 

        <authorname><date>

        <date><time>

        <date><time><authorname>

        <date><authorname>

        <historical>

    All fields can be separated by spaces or line ends but a separator between author alias/name and date can be missing as well"

    "unknown:= 'unknown'."

    unknown := nil.

    aString isEmptyOrNil

        ifTrue: [ ^ unknown ].

    dateStartIndex := (aString indexOf: $/) - 1.	"If there is no / character in the timestamp, no author alias/name exists"

    dateStartIndex = -1

        ifTrue: [ ^ unknown ].

    ^ [ 

    "Go the start of the date string (there can be 1 or 2 digits and a space separator can be missing at the front!!!!)"

    (dateStartIndex >= 2 and: [ (aString at: dateStartIndex - 1) isDigit ])

        ifTrue: [ dateStartIndex := dateStartIndex - 1 ].	"Extract only those tokens that do not possible represent date or time - meaning that authorname may be at the end"

    tokens := (aString copyFrom: dateStartIndex to: aString size) substrings

        reject: [ :token | (token occurrencesOf: $/) = 2 or: [ (token occurrencesOf: $:) = 1 ] ].	"only one token should be left if author name/alias exists"

    ^ tokens isEmpty

        ifTrue: [ 

            "if dateStartIndex is not 1 then the authorname may be at the beginning"

            dateStartIndex > 1

                ifTrue: [ (aString copyFrom: 1 to: dateStartIndex - 1) trimBoth ]

                ifFalse: [ unknown ] ]

        ifFalse: [ tokens first ] ]

        on: Exception

        do: [ :e | unknown ]

!

parseAuthorAliasFrom: aString

    "Allows other applications  to treat a different empty alias by overriding this method"

    ^self basicParseAuthorAliasFrom: aString

!

parseTimestampFrom: aString

    ^self parseTimestampFrom: aString default: nil

!

parseTimestampFrom: aString default: anObject

    "Parse a date-time from a timestamp-string that is extracted from a source file. If there is no timestamp, or we cannot make sense of it, we return the default value."

    | tokens dateStartIndex unknown |

    "The following timestamp strings are supported (source: squeak sources archeological survey):

        <authorname><date><time>. 

        <authorname><date>

        <date><time>

        <date><time><authorname>

        <date><authorname>

        <historical>

    All fields can be separated by spaces or line ends but a separator between authorname and date can be missing as well"

    unknown := anObject.

    aString isEmptyOrNil

        ifTrue: [ ^ unknown ].

    dateStartIndex := (aString indexOf: $/) - 1.	"If there is no / character in the timestamp, we cannot parse a date and return the epoch"

    dateStartIndex = -1

        ifTrue: [ ^ unknown ].

    ^ [ 

    "Go the start of the date string (there can be 1 or 2 digits and a space separator can be missing at the front!!!!)"

    (dateStartIndex >= 2 and: [ (aString at: dateStartIndex - 1) isDigit ])

        ifTrue: [ dateStartIndex := dateStartIndex - 1 ].	"Extract only those tokens that possibly represent date or time"

    tokens := (aString copyFrom: dateStartIndex to: aString size) substrings

        select: [ :token | (token occurrencesOf: $/) = 2 or: [ (token occurrencesOf: $:) = 1 ] ].	"2 tokens is a datetime"

    tokens size = 2

        ifTrue: [ (tokens joinUsing: Character space) asDateAndTime ]

        ifFalse: [ tokens first asDate asDateAndTime ] ]

        on: Exception

        do: [ :e | unknown ]

! !

!RGElementDefinition methodsFor:'accessing'!

fullName: aString

    ^ self annotationNamed: self class fullNameKey put: aString asSymbol

!

isMetaSide

    "Even thought several class elements do not define this property (ie. class variables, pool variables) they understand it"

    "This is a derived property from the class definining the receiver and thus its value is kept as an annotation"

    "Default value is false"

    ^self annotationNamed: self class isMetaSideKey ifAbsentPut: [ false ]

!

isMetaSide: aBoolean

    self annotationNamed: self class isMetaSideKey put: aBoolean

!

package

    ^self parent package 

! !

!RGElementDefinition methodsFor:'backward compatibility'!

actualClass

    "returns the Smalltalk class of the receiver"

    ^ self realClass

! !

!RGElementDefinition methodsFor:'class element specific api'!

className

    ^ self parentName

!

className: aName

    ^ self parentName: aName

!

realClass

    "Retrieves the Class/Trait/.. object in the System corresponding to the class of the this element."

    ^ self realParent

!

ringClass

    "Return the ring definition of the class containing the receiver."

    ^ self parent

!

theNonMetaClassName

    ^self theNonMetaParentName 

! !

!RGElementDefinition methodsFor:'comparing'!

= aRGElementDefinition

    "This method look for equality of the properties of the receiver"

    "Verifies the class and the parentName of the receiver"

    ^self class = aRGElementDefinition class

        and:[ self parentName == aRGElementDefinition parentName 

            and:[ self isMetaSide = aRGElementDefinition isMetaSide ] ]

!

hash

    "Hash is re-implemented because #= is re-implemented"

    ^self class hash bitXor: (self parentName hash bitXor: self isMetaSide hash)

! !

!RGElementDefinition methodsFor:'generic parent api'!

parent

    "The parent of a class definition element: method, comment and variable is the class definition. This method retrieves the class that defines such element"

    ^ parent

!

parent: aRGBehaviorDefinition

    "Set the class associated to the receiver"

    parent := aRGBehaviorDefinition.

    self setParentInfo: aRGBehaviorDefinition.

!

parentName

    "Retrieves the name of the class defining the receiver. Its value is kept as an annotation"

    ^ self annotationNamed: self class classNameKey

!

parentName: aString

    self annotationNamed: self class classNameKey put: aString asSymbol

!

realParent

    "Retrieves the Class/Trait/.. object in the System corresponding to the class of the this element."

    ^self parent notNil

        ifTrue: [ self parent realClass ]

        ifFalse: [ self rootEnvironment classNamed: self parentName ]

!

theNonMetaParentName

    "Rejects the prefix ' class' or ' classTrait' of the parentName"

    | index |

    index := self parentName

                indexOfSubCollection: ' class'

                startingAt: 1

                ifAbsent: [ ^self parentName ].

    ^(self parentName 

        copyFrom: 1

        to: index - 1) asSymbol

! !

!RGElementDefinition methodsFor:'private'!

setParentInfo: anObject

    "anObject is aRGBehaviorDefinition or aClass/aTrait"

    self parentName: anObject name. 

    self isMetaSide: anObject isMeta

! !

!RGElementDefinition methodsFor:'testing'!

isDefined

    "isDefined when the receiver has its realClass defined in the system"

    ^self realClass notNil

!

isSameRevisionAs: aRGElementDefinition

    "This method look for equality of the properties of the receiver"

    "Verifies the class and the parentName of the receiver"

    ^self class = aRGElementDefinition class

        and:[ self parentName == aRGElementDefinition parentName ]

! !