[Scsh-checkins] CVS: scx/c/xlib error.c,1.2,1.3 extension.c,1.2,1.3 grab.c,1.3,1.4

[David Frese <frese@users.sourceforge.net>]

Update of /cvsroot/scsh/scx/c/xlib
In directory usw-pr-cvs1:/tmp/cvs-serv4931

Modified Files:
        error.c extension.c grab.c 
Log Message:
implementation for scheme48.


Index: error.c
===================================================================
RCS file: /cvsroot/scsh/scx/c/xlib/error.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -r1.2 -r1.3
*** error.c     2001/05/14 13:48:37     1.2
--- error.c     2001/08/29 14:54:05     1.3
***************
*** 1,5 ****
  #include "xlib.h"
  
! static s48_value V_X_Error_Handler, V_X_Fatal_Error_Handler;
  
  /* Default error handlers of the Xlib */
--- 1,7 ----
  #include "xlib.h"
+ #include <stdio.h>
  
! 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 */
***************
*** 7,92 ****
  extern int _XDefaultError();
  
! static X_Fatal_Error (d) Display *d; {
!     s48_value args, fun;
!     S48_DECLARE_GC_PROTECT(1);
! 
!     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*/
! }
  
! static X_Error (d, ep) Display *d; XErrorEvent *ep; {
!     s48_value args, a, fun;
!     S48_DECLARE_GC_PROTECT(1);
! 
!     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);
  }
  
! static X_After_Function (d) Display *d; {
!     s48_value args;
!     S48_DECLARE_GC_PROTECT(1);
! 
!     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);
! }
  
! 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);
  }
--- 9,67 ----
  extern int _XDefaultError();
  
! static X_Fatal_Error (Display* d) {
!   //Reset_IO (0); //??
  
!   // 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(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); //??
! 
!   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);
  }
! 
! 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");
! 
!   (void)XSetIOErrorHandler (X_Fatal_Error);
!   (void)XSetErrorHandler (X_Error);
! 
  }

Index: extension.c
===================================================================
RCS file: /cvsroot/scsh/scx/c/xlib/extension.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -r1.2 -r1.3
*** extension.c 2001/05/14 13:48:37     1.2
--- extension.c 2001/08/29 14:54:05     1.3
***************
*** 1,48 ****
  #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;
  }
  
! 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);
! 
!     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;
  }
  
! elk_init_xlib_extension () {
!     Define_Primitive (P_List_Extensions,    "list-extensions",   1, 1, EVAL);
!     Define_Primitive (P_Query_Extension,    "query-extension",   2, 2, EVAL);
  }
--- 1,46 ----
  #include "xlib.h"
  
! 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;
  }
  
! s48_value scx_Query_Extension (s48_value d, s48_value name) {
!   int opcode, event, error;
!   s48_value ret;
!   S48_DECLARE_GC_PROTECT(1);
! 
!   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;
  }
  
! scx_init_extension () {
!   S48_EXPORT_FUNCTION(scx_List_Extensions);
!   S48_EXPORT_FUNCTION(scx_Query_Extension);
  }

Index: grab.c
===================================================================
RCS file: /cvsroot/scsh/scx/c/xlib/grab.c,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -r1.3 -r1.4
*** grab.c      2001/08/22 12:09:56     1.3
--- grab.c      2001/08/29 14:54:05     1.4
***************
*** 132,136 ****
  
  s48_value scx_Grab_Server (s48_value Xdpy){
!   XGravServer(SCX_EXTRACT_DISPLAY(Xdpy));
    return S48_UNSPECIFIC;
  }
--- 132,136 ----
  
  s48_value scx_Grab_Server (s48_value Xdpy){
!   XGrabServer(SCX_EXTRACT_DISPLAY(Xdpy));
    return S48_UNSPECIFIC;
  }
***************
*** 151,155 ****
    S48_EXPORT_FUNCTION(scx_Grab_Keyboard);
    S48_EXPORT_FUNCTION(scx_Ungrab_Keyboard);
!   S48_EXPORT_FUNCITON(scx_Grab_Key);
    S48_EXPORT_FUNCTION(scx_Ungrab_Key);
    S48_EXPORT_FUNCTION(scx_Allow_Events);
--- 151,155 ----
    S48_EXPORT_FUNCTION(scx_Grab_Keyboard);
    S48_EXPORT_FUNCTION(scx_Ungrab_Keyboard);
!   S48_EXPORT_FUNCTION(scx_Grab_Key);
    S48_EXPORT_FUNCTION(scx_Ungrab_Key);
    S48_EXPORT_FUNCTION(scx_Allow_Events);