diff --git a/c/xlib/client.c b/c/xlib/client.c index 5bb630c..469c83b 100644 --- a/c/xlib/client.c +++ b/c/xlib/client.c @@ -1,13 +1,10 @@ #include "xlib.h" -// TODO -#define scx_raise_status_error(sname, cname) return S48_FALSE - s48_value scx_Iconify_Window(s48_value display, s48_value w, s48_value scr) { if (!XIconifyWindow(scx_extract_display(display), scx_extract_window(w), s48_extract_integer(scr))) - scx_raise_status_error("iconify-window", "XIconifyWindow"); + return S48_FALSE; return S48_UNSPECIFIC; } @@ -15,7 +12,7 @@ s48_value scx_Withdraw_Window(s48_value display, s48_value w, s48_value scr) { if (!XWithdrawWindow(scx_extract_display(display), scx_extract_window(w), s48_extract_integer(scr))) - scx_raise_status_error("withdraw-window", "XWithdrawWindow"); + return S48_FALSE; return S48_UNSPECIFIC; } @@ -28,7 +25,7 @@ s48_value scx_Reconfigure_Wm_Window(s48_value dpy, s48_value w, s48_value scr, scx_extract_window(w), s48_extract_integer(scr), mask, &WC)) - scx_raise_status_error("reconfigure-wm-window", "XReconfigureWMWindow"); + return S48_FALSE; return S48_UNSPECIFIC; } @@ -41,7 +38,7 @@ s48_value scx_Get_Wm_Command(s48_value dpy, s48_value w) { if (!XGetCommand (scx_extract_display(dpy), scx_extract_window(w), &av, &ac)) - scx_raise_status_error("get-wm-command", "XGetCommand"); + return S48_FALSE; S48_GC_PROTECT_1(ret); for (i = ac-1; i >= 0; i--) @@ -72,7 +69,7 @@ s48_value scx_Get_Wm_Protocols(s48_value display, s48_value w) { if (!XGetWMProtocols (scx_extract_display(display), scx_extract_window(w), &p, &n)) - scx_raise_status_error("get-wm-protocols", "XGetWMProtocols"); + return S48_FALSE; S48_GC_PROTECT_1(ret); for (i = n-1; i >= 0; i--) @@ -94,7 +91,7 @@ s48_value scx_Set_Wm_Protocols (s48_value display, s48_value w, s48_value v) { if (!XSetWMProtocols (scx_extract_display(display), scx_extract_window(w), p, n)) - scx_raise_status_error("set-wm-protocols", "XSetWMProtocols"); + return S48_FALSE; return S48_UNSPECIFIC; } @@ -107,7 +104,7 @@ s48_value scx_Get_Wm_Class (s48_value display, s48_value w) { c.res_name = c.res_class = 0; if (!XGetClassHint(scx_extract_display(display), scx_extract_window(w), &c)) - scx_raise_status_error("get-wm-class", "XGetClassHint"); + return S48_FALSE; ret = s48_cons(S48_FALSE, S48_FALSE); S48_GC_PROTECT_1(ret); @@ -188,39 +185,33 @@ void scx_extract_wm_hint_alist(s48_value alist, XWMHints* p) { while (alist != S48_NULL) { int h = scx_extract_wm_hint(S48_CAR(S48_CAR(alist))); s48_value v = S48_CDR(S48_CAR(alist)); - switch (h) { - case 0: - p->flags |= InputHint; + p->flags |= (1L << h); + switch (1L << h) { + case InputHint: p->input = S48_EXTRACT_BOOLEAN(v); break; - case 1: - p->flags |= StateHint; + case StateHint: p->initial_state = scx_extract_initial_state(v); break; - case 2: - p->flags |= IconPixmapHint; + case IconPixmapHint: p->icon_pixmap = scx_extract_pixmap(v); break; - case 3: - p->flags |= IconWindowHint; + case IconWindowHint: p->icon_window = scx_extract_window(v); break; - case 4: - p->flags |= IconPositionHint; + case IconPositionHint: p->icon_x = s48_extract_integer(S48_CAR(v)); p->icon_y = s48_extract_integer(S48_CDR(v)); break; - case 5: - p->flags |= IconMaskHint; + case IconMaskHint: p->icon_mask = scx_extract_pixmap(v); break; - case 6: - p->flags |= WindowGroupHint; + case WindowGroupHint: p->window_group = scx_extract_window(v); break; - case 7: - if (S48_EXTRACT_BOOLEAN(v)) - p->flags |= XUrgencyHint; + case XUrgencyHint: + if (v == S48_FALSE) + p->flags &= ~XUrgencyHint; break; } alist = S48_CDR(alist); @@ -237,7 +228,7 @@ s48_value scx_Get_Wm_Hints(s48_value dpy, s48_value w) { res = scx_enter_wm_hint_alist(p); XFree(p); } else - scx_raise_status_error("get-wm-hints", "XGetWMHints"); + return S48_FALSE; return res; } @@ -255,7 +246,7 @@ s48_value scx_Get_Transient_For(s48_value dpy, s48_value w) { if (!XGetTransientForHint(scx_extract_display(dpy), scx_extract_window(w), &win)) - scx_raise_status_error("get-transient-for", "XGetTransientForHint"); + return S48_FALSE; return scx_enter_window(win); } @@ -273,7 +264,7 @@ s48_value scx_Get_Text_Property(s48_value dpy, s48_value w, s48_value a) { scx_extract_window(w), &ret, scx_extract_atom(a))) - scx_raise_status_error("get-text-property", "XGetTextProperty"); + return S48_FALSE; res = scx_enter_property(ret.encoding, ret.format, ret.value, ret.nitems); XFree(ret.value); return res; @@ -397,7 +388,7 @@ s48_value scx_Get_Wm_Normal_Hints(s48_value dpy, s48_value win) { if (!XGetWMNormalHints(scx_extract_display(dpy), scx_extract_window(win), &SH, &supplied_by_user)) - scx_raise_status_error("get-wm-normal-hints", "XGetWMNormalHints"); + return S48_FALSE; // ignoring supplied_by_user ... ?! return scx_enter_size_hint_alist(&SH); } @@ -446,7 +437,7 @@ s48_value scx_Get_Icon_Sizes(s48_value dpy, s48_value w) { if (!XGetIconSizes (scx_extract_display(dpy), scx_extract_window(w), &p, &n)) - scx_raise_status_error("get-icon-sizes", "XGetIconSizes"); + return S48_FALSE; S48_GC_PROTECT_1(v); for (i = n-1; i >= 0; i--) diff --git a/c/xlib/display.c b/c/xlib/display.c index ab7e7c1..316d4f1 100644 --- a/c/xlib/display.c +++ b/c/xlib/display.c @@ -14,30 +14,35 @@ s48_value scx_enter_screenformat(ScreenFormat* sf) { return res; } +s48_value scx_screen_list = S48_NULL; + s48_value scx_enter_screen(Screen* scr) { - s48_value s = s48_make_record(scx_screen); - S48_DECLARE_GC_PROTECT(1); - S48_GC_PROTECT_1(s); - S48_RECORD_SET(s, 0, s48_enter_integer((long)scr)); - S48_RECORD_SET(s, 1, scx_enter_display(DisplayOfScreen(scr))); - S48_RECORD_SET(s, 2, scx_enter_window(RootWindowOfScreen(scr))); - S48_RECORD_SET(s, 3, s48_enter_integer(WidthOfScreen(scr))); - S48_RECORD_SET(s, 4, s48_enter_integer(HeightOfScreen(scr))); - S48_RECORD_SET(s, 5, s48_enter_integer(WidthMMOfScreen(scr))); - S48_RECORD_SET(s, 6, s48_enter_integer(HeightMMOfScreen(scr))); - S48_RECORD_SET(s, 7, S48_FALSE); // TODO depths - S48_RECORD_SET(s, 8, s48_enter_integer(DefaultDepthOfScreen(scr))); - S48_RECORD_SET(s, 9, scx_enter_visual(DefaultVisualOfScreen(scr))); - S48_RECORD_SET(s, 10, scx_enter_gc(DefaultGCOfScreen(scr))); - S48_RECORD_SET(s, 11, scx_enter_colormap(DefaultColormapOfScreen(scr))); - S48_RECORD_SET(s, 12, scx_enter_pixel(BlackPixelOfScreen(scr))); - S48_RECORD_SET(s, 13, scx_enter_pixel(WhitePixelOfScreen(scr))); - S48_RECORD_SET(s, 14, s48_enter_integer(MinCmapsOfScreen(scr))); - S48_RECORD_SET(s, 15, s48_enter_integer(MaxCmapsOfScreen(scr))); - S48_RECORD_SET(s, 16, scx_enter_backing_store(DoesBackingStore(scr))); - S48_RECORD_SET(s, 17, S48_ENTER_BOOLEAN(DoesSaveUnders(scr))); - S48_RECORD_SET(s, 18, scx_enter_event_mask(EventMaskOfScreen(scr))); - S48_GC_UNPROTECT(); + s48_value s = scx_struct_cache_ref(scr, scx_screen_list); + if (s == S48_FALSE) { + S48_DECLARE_GC_PROTECT(1); + s = s48_make_record(scx_screen); + S48_GC_PROTECT_1(s); + S48_RECORD_SET(s, 0, s48_enter_integer((long)scr)); + S48_RECORD_SET(s, 1, scx_enter_display(DisplayOfScreen(scr))); + S48_RECORD_SET(s, 2, scx_enter_window(RootWindowOfScreen(scr))); + S48_RECORD_SET(s, 3, s48_enter_integer(WidthOfScreen(scr))); + S48_RECORD_SET(s, 4, s48_enter_integer(HeightOfScreen(scr))); + S48_RECORD_SET(s, 5, s48_enter_integer(WidthMMOfScreen(scr))); + S48_RECORD_SET(s, 6, s48_enter_integer(HeightMMOfScreen(scr))); + S48_RECORD_SET(s, 7, s48_enter_integer(XScreenNumberOfScreen(scr))); + S48_RECORD_SET(s, 8, s48_enter_integer(DefaultDepthOfScreen(scr))); + S48_RECORD_SET(s, 9, scx_enter_visual(DefaultVisualOfScreen(scr))); + S48_RECORD_SET(s, 10, scx_enter_gc(DefaultGCOfScreen(scr))); + S48_RECORD_SET(s, 11, scx_enter_colormap(DefaultColormapOfScreen(scr))); + S48_RECORD_SET(s, 12, scx_enter_pixel(BlackPixelOfScreen(scr))); + S48_RECORD_SET(s, 13, scx_enter_pixel(WhitePixelOfScreen(scr))); + S48_RECORD_SET(s, 14, s48_enter_integer(MinCmapsOfScreen(scr))); + S48_RECORD_SET(s, 15, s48_enter_integer(MaxCmapsOfScreen(scr))); + S48_RECORD_SET(s, 16, scx_enter_backing_store(DoesBackingStore(scr))); + S48_RECORD_SET(s, 17, S48_ENTER_BOOLEAN(DoesSaveUnders(scr))); + S48_RECORD_SET(s, 18, scx_enter_event_mask(EventMaskOfScreen(scr))); + S48_GC_UNPROTECT(); + } return s; } @@ -74,7 +79,8 @@ s48_value scx_enter_display(Display* dpy) { S48_RECORD_SET(d, 9, s48_enter_integer(VendorRelease(dpy))); S48_RECORD_SET(d, 10, s48_enter_integer(QLength(dpy))); S48_RECORD_SET(d, 11, s48_enter_string(DisplayString(dpy))); - S48_RECORD_SET(d, 12, s48_enter_integer(DefaultScreen(dpy))); + S48_RECORD_SET(d, 12, + scx_enter_screen(ScreenOfDisplay(dpy, DefaultScreen(dpy)))); for (i = ScreenCount(dpy)-1; i >= 0; i--) l = s48_cons(scx_enter_screen(ScreenOfDisplay(dpy, i)), l); S48_RECORD_SET(d, 13, l); @@ -135,6 +141,7 @@ s48_value scx_Display_Select_Input(s48_value display, s48_value window, void scx_init_display(void) { S48_GC_PROTECT_GLOBAL(scx_display_list); + S48_GC_PROTECT_GLOBAL(scx_screen_list); S48_EXPORT_FUNCTION(scx_Open_Display); S48_EXPORT_FUNCTION(scx_Close_Display); diff --git a/c/xlib/error.c b/c/xlib/error.c index 172969a..0fe1c7a 100644 --- a/c/xlib/error.c +++ b/c/xlib/error.c @@ -49,15 +49,25 @@ void scx_extract_x_error(s48_value e, XErrorEvent* xe) { xe->resourceid = s48_extract_integer(S48_RECORD_REF(e, 5)); } -static s48_value internal_error_handler_binding = S48_FALSE; +/* Default error handlers of the Xlib */ +extern int _XDefaultIOError(); +extern int _XDefaultError(); + +static s48_value internal_x_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)); + if ((internal_x_error_handler_binding != S48_FALSE) && + (S48_SHARED_BINDING_REF(internal_x_error_handler_binding) != S48_FALSE)) + s48_call_scheme(S48_SHARED_BINDING_REF(internal_x_error_handler_binding), + 2, + scx_enter_display(dpy), + scx_enter_x_error(e)); + else + _XDefaultError(dpy, e); return 0; } +/* s48_value scx_Set_Error_Handler(s48_value fun) { s48_value maybe_previous = internal_error_handler_binding; int (*previous)() = NULL; @@ -81,6 +91,7 @@ s48_value scx_Call_C_Error_Handler(s48_value pointer, s48_value display, 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]; @@ -104,35 +115,37 @@ s48_value scx_Get_Error_Database_Text(s48_value display, s48_value name, 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) { +static int fatal_error_handler_wrapper(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)); - + if ((internal_x_fatal_error_handler_binding != S48_FALSE) && + (S48_SHARED_BINDING_REF(internal_x_fatal_error_handler_binding) + != S48_FALSE)) + 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); + // And if even the default handler does not exit: + exit(1); /*NOTREACHED*/ + return 0; } void scx_init_error() { - S48_GC_PROTECT_GLOBAL(internal_error_handler_binding); + S48_GC_PROTECT_GLOBAL(internal_x_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_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! + //S48_EXPORT_FUNCTION(scx_Set_IO_Error_Handler); internal_x_fatal_error_handler_binding = s48_get_imported_binding("internal-x-fatal-error-handler"); + internal_x_error_handler_binding = + s48_get_imported_binding("internal-x-error-handler"); - (void)XSetIOErrorHandler(X_Fatal_Error); - //(void)XSetErrorHandler(X_Error); + (void)XSetIOErrorHandler(fatal_error_handler_wrapper); + (void)XSetErrorHandler(error_handler_wrapper); } diff --git a/c/xlib/event-types.c b/c/xlib/event-types.c index 357e85f..39d0408 100644 --- a/c/xlib/event-types.c +++ b/c/xlib/event-types.c @@ -14,6 +14,7 @@ EENTER(3, display, scx_enter_display); #define EENTER_END() \ + S48_GC_UNPROTECT(); \ return e s48_value scx_enter_key_event(XKeyEvent* xe) { diff --git a/c/xlib/gcontext.c b/c/xlib/gcontext.c index 1e7c783..53d09a8 100644 --- a/c/xlib/gcontext.c +++ b/c/xlib/gcontext.c @@ -98,8 +98,8 @@ unsigned long scx_extract_gc_value_alist(s48_value values, XGCValues* GCV) { int mv = scx_extract_gc_value(S48_CAR(S48_CAR(values))); s48_value v = S48_CDR(S48_CAR(values)); values = S48_CDR(values); - mask = mask | mv; - switch (mv) { + mask = mask | (1L << mv); + switch (1L << mv) { case GCFunction: GCV->function = scx_extract_gc_function(v); break; case GCPlaneMask: @@ -158,7 +158,7 @@ static s48_value scx_enter_gc_value_alist(s48_value values, XGCValues* GCV) { S48_GC_PROTECT_3(res, v, values); while (values != S48_NULL) { int mv = scx_extract_gc_value(S48_CAR(values)); - switch (mv) { + switch (1L << mv) { case GCFunction: v = scx_extract_gc_function(GCV->function); break; case GCPlaneMask: @@ -234,7 +234,7 @@ s48_value scx_Copy_Gc(s48_value display, s48_value source, s48_value mask, s48_value scx_Change_Gc(s48_value display, s48_value gc, s48_value values) { XGCValues GCV; unsigned long mask = scx_extract_gc_value_alist(values, &GCV); - XChangeGC(scx_extract_display(display), scx_extract_gc(gc), + XChangeGC(scx_extract_display(display), scx_extract_gc(gc), mask, &GCV); return S48_UNSPECIFIC; } @@ -252,7 +252,7 @@ s48_value scx_Get_Gc_Values(s48_value display, s48_value gc, unsigned long mask = 0; XGCValues GCV; for (; values != S48_NULL; values = S48_CDR(values)) - mask |= scx_extract_gc_value(S48_CAR(values)); + mask |= (1L << scx_extract_gc_value(S48_CAR(values))); if (!XGetGCValues(scx_extract_display(display), scx_extract_gc(gc), diff --git a/c/xlib/types.c b/c/xlib/types.c index aa4be82..b55920c 100644 --- a/c/xlib/types.c +++ b/c/xlib/types.c @@ -39,23 +39,26 @@ s48_value scx_struct_cache_ref(void* cpointer, s48_value list) { void scx_struct_cache_set(void* cpointer, s48_value* l, s48_value v) { s48_value list = *l; - s48_value wp = S48_FALSE; - S48_DECLARE_GC_PROTECT(2); + s48_value previous = S48_FALSE; + s48_value pair = S48_FALSE; + S48_DECLARE_GC_PROTECT(3); + S48_GC_PROTECT_3(list, pair, previous); + + // create the new entry + pair = s48_make_weak_pointer(v); + pair = s48_cons(S48_ENTER_POINTER(cpointer), pair); + *l = s48_cons(pair, *l); + previous = *l; + + // remove all empty and duplicate entries while (list != S48_NULL) { - if (S48_EXTRACT_POINTER(S48_CAR(S48_CAR(list))) == cpointer) { - S48_GC_PROTECT_1(list); - wp = s48_make_weak_pointer(v); - S48_SET_CDR(S48_CAR(list), wp); - S48_GC_UNPROTECT(); - return; - } + s48_value entry = S48_WEAK_POINTER_REF(S48_CDR(S48_CAR(list))); + if ((entry == S48_FALSE) || (S48_EXTRACT_POINTER(entry) == cpointer)) + S48_SET_CDR(previous, S48_CDR(list)); + else + previous = list; list = S48_CDR(list); } - S48_GC_PROTECT_2(list, wp); - // TODO: if not found, use first free entry to keep list small... - wp = s48_make_weak_pointer(v); - wp = s48_cons(S48_ENTER_POINTER(cpointer), wp); - *l = s48_cons(wp, *l); S48_GC_UNPROTECT(); } diff --git a/c/xlib/window.c b/c/xlib/window.c index 8c543a8..7efb97e 100644 --- a/c/xlib/window.c +++ b/c/xlib/window.c @@ -2,16 +2,19 @@ #include "xlib.h" +#define scx_extract_set_window_attribute(x) \ + S48_EXTRACT_ENUM(x, "scx-set-window-attribute") + static unsigned long scx_extract_set_window_attribute_alist(s48_value attribs, XSetWindowAttributes* Xattrs) { unsigned long mask = 0; while (attribs != S48_NULL) { - int mv = scx_extract_gc_value(S48_CAR(S48_CAR(attribs))); + int mv = scx_extract_set_window_attribute(S48_CAR(S48_CAR(attribs))); s48_value v = S48_CDR(S48_CAR(attribs)); attribs = S48_CDR(attribs); - mask = mask | mv; - switch (mv) { + mask = mask | (1L << mv); + switch (1L << mv) { case CWBackPixmap: Xattrs->background_pixmap = scx_extract_pixmap(v); break; case CWBackPixel: @@ -93,7 +96,6 @@ s48_value scx_Change_Window_Attributes(s48_value display, s48_value window, XSetWindowAttributes Xattrs; unsigned long mask = scx_extract_set_window_attribute_alist(attribs, &Xattrs); - XChangeWindowAttributes(scx_extract_display(display), scx_extract_window(window), mask, &Xattrs); @@ -151,8 +153,8 @@ unsigned long scx_extract_window_changes(s48_value changes, int mv = scx_extract_window_change(S48_CAR(S48_CAR(changes))); s48_value v = S48_CDR(S48_CAR(changes)); changes = S48_CDR(changes); - mask = mask | mv; - switch (mv) { + mask = mask | (1L << mv); + switch (1L << mv) { case CWX: WC->x = s48_extract_integer(v); break; case CWY: diff --git a/c/xlib/xlib.h b/c/xlib/xlib.h index b89deca..d5e49d2 100644 --- a/c/xlib/xlib.h +++ b/c/xlib/xlib.h @@ -37,14 +37,16 @@ extern int s48_list_length(s48_value list); #define S48_EXTRACT_ENUM(x, typestr) \ s48_extract_integer(s48_checked_record_ref(x, 1, \ - S48_SHARED_BINDING_REF(s48_get_imported_binding(typestr)))) + s48_get_imported_binding(typestr))) +// S48_SHARED_BINDING_REF(s48_get_imported_binding(typestr)))) #define S48_ENTER_ENUM(index, vvectorstr) \ S48_VECTOR_REF(S48_SHARED_BINDING_REF(s48_get_imported_binding(vvectorstr)),\ index) #define S48_EXTRACT_ENUM_SET(x, typestr) \ s48_extract_integer(s48_checked_record_ref(x, 1, \ - S48_SHARED_BINDING_REF(s48_get_imported_binding(typestr)))) + s48_get_imported_binding("s48-enum-set-type"))) +// TODO check type in record-field 0 extern s48_value s48_enter_enum_set(unsigned long v, char* typestr); // *** Extraction-Macros for the XIDs ******************************** diff --git a/scheme/xlib/client.scm b/scheme/xlib/client.scm index 769f671..22c0e18 100644 --- a/scheme/xlib/client.scm +++ b/scheme/xlib/client.scm @@ -4,7 +4,7 @@ ;; format), to the root window of the specified screen. See ;; XIconifyWindow. -;; raises scx-status-error on error. +;; returns #f on error. (import-lambda-definition iconify-window (display window screen-num) "scx_Iconify_Window") @@ -12,7 +12,7 @@ ;; UnmapNotify event to the root window of the specified screen. See ;; XWithdrawWindow. -;; raises scx-status-error on error. +;; returns #f on error. (import-lambda-definition withdraw-window (display window scr-num) "scx_Withdraw_Window") @@ -21,7 +21,7 @@ ;; the root window if that fails. See XReconfigureWMWindow. See ;; configure-window. -;; raises scx-status-error on error. +;; returns #f on error. (import-lambda-definition reconfigure-wm-window (display window scr-num changes) "scx_Reconfigure_Wm_Window") @@ -31,7 +31,7 @@ ;; get-wm-command reads the WM_COMMAND property from the specified ;; window and returns it as a list of strings. See XGetCommand. -;; raises scx-status-error on error. +;; returns #f on error. (import-lambda-definition get-wm-command (display window) "scx_Get_Wm_Command") @@ -48,28 +48,28 @@ ;; window manager protocols in which the owner of this window is ;; willing to participate. See XGetWMProtocols. -;; raises scx-status-error on error. +;; returns #f on error. (import-lambda-definition get-wm-protocols (display window) "scx_Get_Wm_Protocols") ;; set-wm-protocols! sets the WM_PROTOCOLS property of the specified ;; window. protocols has to be a list of atoms. See XSetWMProtocols. -;; raises scx-status-error on error. +;; returns #f on error. (import-lambda-definition set-wm-protocols! (display window protocols) "scx_Set_Wm_Protocols") ;; get-wm-class returns the class hint for the specified window. That ;; is a pair of strings (name . class) See XGetClassHint. -;; raises scx-status-error on error. +;; returns #f on error. (import-lambda-definition get-wm-class (display window) "scx_Get_Wm_Class") ;; set-wm-class! sets the class hint for the specified window. See ;; XSetClassHint. -;; raises scx-status-error on error. +;; returns #f on error. (import-lambda-definition set-wm-class! (display window name class) "scx_Set_Wm_Class") @@ -146,7 +146,7 @@ (define xa-string 31) ;; defined in Xatom.h (define (string-list->property strings) - (make-property xa-string 8 + (make-property xa-string (property-format char) (string-list->string strings))) ;; The following function a wrappers for the get/set-text-property @@ -156,23 +156,23 @@ (define xa-wm-icon-name 37) (define xa-wm-client-machine 36) -(define (get-wm-name w) - (get-text-property w xa-wm-name)) +(define (get-wm-name display w) + (get-text-property display w xa-wm-name)) -(define (get-wm-icon-name w) - (get-text-property w xa-wm-icon-name)) +(define (get-wm-icon-name display w) + (get-text-property display w xa-wm-icon-name)) -(define (get-wm-client-machine w) - (get-text-property w xa-wm-client-machine)) +(define (get-wm-client-machine display w) + (get-text-property display w xa-wm-client-machine)) -(define (set-wm-name! w s) - (set-text-property! w s xa-wm-name)) +(define (set-wm-name! display w s) + (set-text-property! display w s xa-wm-name)) -(define (set-wm-icon-name! w s) - (set-text-property! w s xa-wm-icon-name)) +(define (set-wm-icon-name! display w s) + (set-text-property! display w s xa-wm-icon-name)) -(define (set-wm-client-machine! w s) - (set-text-property! w s xa-wm-client-machine)) +(define (set-wm-client-machine! display w s) + (set-text-property! display w s xa-wm-client-machine)) ;; an enumerated type for XSizeHints used by get-wm-normal-hints and ;; set-wm-normal-hints! diff --git a/scheme/xlib/colormap.scm b/scheme/xlib/colormap.scm index 1e8660c..a3aa80e 100644 --- a/scheme/xlib/colormap.scm +++ b/scheme/xlib/colormap.scm @@ -8,6 +8,8 @@ (green color:green set-color:green!) (blue color:blue set-color:blue!)) +(define-exported-binding "scx-color" :color) + (define-enumerated-type colormap-state :colormap-state colormap-state? colormap-states colormap-state-name colormap-state-index (uninstalled installed)) diff --git a/scheme/xlib/display.scm b/scheme/xlib/display.scm index 063bc99..c927c95 100644 --- a/scheme/xlib/display.scm +++ b/scheme/xlib/display.scm @@ -53,9 +53,10 @@ (define-record-type screen :screen (make-screen cpointer display root-window width height width-mm - height-mm depths root-depth default-visual default-gc + height-mm number root-depth default-visual default-gc default-colormap white-pixel black-pixel max-maps min-maps does-backing-store does-save-unders? event-mask) + ;; maybe add depths ?? (TODO) ;; does event-mask change ?? (TODO) screen? (cpointer screen:cpointer) @@ -65,7 +66,7 @@ (height screen:height) (width-mm screen:width-mm) (height-mm screen:height-mm) - (depths screen:depths) + (number screen:number) (root-depth screen:root-depth) (default-visual screen:default-visual) (default-gc screen:default-gc) @@ -113,8 +114,6 @@ (define no-symbol 0) (define all-planes (- (arithmetic-shift 1 32) 1)) -;; *** record types ************************************************** - (import-lambda-definition display:last-request-read (display) "scx_Display_Last_Request_Read") @@ -124,6 +123,14 @@ (screen:root-window (list-ref (display:screens display) (display:default-screen display)))) +(define (black-pixel display) + (screen:black-pixel (list-ref (display:screens display) + (display:default-screen display)))) + +(define (white-pixel display) + (screen:white-pixel (list-ref (display:screens display) + (display:default-screen display)))) + (import-lambda-definition next-request (display) "scx_Next_Request") diff --git a/scheme/xlib/error.scm b/scheme/xlib/error.scm index 541619e..722c5d6 100644 --- a/scheme/xlib/error.scm +++ b/scheme/xlib/error.scm @@ -26,11 +26,148 @@ ;; *** error exceptions ********************************************** -;; Call synchronize to have the exceptions signaled where they belong to. +(define (opcode->string oc) + (case oc + ((1) "X_CreateWindow") + ((2) "X_ChangeWindowAttributes") + ((3) "X_GetWindowAttributes") + ((4) "X_DestroyWindow") + ((5) "X_DestroySubwindows") + ((6) "X_ChangeSaveSet") + ((7) "X_ReparentWindow") + ((8) "X_MapWindow") + ((9) "X_MapSubwindows") + ((10) "X_UnmapWindow") + ((11) "X_UnmapSubwindows") + ((12) "X_ConfigureWindow") + ((13) "X_CirculateWindow") + ((14) "X_GetGeometry") + ((15) "X_QueryTree") + ((16) "X_InternAtom") + ((17) "X_GetAtomName") + ((18) "X_ChangeProperty") + ((19) "X_DeleteProperty") + ((20) "X_GetProperty") + ((21) "X_ListProperties") + ((22) "X_SetSelectionOwner") + ((23) "X_GetSelectionOwner") + ((24) "X_ConvertSelection") + ((25) "X_SendEvent") + ((26) "X_GrabPointer") + ((27) "X_UngrabPointer") + ((28) "X_GrabButton") + ((29) "X_UngrabButton") + ((30) "X_ChangeActivePointerGrab") + ((31) "X_GrabKeyboard") + ((32) "X_UngrabKeyboard") + ((33) "X_GrabKey") + ((34) "X_UngrabKey") + ((35) "X_AllowEvents") + ((36) "X_GrabServer") + ((37) "X_UngrabServer") + ((38) "X_QueryPointer") + ((39) "X_GetMotionEvents") + ((40) "X_TranslateCoords") + ((41) "X_WarpPointer") + ((42) "X_SetInputFocus") + ((43) "X_GetInputFocus") + ((44) "X_QueryKeymap") + ((45) "X_OpenFont") + ((46) "X_CloseFont") + ((47) "X_QueryFont") + ((48) "X_QueryTextExtents") + ((49) "X_ListFonts") + ((50) "X_ListFontsWithInfo") + ((51) "X_SetFontPath") + ((52) "X_GetFontPath") + ((53) "X_CreatePixmap") + ((54) "X_FreePixmap") + ((55) "X_CreateGC") + ((56) "X_ChangeGC") + ((57) "X_CopyGC") + ((58) "X_SetDashes") + ((59) "X_SetClipRectangles") + ((60) "X_FreeGC") + ((61) "X_ClearArea") + ((62) "X_CopyArea") + ((63) "X_CopyPlane") + ((64) "X_PolyPoint") + ((65) "X_PolyLine") + ((66) "X_PolySegment") + ((67) "X_PolyRectangle") + ((68) "X_PolyArc") + ((69) "X_FillPoly") + ((70) "X_PolyFillRectangle") + ((71) "X_PolyFillArc") + ((72) "X_PutImage") + ((73) "X_GetImage") + ((74) "X_PolyText8") + ((75) "X_PolyText16") + ((76) "X_ImageText8") + ((77) "X_ImageText16") + ((78) "X_CreateColormap") + ((79) "X_FreeColormap") + ((80) "X_CopyColormapAndFree") + ((81) "X_InstallColormap") + ((82) "X_UninstallColormap") + ((83) "X_ListInstalledColormaps") + ((84) "X_AllocColor") + ((85) "X_AllocNamedColor") + ((86) "X_AllocColorCells") + ((87) "X_AllocColorPlanes") + ((88) "X_FreeColors") + ((89) "X_StoreColors") + ((90) "X_StoreNamedColor") + ((91) "X_QueryColors") + ((92) "X_LookupColor") + ((93) "X_CreateCursor") + ((94) "X_CreateGlyphCursor") + ((95) "X_FreeCursor") + ((96) "X_RecolorCursor") + ((97) "X_QueryBestSize") + ((98) "X_QueryExtension") + ((99) "X_ListExtensions") + ((100) "X_ChangeKeyboardMapping") + ((101) "X_GetKeyboardMapping") + ((102) "X_ChangeKeyboardControl") + ((103) "X_GetKeyboardControl") + ((104) "X_Bell") + ((105) "X_ChangePointerControl") + ((106) "X_GetPointerControl") + ((107) "X_SetScreenSaver") + ((108) "X_GetScreenSaver") + ((109) "X_ChangeHosts") + ((110) "X_ListHosts") + ((111) "X_SetAccessControl") + ((112) "X_SetCloseDownMode") + ((113) "X_KillClient") + ((114) "X_RotateProperties") + ((115) "X_ForceScreenSaver") + ((116) "X_SetPointerMapping") + ((117) "X_GetPointerMapping") + ((118) "X_SetModifierMapping") + ((119) "X_GetModifierMapping") + ((127) "X_NoOperation") + (else "unknown"))) -(define (use-x-error-exceptions!) +(define (x-error->string e) + (string-append (x-error:text e) "\n" + " Major Opcode: " (number->string (x-error:major-opcode e)) + " (" (opcode->string (x-error:major-opcode e)) ")\n" + " Resource ID: " (number->string (x-error:resource-id e)))) + +(define-condition-type 'x-warning '(warning)) +(define x-warning? (condition-predicate 'x-warning)) +(define (x-warning:x-error w) + (cadr (condition-stuff w))) +(define (signal-x-warning x-error) + (signal 'x-warning (x-error->string x-error) x-error)) + +;; Call synchronize to have the warnings signaled where they belong to. + +(define (use-x-error-warnings!) (set-error-handler! (lambda (display error) - (error "x-exception: " display error)))) ;; TODO + (signal-x-warning error)))) ;; *** error-queue *************************************************** @@ -73,17 +210,25 @@ ;; *** default error handlers **************************************** -(import-lambda-definition %set-error-handler (handler) - "scx_Set_Error_Handler") - -(import-lambda-definition call-c-error-handler (pointer display event) - "scx_Call_C_Error_Handler") +(define *x-error-handler* #f) +(define-exported-binding "internal-x-error-handler" *x-error-handler*) (define (set-error-handler! handler) - (let ((res (%set-error-handler handler))) - (if (number? res) - (lambda (display event) (call-c-error-handler (res display event))) - res))) + (let ((old-handler *x-error-handler*)) + (set! *x-error-handler* handler) + old-handler)) + +;(import-lambda-definition %set-error-handler (handler) +; "scx_Set_Error_Handler") + +;(import-lambda-definition call-c-error-handler (pointer display event) +; "scx_Call_C_Error_Handler") + +;(define (set-error-handler! handler) +; (let ((res (%set-error-handler handler))) +; (if (number? res) +; (lambda (display event) (call-c-error-handler (res display event))) +; res))) (import-lambda-definition get-error-text (display code) "scx_Get_Error_Text") @@ -95,14 +240,15 @@ ;(import-lambda-definition %set-io-error-handler (handler) ; "scx_Set_IO_Error_Handler") -(define *x-fatal-error-handler* ;; TODO do it like above?? - (lambda (display) - #f)) - +(define *x-fatal-error-handler* #f) (define-exported-binding "internal-x-fatal-error-handler" *x-fatal-error-handler*) -(define (set-io-error-handler handler) +(define (set-fatal-error-handler! handler) (let ((old-handler *x-fatal-error-handler*)) (set! *x-fatal-error-handler* handler) old-handler)) + +;; *** The default is to use warnings ******************************** + +(use-x-error-warnings!) diff --git a/scheme/xlib/event.scm b/scheme/xlib/event.scm index baada70..0a15cd4 100644 --- a/scheme/xlib/event.scm +++ b/scheme/xlib/event.scm @@ -8,20 +8,28 @@ (block-on-message-inport dpy)) (next-event dpy)) -(define (block-on-message-inport dpy) ; needs ports, locks +(define (block-on-message-inport dpy) (let ((port (display-message-inport dpy))) - (disable-interrupts!) - (if (not (char-ready? port)) - (begin - (obtain-lock (port-lock port)) - (add-pending-channel (port->channel port)) - (wait-for-channel (port->channel port)) ;; enables interrupts - (release-lock (port-lock port))) - (enable-interrupts!)))) + (call-with-values + (lambda () (select (vector port) (vector) (vector))) + (lambda (ready-read ready-write ex) + (if (not (member port (vector->list ready-read))) + (block-on-message-inport dpy)))))) -;;; Only here until scsh provides us with select -(import-lambda-definition add-pending-channel (channel) - "scx_add_pending_channel") +;(define (block-on-message-inport dpy) ; needs ports, locks +; (let ((port (display-message-inport dpy))) +; (disable-interrupts!) +; (if (not (char-ready? port)) +; (begin +; (obtain-lock (port-lock port)) +; (add-pending-channel (port->channel port)) +; (wait-for-channel (port->channel port)) ;; enables interrupts +; (release-lock (port-lock port))) +; (enable-interrupts!)))) + +;;;; Only here until scsh provides us with select +;(import-lambda-definition add-pending-channel (channel) +; "scx_add_pending_channel") ;; How to find out if there are events available ********************* diff --git a/scheme/xlib/sync-event.scm b/scheme/xlib/sync-event.scm index 1400c09..2b94976 100644 --- a/scheme/xlib/sync-event.scm +++ b/scheme/xlib/sync-event.scm @@ -1,3 +1,11 @@ +(define (with-lock lock thunk) + (obtain-lock lock) + (let ((res (thunk))) + (release-lock lock) + res)) + +;; Thread-safe event queue ******************************************* + (define-record-type sync-x-event :sync-x-event (really-make-sync-x-event event next) sync-x-event? @@ -18,15 +26,206 @@ (really-next-sync-x-event sync-x-event) next-sync-x-event)) -(define (init-sync-x-events dpy) - (let ((most-recent-sync-x-event (make-sync-x-event 'no-event))) +(define *most-recent-sync-x-event* (make-sync-x-event 'no-event)) +(define *most-recent-lock* (make-lock)) + +(define (init-sync-x-events display) + (spawn + (lambda () + (let lp () + (let ((next (wait-event display))) + (with-lock *most-recent-lock* + (lambda () + (set-next-sync-x-event! *most-recent-sync-x-event* + (make-sync-x-event next)) + (set! *most-recent-sync-x-event* + (placeholder-value (really-next-sync-x-event + *most-recent-sync-x-event*))))) + (lp)))))) + +(define (most-recent-sync-x-event) + *most-recent-sync-x-event*) + +;; High-Level Event-Dispatcher *************************************** + +;; contains (display window event-mask) triples +(define *event-requests* '()) +(define *event-requests-lock* (make-lock)) + +(define (make-request display window event-mask) + (list display window event-mask)) + +(define (add-request! req) + (with-lock *event-requests-lock* + (lambda () + (set! *event-requests* + (cons req *event-requests*)) + (select-requests)))) + +(define (remove-request! req) + (with-lock *event-requests-lock* + (lambda () + (set! *event-requests* + (filter (lambda (r) (not (eq? r req))) *event-requests*)) + (select-requests)))) + +(define request:display car) +(define request:window cadr) +(define request:event-mask caddr) + +(define (event-masks-union masks) + (fold-right (lambda (m res) + (enum-set-union m res)) + (event-mask) + masks)) + +(define (select-requests) + (let loop ((rest *event-requests*)) + (if (not (null? rest)) + (let ((r (car rest))) + (call-with-values + (lambda () + (partition (lambda (r2) + ;; find all with the same display and window + (and (eq? (request:display r2) (request:display r)) + (eq? (request:window r2) (request:window r)))) + (cdr rest))) + (lambda (same rest) + (let ((mask (event-masks-union (map request:event-mask + (cons r same))))) + (display-select-input (request:display r) (request:window r) + mask)) + (loop rest))))))) + +(define (call-with-event-channel display window event-mask fun) + (let ((r (make-request display window event-mask)) + (channel (make-channel))) + (spawn-event-filter (most-recent-sync-x-event) + channel display window event-mask) + (dynamic-wind + (lambda () (add-request! r)) + (lambda () (fun channel)) + (lambda () (remove-request! r))))) + +(define (spawn-event-filter se out-channel display window event-mask) + (let ((pred (lambda (e) + (and (eq? (any-event-display e) display) + (matches-event-mask? window event-mask e))))) (spawn (lambda () - (let lp () - (let ((next (wait-event dpy))) - (set-next-sync-x-event! most-recent-sync-x-event - (make-sync-x-event next)) - (set! most-recent-sync-x-event - (placeholder-value (really-next-sync-x-event - most-recent-sync-x-event)))) - (lp)))) - (lambda () most-recent-sync-x-event))) + (let loop ((se se)) + (let ((nse (next-sync-x-event se pred))) + (send out-channel (sync-x-event-event nse)) + (loop nse))))))) + +(define (matches-event-mask? window event-mask event) + (let ((type (any-event-type event))) + (cond + ;; keymap-event has no window element + ((eq? type (event-type keymap-notify)) + (enum-set-member? event-mask (event-mask-item keymap-state))) + ;; other events must have at least the correct window + ((not (eq? window (any-event-window event))) + #f) + ;; these event are send always because they do not depend on a mask + ((or (eq? type (event-type client-message)) + (eq? type (event-type mapping-notify)) + (eq? type (event-type selection-clear)) + (eq? type (event-type selection-notify)) + (eq? type (event-type selection-request))) + #t) + ;; these do not depend an an event-mask too, but on a flag in GC, + ;; so we sent it too + ((or (eq? type (event-type graphics-expose)) + (eq? type (event-type no-expose))) + #t) + + ;; OwnerGrabButtonMask only generates extra events between a + ;; ButtonPress and ButtonRelease event and does not be respected + ;; here + + ;; PointerMotionHintMask only has an effect if one of the + ;; ButtonMotion Masks or PointerMotionMask is selected, so we + ;; don't have to take a look at it here. + + ;; for the rest one of the event-mask items must match the type + ((any (lambda (mask-item) + (matches-event-mask-2? type window event mask-item)) + (enum-set->list event-mask)) + #t) + (else #f)))) + +(define (matches-event-mask-2? type window event mask-item) + (cond + ((or (eq? mask-item (event-mask-item button-motion)) + (eq? mask-item (event-mask-item button-1-motion)) + (eq? mask-item (event-mask-item button-2-motion)) + (eq? mask-item (event-mask-item button-3-motion)) + (eq? mask-item (event-mask-item button-4-motion)) + (eq? mask-item (event-mask-item button-5-motion))) + (eq? type (event-type motion-notify))) + ((eq? mask-item (event-mask-item button-press)) + (eq? type (event-type button-press))) + ((eq? mask-item (event-mask-item button-release)) + (eq? type (event-type button-release))) + ((eq? mask-item (event-mask-item colormap-change)) + (eq? type (event-type colormap-notify))) + ((eq? mask-item (event-mask-item enter-window)) + (eq? type (event-type enter-notify))) + ((eq? mask-item (event-mask-item leave-window)) + (eq? type (event-type leave-notify))) + ((eq? mask-item (event-mask-item exposure)) + (eq? type (event-type expose))) + ((eq? mask-item (event-mask-item focus-change)) + (or (eq? type (event-type focus-in)) + (eq? type (event-type focus-out)))) + ((eq? mask-item (event-mask-item keymap-state)) + (eq? type (event-type keymap-notify))) + ((eq? mask-item (event-mask-item key-press)) + (eq? type (event-type key-press))) + ((eq? mask-item (event-mask-item key-release)) + (eq? type (event-type key-release))) + ((eq? mask-item (event-mask-item pointer-motion)) + (eq? type (event-type motion-notify))) + ((eq? mask-item (event-mask-item property-change)) + (eq? type (event-type property-notify))) + ((eq? mask-item (event-mask-item resize-redirect)) + (eq? type (event-type resize-request))) + ((eq? mask-item (event-mask-item structure-notify)) + (or (and (eq? type (event-type circulate-notify)) + (eq? window (circulate-event-window event))) + (and (eq? type (event-type configure-notify)) + (eq? window (configure-event-window event))) + (and (eq? type (event-type destroy-notify)) + (eq? window (destroy-window-event-window event))) + (and (eq? type (event-type gravity-notify)) + (eq? window (gravity-event-window event))) + (and (eq? type (event-type map-notify)) + (eq? window (map-event-window event))) + (and (eq? type (event-type reparent-notify)) + (eq? window (reparent-event-window event))) + (and (eq? type (event-type unmap-notify)) + (eq? window (unmap-event-window event))))) + ((eq? mask-item (event-mask-item substructure-notify)) + (or (and (eq? type (event-type circulate-notify)) + (not (eq? window (circulate-event-window event)))) + (and (eq? type (event-type configure-notify)) + (not (eq? window (configure-event-window event)))) + (and (eq? type (event-type create-notify)) + (not (eq? window (create-window-event-window event)))) + (and (eq? type (event-type destroy-notify)) + (not (eq? window (destroy-window-event-window event)))) + (and (eq? type (event-type gravity-notify)) + (not (eq? window (gravity-event-window event)))) + (and (eq? type (event-type map-notify)) + (not (eq? window (map-event-window event)))) + (and (eq? type (event-type reparent-notify)) + (not (eq? window (reparent-event-window event)))) + (and (eq? type (event-type unmap-notify)) + (not (eq? window (unmap-event-window event)))))) + ((eq? mask-item (event-mask-item substructure-redirect)) + (or (eq? type (event-type circulate-request)) + (eq? type (event-type configure-request)) + (eq? type (event-type map-request)))) + ((eq? mask-item (event-mask-item visibility-change)) + (eq? type (event-type visibility-notify))) + (else #f))) diff --git a/scheme/xlib/window.scm b/scheme/xlib/window.scm index 9791de7..3166cb0 100644 --- a/scheme/xlib/window.scm +++ b/scheme/xlib/window.scm @@ -37,6 +37,8 @@ override-redirect save-under event-mask do-not-propagate-mask colormap cursor)) +(define-exported-binding "scx-set-window-attribute" :set-window-attribute) + (define-syntax make-set-window-attribute-alist (syntax-rules () diff --git a/scheme/xlib/xlib-interfaces.scm b/scheme/xlib/xlib-interfaces.scm index 84e3dc6..d47e8d7 100644 --- a/scheme/xlib/xlib-interfaces.scm +++ b/scheme/xlib/xlib-interfaces.scm @@ -1,4 +1,6 @@ (define :enumeration :syntax) +(define :display :value) +(define :x-error :value) (define-interface xlib-internal-interface (export @@ -28,7 +30,7 @@ screen? screen:display screen:root-window screen:width screen:height - screen:width-mm screen:height-mm screen:depths screen:root-depth + screen:width-mm screen:height-mm screen:number screen:root-depth screen:default-visual screen:default-gc screen:default-colormap screen:white-pixel screen:black-pixel screen:max-maps screen:min-maps screen:does-backing-store screen:does-save-unders? @@ -173,26 +175,32 @@ x-error:text (error-code :syntax) error-code? - use-x-error-exceptions! + use-x-error-warnings! use-x-error-queue! x-error-queue? x-error-queue:this empty-x-error-queue? next-x-error-queue - set-error-handler! + ((set-error-handler!) (proc ((proc (:display :x-error) :value)) + (proc (:display :x-error) :value))) get-error-text get-error-database-text - set-io-error-handler + ((set-fatal-error-handler!) (proc ((proc (:display) :value)) + (proc (:display) :value))) ;; sync-event.scm ************************************************* init-sync-x-events sync-x-event? sync-x-event-event next-sync-x-event + most-recent-sync-x-event + + call-with-event-channel ;; event-types.scm ************************************************ (event-type :enumeration) + (event-mask :syntax) any-event-type any-event-serial any-event-send-event? diff --git a/scheme/xlib/xlib-packages.scm b/scheme/xlib/xlib-packages.scm index 936476a..20b70a7 100644 --- a/scheme/xlib/xlib-packages.scm +++ b/scheme/xlib/xlib-packages.scm @@ -12,8 +12,8 @@ (define :enum-set-type (record-ref test-value 0)) (define-exported-binding "s48-enum-set-type" :enum-set-type))) -(define-structures ((xlib-internal xlib-internal-interface) - (xlib xlib-interface)) +(define-structures ((xlib xlib-interface) + (xlib-internal xlib-internal-interface)) (open scsh-level-0 scheme list-lib @@ -30,7 +30,9 @@ ports locks channel-i/o interrupts - ascii) + ascii + conditions + rendezvous-channels) (files display visual colormap