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

- the xlib-internal event-queue was not respected in event-ready? and 

wait-event etc.
This commit is contained in:
frese 2002-03-17 15:44:45 +00:00
parent a7ec9ccd53
commit 2c91c73a18
2 changed files with 79 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
c/xlib/event.c
View File

@ -433,8 +433,8 @@ XEvent scx_extract_event(s48_value type, s48_value v) {
e.xmap.override_redirect = S48_EXTRACT_BOOLEAN(REF(6));
} break;
case MapRequest: {
e.xmaprequest.window = SCX_EXTRACT_WINDOW(REF(4));
e.xmaprequest.parent = SCX_EXTRACT_WINDOW(REF(5));
e.xmaprequest.parent = SCX_EXTRACT_WINDOW(REF(4));
e.xmaprequest.window = SCX_EXTRACT_WINDOW(REF(5));
} break;
case ReparentNotify: {
e.xreparent.event = SCX_EXTRACT_WINDOW(REF(4));
@ -603,6 +603,12 @@ s48_value scx_Peek_Event(s48_value Xdisplay) {
return scx_enter_event(&e);
}
s48_value scx_Events_Queued(s48_value Xdisplay, s48_value mode) {
int r = XEventsQueued(SCX_EXTRACT_DISPLAY(Xdisplay),
s48_extract_integer(mode));
return s48_enter_integer(r);
}
s48_value scx_Events_Pending(s48_value Xdisplay) {
return s48_enter_integer(XPending(SCX_EXTRACT_DISPLAY(Xdisplay)));
}
@ -647,6 +653,7 @@ void scx_init_event(void) {
S48_EXPORT_FUNCTION(scx_Send_Event);
S48_EXPORT_FUNCTION(scx_Next_Event);
S48_EXPORT_FUNCTION(scx_Peek_Event);
S48_EXPORT_FUNCTION(scx_Events_Queued);
S48_EXPORT_FUNCTION(scx_Events_Pending);
S48_EXPORT_FUNCTION(scx_Get_Motion_Events);
S48_EXPORT_FUNCTION(scx_add_pending_channel);

109
scheme/xlib/event.scm
View File

@ -1,7 +1,14 @@
;; Thread-safe event reading *****************************************
;; wait-event blocks the current thread until an event is available,
;; and then it returns this new event.
(define (wait-event dpy) ; needs ports, locks
(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) ; needs ports, locks
(let ((port (display-message-inport dpy)))
(disable-interrupts!)
(if (not (char-ready? port))
@ -10,14 +17,69 @@
(add-pending-channel (port->channel port))
(wait-for-channel (port->channel port)) ;; enables interrupts
(release-lock (port-lock port)))
(enable-interrupts!))
(next-event dpy)))
(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 *********************
(define (event-ready? display)
(char-ready? (display-message-inport display)))
(or (> (events-queued display (queued-mode already)) 0)
(char-ready? (display-message-inport display))))
(define (send-event window propagate? event-mask event)
(let ((Xdisplay (display-Xdisplay (window-display window)))
(define (events-queued display mode)
(%events-queued (display-Xdisplay display)
(queued-mode->integer mode)))
(import-lambda-definition %events-queued (Xdisplay mode)
"scx_Events_Queued")
(define-enumerated-type queued-mode :queued-mode
queued-mode? queued-modes queued-mode-name queued-mode-index
(already after-reading after-flush))
(define (queued-mode->integer mode)
(queued-mode-index mode))
;; events-pending is identical to events-pending with after-flush
;; mode.
(define (events-pending display)
(%events-pending (display-Xdisplay display)))
(import-lambda-definition %events-pending (Xdisplay)
"scx_Events_Pending")
;; Other event reading ***********************************************
(define (next-event display)
(let ((r (%next-event (display-Xdisplay display))))
(complete-event r)))
(import-lambda-definition %next-event (Xdisplay)
"scx_Next_Event")
(define (peek-event display)
(let ((r (%peek-event (display-Xdisplay display))))
(complete-event r)))
(import-lambda-definition %peek-event (Xdisplay)
"scx_Peek_Event")
(define (get-motion-events window from-time to-time)
(%get-motion-events (display-Xdisplay (window-display window))
(window-Xwindow window)
from-time to-time))
(import-lambda-definition %get-motion-events (Xdisplay Xwindow from to)
"scx_Get_Motion_Events")
;; Sending events ****************************************************
(define (send-event display window propagate? event-mask event)
(let ((Xdisplay (display-Xdisplay display))
(Xwindow (window-Xwindow window))
(mask (event-mask->integer event-mask))
(v (any-event->vector event))
@ -27,6 +89,8 @@
(import-lambda-definition %send-event (Xdisplay Xwindow propagate mask v type)
"scx_Send_Event")
;; Auxiliaries *******************************************************
;; creates an event type
(define (complete-event v)
@ -73,37 +137,4 @@
;;event-type-0 event-type-1 ;; those are not defined
(define (next-event display)
(let ((r (%next-event (display-Xdisplay display))))
(complete-event r)))
(import-lambda-definition %next-event (Xdisplay)
"scx_Next_Event")
(define (peek-event display)
(let ((r (%peek-event (display-Xdisplay display))))
(complete-event r)))
(import-lambda-definition %peek-event (Xdisplay)
"scx_Peek_Event")
(define (events-pending display)
(%events-pending (display-Xdisplay display)))
; (if (event-ready? display)
; (%events-pending (display-Xdisplay display))
; 0))
(import-lambda-definition %events-pending (Xdisplay)
"scx_Events_Pending")
(define (get-motion-events window from-time to-time)
(%get-motion-events (display-Xdisplay (window-display window))
(window-Xwindow window)
from-time to-time))
(import-lambda-definition %get-motion-events (Xdisplay Xwindow from to)
"scx_Get_Motion_Events")
;;; Only here until scsh provides us with select
(import-lambda-definition add-pending-channel (channel)
"scx_add_pending_channel")