"

 COPYRIGHT (c) 1996-2011 by Claus Gittinger

 New code and modifications done at SWING Research Group [1]:

 COPYRIGHT (c) 2010-2011 by Jan Vrany, Jan Kurs and Marcel Hlopko

                            SWING Research Group, Czech Technical University in Prague

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

 [1] Code written at SWING Research Group contains a signature

     of one of the above copright owners. For exact set of such code,

     see the differences between this version and version stx:libjava

     as of 1.9.2010

"

"{ Package: 'stx:libjava' }"

JavaBehavior subclass:#JavaClass

	instanceVariableNames:'classLoader fullName sourceFile sourceString binaryFilePath

		fields initValues staticFields annotations protectionDomain

		signatureJ'

	classVariableNames:'ArgumentConversionErrorSignal OrderOfClassInits'

	poolDictionaries:''

	category:'Languages-Java-Classes'

!

!JavaClass class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1996-2011 by Claus Gittinger

 New code and modifications done at SWING Research Group [1]:

 COPYRIGHT (c) 2010-2011 by Jan Vrany, Jan Kurs and Marcel Hlopko

                            SWING Research Group, Czech Technical University in Prague

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

 [1] Code written at SWING Research Group contains a signature

     of one of the above copright owners. For exact set of such code,

     see the differences between this version and version stx:libjava

     as of 1.9.2010

"

!

examples

"

    (Java at:'java.util.Stack') new inspect

    (Java at:'java.util.Vector') new inspect

"

! !

!JavaClass class methodsFor:'instance creation'!

fullName:aString

    self shouldNotImplement.

    ^ self new flags:0; setFullName:aString

!

fullName:aString numStatic:nStatic

    |meta cls s ns nameComponents classLoader accessor |

    "/ check for a JAVA nameSpace to exist

    JAVA isNil ifTrue:[

        JavaPackage name:'JAVA'

    ].

    classLoader := JavaClassReader classLoaderQuerySignal query.

    "create the metaclass first"

    meta := Metaclass new.

    meta setSuperclass:self.

    meta instSize:(meta superclass instSize + nStatic).

"/    meta setName:(aString , 'class') asSymbol.

"/    meta setClassVariableString:''.

    meta flags:(meta flags bitOr:Behavior flagJavaClass).

"/    meta setSuperclass:JavaObject class.

    "then let the new meta create the class"

    cls := meta new.

    cls setSuperclass:JavaObject.

    cls instSize:0.

    cls setName:('JAVA::' , aString).   

    cls flags:0.

    cls setAccessFlags:0.

"/    cls setClassVariableString:''.

    cls setInstanceVariableString:''.

    cls setCategory:#java.

    cls setFullName:aString.

    "/ java classes do not really have a category;

    "/ simulate one by separating its name into individual components,

    "/ prepending 'java'"

    nameComponents := aString asCollectionOfSubstringsSeparatedBy:$/.

    nameComponents size > 1 ifTrue:[

        cls setCategory:((nameComponents asStringWith:$/ from:1 to:(nameComponents size - 1))

                            replaceAll:$/ with:$. ).

    ].

    nameComponents size > 1 ifTrue:[

        cls setPackage:((nameComponents copyWithoutLast:1) asStringWith:$/) asSymbol

    ] ifFalse:[

        cls setPackage:aString asSymbol

    ].

    "/ break up the package and create nameSpaces

    "/ for each package component.

    "/ This allows java.foo.bar to be visible in ST/X

    "/ under the name JAVA::java::foo::bar

    accessor := cls"JavaClassAccessor fullName: aString".    

    ns := JAVA.

    nameComponents size > 1 ifTrue:[

        s := '' writeStream.

        s nextPutAll:'JAVA'.

        nameComponents from:1 to:(nameComponents size - 1) do:[:aPart |

            s nextPutAll:'::'.

            s nextPutAll:aPart

        ].

        Metaclass confirmationQuerySignal answer:false do:[

            Class withoutUpdatingChangesDo:[

                ns := JavaPackage fullName:(s contents).

            ]

        ]

    ].

    ns isNameSpace ifTrue:[

        ns at:nameComponents last asSymbol put:accessor.

    ].

    "/ for ST/X browsing

    Smalltalk at:('JAVA::' , aString) asSymbol put:accessor.

    ^ cls

    "Created: / 15-04-1996 / 15:52:55 / cg"

    "Modified: / 03-01-1998 / 22:32:25 / cg"

    "Modified: / 29-02-2012 / 11:24:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

