From 780cc2f9395c64af64ef33590516d9a06025296b Mon Sep 17 00:00:00 2001 From: frese Date: Wed, 29 Aug 2001 14:54:05 +0000 Subject: [PATCH] implementation for scheme48. --- c/xlib/error.c | 127 ++++++++++++++++++--------------------------- c/xlib/extension.c | 78 ++++++++++++++-------------- c/xlib/grab.c | 4 +- 3 files changed, 91 insertions(+), 118 deletions(-) diff --git a/c/xlib/error.c b/c/xlib/error.c index 084fe72..58ee761 100644 --- a/c/xlib/error.c +++ b/c/xlib/error.c @@ -1,92 +1,67 @@ #include "xlib.h" +#include -static s48_value V_X_Error_Handler, V_X_Fatal_Error_Handler; +s48_value internal_x_error_handler_binding = S48_FALSE; +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 (d) Display *d; { - s48_value args, fun; - S48_DECLARE_GC_PROTECT(1); +static X_Fatal_Error (Display* d) { + //Reset_IO (0); //?? - Reset_IO (0); - args = Make_Display (0, d); - S48_GC_PROTECT_1 (args); - args = s48_cons (args, S48_NULL); - S48_GC_UNPROTECT; - fun = Var_Get (V_X_Fatal_Error_Handler); - if (TYPE(fun) == T_Compound) - (void)Funcall (fun, args, 0); - _XDefaultIOError (d); - exit (1); /* In case the default handler doesn't exit() */ - /*NOTREACHED*/ + // 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*/ } -static X_Error (d, ep) Display *d; XErrorEvent *ep; { - s48_value args, a, fun; - S48_DECLARE_GC_PROTECT(1); +static X_Error(Display* d, XErrorEvent* ep) { + s48_value args = s48_make_vector(7, S48_FALSE); + s48_value a = S48_FALSE, r = S48_FALSE; + int max_s = 1024; + char s[max_s]; + S48_DECLARE_GC_PROTECT(2); - Reset_IO (0); - args = s48_enter_integer ((unsigned long)ep->resourceid); - S48_GC_PROTECT_1 (args); - args = s48_cons (args, S48_NULL); - a = s48_enter_integer (ep->minor_code); - args = s48_cons (a, args); - a = s48_enter_integer (ep->request_code); - args = s48_cons (a, args); - a = Bits_To_Symbols ((unsigned long)ep->error_code, 0, Error_Syms); - if (S48_NULL_P (a)) - a = s48_enter_integer (ep->error_code); - args = s48_cons (a, args); - a = s48_enter_integer (ep->serial); - args = s48_cons (a, args); - a = Make_Display (0, ep->display); - args = s48_cons (a, args); - S48_GC_UNPROTECT; - fun = Var_Get (V_X_Error_Handler); - if (TYPE(fun) == T_Compound) - (void)Funcall (fun, args, 0); - else - _XDefaultError (d, ep); + //Reset_IO (0); //?? + + S48_GC_PROTECT_2(args, a); + S48_VECTOR_SET(args, 0, SCX_ENTER_DISPLAY(d)); + S48_VECTOR_SET(args, 1, s48_enter_integer(ep->serial)); + a = Bit_To_Symbol ((unsigned long)ep->error_code, Error_Syms); + if (S48_NULL_P (a)) + a = s48_enter_integer (ep->error_code); + S48_VECTOR_SET(args, 2, a); + S48_VECTOR_SET(args, 3, s48_enter_integer (ep->request_code)); + S48_VECTOR_SET(args, 4, s48_enter_integer (ep->minor_code)); + S48_VECTOR_SET(args, 5, s48_enter_integer ((unsigned long)ep->resourceid)); + XGetErrorText(d, ep->error_code, s, max_s); + S48_VECTOR_SET(args, 6, s48_enter_string(s)); + + r = s48_call_scheme(S48_SHARED_BINDING_REF(internal_x_error_handler_binding), + 1, args); + + S48_GC_UNPROTECT(); + + if S48_FALSE_P( r ) + _XDefaultError (d, ep); } -static X_After_Function (d) Display *d; { - s48_value args; - S48_DECLARE_GC_PROTECT(1); +void scx_init_error() { + S48_GC_PROTECT_GLOBAL(internal_x_error_handler_binding); + S48_GC_PROTECT_GLOBAL(internal_x_fatal_error_handler_binding); + internal_x_error_handler_binding = + s48_get_imported_binding("internal-x-error-handler"); + internal_x_fatal_error_handler_binding = + s48_get_imported_binding("internal-x-fatal-error-handler"); - args = Make_Display (0, d); - S48_GC_PROTECT_1 (args); - args = s48_cons (args, S48_NULL); - S48_GC_UNPROTECT; - (void)Funcall (DISPLAY(S48_CAR (args))->after, args, 0); -} + (void)XSetIOErrorHandler (X_Fatal_Error); + (void)XSetErrorHandler (X_Error); -static s48_value P_Set_After_Function (d, f) s48_value d, f; { - s48_value old; - - Check_Type (d, T_Display); - if (S48_EQ_P(f, S48_FALSE)) { - (void)XSetAfterFunction (DISPLAY(d)->dpy, (int (*)())0); - } else { - Check_Procedure (f); - (void)XSetAfterFunction (DISPLAY(d)->dpy, X_After_Function); - } - old = DISPLAY(d)->after; - DISPLAY(d)->after = f; - return old; -} - -static s48_value P_After_Function (d) s48_value d; { - Check_Type (d, T_Display); - return DISPLAY(d)->after; -} - -elk_init_xlib_error () { - Define_Variable (&V_X_Fatal_Error_Handler, "x-fatal-error-handler", S48_NULL); - Define_Variable (&V_X_Error_Handler, "x-error-handler", S48_NULL); - (void)XSetIOErrorHandler (X_Fatal_Error); - (void)XSetErrorHandler (X_Error); - Define_Primitive (P_Set_After_Function, "set-after-function!", 2, 2, EVAL); - Define_Primitive (P_After_Function, "after-function", 1, 1, EVAL); } diff --git a/c/xlib/extension.c b/c/xlib/extension.c index 672b4e6..423fde8 100644 --- a/c/xlib/extension.c +++ b/c/xlib/extension.c @@ -1,48 +1,46 @@ #include "xlib.h" -static s48_value P_List_Extensions (d) s48_value d; { - s48_value ret; - int n; - register i; - register char **p; - S48_DECLARE_GC_PROTECT(1); - - Check_Type (d, T_Display); - Disable_Interrupts; - p = XListExtensions (DISPLAY(d)->dpy, &n); - Enable_Interrupts; - ret = s48_make_vector (n, S48_NULL); - S48_GC_PROTECT_1 (ret); - for (i = 0; i < n; i++) { - s48_value e; - - e = Make_String (p[i], strlen (p[i])); - S48_VECTOR_SET(ret, i, e;) - } - S48_GC_UNPROTECT; - XFreeExtensionList (p); - return ret; +s48_value scx_List_Extensions (s48_value d) { + s48_value ret; + int n, i; + char **p; + S48_DECLARE_GC_PROTECT(1); + + //Disable_Interrupts; + p = XListExtensions (SCX_EXTRACT_DISPLAY(d), &n); + //Enable_Interrupts; + ret = s48_make_vector (n, S48_FALSE); + S48_GC_PROTECT_1 (ret); + for (i = 0; i < n; i++) { + S48_VECTOR_SET(ret, i, s48_enter_string(p[i])); + } + S48_GC_UNPROTECT(); + XFreeExtensionList (p); + return ret; } -static s48_value P_Query_Extension (d, name) s48_value d, name; { - int opcode, event, error; - s48_value ret, t; - S48_DECLARE_GC_PROTECT(2); +s48_value scx_Query_Extension (s48_value d, s48_value name) { + int opcode, event, error; + s48_value ret; + S48_DECLARE_GC_PROTECT(1); - Check_Type (d, T_Display); - if (!XQueryExtension (DISPLAY(d)->dpy, Get_Strsym (name), &opcode, - &event, &error)) - return S48_FALSE; - t = ret = P_Make_List (s48_enter_integer (3), S48_NULL); - S48_GC_PROTECT_2 (ret, t); - S48_CAR (t) = (opcode ? s48_enter_integer (opcode) : S48_FALSE); t = S48_CDR (t); - S48_CAR (t) = (event ? s48_enter_integer (event) : S48_FALSE); t = S48_CDR (t); - S48_CAR (t) = (error ? s48_enter_integer (error) : S48_FALSE); - S48_GC_UNPROTECT; - return ret; + if (!XQueryExtension (SCX_EXTRACT_DISPLAY(d), + s48_extract_string(name), + &opcode, &event, &error)) + return S48_FALSE; + + ret = s48_make_vector(3, S48_FALSE); + S48_GC_PROTECT_1(ret); + + S48_VECTOR_SET(ret, 0, opcode ? s48_enter_integer (opcode) : S48_FALSE); + S48_VECTOR_SET(ret, 1, event ? s48_enter_integer (event) : S48_FALSE); + S48_VECTOR_SET(ret, 2, error ? s48_enter_integer (error) : S48_FALSE); + + S48_GC_UNPROTECT(); + return ret; } -elk_init_xlib_extension () { - Define_Primitive (P_List_Extensions, "list-extensions", 1, 1, EVAL); - Define_Primitive (P_Query_Extension, "query-extension", 2, 2, EVAL); +scx_init_extension () { + S48_EXPORT_FUNCTION(scx_List_Extensions); + S48_EXPORT_FUNCTION(scx_Query_Extension); } diff --git a/c/xlib/grab.c b/c/xlib/grab.c index 4c89d1b..6699e2b 100644 --- a/c/xlib/grab.c +++ b/c/xlib/grab.c @@ -131,7 +131,7 @@ s48_value scx_Allow_Events (s48_value Xdpy, s48_value mode, s48_value time){ s48_value scx_Grab_Server (s48_value Xdpy){ - XGravServer(SCX_EXTRACT_DISPLAY(Xdpy)); + XGrabServer(SCX_EXTRACT_DISPLAY(Xdpy)); return S48_UNSPECIFIC; } @@ -150,7 +150,7 @@ void scx_init_grab(void) { S48_EXPORT_FUNCTION(scx_Change_Active_Pointer_Grab); S48_EXPORT_FUNCTION(scx_Grab_Keyboard); S48_EXPORT_FUNCTION(scx_Ungrab_Keyboard); - S48_EXPORT_FUNCITON(scx_Grab_Key); + S48_EXPORT_FUNCTION(scx_Grab_Key); S48_EXPORT_FUNCTION(scx_Ungrab_Key); S48_EXPORT_FUNCTION(scx_Allow_Events); S48_EXPORT_FUNCTION(scx_Grab_Server);