added support for setting debug and error callbacks

[helm.git] / helm / DEVEL / gdome_xslt / ocaml / gdome_xslt / ml_gdome_xslt.c

diff --git a/helm/DEVEL/gdome_xslt/ocaml/gdome_xslt/ml_gdome_xslt.c b/helm/DEVEL/gdome_xslt/ocaml/gdome_xslt/ml_gdome_xslt.c
index b6330868f99077805710a162459e80d38938a921..bc2854a9b890066fec49d49aae7986d3d7248d22 100644 (file)
--- a/helm/DEVEL/gdome_xslt/ocaml/gdome_xslt/ml_gdome_xslt.c
+++ b/helm/DEVEL/gdome_xslt/ocaml/gdome_xslt/ml_gdome_xslt.c
@@ -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>
@@ -141,3 +142,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);
+}
+