name:aString

    self shouldNotImplement

    "Created: 15.4.1996 / 15:52:55 / cg"

! !

!JavaClass class methodsFor:'boxing-unboxing'!

box: stArgumentsCollection to: typesCollection

    " box smalltalk arguments collection to Java arguments "

    ^ stArgumentsCollection with: typesCollection collect: [ :stObject :javaType |

        (JavaTypeBox  typeBoxForJava: javaType) box: stObject.

    ]

    "Created: / 25-09-2011 / 20:20:35 / Jan Kurs <kursjan@fit.cvut.cz>"

!

unbox:jObj returnType: returnType

    "JV@2011-02-04"

    "Hack for primitive types"

    "/    JK: it is hack, but it is fast :)

    (JavaDescriptor baseTypesByTypeName keys includes: returnType) ifTrue:[^jObj].

    ^ (JavaTypeBox typeBoxForJava: returnType) unbox: jObj.

    "Created: / 30-08-2011 / 22:13:41 / Jan Kurs <kursjan@fit.cvut.cz>"

! !

!JavaClass class methodsFor:'class initialization'!

initialize

    ArgumentConversionErrorSignal := Signal new notifierString:'argument conversion error'.

    "Created: / 20-10-2010 / 11:11:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!JavaClass class methodsFor:'method lookup'!

canConvertArgsToJava:argArray asSpecifiedIn:argSigSpecArray

    "given a smalltalk argument array, return true, if these can be converted to java objects as appropriate."

    argArray

	with:argSigSpecArray

	do:[:arg :type |

		self

		    convertToJava:arg

		    type:type

		    ifFail:[:msg :default| ^ false]].

    ^ true

    "Created: / 5.11.1998 / 18:25:05 / cg"

    "Modified: / 6.11.1998 / 00:45:58 / cg"

!

convertArgsToJava:argArray asSpecifiedIn:argSigSpecArray numArgs:na

    "given a smalltalk argument array, convert to java objects as appropriate.

     Currently, only Strings and booleans are converted."

    |sigIndex newArgIndex newArgArray|

    sigIndex := newArgIndex := 1.

    newArgArray := Array new:na.

    argArray do:[:arg |

	|type newArg|

	type := argSigSpecArray at:sigIndex.

	sigIndex := sigIndex + 1.

	newArg := self convertToJava:arg type:type.

	newArgArray at:newArgIndex put:newArg.

	newArgIndex := newArgIndex + 1.

	(type == #long or:[type == #double]) ifTrue:[

	    newArgIndex > na ifTrue:[

		self halt:'should not happen'

	    ].

	    newArgArray at:newArgIndex put:nil.

	    newArgIndex := newArgIndex + 1.

	]

    ].

    ^ newArgArray

    "Created: / 5.11.1998 / 18:30:57 / cg"

    "Modified: / 6.11.1998 / 00:45:00 / cg"

!

convertToJava:arg type:type

    "given a smalltalk argument, convert to a java object as appropriate."

    ^ self

        convertToJava:arg

        type:type

        ifFail:[:msg :default |

                    ArgumentConversionErrorSignal

                        raiseWith:arg

                        errorString:msg.

                    default

               ]

    "Created: / 06-11-1998 / 00:45:13 / cg"

    "Modified: / 20-10-2010 / 11:08:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

