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 <>] 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 { goal м FirstFocusTarget[child, searchLimit-1]; IF goal#NIL THEN stop м TRUE } ELSE { 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. ю 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 --use next younger sibling --ignore older siblings Э╩oХNewlineDelimiter Ц(cedarcode) styleЩcodeЪ╧cЩKЪЬ ╧eЬ1ЩKШKШЧЪаЬЯЬЯЬ%ЯЬШBЪЯЬЯЬЯШKЪЬЯЬЯЬШЪЬЯЬЯЬШKЪЬ.ЯЬШ5KШЧЪЯЬШKЪЬ.Ш.KЪЬ.ЯЬШ4KШЧЧKШKШЧKЪЯЬШKШKШЧЕЧLй