SlateCommonImpl.mesa
Copyright Ó 1992, 1993 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, November 2, 1990 1:04:32 pm PST
Christian Jacobi, July 3, 1993 9:58 am PDT
DIRECTORY
IO,
PropList,
Rope,
SharedCell,
SlatePrivateTypes,
Slate;
SlateCommonImpl:
CEDAR
MONITOR
IMPORTS IO, SharedCell, PropList
EXPORTS Slate ~
BEGIN OPEN Slate;
SessionPrivateRec: PUBLIC TYPE = SlatePrivateTypes.SessionPrivateRec;
InstancePrivateRec: PUBLIC TYPE = SlatePrivateTypes.InstancePrivateRec;
CallbackList: TYPE = SlatePrivateTypes.CallbackList;
CallbackRec: TYPE = SlatePrivateTypes.CallbackRec;
ClosureList: TYPE = SlatePrivateTypes.ClosureList;
ClosureRec: TYPE = SlatePrivateTypes.ClosureRec;
globalProperties: PUBLIC PropList.List ¬ PropList.NewPropList[];
globalCallbacks: CallbackList ¬ NIL;
GetCallback:
PROC [callbacks: CallbackList, event:
REF
ANY]
RETURNS [CallbackList ¬
NIL] = {
WHILE callbacks#
NIL
DO
IF callbacks.first.event=event THEN RETURN [callbacks];
callbacks ¬ callbacks.rest;
ENDLOOP
};
CallCallbackList:
PROC [callbacks: CallbackList, instance: Instance, session: Session, event:
REF, callData:
REF] = {
cbl: CallbackList ¬ GetCallback[callbacks, event];
IF cbl#
NIL
THEN {
closures: ClosureList ¬ cbl.first.closures;
WHILE closures#
NIL
DO
closures.first.proc[instance: instance, session: session, callData: callData, registerData: closures.first.registerData, event: event];
closures ¬ closures.rest;
ENDLOOP;
};
};
CallGlobalEvent:
PUBLIC
PROC [instance: Instance, session: Session, event:
REF, callData:
REF ¬
NIL] = {
CallCallbackList[globalCallbacks, instance, session, event, callData];
};
CallSessionEvent:
PUBLIC
PROC [instance: Instance, session: Session, event:
REF, callData:
REF ¬
NIL] = {
spr: REF SessionPrivateRec;
IF session=NIL THEN session ¬ instance.session;
spr ¬ session.private;
CallCallbackList[spr.callbacks, instance, session, event, callData];
};
CallInstanceEvent:
PUBLIC
PROC [instance: Instance, session: Session, event:
REF, callData:
REF ¬
NIL] = {
ipr: REF InstancePrivateRec ¬ instance.private;
CallCallbackList[ipr.callbacks, instance, session, event, callData];
};
RegisterClosure:
ENTRY
PROC [cbl: CallbackList, proc: EventProc, registerData:
REF] = {
cbl.first.closures ¬ CONS[[proc, registerData], cbl.first.closures]
};
RegisterGlobalEventProc:
PUBLIC
PROC [event:
REF, proc: EventProc, registerData:
REF] = {
GetOrCreateCallback:
ENTRY
PROC [event:
REF]
RETURNS [cbl: CallbackList] = {
cbl ¬ GetCallback[globalCallbacks, event];
IF cbl=
NIL
THEN
globalCallbacks ¬ cbl ¬ CONS[[event: event, closures: NIL], globalCallbacks];
};
p: EventProc ¬ proc;
IF p#
NIL
THEN {
cbl: CallbackList ¬ GetOrCreateCallback[event];
RegisterClosure[cbl, p, registerData];
};
};
RegisterSessionEventProc:
PUBLIC
PROC [session: Session, event:
REF, proc: EventProc, registerData:
REF] = {
GetOrCreateCallback:
ENTRY
PROC [spr:
REF SessionPrivateRec, event:
REF]
RETURNS [cbl: CallbackList] = {
cbl ¬ GetCallback[spr.callbacks, event];
IF cbl=
NIL
THEN
spr.callbacks ¬ cbl ¬ CONS[[event: event, closures: NIL], spr.callbacks];
};
p: EventProc ¬ proc;
spr: REF SessionPrivateRec ¬ session.private;
IF spr#
NIL
AND p#
NIL
THEN {
cbl: CallbackList ¬ GetOrCreateCallback[spr, event];
RegisterClosure[cbl, p, registerData];
};
};
RegisterInstanceEventProc:
PUBLIC
PROC [instance: Instance, event:
REF, proc: EventProc, registerData:
REF] = {
GetOrCreateCallback:
ENTRY
PROC [ipr:
REF InstancePrivateRec, event:
REF]
RETURNS [cbl: CallbackList] = {
cbl ¬ GetCallback[ipr.callbacks, event];
IF cbl=
NIL
THEN
ipr.callbacks ¬ cbl ¬ CONS[[event: event, closures: NIL], ipr.callbacks];
};
p: EventProc ¬ proc;
ipr: REF InstancePrivateRec ¬ instance.private;
IF ipr#
NIL
AND p#
NIL
THEN {
cbl: CallbackList ¬ GetOrCreateCallback[ipr, event];
RegisterClosure[cbl, p, registerData];
};
};
SetSessionName:
PUBLIC
PROC [session: Session, name: Rope.
ROPE] = {
SharedCell.SetContents[session.nameCell, name];
CallGlobalEvent[instance:
NIL, session: session, event: $SessionRenamed0, callData: name
!
UNCAUGHT => {
--catch uncaught because there is an uncaught error in SlateJoinAppImpl (July 2, 1993)
IO.PutRope[session.debugLog, "uncaught error while renaming session\n"];
CONTINUE
}];
};
SessionName:
PUBLIC PROC [session: Session]
RETURNS [Rope.
ROPE] = {
WITH SharedCell.GetContents[session.nameCell]
SELECT
FROM
r: Rope.ROPE => RETURN [r];
ENDCASE => RETURN [NIL];
};
END.