[Chicken-users] Re: FFI with XQueryTree

[Eduardo Cavazos]

Eduardo Cavazos wrote:

> XQueryTree is a function from xlib:
>
> extern Status XQueryTree(
>     Display*        /* display */,
>     Window        /* w */,
>     Window*        /* root_return */,
>     Window*        /* parent_return */,
>     Window**        /* children_return */,
>     unsigned int*    /* nchildren_return */
> );
>
> This is how I'm pulling it into Chicken (using a 'c-function' macro I'm 
> using for cross-Scheme compatability):
>
> (c-function Status XQueryTree
>   (Display*
>    Window
>    u32vector
>    u32vector
>    (c-pointer (c-pointer unsigned-long))
>    u32vector))
>
> The tricky parameter is the 'Window**' one.
>
> I can allocate enough storage for a pointer via:
>
>     (define children-return (allocate sizeof:c-pointer))
>
> The trouble is, how do I portably extract the address? If I assume a 
> 32-bit pointer size, it's easy:
>
>   (pointer-u32-ref children-return)
>
> on a 64-bit machine, that should be:
>
>   (pointer-u64-ref children-return)
>
> but, there is no 'pointer-u64-ref'. :-)
>
> Once I have the address, the rest is easy; convert it to a pointer with 
> address->pointer, and extract individual windows with pointer-u32-ref.
>
> For reference, Ypsilon has this procedure that I use in this sort of case:
>
>     bytevector-c-void*-ref
>
> Larceny has:
>
>     %get-pointer

Below is how I ended up wrapping XQueryTree. Suggestions and 
improvements still welcome! ;-)

(define (x-query-tree dpy win)

  (let ((root-return      (u32vector 0))
        (parent-return    (u32vector 0))
        (children-return  (allocate sizeof:c-pointer))
        (nchildren-return (u32vector 0)))

    (XQueryTree dpy
                win
                root-return
                parent-return
                children-return
                nchildren-return)

    (let ((root      (u32vector-ref       root-return      0))
          (parent    (u32vector-ref       parent-return    0))
          (children* (pointer-pointer-ref children-return   ))
          (nchildren (u32vector-ref       nchildren-return 0)))

      (let ((children (make-vector nchildren)))

        (let loop ((i 0))

          (cond ((>= i nchildren)
                 (XFree children*)
                 children)
                (else (vector-set! children i
                                   (pointer-u32-ref
                                    (pointer-offset children* (* i 4))))
                      (loop (+ i 1)))))

        (list root parent children)))))