SchemeEventsImpl.mesa
Copyright Ó 1989, 1991 by Xerox Corporation. All rights reserved.
Michael Plass, February 26, 1992 11:58 am PST
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];
~
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] ~ {
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] };
[] ¬ 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]];
};