convertToJava: arg type: type ifFail: failBlock 

    "given a smalltalk argument, convert to a java object as appropriate.

     Currently, only a few types are converted."

    | expectedCls  f  failValue |

    type == #boolean ifTrue: [

        arg == true ifTrue: [ ^ 1 ].

        arg == false ifTrue: [ ^ 0 ].

        ^ failBlock value: ('cannot convert argument to ' , type) value: 0

    ].

    type == #int ifTrue: [

        arg isInteger ifTrue: [

            (arg between: (16r8000000 * -1) and: 16r7FFFFFFF) ifTrue: [ ^ arg ].

            ^ failBlock value: ('integer range; cannot convert argument to ' , type)

                value: 0.

        ].

        ^ failBlock value: ('cannot convert argument to ' , type) value: 0

    ].

    type == #long ifTrue: [

        arg isInteger ifTrue: [

            (arg "(-1 * 16r800000000000000) -->" between: -576460752303423488

                and: 16r7FFFFFFFFFFFFFFF) ifTrue: [ ^ arg ].

            ^ failBlock value: ('integer range; cannot convert argument to ' , type)

                value: 0

        ].

        ^ failBlock value: ('cannot convert argument to ' , type) value: 0

    ].

    (type == #float) ifTrue: [

        arg isLimitedPrecisionReal ifTrue: [ ^ arg asShortFloat ].

        ^ failBlock value: ('cannot convert argument to ' , type) value: 0.0.

    ].

    (type = 'java.lang.Float') ifTrue: [

        arg isLimitedPrecisionReal ifTrue: [

            f := (Java at: 'java.lang.Float') new.

            f perform: #'<init>(F)V' with: (arg asShortFloat).

            self halt.

            ^ f.

        ].

        ^ failBlock value: ('cannot convert argument to ' , type) value: 0.0.

    ].

    (type = 'java.lang.Double') ifTrue: [

        arg isLimitedPrecisionReal ifTrue: [

            f := (Java at: 'java.lang.Double') new.

            f perform: #'<init>(D)V' with: (arg asFloat).

            self halt.

            ^ f.

        ].

        ^ failBlock value: ('cannot convert argument to ' , type) value: 0.0.

    ].

    (type == #double) ifTrue: [

        arg isLimitedPrecisionReal ifTrue: [ ^ arg asFloat ].

        ^ failBlock value: ('cannot convert argument to ' , type) value: 0.0.

    ].

    (type == #char) ifTrue: [

        arg isCharacter ifTrue: [ ^ arg asciiValue ].

        ^ failBlock value: ('cannot convert argument to ' , type) value: 0

    ].

    (type = 'char[]') ifTrue: [

        arg isString ifTrue: [ ^ arg ].

        ^ failBlock value: ('cannot convert argument to ' , type) value: ''

    ].

    (type = 'int[]') ifTrue: [

        (arg isArray or: [ arg isMemberOf: SignedIntegerArray ]) ifTrue: [ ^ arg ].

        ^ failBlock value: ('cannot convert argument to ' , type) value: ''

    ].

    (type = 'long[]') ifTrue: [

        (arg isArray or: [ arg isMemberOf: SignedIntegerArray ]) ifTrue: [ ^ arg ].

        ^ failBlock value: ('cannot convert argument to ' , type) value: ''

    ].

    (type = 'float[]') ifTrue: [

        (arg isArray or: [ arg isMemberOf: FloatArray ]) ifTrue: [ ^ arg ].

        ^ failBlock value: ('cannot convert argument to ' , type) value: ''

    ].

    (type = 'double[]') ifTrue: [

        (arg isArray or: [ arg isMemberOf: DoubleArray ]) ifTrue: [ ^ arg ].

        ^ failBlock value: ('cannot convert argument to ' , type) value: ''

    ].

    (type endsWith: '[]') ifTrue: [

        (arg isArray or: [ arg isNil ]) ifTrue: [ ^ arg ].

        ^ failBlock value: ('cannot convert argument to ' , type) value: ''

    ].

    expectedCls := JavaVM classForName: type.

    (arg isKindOf: expectedCls) ifTrue: [

        "/ matches class and subclasses

        ^ arg

    ].

    (type = 'java.lang.Object') ifTrue: [

        "/ matches any

        ^ arg

    ].

    (type = 'java.lang.String') ifTrue: [

        arg isString ifTrue: [ ^ Java as_String: arg ].

        failValue := ''

    ].

    arg isNil ifTrue: [

        "/ matches any

        ^ arg

    ].

    self halt.

    ^ failBlock value: ('cannot convert argument to ' , type) value: failValue

    "Created: / 06-11-1998 / 00:46:19 / cg"

    "Modified: / 06-11-2001 / 13:28:29 / cg"

    "Modified: / 17-01-2011 / 10:08:04 / kursjan <kursjan@fit.cvut.cz>"

    "Modified: / 17-03-2011 / 14:09:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

