X-Git-Url: http://matita.cs.unibo.it/gitweb/?p=helm.git;a=blobdiff_plain;f=helm%2FDEVEL%2Flablgtk%2Flablgtk_20000829-0.1.0%2Fml_glib.c;fp=helm%2FDEVEL%2Flablgtk%2Flablgtk_20000829-0.1.0%2Fml_glib.c;h=0000000000000000000000000000000000000000;hp=b7d3fcbc249f13af03f048793a4f8cca8a9d983f;hb=869549224eef6278a48c16ae27dd786376082b38;hpb=89262281b6e83bd2321150f81f1a0583645eb0c8

diff --git a/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/ml_glib.c b/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/ml_glib.c
deleted file mode 100644
index b7d3fcbc2..000000000
--- a/helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/ml_glib.c
+++ /dev/null
@@ -1,135 +0,0 @@
-/* $Id$ */
-
-#include <glib.h>
-#include <caml/mlvalues.h>
-#include <caml/alloc.h>
-#include <caml/memory.h>
-#include <caml/callback.h>
-
-#include "wrappers.h"
-#include "ml_glib.h"
-
-/*
-value Val_GSList (GSList *list, value (*func)(gpointer))
-{
-    value new_cell, result, last_cell, cell;
-
-    if (list == NULL) return Val_unit;
-
-    last_cell = cell = Val_unit;
-    result = func(list->data);
-    Begin_roots3 (last_cell, cell, result);
-    cell = last_cell = alloc_tuple (2);
-    Field(cell,0) = result;
-    Field(cell,1) = Val_unit;
-    list = list->next;
-    while (list != NULL) {
-	result = func(list->data);
-	new_cell = alloc_tuple(2);
-	Field(new_cell,0) = result;
-	Field(new_cell,1) = Val_unit;
-	modify(&Field(last_cell,1), new_cell);
-	last_cell = new_cell;
-	list = list->next;
-    }
-    End_roots ();
-    return cell;
-}
-
-GSList *GSList_val (value list, gpointer (*func)(value))
-{
-    GSList *res = NULL;
-    GSList **current = &res;
-    value cell = list;
-    if (list == Val_unit) return res;
-    Begin_root (cell);
-    while (cell != Val_unit) {
-	*current = g_slist_alloc ();
-	(*current)->data = func(Field(cell,0));
-	cell = Field(cell,1);
-	current = &(*current)->next;
-    }
-    End_roots ();
-    return res;
-}
-*/
-
-value Val_GList (GList *list, value (*func)(gpointer))
-{
-    value new_cell, result, last_cell, cell;
-
-    if (list == NULL) return Val_unit;
-
-    last_cell = cell = Val_unit;
-    result = func(list->data);
-    Begin_roots3 (last_cell, cell, result);
-    cell = last_cell = alloc_small(2,0);
-    Field(cell,0) = result;
-    Field(cell,1) = Val_unit;
-    list = list->next;
-    while (list != NULL) {
-	result = func(list->data);
-	new_cell = alloc_small(2,0);
-	Field(new_cell,0) = result;
-	Field(new_cell,1) = Val_unit;
-	modify(&Field(last_cell,1), new_cell);
-	last_cell = new_cell;
-	list = list->next;
-    }
-    End_roots ();
-    return cell;
-}
-
-GList *GList_val (value list, gpointer (*func)(value))
-{
-    CAMLparam1(list);
-    GList *res = NULL;
-    if (list == Val_unit) CAMLreturn (res);
-    for (; Is_block(list); list = Field(list,1))
-      res = g_list_append (res, func(Field(list,0)));
-    CAMLreturn (res);
-}
-
-static value ml_warning_handler = 0L;
-
-static void ml_warning_wrapper (const gchar *msg)
-{
-    value arg = copy_string ((char*)msg);
-    callback (ml_warning_handler, arg);
-}
-    
-value ml_g_set_warning_handler (value clos)
-{
-    value old_handler = ml_warning_handler ? ml_warning_handler : clos;
-    if (!ml_warning_handler) register_global_root (&ml_warning_handler);
-    g_set_warning_handler (ml_warning_wrapper);
-    ml_warning_handler = clos;
-    return old_handler;
-}
-
-static value ml_print_handler = 0L;
-
-static void ml_print_wrapper (const gchar *msg)
-{
-    value arg = copy_string ((char*)msg);
-    callback (ml_print_handler, arg);
-}
-    
-value ml_g_set_print_handler (value clos)
-{
-    value old_handler = ml_print_handler ? ml_print_handler : clos;
-    if (!ml_print_handler) register_global_root (&ml_print_handler);
-    g_set_print_handler (ml_print_wrapper);
-    ml_print_handler = clos;
-    return old_handler;
-}
-
-value ml_get_null (value unit) { return 0L; }
-
-#define GMainLoop_val(val) ((GMainLoop*)Addr_val(val))
-ML_1 (g_main_new, Bool_val, Val_addr)
-ML_1 (g_main_iteration, Bool_val, Val_bool)
-ML_0 (g_main_pending, Val_bool)
-ML_1 (g_main_is_running, GMainLoop_val, Val_bool)
-ML_1 (g_main_quit, GMainLoop_val, Unit)
-ML_1 (g_main_destroy, GMainLoop_val, Unit)