src/extensions.st
author vranyj1
Sun, 01 Jan 2012 17:03:10 +0000
branchjk_new_structure
changeset 1332 a2e2c13b0ff6
parent 1328 06e2e372ebb0
child 1336 5f651f3589d9
permissions -rw-r--r--
Some testing methods

"{ Package: 'stx:libjava' }"

!

!BooleanArray methodsFor:'queries'!

isInterface

    ^false

    "Created: / 31-05-2011 / 16:07:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!CharacterArray methodsFor:'java conversions'!

asDottedJavaClassName

 "
    examples:
    java.lang.String
    [[[Ljava/lang/Object; => java.lang.Object
    "


    | nm |
    nm := self asJavaComponentClassName.
    (nm startsWith: $L) ifTrue: [
	nm := nm copyFrom: 2 to: nm size - 1
    ].
    (nm includes: $/) ifTrue: [
	nm := nm asString copyReplaceAll: $/ with: $.
    ].
    ^ nm.

    "Created: / 21-10-2011 / 12:31:51 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
    "Created: / 30-10-2011 / 17:41:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!CharacterArray methodsFor:'java conversions'!

asInternalJavaClassName

    <resource: #obsolete>

    ^self asSlashedJavaClassName

    "Created: / 21-10-2011 / 12:31:51 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
    "Modified: / 30-10-2011 / 17:40:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!CharacterArray methodsFor:'java conversions'!

asJavaComponentClassName
    | componentClassName |

    componentClassName := self utf8Encoded.
    (componentClassName matches: '*\[*') ifTrue: [
	componentClassName := componentClassName
		    copyFrom: (componentClassName lastIndexOf: $[) + 1
		    to: componentClassName size.
    ].
    ^ componentClassName.
! !
!CharacterArray methodsFor:'java conversions'!

asJavaishClassName

    <resource: #obsolete>

    ^self asDottedJavaClassName.

    "Created: / 21-10-2011 / 12:33:01 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
    "Modified: / 30-10-2011 / 17:41:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!CharacterArray methodsFor:'java conversions'!

asNiceJavaClassName
    | niceName |

    niceName := self asJavaComponentClassName asSTXInternalJavaClassName.
    (self occurrencesOf: $[) timesRepeat: [ niceName := niceName , '[]' ].
    niceName := niceName asString copyReplaceAll: $/ with: $..
    ^ niceName.
! !
!CharacterArray methodsFor:'java conversions'!

asSTXInternalJavaClassName
    | internalName |

    internalName := self asJavaComponentClassName.
    (internalName startsWith: $L) ifTrue: [
	internalName := internalName copyFrom: 2 to: internalName size - 1
    ].
    (internalName includes: $.) ifTrue: [
	internalName := internalName asString copyReplaceAll: $. with: $/
    ].
    ^internalName.
! !
!CharacterArray methodsFor:'java conversions'!

asSlashedJavaClassName
    "removes square brackets and adds slashes"
    | internalName |
    internalName := self asJavaComponentClassName.
    (internalName startsWith: $L) ifTrue: [
	internalName := internalName copyFrom: 2 to: internalName size - 1
    ].
    (internalName includes: $.) ifTrue: [
	internalName := internalName asString copyReplaceAll: $. with: $/
    ].
    ^ internalName.

    "Created: / 21-10-2011 / 12:31:51 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
    "Created: / 30-10-2011 / 17:40:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!CharacterArray methodsFor:'java queries'!

isJavaArrayDescriptor
^ self startsWith:$[.
! !
!CharacterArray methodsFor:'java queries'!

isJavaPrimitiveTypeDescriptor
    ^ (self size = 1 and: [ JavaDescriptor baseTypes includesKey: self first ]).
! !
!Class methodsFor:'method lookup'!

perform:aMessage onReceiver:receiver from:sender ifNotFound:aBlock
    | method  selector class args retval|
    selector := aMessage selector.
    args := aMessage arguments.
    class := receiver class.

    SmalltalkLookup isNil ifTrue:[
        (Smalltalk loadPackage: 'stx:libjava/experiments') ifFalse:[
            self error: 'You should load package stx:libjava/experiments if you want some interop - still experimental' mayProceed: true.
            ^nil                        
        ]
    ].

    method := SmalltalkLookup instance lookupMethodForSelector: selector
            directedTo: class
            for: receiver
            withArguments: args
            from: sender
            ilc: nil.

    method ifNotNil:
    [  | unboxedArgs |
        unboxedArgs := self unbox: args to: method argTypes.
        retval := receiver perform: method selector withArguments: unboxedArgs.
        ^ self box: retval toType: method returnType.
    ].
    ^ aBlock value.

    "Created: / 28-09-2011 / 11:31:33 / Jan Kurs <kursjan@fit.cvut.cz>"
    "Modified: / 03-12-2011 / 21:37:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Delay methodsFor:'delaying'!

waitWithState:state
    "suspend the current process until either the relative time delta
     has passed (if millisecondDelta is non-nil), or the absolute millisecondTime
     has been reached (if resumptionTime non-nil)."
    
    | wasBlocked  currentDelta  dueTime  now  then |
    isInterrupted := false.
    millisecondDelta notNil ifTrue: [
        now := OperatingSystem getMillisecondTime.
        currentDelta := millisecondDelta rounded.
        currentDelta > 16r0fffffff ifTrue: [
            "NOTE: the microsecondTime is increasing monotonically,
                   while millisecondTime is wrapping at 16r1fffffff.
                   So use the microsecondTime to check when we are finished"
            dueTime := OperatingSystem getMicrosecondTime + (currentDelta * 1000).
            currentDelta := 16r0fffffff.
        ].
        then := OperatingSystem millisecondTimeAdd: now and: currentDelta.
    ] ifFalse: [ then := resumptionTime. ].
    wasBlocked := OperatingSystem blockInterrupts.
    [
        [
            Processor signal: delaySemaphore atMilliseconds: then.
            Processor activeProcess state: state.
            delaySemaphore wait.
        ] doWhile: [
            (dueTime notNil 
                and: [
                    isInterrupted not 
                        and: [ (currentDelta := dueTime - OperatingSystem getMicrosecondTime) > 0 ]
                ]) 
                    ifTrue: [
                        currentDelta := (currentDelta // 1000) min: 16r0fffffff.
                        now := OperatingSystem getMillisecondTime.
                        then := OperatingSystem millisecondTimeAdd: now and: currentDelta.
                        true.
                    ]
                    ifFalse: [ false ]
        ].
    ] ensure: [ wasBlocked ifFalse: [ OperatingSystem unblockInterrupts ]. ]

    "
     Transcript showCR:'1'.
     (Delay forSeconds:10) wait.
     Transcript showCR:'2'."

    "Modified: / 26-02-1997 / 15:21:35 / cg"
    "Modified: / 18-04-1997 / 11:56:46 / stefan"
    "Created: / 30-11-2011 / 13:38:18 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
! !
!Object methodsFor:'testing'!

isJavaArray

    ^self class isJavaArrayClass

    "Created: / 19-12-2010 / 17:05:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Object methodsFor:'testing'!

isJavaNameAndType
    "return true, if given object represents name and type struct in java constant pool"

    ^ false.

    "Created: / 10-05-2011 / 12:21:52 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
! !
!Object methodsFor:'testing'!

isJavaPackage
    "return true, if the receiver is a java package.
     False is returned here - the method is only redefined in JavaPackage."

    ^ false

    "Created: / 09-08-2011 / 09:35:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Object methodsFor:'testing'!

isJavaRef
"return true, if given object represents reference in java constant pool"
^ false.

    "Created: / 08-04-2011 / 16:12:45 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
! !
!Object methodsFor:'testing'!

isJavaWrapperClass
    "return true, if this is a java wrapper class, i.e, java.lang.Integer, java.lang.Boolean etc."

    ^ false

    "Created: / 01-01-2012 / 17:25:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Object methodsFor:'autoboxing support'!

javaBox: anObject

    ^anObject

    "Created: / 15-08-2011 / 10:52:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Object methodsFor:'autoboxing support'!

javaUnwrap: anObject
    "Unwraps the objects. Possibly call on the wrapped class"

    ^anObject

    "Created: / 10-12-2011 / 19:51:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Object methodsFor:'autoboxing support'!

javaUnwrapFrom: javaType
    ^ self.

    "Created: / 10-12-2011 / 19:51:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Created: / 30-12-2011 / 15:22:06 / kursjan <kursjan@fit.cvut.cz>"
! !
!Object methodsFor:'autoboxing support'!

javaWrap: anObject
    "Wraps the receiver into corresponding Java object"

    ^anObject

    "Created: / 26-12-2011 / 00:57:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Process methodsFor:'Java protocol'!

clearInterrupted
    JavaVM threadInterrupts at: self put: false.

    "Created: / 30-11-2011 / 10:44:26 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
! !
!Process methodsFor:'Java protocol'!

isInterrupted

    ^ JavaVM threadInterrupts at: self
        ifAbsent: [ JavaVM threadInterrupts at: self put: false. ]

    "Created: / 30-11-2011 / 12:12:33 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
! !
!Process methodsFor:'queries'!

isSleeping
    "return true, iff the receiver is sleeping on Delay"
    
    ^ (state == #sleep)

    "Created: / 30-11-2011 / 13:35:18 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
! !
!Process methodsFor:'queries'!

isWaiting
    "return true, iff the receiver is waiting on semaphore or something"

    ^ (state == #wait)

    "Created: / 20-11-2011 / 20:55:11 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
! !
!Process methodsFor:'Java protocol'!

javaInterrupt
    self isWaiting ifTrue: [
        self 
            interruptWith: [
                JavaVM 
                    throwInterruptedException: 'thread has been interrupted during wait'.
                self terminate
            ]
    ] ifFalse: [
        self isSleeping ifTrue: [
      
            self 
                interruptWith: [
                    JavaVM 
                        throwInterruptedException: 'thread has been interrupted during sleep'.
                    self terminate
                ]
        ] ifFalse: [ self setInterrupted. ]
    ]

    "Created: / 30-11-2011 / 13:35:18 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
! !
!Process methodsFor:'Java protocol'!

setInterrupted

    JavaVM threadInterrupts at: self put: true.

    "Created: / 30-11-2011 / 10:44:37 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
! !
!Set methodsFor:'javaProtocol'!

java__contains:anObject
         ^ self contains: [:el | anObject = el ] 
! !
!SmallInteger methodsFor:'autoboxing'!

javaUnwrapFrom: javaType
    javaType = #boolean ifTrue: [
        ^ self = 1
    ].
    ^ self

    "Created: / 30-12-2011 / 15:22:52 / kursjan <kursjan@fit.cvut.cz>"
! !
!String methodsFor:'converting'!

asArrayOfSubstringsSeparatedBy:aSeparator
    "Modified version of asArrayOfSubstrings"

    |substrings start end|

    substrings := OrderedCollection new.
    start := 1.
    [start <= self size] whileTrue:[
	(self at:start) = aSeparator ifFalse:[
	    end := start + 1.
	    [
		end <= self size and:[(self at:end) ~= aSeparator]
	    ] whileTrue:[end := end + 1].
	    substrings add:(self copyFrom:start to:end - 1).
	    start := end - 1
	].
	start := start + 1
    ].
    ^ substrings asArray

    "Created: / 07-02-2011 / 11:18:03 / Marcel Hlopko <hlopik@gmail.com>"
    "Modified: / 08-02-2011 / 01:08:15 / Marcel Hlopko <hlopik@gmail.com>"
! !
!UserPreferences methodsFor:'accessing-java-devel'!

javaTestsDirectory
    ^ self at: #javaTestsDirectory
	ifAbsent:
	    [ | nm |

	    nm := OperatingSystem getLoginName.
	     "Default path for Jan"
	    (nm = 'jv' and:[OperatingSystem isUNIXlike])
		ifTrue:
		    [ '/home/jv/Projects/libjava/sources/libjava/branches/jk_new_structure/tests' ]
		ifFalse:
		    [ "Default path for Jan (the other one :-)"
		    nm = 'jk'
			ifTrue: [ 'path for Jan' ]
			ifFalse:
			    [ "Default path for Marcel"
			    nm = 'm'
				ifTrue: [ '/home/m/Projects/libjava/branches/jk_new_structure/tests' ]
				ifFalse:
				    [ | "Look into package dir" p |

				    (p := (Smalltalk getPackageDirectoryForPackage: 'stx:libjava') asFilename
						/ 'tests') exists
					ifTrue: [ p pathName ]
					ifFalse:
					    [ | "Try the environment variable (used by Hudson)" p |

					    (p := OperatingSystem getEnvironment: 'LIBJAVA_TESTS') notNil
						ifTrue: [ p ]
						ifFalse:
						    [ "No default, trigger an error"
						    self error: 'No tests path specified' ] ] ] ] ] ]

    "
	UserPreferences current javaTestsDirectory"

    "Created: / 07-05-2011 / 17:43:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 07-05-2011 / 20:21:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 12-05-2011 / 15:54:39 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
! !
!UserPreferences methodsFor:'accessing-java-devel'!

javaTestsDirectory: aStringOrFilename

    self at:#javaTestsDirectory put: aStringOrFilename asString.

    "Created: / 07-05-2011 / 17:45:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!WrappedMethod methodsFor:'accessing'!

descriptor
    "Returns descriptor object (for wrapped Java methods)"

    | orig |
    orig := self originalMethod.
    ^(orig respondsTo: #descriptor) ifTrue:[
        orig descriptor
    ] ifFalse:[
        self doesNotUnderstand: (Message selector: #descriptor)
    ]

    "Created: / 16-12-2011 / 20:03:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!WrappedMethod methodsFor:'queries'!

isAbstract

    ^self originalMethod isAbstract.

    "Created: / 04-12-2011 / 11:24:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ZipArchive methodsFor:'reading - java support'!

nextBytes: bytesToRead of: zmember startingAt: pos into: b startingAt: off

    file position0Based: zmember fileStart + startOfArchive + pos.
    ^ file nextBytes: bytesToRead into: b startingAt: off.

    "Created: / 01-05-2011 / 16:21:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Boolean class methodsFor:'queries'!

isJavaPrimitiveType

    ^true

    "Created: / 25-02-2011 / 08:22:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Boolean class methodsFor:'queries'!

javaArrayClass
    ^ BooleanArray

    "Created: / 25-02-2011 / 08:27:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Boolean class methodsFor:'autoboxing support'!

javaBox: anObject
    | wrapper |

    wrapper := (JavaVM classForName: 'java.lang.Boolean') new.
    wrapper perform: #'<init>(Z)V' with: anObject.
    ^ wrapper

    "Created: / 16-08-2011 / 09:58:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Boolean class methodsFor:'accessing'!

javaName

    ^'boolean'.

    "Modified: / 25-02-2011 / 18:58:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Boolean class methodsFor:'autoboxing support'!

javaUnbox: object onError: errorBlock

    | value |

    (object class name = 'java/lang/Boolean') ifFalse:[
        errorBlock value.
    ].
    value := object instVarNamed: #value.
    (value ~~ 0 and:[value ~~ 1]) ifTrue:[
        errorBlock value.
    ].
    ^value

    "Created: / 22-11-2011 / 11:52:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Boolean class methodsFor:'autoboxing support'!

javaUnwrap: zeroOrOne

    ^zeroOrOne == 1

    "Created: / 10-12-2011 / 20:00:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!BooleanArray class methodsFor:'testing'!

isInterface

    ^false
! !
!BooleanArray class methodsFor:'queries'!

isJavaArrayClass

    ^true

    "Created: / 20-12-2010 / 22:47:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!BooleanArray class methodsFor:'queries'!

isJavaReferenceType

    "Java arrays are reference types"
    ^true

    "Created: / 20-12-2010 / 22:30:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!BooleanArray class methodsFor:'accessing-java'!

javaArrayClass
    ^ JavaArray javaArrayClassFor: self

    "Created: / 06-12-2011 / 17:29:22 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
! !
!BooleanArray class methodsFor:'accessing-java'!

javaComponentClass

    ^Boolean

    "Created: / 20-12-2010 / 22:13:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!BooleanArray class methodsFor:'accessing'!

javaName

    ^'[Z'.

    "Modified: / 31-08-2011 / 23:57:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ByteArray class methodsFor:'testing'!

isInterface

    ^false
! !
!ByteArray class methodsFor:'queries'!

isJavaArrayClass

    ^true

    "Created: / 05-02-2011 / 22:45:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ByteArray class methodsFor:'queries'!

isJavaReferenceType

    "Java arrays are reference types"
    ^true

    "Created: / 20-12-2010 / 22:30:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ByteArray class methodsFor:'accessing-java'!

javaArrayClass

    ^JavaArray javaArrayClassFor: self

    "Created: / 11-06-2011 / 23:42:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ByteArray class methodsFor:'accessing-java'!

javaComponentClass

    ^JavaByte

    "Created: / 20-12-2010 / 22:05:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ByteArray class methodsFor:'accessing'!

javaName

    ^'[B'.

    "Modified: / 25-02-2011 / 19:02:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Character class methodsFor:'queries'!

isJavaPrimitiveType

    ^true

    "Created: / 20-12-2010 / 22:18:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Character class methodsFor:'accessing'!

javaArrayClass
    ^ String

    "Created: / 11-02-2011 / 10:44:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Character class methodsFor:'autoboxing support'!

javaBox: anObject
    | wrapper |

    wrapper := (JavaVM classForName: 'java.lang.Character') new.
    wrapper perform: #'<init>(C)V' with: anObject codePoint.
    ^ wrapper

    "Created: / 16-08-2011 / 09:58:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Character class methodsFor:'accessing'!

javaName

    ^'char'.

    "Modified: / 25-02-2011 / 18:58:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Character class methodsFor:'autoboxing support'!

javaUnbox: object onError: errorBlock

    | value |

    (object class name = 'java/lang/Character') ifFalse:[
        errorBlock value.
    ].
    value := object instVarNamed: #value.
    (value between: 0 and: 255) ifFalse:[
        errorBlock value.
    ].
    ^value

    "Created: / 22-11-2011 / 11:52:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!CharacterArray class methodsFor:'encoding & decoding'!

decodeFromJavaUTF8: bytes
    "Decodes a string from modified UTF8 encoding
     as used in Java .class files. see
     'The class file format specification', section 4.5.7"

    | string  i  s  b  codePoint  realLength |

    string := String new: bytes size.
    realLength := bytes size.
    s := bytes readStream.
    i := 1.
    [ s atEnd ] whileFalse:
            [ b := s next.
            (b & 2r10000000) == 0
                ifTrue: [ codePoint := b ]
                ifFalse:
                    [ self assert: (b & 2r01000000) = 2r01000000.
                    (b & 2r00100000) = 0
                        ifTrue:
                            [ "two byte utf char"
                            realLength := realLength - 1.
                            self assert: s size > 0.
                            self assert: (b & 2r01000000) = 2r01000000.
                            string bitsPerCharacter < 16
                                ifTrue: [ string := Unicode16String fromString: string ].
                            codePoint := (b & 2r00011111) << 6.
                            b := s next.
                            self assert: (b & 2r11000000) = 2r10000000.
                            codePoint := codePoint + (b & 2r00111111). ]
                        ifFalse:
                            [ "at lease 3 byte utf char"
                            realLength := realLength - 2.
                            string bitsPerCharacter < 16"was: 32"
                                ifTrue: [ string := Unicode16String"was: Unicode32String" fromString: string ].
                            self assert: s size > 1.
                            (b & 2r00010000) = 0
                                ifTrue:
                                    [ | utf32Possible  utf32Value |

                                    "3 or 6 byte utf char"
                                    self assert: s size > 1.
                                    s size < 5
                                        ifTrue: [ utf32Possible := false ]
                                        ifFalse: [ utf32Possible := true ].
                                    b ~= 2r11101101 ifTrue: [ utf32Possible := false ].
                                    codePoint := (b & 2r00001111) << 12.
                                    b := s next.
                                    self assert: (b & 2r11000000) = 2r10000000.
                                    ((b & 2r11110000) = 2r10100000 and: [ utf32Possible ])
                                        ifTrue: [ utf32Value := 2r00010000 + ((b & 2r00001111) << 16) ]
                                        ifFalse: [ utf32Possible := false ].
                                    codePoint := codePoint + ((b & 2r00111111) << 6).
                                    b := s next.
                                    self assert: (b & 2r11000000) = 2r10000000.
                                    utf32Possible
                                        ifTrue: [ utf32Value := utf32Value + ((b & 2r00111111) << 10) ].
                                    codePoint := codePoint + (b & 2r00111111).
                                    utf32Possible
                                        ifTrue:
                                            [ | tmpB |

                                            string bitsPerCharacter < 32
                                                ifTrue: [ string := Unicode32String fromString: string ].
                                            tmpB := s copy.
                                            b := tmpB next.
                                            b = 2r11101101
                                                ifTrue:
                                                    [ b := tmpB next.
                                                    (b & 2r11110000) = 2r10110000
                                                        ifTrue:
                                                            [ utf32Value := utf32Value + ((b & 2r00001111) << 6).
                                                            b := tmpB next.
                                                            self assert: (b & 2r11000000) = 2r10000000.
                                                            utf32Value := utf32Value + (b & 2r00111111).
                                                            codePoint := utf32Value.
                                                            realLength := realLength - 3. s position: tmpB position.] ] ] ]
                                ifFalse:
                                    [ "should not happen, ask mh"
                                    self halt. ] ] ].
            string at: i put: (Character codePoint: codePoint).
            i := i + 1. ].
    ^ string subString: 1 to: realLength.

    "
        String decodeFromJavaUTF8: 'Hello world' asByteArray"

    "Created: / 22-12-2010 / 23:45:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 09-02-2011 / 01:12:25 / Marcel Hlopko <hlopik@gmail.com>"
    "Modified: / 13-03-2011 / 15:52:36 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
    "Modified: / 09-12-2011 / 19:49:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!CharacterArray class methodsFor:'instance creation'!

fromJavaUTF8Bytes:aByteCollection
    "return a new string which represents the characters as decoded
     from the modified utf8 encoded bytes as specified in
     The class file format specification, section 4.5.7"

    ^ self decodeFromJavaUTF8:aByteCollection.

    "
     CharacterArray fromUTF8Bytes:#[ 16r41 16r42 ]
     CharacterArray fromUTF8Bytes:#[ 16rC1 16r02 ]
     CharacterArray fromUTF8Bytes:#[ 16rE0 16r81 16r02 ]
     CharacterArray fromUTF8Bytes:#[ 16rEF 16rBF 16rBF ]

   rfc2279 examples:
     CharacterArray fromUTF8Bytes:#[ 16r41 16rE2 16r89 16rA2 16rCE 16r91 16r2E ]
     CharacterArray fromUTF8Bytes:#[ 16rED 16r95 16r9C 16rEA 16rB5 16rAD 16rEC 16r96 16rB4 ]
     CharacterArray fromUTF8Bytes:#[ 16rE6 16r97 16rA5 16rE6 16r9C 16rAC 16rE8 16rAA 16r9E ]

   invalid:
     CharacterArray fromUTF8Bytes:#[ 16rC0 16r80 ]
     CharacterArray fromUTF8Bytes:#[ 16rE0 16r80 16r80 ]
    "

    "Created: / 23-12-2010 / 09:01:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!CharacterArray class methodsFor:'queries'!

isJavaArrayClass

    ^true

    "Created: / 05-02-2011 / 22:45:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!CharacterArray class methodsFor:'accessing-java'!

javaArrayClass

    ^JavaArray javaArrayClassFor: Unicode16String

    "Created: / 11-06-2011 / 23:42:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 10-08-2011 / 13:18:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!CharacterArray class methodsFor:'accessing-java'!

javaComponentClass

    ^Character

    "Created: / 20-12-2010 / 22:05:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!DoubleArray class methodsFor:'testing'!

isInterface

    ^false
! !
!DoubleArray class methodsFor:'queries'!

isJavaArrayClass

    ^true

    "Created: / 20-12-2010 / 22:47:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!DoubleArray class methodsFor:'queries'!

isJavaReferenceType

    "Java arrays are reference types"
    ^true

    "Created: / 20-12-2010 / 22:30:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!DoubleArray class methodsFor:'accessing-java'!

javaArrayClass
    ^ JavaArray javaArrayClassFor: self.

    "Created: / 06-12-2011 / 17:28:26 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
! !
!DoubleArray class methodsFor:'accessing-java'!

javaComponentClass

    ^Float

    "Created: / 20-12-2010 / 22:06:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!DoubleArray class methodsFor:'accessing'!

javaName

    ^'[D'.

    "Modified: / 25-02-2011 / 19:03:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Float class methodsFor:'queries'!

isJavaPrimitiveType

    ^true

    "Created: / 06-02-2011 / 17:21:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Float class methodsFor:'accessing'!

javaArrayClass
    ^ DoubleArray

    "Created: / 11-02-2011 / 10:50:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Float class methodsFor:'autoboxing support'!

javaBox: anObject
    | wrapper |

    wrapper := (JavaVM classForName: 'java.lang.Double') new.
    wrapper perform: #'<init>(D)V' with: anObject.
    ^ wrapper

    "Created: / 16-08-2011 / 09:58:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Float class methodsFor:'accessing'!

javaName

    ^'double'.

    "Modified: / 25-02-2011 / 18:59:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!FloatArray class methodsFor:'testing'!

isInterface

    ^false
! !
!FloatArray class methodsFor:'queries'!

isJavaArrayClass

    ^true

    "Created: / 20-12-2010 / 22:47:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!FloatArray class methodsFor:'queries'!

isJavaReferenceType

    "Java arrays are reference types"
    ^true

    "Created: / 20-12-2010 / 22:30:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!FloatArray class methodsFor:'accessing-java'!

javaArrayClass
    ^ JavaArray javaArrayClassFor: self.

    "Created: / 06-12-2011 / 17:29:01 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
! !
!FloatArray class methodsFor:'accessing-java'!

javaComponentClass

    ^ShortFloat

    "Created: / 20-12-2010 / 22:06:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!FloatArray class methodsFor:'accessing'!

javaName

    ^'[F'.

    "Modified: / 25-02-2011 / 19:03:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!GenericToolbarIconLibrary class methodsFor:'image specs-tools-SystemBrowser-java'!

javaClassBrowserIcon
    "This resource specification was automatically generated
     by the ImageEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the ImageEditor may not be able to read the specification."

    "
     self javaClassBrowserIcon inspect
     ImageEditor openOnClass:self andSelector:#javaClassBrowserIcon
     Icon flushCachedIcons
    "

    <resource: #image>

    ^Icon
	constantNamed:'GenericToolbarIconLibrary class javaClassBrowserIcon'
	ifAbsentPut:[(Depth8Image new) width: 16; height: 16; photometric:(#palette); bitsPerSample:(#(8)); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'
VU%YVU%YVU%YVU%YVU%YVU%YVU%YVU%YVU%YVU%YVU%YVU%YVU\OF@4YC5]YVU%YVU%YVP$MO4YFQ#<ABU%YVU%YVP$[R5YTUUQRQ0(IVU%YVU\MRUAXVE!!X
VD=H@U]YVU$GPEEXVEMMS%!!LR$@PVU%YASYBVDMAPTEEQDP>AU%YVPDVI5 (EALSEA\\H@1YVU$EGQ)XJQ8"H!!H.C"PEVU%YDBD3M5 /I!!=XOR4*@E%YVU\J
LC(4VE!!XMS02B%]YVU%YDP,#NC$;NS 1@!!EYVU%YVU$QERT+KB,%EQEYVU%YVU%YVU\F@0PCBE]YVU%YVU%YVU%YVU%YVU%YVU%YVP@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@a') ; colorMapFromArray:#[108 168 129 51 130 77 54 131 79 64 137 88 66 139 90 70 143 94 84 152 106 90 155 112 92 156 113 130 179 146 36 118 62 46 124 70 51 129 75 57 134 80 88 156 109 93 158 113 99 162 119 129 178 144 162 201 174 45 124 68 46 125 69 47 125 70 48 126 70 51 129 73 75 146 96 74 144 94 119 174 135 50 128 71 54 132 74 59 135 79 63 137 82 142 189 154 62 136 79 62 136 80 62 135 80 70 142 87 71 143 88 82 150 98 107 167 122 143 190 154 195 221 201 226 239 229 82 150 96 86 154 100 86 153 100 93 156 106 171 207 179 188 216 194 84 151 97 87 153 100 88 153 100 94 156 106 218 234 221 230 241 232 82 150 94 241 247 242 96 160 105 124 178 132 121 174 129 133 184 140 140 188 147 240 247 241 89 153 97 104 164 111 97 160 103 96 158 102 158 198 161 220 234 221 103 162 106 109 166 112 119 174 120 128 179 128 123 177 122 121 174 119 135 184 133 129 179 125 225 239 224 145 190 140 179 210 176 188 217 185 190 218 187 159 199 154 160 199 155 187 216 183 194 220 191 198 222 195 176 208 171 201 208 199 255 255 255 255 255 255]; mask:((ImageMask new) width: 16; height: 16; photometric:(#blackIs0); bitsPerSample:(#[1]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@@_0C? _?C?>O?8??#?>O?8??#?>G?0O>@_0@@@b') ; yourself); yourself]
! !
!GenericToolbarIconLibrary class methodsFor:'image specs-tools-SystemBrowser-java'!

javaExceptionBrowserIcon
    "This resource specification was automatically generated
     by the ImageEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the ImageEditor may not be able to read the specification."

    "
     self javaExceptionBrowserIcon inspect
     ImageEditor openOnClass:self andSelector:#javaExceptionBrowserIcon
     Icon flushCachedIcons
    "

    <resource: #image>

    ^Icon
	constantNamed:'GenericToolbarIconLibrary class javaExceptionBrowserIcon'
	ifAbsentPut:[(Depth8Image new) width: 16; height: 16; photometric:(#palette); bitsPerSample:(#(8)); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'
D!!HRD!!HC@@DRD!!HRD!!HRD!!HRD!!HR@0@AD!!HRD!!HRD!!HRD!!HRD L@@QHRA $IA!!HRD!!HRD!!HC@@DRD $EAP$RD!!HRD!!HR@0@AD!!HIAPTID!!HRD!!HRD L@@QHR
B ,KB!!HRD!!HR@0HB@@HRD  PD@ RD!!HRD LA@@HRD!!HLDQDLD!!HRD!!HRD!!HRD!!HRA0<OA1HRD!!HRD!!HRD!!HRD!!HNC!!HRD!!HRD!!HRD!!HRD!!HRD!!HRD!!HRD!!HR
D!!HRD!!HRA $IA!!HRD!!HRD!!HRD!!HRD $MA@$RD!!HRD!!HRD!!HRD!!HNCPPND!!HRD!!HRD!!HRD!!HRA 8NA!!HRD!!HRD!!HRD!!HRD!!HRD!!HRD @@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@a') ; colorMapFromArray:#[40 98 150 81 128 170 110 150 185 194 211 226 255 223 95 255 234 145 228 221 192 218 204 156 184 149 37 190 156 40 188 153 39 255 226 134 180 143 35 255 223 127 170 130 30 207 167 62 254 215 119 254 207 108 255 255 255]; mask:((ImageMask new) width: 16; height: 16; photometric:(#blackIs0); bitsPerSample:(#[1]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'A0@G@@\<A30GO@\<G30^O@@<@A @@@@<@C0@O@@<@@@b') ; yourself); yourself]
! !
!GenericToolbarIconLibrary class methodsFor:'image specs-tools-SystemBrowser-java'!

javaPrivateClassBrowserIcon
    "This resource specification was automatically generated
     by the ImageEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the ImageEditor may not be able to read the specification."

    "
     self javaPrivateClassBrowserIcon inspect
     ImageEditor openOnClass:self andSelector:#javaPrivateClassBrowserIcon
     Icon flushCachedIcons
    "

    <resource: #image>

    ^Icon
	constantNamed:'GenericToolbarIconLibrary class javaPrivateClassBrowserIcon'
	ifAbsentPut:[(Depth8Image new) width: 16; height: 16; photometric:(#palette); bitsPerSample:(#(8)); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'
XVE!!XQHWHAX!!E1I!!XVE!!XVE!!XQ@VPD]GQ4@JDFE!!XVE!!XQ@$SE]UU%USRALPXVE!!XQHVR%E XFA XEAIB!!I!!XVDNPUI XEQNS6AMR4DXXVE!!CC%CXDQBP$IF
QTT?CFE!!XP(^K6@1GA,[GA<%JQU!!XVDLI"I L"\+J1$4F" QXVE!!FB(7N&@5K%)ZV%)ZV%)!!XRLSM#48XFAYWE1\WE1YXVE!!C1P,N30>V51^W%9\V6E!!XVDO
GR43L@HGA TFA0I!!XVE!!XQHMB0$CW54@@E<AXVE!!XVE!!XVE!!AE!!XVE!!XAFE!!XVE!!XVE!!XP HB@ HB@!!!!XVE!!XVE!!XVE!!XVE!!XVE!!XP@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@a') ; colorMapFromArray:#[231 96 97 200 41 48 200 48 52 200 41 49 200 29 44 242 77 92 241 77 92 245 118 128 200 25 42 152 195 167 51 130 77 64 137 88 70 143 94 84 152 106 90 155 112 126 179 144 129 181 146 155 198 169 205 226 212 36 118 62 46 124 70 51 129 75 57 134 80 93 158 113 99 162 119 162 201 174 166 204 178 45 124 68 46 125 69 47 125 70 48 126 70 51 129 73 75 146 96 74 144 94 119 174 135 216 233 221 50 128 71 54 132 74 59 135 79 63 137 82 155 198 166 62 136 79 62 136 80 62 135 80 70 142 87 82 150 98 107 167 122 143 190 154 164 203 173 195 221 201 226 239 229 86 154 100 171 207 179 188 216 194 84 151 97 94 156 106 218 234 221 82 150 94 241 247 242 96 160 105 124 178 132 121 174 129 167 204 172 89 153 97 104 164 111 97 160 103 96 158 102 158 198 161 220 234 221 103 162 106 109 166 112 119 174 120 128 179 128 123 177 122 121 174 119 135 184 133 129 179 125 225 239 224 145 190 140 179 210 176 188 217 185 190 218 187 159 199 154 160 199 155 187 216 183 194 220 191 198 222 195 176 208 171 231 147 139 201 67 60 201 71 62 201 62 58 246 146 142 231 96 96 245 124 124 237 131 131 255 255 255 255 255 255]; mask:((ImageMask new) width: 16; height: 16; photometric:(#blackIs0); bitsPerSample:(#[1]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'C>@_<C?8_?1??G?<_?1??G?>_?8??!!?>C?8@? C>@@@b') ; yourself); yourself]
! !
!GenericToolbarIconLibrary class methodsFor:'image specs-tools-SystemBrowser-java'!

javaPrivateEnumBrowserIcon
    "This resource specification was automatically generated
     by the ImageEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the ImageEditor may not be able to read the specification."

    "
     self javaPrivateEnumBrowserIcon inspect
     ImageEditor openOnClass:self andSelector:#javaPrivateEnumBrowserIcon
     Icon flushCachedIcons
    "

    <resource: #image>

    ^Icon
	constantNamed:'GenericToolbarIconLibrary class javaPrivateEnumBrowserIcon'
	ifAbsentPut:[(Depth8Image new) width: 16; height: 16; photometric:(#palette); bitsPerSample:(#(8)); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'
QDQDQC\#F1PZH3]DQDQDQDQDQB0TI"@ HBXRKDQDQDQDQB0PJ#D1LSD1I 0,QDQDQC\TJR%BP$IBP#H D#]DQDP!!IBP$P$H6K2<''IBP%QDQDFQ0"H$IBKRH"
H"T FTQDQAHOCP5BP$IBP" SE!!EDQDPYEQTUP$H0NC JL3L5QDQDIQX\GDIBB30<OC0<OC1DQC\LG!!9BP$L<O#8>O#8;QDQDJ04XK"89OS9@PD@>OTQDQDP+
C!!4 BPHGA TFA0IDQDQDQC\_E3PCPS<@@DDAQDQDQDQDQDQDAC(:N#(:BDQDQDQDQDQDQ@ HB@ HB@!!DQDQDQDQDQDQDQDQDQDQDQ@@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@a') ; colorMapFromArray:#[231 96 97 200 41 48 200 48 52 200 41 49 200 29 44 242 77 92 241 77 92 245 118 128 200 25 42 217 201 182 219 204 186 230 219 206 140 89 32 142 92 36 142 93 37 143 93 38 144 94 39 144 95 40 145 96 41 146 97 43 147 99 45 147 100 47 148 101 48 149 103 50 152 107 56 153 108 57 154 109 60 155 111 62 158 115 67 158 116 68 159 117 69 160 118 71 161 119 73 163 123 77 165 125 81 165 126 81 166 127 83 169 131 88 170 133 91 176 141 102 178 144 106 180 147 110 185 154 119 186 156 122 187 157 124 190 161 129 194 167 137 199 174 146 204 182 157 206 184 160 209 188 165 212 193 172 213 195 174 214 196 176 216 199 180 225 211 196 226 213 199 231 220 208 231 147 139 201 67 60 201 71 62 201 62 58 246 146 142 231 96 96 245 124 124 237 131 131 255 254 254 255 255 255 255 255 255]; mask:((ImageMask new) width: 16; height: 16; photometric:(#blackIs0); bitsPerSample:(#[1]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'C>@_<C?8_?1??G?<_?1??G?>_?8??!!?>C?8@? C>@@@b') ; yourself); yourself]
! !
!GenericToolbarIconLibrary class methodsFor:'image specs-tools-SystemBrowser-java'!

javaPrivateInterfaceBrowserIcon
    "This resource specification was automatically generated
     by the ImageEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the ImageEditor may not be able to read the specification."

    "
     self javaPrivateInterfaceBrowserIcon inspect
     ImageEditor openOnClass:self andSelector:#javaPrivateInterfaceBrowserIcon
     Icon flushCachedIcons
    "

    <resource: #image>

    ^Icon
	constantNamed:'GenericToolbarIconLibrary class javaPrivateInterfaceBrowserIcon'
	ifAbsentPut:[(Depth8Image new) width: 16; height: 16; photometric:(#palette); bitsPerSample:(#(8)); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'
TUEQTTPVCP,NE$QQTUEQTUEQTS<KD!!TUEQHKO5EQTUEQTS<3OQ-GQ4\[OSL?TUEQTRD,NQ1PTEAPB!!0;KBEQTUDVD3 8FEAPBS 8NAPYTUEQC4XLC@1PTDLL
CCT5C5EQTR<(J"\''TE@ I2\*IB9QTUDOKR,&I%APPT@^GQ5BTUEQFSH0LTUPTD)JR$)JR$)QTRH#M#)PTEAJSD1LSD1ITUEQF"TQOC0_R41NS$9LR5EQTUDZ
JS\PO HGA TFA0IQTUEQTTPWMA<CS44@@D<ATUEQTUEQTUEQAD!!HRD!!HBEEQTUEQTUEQTP HB@ HB@!!QTUEQTUEQTUEQTUEQTUEQTP@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@a') ; colorMapFromArray:#[231 96 97 200 41 48 200 48 52 200 41 49 200 29 44 242 77 92 241 77 92 245 118 128 200 25 42 197 188 224 215 209 233 112 94 176 111 93 174 114 96 177 113 95 176 115 97 177 117 100 177 120 102 180 125 108 184 125 108 183 130 114 185 143 128 194 151 136 198 149 135 197 158 145 203 156 143 201 159 146 203 165 153 207 168 156 208 168 156 207 167 155 205 171 160 209 174 164 209 220 215 236 226 222 240 85 66 159 90 71 159 93 74 164 90 72 159 89 71 158 92 73 160 94 75 164 93 74 161 93 75 161 97 79 167 96 79 166 97 79 166 98 80 167 98 80 165 96 79 162 101 83 168 101 84 169 108 91 173 107 91 172 111 94 174 117 100 178 131 116 188 137 122 191 134 120 187 139 125 191 138 124 190 142 128 193 154 142 199 161 149 204 167 156 207 174 165 210 181 172 216 185 176 218 204 198 228 94 78 161 105 89 172 174 165 212 231 147 139 201 67 60 201 71 62 201 62 58 246 146 142 231 96 96 245 124 124 237 131 131 255 255 255 255 255 255]; mask:((ImageMask new) width: 16; height: 16; photometric:(#blackIs0); bitsPerSample:(#[1]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'C>@_<C?8_?1??G?<_?1??G?>_?8??!!?>C?8@? C>@@@b') ; yourself); yourself]
! !
!GenericToolbarIconLibrary class methodsFor:'image specs-tools-SystemBrowser-java'!

javaProtectedClassBrowserIcon
    "This resource specification was automatically generated
     by the ImageEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the ImageEditor may not be able to read the specification."

    "
     self javaProtectedClassBrowserIcon inspect
     ImageEditor openOnClass:self andSelector:#javaProtectedClassBrowserIcon
     Icon flushCachedIcons
    "

    <resource: #image>

    ^Icon
	constantNamed:'GenericToolbarIconLibrary class javaProtectedClassBrowserIcon'
	ifAbsentPut:[(Depth8Image new) width: 16; height: 16; photometric:(#palette); bitsPerSample:(#(8)); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'
X6M#X0(PE 8WD@)#X6M#X6M#X0\NM34=OS\@A6M#X6M#X0\\P$5KSD-IO ,GX6M#X0(NPD]"X&I"X$X?@@)#X6LEND!!"X$)DQVICPS QX6M#@2<:X#,9NS$<
LSD6@6M#X0@UIVH(D1HRD1 _I 5#X6LCGQ)"JQ8!!HP<(T%HHX6M#DR@-LFH+IA%"T$9NT&M#X1,KKCP.X&I"T5APTD=TX6M#A 0"L#L5VUUZV%)ZUUE#X6LF
EBL*I5!!_XVE!!XU=WX6M#X0(D@PHIW&A XFAVX6M#X6M#X6M#X6M\XFA]X6M#X6M#X6M#X6M#X5-[X6M#X6M#X6M#X6M#X6M#X6M#X0@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@a') ; colorMapFromArray:#[51 130 77 64 137 88 66 139 90 70 143 94 84 152 106 90 155 112 126 179 144 129 181 146 155 198 169 180 212 191 205 226 212 36 118 62 46 124 70 51 129 75 57 134 80 79 149 101 93 158 113 99 162 119 45 124 68 46 125 69 47 125 70 48 126 70 75 146 96 74 144 94 83 151 103 109 168 126 119 174 135 216 233 221 50 128 71 59 135 79 63 137 82 144 191 156 62 136 80 62 135 80 70 142 87 82 150 98 107 167 122 143 190 154 150 194 161 164 203 173 195 221 201 226 239 229 86 154 100 188 216 194 84 151 97 94 156 106 218 234 221 82 150 94 241 247 242 84 151 94 96 160 105 124 178 132 121 174 129 167 204 172 89 153 97 104 164 111 97 160 103 96 158 102 158 198 161 220 234 221 109 166 112 119 174 120 128 179 128 123 177 122 121 174 119 135 184 133 129 179 125 225 239 224 145 190 140 179 210 176 188 217 185 190 218 187 159 199 154 160 199 155 187 216 183 194 220 191 198 222 195 176 208 171 255 242 176 255 233 145 255 234 145 183 147 37 190 156 40 187 152 39 187 153 39 255 230 152 174 135 31 179 141 34 178 141 34 184 147 36 255 222 125 167 126 28 170 129 29 170 130 30 174 135 32 254 219 140 254 222 150 254 207 108 255 255 255 255 255 255]; mask:((ImageMask new) width: 16; height: 16; photometric:(#blackIs0); bitsPerSample:(#[1]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'C>@_<C?8_?1??G?<_?1??G?<_?8??1??C?8@O@@X@@@b') ; yourself); yourself]
! !
!GenericToolbarIconLibrary class methodsFor:'image specs-tools-SystemBrowser-java'!

javaProtectedEnumBrowserIcon
    "This resource specification was automatically generated
     by the ImageEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the ImageEditor may not be able to read the specification."

    "
     self javaProtectedEnumBrowserIcon inspect
     ImageEditor openOnClass:self andSelector:#javaProtectedEnumBrowserIcon
     Icon flushCachedIcons
    "

    <resource: #image>

    ^Icon
	constantNamed:'GenericToolbarIconLibrary class javaProtectedEnumBrowserIcon'
	ifAbsentPut:[(Depth8Image new) width: 16; height: 16; photometric:(#palette); bitsPerSample:(#(8)); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'
Q4]GQ4P-IQ4$KTQGQ4]GQ4]GQ3\]LB(*J#@\M4]GQ4]GQ3\ZMS4=OS4=LAX7Q4]GQ4P]L3MFQ$YFQ#8*GDQGQ4\+K"8.Q$YCN3,1K"8/Q4]GH2X,KDYFNB0,
KB<*H4]GQ10YE1]FQ$YFQ#H?PQ-GQ4\#G!!8^Q$X<MCPUA@QBQ4]GK1<&I$YFNRYCA@@@AD]GQ4PVJB!!FQ$YFAPHB@ DFQ4]GM!!\"N#)EB0\LC@0LA0MGQ4\6
FB\*E@(QD1LSD1DIQ4]GQ4P)HBE@DAHRD!!HHQ4]GQ4]GQ4]GQ4\ND!!HOQ4]GQ4]GQ4]GQ4]GQ04MQ4]GQ4]GQ4]GQ4]GQ4]GQ4]GQ0@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@a') ; colorMapFromArray:#[255 242 176 255 233 145 255 234 145 183 147 37 190 156 40 187 152 39 187 153 39 255 230 152 174 135 31 179 141 34 178 141 34 184 147 36 255 222 125 167 126 28 170 129 29 170 130 30 174 135 32 254 219 140 254 222 150 254 207 108 217 201 182 219 204 186 140 89 32 142 92 36 142 93 37 143 93 38 144 94 39 144 95 40 145 96 41 147 99 45 147 100 47 148 101 48 149 103 50 151 104 53 152 107 56 153 108 57 154 109 60 155 111 62 158 115 67 158 116 68 159 117 69 160 118 71 161 119 73 163 123 77 165 125 81 165 126 81 166 127 83 169 131 88 170 133 91 176 141 102 178 144 106 180 147 110 182 150 114 185 154 119 186 156 122 187 157 124 190 161 129 192 164 133 194 167 137 199 174 146 204 182 157 206 184 160 209 188 165 211 192 170 213 194 173 212 193 172 214 196 176 216 199 180 225 211 196 231 220 208 255 254 254 255 255 255]; mask:((ImageMask new) width: 16; height: 16; photometric:(#blackIs0); bitsPerSample:(#[1]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'C>@_<C?8_?1??G?<_?1??G?<_?8??1??C?8@O@@X@@@b') ; yourself); yourself]
! !
!GenericToolbarIconLibrary class methodsFor:'image specs-tools-SystemBrowser-java'!

javaProtectedInterfaceBrowserIcon
    "This resource specification was automatically generated
     by the ImageEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the ImageEditor may not be able to read the specification."

    "
     self javaProtectedInterfaceBrowserIcon inspect
     ImageEditor openOnClass:self andSelector:#javaProtectedInterfaceBrowserIcon
     Icon flushCachedIcons
    "

    <resource: #image>

    ^Icon
	constantNamed:'GenericToolbarIconLibrary class javaProtectedInterfaceBrowserIcon'
	ifAbsentPut:[(Depth8Image new) width: 16; height: 16; photometric:(#palette); bitsPerSample:(#(8)); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'
U%YVU#4MA@HECS5VU%YVU%YVU# BBP0LC@$BNEYVU%YVU# -M1I@PD@RM248U%YVU!!0&L1QUUUUU@QP5I!!1VU%XMB#H2C5UU@CH2L ,PU%YVA#<C@0MUUS0C
@2</A%YVU"$"IBD!!UUTYHRDUD2!!VU%XFI2T HEUUN"@VQTT;U%YVDB0*J39UUQ(9QTEAQUYVU!!4^LCQUUUUUQ$MCP4IGU%YVDQ<HM#XWSD!!MST5MRDQVU%XQ
H3DGF4-RUEQTUEIJU%YVU#4NK"\XTUMST5MIU%YVU%YVU%YVU%YOT5MPU%YVU%YVU%YVU%YVU$9NU%YVU%YVU%YVU%YVU%YVU%YVU @@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@a') ; colorMapFromArray:#[197 188 224 215 209 233 112 94 176 111 93 174 114 96 177 113 95 176 115 97 177 117 100 177 120 102 180 125 108 184 125 108 183 130 114 185 143 128 194 151 136 198 149 135 197 158 145 203 156 143 201 159 146 203 165 153 207 167 155 207 168 156 208 168 156 207 167 155 205 171 160 209 178 167 213 174 164 209 177 167 212 183 173 216 220 215 236 226 222 240 85 66 159 93 74 164 90 72 159 89 71 158 92 73 160 94 75 164 93 74 161 93 75 161 97 79 167 96 79 166 97 79 166 98 80 167 98 80 165 96 79 162 101 83 168 101 84 169 108 91 173 107 91 172 111 94 174 117 100 178 131 116 188 137 122 191 134 120 187 139 125 191 138 124 190 142 128 193 161 149 204 169 159 207 174 165 210 181 172 216 185 176 218 204 198 228 94 78 161 105 89 172 174 165 212 255 242 176 255 233 145 255 234 145 183 147 37 190 156 40 187 152 39 187 153 39 255 230 152 174 135 31 179 141 34 178 141 34 184 147 36 255 222 125 167 126 28 170 129 29 170 130 30 174 135 32 254 219 140 254 222 150 254 207 108 255 255 255 255 255 255]; mask:((ImageMask new) width: 16; height: 16; photometric:(#blackIs0); bitsPerSample:(#[1]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'C>@_<C?8_?1??G?<_?1??G?<_?8??1??C?8@O@@X@@@b') ; yourself); yourself]
! !
!GenericToolbarIconLibrary class methodsFor:'image specs-tools-SystemBrowser-java'!

javaPublicClassBrowserIcon
    "This resource specification was automatically generated
     by the ImageEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the ImageEditor may not be able to read the specification."

    "
     self javaClassBrowserIcon inspect
     ImageEditor openOnClass:self andSelector:#javaClassBrowserIcon
     Icon flushCachedIcons
    "

    <resource: #image>

    ^Icon
	constantNamed:'GenericToolbarIconLibrary class javaClassBrowserIcon'
	ifAbsentPut:[(Depth8Image new) width: 16; height: 16; photometric:(#palette); bitsPerSample:(#(8)); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'
VU%YVU%YVU%YVU%YVU%YVU%YVU%YVU%YVU%YVU%YVU%YVU%YVU\OF@4YC5]YVU%YVU%YVP$MO4YFQ#<ABU%YVU%YVP$[R5YTUUQRQ0(IVU%YVU\MRUAXVE!!X
VD=H@U]YVU$GPEEXVEMMS%!!LR$@PVU%YASYBVDMAPTEEQDP>AU%YVPDVI5 (EALSEA\\H@1YVU$EGQ)XJQ8"H!!H.C"PEVU%YDBD3M5 /I!!=XOR4*@E%YVU\J
LC(4VE!!XMS02B%]YVU%YDP,#NC$;NS 1@!!EYVU%YVU$QERT+KB,%EQEYVU%YVU%YVU\F@0PCBE]YVU%YVU%YVU%YVU%YVU%YVU%YVP@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@a') ; colorMapFromArray:#[108 168 129 51 130 77 54 131 79 64 137 88 66 139 90 70 143 94 84 152 106 90 155 112 92 156 113 130 179 146 36 118 62 46 124 70 51 129 75 57 134 80 88 156 109 93 158 113 99 162 119 129 178 144 162 201 174 45 124 68 46 125 69 47 125 70 48 126 70 51 129 73 75 146 96 74 144 94 119 174 135 50 128 71 54 132 74 59 135 79 63 137 82 142 189 154 62 136 79 62 136 80 62 135 80 70 142 87 71 143 88 82 150 98 107 167 122 143 190 154 195 221 201 226 239 229 82 150 96 86 154 100 86 153 100 93 156 106 171 207 179 188 216 194 84 151 97 87 153 100 88 153 100 94 156 106 218 234 221 230 241 232 82 150 94 241 247 242 96 160 105 124 178 132 121 174 129 133 184 140 140 188 147 240 247 241 89 153 97 104 164 111 97 160 103 96 158 102 158 198 161 220 234 221 103 162 106 109 166 112 119 174 120 128 179 128 123 177 122 121 174 119 135 184 133 129 179 125 225 239 224 145 190 140 179 210 176 188 217 185 190 218 187 159 199 154 160 199 155 187 216 183 194 220 191 198 222 195 176 208 171 201 208 199 255 255 255 255 255 255]; mask:((ImageMask new) width: 16; height: 16; photometric:(#blackIs0); bitsPerSample:(#[1]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@@_0C? _?C?>O?8??#?>O?8??#?>G?0O>@_0@@@b') ; yourself); yourself]

    "Created: / 23-10-2011 / 14:41:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!GenericToolbarIconLibrary class methodsFor:'image specs-tools-SystemBrowser-java'!

javaPublicEnumBrowserIcon
    "This resource specification was automatically generated
     by the ImageEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the ImageEditor may not be able to read the specification."

    "
     self javaPublicEnumBrowserIcon inspect
     ImageEditor openOnClass:self andSelector:#javaPublicEnumBrowserIcon
     Icon flushCachedIcons
    "

    <resource: #image>

    ^Icon
	constantNamed:'GenericToolbarIconLibrary class javaPublicEnumBrowserIcon'
	ifAbsentPut:[(Depth8Image new) width: 16; height: 16; photometric:(#palette); bitsPerSample:(#(8)); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'
LC@0LB8ZD@ OF"80LC@0LC@0LBTHGQXVE!!4FIS@0LC@0LBTDH2,+J2,+GP@%LC@0LB8HHRD/K2</K20VA"80LC@WF1,[K2<-JR$_F1,\LC@0C!!DYFR</I!!$Y
FQ0VC#@0L@XC@PD/K2</K2@GB T0LC@NBP$IK2<*H"H[BP$NLC@0G@(QDR</I1DQDQDQG#@0LB8@D1L/K2</K20V@B80LC@0I@DMJB (JB ]A2P0LC@0LC@$
@!!HVEQXR@"P0LC@0LC@0LB8TB00KFB80LC@0LC@0LC@0LC@0LC@0LC@0LC@0LC@0LC@0LC@0LC@0LC@0LC@0LC@0LC@0LC@0LC@0L@@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@a') ; colorMapFromArray:#[140 89 32 142 92 36 142 93 37 143 93 38 144 94 39 144 95 40 145 96 41 146 97 43 147 99 45 147 100 47 148 101 48 149 103 50 151 104 53 152 107 56 153 108 57 154 109 60 155 111 62 158 115 67 158 116 68 159 117 69 160 118 71 161 119 72 161 119 73 163 123 77 164 124 79 165 125 81 165 126 81 166 127 83 169 131 88 170 133 91 175 139 100 176 141 102 178 144 106 180 147 110 182 150 114 185 154 119 186 156 122 187 157 124 190 161 129 192 164 133 194 167 137 199 174 146 204 182 157 206 184 160 209 188 165 216 199 180 225 211 196 255 254 254 255 255 255]; mask:((ImageMask new) width: 16; height: 16; photometric:(#blackIs0); bitsPerSample:(#[1]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'C>@_<C?8_?1??G?<_?1??G?<_?0?>A?0C>@@@@@@@@@b') ; yourself); yourself]
! !
!GenericToolbarIconLibrary class methodsFor:'image specs-tools-SystemBrowser-java'!

javaPublicInterfaceBrowserIcon
    "This resource specification was automatically generated
     by the ImageEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the ImageEditor may not be able to read the specification."

    "
     self javaPublicInterfaceBrowserIcon inspect
     ImageEditor openOnClass:self andSelector:#javaPublicInterfaceBrowserIcon
     Icon flushCachedIcons
    "

    <resource: #image>

    ^Icon
	constantNamed:'GenericToolbarIconLibrary class javaPublicInterfaceBrowserIcon'
	ifAbsentPut:[(Depth8Image new) width: 16; height: 16; photometric:(#palette); bitsPerSample:(#(8)); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'
P4MCP38NAPLFC#9CP4MCP4MCP3,CB 4MCP(CN4MCP4MCP3,.N!!UAPTDUN"8;P4MCP1$%M!!YBP$IB@!!X8IQ%CP4LNB3T5DTIB@CT5MP0RP4MCA4@DA@QBP#4D
AC@0A4MCP2  H!!<_P$HWG1<"GB]CP4LGI"P^G$IBOA8_H"LGP4MCD"4*J3=BP!! ?J2,,EDMCP1([L3]BP$IB@S\2F1%CP4MCD14INS$9NS$1JQMCP4MCP4LS
HSPHB@ 4HQMCP4MCP4MCP38OK2X/DC9CP4MCP4MCP4MCP4MCP4MCP4MCP4MCP4MCP4MCP4MCP4MCP4MCP4MCP4MCP4MCP4MCP4MCP0@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@a') ; colorMapFromArray:#[197 188 224 197 189 222 215 209 233 112 94 176 111 93 174 114 96 177 113 95 176 115 97 177 117 100 177 120 102 180 125 108 184 125 108 183 130 114 185 143 128 194 151 136 198 149 135 197 152 138 199 158 145 203 156 143 201 159 146 203 162 150 204 165 153 207 168 156 208 174 164 209 177 167 212 220 215 236 226 222 240 85 66 159 90 71 159 93 74 164 90 72 159 89 71 158 92 73 160 94 75 164 93 74 161 92 74 160 93 75 161 97 79 167 96 79 166 97 79 166 98 80 167 100 82 168 98 80 165 96 79 162 100 82 167 101 83 168 101 84 169 108 91 173 107 91 172 108 92 172 113 96 177 111 94 174 117 100 178 131 116 188 137 122 191 134 120 187 139 125 191 138 124 190 142 128 193 161 149 204 174 165 210 185 176 218 204 198 228 94 78 161 105 89 172 174 165 212 255 255 255 255 255 255]; mask:((ImageMask new) width: 16; height: 16; photometric:(#blackIs0); bitsPerSample:(#[1]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'C>@_<C?8_?1??G?<_?1??G?<_?0?>A?0C>@@@@@@@@@b') ; yourself); yourself]
! !
!GenericToolbarIconLibrary class methodsFor:'image specs-tools-SystemBrowser-java'!

javaRuntimeExceptionBrowserIcon
    "This resource specification was automatically generated
     by the ImageEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the ImageEditor may not be able to read the specification."

    "
     self javaRuntimeExceptionBrowserIcon inspect
     ImageEditor openOnClass:self andSelector:#javaRuntimeExceptionBrowserIcon
     Icon flushCachedIcons
    "

    <resource: #image>

    ^Icon
	constantNamed:'GenericToolbarIconLibrary class javaRuntimeExceptionBrowserIcon'
	ifAbsentPut:[(Depth8Image new) width: 16; height: 16; photometric:(#palette); bitsPerSample:(#(8)); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'
D1LSD1LMB ,SD1LSD1LSD1LSD1LSCP(KD1LSD1LSD1LSD1LSD04JB1LSB@8NBALSD1LSD1LMB ,SD08OC08SD1LSD1LSCP(KD1LND!!DND1LSD1LSD04JB1LS
D@@@DALSD1LSCP0LB 0SD0DB@0DSD1LSD04KB 0SD1LGAPPGD1LSD1LSD1LSD1LSA 8NA!!LSD1LSD1LSD1LSD1LGA1LSD1LSD1LSD1LSD1LSD1LSD1LSD1LS
D1LSD1LSBP8NBQLSD1LSD1LSD1LSD08QDP8SD1LSD1LSD1LSD1LGDQDGD1LSD1LSD1LSD1LSB@\GBALSD1LSD1LSD1LSD1LSD1LSD0@@@@@@@@@@@@@@@@@@
@@@@@@@@@@@@@@@@@@@@@@@@@@@a') ; colorMapFromArray:#[244 120 123 200 39 47 244 102 111 243 103 111 243 88 99 242 87 99 233 164 170 200 25 42 242 197 202 244 208 212 40 98 150 81 128 170 110 150 185 194 211 226 201 71 62 246 146 142 201 58 56 246 136 134 246 135 135 255 255 255]; mask:((ImageMask new) width: 16; height: 16; photometric:(#blackIs0); bitsPerSample:(#[1]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'A0@G@@\<A30GO@\<G30^O@@<@A @@@@<@C0@O@@<@@@b') ; yourself); yourself]
! !
!Integer class methodsFor:'queries'!

isJavaPrimitiveType

    ^true

    "Created: / 11-02-2011 / 11:12:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Integer class methodsFor:'accessing'!

javaArrayClass
    ^ SignedIntegerArray

    "Created: / 11-02-2011 / 10:51:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Integer class methodsFor:'autoboxing support'!

javaBox: anObject
    | wrapper |

    wrapper := (JavaVM classForName: 'java.lang.Integer') new.
    wrapper perform: #'<init>(I)V' with: anObject.
    ^ wrapper

    "Created: / 16-08-2011 / 09:58:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Integer class methodsFor:'accessing'!

javaName

    ^'int'.

    "Modified: / 25-02-2011 / 18:59:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Integer class methodsFor:'autoboxing support'!

javaUnbox: object onError: errorBlock

    ^self javaUnbox: object onError: errorBlock 
          min: "Integer.MIN_VALUE"-2147483648
          max: "Integer.MAX_VALUE" 2147483647

    "Created: / 25-11-2011 / 19:10:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Integer class methodsFor:'autoboxing support'!

javaUnbox: object onError: errorBlock min: min max: max

    | value |

    (#(  'java/lang/Byte'
        'java/lang/Short'
        'java/lang/Integer'
        "'java/lang/Long'" ) includes: object class name) ifFalse:[
        errorBlock value.
    ].

    value := object instVarNamed:#value.
    (value between: min and: max) ifFalse:[
        errorBlock value.
    ].
    ^value

    "Created: / 22-11-2011 / 11:43:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!LargeInteger class methodsFor:'queries'!

isJavaPrimitiveType

    ^true

    "Created: / 04-02-2011 / 11:55:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!LargeInteger class methodsFor:'accessing'!

javaArrayClass
    ^ SignedLongIntegerArray

    "Created: / 11-02-2011 / 10:51:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!LargeInteger class methodsFor:'autoboxing support'!

javaBox: anObject
    | wrapper |

    wrapper := (JavaVM classForName: 'java.lang.Long') new.
    wrapper perform: #'<init>(J)V' with: anObject.
    ^ wrapper

    "Created: / 16-08-2011 / 09:58:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!LargeInteger class methodsFor:'accessing'!

javaName

    ^'long'.

    "Modified: / 25-02-2011 / 18:59:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!LargeInteger class methodsFor:'autoboxing support'!

javaUnbox: object onError: errorBlock

    | value |

    (object class name = 'java/lang/Long') ifFalse:[
        errorBlock value.
    ].

    value := object instVarNamed:#value.
    (value between: "Integer.MIN_VALUE"-9223372036854775808 and: "Integer.MAX_VALUE" 9223372036854775807) ifFalse:[
        errorBlock value.
    ].
    ^value

    "Created: / 22-11-2011 / 11:45:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Object class methodsFor:'queries'!

isJavaArrayClass

    ^false

    "Created: / 19-12-2010 / 17:05:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Object class methodsFor:'queries'!

isJavaClassType

    ^false

    "Created: / 11-02-2011 / 08:08:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Object class methodsFor:'queries'!

isJavaPrimitiveType

    ^false

    "Created: / 20-12-2010 / 21:52:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Object class methodsFor:'queries'!

isJavaReferenceType

    ^false

    "Created: / 20-12-2010 / 21:52:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Object class methodsFor:'queries'!

isJavaType

    ^false

    "Created: / 20-12-2010 / 21:52:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProjectDefinition class methodsFor:'description - java'!

javaClassPath

    "Defines a Java class path containing java classes/jars
     required by this package"

    ^#()

    "Created: / 13-12-2011 / 23:48:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProjectDefinition class methodsFor:'description - java'!

javaSourcePath

    "Defines paths to Java source files (for packages that
     contains Java code"    
    ^#()

    "Created: / 13-12-2011 / 23:49:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ShortFloat class methodsFor:'queries'!

isJavaPrimitiveType

    ^true

    "Created: / 06-02-2011 / 17:21:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ShortFloat class methodsFor:'accessing'!

javaArrayClass
    ^ FloatArray

    "Created: / 11-02-2011 / 10:50:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ShortFloat class methodsFor:'autoboxing support'!

javaBox: anObject
    | wrapper |

    wrapper := (JavaVM classForName: 'java.lang.Float') new.
    wrapper perform: #'<init>(F)V' with: anObject.
    ^ wrapper

    "Created: / 16-08-2011 / 09:58:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ShortFloat class methodsFor:'accessing'!

javaName

    ^'float'.

    "Modified: / 25-02-2011 / 18:59:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SignedIntegerArray class methodsFor:'testing'!

isInterface

    ^false
! !
!SignedIntegerArray class methodsFor:'queries'!

isJavaArrayClass

    ^true

    "Created: / 06-02-2011 / 15:16:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SignedIntegerArray class methodsFor:'accessing-java'!

javaArrayClass

    ^JavaArray javaArrayClassFor: SignedIntegerArray

    "Created: / 11-06-2011 / 23:42:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 10-08-2011 / 22:47:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SignedIntegerArray class methodsFor:'accessing'!

javaComponentClass

    ^ Integer

    "Created: / 25-06-2011 / 08:38:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SignedIntegerArray class methodsFor:'accessing'!

javaName

    ^'[I'.

    "Modified: / 25-02-2011 / 19:03:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SignedLongIntegerArray class methodsFor:'testing'!

isInterface

    ^false
! !
!SignedLongIntegerArray class methodsFor:'queries'!

isJavaArrayClass

    ^true

    "Created: / 20-12-2010 / 22:47:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SignedLongIntegerArray class methodsFor:'queries'!

isJavaReferenceType

    "Java arrays are reference types"
    ^true

    "Created: / 20-12-2010 / 22:30:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SignedLongIntegerArray class methodsFor:'accessing-java'!

javaArrayClass

    ^JavaArray javaArrayClassFor: SignedLongIntegerArray

    "Modified: / 10-08-2011 / 22:47:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Created: / 26-08-2011 / 18:29:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SignedLongIntegerArray class methodsFor:'accessing'!

javaComponentClass

    ^LargeInteger

    "Modified: / 25-06-2011 / 08:38:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SignedLongIntegerArray class methodsFor:'accessing'!

javaName

    ^'[J'.

    "Modified: / 25-02-2011 / 19:03:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!UndefinedObject class methodsFor:'queries'!

isJavaPrimitiveType

    "void"

    ^true

    "Created: / 21-12-2010 / 22:52:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!UndefinedObject class methodsFor:'accessing'!

javaName

    ^'void'.

    "Modified: / 25-02-2011 / 18:59:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!WordArray class methodsFor:'testing'!

isInterface

    ^false
! !
!WordArray class methodsFor:'queries'!

isJavaArrayClass

    ^true

    "Created: / 20-12-2010 / 22:47:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!WordArray class methodsFor:'queries'!

isJavaReferenceType

    "Java arrays are reference types"
    ^true

    "Created: / 20-12-2010 / 22:30:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!WordArray class methodsFor:'accessing-java'!

javaArrayClass

    ^JavaArray javaArrayClassFor: WordArray

    "Created: / 11-06-2011 / 23:42:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 10-08-2011 / 22:46:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!WordArray class methodsFor:'accessing-java'!

javaComponentClass

    ^JavaShort

    "Created: / 20-12-2010 / 22:13:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!WordArray class methodsFor:'accessing'!

javaName
    ^ '[S'.

    "Modified: / 06-12-2011 / 16:43:59 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
! !
!stx_libjava class methodsFor:'documentation'!

extensionsVersion_SVN
    ^ '$Id$'
! !