convertToSmalltalk:jObj type:type

    "given a java return value, convert to a smalltalk object as appropriate.

     Currently, only a few types are converted."

    "JV@2011-02-04"

    "Hack for primitive types"

    (JavaDescriptor baseTypesByTypeName keys includes: type) ifTrue:[^jObj].

    "jObj is registered for the specified type?"

    "

    (JavaObjectDictionary new reflectionOf: jObj class name)  = (Java classForName: type) ifTrue: [

        ^ jObj

    ].

    "

    type == #boolean ifTrue:[

        jObj == 0 ifTrue:[

            ^ false

        ].

        ^ true

    ].

    type == #void ifTrue:[

        ^ nil

    ].

    (type = 'java.lang.String') ifTrue:[

        ^ Java as_ST_String:jObj

    ].

"/    (type = 'java.lang.Float') ifTrue:[

"/        ^ jObj instVarNamed:'value'

"/    ].

"/    (type = 'java.lang.Double') ifTrue:[

"/        ^ jObj instVarNamed:'value'

"/    ].

    (type == #char) ifTrue:[

        jObj isInteger ifTrue:[

            ^ Character value:jObj

        ].

    ].

    ^ jObj

    "Created: / 06-11-1998 / 00:49:53 / cg"

    "Modified: / 11-11-1998 / 02:08:11 / cg"

    "Modified: / 17-01-2011 / 10:42:56 / kursjan <kursjan@fit.cvut.cz>"

    "Modified: / 08-04-2011 / 17:04:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

lookupMethod:selector numArgs:nargs in:aClass static:staticMethod

    "lookup a method"

    |method cls sel|

    sel := selector.

    (sel includes:$:) ifTrue:[

	sel := sel copyTo:(sel indexOf:$:)-1

    ].

    sel := sel asSymbolIfInterned.

    sel notNil ifTrue:[

	cls := aClass.

	[cls notNil

	and:[cls ~~ JavaObject

	and:[cls ~~ JavaClass]]] whileTrue:[

	    cls methodDictionary keysAndValuesDo:[:jSel :m |

		|aMethod|

		aMethod := m.

		aMethod isWrapped ifTrue:[

		    aMethod := aMethod originalMethod

		].

		((jSel == sel)

		or:[aMethod name = sel

		or:[aMethod signatureNameWithoutReturnType = sel]])

		ifTrue:[

		    aMethod numArgs == nargs ifTrue:[

			staticMethod == (aMethod isStatic) ifTrue:[

			    ^ m

			]

		    ]

		]

	    ].

	    cls := cls superclass.

	].

    ].

"/ self halt.

    ^ nil

    "Created: / 17.8.1997 / 18:25:47 / cg"

    "Modified: / 16.11.1998 / 16:46:48 / cg"

!

lookupMethods:selector numArgs:nargs in:aClass static:staticMethod

    "lookup methods matching a selector.

     This is a special entry for doesNotUnderstand redirection

     (the caller must select the one method which fits the argument(s) best."

    |methods cls sel|

    sel := selector.

    (sel includes:$:) ifTrue:[

	sel := sel copyTo:(sel indexOf:$:)-1

    ].

    sel := sel asSymbolIfInterned.

    sel notNil ifTrue:[

	cls := aClass.

	[cls notNil

	and:[cls ~~ JavaObject

	and:[cls ~~ JavaClass]]] whileTrue:[

	    cls methodDictionary keysAndValuesDo:[:jSel :aMethod |

		((jSel == sel)

		or:[aMethod name = sel

		or:[aMethod signatureNameWithoutReturnType = sel]])

		ifTrue:[

		    (nargs isNil

		    or:[aMethod numArgs == nargs]) ifTrue:[

			staticMethod == (aMethod isStatic) ifTrue:[

			    methods isNil ifTrue:[

				methods := OrderedCollection new

			    ].

			    methods add:aMethod

			]

		    ]

		]

	    ].

	    cls := cls superclass.

	].

    ].

    ^ methods ? #()

    "Created: / 4.11.1998 / 19:04:51 / cg"

    "Modified: / 4.11.1998 / 19:31:33 / cg"

!