scx/c/xlib/error.c

#include "xlib.h"
#include <stdio.h>

s48_value scx_enter_error_code(int code) {
  s48_value v =
    S48_SHARED_BINDING_REF(s48_get_imported_binding("scx-error-codes"));
  if (code < S48_VECTOR_LENGTH(v))
    return S48_VECTOR_REF(v, code);
  else
    return s48_enter_integer(code); // Extension Errors
}

s48_value scx_extract_error_code(s48_value code) {
  if (S48_RECORD_P(code)) {
    s48_value t =
      S48_SHARED_BINDING_REF(s48_get_imported_binding("scx-error-code"));
    return s48_extract_integer(s48_checked_record_ref(code, 1, t));
  } else
    return s48_extract_integer(code);
}

s48_value scx_enter_x_error(XErrorEvent* xe) {
  s48_value e = s48_make_record(s48_get_imported_binding("scx-x-error"));
  char s[1024];
  S48_DECLARE_GC_PROTECT(1);
  S48_GC_PROTECT_1(e);

  S48_RECORD_SET(e, 0, scx_enter_display(xe->display));
  S48_RECORD_SET(e, 1, s48_enter_integer(xe->serial));
  S48_RECORD_SET(e, 2, scx_enter_error_code(xe->error_code));
  S48_RECORD_SET(e, 3, s48_enter_integer(xe->request_code));
  S48_RECORD_SET(e, 4, s48_enter_integer(xe->minor_code));
  S48_RECORD_SET(e, 5, s48_enter_integer(xe->resourceid));
  XGetErrorText(xe->display, xe->error_code, s, 1023);
  S48_RECORD_SET(e, 6, s48_enter_string(s));
  
  S48_GC_UNPROTECT();
  return e;
}

void scx_extract_x_error(s48_value e, XErrorEvent* xe) {
  s48_check_record_type(e, s48_get_imported_binding("scx-x-error"));
  xe->type = 1;
  xe->display = scx_extract_display(S48_RECORD_REF(e, 0));
  xe->serial = s48_extract_integer(S48_RECORD_REF(e, 1));
  xe->error_code = scx_extract_error_code(S48_RECORD_REF(e, 2));
  xe->request_code = s48_extract_integer(S48_RECORD_REF(e, 3));
  xe->minor_code = s48_extract_integer(S48_RECORD_REF(e, 4));
  xe->resourceid = s48_extract_integer(S48_RECORD_REF(e, 5));
}

static s48_value internal_error_handler_binding = S48_FALSE;

static int error_handler_wrapper(Display* dpy, XErrorEvent* e) {
  s48_call_scheme(internal_error_handler_binding, 2,
		  scx_enter_display(dpy),
		  scx_enter_x_error(e));
  return 0;
}

s48_value scx_Set_Error_Handler(s48_value fun) {
  s48_value maybe_previous = internal_error_handler_binding;
  int (*previous)() = NULL;
  if (S48_POINTER_P(fun))
    previous = XSetErrorHandler(S48_EXTRACT_POINTER(fun));
  else if (S48_CLOSURE_P(fun)) {
    previous = XSetErrorHandler(&error_handler_wrapper);
    internal_error_handler_binding = fun;
  } // TODO else error
  if (previous == &error_handler_wrapper)
    return maybe_previous;
  else
    return S48_ENTER_POINTER(previous);
}

s48_value scx_Call_C_Error_Handler(s48_value pointer, s48_value display,
				   s48_value event) {
  int (*procedure)() = S48_EXTRACT_POINTER(pointer);
  XErrorEvent ev; int result;
  scx_extract_x_error(event, &ev);
  result = procedure(scx_extract_display(display), &ev);
  return s48_enter_integer(result);
}

s48_value scx_Get_Error_Text(s48_value display, s48_value code) {
  char buf[1024];
  XGetErrorText(scx_extract_display(display), scx_extract_error_code(code),
		buf, 1024);
  buf[1023] = 0;
  return s48_enter_string(buf);
}

s48_value scx_Get_Error_Database_Text(s48_value display, s48_value name,
				      s48_value message, s48_value def) {
  char buf[1024];
  XGetErrorDatabaseText(scx_extract_display(display),
			s48_extract_string(name),
			s48_extract_string(message),
			s48_extract_string(def),
			buf, 1024);
  buf[1023] = 0;
  return s48_enter_string(buf);
}

s48_value internal_x_fatal_error_handler_binding = S48_FALSE;

/* Default error handlers of the Xlib */
extern int _XDefaultIOError();   
extern int _XDefaultError();

static X_Fatal_Error (Display* d) {
  // call the scheme-func internal-x-fatal-error-handler, which does the rest.
  s48_call_scheme(S48_SHARED_BINDING_REF(internal_x_fatal_error_handler_binding),
		  1, scx_enter_display(d));

  // In case the scheme error handler does not exit (or none exists):
  _XDefaultIOError (d);
  // And if event the default handler does not exit:
  exit (1);         
  /*NOTREACHED*/
}

void scx_init_error() {
  S48_GC_PROTECT_GLOBAL(internal_error_handler_binding);
  S48_GC_PROTECT_GLOBAL(internal_x_fatal_error_handler_binding);

  S48_EXPORT_FUNCTION(scx_Set_Error_Handler);
  S48_EXPORT_FUNCTION(scx_Call_C_Error_Handler);
  S48_EXPORT_FUNCTION(scx_Get_Error_Text);
  S48_EXPORT_FUNCTION(scx_Get_Error_Database_Text);
  //S48_EXPORT_FUNCTION(scx_Set_IO_Error_Handler); TODO!

  internal_x_fatal_error_handler_binding =
    s48_get_imported_binding("internal-x-fatal-error-handler");

  (void)XSetIOErrorHandler(X_Fatal_Error);
  //(void)XSetErrorHandler(X_Error);
}