XTkTIPImpl.mesa
Copyright Ó 1988, 1989, 1990, 1991, 1992 by Xerox Corporation. All rights reserved.
Christian Jacobi, November 23, 1988 5:21:43 pm PST
Christian Jacobi, August 25, 1992 2:55 pm PDT
Doug Wyatt, August 19, 1992 2:14 pm PDT
DIRECTORY
Rope,
TIPPrivate,
TIPResults,
TIPTypes,
TIPUser,
UserInput,
Xl,
XlDispatch,
XTk,
XTkOps,
XTkTIP,
XTkTIPSource;
XTkTIPImpl:
CEDAR
MONITOR
LOCKS t
USING t: TIPRef
IMPORTS TIPPrivate, TIPResults, TIPUser, Xl, XlDispatch, XTk, XTkOps, XTkTIPSource
EXPORTS XTkTIP
SHARES Xl, TIPPrivate =
BEGIN OPEN XTkTIP;
SetInit:
ENTRY
PROC [t: TIPRef, val:
BOOL ¬
TRUE]
RETURNS [b:
BOOL] = {
b ¬ t.init; t.init ¬ val;
};
InvalidTable: PUBLIC SIGNAL [errorMsg: Rope.ROPE] ¬ TIPUser.InvalidTable;
InstantiateNewTIPTable:
PUBLIC
PROC [file: Rope.
ROPE]
RETURNS [table: TIPTable] = {
table ¬ TIPUser.InstantiateNewTIPTable[file ! TIPUser.InvalidTable => {
SIGNAL InvalidTable[errorMsg]; RESUME
}];
};
RegisterTIPPredicate:
PUBLIC
PROC [key:
ATOM, p: TIPPredicate] = {
TIPUser.RegisterTIPPredicate[key, p];
};
myKey: REF INT = NEW[INT];
TIPRef: TYPE = REF TIPData;
TIPData:
TYPE =
MONITORED
RECORD [
tipTable: TIPTypes.TIPTable ¬ NIL,
tipClient: TIPPrivate.TIPClient ¬ NIL,
tsh: XTkTIPSource.TipSourceHandle ¬ NIL,
tipTQ: Xl.TQ ¬ NIL,
eventProc: Xl.EventProcType ¬ NIL,
eventData: REF ¬ NIL,
dispatchKey: XlDispatch.WindowData ¬ NIL,
dispatch: BOOL ¬ FALSE,
init: BOOL ¬ FALSE --means ResetTIPContext with tip table is called
];
MasterNotifyProc: TIPPrivate.TIPNotifyProc ~ {
WITH clientData
SELECT
FROM
widget: XTk.Widget => {
WITH XTk.GetWidgetProp[widget, myKey]
SELECT
FROM
t: TIPRef => {
event: REF Xl.EventRep.tipEvent ~ NEW[Xl.EventRep.tipEvent];
event.originalCodeByte ¬ ORD[Xl.EventCode[tipEvent]];
event.dispatchDrawable ¬ widget.window.drawable;
event.connection ¬ widget.connection;
event.results ¬ TIPResults.MakeImmutable[results];
event.who ¬ widget;
event.eventSource ¬ NARROW[eventSource];
event.timeStamp ¬ XTkTIPSource.GetServerTime[t.tsh];
IF t.eventProc#
NIL
THEN {
IF t.tipTQ#
NIL
THEN Xl.Enqueue[t.tipTQ, t.eventProc, t.eventData, event]
ELSE t.eventProc[event, t.eventData, NIL];
};
IF t.dispatchKey#NIL THEN XlDispatch.DispatchExplicite[t.dispatchKey, event];
};
ENDCASE => {};
};
ENDCASE => {};
};
PostRealize: XTk.WidgetNotifyProc = {
t: TIPRef ~ NARROW[registerData];
IF t.dispatch
THEN
t.dispatchKey ¬ XlDispatch.GetWindowData[widget.connection, widget.window];
t.init ¬ TRUE;
TIPPrivate.ResetTIPContext[t.tipClient, t.tipTable, MasterNotifyProc, FALSE];
TIPPrivate.DiscardTypeAhead[t.tipClient];
TIPPrivate.StartTIPClient[t.tipClient];
};
UndoRealize: XTk.WidgetNotifyProc = {
This procedure is supposed to stop tip matcher process from running forever
t: TIPRef ~ NARROW[registerData];
tipClient: TIPPrivate.TIPClient ~ t.tipClient;
IF tipClient#
NIL
THEN {
TIPPrivate.DestroyClient[tipClient]; -- Look at TIPMatcherImpl.DestroyClient to see that TIPPrivate.DestroyClient is the inverse of TIPPrivate.StartTIPClient; not the inverse of TIPPrivate.CreateTIPClient
};
};
Bind:
PUBLIC
PROC [widget: XTk.Widget, tipTable: TIPTable ¬
NIL, eventProc: Xl.EventProcType ¬
NIL, eventData:
REF ¬
NIL, inputTQ: Xl.
TQ ¬
NIL, tipTQ: Xl.
TQ ¬
NIL, dispatch:
BOOL ¬
FALSE, yup:
BOOL ¬
FALSE, pseudoHeight:
INT ¬ -1, scrollPos: Xl.Point ¬ [0, 0]] = {
WITH XTk.GetWidgetProp[widget, myKey]
SELECT
FROM
t: TIPRef => ERROR;
ENDCASE => {
t: TIPRef ~ NEW[TIPData ¬ [tipTable: tipTable, dispatch: dispatch, eventProc: eventProc, eventData: eventData, tipTQ: tipTQ]];
t.tipClient ¬ TIPPrivate.CreateTIPClient[notify: MasterNotifyProc, clientData: widget];
t.tsh ¬ XTkTIPSource.BindTipSource[widget, TIPPrivate.GetInputHandle[t.tipClient], inputTQ, yup, pseudoHeight, scrollPos];
XTk.PutWidgetProp[widget, myKey, t];
XTk.RegisterNotifier[widget, XTk.preStopFastAccessKey, UndoRealize, t];
XTkOps.CallAndRegisterOnPostRealize[widget, PostRealize, t];
};
};
ChangeTipTable:
PUBLIC
PROC [widget: XTk.Widget, tipTable: TIPTable] = {
IF tipTable#
NIL
THEN {
WITH XTk.GetWidgetProp[widget, myKey]
SELECT
FROM
t: TIPRef => {
t.tipTable ¬ tipTable;
IF t.init
THEN
TIPPrivate.ResetTIPContext[t.tipClient, t.tipTable, MasterNotifyProc, FALSE];
};
ENDCASE => {};
};
};
ChangePseudoHeight:
PUBLIC
PROC [widget: XTk.Widget, pseudoHeight:
INT ¬ -1] = {
WITH XTk.GetWidgetProp[widget, myKey]
SELECT
FROM
t: TIPRef => XTkTIPSource.ChangePseudoHeight[t.tsh, pseudoHeight];
ENDCASE => {};
};
ChangeScrollPos:
PUBLIC
PROC [widget: XTk.Widget, scrollPos: Xl.Point ¬ [0, 0]] = {
WITH XTk.GetWidgetProp[widget, myKey]
SELECT
FROM
t: TIPRef => XTkTIPSource.ChangeScrollPos[t.tsh, scrollPos];
ENDCASE => {};
};
AdditionalKeySource:
PUBLIC
PROC [widget: XTk.Widget, from: XTk.Widget] = {
WITH XTk.GetWidgetProp[widget, myKey]
SELECT
FROM
t: TIPRef => XTkTIPSource.AdditionalKeySource[t.tsh, from];
ENDCASE => {};
};
END.