/Xlib.ml

Large files files are truncated, but you can click here to view the full file

(** OCaml bindings for the Xlib library. *)
(*  Copyright (C) 2008, 2009, 2010 by Florent Monnier
 *  Contact: <fmonnier@linux-nantes.org>
 *
 * OCaml-Xlib is free software: you can redistribute it and/or modify
 * it under the terms of the GNU Lesser General Public License as published
 * by the Free Software Foundation, either version 3 of the License,
 * or (at your option) any later version.
 *
 * OCaml-Xlib is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public License
 * along with OCaml-Xlib.  If not, see:
 * <http://www.gnu.org/licenses/>
 *)

(**
{ul
  {- {{:http://www.x.org/docs/X11/xlib.pdf}Xlib manual (pdf)}}
  {- {{:http://tronche.com/gui/x/xlib/}Xlib manual (html)}}
}
*)

(** {3 Types} *)

type event_mask =
  | KeyPressMask
  | KeyReleaseMask
  | ButtonPressMask
  | ButtonReleaseMask
  | EnterWindowMask
  | LeaveWindowMask
  | PointerMotionMask
  | PointerMotionHintMask
  | Button1MotionMask
  | Button2MotionMask
  | Button3MotionMask
  | Button4MotionMask
  | Button5MotionMask
  | ButtonMotionMask
  | KeymapStateMask
  | ExposureMask
  | VisibilityChangeMask
  | StructureNotifyMask
  | ResizeRedirectMask
  | SubstructureNotifyMask
  | SubstructureRedirectMask
  | FocusChangeMask
  | PropertyChangeMask
  | ColormapChangeMask
  | OwnerGrabButtonMask

(* just in case a futur ocaml implementation would handle uint *)
type uint = int

type 'a drawable
type _window type window = _window drawable
type _pixmap type pixmap = _pixmap drawable
(** both windows and pixmaps can be used as drawable *)
type gc
type colormap
type atom
type time = int64

(* exposed *)
type keysym = int
type keycode = int

(*
(* abstract *)
type keysym
type keycode

external keysym_of_int: int -> keysym = "%identity"
external int_of_keysym: keysym -> int = "%identity"

external keycode_of_int: int -> keycode = "%identity"
external int_of_keycode: keycode -> int = "%identity"
*)


(** {3 Display} *)

(** {{:http://tronche.com/gui/x/xlib/display/}Display Functions} *)

type display
external xOpenDisplay: name:string -> display = "ml_XOpenDisplay"
(** {{:http://tronche.com/gui/x/xlib/display/opening.html}man} *)

#if defined(MLI)
val open_display: ?name:string -> unit -> display
#else
let open_display ?name () =
  let name = match name with Some id -> id
    | None -> try Sys.getenv "DISPLAY" with Not_found -> ":0"
  in
  xOpenDisplay ~name
;;
#endif

external xCloseDisplay: dpy:display -> unit = "ml_XCloseDisplay"
(** {{:http://tronche.com/gui/x/xlib/display/XCloseDisplay.html}man} *)

external xFlush: dpy:display -> unit = "ml_XFlush"
(** {{:http://tronche.com/gui/x/xlib/event-handling/XFlush.html}man} *)

external xBell: dpy:display -> percent:int -> unit = "ml_XBell"
(** {{:http://tronche.com/gui/x/xlib/input/XBell.html}man} *)

(* WIP *)
external xChangeKeyboardControl_bell_percent: dpy:display -> bell_percent:int -> unit
   = "ml_XChangeKeyboardControl_bell_percent"
external xChangeKeyboardControl_bell_pitch: dpy:display -> bell_pitch:int -> unit
   = "ml_XChangeKeyboardControl_bell_pitch"
external xChangeKeyboardControl_bell_duration: dpy:display -> bell_duration:int -> unit
   = "ml_XChangeKeyboardControl_bell_duration"

external xChangeKeyboardControl_bell: dpy:display ->
    bell_percent:int ->
    bell_pitch:int ->
    bell_duration:int -> unit
   = "ml_XChangeKeyboardControl_bell"
(** [bell_percent] sets the base volume for the bell between 0 (off) and 100
    (loud) inclusive, if possible.  A setting of -1 restores the default. Other
    negative values generate a BadValue error.

    [bell_pitch] member sets the pitch (specified in Hz) of the bell, if possible.
    A setting of -1 restores the default. Other negative values generate a BadValue error.
   
    [bell_duration] member sets the duration of the bell specified in milliseconds,
    if possible.  A setting of -1 restores the default. Other negative values generate 
    a BadValue error. *)

external xChangeKeyboardControl_key_click_percent: dpy:display -> key_click_percent:int -> unit
   = "ml_XChangeKeyboardControl_key_click_percent"

(* /WIP *)


type close_mode =
  | DestroyAll
  | RetainPermanent
  | RetainTemporary
external xSetCloseDownMode: dpy:display -> close_mode:close_mode -> unit = "ml_XSetCloseDownMode"
(** {{:http://tronche.com/gui/x/xlib/display/XSetCloseDownMode.html}man} *)

external xSync: dpy:display -> discard:bool -> unit = "ml_XSync"
(** {{:http://tronche.com/gui/x/xlib/event-handling/XSync.html}man} *)

external xConnectionNumber: dpy:display -> int = "ml_XConnectionNumber"
(** {{:http://tronche.com/gui/x/xlib/display/display-macros.html#ConnectionNumber}man} *)

external xProtocolVersion: dpy:display -> int = "ml_XProtocolVersion"
(** {{:http://tronche.com/gui/x/xlib/display/display-macros.html#ProtocolVersion}man} *)

external xProtocolRevision: dpy:display -> int = "ml_XProtocolRevision"
external xVendorRelease: dpy:display -> int = "ml_XVendorRelease"
external xServerVendor: dpy:display -> string = "ml_XServerVendor"

external xlibSpecificationRelease: unit -> int = "ml_XlibSpecificationRelease"


(** Server Grabbing *)

external xGrabServer: dpy:display -> unit = "ml_XGrabServer"
(** {{:http://tronche.com/gui/x/xlib/window-and-session-manager/XGrabServer.html}man} *)

external xUngrabServer: dpy:display -> unit = "ml_XUngrabServer"
(** {{:http://tronche.com/gui/x/xlib/window-and-session-manager/XUngrabServer.html}man} *)

external xUngrabPointer: dpy:display -> time:time -> unit = "ml_XUngrabPointer"
(** {{:http://tronche.com/gui/x/xlib/input/XUngrabPointer.html}man} *)

external xUngrabKeyboard: dpy:display -> time:time -> unit = "ml_XUngrabKeyboard"
(** {{:http://tronche.com/gui/x/xlib/input/XUngrabKeyboard.html}man} *)


(** {3 Screen number} *)

type screen_number = private int

external xDefaultScreen: dpy:display -> screen_number = "ml_XDefaultScreen"
(** {{:http://tronche.com/gui/x/xlib/display/display-macros.html#DefaultScreen}man} *)

external xDisplayWidth: dpy:display -> scr:screen_number -> int = "ml_XDisplayWidth"
external xDisplayHeight: dpy:display -> scr:screen_number -> int = "ml_XDisplayHeight"

external xDefaultDepth: dpy:display -> scr:screen_number -> int = "ml_XDefaultDepth"
(** {{:http://tronche.com/gui/x/xlib/display/display-macros.html#DefaultDepth}man} *)

external xListDepths: dpy:display -> scr:screen_number -> int array = "ml_XListDepths"
(** {{:http://tronche.com/gui/x/xlib/display/display-macros.html#XListDepths}man} *)

external xDisplayPlanes: dpy:display -> scr:screen_number -> int = "ml_XDisplayPlanes"
(** {{:http://tronche.com/gui/x/xlib/display/display-macros.html#DisplayPlanes}man} *)

external xScreenCount: dpy:display -> int = "ml_XScreenCount"
(** {{:http://tronche.com/gui/x/xlib/display/display-macros.html#ScreenCount}man} *)

#if defined(MLI)
val xScreenNumbers : dpy:display -> screen_number array
(** returns an array of all the screen numbers *)
#else
let xScreenNumbers ~dpy =
  let n = xScreenCount ~dpy in
  Array.init n (fun i -> (Obj.magic i : screen_number))
;;
#endif


(** {3 Pixel Colors} *)

type pixel_color
external xBlackPixel: dpy:display -> scr:screen_number -> pixel_color = "ml_XBlackPixel"
(** {{:http://tronche.com/gui/x/xlib/display/display-macros.html#BlackPixel}man} *)

external xWhitePixel: dpy:display -> scr:screen_number -> pixel_color = "ml_XWhitePixel"
(** {{:http://tronche.com/gui/x/xlib/display/display-macros.html#WhitePixel}man} *)


(** {3 XColor} *)

(** {{:http://tronche.com/gui/x/xlib/color/}Color Management Functions} *)

type xColor
external new_xColor: unit -> xColor = "ml_alloc_XColor"
(** this type is garbage collected *)

external xAllocNamedColor: dpy:display -> colormap:colormap -> color_name:string -> xColor * xColor = "ml_XAllocNamedColor"
(** the returned values are garbage collected,
    {{:http://tronche.com/gui/x/xlib/color/XAllocNamedColor.html}man} *)

external xColor_set_red: xColor -> int -> unit = "ml_XColor_set_red"
external xColor_set_green: xColor -> int -> unit = "ml_XColor_set_green"
external xColor_set_blue: xColor -> int -> unit = "ml_XColor_set_blue"

external xColor_set_rgb: xColor -> r:int -> g:int -> b:int -> unit = "ml_XColor_set_rgb"

type color_flags =
  | DoRed
  | DoGreen
  | DoBlue

external xColor_set_flags: xColor -> color_flags list -> unit = "ml_XColor_set_flags"

#if defined(ML)
type x_color =
  { xcolor : xColor;
    set_red   : int -> unit;
    set_green : int -> unit;
    set_blue  : int -> unit;
  }
let new_x_color () =
  let xcolor = new_xColor() in
  xColor_set_flags xcolor [DoRed; DoGreen; DoBlue];
  { xcolor = xcolor;
    set_red   = xColor_set_red xcolor;
    set_green = xColor_set_green xcolor;
    set_blue  = xColor_set_blue  xcolor;
  }
#endif

external xAllocColor: dpy:display -> colormap:colormap -> xColor -> unit = "ml_XAllocColor"
(** {{:http://tronche.com/gui/x/xlib/color/XAllocColor.html}man} *)

external xAllocColorCells: dpy:display -> colormap:colormap ->
            contig:bool -> nplanes:uint -> npixels:uint -> uint array * uint array = "ml_XAllocColorCells"
(** {{:http://tronche.com/gui/x/xlib/color/XAllocColorCells.html}man},
    returns [(plane_masks, pixels)] *)

external xAllocColorCellsPixels: dpy:display -> colormap:colormap ->
            contig:bool -> npixels:uint -> uint array = "ml_XAllocColorCellsPixels"
(** same than [xAllocColorCells] but only requests for the pixels *)

external xColor_pixel: xColor -> pixel_color = "ml_XColor_pixel"
external xColor_set_pixel: xColor -> pixel_color -> unit = "ml_XColor_set_pixel"

external xQueryColor: dpy:display -> colormap:colormap -> xColor -> unit = "ml_XQueryColor"
(** {{:http://tronche.com/gui/x/xlib/color/XQueryColor.html}man} *)

external xColor_get_red: xColor -> int = "ml_XColor_get_red"
external xColor_get_green: xColor -> int = "ml_XColor_get_green"
external xColor_get_blue: xColor -> int = "ml_XColor_get_blue"
external xColor_get_rgb: xColor -> int * int * int = "ml_XColor_get_rgb"


(** {3 Visual} *)

type visual
type visualID
external xDefaultVisual: dpy:display -> scr:screen_number -> visual = "ml_XDefaultVisual"
(** {{:http://tronche.com/gui/x/xlib/display/display-macros.html#DefaultVisual}man} *)

external visual_red_mask: visual:visual -> int = "ml_Visual_red_mask"
external visual_green_mask: visual:visual -> int = "ml_Visual_green_mask"
external visual_blue_mask: visual:visual -> int = "ml_Visual_blue_mask"

external visual_bits_per_rgb: visual:visual -> int = "ml_Visual_bits_per_rgb"
external visual_visualid: visual:visual -> visualID = "ml_Visual_visualid"
external visual_map_entries: visual:visual -> int = "ml_Visual_map_entries"
(** color map entries *)


(** {3 xVisualInfo} *)

(** {{:http://tronche.com/gui/x/xlib/utilities/visual.html}man} *)

type xVisualInfo  (* pointer to a structure *)

type xVisualInfo_contents =  (* contents of this structure *)
  { visual: visual;
    visual_id: visualID;
    screen_number: screen_number;
    depth: int;
    red_mask: uint;
    green_mask: uint;
    blue_mask: uint;
    colormap_size: int;
    bits_per_rgb: int;
  }

external xVisualInfo_datas: visual_info:xVisualInfo  -> xVisualInfo_contents = "ml_XVisualInfo_contents"
external xFree_xVisualInfo: xVisualInfo -> unit = "ml_XFree_XVisualInfo"

type color_class =
  | StaticGray
  | GrayScale
  | StaticColor
  | PseudoColor
  | TrueColor
  | DirectColor

external new_xVisualInfo: unit -> xVisualInfo = "ml_alloc_XVisualInfo"
(** do not call {!xFree_xVisualInfo} with this [xVisualInfo] *)

external xVisualInfo_set_visual: visual -> unit = "ml_XVisualInfo_set_visual"
external xVisualInfo_set_visualid: visualID -> unit = "ml_XVisualInfo_set_visualid"
external xVisualInfo_set_screen: screen_number -> unit = "ml_XVisualInfo_set_screen"
external xVisualInfo_set_depth: uint -> unit = "ml_XVisualInfo_set_depth"
external xVisualInfo_set_class: color_class -> unit = "ml_XVisualInfo_set_class"
external xVisualInfo_set_red_mask: uint -> unit = "ml_XVisualInfo_set_red_mask"
external xVisualInfo_set_green_mask: uint -> unit = "ml_XVisualInfo_set_green_mask"
external xVisualInfo_set_blue_mask: uint -> unit = "ml_XVisualInfo_set_blue_mask"
external xVisualInfo_set_colormap_size: int -> unit = "ml_XVisualInfo_set_colormap_size"
external xVisualInfo_set_bits_per_rgb: int -> unit = "ml_XVisualInfo_set_bits_per_rgb"

type visual_info_mask =
  | VisualNoMask
  | VisualIDMask
  | VisualScreenMask
  | VisualDepthMask
  | VisualClassMask
  | VisualRedMaskMask
  | VisualGreenMaskMask
  | VisualBlueMaskMask
  | VisualColormapSizeMask
  | VisualBitsPerRGBMask
  | VisualAllMask

external xGetVisualInfo: dpy:display -> visual_info_mask list -> template:xVisualInfo -> xVisualInfo array
    = "ml_XGetVisualInfo"
(** {{:http://tronche.com/gui/x/xlib/utilities/XGetVisualInfo.html}man} *)

external xMatchVisualInfo: dpy:display -> scr:screen_number -> depth:int -> color_class:color_class -> xVisualInfo
    = "ml_XMatchVisualInfo"
(** {{:http://tronche.com/gui/x/xlib/utilities/XMatchVisualInfo.html}man}
    no need to call {!xFree_xVisualInfo} on the returned value *)


(** {3 Colormap} *)

external xDefaultColormap: dpy:display -> scr:screen_number -> colormap = "ml_XDefaultColormap"
(** do not free the default colormap,
    {{:http://tronche.com/gui/x/xlib/display/display-macros.html#DefaultColormap}man} *)

external xDisplayCells: dpy:display -> scr:screen_number -> int = "ml_XDisplayCells"
(** {{:http://tronche.com/gui/x/xlib/display/display-macros.html#DisplayCells}man} *)

type colormap_alloc =
  | AllocNone
  | AllocAll

external xCreateColormap: dpy:display -> win:window -> visual:visual -> alloc:colormap_alloc -> colormap = "ml_XCreateColormap"
(** {{:http://tronche.com/gui/x/xlib/color/XCreateColormap.html}man} *)

external xFreeColormap: dpy:display -> colormap:colormap -> unit = "ml_XFreeColormap"
(** {{:http://tronche.com/gui/x/xlib/color/XFreeColormap.html}man} *)

external xCopyColormapAndFree: dpy:display -> colormap:colormap -> colormap = "ml_XCopyColormapAndFree"
(** {{:http://tronche.com/gui/x/xlib/color/XCopyColormapAndFree.html}man} *)

external xSetWindowColormap: dpy:display -> win:window -> colormap:colormap -> unit = "ml_XSetWindowColormap"
(** {{:http://tronche.com/gui/x/xlib/window/XSetWindowColormap.html}man} *)

(*
XChangeWindowAttributes
*)

(** {4 Managing Installed Colormaps} *)

external xInstallColormap: dpy:display -> colormap:colormap -> unit = "ml_XInstallColormap"
(** {{:http://tronche.com/gui/x/xlib/window-and-session-manager/XInstallColormap.html}man} *)

external xUninstallColormap: dpy:display -> colormap:colormap -> unit = "ml_XUninstallColormap"
(** {{:http://tronche.com/gui/x/xlib/window-and-session-manager/XUninstallColormap.html}man} *)

external xListInstalledColormaps: dpy:display -> win:window -> colormap array = "ml_XListInstalledColormaps"
(** {{:http://tronche.com/gui/x/xlib/window-and-session-manager/XListInstalledColormaps.html}man} *)



(** {4 xSetWindowAttributes} *)

type xSetWindowAttributes
external new_xSetWindowAttributes: unit -> xSetWindowAttributes = "ml_XSetWindowAttributes_alloc"
(** the returned [xSetWindowAttributes] is garbage collected *)

type event_mask_list = event_mask list

type cursor

(* {{{ setting xSetWindowAttributes fields *)

external winAttr_set_background_pixmap: xSetWindowAttributes -> background_pixmap:pixmap -> unit = "ml_xSetWindowAttributes_set_background_pixmap"
external winAttr_set_background_pixel: xSetWindowAttributes -> background_pixel:pixel_color -> unit = "ml_xSetWindowAttributes_set_background_pixel"
external winAttr_set_border_pixmap: xSetWindowAttributes -> border_pixmap:pixmap -> unit = "ml_xSetWindowAttributes_set_border_pixmap"
external winAttr_set_border_pixel: xSetWindowAttributes -> border_pixel:pixel_color -> unit = "ml_xSetWindowAttributes_set_border_pixel"
external winAttr_set_bit_gravity: xSetWindowAttributes -> bit_gravity:int -> unit = "ml_xSetWindowAttributes_set_bit_gravity"
external winAttr_set_win_gravity: xSetWindowAttributes -> win_gravity:int -> unit = "ml_xSetWindowAttributes_set_win_gravity"
external winAttr_set_backing_store: xSetWindowAttributes -> backing_store:int -> unit = "ml_xSetWindowAttributes_set_backing_store"
external winAttr_set_backing_planes: xSetWindowAttributes -> backing_planes:uint -> unit = "ml_xSetWindowAttributes_set_backing_planes"
external winAttr_set_backing_pixel: xSetWindowAttributes -> backing_pixel:uint -> unit = "ml_xSetWindowAttributes_set_backing_pixel"
external winAttr_set_save_under: xSetWindowAttributes -> save_under:bool -> unit = "ml_xSetWindowAttributes_set_save_under"
external winAttr_set_event_mask: xSetWindowAttributes -> event_mask:event_mask_list -> unit = "ml_xSetWindowAttributes_set_event_mask"
external winAttr_set_do_not_propagate_mask: xSetWindowAttributes -> do_not_propagate_mask:int -> unit = "ml_xSetWindowAttributes_set_do_not_propagate_mask"
external winAttr_set_override_redirect: xSetWindowAttributes -> override_redirect:bool -> unit = "ml_xSetWindowAttributes_set_override_redirect"
external winAttr_set_colormap: xSetWindowAttributes -> colormap:colormap -> unit = "ml_xSetWindowAttributes_set_colormap"
external winAttr_set_cursor: xSetWindowAttributes -> cursor:cursor -> unit = "ml_xSetWindowAttributes_set_cursor"

(* }}} *)

type set_win_attr = {
    attr : xSetWindowAttributes;
    set_background_pixmap: background_pixmap:pixmap -> unit;
    set_background_pixel: background_pixel:pixel_color -> unit;
    set_border_pixmap: border_pixmap:pixmap -> unit;
    set_border_pixel: border_pixel:pixel_color -> unit;
    set_bit_gravity: bit_gravity:int -> unit;
    set_win_gravity: win_gravity:int -> unit;
    set_backing_store: backing_store:int -> unit;
    set_backing_planes: backing_planes:uint -> unit;
    set_backing_pixel: backing_pixel:uint -> unit;
    set_save_under: save_under:bool -> unit;
    set_event_mask: event_mask:event_mask_list -> unit;
    set_do_not_propagate_mask: do_not_propagate_mask:int -> unit;
    set_override_redirect: override_redirect:bool -> unit;
    set_colormap: colormap:colormap -> unit;
    set_cursor: cursor:cursor -> unit;
  }
(** a record to replace all the [winAttr_set_*] functions *)

#if defined(ML)
let new_win_attr () =
  let wa = new_xSetWindowAttributes() in
  { attr = wa;
    set_background_pixmap     = winAttr_set_background_pixmap wa;
    set_background_pixel      = winAttr_set_background_pixel wa;
    set_border_pixmap         = winAttr_set_border_pixmap wa;
    set_border_pixel          = winAttr_set_border_pixel wa;
    set_bit_gravity           = winAttr_set_bit_gravity wa;
    set_win_gravity           = winAttr_set_win_gravity wa;
    set_backing_store         = winAttr_set_backing_store wa;
    set_backing_planes        = winAttr_set_backing_planes wa;
    set_backing_pixel         = winAttr_set_backing_pixel wa;
    set_save_under            = winAttr_set_save_under wa;
    set_event_mask            = winAttr_set_event_mask wa;
    set_do_not_propagate_mask = winAttr_set_do_not_propagate_mask wa;
    set_override_redirect     = winAttr_set_override_redirect wa;
    set_colormap              = winAttr_set_colormap wa;
    set_cursor                = winAttr_set_cursor wa;
  }
#else
val new_win_attr: unit -> set_win_attr
(** replaces [new_xSetWindowAttributes],
    this one is supposed to produce more concise code *)
#endif


(** {3 Windows} *)

external xRootWindow: dpy:display -> scr:screen_number -> window = "ml_XRootWindow"
(** {{:http://tronche.com/gui/x/xlib/display/display-macros.html#RootWindow}man} *)

external xDefaultRootWindow: dpy:display -> window = "ml_XDefaultRootWindow"
(** {{:http://tronche.com/gui/x/xlib/display/display-macros.html#DefaultRootWindow}man} *)

#if defined(ML)
let root_win ~dpy ?scr () =
  let scr =
    match scr with Some scr -> scr
    | None -> xDefaultScreen ~dpy
  in
  let win = xRootWindow ~dpy ~scr in
  (win)
;;
#else
val root_win: dpy:display -> ?scr:screen_number -> unit -> window
(** alternative for [xRootWindow] and [xDefaultRootWindow] *)
#endif


external xCreateSimpleWindow: dpy:display -> parent:window -> x:int -> y:int ->
                              width:uint -> height:uint -> border_width:uint ->
                              border_color:pixel_color -> background:pixel_color -> window
    = "ml_XCreateSimpleWindow_bytecode"
      "ml_XCreateSimpleWindow"
(** {{:http://tronche.com/gui/x/xlib/window/XCreateWindow.html}man} *)


#if defined(ML)
let simple_window ~dpy
  ?(parent) ?(x=0) ?(y=0)
  ?(width=0xFF) ?(height=0xFF) ?(border_width=0x01)
  ?(border_color) ?(background) ()
  =
  let d, s = dpy, xDefaultScreen dpy in

  let parent =
    match parent with Some v -> v | None -> xRootWindow d s

  and border_color =
    match border_color with Some v -> v | None -> xBlackPixel d s

  and background =
    match background with Some v -> v | None -> xWhitePixel d s
  in
  xCreateSimpleWindow
                  ~dpy ~parent
                  ~x ~y ~width ~height
                  ~border_width ~border_color
                  ~background
;;
(** returns a window with eventually defaut parameters (wip) *)
#else
val simple_window: dpy:display -> ?parent:window -> ?x:int -> ?y:int ->
                   ?width:uint -> ?height:uint -> ?border_width:uint ->
                   ?border_color:pixel_color -> ?background:pixel_color -> unit -> window
(** returns a window with eventually defaut parameters (wip) *)
#endif

external xDestroyWindow: dpy:display -> win:window -> unit = "ml_XDestroyWindow"
(** {{:http://tronche.com/gui/x/xlib/window/XDestroyWindow.html}man} *)

external xid: int -> 'a = "caml_get_xid"
(** some magic *)

external xStoreName: dpy:display -> win:window -> name:string -> unit = "ml_XStoreName"
(** {{:http://tronche.com/gui/x/xlib/ICC/client-to-window-manager/XStoreName.html}man} *)

(* TODO test this function XXX *)
external xFetchName: dpy:display -> win:window -> string = "ml_XFetchName"
(** {{:http://tronche.com/gui/x/xlib/ICC/client-to-window-manager/XFetchName.html}man} *)

external xSelectInput: dpy:display -> win:window -> event_mask:event_mask list -> unit = "ml_XSelectInput"
external xMapWindow: dpy:display -> win:window -> unit = "ml_XMapWindow"
(** {{:http://tronche.com/gui/x/xlib/window/XMapWindow.html}man} *)

external xMapSubwindows: dpy:display -> win:window -> unit = "ml_XMapSubwindows"
(** {{:http://tronche.com/gui/x/xlib/window/XMapSubwindows.html}man} *)

external xMapRaised: dpy:display -> win:window -> unit = "ml_XMapRaised"
(** {{:http://tronche.com/gui/x/xlib/window/XMapRaised.html}man} *)

external xUnmapWindow: dpy:display -> win:window -> unit = "ml_XUnmapWindow"
(** {{:http://tronche.com/gui/x/xlib/window/XUnmapWindow.html}man} *)


(*
typedef struct {
        int x, y;
        int width, height;
        int border_width;
        Window sibling;
        int stack_mode; // Above, Below, TopIf, BottomIf, Opposite (* xconfreq_detail *)
} XWindowChanges;

/* Configure window value mask bits */
#define CWX             (1<<0)
#define CWY             (1<<1)
#define CWWidth         (1<<2)
#define CWHeight        (1<<3)
#define CWBorderWidth   (1<<4)
#define CWSibling       (1<<5)
#define CWStackMode     (1<<6)

int XConfigureWindow(
    Display*            /* display */,
    Window              /* w */,
    unsigned int        /* value_mask */,
    XWindowChanges*     /* values */
);
(** {{:http://tronche.com/gui/x/xlib/window/XConfigureWindow.html}man} *)


Status XReconfigureWMWindow(
    Display*            /* display */,
    Window              /* w */,
    int                 /* screen_number */,
    unsigned int        /* mask */,
    XWindowChanges*     /* changes */
);
*)

type window_class =
  | CopyFromParent
  | InputOutput
  | InputOnly

type winattr_valuemask =
  | CWBackPixmap
  | CWBackPixel
  | CWBorderPixmap
  | CWBorderPixel
  | CWBitGravity
  | CWWinGravity
  | CWBackingStore
  | CWBackingPlanes
  | CWBackingPixel
  | CWOverrideRedirect
  | CWSaveUnder
  | CWEventMask
  | CWDontPropagate
  | CWColormap
  | CWCursor

external xCreateWindow:
    dpy:display -> parent:window -> x:int -> y:int ->
    width:uint -> height:uint ->
    border_width:uint ->
    depth:int -> win_class:window_class -> visual:visual ->
    valuemask:winattr_valuemask list ->
    attributes:xSetWindowAttributes -> window
    = "ml_XCreateWindow_bytecode" "ml_XCreateWindow"
(** {{:http://tronche.com/gui/x/xlib/window/XCreateWindow.html}man} *)

(* {{{ create_window *)

type winattr =
  | BackPixmap       of pixmap 
  | BackPixel        of pixel_color
  | BorderPixmap     of pixmap
  | BorderPixel      of pixel_color
  | BitGravity       of int
  | WinGravity       of int
  | BackingStore     of int
  | BackingPlanes    of uint
  | BackingPixel     of uint
  | OverrideRedirect of bool
  | SaveUnder        of bool
  | EventMask        of event_mask_list
  | DontPropagate    of int
  | Colormap         of colormap
  | Cursor           of cursor

#if defined(ML)

let create_window ~dpy ~parent ~x ~y ~width ~height
      ~border_width ~depth ~win_class ~visual
      ~win_attrs =
  let wa = new_xSetWindowAttributes() in
  let valuemask =
    List.map (function
    | BackPixmap       pixmap            -> winAttr_set_background_pixmap wa pixmap            ; CWBackPixmap
    | BackPixel        background_pixel  -> winAttr_set_background_pixel wa background_pixel   ; CWBackPixel
    | BorderPixmap     border_pixmap     -> winAttr_set_border_pixmap wa border_pixmap         ; CWBorderPixmap
    | BorderPixel      border_pixel      -> winAttr_set_border_pixel wa border_pixel           ; CWBorderPixel
    | BitGravity       bit_gravity       -> winAttr_set_bit_gravity wa bit_gravity             ; CWBitGravity
    | WinGravity       win_gravity       -> winAttr_set_win_gravity wa win_gravity             ; CWWinGravity
    | BackingStore     backing_store     -> winAttr_set_backing_store wa backing_store         ; CWBackingStore
    | BackingPlanes    backing_planes    -> winAttr_set_backing_planes wa backing_planes       ; CWBackingPlanes
    | BackingPixel     backing_pixel     -> winAttr_set_backing_pixel wa backing_pixel         ; CWBackingPixel
    | OverrideRedirect override_redirect -> winAttr_set_override_redirect wa override_redirect ; CWOverrideRedirect
    | SaveUnder        save_under        -> winAttr_set_save_under wa save_under               ; CWSaveUnder
    | EventMask        event_mask        -> winAttr_set_event_mask wa event_mask               ; CWEventMask
    | DontPropagate    dont_propagate    -> winAttr_set_do_not_propagate_mask wa dont_propagate; CWDontPropagate
    | Colormap         colormap          -> winAttr_set_colormap wa colormap                   ; CWColormap
    | Cursor           cursor            -> winAttr_set_cursor wa cursor                       ; CWCursor
    ) win_attrs
  in
  xCreateWindow
    ~dpy ~parent ~x ~y ~width ~height ~border_width
    ~depth ~win_class ~visual
    ~valuemask
    ~attributes:wa ;;

#else
val create_window:
    dpy:display -> parent:window -> x:int -> y:int ->
    width:uint -> height:uint ->
    border_width:uint ->
    depth:int -> win_class:window_class -> visual:visual ->
    win_attrs:winattr list -> window
(** equivalent of [xCreateWindow] *)
#endif

(* }}} *)

external xResizeWindow: dpy:display -> win:window -> width:uint -> height:uint -> unit = "ml_XResizeWindow"
(** {{:http://tronche.com/gui/x/xlib/window/XResizeWindow.html}man} *)

external xMoveWindow: dpy:display -> win:window -> x:int -> y:int -> unit = "ml_XMoveWindow"
(** {{:http://tronche.com/gui/x/xlib/window/XMoveWindow.html}man} *)

external xMoveResizeWindow: dpy:display -> win:window -> x:int -> y:int -> width:uint -> height:uint -> unit
    = "ml_XMoveResizeWindow_bytecode" "ml_XMoveResizeWindow"
(** {{:http://tronche.com/gui/x/xlib/window/XMoveResizeWindow.html}man} *)

external xLowerWindow: dpy:display -> win:window -> unit = "ml_XLowerWindow"
(** {{:http://tronche.com/gui/x/xlib/window/XLowerWindow.html}man} *)

external xRaiseWindow: dpy:display -> win:window -> unit = "ml_XRaiseWindow"
(** {{:http://tronche.com/gui/x/xlib/window/XRaiseWindow.html}man} *)

external xQueryTree: dpy:display -> win:window -> window * window * window array = "ml_XQueryTree"
(** {{:http://tronche.com/gui/x/xlib/window-information/XQueryTree.html}man},
    returns [(root_window, parent_window, children_windows)] *)

external xRestackWindows: dpy:display -> win:window array -> unit = "ml_XRestackWindows"
(** {{:http://tronche.com/gui/x/xlib/window/XRestackWindows.html}man} *)

external xCirculateSubwindowsDown: dpy:display -> win:window -> unit = "ml_XCirculateSubwindowsDown"
external xCirculateSubwindowsUp: dpy:display -> win:window -> unit = "ml_XCirculateSubwindowsUp"
type circulate_subwindows_direction = RaiseLowest | LowerHighest
external xCirculateSubwindows: dpy:display -> win:window -> dir:circulate_subwindows_direction -> unit
    = "ml_XCirculateSubwindows"

type req_type = Atom of atom | AnyPropertyType

external xGetWindowProperty_string:
    dpy:display ->
    win:window ->
    property:atom ->
    long_offset:int ->
    long_length:int ->
    delete:bool ->
    req_type:req_type ->
    atom *   (* actual_type *)
    int *    (* actual_format *)
    int *    (* nitems *)
    int *    (* bytes_after *)
    string   (* prop_return *)
    = "ml_XGetWindowProperty_string_bytecode"
      "ml_XGetWindowProperty_string"

external xGetWindowProperty_window:
    dpy:display ->
    win:window ->
    property:atom ->
    long_offset:int ->
    long_length:int ->
    delete:bool ->
    req_type:req_type ->
    atom *   (* actual_type *)
    int *    (* actual_format *)
    int *    (* nitems *)
    int *    (* bytes_after *)
    window   (* prop_return *)
    = "ml_XGetWindowProperty_window_bytecode"
      "ml_XGetWindowProperty_window"
(** {{:http://tronche.com/gui/x/xlib/window-information/XGetWindowProperty.html}man} *)



(** {3 XScreen} *)

type xScreen
(** this type wraps the scruture Screen from the Xlib, but is here renamed with
    an additionnal x as a way of disambiguation with the type [screen_number] *)

external xDefaultScreenOfDisplay: dpy:display -> xScreen = "ml_XDefaultScreenOfDisplay"
(** the result points to a member of the input structure *)

external xScreenOfDisplay: dpy:display -> scr:screen_number -> xScreen = "ml_XScreenOfDisplay"

external xDefaultVisualOfScreen: xScreen -> visual = "ml_XDefaultVisualOfScreen"
(** the result points to a member of the input structure *)

external xRootWindowOfScreen: xScreen -> window = "ml_XRootWindowOfScreen"
external xBlackPixelOfScreen: xScreen -> pixel_color = "ml_XBlackPixelOfScreen"
external xWhitePixelOfScreen: xScreen -> pixel_color = "ml_XWhitePixelOfScreen"
external xDefaultColormapOfScreen: xScreen -> colormap = "ml_XDefaultColormapOfScreen"
external xDefaultDepthOfScreen: xScreen -> int = "ml_XDefaultDepthOfScreen"
external xDefaultGCOfScreen: xScreen -> gc = "ml_XDefaultGCOfScreen"
external xDisplayOfScreen: xScreen -> display = "ml_XDisplayOfScreen"
external xWidthOfScreen: xScreen -> int = "ml_XWidthOfScreen"
external xHeightOfScreen: xScreen -> int = "ml_XHeightOfScreen"
external xScreenNumberOfScreen: xScreen -> screen_number = "ml_XScreenNumberOfScreen"



(** {3 xWindowAttributes} *)

type xWindowAttributes
(** xWindowAttributes is garbage collected *)

external xGetWindowAttributes: dpy:display -> win:window -> xWindowAttributes = "ml_XGetWindowAttributes"
(** {{:http://tronche.com/gui/x/xlib/window-information/XGetWindowAttributes.html}man} *)

external xWindowAttributes_x: xWindowAttributes -> int = "ml_XWindowAttributes_x"
external xWindowAttributes_y: xWindowAttributes -> int = "ml_XWindowAttributes_y"
external xWindowAttributes_width: xWindowAttributes -> int = "ml_XWindowAttributes_width"
external xWindowAttributes_height: xWindowAttributes -> int = "ml_XWindowAttributes_height"
external xWindowAttributes_depth: xWindowAttributes -> int = "ml_XWindowAttributes_depth"
external xWindowAttributes_screen: xWindowAttributes -> xScreen = "ml_XWindowAttributes_screen"
external xWindowAttributes_border_width: xWindowAttributes -> int = "ml_XWindowAttributes_border_width"
external xWindowAttributes_colormap: xWindowAttributes -> colormap = "ml_XWindowAttributes_colormap"
external xWindowAttributes_map_installed: xWindowAttributes -> bool = "ml_XWindowAttributes_map_installed"

type wattr = {
    wattr_x: int;
    wattr_y: int;
    wattr_width: int;
    wattr_height: int;
    wattr_depth: int;
  }
(** a record to replace all the [xWindowAttributes_*] functions *)

#if defined(ML)
external xGetWindowAttributesAll: dpy:display -> win:window -> wattr = "ml_XWindowAttributes_all"
let get_win_attrs = xGetWindowAttributesAll
#else
val get_win_attrs : dpy:display -> win:window -> wattr
(** replaces [xGetWindowAttributes],
    this one is supposed to produce more concise code *)
#endif

type wattrs = {
    winat_x: unit -> int;
    winat_y: unit -> int;
    winat_width: unit -> int;
    winat_height: unit -> int;
    winat_depth: unit -> int;
    winat_screen: unit -> xScreen;
    winat_border_width: unit -> int;
    winat_colormap: unit -> colormap;
    winat_map_installed: unit -> bool;
  }
(** another record to replace all the [xWindowAttributes_*] functions *)

#if defined(ML)
let win_attrs ~dpy ~win =
  let xwa = xGetWindowAttributes ~dpy ~win in
  {
    winat_x             = (fun () -> xWindowAttributes_x xwa);
    winat_y             = (fun () -> xWindowAttributes_y xwa);
    winat_width         = (fun () -> xWindowAttributes_width xwa);
    winat_height        = (fun () -> xWindowAttributes_height xwa);
    winat_depth         = (fun () -> xWindowAttributes_depth xwa);
    winat_screen        = (fun () -> xWindowAttributes_screen xwa);
    winat_border_width  = (fun () -> xWindowAttributes_border_width xwa);
    winat_colormap      = (fun () -> xWindowAttributes_colormap xwa);
    winat_map_installed = (fun () -> xWindowAttributes_map_installed xwa);
  }
#else
val win_attrs : dpy:display -> win:window -> wattrs
(** another replacement for [xWindowAttributes] functions *)
#endif



(** {3 XSizeHints} *)

type xSizeHints
external new_xSizeHints: unit -> xSizeHints = "ml_alloc_XSizeHints"
(** this type is garbage collected *)

external xSizeHints_set_USPosition: xSizeHints -> x:int -> y:int -> unit = "ml_XSizeHints_set_USPosition"
external xSizeHints_set_USSize: xSizeHints -> width:int -> height:int -> unit = "ml_XSizeHints_set_USSize"
external xSizeHints_set_PPosition: xSizeHints -> x:int -> y:int -> unit = "ml_XSizeHints_set_PPosition"
external xSizeHints_set_PSize: xSizeHints -> width:int -> height:int -> unit = "ml_XSizeHints_set_PSize"
external xSizeHints_set_PMinSize: xSizeHints -> width:int -> height:int -> unit = "ml_XSizeHints_set_PMinSize"
external xSizeHints_set_PMaxSize: xSizeHints -> width:int -> height:int -> unit = "ml_XSizeHints_set_PMaxSize"
external xSizeHints_set_PResizeInc: xSizeHints -> width_inc:int -> height_inc:int -> unit = "ml_XSizeHints_set_PResizeInc"
external xSizeHints_set_PBaseSize: xSizeHints -> base_width:int -> base_height:int -> unit = "ml_XSizeHints_set_PBaseSize"
external xSizeHints_set_PAspect: xSizeHints -> min_aspect:int * int -> max_aspect:int * int -> unit = "ml_XSizeHints_set_PAspect"
external xSizeHints_set_PWinGravity: xSizeHints -> win_gravity:int -> unit = "ml_XSizeHints_set_PWinGravity"

external xSetNormalHints: dpy:display -> win:window -> hints:xSizeHints -> unit = "ml_XSetNormalHints"
external xSetStandardProperties: dpy:display -> win:window -> window_name:string -> icon_name:string ->
              icon_pixmap:pixmap option -> argv:string array -> hints:xSizeHints -> unit
    = "ml_XSetStandardProperties_bytecode"
      "ml_XSetStandardProperties"

type set_size_hints = {
    hints: xSizeHints;
    set_USPosition: x:int -> y:int -> unit;
    set_USSize: width:int -> height:int -> unit;
    set_PPosition: x:int -> y:int -> unit;
    set_PSize: width:int -> height:int -> unit;
    set_PMinSize: width:int -> height:int -> unit;
    set_PMaxSize: width:int -> height:int -> unit;
    set_PResizeInc: width_inc:int -> height_inc:int -> unit;
    set_PBaseSize: base_width:int -> base_height:int -> unit;
    set_PAspect: min_aspect:int * int -> max_aspect:int * int -> unit;
    set_PWinGravity: win_gravity:int -> unit;
  }
(** a record to replace all the [xSizeHints_set_*] functions *)

#if defined(ML)
let new_size_hints () =
  let sh = new_xSizeHints() in
  { hints = sh;
    set_USPosition  = xSizeHints_set_USPosition sh;
    set_USSize      = xSizeHints_set_USSize sh;
    set_PPosition   = xSizeHints_set_PPosition sh;
    set_PSize       = xSizeHints_set_PSize sh;
    set_PMinSize    = xSizeHints_set_PMinSize sh;
    set_PMaxSize    = xSizeHints_set_PMaxSize sh;
    set_PResizeInc  = xSizeHints_set_PResizeInc sh;
    set_PBaseSize   = xSizeHints_set_PBaseSize sh;
    set_PAspect     = xSizeHints_set_PAspect sh;
    set_PWinGravity = xSizeHints_set_PWinGravity sh;
  }
#else
val new_size_hints : unit -> set_size_hints
(** replaces [new_xSizeHints] *)
#endif


(** a variant to replace all the [xSizeHints_set_*] functions *)
type size_hints =
  | USPosition of int * int
  | USSize of int * int     (** (width, height) *)
  | PPosition of int * int
  | PSize of int * int
  | PMinSize of int * int
  | PMaxSize of int * int
  | PResizeInc of int * int
  | PBaseSize of int * int
  | PAspect of (int * int) * (int * int)
  | PWinGravity of int 

#if defined(ML)
let set_normal_hints ~dpy ~win ~hints =
  let sh = new_xSizeHints() in
  List.iter (function
  | USPosition(x, y)                   -> xSizeHints_set_USPosition sh x y;
  | USSize(width, height)              -> xSizeHints_set_USSize sh width height;
  | PPosition(x, y)                    -> xSizeHints_set_PPosition sh x y;
  | PSize(width, height)               -> xSizeHints_set_PSize sh width height;
  | PMinSize(width, height)            -> xSizeHints_set_PMinSize sh width height;
  | PMaxSize(width, height)            -> xSizeHints_set_PMaxSize sh width height;
  | PResizeInc(width_inc, height_inc)  -> xSizeHints_set_PResizeInc sh width_inc height_inc;
  | PBaseSize(base_width, base_height) -> xSizeHints_set_PBaseSize sh base_width base_height;
  | PAspect(min_aspect, max_aspect)    -> xSizeHints_set_PAspect sh min_aspect max_aspect;
  | PWinGravity(win_gravity)           -> xSizeHints_set_PWinGravity sh win_gravity;
  ) hints;
  xSetNormalHints ~dpy ~win ~hints:sh ;;
#else
val set_normal_hints: dpy:display -> win:window -> hints:size_hints list -> unit
(** replaces [xSetNormalHints] *)
#endif


#if defined(ML)
let set_standard_properties ~dpy ~win ~window_name ~icon_name
                            ~icon_pixmap ~argv ~hints =
  let sh = new_xSizeHints() in
  List.iter (function
  | USPosition(x, y)                   -> xSizeHints_set_USPosition sh x y;
  | USSize(width, height)              -> xSizeHints_set_USSize sh width height;
  | PPosition(x, y)                    -> xSizeHints_set_PPosition sh x y;
  | PSize(width, height)               -> xSizeHints_set_PSize sh width height;
  | PMinSize(width, height)            -> xSizeHints_set_PMinSize sh width height;
  | PMaxSize(width, height)            -> xSizeHints_set_PMaxSize sh width height;
  | PResizeInc(width_inc, height_inc)  -> xSizeHints_set_PResizeInc sh width_inc height_inc;
  | PBaseSize(base_width, base_height) -> xSizeHints_set_PBaseSize sh base_width base_height;
  | PAspect(min_aspect, max_aspect)    -> xSizeHints_set_PAspect sh min_aspect max_aspect;
  | PWinGravity(win_gravity)           -> xSizeHints_set_PWinGravity sh win_gravity;
  ) hints;
  xSetStandardProperties ~dpy ~win ~window_name ~icon_name
                         ~icon_pixmap ~argv ~hints:sh ;;
#else
val set_standard_properties: dpy:display -> win:window -> window_name:string -> icon_name:string ->
            icon_pixmap:pixmap option -> argv:string array -> hints:size_hints list -> unit
(** replaces [xSetStandardProperties] *)
#endif


(** {3 XEvents} *)

type 'a xEvent

type event_type =
  | KeyPress
  | KeyRelease
  | ButtonPress
  | ButtonRelease
  | MotionNotify
  | EnterNotify
  | LeaveNotify
  | FocusIn
  | FocusOut
  | KeymapNotify
  | Expose
  | GraphicsExpose
  | NoExpose
  | VisibilityNotify
  | CreateNotify
  | DestroyNotify
  | UnmapNotify
  | MapNotify
  | MapRequest
  | ReparentNotify
  | ConfigureNotify
  | ConfigureRequest
  | GravityNotify
  | ResizeRequest
  | CirculateNotify
  | CirculateRequest
  | PropertyNotify
  | SelectionClear
  | SelectionRequest
  | SelectionNotify
  | ColormapNotify
  | ClientMessage
  | MappingNotify

type any

type xKeyEvent
type xButtonEvent
type xMotionEvent
type xCrossingEvent
type xFocusChangeEvent
type xExposeEvent
type xGraphicsExposeEvent
type xNoExposeEvent
type xVisibilityEvent
type xCreateWindowEvent
type xDestroyWindowEvent
type xUnmapEvent
type xMapEvent
type xMapRequestEvent
type xReparentEvent
type xConfigureEvent
type xGravityEvent
type xResizeRequestEvent
type xConfigureRequestEvent
type xCirculateEvent
type xCirculateRequestEvent
type xPropertyEvent
type xSelectionClearEvent
type xSelectionRequestEvent
type xSelectionEvent
type xColormapEvent
type xClientMessageEvent
type xMappingEvent
type xErrorEvent
type xKeymapEvent

type xKeyPressedEvent  = xKeyEvent
type xKeyReleasedEvent = xKeyEvent

type xButtonPressedEvent  = xButtonEvent
type xButtonReleasedEvent = xButtonEvent

type xEnterWindowEvent = xCrossingEvent
type xLeaveWindowEvent = xCrossingEvent

type xFocusInEvent  = xFocusChangeEvent
type xFocusOutEvent = xFocusChangeEvent


type event_kind =
  | XKeyPressedEvent       of xKeyPressedEvent       xEvent
  | XKeyReleasedEvent      of xKeyReleasedEvent      xEvent

  | XButtonPressedEvent    of xButtonPressedEvent    xEvent
  | XButtonReleasedEvent   of xButtonReleasedEvent   xEvent

  | XMotionEvent           of xMotionEvent           xEvent
  | XCrossingEvent         of xCrossingEvent         xEvent
  | XFocusChangeEvent      of xFocusChangeEvent      xEvent
  | XExposeEvent           of xExposeEvent           xEvent
  | XGraphicsExposeEvent   of xGraphicsExposeEvent   xEvent
  | XNoExposeEvent         of xNoExposeEvent         xEvent
  | XVisibilityEvent       of xVisibilityEvent       xEvent
  | XCreateWindowEvent     of xCreateWindowEvent     xEvent
  | XDestroyWindowEvent    of xDestroyWindowEvent    xEvent
  | XUnmapEvent            of xUnmapEvent            xEvent
  | XMapEvent              of xMapEvent              xEvent
  | XMapRequestEvent       of xMapRequestEvent       xEvent
  | XReparentEvent         of xReparentEvent         xEvent
  | XConfigureEvent        of xConfigureEvent        xEvent
  | XGravityEvent          of xGravityEvent          xEvent
  | XResizeRequestEvent    of xResizeRequestEvent    xEvent
  | XConfigureRequestEvent of xConfigureRequestEvent xEvent
  | XCirculateEvent        of xCirculateEvent        xEvent
  | XCirculateRequestEvent of xCirculateRequestEvent xEvent
  | XPropertyEvent         of xPropertyEvent         xEvent
  | XSelectionClearEvent   of xSelectionClearEvent   xEvent
  | XSelectionRequestEvent of xSelectionRequestEvent xEvent
  | XSelectionEvent        of xSelectionEvent        xEvent
  | XColormapEvent         of xColormapEvent         xEvent
  | XClientMessageEvent    of xClientMessageEvent    xEvent
  | XMappingEvent          of xMappingEvent          xEvent
  | XErrorEvent            of xErrorEvent            xEvent
  | XKeymapEvent           of xKeymapEvent           xEvent


external new_xEvent: unit -> any xEvent = "ml_alloc_XEvent"
(** the return value is garbage collected *)

external xNextEvent: dpy:display -> event:any xEvent -> unit = "ml_XNextEvent"
(** {{:http://tronche.com/gui/x/xlib/event-handling/manipulating-event-queue/XNextEvent.html}man}

    this function modifies the [event] parameter, which is supposed to come from
    the function [new_xEvent]. *)

external xNextEventFun: dpy:display -> any xEvent = "ml_XNextEvent_fun"
(** This function is supposed to replace the functions [new_xEvent] and [xNextEvent],
    in order to produce more functional code. The tradeoff is that there is a
    new allocation of the xEvent structure at each call. *)

external xPeekEvent: dpy:display -> event:any xEvent -> unit = "ml_XPeekEvent"
(** {{:http://tronche.com/gui/x/xlib/event-handling/manipulating-event-queue/XPeekEvent.html}man} *)

external xMaskEvent: dpy:display -> event_mask list -> any xEvent -> unit = "ml_XMaskEvent"
(** {{:http://tronche.com/gui/x/xlib/event-handling/manipulating-event-queue/XMaskEvent.html}man} *)

(* TODO s/'a/any/ ??? *)
(* TODO s/xWindowEvent/xWindowEventFun/ ??? *)
external xWindowEvent: dpy:display -> win:window -> event_mask list -> 'a xEvent = "ml_XWindowEvent"
(** {{:http://tronche.com/gui/x/xlib/event-handling/manipulating-event-queue/XWindowEvent.html}man} *)

external xPending: dpy:display -> int = "ml_XPending"
(** {{:http://tronche.com/gui/x/xlib/event-handling/XPending.html}man} *)

type event_mode =
  | AsyncPointer
  | SyncPointer
  | AsyncKeyboard
  | SyncKeyboard
  | ReplayPointer
  | ReplayKeyboard
  | AsyncBoth
  | SyncBoth

external xAllowEvents: dpy:display -> event_mode:event_mode -> time:time -> unit = "ml_XAllowEvents"
(** {{:http://tronche.com/gui/x/xlib/input/XAllowEvents.html}man} *)

(*
extern int XIfEvent(
    Display*            /* display */,
    XEvent*             /* event_return */,
    Bool ( * ) (
               Display*                 /* display */,
               XEvent*                  /* event */,
               XPointer                 /* arg */
             )          /* predicate */,
    XPointer            /* arg */
);
(** {{:http://tronche.com/gui/x/xlib/event-handling/manipulating-event-queue/XIfEvent.html}man},
    {{:http://tronche.com/gui/x/xlib/event-handling/manipulating-event-queue/selecting-using-predicate.html}man}
 *)
*)

external xPutBackEvent: dpy:display -> event:'a xEvent -> unit = "ml_XPutBackEvent"
(** {{:http://tronche.com/gui/x/xlib/event-handling/XPutBackEvent.html}man} *)

(*
Status XSendEvent(
    Display*            /* display */,
    Window              /* w */,
    Bool                /* propagate */,
    long                /* event_mask */,
    XEvent*             /* event_send */
);
(** {{:http://tronche.com/gui/x/xlib/event-handling/XSendEvent.html}man} *)
*)

type queued_mode =
  | QueuedAlready
  | QueuedAfterFlush
  | QueuedAfterReading

external xEventsQueued: dpy:display -> mode:queued_mode -> int = "ml_XEventsQueued"
(** {{:http://tronche.com/gui/x/xlib/event-handling/XEventsQueued.html}man} *)

external xCheckTypedEvent: dpy:display -> event_type -> any xEvent -> bool = "ml_XCheckTypedEvent"
(** {{:http://tronche.com/gui/x/xlib/event-handling/manipulating-event-queue/XCheckTypedEvent.html}man},
    this function is imperative: the xEvent provided is modified, so is a returned value too *)

#if defined(MLI)
val xCheckTypedEvent_option: dpy:display -> event_type -> any xEvent option
(** replaces [xCheckTypedEvent] *)
#else
let xCheckTypedEvent_option ~dpy event_type =
  let ev = new_xEvent() in
  if (xCheckTypedEvent ~dpy event_type ev)
  then Some ev
  else None
#endif

external xEventType: event:'a xEvent -> event_type = "ml_XEvent_type"


#if defined(MLI)
val xEventKind : event:any xEvent -> event_kind
(** selects the right type of the event *)
#else
let xEventKind ~event =
  match xEventType ~event with
  | MotionNotify        -> XMotionEvent           (Obj.magic event : xMotionEvent           xEvent)
 
  | KeyPress            -> XKeyPressedEvent       (Obj.magic event : xKeyPressedEvent       xEvent)  (* xKeyEvent *)
  | KeyRelease          -> XKeyReleasedEvent      (Obj.magic event : xKeyReleasedEvent      xEvent)  (* xKeyEvent *)

  | ButtonPress         -> XButtonPressedEvent    (Obj.magic event : xButtonPressedEvent    xEvent)  (* xButtonEvent *)
  | ButtonRelease       -> XButtonReleasedEvent   (Obj.magic event : xButtonReleasedEvent   xEvent)  (* xButtonEvent *)
 
  | EnterNotify         -> XCrossingEvent         (Obj.magic event : xEnterWindowEvent      xEvent)  (* xCrossingEvent *)
  | LeaveNotify         -> XCrossingEvent         (Obj.magic event : xLeaveWindowEvent      xEvent)  (* xCrossingEvent *)
 
  | FocusIn             -> XFocusChangeEvent      (Obj.magic event : xFocusInEvent          xEvent)  (* xFocusChangeEvent *)
  | FocusOut            -> XFocusChangeEvent      (Obj.magic event : xFocusOutEvent         xEvent)  (* xFocusChangeEvent *)
 
  | KeymapNotify        -> XKeymapEvent           (Obj.magic event : xKeymapEvent           xEvent)
  | Expose              -> XExposeEvent           (Obj.magic event : xExposeEvent           xEvent)
  | GraphicsExpose      -> XGraphicsExposeEvent   (Obj.magic event : xGraphicsExposeEvent   xEvent)
  | NoExpose            -> XNoExposeEvent         (Obj.magic event : xNoExposeEvent         xEvent)
  | VisibilityNotify    -> XVisibilityEvent       (Obj.magic event : xVisibilityEvent       xEvent)
  | CreateNotify        -> XCreateWindowEvent     (Obj.magic event : xCreateWindowEvent     xEvent)
  | DestroyNotify       -> XDestroyWindowEvent    (Obj.magic event : xDestroyWindowEvent    xEvent)
  | UnmapNotify         -> XUnmapEvent            (Obj.magic event : xUnmapEvent            xEvent)
  | MapNotify           -> XMapEvent              (Obj.magic event : xMapEvent              xEvent)
  | MapRequest          -> XMapRequestEvent       (Obj.magic event : xMapRequestEvent       xEvent)
  | ReparentNotify      -> XReparentEvent         (Obj.magic event : xReparentEvent         xEvent)
  | ConfigureNotify     -> XConfigureEvent        (Obj.magic event : xCo…