DIRECTORY Ascii USING [CR, FF, LF, SP, TAB], IO, Process, Rope USING [Fetch, ROPE, Size], Scheme, SchemeEvents USING [InputEvent, InputQueue, InputQueueRep, MouseEventRep], ScreenCoordsTypes USING [TIPScreenCoords]; SchemeEventsImpl: CEDAR MONITOR LOCKS queue USING queue: InputQueue IMPORTS IO, Process, Rope, Scheme EXPORTS SchemeEvents ~ BEGIN OPEN Scheme, SchemeEvents; MakeInputQueue: PUBLIC PROC RETURNS [InputQueue] ~ { head: LIST OF InputEvent ~ LIST[NIL]; queue: InputQueue ~ NEW[InputQueueRep ¬ [count: 0, head: head, last: head]]; TRUSTED { Process.EnableAborts[@queue.ready] }; RETURN [queue] }; Enqueue: PUBLIC ENTRY PROC [queue: InputQueue, a: InputEvent] ~ { InternalEnqueue[queue, a]; }; InternalEnqueue: INTERNAL PROC [queue: InputQueue, a: InputEvent] ~ INLINE { queue.last ¬ queue.last.rest ¬ LIST[a]; IF queue.count = 0 THEN BROADCAST queue.ready; queue.count ¬ queue.count + 1; }; EnqueueMouse: PUBLIC PROC [queue: InputQueue, me: MouseEventRep] ~ { Enqueue[queue, NEW[MouseEventRep ¬ me]]; }; StreamWaiter: PROC [queue: InputQueue, stream: IO.STREAM] ~ { [] ¬ IO.CharsAvail[self: stream, wait: TRUE]; StreamReady[queue, stream]; }; FlushAvailableWhitespace: PUBLIC PROC [stream: IO.STREAM] RETURNS [newlineRead: BOOL ¬ FALSE] ~ { WHILE IO.CharsAvail[stream] > 0 DO c: CHAR ~ IO.GetChar[stream ! IO.EndOfStream => EXIT]; SELECT c FROM Ascii.CR, Ascii.LF => { newlineRead ¬ TRUE }; Ascii.SP, Ascii.FF, Ascii.TAB => NULL; ENDCASE => { IO.Backup[stream, c]; EXIT }; ENDLOOP; }; EnqueueStream: PUBLIC ENTRY PROC [queue: InputQueue, stream: IO.STREAM] ~ { IF IO.CharsAvail[stream] > 0 THEN { InternalEnqueue[queue, stream] } ELSE TRUSTED { process: PROCESS ~ FORK StreamWaiter[queue, stream]; list: LIST OF PROCESS ¬ NARROW[queue.impl]; list ¬ CONS[process, list]; queue.impl ¬ list; Process.Detach[process]; }; }; GetCurrent: PROC RETURNS [PROCESS] ~ TRUSTED { RETURN [LOOPHOLE[Process.GetCurrent[]]] }; StreamReady: ENTRY PROC [queue: InputQueue, stream: IO.STREAM] ~ { ENABLE UNWIND => NULL; process: PROCESS ~ GetCurrent[]; WITH queue.impl SELECT FROM processes: LIST OF PROCESS => { prev: LIST OF PROCESS ¬ NIL; FOR tail: LIST OF PROCESS ¬ processes, tail.rest UNTIL tail = NIL DO IF tail.first = process THEN { IF prev = NIL THEN queue.impl ¬ tail.rest ELSE prev.rest ¬ tail.rest; InternalEnqueue[queue, stream]; RETURN; }; prev ¬ tail; ENDLOOP; }; ENDCASE => NULL; }; Reset: PUBLIC ENTRY PROC [queue: InputQueue] ~ { ENABLE UNWIND => NULL; WITH queue.impl SELECT FROM processes: LIST OF PROCESS => { FOR tail: LIST OF PROCESS ¬ processes, tail.rest UNTIL tail = NIL DO TRUSTED { Process.Abort[tail.first] }; ENDLOOP; }; ENDCASE => NULL; queue.count ¬ 0; queue.last ¬ queue.head; queue.head.first ¬ NIL; queue.head.rest ¬ NIL; queue.impl ¬ NIL; }; InputAvailable: PUBLIC ENTRY PROC [queue: InputQueue] RETURNS [BOOL] ~ { RETURN [queue.count # 0] }; Dequeue: PUBLIC ENTRY PROC [queue: InputQueue] RETURNS [a: InputEvent] ~ { ENABLE UNWIND => NULL; t: LIST OF InputEvent ¬ NIL; WHILE queue.count = 0 DO WAIT queue.ready ENDLOOP; t ¬ queue.head; queue.head ¬ t.rest; t.rest ¬ NIL; a ¬ queue.head.first; queue.count ¬ queue.count - 1; }; Notify: PUBLIC PROC [queue: InputQueue, input: LIST OF REF ANY] = { mx: INT ¬ 0; my: INT ¬ 0; ctrlshift: INT ¬ 0; includeCtrlShift: BOOL ¬ FALSE; button: ATOM ¬ NIL; Button: PROC [atom: ATOM] ~ { IF button = NIL THEN button ¬ atom ELSE bogus ¬ TRUE }; action: ATOM ¬ NIL; Action: PROC [atom: ATOM] ~ { IF action = NIL THEN action ¬ atom ELSE bogus ¬ TRUE }; bogus: BOOL ¬ FALSE; FOR tail: LIST OF REF ¬ input, tail.rest UNTIL tail = NIL DO WITH tail.first SELECT FROM z: ScreenCoordsTypes.TIPScreenCoords => { mx ¬ z.mouseX; my ¬ z.mouseY; }; atom: ATOM => { SELECT atom FROM $Ctrl => { ctrlshift ¬ ctrlshift + 2 }; $Shift => { ctrlshift ¬ ctrlshift + 1 }; $Red => { Button[$left] }; $Yellow => { Button[$middle] }; $Blue => { Button[$right] }; $Track => { Action[$mouseto]; includeCtrlShift ¬ TRUE; }; $Down => { Action[$buttondown]; includeCtrlShift ¬ TRUE; }; $Up => { Action[$buttonup]; includeCtrlShift ¬ TRUE; }; ENDCASE => { Action[atom] }; }; char: REF CHAR => { Enqueue[queue, MakeChar[char­]]; }; text: REF TEXT => { FOR i: NAT IN [0..text.length) DO Enqueue[queue, MakeChar[text[i]]]; ENDLOOP; }; rope: Rope.ROPE => { FOR i: INT IN [0..Rope.Size[rope]) DO Enqueue[queue, MakeChar[Rope.Fetch[rope, i]]]; ENDLOOP; }; ENDCASE => { bogus ¬ TRUE }; ENDLOOP; IF action = NIL THEN bogus ¬ TRUE; IF bogus THEN EnqueueMouse[queue, [action: $bogus, args: Reverse[Reverse[input]]]] ELSE EnqueueMouse[queue, [action: action, button: button, mx: mx, my: my, args: IF includeCtrlShift THEN Cons[MakeFixnum[ctrlshift], NIL] ELSE NIL]]; }; END. . SchemeEventsImpl.mesa Copyright Σ 1989, 1991 by Xerox Corporation. All rights reserved. Michael Plass, February 26, 1992 11:58 am PST This gets forked, and blocks until characters are available. ok: BOOL _ TRUE; eof: BOOL _ FALSE; Inner: PROC ~ { c _ IO.GetChar[stream ! IO.EndOfStream => {eof _ TRUE; CONTINUE};]; }; SchemeSys.DoWithIOErrorCatch[Inner ! Complain => { ok _ FALSE; Enqueue[queue, NEW[StreamErrorEventRep _ [stream, object, msg]]]; CONTINUE; }]; IF ok AND NOT eof THEN { IO.Backup[stream, c] }; IF ok THEN { Enqueue[queue, stream] }; Κ P•NewlineDelimiter –(cedarcode) style™codešœ™Kšœ Οeœ7™BK™-K™—šΟk ˜ Kš œžœžœžœžœžœžœ˜"Kšžœ˜Kšœ˜Kšœžœ žœ˜Kšœ˜Kšœ žœ8˜JKšœžœ˜*K˜—Kš Οnœžœžœžœžœ˜CKšžœžœ˜!Kšžœ ˜šœžœžœ˜"K˜šŸœž œžœ˜4Kš œžœžœžœžœ˜%Kšœžœ5˜LKšžœ(˜/Kšžœ˜Kšœ˜K˜—šŸœž œžœ'˜AKšœ˜Kšœ˜—K˜šŸœžœžœ&žœ˜LKšœžœ˜'Kšžœžœž œ ˜.K˜Kšœ˜K˜—šŸ œž œ+˜DKšœžœ˜(Kšœ˜K˜—šŸ œžœžœžœ˜=K™