DIRECTORY
Atom USING [GetPName, MakeAtom],
Commander USING [CommandProc, Register],
IO,
MaintainDefs USING [addMemberChoices, ClassList, CmdButton, cmdButtons, CmdRec, CmdRef, Command, createChoices, deleteMemberChoices, detailChoices, levelClass, matchesChoices, membersChoices, MyData, MyDataObject, Part, RegisterProc, removeChoices, RetrieveProc, SelectorClass, SelectorInstance, SelectorInstanceRec, setChoices, summaryChoices, quoteClass, verifyClass],
MaintainMisc USING [RopeFromCommand, RopeFromWhat],
MaintainProcs USING [AnotherProc, ChangeLevel, ChangeLooksProc, CmdProc, ComputeColumnProc, CreateButtonsProc, CreateProc, CredentialsChange, DestroyObjectProc, DisplayThisButton, FixUpCase, FixUpMyData, GetContentsProc, GetSelectedContentsProc, HelpProc, IsIconicProc, MoveObjectProc, ReplaceThisRope, ShowCredentials, SetOpenHeightProc, SetServerProc, StopProc<<, UpdateMapProc>>],
PopUpButtons USING [ChoiceList, Class, GetSpec, Image, ImageForRope],
Real USING [Round],
Rope USING [Concat, Length, ROPE],
UserProfile USING [Boolean, Token],
ViewerClasses USING [Viewer],
ViewerSpecs USING [windowBorderSize],
Xl,
XNSCredentials USING [XNSCredentialsChangeProc, GetIdentity, RegisterForChange],
XTk,
XTkPopUps,
XTkWidgets;
MaintainXTkImpl:
CEDAR
PROGRAM
LOCKS d
USING d: MyData
IMPORTS Atom, Commander, IO, MaintainDefs, MaintainMisc, MaintainProcs, PopUpButtons, Real, Rope, UserProfile, ViewerSpecs, XNSCredentials, XTk, XTkPopUps, XTkWidgets ~ {
CmdButton: TYPE ~ MaintainDefs.CmdButton;
MyData: TYPE ~ MaintainDefs.MyData;
SelectorClass: TYPE ~ MaintainDefs.SelectorClass;
SelectorInstance: TYPE ~ MaintainDefs.SelectorInstance;
SelectorInstanceRec: TYPE ~ MaintainDefs.SelectorInstanceRec;
ROPE: TYPE ~ Rope.ROPE;
Viewer: TYPE ~ ViewerClasses.Viewer;
Widget: TYPE ~ XTkWidgets.Widget;
DestroyProc: XTkWidgets.ButtonHitProcType ~ {
d: MyData ¬ NARROW[registerData];
XTkWidgets.DestroyShell[GetWidget[d.parent]];
};
AnotherProc: XTkWidgets.ButtonHitProcType ~ {
d: MyData ¬ NARROW[registerData];
MaintainProcs.AnotherProc[d];
};
StopProc: XTkWidgets.ButtonHitProcType ~ {
d: MyData ¬ NARROW[registerData];
MaintainProcs.StopProc[d];
};
HelpProc: XTkWidgets.ButtonHitProcType ~ {
d: MyData ¬ NARROW[registerData];
MaintainProcs.HelpProc[d];
};
FindProc: XTkWidgets.ButtonHitProcType ~ {};
WordProc: XTkWidgets.ButtonHitProcType ~ {};
NormalizeProc: XTkWidgets.ButtonHitProcType ~ {};
PrevPlaceProc: XTkWidgets.ButtonHitProcType ~ {};
ScratchProc: XTkWidgets.ButtonHitProcType ~ {
d: MyData ¬ NARROW[registerData];
IF d = NIL THEN RETURN;
d.displayScratch ¬ ~d.displayScratch;
CreateButtons[d];
};
TextLabelProc: XTkWidgets.ButtonHitProcType = {
abc: BYTE ← event.details.button;
i: CARD ¬ 3;
i ¬ (i + i + 5) * i;
};
TextLabelProc: XTkWidgets.ButtonHitProcType = {
w: Widget = NARROW[registerData];
MaintainProcs.TextLabelProc[w];
};
GetPart:
PROC [obj:
REF
ANY, where: MaintainDefs.Part]
RETURNS [
INT] ~ {
w: Widget ¬ GetWidget[obj];
SELECT where
FROM
width => RETURN[w.s.geometry.size.width];
height => RETURN[w.s.geometry.size.height];
x => RETURN[w.s.geometry.pos.x];
y => RETURN[w.s.geometry.pos.y];
ENDCASE => RETURN[-2000];
};
DestroyObject: MaintainProcs.DestroyObjectProc ~ {
w: XTkWidgets.Widget ¬ NARROW[o];
XTk.DestroyWidget[w];
};
MatchesProc: XTkWidgets.ButtonHitProcType ~ {
};
SetOpenHeight: MaintainProcs.SetOpenHeightProc ~ {
};
MoveObject: MaintainProcs.MoveObjectProc ~ {
widg: Widget ¬ GetWidget[o];
XTk.NoteAndStartReconfigure[widget: widg, geometry: [pos: [x: x, y: y], size:[height: h, width: w]]];
};
IsIconic: MaintainProcs.IsIconicProc ~ {
RETURN[FALSE];
};
ChangeLooks: MaintainProcs.ChangeLooksProc ~ {
};
ComputeColumn: MaintainProcs.ComputeColumnProc ~ {
};
Append:
PROC [a:
LIST
OF
ROPE, b:
ROPE]
RETURNS [
LIST
OF
ROPE] ~ {
IF a =
NIL
THEN
RETURN[LIST[b]]
ELSE
RETURN[CONS[a.first, Append[a.rest, b]]];
};
Choosen: XTkWidgets.ButtonHitProcType ~{
d: MaintainDefs.CmdRef ¬ NARROW[registerData];
MaintainProcs.CmdProc[widget, d, callData];
};
CreateMenuClosure: XTkPopUps.CreateWidgetProc = {
d: REF MaintainDefs.CmdRec ~ NARROW[closureData];
buttonName: ROPE ¬ MaintainProcs.ReplaceThisRope[Rope.Concat[MaintainMisc.RopeFromCommand[d.cb.cmd], MaintainMisc.RopeFromWhat[d.cb.what]], " ", ""];
ch: PopUpButtons.ChoiceList ¬
SELECT d.cb.what
FROM
matches => MaintainDefs.matchesChoices,
members => MaintainDefs.membersChoices,
member => IF d.cb.cmd = add THEN MaintainDefs.addMemberChoices ELSE MaintainDefs.deleteMemberChoices,
summary => MaintainDefs.summaryChoices,
details => MaintainDefs.detailChoices,
createIndividual => MaintainDefs.createChoices,
fileService => MaintainDefs.setChoices,
alias =>
IF d.cb.cmd = remove
THEN MaintainDefs.removeChoices
ELSE LIST [[Atom.MakeAtom[buttonName], d.cb.doc]],
ENDCASE => LIST [[Atom.MakeAtom[buttonName], d.cb.doc]];
choices: XTkPopUps.ChoiceList ¬ ConvertChoices[ch];
newClosure: XTkPopUps.WidgetCreateClosure ¬ XTkPopUps.WidgetCreateClosureFromChoiceList[
list: choices, defaultNotify: Choosen
];
RETURN [newClosure.creator[parent: parent, closureData: newClosure.closureData, registerData: d, image: image, event: event]];
};
ConvertChoices:
PROC [ch: PopUpButtons.ChoiceList]
RETURNS [choiceList: XTkPopUps.ChoiceList ¬
NIL] = {
last: XTkPopUps.ChoiceList ¬ NIL;
AppendChoice:
PROC[c: XTkPopUps.Choice] = {
l: XTkPopUps.ChoiceList ¬ LIST[c];
IF last=NIL THEN choiceList ¬ l ELSE last.rest ¬ l;
last ¬ l;
};
FOR l: PopUpButtons.ChoiceList ¬ ch, l.rest
WHILE l#
NIL
DO
image: REF ¬ l.first.image;
IF image=NIL THEN image ¬ l.first.key;
IF image#NIL THEN AppendChoice[[image: image, key: l.first.key, help: l.first.doc]];
ENDLOOP
};
CreateButtons:
ENTRY MaintainProcs.CreateButtonsProc = {
ENABLE UNWIND => NULL;
parent: Widget ¬ NARROW[d.parent];
child: Widget ¬ NIL;
currentCmd: MaintainDefs.Command ¬ nullCmd;
buttonsOnLine: CARD ¬ 0;
maxButtonsOnLine: CARD = 4;
gcProc: MaintainProcs.GetContentsProc ¬ LOOPHOLE[MaintainDefs.RetrieveProc[d.flavor, $GetContents]];
MakeCmdButton:
PROC [cc: PopUpButtons.Class, cb: CmdButton] = {
c: XTkWidgets.Widget ¬ XTkPopUps.CreatePopUpButton[
text: MaintainMisc.RopeFromWhat[cb.what],
registerData: d,
createMenu:
NEW[XTkPopUps.WidgetCreateClosureRec ¬ [
CreateMenuClosure, NEW[MaintainDefs.CmdRec ¬ [d, cb]]
]]
hitProc: CmdProc,
registerData: NEW[MaintainDefs.CmdRec ← [d, cb]],
callData: MaintainMisc.AtomFromWhat[cb.what]
];
c.s.geometry ¬ [
pos: [x: GetPart[child, x] + d.maxW + 1, y: GetPart[child, y]],
size: [height: 15, width: d.maxW],
borderWidth: 1
];
child ¬ c;
XTkWidgets.AppendChild[kids, child];
child ← cc.Instantiate[
viewerInfo: [name: MaintainMisc.RopeFromWhat[cb.what], parent: kids, border: TRUE, wy: child.wy, wx: child.wx + d.maxW - 1, ww: d.maxW],
instanceData: NEW[CmdRec ← [d, cb]],
paint: FALSE];
};
LabelText:
PROC[name, data:
ROPE, prev: Widget, newline:
BOOL ¬
TRUE, wide:
BOOL ¬
TRUE]
RETURNS[Widget] = {
child2: Widget;
tmp: INT ¬ 0;
x: INTEGER = IF newline THEN 2 ELSE IF wide THEN GetPart[child, x] + d.maxW - 1 ELSE GetPart[child, x] + GetPart[child, width] + 10;
y: INTEGER = IF newline THEN GetPart[child, y] + (IF (tmp ¬ GetPart[child, height]) = XTk.dontUse THEN 19 ELSE tmp) + 2 ELSE GetPart[child, y];
tempWW: INTEGER ← Real.Round[PopUpButtons.ImageForRope[name].size.x];
child ¬ XTkWidgets.CreateField[
widgetSpec: [geometry: [pos: [x: 80 + 2, y: y], size: [width: (d.maxW * 4), height: 15]]]];
XTkWidgets.AppendChild[kids, child];
child ← ViewerTools.MakeNewTextViewer[
info: [parent: kids, wh: d.buttH, ww: 999, scrollable: TRUE,
data: IF prev = NIL THEN data ELSE ViewerTools.GetContents[prev],
border: FALSE,
wx: IF wide THEN x + d.maxW + 2 ELSE x + tempWW + 2,
wy: y],
paint: FALSE ];
Containers.ChildXBound[kids, child];
child2 ¬ XTkWidgets.CreateButton[
widgetSpec: [geometry: [pos: [x: x, y: y], size: [height: d.buttH, width: 80]]],
text: name,
hitProc: TextLabelProc,
registerData: child];
XTkWidgets.AppendChild[kids, child2];
[] ← Buttons.Create[
info: [name: name, parent: kids, wh: d.buttH,
border: FALSE, wx: x, wy: y],
proc: TextLabelProc, clientData: child, fork: FALSE, paint: FALSE];
RETURN[child]
};
Label:
PROC [name:
ROPE] = {
child ¬ XTkWidgets.CreateLabel[
widgetSpec: [geometry: [pos: [x: 2, y: GetPart[child, y] + GetPart[child, height] + 1]]],
text: name
];
XTkWidgets.AppendChild[kids, child];
child ← Labels.Create[
info: [name: name, parent: kids, border: FALSE,
wy: child.wy + child.wh + (IF child.class.flavor = $PopUpButton THEN -1 ELSE 2),
wx: 2],
paint: FALSE ];
};
Rule:
PROC = {
child ¬ XTkWidgets.CreateRuler[widgetSpec: [geometry: [size: [d.maxW * maxButtonsOnLine + d.maxW + 3, 1], pos: [x: 0, y: IF child = NIL THEN 0 ELSE GetPart[child, y] + GetPart[child, height] + 2], borderWidth: 1]]];
XTkWidgets.AppendChild[kids, child];
child ← Rules.Create[
info: [parent: kids, border: FALSE,
wy: IF child = NIL THEN 0 ELSE child.wy + child.wh + 2, wx: 0, ww: kids.ww, wh: 1],
paint: FALSE ];
Containers.ChildXBound[kids, child];
};
hold: Rope.ROPE;
tw: Widget ¬ NARROW[d.topChild];
kids: Widget = XTkWidgets.CreateContainer[widgetSpec: [--attributes: [backgroundPixel: parent.screenDepth.screen.whitePixel], --geometry: [pos: [x: 0, y: GetPart[d.topChild, y] + GetPart[d.topChild, height] + 2]]]];
kids.attributes.backgroundPixel ¬ parent.attributes.backgroundPixel;
kids: Widget = Containers.Create[
info: [parent: parent, border: FALSE, scrollable: FALSE, wx: 0, wy: -9999, ww: 9999, wh: 0] ];
Containers.ChildXBound[parent, kids];
Rule[];
IF d.groupT #
NIL
THEN
hold ¬ GetContents[d.groupT]
d.groupT ¬ LabelText[
name: "Name:",
data: hold,
prev: GetWidget[d.groupT] ];
SetContents[d.groupT, hold];
IF d.dataGT #
NIL
THEN
hold ¬ GetContents[d.dataGT]
d.dataGT ¬ LabelText[
name: "Argument:",
data: hold,
prev: GetWidget[d.dataGT] ];
SetContents[d.dataGT, hold];
IF d.scratchGT #
NIL
THEN
hold ¬ GetContents[d.scratchGT]
IF d.displayScratch
THEN {
d.scratchGT ¬ LabelText[
name: "Scratch:",
data: d.scratchRope,
prev: GetWidget[d.scratchGT] ];
SetContents[d.scratchGT, hold];
}
FOR cbl: MaintainDefs.ClassList ¬ MaintainDefs.cmdButtons, cbl.rest
WHILE cbl #
NIL
DO
c: PopUpButtons.Class ~ cbl.first;
b: CmdButton ~ NARROW[c.GetSpec[].spec.classData, REF CmdButton];
IF b.nextLine THEN buttonsOnLine ¬ maxButtonsOnLine;
IF ~MaintainProcs.DisplayThisButton[d, b] THEN LOOP;
IF b.cmd # currentCmd
OR buttonsOnLine >= maxButtonsOnLine
THEN {
Label[IF b.cmd # currentCmd THEN Rope.Concat[MaintainMisc.RopeFromCommand[b.cmd], ":"] ELSE ""];
buttonsOnLine ¬ 0;
};
buttonsOnLine ¬ buttonsOnLine + 1;
MakeCmdButton[c, b];
currentCmd ¬ b.cmd;
ENDLOOP;
Rule[];
IF d.level = wizard
THEN {
c: XTk.Widget;
tmpH: INT ¬ 15;
tx: INT ¬ 2;
ty: INT ¬ GetPart[child, y] + (IF (tmpH ¬ GetPart[child, height]) = XTk.dontUse THEN 15 ELSE tmpH) + 2;
[child, d.verify] ¬ InstantiateSelector[
class: MaintainDefs.verifyClass,
init: d.verify,
clientData: d,
viewer: kids,
x: 2, y: GetPart[child, y] + (IF (tmpH ¬ GetPart[child, height]) = XTk.dontUse THEN 15 ELSE tmpH) + 2,
proc: UpdateVerifyProc];
[child, d.quote] ¬ InstantiateSelector[
class: MaintainDefs.quoteClass,
init: d.quote,
clientData: d,
viewer: kids,
x: 2, y: GetPart[child, y] + (IF (tmpH ¬ GetPart[child, height]) = XTk.dontUse THEN 15 ELSE tmpH) + 2,
proc: UpdateQuoteProc];
[child, d.gvms] ¬ InstantiateSelector[
class: MaintainDefs.updatesClass,
init: d.gvms,
clientData: d,
viewer: kids,
x: 2, y: GetPart[child, y] + (IF (tmpH ¬ GetPart[child, height]) = XTk.dontUse THEN 15 ELSE tmpH) + 2,
proc: UpdateGVMSProc];
child ¬ XTkWidgets.CreateToggle[
widgetSpec: [geometry: [pos: [x: 2, y: (IF (tmpH ¬ GetPart[child, y]) # XTk.dontUse THEN tmpH ELSE 15) + (IF (tmpH ¬ GetPart[child, height]) # XTk.dontUse THEN tmpH ELSE 15) + 2], size: [width: d.maxW * 2, height: XTk.dontUse], borderWidth: 1]], hitProc: AutoDeleteProc, registerData: d, choices: LIST[["AutoDelete is Off", NEW[BOOL ¬ FALSE]], ["AutoDelete is On", NEW[BOOL ¬ TRUE]]]];
XTkWidgets.AppendChild[kids, child];
child ¬ XTkWidgets.CreateToggle[
widgetSpec: [geometry: [pos: [x: GetPart[child, x] + GetPart[child, width] + 1, y: GetPart[child, y]], size: [width: d.maxW * 2, height: XTk.dontUse], borderWidth: 1]], hitProc: DebugSwitchProc, registerData: d, choices: LIST[["Debug is Off", NEW[BOOL ¬ FALSE]], ["Debug is On", NEW[BOOL ¬ TRUE]]]];
XTkWidgets.AppendChild[kids, child];
child ← debugSwitchClass.Instantiate[
viewerInfo: [name: debugSwitchClassLabel, parent: kids, wh: d.buttH,
border: TRUE, wx: child.wx + child.ww + 10, wy: child.wy],
instanceData: d,
image: IF d.debugSwitch
THEN PopUpButtons.ImageForRope[debugSwitchClassLabel, PopUpButtons.inverseColors]
ELSE PopUpButtons.ImageForRope[debugSwitchClassLabel],
paint: FALSE];
c ¬ XTkPopUps.CreatePopUpButton[
text: "UpdateMap",
registerData: d,
createMenu: XTkPopUps.WidgetCreateClosureFromChoiceList[
list: LIST[[$UpdateMap], [$MapStatistics]],
defaultNotify: UpdateMapProc
]
];
c.s.geometry ¬ [
pos: [x: 2, y: GetPart[child, y] + 19],
size: [width: d.maxW * 2, height: XTk.dontUse],
borderWidth: 1
];
child ¬ c;
XTkWidgets.AppendChild[kids, child];
child ← updateMapClass.Instantiate[
viewerInfo: [name: "UpdateMap", parent: kids, wh: d.buttH,
border: TRUE, wx: 2, wy: child.wy + child.wh + 2],
instanceData: d, paint: FALSE];
c ¬ XTkPopUps.CreatePopUpButton[
text: "SetServer",
registerData: d,
createMenu: XTkPopUps.WidgetCreateClosureFromChoiceList[
list: LIST[[$SetServer]],
defaultNotify: SetServerProc
]
];
c.s.geometry ¬ [
pos: [x: GetPart[child, x] + GetPart[child, width] + 1, y: GetPart[child, y]],
size: [width: d.maxW * 2, height: XTk.dontUse],
borderWidth: 1
];
child ¬ c;
XTkWidgets.AppendChild[kids, child];
child ← setServerClass.Instantiate[
viewerInfo: [name: "SetServer", parent: kids, wh: d.buttH,
border: TRUE, wx: child.wx + child.ww + 10, wy: child.wy],
instanceData: d, paint: FALSE];
d.serverT ¬ LabelText[
name: "Host:",
data: "",
prev: GetWidget[d.serverT],
newline: TRUE,
wide: FALSE ];
Rule[];
}
ELSE { d.serverT ¬ NIL };
XTkWidgets.AppendChild[GetWidget[d.mainSubContainer], kids];
{
kidsY: INTEGER = GetPart[d.topChild, y] + GetPart[d.topChild, height] + 2;
kidsH: INTEGER = GetPart[child, y] + GetPart[child, height] + 2;
doProc: MaintainProcs.DestroyObjectProc ¬ LOOPHOLE[MaintainDefs.RetrieveProc[d.flavor, $DestroyObject]];
moProc: MaintainProcs.MoveObjectProc ¬ LOOPHOLE[MaintainDefs.RetrieveProc[d.flavor, $MoveObject]];
sohProc: MaintainProcs.SetOpenHeightProc ¬ LOOPHOLE[MaintainDefs.RetrieveProc[d.flavor, $SetOpenHeight]];
iiProc: MaintainProcs.IsIconicProc ¬ LOOPHOLE[MaintainDefs.RetrieveProc[d.flavor, $IsIconic]];
ccProc: MaintainProcs.ComputeColumnProc ¬ LOOPHOLE[MaintainDefs.RetrieveProc[d.flavor, $ComputeColumn]];
IF d.kids # NIL THEN doProc[d.kids, FALSE];
d.kids ¬ kids;
sohProc[parent, kidsY + kidsH + 8 * d.buttH];
IF NOT iiProc[parent] THEN ccProc[parent];
XTk.NoteChildChangePropagate[GetWidget[d.mainSubContainer]];
IF d.out #
NIL
THEN {
XTk.StartReconfigureChildren[GetWidget[d.parent]];
};
};
};
ChangeLevel: XTkWidgets.ButtonHitProcType ~ {
d: MyData ¬ NARROW[registerData];
which: ATOM ¬ NARROW[callData];
MaintainProcs.ChangeLevel[d, which];
};
VerboseProc: XTkWidgets.ButtonHitProcType ~ {
d: MyData ¬ NARROW[registerData];
which: REF BOOL ¬ NARROW[callData];
d.verbose ¬ which;
};
AutoDeleteProc: XTkWidgets.ButtonHitProcType ~ {
d: MyData ¬ NARROW[registerData];
which: REF BOOL ¬ NARROW[callData];
d.autoDelete ¬ which;
};
DebugSwitchProc: XTkWidgets.ButtonHitProcType ~ {
d: MyData ¬ NARROW[registerData];
which: REF BOOL ¬ NARROW[callData];
d.debugSwitch ¬ which;
};
UpdateMapProc: XTkWidgets.ButtonHitProcType ~ {
d: MyData ~ NARROW[registerData];
atom: ATOM ~ NARROW[callData];
MaintainProcs.UpdateMapProc[d, atom];
IO.PutRope[d.out, "Not implemented\n"];
};
SetServerProc: XTkWidgets.ButtonHitProcType ~ {
d: MyData ~ NARROW[registerData];
atom: ATOM ~ NARROW[callData];
MaintainProcs.SetServerProc[d, atom];
};
UpdateVerifyProc: XTkWidgets.ButtonHitProcType ~ {
d: MyData ¬ NARROW[registerData];
which: ATOM ¬ NARROW[callData];
d.verify ¬ NEW[ATOM ¬ which];
};
UpdateQuoteProc: XTkWidgets.ButtonHitProcType ~ {
d: MyData ¬ NARROW[registerData];
which: ATOM ¬ NARROW[callData];
d.quote ¬ NEW[ATOM ¬ which];
};
InstantiateSelector:
PROC [class: SelectorClass, init:
REF
ATOM ¬
NIL, clientData:
REF ¬
NIL, viewer:
REF
ANY, x, y:
INTEGER, proc: XTkWidgets.ButtonHitProcType ¬
NIL]
RETURNS [child: Widget, value:
REF
ATOM] ~ {
d: MyData ¬ NARROW[clientData];
si: SelectorInstance ~
NEW [SelectorInstanceRec ¬ [
clientData: clientData,
value:
IF init #
NIL
THEN init
ELSE NEW[ATOM ¬ Atom.MakeAtom[MaintainProcs.FixUpCase[UserProfile.Token[Rope.Concat["Maintain.", class.name], Atom.GetPName[class.values.first]]]]],
class: class]];
last, list: LIST OF XTkWidgets.ChoiceElement ¬ NIL;
choice: XTkWidgets.Widget ¬ NIL;
cl: LIST OF ATOM ¬ NIL;
MaintainProcs.FixUpMyData[si];
value ¬ si.value;
child ¬ XTkWidgets.CreateLabel[widgetSpec: [geometry: [pos: IF viewer = NIL THEN [x: XTk.dontUse, y: XTk.dontUse] ELSE [x: x, y: y], size: [height: 15, width: XTk.dontUse]]], text: Rope.Concat[class.name, ": "]];
FOR cl ¬ class.values, cl.rest
WHILE cl #
NIL
DO
this:
LIST
OF XTkWidgets.ChoiceElement ~
LIST[
[Atom.GetPName[cl.first], cl.first]];
IF last=NIL THEN list ¬ this ELSE last.rest ¬ this;
last ¬ this;
ENDLOOP;
child ¬ XTkWidgets.CreateXStack[[geometry: [pos:
IF viewer =
NIL
THEN [x: XTk.dontUse, y: XTk.dontUse]
ELSE [x: GetPart[child, x], y: GetPart[child, y]], size: [height: 15, width: XTk.dontUse]]],
LIST[child, XTkWidgets.CreateChoices[
widgetSpec: [geometry: [pos: IF viewer = NIL THEN [x: XTk.dontUse, y: XTk.dontUse] ELSE [x: GetPart[child, x] + GetPart[child, width] + 2, y: GetPart[child, y]]]],
choices: list,
horizontal: TRUE,
hitProc: proc,
registerData: clientData]]];
IF viewer #
NIL
THEN
XTkWidgets.AppendChild[GetWidget[viewer], child];
};
CreateProc: Commander.CommandProc = {
[cmd: Handle]
Create[];
};
SetContents:
PROC [where:
REF
ANY, text: Rope.
ROPE] ~ {
XTkWidgets.SetText[GetWidget[where], text];
};
GetContents:
PUBLIC MaintainProcs.GetContentsProc ~ {
contents ¬ XTkWidgets.GetText[GetWidget[where]];
IF Rope.Length[contents] = 0 THEN contents ¬ default;
};
GetSelectedContents:
PUBLIC MaintainProcs.GetSelectedContentsProc ~ {
RETURN["Fix This!"];
};
GetWidget:
PUBLIC
PROC[r:
REF
ANY]
RETURNS [v: XTkWidgets.Widget ¬
NIL] ~ {
v ¬ NARROW[r];
};
CreateMenu:
ENTRY
PROC [d: MyData, parent: XTkWidgets.Widget] = {
ENABLE UNWIND => NULL;
menu: XTkWidgets.Widget ¬ NIL;
menu ¬ XTkWidgets.CreateButton[widgetSpec: [geometry: [pos: [x: 2, y: 2], size: [width: XTk.dontUse, height: 15]]], text: "Destroy", hitProc: DestroyProc, registerData: d];
d.topChild ¬ menu;
menu ¬ XTkWidgets.CreateXStack[[], LIST[menu, XTkWidgets.CreateButton[text: "STOP", hitProc: StopProc, registerData: d]]];
menu ¬ XTkWidgets.CreateXStack[[], LIST[menu, XTkWidgets.CreateButton[text: "Another", hitProc: AnotherProc, registerData: d]]];
menu ¬ XTkWidgets.CreateXStack[[], LIST[menu, XTkWidgets.CreateButton[text: "Help", hitProc: HelpProc, registerData: d]]];
menu ¬ XTkWidgets.CreateXStack[[], LIST[menu, XTkWidgets.CreateButton[text: "Find", hitProc: FindProc, registerData: d]]];
menu ¬ XTkWidgets.CreateXStack[[], LIST[menu, XTkWidgets.CreateButton[text: "Word", hitProc: WordProc, registerData: d]]];
menu ¬ XTkWidgets.CreateXStack[[], LIST[menu, XTkWidgets.CreateButton[text: "Normalize", hitProc: NormalizeProc, registerData: d]]];
menu ¬ XTkWidgets.CreateXStack[[], LIST[menu, XTkWidgets.CreateButton[text: "PrevPlace", hitProc: PrevPlaceProc, registerData: d]]];
menu ¬ XTkWidgets.CreateXStack[[], LIST[menu, XTkWidgets.CreateButton[text: "Scratch", hitProc: ScratchProc, registerData: d]]];
XTkWidgets.AppendChild[GetWidget[d.mainSubContainer], menu];
};
Create: MaintainProcs.CreateProc = {
[cmd: Handle]
tmp1, tmp: INT;
tmpW: XTkWidgets.Widget;
d: MaintainDefs.MyData = NEW[MaintainDefs.MyDataObject];
v: XTkWidgets.Widget ¬ XTkWidgets.CreateShell[windowHeader: "Maintain", iconName: "Maintain", className: $Maintain, standardMigration: TRUE];
d.parent ¬ v;
d.flavor ¬ $XTk;
d.mainSubContainer ¬ XTkWidgets.CreateContainer[--widgetSpec: [attributes: [backgroundPixel: v.screenDepth.screen.whitePixel]]--];
NARROW[d.mainSubContainer, Widget].attributes.backgroundPixel ¬ v.attributes.backgroundPixel;
{
kludge to find max button size! --
d.maxW ¬ 0;
d.buttH ¬ 0;
FOR cbl: MaintainDefs.ClassList ¬ MaintainDefs.cmdButtons, cbl.rest
WHILE cbl #
NIL
DO
c: PopUpButtons.Class ~ cbl.first;
b: CmdButton ~ NARROW[c.GetSpec[].spec.classData, REF CmdButton];
temp: PopUpButtons.Image ~ PopUpButtons.ImageForRope[MaintainMisc.RopeFromWhat[b.what]];
IF temp.size.x > d.maxW THEN d.maxW ¬ Real.Round[temp.size.x];
IF temp.size.y > d.buttH THEN d.buttH ¬ Real.Round[temp.size.y];
ENDLOOP;
d.maxW ¬ Real.Round[d.maxW + 2*ViewerSpecs.windowBorderSize];
d.buttH ¬ Real.Round[d.buttH + 2*ViewerSpecs.windowBorderSize];
};
CreateMenu[d, v];
tmpW ¬ NARROW[d.topChild];
d.topChild ¬ InstantiateSelector[class: MaintainDefs.levelClass,
clientData: d,
viewer: d.mainSubContainer,
x: 2, y: (IF (tmp1 ¬ GetPart[d.topChild, y]) # XTk.dontUse THEN tmp1 ELSE 15) + (IF (tmp ¬ GetPart[d.topChild, height]) # XTk.dontUse THEN tmp ELSE 15) + 2, proc: ChangeLevel].child;
d.topChild ¬ XTkWidgets.CreateToggle[
widgetSpec: [geometry: [pos: [x: 2, y: (IF (tmp1 ¬ GetPart[d.topChild, y]) # XTk.dontUse THEN tmp1 ELSE 15) + (IF (tmp ¬ GetPart[d.topChild, height]) # XTk.dontUse THEN tmp ELSE 15) + 2], borderWidth: 1]], --text: MaintainDefs.verboseClassLabel,-- hitProc: VerboseProc, registerData: d, choices: LIST[["Verbose is Off", NEW[BOOL ¬ FALSE]], ["Verbose is On", NEW[BOOL ¬ TRUE]]]];
XTkWidgets.AppendChild[GetWidget[d.mainSubContainer], GetWidget[d.topChild]];
tmpW ¬ NARROW[d.topChild];
d.topChild ¬InstantiateSelector[class: MaintainDefs.modeClass,
clientData: d,
viewer: d.mainSubContainer,
x: 2,
y: GetPart[d.topChild, y] + (IF (tmp ¬ GetPart[d.topChild, height]) # XTk.dontUse THEN tmp ELSE 19) + 2,
proc: ChangeMode].child;
d.displayScratch ¬ UserProfile.Boolean["Maintain.Scratch", TRUE];
d.script ¬ XTkWidgets.CreateStreamWidget[widgetSpec: [geometry: [pos: [x: 0, y: 209], size: [400, 400]]]];
NARROW[d.script, Widget].attributes.backingStore ¬ always;
NARROW[d.script, Widget].attributes.saveUnder ¬ true;
NARROW[d.script, Widget].attributes.winGravity ¬ northWest;
d.out ¬ NIL;
CreateButtons[d];
tmpW ¬ XTkWidgets.CreateYStack[[], LIST[GetWidget[d.mainSubContainer], GetWidget[d.script]]];
d.out ¬ XTkWidgets.CreateStream[GetWidget[d.script]];
d.identity ¬ XNSCredentials.GetIdentity[];
[d.gvName, d.gvPassword] ¬ UserCredentials.Get[];
XNSCredentials.RegisterForChange[MaintainProcs.CredentialsChange, d];
XTkWidgets.SetShellChild[v, GetWidget[tmpW]];
XTkWidgets.RealizeShell[v];
ViewerOps.AddProp[v, maintainDataProp, d];
d.destructionEvent ← ViewerEvents.RegisterEventProc[proc: NoteDestruction, event: destroy, filter: v, before: TRUE];
Booting.RegisterProcs[c: MyCheckpointProc, r: MyRollbackProc, b: NIL, clientData: d];
MaintainProcs.ShowCredentials[d];
};
MaintainDefs.RegisterProc[$XTk, $ChangeLooks, ChangeLooks];
MaintainDefs.RegisterProc[$XTk, $ComputeColumn, ComputeColumn];
MaintainDefs.RegisterProc[$XTk, $Create, Create];
MaintainDefs.RegisterProc[$XTk, $CreateButtons, CreateButtons];
MaintainDefs.RegisterProc[$XTk, $DestroyObject, DestroyObject];
MaintainDefs.RegisterProc[$XTk, $GetContents, GetContents];
MaintainDefs.RegisterProc[$XTk, $GetSelectedContents, GetSelectedContents];
MaintainDefs.RegisterProc[$XTk, $IsIconic, IsIconic];
MaintainDefs.RegisterProc[$XTk, $InstantiateSelector, InstantiateSelector];
MaintainDefs.RegisterProc[$XTk, $MoveObject, MoveObject];
MaintainDefs.RegisterProc[$XTk, $SetOpenHeight, SetOpenHeight];
Commander.Register[key: "XMaintain", proc: CreateProc,
doc: "Performs enquiries and updates to the NS and Grapevine databases"];
}.