! Copyright (C) 2007, 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.strings arrays byte-arrays
hashtables io io.encodings.string kernel math namespaces
sequences strings continuations x11 x11.xlib specialized-arrays.uint
accessors io.encodings.utf16n ;
IN: x11.xim

SYMBOL: xim

: (init-xim) ( classname medifier -- im )
    XSetLocaleModifiers [ "XSetLocaleModifiers() failed" throw ] unless
    [ dpy get f ] dip dup XOpenIM ;

: init-xim ( classname -- )
    dup "" (init-xim)
    [ nip ]
    [ "@im=none" (init-xim) [ "XOpenIM() failed" throw ] unless* ] if*
    xim set-global ;

: close-xim ( -- )
    xim get-global XCloseIM drop f xim set-global ;

: with-xim ( quot -- )
    [ "Factor" init-xim ] dip [ close-xim ] [ ] cleanup ; inline

: create-xic ( window classname -- xic )
    [
        [ xim get-global XNClientWindow ] dip
        XNFocusWindow over
        XNInputStyle XIMPreeditNothing XIMStatusNothing bitor
        XNResourceName
    ] dip
    XNResourceClass over 0 XCreateIC
    [ "XCreateIC() failed" throw ] unless* ;

CONSTANT: buf-size 50

SYMBOL: keybuf
SYMBOL: keysym
SYMBOL: status

: prepare-lookup ( n -- )
    <uint-array> keybuf set
    0 <KeySym> keysym set 0 <int> status set ;
    
: prepare-XwcLookupString ( event xic len -- xic event keybuf len keysym status )
    [ swap ] dip keybuf get swap keysym get status get ;

: finish-lookup ( len -- string keysym )
    keybuf get swap head >string
    keysym get *KeySym ;

: lookup-string ( event xic -- string keysym )
    [
        buf-size prepare-lookup
        2dup buf-size prepare-XwcLookupString 
        XwcLookupString status get *int XBufferOverflow = 
        [ dup prepare-lookup prepare-XwcLookupString XwcLookupString ] [ [ 2drop ] dip ] if
        finish-lookup
    ] with-scope ;