XTkDelegation.mesa
Copyright Ó 1991 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, July 2, 1991 1:58 pm PDT
Christian Jacobi, March 24, 1992 1:20 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
XTk USING [HasClassKey, PutWidgetProp, Widget];
XTkDelegation:
CEDAR
DEFINITIONS
IMPORTS XTk ~
BEGIN
Set delegation
Delegate:
PROC [from: XTk.Widget, alternateKey:
REF, to:
REF] =
INLINE {
XTk.PutWidgetProp[from, alternateKey, to];
};
Single delegation
alternateKey is a property on widget which should return delegant widget
InlineSingleDelegant:
PROC [widget: XTk.Widget, expect:
ATOM, alternateKey:
REF]
RETURNS [XTk.Widget] =
INLINE {
IF XTk.HasClassKey[widget, expect]
THEN RETURN [widget]
ELSE RETURN [SingleDelegant[widget, expect, alternateKey]]
};
SingleDelegant: PROC [widget: XTk.Widget, expect: ATOM, alternateKey: REF] RETURNS [XTk.Widget];
Multiple delegation
alternateKey is a property on widget which should return delegant widget or LIST OF delegant widgets.
Not to do delegation is the simple case which expect the caller to implement the procedure directly.
InlineDidMultiDelegation:
PROC [widget: XTk.Widget, expect:
ATOM, alternateKey:
REF, proc:
PROC [w: XTk.Widget]]
RETURNS [did:
BOOL] =
INLINE {
--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]
ELSE RETURN [DidMultiDelegation[widget, expect, alternateKey, proc]];
};
DidMultiDelegation:
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.
END.