]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/DEVEL/gdome_xslt/ocaml/gdome_xslt/ml_gdome_xslt.c
ocaml 3.09 transition
[helm.git] / helm / DEVEL / gdome_xslt / ocaml / gdome_xslt / ml_gdome_xslt.c
index b6330868f99077805710a162459e80d38938a921..225698a7900ef6f43617fcd96f3727490792c09f 100644 (file)
@@ -30,6 +30,7 @@
 #include <caml/memory.h>
 #include <caml/custom.h>
 #include <caml/callback.h>
+#include <caml/mlvalues.h>
 
 #include <libxslt/xsltconfig.h>
 #include <libxslt/imports.h>
@@ -115,9 +116,11 @@ value ml_applyStylesheet(value source, value style, value params)
       i+=2;
    }
    c_params[i] = NULL;
+   enter_blocking_section();
    res = applyStylesheet(Document_val(source),
                         XsltStylesheetPtr_val(style),
                         c_params);
+   leave_blocking_section();
    free(c_params);
    if (res == NULL) {
       value* excp;
@@ -141,3 +144,43 @@ value ml_saveResultToChannel(value channel,
        CAMLreturn0;
 }
 
+       /* error callback handling */
+
+static void ml_gdomeXsltErrorCallback(const char *msg) {
+       callback(*caml_named_value("error_callback"), copy_string(msg));
+
+       return;
+}
+
+value ml_enableErrorCallback(value unit) {
+       CAMLparam1(unit);
+       setErrorCallback(ml_gdomeXsltErrorCallback);
+       CAMLreturn(Val_unit);
+}
+
+value ml_disableErrorCallback(value unit) {
+       CAMLparam1(unit);
+       setErrorCallback(NULL);
+       CAMLreturn(Val_unit);
+}
+
+       /* debug callback handling */
+
+static void ml_gdomeXsltDebugCallback(const char *msg) {
+       callback(*caml_named_value("debug_callback"), copy_string(msg));
+
+       return;
+}
+
+value ml_enableDebugCallback(value unit) {
+       CAMLparam1(unit);
+       setDebugCallback(ml_gdomeXsltDebugCallback);
+       CAMLreturn(Val_unit);
+}
+
+value ml_disableDebugCallback(value unit) {
+       CAMLparam1(unit);
+       setDebugCallback(NULL);
+       CAMLreturn(Val_unit);
+}
+