XTkOpsImpl.mesa
Copyright Ó 1991, 1992, 1993 by Xerox Corporation. All rights reserved.
Christian Jacobi, March 8, 1991 3:12:12 pm PST
Christian Jacobi, February 24, 1993 0:03 am PST
DIRECTORY
Xl,
XTk,
XTkFriends,
XTkOps,
XTkShellWidgets;
XTkOpsImpl:
CEDAR
MONITOR
LOCKS widget USING widget: XTk.Widget
IMPORTS Xl, XTk, XTkFriends, XTkShellWidgets
EXPORTS XTkOps =
BEGIN
RegisterNotifierProcOnEvents:
PUBLIC
PROC [widget: XTk.Widget, handles: Xl.EventFilter, tq: XTk.TQ, generate: Xl.SetOfEvent, proc--LX--: XTk.WidgetNotifyProc, registerData
, callData:
REF, temporary:
BOOL ¬
FALSE] = {
d: REF ThisNotifierData ~ NEW[ThisNotifierData ¬ [w: widget, proc: proc, registerData: registerData, callData: callData]];
IF tq=NIL THEN tq ¬ widget.rootTQ;
IF proc=NIL THEN ERROR;
IF temporary
THEN XTk.AddTemporaryMatch[widget, [CallThisNotifierNow, handles, tq, d], generate]
ELSE XTk.AddPermanentMatch[widget, [CallThisNotifierNow, handles, tq, d], generate];
};
CallThisNotifierNow: Xl.EventProcType = {
d: REF ThisNotifierData ~ NARROW[clientData];
d.proc[widget: d.w, registerData: d.registerData, callData: d.callData, event: event];
};
ThisNotifierData:
TYPE =
RECORD [
w: XTk.Widget,
proc: XTk.WidgetNotifyProc,
registerData, callData: REF
];
RegisterCallNotifiersOnEvents:
PUBLIC
PROC [widget: XTk.Widget, handles: Xl.EventFilter, tq: XTk.
TQ, generate: Xl.SetOfEvent, notifierKey:
REF, callData:
REF, temporary:
BOOL ¬
FALSE] = {
d: REF RegisteredNotifiersData ~ NEW[RegisteredNotifiersData ¬ [w: widget, notifierKey: notifierKey, callData: callData]];
IF tq=NIL THEN tq ¬ widget.rootTQ;
XTk.RegisterNotifier[widget, XTk.postStopFastAccessKey, RemoveRegisteredNotifiers, d];
IF temporary
THEN XTk.AddTemporaryMatch[widget, [CallRegisteredNotifiersNow, handles, tq, d], generate]
ELSE XTk.AddPermanentMatch[widget, [CallRegisteredNotifiersNow, handles, tq, d], generate];
};
RegisteredNotifiersData:
TYPE =
RECORD [
w: XTk.Widget,
notifierKey, callData: REF
];
CallRegisteredNotifiersNow: Xl.EventProcType = {
d: REF RegisteredNotifiersData ~ NARROW[clientData];
XTkFriends.CallNotifiers[widget: d.w, key: d.notifierKey, event: event, callData: d.callData];
};
RemoveRegisteredNotifiers: XTk.WidgetNotifyProc = {
d: REF RegisteredNotifiersData ~ NARROW[registerData];
XTkFriends.RemoveNotifiers[widget: d.w, key: d.notifierKey];
};
GetWidgetPropStar:
PUBLIC PROC [w: XTk.Widget, key:
REF]
RETURNS [val:
REF ¬
NIL, who: XTk.Widget ¬
NIL] = {
val ¬ XTk.GetWidgetProp[w, key]; who ¬ w;
WHILE val=
NIL
AND w.parent#
NIL
DO
w ¬ w.parent;
val ¬ XTk.GetWidgetProp[w, key]; who ¬ w;
ENDLOOP;
IF val=
NIL
THEN {
c: Xl.Connection ¬ w.connection;
IF Xl.Alive[c] THEN val ¬ Xl.GetConnectionProp[w.connection, key];
who ¬ NIL
};
};
DestructionRegRec:
TYPE =
RECORD [
shell: XTk.Widget, --to be destroyed
triggerKey: REF,
trigger: XTk.Widget
];
TriggerNotify: XTk.WidgetNotifyProc = {
--The destruction which has been setup with "SetupDestruction" is triggered
drr: REF DestructionRegRec ~ NARROW[registerData];
shell: XTk.Widget ~ drr.shell;
IF shell#
NIL
THEN {
XTkShellWidgets.DestroyShell[shell];
drr.shell ¬ NIL; --just being friendly
};
};
CanUnregisterNotify: XTk.WidgetNotifyProc = {
--The registered widget died; unregister it from its trigger
drr: REF DestructionRegRec ~ NARROW[registerData];
trigger: XTk.Widget ~ drr.trigger;
IF trigger#
NIL
THEN {
XTk.UnRegisterNotifier[trigger, drr.triggerKey, TriggerNotify, drr];
drr.trigger ¬ NIL; --just being friendly
};
};
SetupDestruction:
PUBLIC
PROC [shell: XTk.Widget, trigger: XTk.Widget, triggerKey:
REF ¬
NIL] = {
drr: REF DestructionRegRec;
IF triggerKey=NIL THEN triggerKey ¬ XTk.forgetScreenKey;
drr ¬ NEW[DestructionRegRec ¬ [shell: shell, trigger: trigger, triggerKey: triggerKey]];
XTk.RegisterNotifier[trigger, triggerKey, TriggerNotify, drr];
XTk.RegisterNotifier[shell, XTk.postWidgetDestructionKey, CanUnregisterNotify, drr];
};
END.