corrected the implementation of the after-function stuff.
This commit is contained in:
parent
b0a1f88472
commit
3a36140b69
|
@ -2,6 +2,8 @@
|
|||
#include "scheme48.h"
|
||||
#include <sys/time.h>
|
||||
|
||||
s48_value internal_after_function_binding = S48_FALSE;
|
||||
|
||||
// Open_Display(name) name should be a string or S48_FALSE (=> Null)
|
||||
s48_value scx_Open_Display (s48_value name) {
|
||||
char* cname = (char*)0;
|
||||
|
@ -18,6 +20,22 @@ s48_value scx_Close_Display(s48_value Xdisplay) {
|
|||
return S48_UNSPECIFIC;
|
||||
}
|
||||
|
||||
|
||||
// After-Function routines
|
||||
static X_After_Function(Display* d) {
|
||||
s48_call_scheme(S48_SHARED_BINDING_REF(internal_after_function_binding),
|
||||
1, SCX_ENTER_DISPLAY(d));
|
||||
}
|
||||
|
||||
s48_value scx_Set_After_Function(s48_value Xdisplay, s48_value active) {
|
||||
if (S48_FALSE_P(active))
|
||||
(void)XSetAfterFunction(SCX_EXTRACT_DISPLAY(Xdisplay),
|
||||
(int (*)())0);
|
||||
else
|
||||
(void)XSetAfterFunction(SCX_EXTRACT_DISPLAY(Xdisplay),
|
||||
X_After_Function);
|
||||
}
|
||||
|
||||
// This function returns the file destriptor of the message-channel.
|
||||
s48_value scx_Display_Message_fd(s48_value Xdisplay) {
|
||||
int fd = ConnectionNumber(SCX_EXTRACT_DISPLAY(Xdisplay));
|
||||
|
@ -211,6 +229,11 @@ s48_value scx_List_Pixmap_Formats (s48_value Xdisplay) {
|
|||
}
|
||||
|
||||
void scx_init_display(void) {
|
||||
S48_GC_PROTECT_GLOBAL(internal_after_function_binding);
|
||||
internal_after_function_binding =
|
||||
s48_get_imported_binding("internal-after-function");
|
||||
|
||||
S48_EXPORT_FUNCTION(scx_Set_After_Function);
|
||||
S48_EXPORT_FUNCTION(scx_Open_Display);
|
||||
S48_EXPORT_FUNCTION(scx_Close_Display);
|
||||
S48_EXPORT_FUNCTION(scx_Display_Message_fd);
|
||||
|
|
|
@ -6,11 +6,28 @@
|
|||
(after-function display-after-function real-display-set-after-function!)
|
||||
(Xdisplay display-Xdisplay display-set-Xdisplay!))
|
||||
|
||||
;; the real AfterFunction registered at the xlib is either none or the
|
||||
;; c-function X_After_Function, which then calls
|
||||
;; internal-after-function.
|
||||
|
||||
(define (display-set-after-function! display proc)
|
||||
(let ((old (display-after-function display)))
|
||||
(real-display-set-after-function! display proc)
|
||||
(%set-after-function (display-Xdisplay display) proc)
|
||||
old))
|
||||
|
||||
(import-lambda-definition %set-after-function (Xdisplay active?)
|
||||
"scx_Set_After_Function")
|
||||
|
||||
(define (internal-after-function Xdisplay)
|
||||
(let ((display (make-display Xdisplay #f)))
|
||||
(if (display-after-function display)
|
||||
((display-after-function display) display))))
|
||||
|
||||
(define-exported-binding "internal-after-function" internal-after-function)
|
||||
|
||||
;; the constructor
|
||||
|
||||
(define (make-display Xdisplay finalize?)
|
||||
(let ((maybe-display (display-list-find Xdisplay)))
|
||||
(if maybe-display
|
||||
|
|
Loading…
Reference in New Issue