]> matita.cs.unibo.it Git - helm.git/blob - helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/gdk.ml
- DoubleTypeInference.does_not_occur exposed
[helm.git] / helm / DEVEL / lablgtk / lablgtk_20000829-0.1.0 / gdk.ml
1 (* $Id$ *)
2
3 open Gaux
4
5 type colormap
6 type visual
7 type region
8 type gc
9 type 'a drawable
10 type window = [`window] drawable
11 type pixmap = [`pixmap] drawable
12 type bitmap = [`bitmap] drawable
13 type font
14 type image
15 type atom = int
16 type keysym = int
17 type 'a event
18 type drag_context
19 type cursor
20 type xid = int32
21
22 exception Error of string
23 let _ = Callback.register_exception "gdkerror" (Error"")
24
25 module Tags = struct
26   type event_type =
27     [ `NOTHING|`DELETE|`DESTROY|`EXPOSE|`MOTION_NOTIFY|`BUTTON_PRESS
28      |`TWO_BUTTON_PRESS|`THREE_BUTTON_PRESS
29      |`BUTTON_RELEASE|`KEY_PRESS
30      |`KEY_RELEASE|`ENTER_NOTIFY|`LEAVE_NOTIFY|`FOCUS_CHANGE
31      |`CONFIGURE|`MAP|`UNMAP|`PROPERTY_NOTIFY|`SELECTION_CLEAR
32      |`SELECTION_REQUEST|`SELECTION_NOTIFY|`PROXIMITY_IN
33      |`PROXIMITY_OUT|`DRAG_ENTER|`DRAG_LEAVE|`DRAG_MOTION|`DRAG_STATUS
34      |`DROP_START|`DROP_FINISHED|`CLIENT_EVENT|`VISIBILITY_NOTIFY
35      |`NO_EXPOSE ]
36
37   type event_mask =
38     [ `EXPOSURE
39      |`POINTER_MOTION|`POINTER_MOTION_HINT
40      |`BUTTON_MOTION|`BUTTON1_MOTION|`BUTTON2_MOTION|`BUTTON3_MOTION
41      |`BUTTON_PRESS|`BUTTON_RELEASE
42      |`KEY_PRESS|`KEY_RELEASE
43      |`ENTER_NOTIFY|`LEAVE_NOTIFY|`FOCUS_CHANGE
44      |`STRUCTURE|`PROPERTY_CHANGE|`VISIBILITY_NOTIFY
45      |`PROXIMITY_IN|`PROXIMITY_OUT|`SUBSTRUCTURE
46      |`ALL_EVENTS ]
47
48   type extension_events =
49     [ `NONE|`ALL|`CURSOR ]
50
51   type visibility_state =
52     [ `UNOBSCURED|`PARTIAL|`FULLY_OBSCURED ]
53
54   type input_source =
55     [ `MOUSE|`PEN|`ERASER|`CURSOR ]
56
57   type notify_type =
58     [ `ANCESTOR|`VIRTUAL|`INFERIOR|`NONLINEAR|`NONLINEAR_VIRTUAL|`UNKNOWN ] 
59
60   type crossing_mode =
61     [ `NORMAL|`GRAB|`UNGRAB ]
62
63   type modifier =
64     [ `SHIFT|`LOCK|`CONTROL|`MOD1|`MOD2|`MOD3|`MOD4|`MOD5|`BUTTON1
65      |`BUTTON2|`BUTTON3|`BUTTON4|`BUTTON5 ]
66
67   type drag_action =
68     [ `DEFAULT|`COPY|`MOVE|`LINK|`PRIVATE|`ASK ]
69
70 end
71 open Tags
72
73 module Convert = struct
74   external test_modifier : modifier -> int -> bool
75       = "ml_test_GdkModifier_val"
76   let modifier i =
77     List.filter [`SHIFT;`LOCK;`CONTROL;`MOD1;`MOD2;`MOD3;`MOD4;`MOD5;
78                  `BUTTON1;`BUTTON2;`BUTTON3;`BUTTON4;`BUTTON5]
79       ~f:(fun m -> test_modifier m i)
80 end
81
82 module Screen = struct
83   external width : unit -> int = "ml_gdk_screen_width"
84   external height : unit -> int = "ml_gdk_screen_height"
85 end
86
87 module Visual = struct
88   type visual_type =
89     [ `STATIC_GRAY|`GRAYSCALE|`STATIC_COLOR
90      |`PSEUDO_COLOR|`TRUE_COLOR|`DIRECT_COLOR ]
91
92   external get_best : ?depth:int -> ?kind:visual_type -> unit -> visual
93       = "ml_gdk_visual_get_best"
94   external get_type : visual -> visual_type = "ml_GdkVisual_type"
95   external depth : visual -> int = "ml_GdkVisual_depth"
96   external red_mask : visual -> int = "ml_GdkVisual_red_mask"
97   external red_shift : visual -> int = "ml_GdkVisual_red_shift"
98   external red_prec : visual -> int = "ml_GdkVisual_red_prec"
99   external green_mask : visual -> int = "ml_GdkVisual_green_mask"
100   external green_shift : visual -> int = "ml_GdkVisual_green_shift"
101   external green_prec : visual -> int = "ml_GdkVisual_green_prec"
102   external blue_mask : visual -> int = "ml_GdkVisual_blue_mask"
103   external blue_shift : visual -> int = "ml_GdkVisual_blue_shift"
104   external blue_prec : visual -> int = "ml_GdkVisual_blue_prec"
105 end
106
107 module Image = struct
108   type image_type =
109     [ `NORMAL|`SHARED|`FASTEST ] 
110
111   external create_bitmap : visual: visual -> data: string -> 
112     width: int -> height: int -> image 
113       = "ml_gdk_image_new_bitmap"
114   external create : kind: image_type -> visual: visual -> 
115     width: int -> height: int -> image
116       = "ml_gdk_image_new"
117   external get :
118       'a drawable -> x: int -> y: int -> width: int -> height: int -> image
119       = "ml_gdk_image_get"
120   external put_pixel : image -> x: int -> y: int -> pixel: int -> unit
121     = "ml_gdk_image_put_pixel"
122   external get_pixel : image -> x: int -> y: int -> int
123     = "ml_gdk_image_get_pixel"
124   external destroy : image -> unit
125     = "ml_gdk_image_destroy"
126 end
127
128 module Color = struct
129   type t
130
131   external color_white : colormap -> t = "ml_gdk_color_white"
132   external color_black : colormap -> t = "ml_gdk_color_black"
133   external color_parse : string -> t = "ml_gdk_color_parse"
134   external color_alloc : colormap -> t -> bool = "ml_gdk_color_alloc"
135   external color_create : red:int -> green:int -> blue:int -> t
136       = "ml_GdkColor"
137
138   external get_system_colormap : unit -> colormap
139       = "ml_gdk_colormap_get_system"
140   external colormap_new : visual -> privat:bool -> colormap
141       = "ml_gdk_colormap_new"
142   let get_colormap ?(privat=false) vis = colormap_new vis ~privat
143
144   type spec = [ `BLACK | `NAME of string | `RGB of int * int * int | `WHITE]
145   let color_alloc ~colormap color =
146     if not (color_alloc colormap color) then raise (Error"Color.alloc");
147     color
148   let alloc ~colormap color =
149     match color with
150       `WHITE -> color_white colormap
151     | `BLACK -> color_black colormap
152     | `NAME s -> color_alloc ~colormap (color_parse s)
153     | `RGB (red,green,blue) ->
154         color_alloc ~colormap (color_create ~red ~green ~blue)
155
156   external red : t -> int = "ml_GdkColor_red"
157   external blue : t -> int = "ml_GdkColor_blue"
158   external green : t -> int = "ml_GdkColor_green"
159   external pixel : t -> int = "ml_GdkColor_pixel"
160 end
161
162 module Rectangle = struct
163   type t
164   external create : x:int -> y:int -> width:int -> height:int -> t
165       = "ml_GdkRectangle"
166   external x : t -> int = "ml_GdkRectangle_x"
167   external y : t -> int = "ml_GdkRectangle_y"
168   external width : t -> int = "ml_GdkRectangle_width"
169   external height : t -> int = "ml_GdkRectangle_height"
170 end
171
172 module Window = struct
173   type background_pixmap = [ `NONE | `PARENT_RELATIVE | `PIXMAP of pixmap]
174   external visual_depth : visual -> int = "ml_gdk_visual_get_depth"
175   external get_visual : window -> visual = "ml_gdk_window_get_visual"
176   external get_parent : window -> window = "ml_gdk_window_get_parent"
177   external get_size : window -> int * int = "ml_gdk_window_get_size"
178   external get_position : window -> int * int =
179     "ml_gdk_window_get_position"
180   external root_parent : unit -> window = "ml_GDK_ROOT_PARENT"
181   external set_back_pixmap : window -> pixmap -> int -> unit = 
182     "ml_gdk_window_set_back_pixmap"
183   external clear : window -> unit = "ml_gdk_window_clear"
184   external get_xwindow : window -> xid = "ml_GDK_WINDOW_XWINDOW"
185
186   let set_back_pixmap w pix = 
187     let null_pixmap = (Obj.magic Gpointer.boxed_null : pixmap) in
188     match pix with
189       `NONE -> set_back_pixmap w null_pixmap 0
190     | `PARENT_RELATIVE -> set_back_pixmap w null_pixmap 1
191     | `PIXMAP(pixmap) -> set_back_pixmap w pixmap 0 
192        (* anything OK, Maybe... *) 
193 end
194
195 module PointArray = struct
196   type t = { len: int}
197   external create : len:int -> t = "ml_point_array_new"
198   external set : t -> pos:int -> x:int -> y:int -> unit = "ml_point_array_set"
199   let set arr ~pos =
200     if pos < 0 || pos >= arr.len then invalid_arg "PointArray.set";
201     set arr ~pos
202 end
203
204 module Region = struct
205   type gdkFillRule = [ `EVEN_ODD_RULE|`WINDING_RULE ]
206   type gdkOverlapType = [ `IN|`OUT|`PART ]
207   external create : unit -> region = "ml_gdk_region_new"
208   external destroy : region -> unit = "ml_gdk_region_destroy"
209   external polygon : PointArray.t -> gdkFillRule -> region 
210       = "ml_gdk_region_polygon"
211   let polygon l =
212     let len = List.length l in
213     let arr = PointArray.create ~len in
214     List.fold_left l ~init:0
215       ~f:(fun pos (x,y) -> PointArray.set arr ~pos ~x ~y; pos+1);
216     polygon arr    
217   external intersect : region -> region -> region
218       = "ml_gdk_regions_intersect"
219   external union : region -> region -> region 
220       = "ml_gdk_regions_union"
221   external subtract : region -> region -> region 
222       = "ml_gdk_regions_subtract"
223   external xor : region -> region -> region 
224       = "ml_gdk_regions_xor"
225   external union_with_rect : region -> Rectangle.t -> region
226       = "ml_gdk_region_union_with_rect"
227   external offset : region -> x:int -> y:int -> unit = "ml_gdk_region_offset"
228   external shrink : region -> x:int -> y:int -> unit = "ml_gdk_region_shrink"
229   external empty : region -> bool = "ml_gdk_region_empty"
230   external equal : region -> region -> bool = "ml_gdk_region_equal"
231   external point_in : region -> x:int -> y:int -> bool 
232       = "ml_gdk_region_point_in"
233   external rect_in : region -> Rectangle.t -> gdkOverlapType
234       = "ml_gdk_region_rect_in"
235   external get_clipbox : region -> Rectangle.t -> unit
236       = "ml_gdk_region_get_clipbox"
237 end
238       
239
240 module GC = struct
241   type gdkFunction = [ `COPY|`INVERT|`XOR ]
242   type gdkFill = [ `SOLID|`TILED|`STIPPLED|`OPAQUE_STIPPLED ]
243   type gdkSubwindowMode = [ `CLIP_BY_CHILDREN|`INCLUDE_INFERIORS ]
244   type gdkLineStyle = [ `SOLID|`ON_OFF_DASH|`DOUBLE_DASH ]
245   type gdkCapStyle = [ `NOT_LAST|`BUTT|`ROUND|`PROJECTING ]
246   type gdkJoinStyle = [ `MITER|`ROUND|`BEVEL ]
247   external create : 'a drawable -> gc = "ml_gdk_gc_new"
248   external set_foreground : gc -> Color.t -> unit = "ml_gdk_gc_set_foreground"
249   external set_background : gc -> Color.t -> unit = "ml_gdk_gc_set_background"
250   external set_font : gc -> font -> unit = "ml_gdk_gc_set_font"
251   external set_function : gc -> gdkFunction -> unit = "ml_gdk_gc_set_function"
252   external set_fill : gc -> gdkFill -> unit = "ml_gdk_gc_set_fill"
253   external set_tile : gc -> pixmap -> unit = "ml_gdk_gc_set_tile"
254   external set_stipple : gc -> pixmap -> unit = "ml_gdk_gc_set_stipple"
255   external set_ts_origin : gc -> x:int -> y:int -> unit
256       = "ml_gdk_gc_set_ts_origin"
257   external set_clip_origin : gc -> x:int -> y:int -> unit
258       = "ml_gdk_gc_set_clip_origin"
259   external set_clip_mask : gc -> bitmap -> unit = "ml_gdk_gc_set_clip_mask"
260   external set_clip_rectangle : gc -> Rectangle.t -> unit
261       = "ml_gdk_gc_set_clip_rectangle"
262   external set_clip_region : gc -> region -> unit = "ml_gdk_gc_set_clip_region"
263   external set_subwindow : gc -> gdkSubwindowMode -> unit
264       = "ml_gdk_gc_set_subwindow"
265   external set_exposures : gc -> bool -> unit = "ml_gdk_gc_set_exposures"
266   external set_line_attributes :
267       gc -> width:int -> style:gdkLineStyle -> cap:gdkCapStyle ->
268       join:gdkJoinStyle -> unit
269       = "ml_gdk_gc_set_line_attributes"
270   external copy : dst:gc -> gc -> unit = "ml_gdk_gc_copy"
271   type values = {
272       foreground : Color.t;
273       background : Color.t;
274       font : font option;
275       fonction : gdkFunction;
276       fill : gdkFill;
277       tile : pixmap option;
278       stipple : pixmap option;
279       clip_mask : bitmap option;
280       subwindow_mode : gdkSubwindowMode;
281       ts_x_origin : int;
282       ts_y_origin : int;
283       clip_x_origin : int;
284       clip_y_origin : int;
285       graphics_exposures : bool;
286       line_width : int;
287       line_style : gdkLineStyle;
288       cap_style : gdkCapStyle;
289       join_style : gdkJoinStyle;
290     }
291   external get_values : gc -> values = "ml_gdk_gc_get_values"
292 end
293
294 module Pixmap = struct
295   external create : window -> width:int -> height:int -> depth:int -> pixmap
296       = "ml_gdk_pixmap_new"
297   external create_from_data :
298       window -> string -> width:int -> height:int -> depth:int ->
299       fg:Color.t -> bg:Color.t -> pixmap
300       = "ml_gdk_pixmap_create_from_data_bc" "ml_gk_pixmap_create_from_data"
301   external create_from_xpm :
302       window -> ?colormap:colormap -> ?transparent:Color.t ->
303       file:string -> pixmap * bitmap
304       = "ml_gdk_pixmap_colormap_create_from_xpm"
305   external create_from_xpm_d :
306       window -> ?colormap:colormap -> ?transparent:Color.t ->
307       data:string array -> pixmap * bitmap
308       = "ml_gdk_pixmap_colormap_create_from_xpm_d"
309 end
310
311 module Bitmap = struct
312   let create : window -> width:int -> height:int -> bitmap =
313     Obj.magic (Pixmap.create ~depth:1)
314   external create_from_data :
315       window -> string -> width:int -> height:int -> bitmap
316       = "ml_gdk_bitmap_create_from_data"
317 end
318
319 module Font = struct
320   external load : string -> font = "ml_gdk_font_load"
321   external load_fontset : string -> font = "ml_gdk_fontset_load"
322   external string_width : font -> string -> int = "ml_gdk_string_width"
323   external char_width : font -> char -> int = "ml_gdk_char_width"
324   external string_height : font -> string -> int = "ml_gdk_string_height"
325   external char_height : font -> char -> int = "ml_gdk_char_height"
326   external string_measure : font -> string -> int = "ml_gdk_string_measure"
327   external char_measure : font -> char -> int = "ml_gdk_char_measure"
328   external get_type : font -> [`FONT | `FONTSET] = "ml_GdkFont_type"
329   external ascent : font -> int = "ml_GdkFont_ascent"
330   external descent : font -> int = "ml_GdkFont_descent"
331 end
332
333 module Draw = struct
334   external point : 'a drawable -> gc -> x:int -> y:int -> unit
335       = "ml_gdk_draw_point"
336   external line : 'a drawable -> gc -> x:int -> y:int -> x:int -> y:int -> unit
337       = "ml_gdk_draw_line_bc" "ml_gdk_draw_line"
338   external rectangle :
339       'a drawable -> gc ->
340       filled:bool -> x:int -> y:int -> width:int -> height:int -> unit
341       = "ml_gdk_draw_rectangle_bc" "ml_gdk_draw_rectangle"
342   let rectangle w gc ~x ~y ~width ~height ?(filled=false) () =
343     rectangle w gc ~x ~y ~width ~height ~filled
344   external arc :
345       'a drawable -> gc -> filled:bool -> x:int -> y:int ->
346       width:int -> height:int -> start:int -> angle:int -> unit
347       = "ml_gdk_draw_arc_bc" "ml_gdk_draw_arc"
348   let arc w gc ~x ~y ~width ~height ?(filled=false) ?(start=0.)
349       ?(angle=360.) () =
350     arc w gc ~x ~y ~width ~height ~filled
351       ~start:(truncate(start *. 64.))
352       ~angle:(truncate(angle *. 64.))
353   external polygon : 'a drawable -> gc -> filled:bool -> PointArray.t -> unit
354       = "ml_gdk_draw_polygon"
355   let polygon w gc ?(filled=false) l =
356     let len = List.length l in
357     let arr = PointArray.create ~len in
358     List.fold_left l ~init:0
359       ~f:(fun pos (x,y) -> PointArray.set arr ~pos ~x ~y; pos+1);
360     polygon w gc ~filled arr
361   external string : 'a drawable -> font: font -> gc -> x: int -> y: int ->
362     string: string -> unit
363       = "ml_gdk_draw_string_bc" "ml_gdk_draw_string"    
364   external image : 'a drawable -> gc -> image: image -> 
365     xsrc: int -> ysrc: int -> xdest: int -> ydest: int -> 
366     width: int -> height: int -> unit
367       = "ml_gdk_draw_image_bc" "ml_gdk_draw_image"
368 end
369
370 module Rgb = struct
371   external init : unit -> unit = "ml_gdk_rgb_init"
372   external get_visual : unit -> visual = "ml_gdk_rgb_get_visual"
373   external get_cmap : unit -> colormap = "ml_gdk_rgb_get_cmap"
374 end
375
376 module DnD = struct
377   external drag_status : drag_context -> drag_action list -> time:int -> unit
378       = "ml_gdk_drag_status"
379   external drag_context_suggested_action : drag_context -> drag_action
380       = "ml_GdkDragContext_suggested_action"
381   external drag_context_targets : drag_context -> atom list
382       = "ml_GdkDragContext_targets"
383 end
384
385 module Truecolor = struct
386   (* Truecolor quick color query *) 
387
388   type visual_shift_prec = {
389       red_shift : int;
390       red_prec : int;
391       green_shift : int;
392       green_prec : int;
393       blue_shift : int;
394       blue_prec : int
395     }
396  
397   let shift_prec visual = {
398     red_shift = Visual.red_shift visual;
399     red_prec = Visual.red_prec visual;
400     green_shift = Visual.green_shift visual;
401     green_prec = Visual.green_prec visual;
402     blue_shift = Visual.blue_shift visual;
403     blue_prec = Visual.blue_prec visual;
404   }
405
406   let color_creator visual =
407     match Visual.get_type visual with
408       `TRUE_COLOR | `DIRECT_COLOR ->
409         let shift_prec = shift_prec visual in
410         Format.eprintf "red : %d %d, "
411           shift_prec.red_shift shift_prec.red_prec;
412         Format.eprintf "green : %d %d, "
413           shift_prec.green_shift shift_prec.green_prec;
414         Format.eprintf "blue : %d %d"
415           shift_prec.blue_shift shift_prec.blue_prec;
416         Format.pp_print_newline Format.err_formatter ();
417         let red_lsr = 16 - shift_prec.red_prec
418         and green_lsr = 16 - shift_prec.green_prec
419         and blue_lsr = 16 - shift_prec.blue_prec in
420         fun ~red: red ~green: green ~blue: blue ->
421           (((red lsr red_lsr) lsl shift_prec.red_shift) lor 
422            ((green lsr green_lsr) lsl shift_prec.green_shift) lor
423            ((blue lsr blue_lsr) lsl shift_prec.blue_shift))
424     | _ -> raise (Invalid_argument "Gdk.Truecolor.color_creator")
425
426   let color_parser visual =
427     match Visual.get_type visual with
428       `TRUE_COLOR | `DIRECT_COLOR ->
429         let shift_prec = shift_prec visual in
430         let red_lsr = 16 - shift_prec.red_prec
431         and green_lsr = 16 - shift_prec.green_prec
432         and blue_lsr = 16 - shift_prec.blue_prec in
433         let mask = 1 lsl 16 - 1 in
434         fun pixel ->
435           ((pixel lsr shift_prec.red_shift) lsl red_lsr) land mask,
436           ((pixel lsr shift_prec.green_shift) lsl green_lsr) land mask,
437           ((pixel lsr shift_prec.blue_shift) lsl blue_lsr) land mask
438     | _ -> raise (Invalid_argument "Gdk.Truecolor.color_parser")
439 end
440
441 module X = struct
442   (* X related functions *)
443   external flush : unit -> unit
444       = "ml_gdk_flush"
445   external beep : unit -> unit
446       = "ml_gdk_beep"
447 end
448
449 module Cursor = struct
450   type cursor_type = [
451     | `X_CURSOR
452     | `ARROW
453     | `BASED_ARROW_DOWN
454     | `BASED_ARROW_UP
455     | `BOAT
456     | `BOGOSITY
457     | `BOTTOM_LEFT_CORNER
458     | `BOTTOM_RIGHT_CORNER
459     | `BOTTOM_SIDE
460     | `BOTTOM_TEE
461     | `BOX_SPIRAL
462     | `CENTER_PTR
463     | `CIRCLE
464     | `CLOCK
465     | `COFFEE_MUG
466     | `CROSS
467     | `CROSS_REVERSE
468     | `CROSSHAIR
469     | `DIAMOND_CROSS
470     | `DOT
471     | `DOTBOX
472     | `DOUBLE_ARROW
473     | `DRAFT_LARGE
474     | `DRAFT_SMALL
475     | `DRAPED_BOX
476     | `EXCHANGE
477     | `FLEUR
478     | `GOBBLER
479     | `GUMBY
480     | `HAND1
481     | `HAND2
482     | `HEART
483     | `ICON
484     | `IRON_CROSS
485     | `LEFT_PTR
486     | `LEFT_SIDE
487     | `LEFT_TEE
488     | `LEFTBUTTON
489     | `LL_ANGLE
490     | `LR_ANGLE
491     | `MAN
492     | `MIDDLEBUTTON
493     | `MOUSE
494     | `PENCIL
495     | `PIRATE
496     | `PLUS
497     | `QUESTION_ARROW
498     | `RIGHT_PTR
499     | `RIGHT_SIDE
500     | `RIGHT_TEE
501     | `RIGHTBUTTON
502     | `RTL_LOGO
503     | `SAILBOAT
504     | `SB_DOWN_ARROW
505     | `SB_H_DOUBLE_ARROW
506     | `SB_LEFT_ARROW
507     | `SB_RIGHT_ARROW
508     | `SB_UP_ARROW
509     | `SB_V_DOUBLE_ARROW
510     | `SHUTTLE
511     | `SIZING
512     | `SPIDER
513     | `SPRAYCAN
514     | `STAR
515     | `TARGET
516     | `TCROSS
517     | `TOP_LEFT_ARROW
518     | `TOP_LEFT_CORNER
519     | `TOP_RIGHT_CORNER
520     | `TOP_SIDE
521     | `TOP_TEE
522     | `TREK
523     | `UL_ANGLE
524     | `UMBRELLA
525     | `UR_ANGLE
526     | `WATCH
527     | `XTERM
528   ]
529   external create : cursor_type -> cursor = "ml_gdk_cursor_new"
530   external create_from_pixmap :
531     pixmap -> mask:bitmap ->
532     fg:Color.t -> bg:Color.t -> x:int -> y:int -> cursor
533     = "ml_gdk_cursor_new_from_pixmap_bc" "ml_gdk_cursor_new_from_pixmap"
534   external destroy : cursor -> unit = "ml_gdk_cursor_destroy"
535 end