XTkHelpShellsImpl.mesa
Copyright Ó 1992 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, March 9, 1992 3:33 pm PST
Christian Jacobi, April 19, 1993 10:40 am PDT
DIRECTORY
ForkOps,
HelpStrings,
Rope,
XTk,
XTkHelpStrings,
XTkLabels,
XTkHelpShells,
XTkShellWidgets;
XTkHelpShellsImpl:
CEDAR
MONITOR
IMPORTS ForkOps, Rope, XTk, XTkHelpStrings, XTkLabels, XTkShellWidgets
EXPORTS XTkHelpShells =
BEGIN
Locking: Make sure widgets are not created double or zero times. However we do not care about which help message is displayed when conflicts would occur.
clear: Rope.ROPE ~ " ";
myHelpClass:
REF HelpStrings.ClassRec ~
NEW[HelpStrings.ClassRec ¬ [
display: MyDisplay,
clear: MyClear,
makeVisible: MakeVisible,
hide: NoVisible,
more: NIL
]];
MyData:
TYPE =
RECORD [
label: XTk.Widget ¬ NIL,
makeVisibleWhenUsed: BOOL ¬ FALSE,
data: REF ¬ NIL,
string: REF ¬ NIL,
text: Rope.ROPE ¬ NIL,
key: REF ¬ NIL
];
AssignLabel:
ENTRY
PROC [md:
REF MyData, label: XTk.Widget]
RETURNS [previous: XTk.Widget] = {
Atomic so destruction and maximum of one help widget is guaranteed
previous ¬ md.label;
md.label ¬ label;
};
CreateHelpWithPopShell:
PUBLIC
PROC [for: XTk.Widget]
RETURNS [h: HelpStrings.Handle] = {
h ¬ MyCreateHandle[];
IF for#NIL THEN XTk.RegisterNotifier[for, XTk.preStopFastAccessKey, ParentDestroyed, h];
};
ParentDestroyed: XTk.WidgetNotifyProc = {
h: HelpStrings.Handle ¬ NARROW[registerData];
WITH h.data
SELECT
FROM
md: REF MyData => Remove[AssignLabel[md, NIL]];
ENDCASE => {}
};
MyCreateHandle:
PROC []
RETURNS [h: HelpStrings.Handle ¬
NIL] = {
md: REF MyData ~ NEW[MyData ¬ []];
h ¬ NEW [HelpStrings.HandleRec ¬ [myHelpClass, md]]
};
MyDisplay:
PROC [h: HelpStrings.Handle, string:
REF, key:
REF ¬
NIL] = {
WITH h.data
SELECT
FROM
md:
REF MyData => {
previousText: Rope.ROPE ¬ md.text;
label: XTk.Widget;
WITH string
SELECT
FROM
r: Rope.ROPE => md.text ¬ r;
ENDCASE => RETURN;
md.string ¬ string; md.key ¬ key;
IF md.makeVisibleWhenUsed
AND (md.label=
NIL
OR md.label.state#realized)
THEN {
not locked; worst case if multiple widgets are created is that all but one will be destroyed again
md.makeVisibleWhenUsed ← FALSE;
previousText ¬ NIL;
ForkOps.ForkDelayed[0, ForkedCreate, h]; --use other thread to move slow widget creation out of the way of fast redisplay
};
label ¬ md.label;
IF label#
NIL
AND ~Rope.Equal[previousText, md.text]
THEN
XTkLabels.SetText[label, md.text, immediately];
};
ENDCASE => {}
};
MyClear:
PROC [h: HelpStrings.Handle, string:
REF, key:
REF ¬
NIL] = {
WITH h.data
SELECT
FROM
md:
REF MyData => {
IF md.string=string
OR md.key=key
THEN {
label: XTk.Widget ~ md.label;
IF label#NIL THEN XTkLabels.SetText[md.label, clear, delayed];
md.text ¬ NIL;
};
};
ENDCASE => {}
};
ForkedCreate:
PROC [x:
REF] = {
h: HelpStrings.Handle ~ NARROW[x];
WITH h.data
SELECT
FROM
md:
REF MyData => {
connection: REF ANY;
label: XTk.Widget ~ XTkLabels.CreateLabel[widgetSpec: [geometry: XTk.G[350, 20]], text: clear];
shell: XTk.Widget ~ XTkShellWidgets.CreateShell[windowHeader: "Help", child: label, className: $Help, focusProtocol: FALSE];
old: XTk.Widget ~ AssignLabel[md, label];
BEGIN
ENABLE UNCAUGHT => GOTO Oops;
XTkHelpStrings.SetHandle[shell, h];
WITH md.data
SELECT
FROM
w: XTk.Widget => connection ¬ w.connection;
ENDCASE => connection ¬ md.data;
XTkShellWidgets.BindScreenShell[shell: shell, connection: connection];
XTkLabels.SetText[label, md.text, immediately];
XTkShellWidgets.RealizeShell[shell];
EXITS Oops => {};
END;
Remove[old];
};
ENDCASE => {};
};
MakeVisible:
PROC [h: HelpStrings.Handle, data:
REF] = {
WITH h.data
SELECT
FROM
md:
REF MyData => {
md.data ¬ data;
md.makeVisibleWhenUsed ¬ TRUE;
};
ENDCASE => {}
};
NoVisible:
PROC [h: HelpStrings.Handle, data:
REF] = {
WITH h.data
SELECT
FROM
md:
REF MyData => {
md.makeVisibleWhenUsed ¬ FALSE;
Remove[AssignLabel[md, NIL]];
};
ENDCASE => {}
};
Remove:
PROC [old: XTk.Widget] = {
IF old#NIL THEN ForkOps.ForkDelayed[0, ForkedDestroy, old];
};
ForkedDestroy:
PROC [x:
REF] = {
shell: XTk.Widget ¬ XTk.RootWidget[NARROW[x]];
IF shell#
NIL
AND XTkShellWidgets.IsShell[shell]
THEN
XTkShellWidgets.DestroyShell[shell];
};
END.