XTkInputFocusImpl.mesa
Copyright Ó 1992 by Xerox Corporation. All rights reserved.
Christian Jacobi, March 8, 1991 3:12:12 pm PST
Christian Jacobi, March 24, 1992 1:20 pm PST
DIRECTORY
Xl, XTk, XTkInputFocus, XTkPrivate, XTkShellWidgets;
XTkInputFocusImpl:
CEDAR
MONITOR
IMPORTS Xl, XTk, XTkPrivate, XTkShellWidgets
EXPORTS XTkInputFocus =
BEGIN
classImplementsFocus: XTk.ClassFlagKey ~ cf1;
inputFocusDelegatedFlag: XTk.WidgetFlagKey ~ wf4;
inputFocusSelfFlag: XTk.WidgetFlagKey ~ wf5;
SetFocus:
PUBLIC
PROC [w: XTk.Widget, time: Xl.TimeStamp ¬ Xl.currentTime] = {
IF w#
NIL
AND w.fastAccessAllowed=ok
THEN {
c: Xl.Connection ~ w.connection;
IF Xl.Alive[c]
THEN {
root: XTk.Widget ~ XTk.RootWidget[w];
IF time=Xl.currentTime THEN time ¬ Xl.LastTime[c];
IF XTkShellWidgets.IsShell[root]
THEN XTkShellWidgets.SetFocus[shell: root, time: time, child: w]
ELSE Xl.SetInputFocus[c, w.window, parent, time, XTkPrivate.detailsForFlushNoErrors];
};
};
};
GiveUpFocus:
PUBLIC
PROC [w: XTk.Widget, time: Xl.TimeStamp ¬ Xl.currentTime] = {
IF w#
NIL
THEN {
c: Xl.Connection ¬ w.connection;
IF Xl.Alive[c]
THEN {
IF time=Xl.currentTime THEN time ¬ Xl.LastTime[c];
Xl.SetInputFocus[c: c, window: Xl.focusPointerRoot, timeStamp: time, details: XTkPrivate.detailsForFlushNoErrors];
};
};
};
ImplementsFocus:
PROC [w: XTk.Widget]
RETURNS [
BOOL ¬
FALSE] =
INLINE {
IF XTk.GetWidgetFlag[w, inputFocusSelfFlag] THEN RETURN [TRUE];
IF XTk.GetClassFlag[w.s.class, classImplementsFocus] THEN RETURN [TRUE];
};
DelegationImplementsFocus:
PROC [w: XTk.Widget]
RETURNS [
BOOL ¬
FALSE] =
INLINE {
RETURN [ XTk.GetWidgetFlag[w, inputFocusDelegatedFlag] ];
};
FocusFor:
PROC [w: XTk.Widget]
RETURNS [XTk.Widget ¬
NIL] = {
THROUGH [0..100 <<prevents infinite loop through circular delegation>>]
DO
IF w=NIL OR w.fastAccessAllowed#ok THEN RETURN [NIL];
IF DelegationImplementsFocus[w]
THEN {
WITH XTk.GetWidgetProp[w, $FocusDelegation]
SELECT
FROM
ww: XTk.Widget => {w ¬ ww; LOOP};
ENDCASE => {};
};
IF ImplementsFocus[w] THEN RETURN [w];
RETURN [NIL];
ENDLOOP;
};
FirstFocusTarget:
PUBLIC PROC [w: XTk.Widget, searchLimit:
INT ¬ 5]
RETURNS [found: XTk.Widget¬
NIL] = {
EachChild: XTk.EachChild = {
try: XTk.Widget ~ FirstFocusTarget[child, searchLimit-1];
IF try#NIL AND try.fastAccessAllowed=ok THEN {found ¬ try; stop ¬ TRUE}
};
IF w#
NIL
AND w.fastAccessAllowed=ok
THEN {
try: XTk.Widget ~ FocusFor[w];
IF try#NIL THEN RETURN [try];
IF searchLimit>=0 THEN XTk.ShallowInternalEnumerateChildren[w, EachChild, NIL];
};
};
NextFocusTarget:
PUBLIC
PROC [w: XTk.Widget, searchLimit:
INT ¬ 5]
RETURNS [XTk.Widget ¬
NIL] = {
parent: XTk.Widget ¬ w.parent;
parentsChild: XTk.Widget ¬ w;
WITH XTk.GetWidgetProp[w, $Next]
SELECT
FROM
w: XTk.Widget => RETURN [FirstFocusTarget[w, searchLimit]];
ENDCASE => {};
THROUGH [0..searchLimit]
DO
EachSibling: XTk.EachChild = {
IF foundSelf
THEN {
--use next younger sibling
goal ¬ FirstFocusTarget[child, searchLimit-1];
IF goal#NIL THEN stop ¬ TRUE
}
ELSE {
--ignore older siblings
IF child=parentsChild THEN foundSelf ¬ TRUE
};
};
foundSelf: BOOL ¬ FALSE;
goal: XTk.Widget ¬ NIL;
IF parent=NIL THEN RETURN [NIL];
IF FocusFor[parent]=
NIL
THEN {
XTk.ShallowInternalEnumerateChildren[parent, EachSibling, NIL];
IF goal#NIL THEN RETURN [goal];
};
parentsChild ¬ parent;
parent ¬ parent.parent
ENDLOOP;
};
SetNext:
PUBLIC
PROC [w: XTk.Widget, using: XTk.Widget ¬
NIL] = {
IF w#
NIL
THEN {
XTk.PutWidgetProp[w, $Next, using];
};
};
Implement:
PUBLIC
PROC [w: XTk.Widget, bool:
BOOL ¬
TRUE] = {
IF w#NIL THEN XTk.SetWidgetFlag[w, inputFocusSelfFlag, bool];
};
Delegate:
PUBLIC
PROC [w: XTk.Widget, using: XTk.Widget ¬
NIL] = {
SELECT
TRUE
FROM
w=NIL => RETURN;
w=using
OR using=
NIL => {
XTk.SetWidgetFlag[w, inputFocusDelegatedFlag, FALSE];
};
ENDCASE => {
XTk.PutWidgetProp[w, $FocusDelegation, using];
XTk.SetWidgetFlag[w, inputFocusDelegatedFlag, TRUE];
};
};
END.