Scheme_Object* scheme_initialize( Scheme_Env * env )
{
DWORD threadID;
Scheme_Env * menv;
Scheme_Small_Object * hotkey_event;
g_native_semaphore = CreateSemaphore( NULL, 0, 500, SEMA_NAME );
CreateThread( NULL, 0, ThreadProc, NULL, 0, &threadID );
menv = scheme_primitive_module( scheme_module_name(), env );
g_hotkey_event_type = scheme_make_type("<system-event>");
hotkey_event = (Scheme_Small_Object*) scheme_malloc( sizeof(Scheme_Small_Object) );
hotkey_event->iso.so.type = g_hotkey_event_type;
hotkey_event->u.int_val = (long)g_native_semaphore;
scheme_register_extension_global( hotkey_event, sizeof(Scheme_Small_Object) );
scheme_add_evt( g_hotkey_event_type,
(Scheme_Ready_Fun) scheme_hotkey_inactive,
(Scheme_Needs_Wakeup_Fun) scheme_hotkey_needs_wakeup,
NULL, 0);
scheme_add_global( "system-events-event", (Scheme_Object*) hotkey_event, menv );
scheme_add_global( "last-system-event",
scheme_make_prim_w_arity( scm_last_system_event, "last-system-event", 0, 0 ),
menv );
scheme_finish_primitive_module( menv );
return scheme_void;
}
static void init_exn_catching_apply()
{
if (!exn_catching_apply) {
char *e =
"(lambda (thunk) "
"(with-handlers ([void (lambda (exn) (cons #f exn))]) "
"(cons #t (thunk))))";
/* make sure we have a namespace with the standard bindings: */
Scheme_Env *env = (Scheme_Env *)scheme_make_namespace(0, NULL);
scheme_register_extension_global(&exn_catching_apply, sizeof(Scheme_Object *));
scheme_register_extension_global(&exn_p, sizeof(Scheme_Object *));
scheme_register_extension_global(&exn_message, sizeof(Scheme_Object *));
exn_catching_apply = scheme_eval_string(e, env);
exn_p = scheme_lookup_global(scheme_intern_symbol("exn?"), env);
exn_message = scheme_lookup_global(scheme_intern_symbol("exn-message"), env);
}
}