<*PRAGMA LL*> UNSAFE MODULE; IMPORT XClient, XClientF, XEventQueue, XScrollQueue, X, Thread, Unix, SchedulerPosix, Word, Rect, Region, TrestleClass, VBTClass, VBT, Ctypes; PROCEDURE XInput Start (trsl: XClient.T; stackSize := 20000) = BEGIN EVAL Thread.Fork( NEW(WaitForXInputClosure, xcon := trsl, stackSize := stackSize)); EVAL Thread.Fork( NEW(FilterXInputClosure, xcon := trsl, stackSize := stackSize)); END Start; TYPE WaitForXInputClosure = Thread.SizedClosure OBJECT xcon: XClient.T OVERRIDES apply := WaitForXInput END; PROCEDUREWaitForXInput (self: WaitForXInputClosure): REFANY RAISES {} = VAR checkIfClosed := FALSE; n : Ctypes.int; BEGIN TRY WITH xcon = self.xcon, dpy = xcon.dpy, file = X.XConnectionNumber(dpy) DO LOOP LOCK xcon DO WHILE (X.XEventsQueued(dpy, X.QueuedAfterReading) # 0) AND NOT xcon.dead DO checkIfClosed := FALSE; Thread.Signal(xcon.qNonEmpty); Thread.Wait(xcon, xcon.qEmpty) END; IF xcon.dead THEN EXIT END; IF checkIfClosed THEN IF (SchedulerPosix.IOWait(file, TRUE, 0.0D0) # SchedulerPosix.WaitResult.Timeout) AND (Unix.ioctl(file, Unix.FIONREAD, ADR(n)) < 0 OR n = 0) THEN XClientF.Kill(xcon); EXIT END END END; EVAL SchedulerPosix.IOWait(file, TRUE); checkIfClosed := TRUE END END EXCEPT X.Error => (* skip *) END; RETURN NIL END WaitForXInput; TYPE FilterXInputClosure = Thread.SizedClosure OBJECT xcon: XClient.T OVERRIDES apply := FilterXInput END; PROCEDUREFilterXInput (self: FilterXInputClosure): REFANY RAISES {} = VAR evRec : X.XEvent; ev := LOOPHOLE(ADR(evRec), X.XAnyEventStar); waiter : XClientF.WaitFor; ra : REFANY; enqueue: BOOLEAN; v : VBT.T; popped := FALSE; (* = in the middle of a sequence of GraphicsExpose *) ur : XClientF.Child; xcon := self.xcon; dpy := xcon.dpy; <*FATAL XEventQueue.Exhausted*> BEGIN TRY LOCK xcon DO LOOP WHILE (X.XEventsQueued(dpy, X.QueuedAfterReading) = 0) AND NOT xcon.dead AND XEventQueue.IsEmpty(xcon.errq) AND XEventQueue.IsEmpty(xcon.ooq) DO Thread.Signal(xcon.qEmpty); Thread.Wait(xcon, xcon.qNonEmpty) END; IF xcon.dead THEN EXIT END; IF NOT XEventQueue.IsEmpty(xcon.errq) THEN evRec := XEventQueue.Remove(xcon.errq) ELSIF XEventQueue.IsEmpty(xcon.ooq) THEN X.XNextEvent(dpy, ADR(evRec)) ELSIF X.XEventsQueued(dpy, X.QueuedAlready) = 0 THEN evRec := XEventQueue.Remove(xcon.ooq) ELSE VAR ooevr := XEventQueue.Peek(xcon.ooq); ooev := LOOPHOLE(ADR(ooevr), X.XAnyEventStar); BEGIN X.XPeekEvent(dpy, ADR(evRec)); IF Word.Minus(ev.serial, ooev.serial) < 0 THEN X.XNextEvent(dpy, ADR(evRec)) ELSE evRec := XEventQueue.Remove(xcon.ooq) END END END; IF (ev.type # 0) AND xcon.vbts.get(ev.window, ra) THEN v := ra; ur := v.upRef ELSE v := NIL; ur := NIL END; waiter := XClientF.FindWaiter(xcon, evRec); CASE ev.type OF X.KeyPress, X.KeyRelease => WITH e = LOOPHOLE(ev, X.XKeyEventStar) DO IF (ur # NIL) AND NOT ur.nwValid AND (e.same_screen # X.False) THEN ur.nw.h := e.x_root - e.x; ur.nw.v := e.y_root - e.y; ur.nwValid := TRUE END END; enqueue := ur # NIL | X.ButtonPress, X.ButtonRelease => WITH e = LOOPHOLE(ev, X.XButtonEventStar) DO IF ur # NIL AND e.same_screen # X.False THEN IF NOT ur.nwValid THEN ur.nw.h := e.x_root - e.x; ur.nw.v := e.y_root - e.y; ur.nwValid := TRUE END; IF ur.inside THEN e.subwindow := ur.w ELSE e.subwindow := X.None END END END; enqueue := ur # NIL | X.EnterNotify, X.LeaveNotify => WITH e = LOOPHOLE(ev, X.XCrossingEventStar) DO IF (ur # NIL) AND NOT ur.nwValid AND (e.same_screen # X.False) THEN ur.nw.h := e.x_root - e.x; ur.nw.v := e.y_root - e.y; ur.nwValid := TRUE END; enqueue := (e.root = e.window AND e.detail # X.NotifyInferior) OR ((ur # NIL) AND ((e.type = X.EnterNotify) AND (e.detail # X.NotifyVirtual) AND (e.detail # X.NotifyNonlinearVirtual) OR (e.type = X.LeaveNotify) AND (e.detail # X.NotifyInferior))); IF ur # NIL THEN ur.inside := e.type = X.EnterNotify OR e.detail = X.NotifyInferior; IF NOT ur.inside THEN ur.recentlyOutside := TRUE END; ur.underXFocus := e.focus # X.False END; END | X.MotionNotify => WITH e = LOOPHOLE(ev, X.XMotionEventStar) DO IF (ur # NIL) AND NOT ur.nwValid AND (e.same_screen # X.False) THEN ur.nw.h := e.x_root - e.x; ur.nw.v := e.y_root - e.y; ur.nwValid := TRUE END; END; enqueue := TRUE | X.FocusIn, X.FocusOut => WITH e = LOOPHOLE(ev, X.XFocusChangeEventStar) DO enqueue := ur # NIL AND e.mode # X.NotifyGrab AND e.mode # X.NotifyUngrab; IF enqueue THEN ur.isXFocus := e.type = X.FocusIn AND e.detail # X.NotifyPointer; ur.underXFocus := e.type = X.FocusIn OR e.detail = X.NotifyAncestor; END END | X.UnmapNotify => IF (ur # NIL) AND ur.mapped THEN enqueue := NOT ur.reshapeComing; IF enqueue THEN ur.reshapeComing := TRUE; ur.oldWidth := ur.width; ur.oldHeight := ur.height END; ur.mapped := FALSE; ur.serial := ev.serial ELSE enqueue := FALSE END | X.MapNotify => IF (ur # NIL) AND NOT ur.mapped THEN enqueue := NOT ur.reshapeComing; IF enqueue THEN ur.reshapeComing := TRUE; ur.oldWidth := 0; ur.oldHeight := 0 END; ur.mapped := TRUE; ur.serial := ev.serial ELSE enqueue := FALSE END | X.ReparentNotify => IF ur # NIL THEN ur.nwValid := FALSE END; enqueue := FALSE | X.ConfigureNotify => WITH e = LOOPHOLE(ev, X.XConfigureEventStar) DO IF ur # NIL THEN IF e.send_event # X.False THEN ur.nw.h := e.x + e.border_width; ur.nw.v := e.y + e.border_width; ur.nwValid := TRUE ELSE ur.nwValid := FALSE END; IF ur.width = e.width AND ur.height = e.height THEN e.send_event := X.True ELSE e.send_event := X.False END; enqueue := NOT ur.reshapeComing AND ur.mapped; IF NOT ur.reshapeComing THEN ur.oldWidth := ur.width; ur.oldHeight := ur.height; ur.reshapeComing := enqueue END; ur.width := e.width; ur.height := e.height; ur.serial := e.serial ELSE enqueue := FALSE END END | X.PropertyNotify => enqueue := FALSE | X.GraphicsExpose => enqueue := FALSE; IF (waiter = NIL) AND (ur # NIL) THEN WITH e = LOOPHOLE(ev, X.XGraphicsExposeEventStar) DO IF NOT popped THEN PopScroll(ur) END; ExpandBadRegion( ur, XClientF.ToRect(e.x, e.y, e.width, e.height)); popped := e.count # 0; IF NOT popped THEN enqueue := TRUE END END END | X.NoExpose => IF (waiter = NIL) AND (ur # NIL) THEN PopScroll(ur) END; enqueue := FALSE | X.Expose => IF (waiter = NIL) AND (ur # NIL) THEN WITH e = LOOPHOLE(ev, X.XExposeEventStar) DO IF e.serial = ur.serial THEN ExpandBadRegion( ur, Rect.Meet( XClientF.ToRect(e.x, e.y, e.width, e.height), Rect.FromSize(ur.oldWidth, ur.oldHeight))) ELSE ExpandBadRegion( ur, XClientF.ToRect(e.x, e.y, e.width, e.height)) END; enqueue := e.count = 0 END ELSE enqueue := FALSE END | X.MappingNotify => enqueue := TRUE | X.DestroyNotify, X.SelectionClear, X.ClientMessage, X.VisibilityNotify => enqueue := ur # NIL ELSE enqueue := FALSE END; IF waiter # NIL THEN waiter.notify(evRec, xcon); (* waiter.turn := TRUE; waiter.ev := evRec; waiter.timeout := FALSE; Thread.Signal(waiter); WHILE waiter.turn AND NOT xcon.dead DO Thread.Wait(xcon, waiter) END *) (* selection requests now have a waiter *) (* ELSIF ev.type = X.SelectionRequest THEN WITH e = LOOPHOLE(ev, X.XSelectionRequestEventStar) DO FOR s := FIRST(xcon.sel^) TO LAST(xcon.sel^) DO IF xcon.sel[s].name = e.selection THEN XProperties.StartSelection( xcon, e.requestor, e.target, e.property, VBT.Selection{s}, e.time) END END END *) ELSIF enqueue THEN IF XEventQueue.IsEmpty(xcon.evq) THEN Thread.Signal(xcon.evc) END; XEventQueue.Insert(xcon.evq, evRec) ELSIF xcon.eventHook # NIL THEN xcon.eventHook(xcon, evRec) END END END EXCEPT X.Error => (* skip *) END; RETURN NIL END FilterXInput; PROCEDUREPopScroll (ur: XClientF.Child) = (* Remove a scroll from the queue of unacknowleged scrolls in ur. LL = ur.ch.parent *) <*FATAL XScrollQueue.Exhausted*> BEGIN EVAL XScrollQueue.Remove(ur.scrollQ) END PopScroll; PROCEDUREExpandBadRegion (ur: XClientF.Child; READONLY br: Rect.T) = (* Every x-vbt has an x-bad-region, which this expands. If you call this, you must eventually call DeliverBadRegion. LL = ur.ch.parent *) VAR i := ur.scrollQ.lo; bad := Region.FromRect(br); BEGIN WITH hi = ur.scrollQ.hi, buff = ur.scrollQ.buff DO WHILE i # hi DO WITH sc = buff[i] DO bad := Region.Join(bad, Region.Add(Region.MeetRect( Rect.Sub(sc.clip, sc.delta), bad), sc.delta)) END; INC(i); IF i = NUMBER(buff^) THEN i := 0 END END END; ur.badR := Region.Join(ur.badR, bad) END ExpandBadRegion; BEGIN END XInput.