SimpleStreamsImpl.mesa
Copyright Ó 1988, 1992 by Xerox Corporation. All rights reserved.
Christian Jacobi, August 26, 1988 11:12:22 am PDT
Christian Jacobi, October 6, 1988 3:08:15 pm PDT
DIRECTORY
Ascii, IO, EditedStream, RefTab, Rope, SafeStorage, SimpleStreams;
SimpleStreamsImpl:
CEDAR
MONITOR
IMPORTS EditedStream, IO, RefTab, SafeStorage
EXPORTS SimpleStreams =
BEGIN OPEN SimpleStreams;
TypeReg: TYPE = RECORD [type: SafeStorage.Type, p: CreateProcType];
types: LIST OF TypeReg ¬ NIL; --there will be only a very small number of registered types
tab: RefTab.Ref ¬ RefTab.Create[3]; --registered window systems
default: REF ¬ NIL; --existence checked before assignment
Find:
PROC [ws:
REF]
RETURNS [found:
REF¬
NIL, proc: CreateProcType¬
NIL] = {
WITH RefTab.Fetch[tab, ws].val
SELECT
FROM
pr: REF CreateProcType => {RETURN[ws, pr]};
ENDCASE => {};
WITH ws
SELECT
FROM
la:
LIST
OF
ATOM =>
--recurse on elements of list
FOR l:
LIST
OF
ATOM ¬ la, l.rest
WHILE l#
NIL
DO
[found, proc] ¬ Find[l.first];
IF found#NIL THEN RETURN;
ENDLOOP;
lra:
LIST
OF
REF
ANY =>
--recurse on elements of list
FOR l:
LIST
OF
REF
ANY ¬ lra, l.rest
WHILE l#
NIL
DO
[found, proc] ¬ Find[l.first];
IF found#NIL THEN RETURN;
ENDLOOP;
a: ATOM => RETURN; --prevent endcase: not worth going through types
ENDCASE => {
IF ws#
NIL
AND types#
NIL
THEN {
type: SafeStorage.Type ¬ SafeStorage.GetReferentType[ws];
FOR l:
LIST
OF TypeReg ¬ types, l.rest
WHILE l#
NIL
DO
IF type=l.first.type THEN RETURN [ws, l.first.p];
ENDLOOP;
FOR l:
LIST
OF TypeReg ¬ types, l.rest
WHILE l#
NIL
DO
IF SafeStorage.EquivalentTypes[type, l.first.type] THEN RETURN [ws, l.first.p];
ENDLOOP;
};
};
};
Create:
PUBLIC
PROC [header: Rope.
ROPE ¬
NIL, echo:
BOOL ¬
TRUE, windowSystem:
REF ¬
NIL]
RETURNS [in, out, err:
IO.
STREAM, hasEcho:
BOOL] = {
ws: REF ¬ NIL; proc: CreateProcType ¬ NIL;
IF windowSystem#NIL THEN [ws, proc] ¬ Find[windowSystem];
IF proc=
NIL
THEN {
[ws, proc] ¬ Find[default];
IF proc=NIL THEN proc ¬ NoWhereCreate;
};
[in, out, err, hasEcho] ¬ proc[header, echo, ws];
IF echo
AND ~hasEcho
THEN
in ¬ EditedStream.Create[in: in, echoTo: out, deliverWhen: DeliverOnCrOrLf];
IF err=NIL THEN err ¬ out;
};
SetCurrentCreate:
PUBLIC PROC [windowSystem:
REF, scope:
REF ¬
NIL] = {
ws: REF ¬ NIL; proc: CreateProcType ¬ NIL;
[ws, proc] ¬ Find[windowSystem];
IF ws#NIL AND proc#NIL THEN default ¬ ws;
};
ImplementCreate:
PUBLIC
ENTRY
PROC [windowSystem:
REF, create: CreateProcType, setCurrent:
BOOL ¬
TRUE] = {
--ENTRY to protect the CONS'ing of type registrations
ENABLE UNWIND => NULL;
IF create#
NIL
THEN {
WITH windowSystem
SELECT
FROM
tr: REF SafeStorage.Type => types ¬ CONS[TypeReg[tr, create], types];
ENDCASE => [] ¬ RefTab.Store[tab, windowSystem, NEW[CreateProcType ¬ create]];
IF setCurrent THEN SetCurrentCreate[windowSystem];
};
};
DeliverOnCrOrLf: EditedStream.DeliverWhenProc = {
IF char = Ascii.
DEL
THEN {
--prevent raising EditedStream.Rubout
--(not an allowed error to be raised by streams; Pfui EditedStream)
RETURN [appendChar: FALSE, activate: FALSE];
};
RETURN [appendChar: TRUE, activate: char = '\l OR char = '\r]
};
NoWhereCreate: CreateProcType = {
in ¬ IO.noInputStream; out ¬ err ¬ IO.noWhereStream; hasEcho ¬ echo;
};
ImplementCreate[NIL, NoWhereCreate, TRUE];
END.