scsh-conservatory
/
scx
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

corrected the implementation of the after-function stuff.

This commit is contained in:
frese 2001-08-29 14:52:44 +00:00
parent b0a1f88472
commit 3a36140b69
2 changed files with 40 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
c/xlib/display.c
View File

@ -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);

17
scheme/xlib/display-type.scm
View File

@ -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