
DIRECTORY 
ForkOps,
HelpStrings,
Rope,
XTk,
XTkHelpStrings, 
XTkLabels,
XTkHelpShells,
XTkShellWidgets;

XTkHelpShellsImpl: CEDAR MONITOR 
IMPORTS ForkOps, Rope, XTk, XTkHelpStrings, XTkLabels, XTkShellWidgets
EXPORTS XTkHelpShells =
BEGIN 


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] = {
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 {
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.

     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

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. 
Atomic so destruction and maximum of one help widget is guaranteed
not locked; worst case if multiple widgets are created is that all but one will be destroyed again
 Э╩∙  ХNewlineDelimiter
Ц(cedarcode) styleШ codeЪЬЩKЪЬ
╧eЬ1Щ<KЪЬ6Щ6KЩ-KЩ ЧЪ╧k	ЬШ
KШKЪЬШKЪЬШKЪЬШKЪЬШKЪЬ
Ш
KЪЬШKЪЬШKШ ЧЪ╧nЬЮЬЮЬШ!KЪЮЬ?ШFKЪЮЬШЧKЪЮЬШKШ KЩЬKШ KЪЬЮЬ(Ш8KШ ЪЬЮЬЮЬШDKЪЬШKЪЬШKЪЬШKЪЬШKЪЬЮШ	KШЧKШ ЪЬЮЬЮЬШKЪЬЮЬШKЪЬЮЬЮЬШ"KЪЬЮЬЮЬШKЪЬЮЬЮЬШKЪЬЮЬЮЬШKЪЬЮЬЮШKЪЬШЧKШ Ъ
ЯЬЮЬЮЬЮЬЮЬШ^KЪЬBЩBKЪЬШKЪЬШKЪЬШЧKШ ЪЯЬЮЬЮЬЮЬШYKЪЬШKЪЮЬЮЬЮЬIШXKЪЬШЧKШ ЪЯЬШ)KЪЬЮЬШ-ЪЮЬЮЬЮШKЪЬЮЬ"ЮЬШ/KЪЮЬШЧKШЧKШ ЪЯЬЮЬЮЬЮЬШAKЪЬЮЬ
ЮЬШ"KЪЬЮЬ-Ш4KШЧKШ Ъ
Я	ЬЮЬ!ЮЬЮЬЮЬШHЪЮЬЮЬЮШЪЬЮЬШKЪЬЮЬШ"KЪЬШЪЮЬЮЬЮШKЪЬЮЬШKЪЮЬЮЬШЧKШ!Ъ
ЮЬЮЬЮЬЮЬЮЬШNKЪЬbЩbKЪЬЮЬШKЪЬЮЬШKЪЬ)╧cQШzKШЧKЪЬШЪЮЬЮЬЮЬ$ЮЬШ9KЪЬ/Ш/ЧKШЧKЪЮЬШЧKЪЬШЧKШ Ъ
ЯЬЮЬ!ЮЬЮЬЮЬШFЪЮЬЮЬЮШЪЬЮЬШЪЮЬЮЬЮЬШ(KЪЬШKЪЮЬЮЬЮЬ-Ш>KЪЬ
ЮЬШKШЧKШЧKЪЮЬШЧKЪЬШЧKШ ЪЯЬЮЬЮЬШKЪЬЮЬШ"ЪЮЬЮЬЮШЪЬЮЬШKЪЬЮЬЮЬШKШ_KЪЬuЮЬШ|KЪЬ)Ш)ЪЮШKЪЮЬЮЬЮЬШKЪЬ#Ш#ЪЮЬ	ЮЬЮШKЪЬ+Ш+KЪЮЬШ!ЧKЪЬFШFKЪЬ/Ш/KЪЬ$Ш$KЪЮЬШKЪЮЬШЧKЪЬШKЪЬШЧKЪЮЬШЧKЪЬШKШ ЧЪЯЬЮЬЮЬШ8ЪЮЬЮЬЮШЪЬЮЬШKЪЬШKЪЬЮЬШKШЧKЪЮЬШЧKЪЬШKШ ЧЪЯ	ЬЮЬЮЬШ6ЪЮЬЮЬЮШЪЬЮЬШKЪЬЮЬШKЪЬЮЬШKШЧKЪЮЬШЧKЪЬШЧKШ ЪЯЬЮЬШ"KЪЮЬЮЬЮЬ,Ш;KШKШ ЧЪЯЬЮЬЮЬШ KЪЬ#ЮЬШ.ЪЮЬЮЬЮЬ ЮЬШ5KШ$ЧKШKШ ЧKЪЮЬШKШ Ч ЕЧ    j  g  