XTkDelegationImpl.mesa
Copyright Ó 1991, 1992 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, July 2, 1991 1:58 pm PDT
Christian Jacobi, March 24, 1992 1:39 pm PST
An experimental friends level interface for XTk.
Try out a delegation concept.
Do expect this interface to evolve and don't expose it to further interfaces.
DIRECTORY
XTkDelegation,
XTk USING [GetWidgetProp, HasClassKey, Widget];
XTkDelegationImpl:
CEDAR
PROGRAM
IMPORTS XTk
EXPORTS XTkDelegation ~
BEGIN OPEN XTkDelegation;
SingleDelegant:
PUBLIC PROC [widget: XTk.Widget, expect:
ATOM, alternateKey:
REF]
RETURNS [XTk.Widget] = {
THROUGH [0..100]
DO
IF XTk.HasClassKey[widget, expect] THEN RETURN [widget];
--Should first check whether widget.class knows about delegations
WITH XTk.GetWidgetProp[widget, alternateKey]
SELECT
FROM
w: XTk.Widget => {widget ¬ w; LOOP};
ENDCASE => {
--Now should check whether alternateKey could lead to delegations
ERROR;
};
ENDLOOP;
ERROR;--probably infinite delegation
};
DidMultiDelegation:
PUBLIC PROC [widget: XTk.Widget, expect:
ATOM, alternateKey:
REF, proc:
PROC [w: XTk.Widget]]
RETURNS [did:
BOOL] = {
--It is up to proc to test whether delegated w is of right class.
--did: is true when proc is called or delegation explicitely worked and decided not to call proc.
IF XTk.HasClassKey[widget, expect] THEN RETURN [FALSE];
WITH XTk.GetWidgetProp[widget, alternateKey]
SELECT
FROM
wl:
LIST
OF XTk.Widget => {
FOR list:
LIST
OF XTk.Widget ¬ wl, list.rest
WHILE list#
NIL
DO
proc[list.first];
ENDLOOP;
did ¬ TRUE;
};
w: XTk.Widget => {
proc[w];
did ¬ TRUE;
};
ENDCASE => {
EachChild: XTkCollections.EachChildProc = {
IF ~child.destructionStarted THEN proc[child];
};
Try out collections; crashes if not a collection, but would ERROR afterwards anyway
XTkCollections.EnumerateChildren[collection: widget, eachChild: EachChild, data: alternateKey];
--Now should check whether alternateKey knows about delegations
ERROR;
};
};
END.