- fixed some small bugs and typos
- changed error and after-function handling a bit - added screen caching - added timeout in wait-event implementation (did not work with multiple threads)
This commit is contained in:
frese
parent
968e69403f
commit
9967c456ee
|
|
@ -131,7 +131,7 @@ s48_value scx_Set_Wm_Class(s48_value dpy, s48_value w, s48_value name,
|
|||
#define scx_enter_initial_state(x) S48_ENTER_ENUM(x, "scx-initial-states")
|
||||
|
||||
#define scx_extract_wm_hint(x) S48_EXTRACT_ENUM(x, "scx-wm-hint")
|
||||
#define scx_enter_wm_hint(x) S48_ENTER_ENUM(x, "scx-wm-hint")
|
||||
#define scx_enter_wm_hint(x) S48_ENTER_ENUM(x, "scx-wm-hints")
|
||||
|
||||
s48_value scx_enter_wm_hint_alist(XWMHints* p) {
|
||||
s48_value res = S48_NULL, t = S48_FALSE;
|
||||
|
|
|
|||
|
|
@ -22,6 +22,8 @@ s48_value scx_enter_screen(Screen* scr) {
|
|||
S48_DECLARE_GC_PROTECT(1);
|
||||
s = s48_make_record(scx_screen);
|
||||
S48_GC_PROTECT_1(s);
|
||||
scx_struct_cache_set(scr, &scx_screen_list, 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)));
|
||||
|
|
@ -34,10 +36,10 @@ s48_value scx_enter_screen(Screen* 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, 12, scx_enter_pixel(WhitePixelOfScreen(scr)));
|
||||
S48_RECORD_SET(s, 13, scx_enter_pixel(BlackPixelOfScreen(scr)));
|
||||
S48_RECORD_SET(s, 14, s48_enter_integer(MaxCmapsOfScreen(scr)));
|
||||
S48_RECORD_SET(s, 15, s48_enter_integer(MinCmapsOfScreen(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)));
|
||||
|
|
@ -50,7 +52,8 @@ s48_value scx_display_list = S48_NULL;
|
|||
|
||||
static int scx_after_function_wrapper(Display* dpy) {
|
||||
s48_value display = scx_enter_display(dpy);
|
||||
s48_value fun = SCX_DISPLAY_AFTER_FUNCTION(display);
|
||||
s48_value fun = S48_SHARED_BINDING_REF(
|
||||
s48_get_imported_binding("scx-general-after-function"));
|
||||
s48_call_scheme(fun, 1, display);
|
||||
return 0;
|
||||
}
|
||||
|
|
@ -84,10 +87,11 @@ s48_value scx_enter_display(Display* 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);
|
||||
S48_RECORD_SET(d, 14, S48_SHARED_BINDING_REF(
|
||||
s48_get_imported_binding("scx-default-after-function")));
|
||||
S48_RECORD_SET(d, 14, S48_FALSE);
|
||||
XSetAfterFunction(dpy, &scx_after_function_wrapper);
|
||||
|
||||
S48_RECORD_SET(d, 15, S48_FALSE); // wakeup placeholder
|
||||
s48_call_scheme(S48_SHARED_BINDING_REF(s48_get_imported_binding(
|
||||
"scx-initialize-display")), 1, d);
|
||||
S48_GC_UNPROTECT();
|
||||
}
|
||||
return d;
|
||||
|
|
|
|||
|
|
@ -56,43 +56,21 @@ extern int _XDefaultError();
|
|||
static s48_value internal_x_error_handler_binding = S48_FALSE;
|
||||
|
||||
static int error_handler_wrapper(Display* dpy, XErrorEvent* e) {
|
||||
char handled = 0;
|
||||
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
|
||||
(S48_SHARED_BINDING_REF(internal_x_error_handler_binding) != S48_FALSE)){
|
||||
s48_value v =
|
||||
s48_call_scheme(S48_SHARED_BINDING_REF(internal_x_error_handler_binding),
|
||||
2,
|
||||
scx_enter_display(dpy),
|
||||
scx_enter_x_error(e));
|
||||
handled = (v != S48_FALSE);
|
||||
}
|
||||
if (!handled)
|
||||
_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;
|
||||
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),
|
||||
|
|
@ -135,11 +113,8 @@ void scx_init_error() {
|
|||
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_Get_Error_Text);
|
||||
S48_EXPORT_FUNCTION(scx_Get_Error_Database_Text);
|
||||
//S48_EXPORT_FUNCTION(scx_Set_IO_Error_Handler);
|
||||
|
||||
internal_x_fatal_error_handler_binding =
|
||||
s48_get_imported_binding("internal-x-fatal-error-handler");
|
||||
|
|
|
|||
|
|
@ -27,7 +27,7 @@ s48_value scx_enter_key_event(XKeyEvent* xe) {
|
|||
EENTER(9, y, s48_enter_integer);
|
||||
EENTER(10, x_root, s48_enter_integer);
|
||||
EENTER(11, y_root, s48_enter_integer);
|
||||
EENTER(12, state, scx_enter_state);
|
||||
EENTER(12, state, scx_enter_state_set);
|
||||
EENTER(13, keycode, scx_enter_keycode);
|
||||
EENTER(14, same_screen, S48_ENTER_BOOLEAN);
|
||||
EENTER_END();
|
||||
|
|
@ -43,7 +43,7 @@ s48_value scx_enter_button_event(XButtonEvent* xe) {
|
|||
EENTER(9, y, s48_enter_integer);
|
||||
EENTER(10, x_root, s48_enter_integer);
|
||||
EENTER(11, y_root, s48_enter_integer);
|
||||
EENTER(12, state, scx_enter_state);
|
||||
EENTER(12, state, scx_enter_state_set);
|
||||
EENTER(13, button, scx_enter_button);
|
||||
EENTER(14, same_screen, S48_ENTER_BOOLEAN);
|
||||
EENTER_END();
|
||||
|
|
@ -59,7 +59,7 @@ s48_value scx_enter_motion_event(XMotionEvent* xe) {
|
|||
EENTER(9, y, s48_enter_integer);
|
||||
EENTER(10, x_root, s48_enter_integer);
|
||||
EENTER(11, y_root, s48_enter_integer);
|
||||
EENTER(12, state, scx_enter_state);
|
||||
EENTER(12, state, scx_enter_state_set);
|
||||
EENTER(13, is_hint, S48_ENTER_BOOLEAN);
|
||||
EENTER(14, same_screen, S48_ENTER_BOOLEAN);
|
||||
EENTER_END();
|
||||
|
|
@ -79,7 +79,7 @@ s48_value scx_enter_crossing_event(XCrossingEvent* xe) {
|
|||
EENTER(13, detail, scx_enter_notify_detail);
|
||||
EENTER(14, same_screen, S48_ENTER_BOOLEAN);
|
||||
EENTER(15, focus, S48_ENTER_BOOLEAN);
|
||||
EENTER(16, state, scx_enter_state);
|
||||
EENTER(16, state, scx_enter_state_set);
|
||||
EENTER_END();
|
||||
}
|
||||
|
||||
|
|
@ -406,7 +406,7 @@ void scx_extract_key_event(s48_value e, XKeyEvent* xe) {
|
|||
EEXTRACT(9, y, s48_extract_integer);
|
||||
EEXTRACT(10, x_root, s48_extract_integer);
|
||||
EEXTRACT(11, y_root, s48_extract_integer);
|
||||
EEXTRACT(12, state, scx_extract_state);
|
||||
EEXTRACT(12, state, scx_extract_state_set);
|
||||
EEXTRACT(13, keycode, scx_extract_keycode);
|
||||
EEXTRACT(14, same_screen, S48_EXTRACT_BOOLEAN);
|
||||
EEXTRACT_END();
|
||||
|
|
@ -422,7 +422,7 @@ void scx_extract_button_event(s48_value e, XButtonEvent* xe) {
|
|||
EEXTRACT(9, y, s48_extract_integer);
|
||||
EEXTRACT(10, x_root, s48_extract_integer);
|
||||
EEXTRACT(11, y_root, s48_extract_integer);
|
||||
EEXTRACT(12, state, scx_extract_state);
|
||||
EEXTRACT(12, state, scx_extract_state_set);
|
||||
EEXTRACT(13, button, scx_extract_button);
|
||||
EEXTRACT(14, same_screen, S48_EXTRACT_BOOLEAN);
|
||||
EEXTRACT_END();
|
||||
|
|
@ -438,7 +438,7 @@ void scx_extract_motion_event(s48_value e, XMotionEvent* xe) {
|
|||
EEXTRACT(9, y, s48_extract_integer);
|
||||
EEXTRACT(10, x_root, s48_extract_integer);
|
||||
EEXTRACT(11, y_root, s48_extract_integer);
|
||||
EEXTRACT(12, state, scx_extract_state);
|
||||
EEXTRACT(12, state, scx_extract_state_set);
|
||||
EEXTRACT(13, is_hint, S48_EXTRACT_BOOLEAN);
|
||||
EEXTRACT(14, same_screen, S48_EXTRACT_BOOLEAN);
|
||||
EEXTRACT_END();
|
||||
|
|
@ -458,7 +458,7 @@ void scx_extract_crossing_event(s48_value e, XCrossingEvent* xe) {
|
|||
EEXTRACT(13, detail, scx_extract_notify_detail);
|
||||
EEXTRACT(14, same_screen, S48_EXTRACT_BOOLEAN);
|
||||
EEXTRACT(15, focus, S48_EXTRACT_BOOLEAN);
|
||||
EEXTRACT(16, state, scx_extract_state);
|
||||
EEXTRACT(16, state, scx_extract_state_set);
|
||||
EEXTRACT_END();
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -41,8 +41,7 @@ s48_value scx_enter_charstruct(XCharStruct* cs) {
|
|||
s48_value scx_enter_fontstruct(XFontStruct* fs) {
|
||||
int i;
|
||||
s48_value plist = S48_NULL, t = S48_NULL;
|
||||
s48_value res =
|
||||
s48_make_record(s48_get_imported_binding("scx-font-struct"));
|
||||
s48_value res = s48_make_record(scx_fontstruct);
|
||||
S48_DECLARE_GC_PROTECT(3);
|
||||
S48_GC_PROTECT_3(res, plist, t);
|
||||
S48_RECORD_SET(res, 0, S48_ENTER_POINTER(fs));
|
||||
|
|
|
|||
|
|
@ -129,14 +129,17 @@ s48_value scx_enter_property(Atom type, int format, char* data,
|
|||
switch (format) {
|
||||
case 8:
|
||||
S48_RECORD_SET(p, 2, s48_enter_substring(data, nelements));
|
||||
break;
|
||||
case 16:
|
||||
for (i = nelements-1; i >= 0; i--)
|
||||
l = s48_cons(s48_enter_integer(((short*)data)[i]), l);
|
||||
S48_RECORD_SET(p, 2, l);
|
||||
break;
|
||||
case 32:
|
||||
for (i = nelements-1; i >= 0; i--)
|
||||
l = s48_cons(s48_enter_integer(((long*)data)[i]), l);
|
||||
S48_RECORD_SET(p, 2, l);
|
||||
break;
|
||||
}
|
||||
S48_GC_UNPROTECT();
|
||||
return p;
|
||||
|
|
|
|||
|
|
@ -115,16 +115,18 @@ s48_value scx_Draw_Text_16(s48_value display, s48_value drawable,
|
|||
|
||||
s48_value scx_Text_Extents(s48_value font_struct, s48_value string) {
|
||||
XCharStruct overall;
|
||||
int dir, ascent, descent;
|
||||
XTextExtents(scx_extract_fontstruct(font_struct),
|
||||
s48_extract_string(string),
|
||||
S48_STRING_LENGTH(string),
|
||||
NULL, NULL, NULL,
|
||||
&dir, &ascent, &descent,
|
||||
&overall);
|
||||
return scx_enter_charstruct(&overall);
|
||||
}
|
||||
|
||||
s48_value scx_Text_Extents_16(s48_value font_struct, s48_value string) {
|
||||
XCharStruct overall;
|
||||
int dir, ascent, descent;
|
||||
int i, len = s48_list_length(string);
|
||||
XChar2b chars[len];
|
||||
for (i = 0; i < len; i++) {
|
||||
|
|
@ -134,7 +136,7 @@ s48_value scx_Text_Extents_16(s48_value font_struct, s48_value string) {
|
|||
}
|
||||
XTextExtents16(scx_extract_fontstruct(font_struct),
|
||||
chars, len,
|
||||
NULL, NULL, NULL,
|
||||
&dir, &ascent, &descent,
|
||||
&overall);
|
||||
return scx_enter_charstruct(&overall);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -52,8 +52,9 @@ void scx_struct_cache_set(void* cpointer, s48_value* l, s48_value v) {
|
|||
|
||||
// remove all empty and duplicate entries
|
||||
while (list != S48_NULL) {
|
||||
s48_value entry = S48_WEAK_POINTER_REF(S48_CDR(S48_CAR(list)));
|
||||
if ((entry == S48_FALSE) || (S48_EXTRACT_POINTER(entry) == cpointer))
|
||||
s48_value entry = S48_CAR(list);
|
||||
if ((S48_WEAK_POINTER_REF(S48_CDR(entry)) == S48_FALSE) ||
|
||||
(S48_EXTRACT_POINTER(S48_CAR(entry)) == cpointer))
|
||||
S48_SET_CDR(previous, S48_CDR(list));
|
||||
else
|
||||
previous = list;
|
||||
|
|
|
|||
|
|
@ -184,10 +184,9 @@ s48_value scx_Configure_Window(s48_value display, s48_value window,
|
|||
return S48_UNSPECIFIC;
|
||||
}
|
||||
|
||||
s48_value scx_window_attributes;
|
||||
|
||||
s48_value scx_enter_window_attributes(XWindowAttributes* WA) {
|
||||
s48_value v = s48_make_record(scx_window_attributes);
|
||||
s48_value v = s48_make_record(
|
||||
s48_get_imported_binding("scx-window-attributes"));
|
||||
S48_DECLARE_GC_PROTECT(1);
|
||||
S48_GC_PROTECT_1(v);
|
||||
S48_RECORD_SET(v, 0, s48_enter_integer(WA->x));
|
||||
|
|
@ -340,7 +339,7 @@ s48_value scx_Clear_Window(s48_value display, s48_value window) {
|
|||
return S48_UNSPECIFIC;
|
||||
}
|
||||
|
||||
s48_value scx_Query_Tree(s48_value Xwindow, s48_value Xdisplay) {
|
||||
s48_value scx_Query_Tree(s48_value display, s48_value window) {
|
||||
Window root, parent, *children;
|
||||
int i;
|
||||
unsigned n;
|
||||
|
|
@ -348,8 +347,8 @@ s48_value scx_Query_Tree(s48_value Xwindow, s48_value Xdisplay) {
|
|||
s48_value c = S48_NULL, res = S48_NULL;
|
||||
S48_DECLARE_GC_PROTECT(2);
|
||||
|
||||
if (! XQueryTree (scx_extract_display(Xdisplay),
|
||||
scx_extract_window(Xwindow),
|
||||
if (! XQueryTree (scx_extract_display(display),
|
||||
scx_extract_window(window),
|
||||
&root, &parent, &children, &n))
|
||||
return S48_FALSE;
|
||||
|
||||
|
|
|
|||
|
|
@ -23,6 +23,8 @@
|
|||
colormap-alloc? colormap-allocs colormap-alloc-name colormap-alloc-index
|
||||
(none all))
|
||||
|
||||
(define-exported-binding "scx-colormap-alloc" :colormap-alloc)
|
||||
|
||||
(import-lambda-definition create-colormap (display window visual alloc)
|
||||
"scx_Create_Colormap")
|
||||
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@
|
|||
(make-display cpointer connection-number protocol-version protocol-revision
|
||||
server-vendor image-byte-order bitmap-unit bitmap-pad
|
||||
bitmap-bit-order vendor-release queue-length name
|
||||
default-screen screens after-function)
|
||||
default-screen screens after-function wakeup)
|
||||
display?
|
||||
(cpointer display:cpointer)
|
||||
(connection-number display:connection-number)
|
||||
|
|
@ -21,13 +21,43 @@
|
|||
(name display:name)
|
||||
(default-screen display:default-screen)
|
||||
(screens display:screens)
|
||||
(after-function display:after-function set-display:after-function!))
|
||||
(after-function display:after-function set-display:after-function!)
|
||||
(wakeup display:wakeup set-display:wakeup!))
|
||||
|
||||
(define-exported-binding "scx-display" :display)
|
||||
|
||||
;(define (wakeup-display dpy)
|
||||
; (placeholder-set! dpy #t))
|
||||
|
||||
;(define (sleep-display dpy)
|
||||
; (let ((ph (make-placeholder)))
|
||||
; (set-display:wakeup! dpy ph)
|
||||
; (placeholder-value ph)))
|
||||
|
||||
(define (initialize-display dpy)
|
||||
; (set-display:wakeup! dpy (make-placeholder))
|
||||
; ;; spawn a thread that weaks up a waiting wait-event call if the
|
||||
; ;; inport has data available
|
||||
; (spawn (lambda ()
|
||||
; (let loop ()
|
||||
; (block-on-message-inport dpy)
|
||||
; (wakeup-display dpy)
|
||||
; (loop))))
|
||||
;; the after-function may also send a wakup
|
||||
#t)
|
||||
|
||||
(define-exported-binding "scx-initialize-display" initialize-display)
|
||||
|
||||
(define (display-message-inport display)
|
||||
(fdes->inport (display:connection-number display)))
|
||||
|
||||
(define (block-on-message-inport dpy . maybe-timeout)
|
||||
(let ((port (display-message-inport dpy)))
|
||||
(call-with-values
|
||||
(lambda () (apply select (vector port) (vector) (vector) maybe-timeout))
|
||||
(lambda (ready-read ready-write ex)
|
||||
(member port (vector->list ready-read))))))
|
||||
|
||||
(define-enumerated-type byte-order :byte-order
|
||||
byte-order? byte-orders byte-order-name byte-order-index
|
||||
(lsb-first msb-first))
|
||||
|
|
@ -133,19 +163,27 @@
|
|||
|
||||
;; *** enable or disable synchronization *****************************
|
||||
|
||||
(define (synchronize display on?)
|
||||
(define (synchronize dpy on?)
|
||||
(if on?
|
||||
(set-after-function! display
|
||||
(lambda (display) (display-sync display #f)))
|
||||
(set-after-function! display default-after-function)))
|
||||
(set-after-function! dpy
|
||||
(lambda (dpy)
|
||||
(display-sync dpy #f)))
|
||||
(set-after-function! dpy #f)))
|
||||
|
||||
;; returns the previous after-function. An after-function is called
|
||||
;; with the display object.
|
||||
|
||||
(define (default-after-function display) ;; TODO: check if this is the real one
|
||||
(display-flush display))
|
||||
(define (general-after-function display)
|
||||
(if (display:after-function display)
|
||||
((display:after-function display) display)
|
||||
;; else the default behaviour ;; TODO: check if this is the real one
|
||||
(display-flush display))
|
||||
)
|
||||
;; if events are in the queue now, then wakeup a wait-event call
|
||||
;;(if (> (events-queued display (queued-mode already)) 0)
|
||||
;; (wakeup-display display)))
|
||||
|
||||
(define-exported-binding "scx-default-after-function" default-after-function)
|
||||
(define-exported-binding "scx-general-after-function" general-after-function)
|
||||
|
||||
(define (set-after-function! display fun)
|
||||
(let ((prev (display:after-function display)))
|
||||
|
|
|
|||
|
|
@ -211,7 +211,11 @@
|
|||
;; *** default error handlers ****************************************
|
||||
|
||||
(define *x-error-handler* #f)
|
||||
(define-exported-binding "internal-x-error-handler" *x-error-handler*)
|
||||
(define (internal-x-error-handler display error)
|
||||
(if *x-error-handler*
|
||||
(*x-error-handler* display error)
|
||||
#f))
|
||||
(define-exported-binding "internal-x-error-handler" internal-x-error-handler)
|
||||
|
||||
(define (set-error-handler! handler)
|
||||
(let ((old-handler *x-error-handler*))
|
||||
|
|
@ -241,8 +245,12 @@
|
|||
; "scx_Set_IO_Error_Handler")
|
||||
|
||||
(define *x-fatal-error-handler* #f)
|
||||
(define (internal-x-fatal-error-handler display)
|
||||
(if *x-fatal-error-handler*
|
||||
(*x-fatal-error-handler* display)
|
||||
#f))
|
||||
(define-exported-binding "internal-x-fatal-error-handler"
|
||||
*x-fatal-error-handler*)
|
||||
internal-x-fatal-error-handler)
|
||||
|
||||
(define (set-fatal-error-handler! handler)
|
||||
(let ((old-handler *x-fatal-error-handler*))
|
||||
|
|
|
|||
|
|
@ -392,7 +392,8 @@
|
|||
|
||||
(define-record-type graphics-expose-event :graphics-expose-event
|
||||
(create-graphics-expose-event type serial send-event? display drawable
|
||||
x y width height major-code minor-code)
|
||||
x y width height count major-code
|
||||
minor-code)
|
||||
graphics-expose-event?
|
||||
(type graphics-expose-event-type)
|
||||
(serial graphics-expose-event-serial)
|
||||
|
|
@ -403,6 +404,7 @@
|
|||
(y graphics-expose-event-y)
|
||||
(width graphics-expose-event-width)
|
||||
(height graphics-expose-event-height)
|
||||
(count graphics-expose-event-count)
|
||||
(major-code graphics-expose-event-major-code)
|
||||
(minor-code graphics-expose-event-minor-code))
|
||||
|
||||
|
|
|
|||
|
|
@ -4,17 +4,12 @@
|
|||
;; and then it returns this new event.
|
||||
|
||||
(define (wait-event dpy)
|
||||
(if (not (> (events-queued dpy (queued-mode after-flush)) 0))
|
||||
(block-on-message-inport dpy))
|
||||
(next-event dpy))
|
||||
|
||||
(define (block-on-message-inport dpy)
|
||||
(let ((port (display-message-inport dpy)))
|
||||
(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))))))
|
||||
(if (> (events-queued dpy (queued-mode after-flush)) 0)
|
||||
(next-event dpy)
|
||||
(begin
|
||||
;;(sleep-display dpy)
|
||||
(block-on-message-inport dpy)
|
||||
(wait-event dpy))))
|
||||
|
||||
;(define (block-on-message-inport dpy) ; needs ports, locks
|
||||
; (let ((port (display-message-inport dpy)))
|
||||
|
|
@ -27,7 +22,7 @@
|
|||
; (release-lock (port-lock port)))
|
||||
; (enable-interrupts!))))
|
||||
|
||||
;;;; Only here until scsh provides us with select
|
||||
;;; Only here until scsh provides us with select
|
||||
;(import-lambda-definition add-pending-channel (channel)
|
||||
; "scx_add_pending_channel")
|
||||
|
||||
|
|
|
|||
|
|
@ -44,7 +44,7 @@
|
|||
(ascent font-struct:ascent)
|
||||
(descent font-struct:descent))
|
||||
|
||||
(define-exported-binding "scx-font-struct" :font-struct)
|
||||
(define-exported-binding "scx-fontstruct" :font-struct)
|
||||
|
||||
;; *** load or unload fonts ******************************************
|
||||
|
||||
|
|
|
|||
|
|
@ -61,6 +61,11 @@
|
|||
(width rectangle:width set-rectangle:width!)
|
||||
(height rectangle:height set-rectangle:height!))
|
||||
|
||||
(define-record-discloser :rectangle
|
||||
(lambda (r)
|
||||
`(Rectangle ,(rectangle:x r) ,(rectangle:y r)
|
||||
,(rectangle:width r) ,(rectangle:height r))))
|
||||
|
||||
(define-exported-binding "scx-rectangle" :rectangle)
|
||||
|
||||
(import-lambda-definition draw-rectangles (display drawable gc rectangles)
|
||||
|
|
|
|||
|
|
@ -29,11 +29,11 @@
|
|||
(define *most-recent-sync-x-event* (make-sync-x-event 'no-event))
|
||||
(define *most-recent-lock* (make-lock))
|
||||
|
||||
(define (init-sync-x-events display)
|
||||
(define (init-sync-x-events dpy)
|
||||
(spawn
|
||||
(lambda ()
|
||||
(let lp ()
|
||||
(let ((next (wait-event display)))
|
||||
(let ((next (wait-event dpy)))
|
||||
(with-lock *most-recent-lock*
|
||||
(lambda ()
|
||||
(set-next-sync-x-event! *most-recent-sync-x-event*
|
||||
|
|
@ -93,8 +93,9 @@
|
|||
(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))
|
||||
(if (window-exists? (request:display r) (request:window r))
|
||||
(display-select-input (request:display r) (request:window r)
|
||||
mask)))
|
||||
(loop rest)))))))
|
||||
|
||||
(define (call-with-event-channel display window event-mask fun)
|
||||
|
|
@ -195,36 +196,36 @@
|
|||
(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)))
|
||||
(eq? window (circulate-event-event event)))
|
||||
(and (eq? type (event-type configure-notify))
|
||||
(eq? window (configure-event-window event)))
|
||||
(eq? window (configure-event-event event)))
|
||||
(and (eq? type (event-type destroy-notify))
|
||||
(eq? window (destroy-window-event-window event)))
|
||||
(eq? window (destroy-window-event-event event)))
|
||||
(and (eq? type (event-type gravity-notify))
|
||||
(eq? window (gravity-event-window event)))
|
||||
(eq? window (gravity-event-event event)))
|
||||
(and (eq? type (event-type map-notify))
|
||||
(eq? window (map-event-window event)))
|
||||
(eq? window (map-event-event event)))
|
||||
(and (eq? type (event-type reparent-notify))
|
||||
(eq? window (reparent-event-window event)))
|
||||
(eq? window (reparent-event-event event)))
|
||||
(and (eq? type (event-type unmap-notify))
|
||||
(eq? window (unmap-event-window event)))))
|
||||
(eq? window (unmap-event-event event)))))
|
||||
((eq? mask-item (event-mask-item substructure-notify))
|
||||
(or (and (eq? type (event-type circulate-notify))
|
||||
(not (eq? window (circulate-event-window event))))
|
||||
(eq? window (circulate-event-event event)))
|
||||
(and (eq? type (event-type configure-notify))
|
||||
(not (eq? window (configure-event-window event))))
|
||||
(eq? window (configure-event-event event)))
|
||||
(and (eq? type (event-type create-notify))
|
||||
(not (eq? window (create-window-event-window event))))
|
||||
(eq? window (create-window-event-parent event)))
|
||||
(and (eq? type (event-type destroy-notify))
|
||||
(not (eq? window (destroy-window-event-window event))))
|
||||
(eq? window (destroy-window-event-event event)))
|
||||
(and (eq? type (event-type gravity-notify))
|
||||
(not (eq? window (gravity-event-window event))))
|
||||
(eq? window (gravity-event-event event)))
|
||||
(and (eq? type (event-type map-notify))
|
||||
(not (eq? window (map-event-window event))))
|
||||
(eq? window (map-event-event event)))
|
||||
(and (eq? type (event-type reparent-notify))
|
||||
(not (eq? window (reparent-event-window event))))
|
||||
(eq? window (reparent-event-event event)))
|
||||
(and (eq? type (event-type unmap-notify))
|
||||
(not (eq? window (unmap-event-window event))))))
|
||||
(eq? window (unmap-event-event event)))))
|
||||
((eq? mask-item (event-mask-item substructure-redirect))
|
||||
(or (eq? type (event-type circulate-request))
|
||||
(eq? type (event-type configure-request))
|
||||
|
|
|
|||
|
|
@ -129,8 +129,8 @@
|
|||
"scx_Configure_Window")
|
||||
|
||||
(define (make-win-configurer change)
|
||||
(lambda (window value)
|
||||
(configure-window window (list (cons change value)))))
|
||||
(lambda (display window value)
|
||||
(configure-window display window (list (cons change value)))))
|
||||
|
||||
(define set-window-x! (make-win-configurer (window-change x)))
|
||||
(define set-window-y! (make-win-configurer (window-change y)))
|
||||
|
|
@ -205,6 +205,8 @@
|
|||
(override-redirect window-attribute:override-redirect)
|
||||
(screen window-attribute:screen))
|
||||
|
||||
(define-exported-binding "scx-window-attributes" :window-attributes)
|
||||
|
||||
(import-lambda-definition get-window-attributes (display window)
|
||||
"scx_Get_Window_Attributes")
|
||||
|
||||
|
|
@ -335,3 +337,19 @@
|
|||
;; the pointer or None
|
||||
(vector-ref q 4) ;; x and y coordinates
|
||||
(vector-ref q 5))))) ;; relative to window
|
||||
|
||||
;; *** convenience functions *****************************************
|
||||
|
||||
(define (window-exists? dpy window)
|
||||
(let ((pe (use-x-error-warnings!)))
|
||||
(let ((result
|
||||
(call-with-current-continuation
|
||||
(lambda (return)
|
||||
(with-handler (lambda (condition punt)
|
||||
(return #f))
|
||||
(lambda ()
|
||||
(query-tree dpy window)
|
||||
(display-sync dpy #f)
|
||||
#t))))))
|
||||
(set-error-handler! pe)
|
||||
result)))
|
||||
|
|
|
|||
|
|
@ -45,9 +45,9 @@
|
|||
|
||||
display:last-request-read
|
||||
default-root-window
|
||||
white-pixel black-pixel
|
||||
next-request
|
||||
synchronize
|
||||
default-after-function
|
||||
set-after-function!
|
||||
display-flush
|
||||
display-sync
|
||||
|
|
@ -126,6 +126,8 @@
|
|||
query-pointer-state
|
||||
query-pointer
|
||||
|
||||
window-exists?
|
||||
|
||||
;; colormap.scm ***************************************************
|
||||
make-color color? color:pixel set-color:pixel!
|
||||
color:red set-color:red! color:green set-color:green!
|
||||
|
|
@ -201,6 +203,15 @@
|
|||
;; event-types.scm ************************************************
|
||||
(event-type :enumeration)
|
||||
(event-mask :syntax)
|
||||
|
||||
(notify-mode :enumeration)
|
||||
(notify-detail :enumeration)
|
||||
(visibility-state :enumeration)
|
||||
(place :enumeration)
|
||||
(property-state :enumeration)
|
||||
(property-format :enumeration)
|
||||
(mapping-request :enumeration)
|
||||
|
||||
any-event-type
|
||||
any-event-serial
|
||||
any-event-send-event?
|
||||
|
|
|
|||
|
|
@ -19,7 +19,7 @@
|
|||
scheme
|
||||
list-lib
|
||||
srfi-13 ;; strings
|
||||
signals
|
||||
signals handle
|
||||
bitwise
|
||||
external-calls
|
||||
define-record-types
|
||||
|
|
|
|||
Loading…
Reference in New Issue