]> matita.cs.unibo.it Git - helm.git/blob - helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/wrappers.c
* click signal changed: now the element argument is optional
[helm.git] / helm / DEVEL / lablgtk / lablgtk_20000829-0.1.0 / wrappers.c
1 /* $Id$ */
2
3 #include <string.h>
4 #include <caml/mlvalues.h>
5 #include <caml/alloc.h>
6 #include <caml/memory.h>
7 #include <caml/callback.h>
8 #include <caml/fail.h>
9
10 #include "wrappers.h"
11
12 value copy_memblock_indirected (void *src, asize_t size)
13 {
14     value ret = alloc (Wosize_asize(size)+2, Abstract_tag);
15     if (!src) ml_raise_null_pointer ();
16     
17     Field(ret,1) = 2;
18     memcpy (&Field(ret,2), src, size);
19     return ret;
20 }
21
22 value ml_some (value v)
23 {
24      CAMLparam1(v);
25      value ret = alloc_small(1,0);
26      Field(ret,0) = v;
27      CAMLreturn(ret);
28 }
29
30 void ml_raise_null_pointer ()
31 {
32   static value * exn = NULL;
33   if (exn == NULL)
34       exn = caml_named_value ("null_pointer");
35   raise_constant (*exn);
36 }   
37
38 value Val_pointer (void *ptr)
39 {
40     value ret = alloc_small (2, Abstract_tag);
41     if (!ptr) ml_raise_null_pointer ();
42     Field(ret,1) = (value)ptr;
43     return ret;
44 }
45
46 value copy_string_check (const char*str)
47 {
48     if (!str) ml_raise_null_pointer ();
49     return copy_string ((char*) str);
50 }
51
52 value copy_string_or_null (const char*str)
53 {
54     return copy_string (str ? (char*) str : "");
55 }
56
57 value ml_lookup_from_c (lookup_info *table, int data)
58 {
59     int i;
60     for (i = table[0].data; i > 0; i--)
61         if (table[i].data == data) return table[i].key;
62     invalid_argument ("ml_lookup_from_c");
63 }
64     
65 int ml_lookup_to_c (lookup_info *table, value key)
66 {
67     int first = 1, last = table[0].data, current;
68
69     while (first < last) {
70         current = (first+last)/2;
71         if (table[current].key >= key) last = current;
72         else first = current + 1;
73     }
74     if (table[first].key == key) return table[first].data;
75     invalid_argument ("ml_lookup_to_c");
76 }