Maintain: Button-style interface
MaintainButtons.mesa
Andrew Birrell August 25, 1983 11:10 am
DIRECTORY
Atom USING[ GetPName ],
BasicTime USING[ FromPupTime ],
Buttons USING[ Button, ButtonProc, Create, Destroy, SetDisplayStyle ],
Commander USING[ CommandProc, Register ],
Containers USING[ ChildXBound, ChildYBound, Create ],
GVBasics USING[ GVString, MakeKey, oldestTime, Password, RName, Timestamp ],
GVNames USING[ CheckStamp, GetEntry, GetEntryInfo, GetEntryList, GetMembers, MemberInfo, NameType, Outcome, RListHandle, ReporterProc, RSOperation, SetServer, SetServerInfo, Update],
IO USING[ Put, PutChar, PutF, PutFR, PutRope, STREAM, Value ],
Labels USING[ Create ],
Rope USING[ Cat, Equal, Fetch, Find, Length, Match, ROPE, Substr ],
Rules USING[ Create ],
TypeScript USING[ Create ],
UserCredentials USING[ Get ],
ViewerClasses USING[ Viewer ],
ViewerIO USING[ CreateViewerStreams ],
ViewerOps USING[ ComputeColumn, DestroyViewer, MoveViewer, SetOpenHeight ],
ViewerTools USING[ GetContents, MakeNewTextViewer, SetContents, SetSelection];
MaintainButtons: CEDAR MONITOR LOCKS d USING d: MyData
IMPORTS Atom, BasicTime, Buttons, Commander, Containers, GVBasics, GVNames, IO, Labels, Rope, Rules, TypeScript, UserCredentials, ViewerIO, ViewerOps, ViewerTools
SHARES GVNames--Update-- =
BEGIN
-- ******** Enquiry operations ******** --
Amount: TYPE = { members, summary, details, names };
TypeGroupMembersProc: Buttons.ButtonProc =
parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL
{ TypeGroup[clientData, members] };
TypeGroupSummaryProc: Buttons.ButtonProc =
parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL
{ TypeGroup[clientData, summary] };
TypeGroupDetailsProc: Buttons.ButtonProc =
parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL
{ TypeGroup[clientData, details] };
TypeGroupNamesProc: Buttons.ButtonProc =
parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL
{ TypeGroup[clientData, names] };
TypeIndividualSummaryProc: Buttons.ButtonProc =
parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL
{ TypeIndividual[clientData, summary] };
TypeIndividualDetailsProc: Buttons.ButtonProc =
parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL
{ TypeIndividual[clientData, details] };
TypeIndividualNamesProc: Buttons.ButtonProc =
parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL
{ TypeIndividual[clientData, names] };
TypeDeadDetailsProc: Buttons.ButtonProc =
parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL
{ TypeDead[clientData, details] };
TypeDeadNamesProc: Buttons.ButtonProc =
parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL
{ TypeDead[clientData, names] };
TypeGroup: PROC[clientData: REF ANY, which: Amount] =
BEGIN
d: MyData = NARROW[clientData];
name: Rope.ROPE = ViewerTools.GetContents[d.groupT];
IF CheckForm[clientData, name, "Group"]
THEN DoEnumerate[d, name, "Groups", which];
END;
TypeIndividual: PROC[clientData: REF ANY, which: Amount] =
BEGIN
d: MyData = NARROW[clientData];
name: Rope.ROPE = ViewerTools.GetContents[d.indivT];
IF CheckForm[clientData, name, "Individual"]
THEN DoEnumerate[d, name, "Individuals", which];
END;
TypeDead: PROC[clientData: REF ANY, which: Amount] =
BEGIN
d: MyData = NARROW[clientData];
name: Rope.ROPE = ViewerTools.GetContents[d.deadT];
IF CheckForm[clientData, name, "Dead"]
THEN DoEnumerate[d, name, "Dead", which];
END;
DoEnumerate: ENTRY PROC[d: MyData, pattern, type: Rope.ROPE, which: Amount] = TRUSTED
BEGIN
IF Rope.Find[pattern, "*"] >= 0
THEN BEGIN
lastDotPos: INT ← -1;
DO thisDot: INT = Rope.Find[pattern, ".", lastDotPos+1];
IF thisDot < 0 THEN EXIT;
lastDotPos ← thisDot;
ENDLOOP;
d.out.PutF["\nEnumerate%g[%g] ... ",
[rope[type]], [rope[pattern]] ];
IF lastDotPos < 0
THEN { d.out.PutRope["the pattern must have an explicit registry\n"]; RETURN };
IF Rope.Find[pattern, "*", lastDotPos+1] > 0
THEN { d.out.PutRope["the registry must not contain \"*\"\n"]; RETURN };
BEGIN
registry: Rope.ROPE = Rope.Substr[pattern, lastDotPos+1];
enumName: Rope.ROPE = Rope.Cat[type, ".", registry];
info: GVNames.MemberInfo = GVNames.GetMembers[enumName];
WITH i: info SELECT FROM
notFound => d.out.PutF["\"%g\" is not a registry\n", [rope[registry]] ];
noChange, individual => d.out.PutRope["internal error - consult a wizard\n"];
allDown => d.out.PutF["no R-Server for registry \"%g\" is available\n", [rope[registry]] ];
group =>
BEGIN
first: BOOL ← TRUE;
FOR l: GVNames.RListHandle ← i.members, l.rest UNTIL l = NIL
DO IF Rope.Match[pattern, l.first, FALSE]
THEN BEGIN
IF which = names
THEN { IF NOT first THEN d.out.PutRope[", "]; d.out.PutRope[l.first] }
ELSE DoEnquiry[d, l.first, which];
first ← FALSE;
END;
ENDLOOP;
IF first
THEN d.out.PutRope["no matches\n"]
ELSE IF which = names THEN d.out.PutChar['\n];
END;
ENDCASE => ERROR;
END;
END
ELSE { IF which = names THEN which ← summary; DoEnquiry[d, pattern, which] };
END;
DoEnquiry: INTERNAL PROC[d: MyData, name: Rope.ROPE, which: Amount[members..details]] = TRUSTED
BEGIN
Reporter: SAFE PROC[report: Rope.ROPE] = TRUSTED
{ d.out.PutF["%g ... ", [rope[report]] ] };
info: REF GVNames.GetEntryInfo;
rc: GVNames.NameType[group..allDown];
d.out.PutF["\n%g[%g] ... ",
[rope[SELECT which FROM
members => "TypeMembers",
summary => "TypeSummary",
details => "TypeDetails",
ENDCASE => ERROR]],
[rope[name]] ];
[rc, info] ← GVNames.GetEntry[name, Reporter];
IF info.type = dead THEN d.out.PutRope["recently deleted name"];
IF info.type # notFound AND which = details
THEN d.out.PutF["\nPrefix: %g, %g, %g",
[rope[info.name]],
[rope[SELECT info.type FROM
individual => "individual",
group => "group",
dead => "dead",
ENDCASE => ERROR]],
Stamp[info.stamp] ];
WITH i: info SELECT FROM
individual =>
BEGIN
IF which = details
THEN d.out.PutF["\nPassword: %b %b %b %b, %g",
[cardinal[i.password[0]]],
[cardinal[i.password[1]]],
[cardinal[i.password[2]]],
[cardinal[i.password[3]]],
Stamp[i.passwordStamp] ];
d.out.PutF["\nConnect: \"%g\"", [rope[i.connect]] ];
IF which = details THEN d.out.PutF[", %g", Stamp[i.connectStamp]];
IF which = details OR i.forward.current # NIL
THEN TypeEntryList[d, i.forward, "Forwarding",
IF which = details THEN details ELSE members];
TypeEntryList[d, i.sites, "Mailboxes", IF which = details THEN details ELSE members];
d.out.PutChar['\n];
END;
group =>
BEGIN
IF which # members THEN d.out.PutF["\nRemark: \"%g\"", [rope[i.remark]] ];
IF which = details THEN d.out.PutF[", %g", Stamp[i.remarkStamp]];
TypeEntryList[d, i.members, "Members", which];
IF which # members
THEN BEGIN
TypeEntryList[d, i.owners, "Owners", IF which = details THEN details ELSE members];
TypeEntryList[d, i.friends, "Friends", IF which = details THEN details ELSE members];
END;
d.out.PutChar['\n];
END;
dead =>
d.out.PutChar['\n];
ENDCASE => TypeRC[d, rc, ReadEntry, name];
END;
Stamp: PROC[stamp: GVBasics.Timestamp] RETURNS[IO.Value] =
BEGIN
time: Rope.ROPE = IO.PutFR[NIL, [time[BasicTime.FromPupTime[stamp.time]]] ];
RETURN[ [rope[IO.PutFR["[%b#%b,%g]",
[cardinal[stamp.net]],
[cardinal[stamp.host]],
[rope[Rope.Substr[time, 0, Rope.Length[time]-4]]]]]]]
END;
TypeEntryList: PROC[d: MyData,
list: GVNames.GetEntryList,
text: Rope.ROPE,
which: Amount] =
BEGIN
TypeEntrySublist[d, list.current, list.currentStamps, text, which];
IF which = details
THEN TypeEntrySublist[d, list.deleted, list.deletedStamps,
Rope.Cat["Del", text], which];
END;
TypeEntrySublist: PROC[d: MyData,
names: GVNames.RListHandle,
stamps: LIST OF GVBasics.Timestamp,
text: Rope.ROPE,
which: Amount] =
BEGIN
count: INT ← 0;
stampList: LIST OF GVBasics.Timestamp ← stamps;
d.out.PutF["\n%g: ", [rope[text]] ];
FOR c: GVNames.RListHandle ← names, c.rest UNTIL c = NIL
DO IF which # summary AND count # 0 THEN d.out.PutRope[", "];
count ← count+1;
IF which # summary THEN d.out.PutRope[c.first];
IF which = details THEN d.out.Put[Stamp[stampList.first]];
stampList ← stampList.rest;
ENDLOOP;
IF which = summary
THEN d.out.Put[[integer[count]]]
ELSE { IF count = 0 THEN d.out.PutRope["none"] };
END;
-- ******** Update operations ******** --
UpdateOp: TYPE = REF UpdateOpRec;
UpdateOpRec: TYPE = RECORD[
d: MyData,
op: GVNames.RSOperation ];
UpdateGroup: Buttons.ButtonProc =
parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL
BEGIN
rec: UpdateOp = NARROW[clientData];
name: Rope.ROPE = ViewerTools.GetContents[rec.d.groupT];
data: Rope.ROPE = IF rec.d.dataGT = NIL THEN NIL ELSE ViewerTools.GetContents[rec.d.dataGT];
IF CheckForm[rec.d, name, "Group"]
AND ( SELECT rec.op FROM
CreateGroup, DeleteGroup, AddSelf, DeleteSelf => TRUE,
ENDCASE => CheckForm[rec.d, data, "Argument"] )
THEN DoUpdate[rec.d, group, rec.op, name, data];
END;
UpdateIndividual: Buttons.ButtonProc =
parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL
BEGIN
rec: UpdateOp = NARROW[clientData];
name: Rope.ROPE = ViewerTools.GetContents[rec.d.indivT];
data: Rope.ROPE = ViewerTools.GetContents[rec.d.dataIT];
IF CheckForm[rec.d, name, "Individual"]
AND ( SELECT rec.op FROM
DeleteIndividual => TRUE,
ENDCASE => CheckForm[rec.d, data, "Argument"] )
THEN DoUpdate[rec.d, individual, rec.op, name, data];
END;
DoUpdate: ENTRY PROC[d: MyData,
expected: GVNames.NameType,
op: GVNames.RSOperation,
target: GVBasics.RName,
value: GVBasics.GVString ← NIL] = TRUSTED
BEGIN
ENABLE UNWIND => NULL;
Reporter: SAFE PROC[report: Rope.ROPE] = TRUSTED
{ d.out.PutF["%g ... ", [rope[report]] ] };
user, password: Rope.ROPE;
outcome: GVNames.Outcome;
[name: user, password: password] ← UserCredentials.Get[];
-- Log command --
IO.PutF[d.out, "\n%g%g[%g,%g] ... ",
[rope[SELECT op FROM
CreateIndividual, CreateGroup
=> "Create",
DeleteIndividual, DeleteGroup
=> "Delete",
AddMember, AddOwner, AddFriend,
AddMailBox, AddForward, AddSelf
=> "Add",
DeleteMember, DeleteOwner, DeleteFriend,
DeleteMailBox, DeleteForward, DeleteSelf
=> "Remove",
ChangeRemark, ChangePassword, ChangeConnect
=> "Set",
ENDCASE => ""]],
[rope[SELECT op FROM
CreateIndividual, DeleteIndividual => "Individual",
CreateGroup, DeleteGroup => "Group",
AddMember, DeleteMember => "Member",
AddOwner, DeleteOwner => "Owner",
AddFriend, DeleteFriend => "Friend",
AddMailBox, DeleteMailBox => "Mailbox",
AddForward, DeleteForward => "Forwarding",
AddSelf, DeleteSelf => "Self",
ChangeRemark => "Remark",
ChangePassword => "Password",
ChangeConnect => "Connect",
ENDCASE => "UnknownOp"]],
[rope[target]],
[rope[SELECT op FROM
CreateIndividual, CreateGroup, ChangePassword,
DeleteIndividual, DeleteGroup,
AddSelf, DeleteSelf => "",
ENDCASE => value]] ];
-- validate argument --
IF (SELECT op FROM
AddMember, AddOwner, AddFriend, AddForward => CheckName[d, value, Reporter],
AddMailBox => CheckInbox[d, value, Reporter],
ChangePassword => CheckPwd[d, user, target, value],
ENDCASE => TRUE)
AND NotGVMS[d, target]
THEN BEGIN
newPwd: GVBasics.Password;
SELECT op FROM
CreateIndividual, ChangePassword => newPwd ← GVBasics.MakeKey[value];
ENDCASE => NULL;
SELECT op FROM -- patch because of inadequate return codes from Update --
CreateIndividual, CreateGroup =>
BEGIN
outcome ← GVNames.CheckStamp[target, GVBasics.oldestTime--, Reporter--];
IF outcome # notFound THEN GOTO bad;
END;
DeleteIndividual, DeleteGroup =>
BEGIN
outcome ← GVNames.CheckStamp[target, GVBasics.oldestTime--, Reporter--];
IF outcome = notFound THEN GOTO bad;
expected ← notFound;
END;
ENDCASE => NULL;
outcome ← GVNames.Update[user: user, password: GVBasics.MakeKey[password],
op: op, target: target, value: value, newPwd: newPwd, reporter: Reporter];
IF outcome # expected THEN GOTO bad;
IO.PutRope[d.out, "ok\n"]
EXITS bad => TypeRC[d, outcome, op, target, value];
END;
END;
verifyOn: ATOM = $on;
CheckName: PROC[d: MyData, name: GVBasics.RName, reporter: GVNames.ReporterProc]
RETURNS[ BOOL ] = TRUSTED
BEGIN
length: INT = Rope.Length[name];
IF length = 0 THEN GOTO bad;
IF length = 1 AND Rope.Fetch[name, 0] = '* THEN RETURN[TRUE];
IF length > 1 AND Rope.Fetch[name, 0] = '* AND Rope.Fetch[name, 1] = '. THEN RETURN[TRUE];
IF GVNames.CheckStamp[name, GVBasics.oldestTime--, reporter--] = notFound
THEN BEGIN
FOR i: INT DECREASING IN [0..length)
DO IF Rope.Fetch[name, i] = '.
THEN BEGIN
f: GVBasics.RName = Rope.Cat[Rope.Substr[name, i+1, length-i], ".foreign"];
IF GVNames.CheckStamp[f, GVBasics.oldestTime--, reporter--] # individual
THEN GOTO bad
END;
REPEAT FINISHED => GOTO bad
ENDLOOP
END;
RETURN[TRUE]
EXITS bad =>
{ IF d.verify # NIL AND d.verify^ # verifyOn
THEN { IO.PutRope[d.out, "(invalid) ... "]; RETURN[TRUE] };
IO.PutF[d.out, "\"%g\" is not a valid name\n", [rope[name]] ];
RETURN[FALSE] }
END;
CheckInbox: PROC[d: MyData, name: GVBasics.RName, reporter: GVNames.ReporterProc]
RETURNS[ BOOL ] = TRUSTED
BEGIN
IF Rope.Equal[name, "Maxc", FALSE] THEN RETURN[TRUE];
IF NOT EndsWith[name, ".ms"]
OR GVNames.CheckStamp[name, GVBasics.oldestTime--, reporter--] # individual
THEN IF d.verify # NIL AND d.verify^ # verifyOn
THEN { IO.PutRope[d.out, "(invalid) ... "]; RETURN[TRUE] }
ELSE BEGIN
IO.PutF[d.out, "\"%g\" is not a mail server\n", [rope[name]] ];
RETURN[FALSE]
END
ELSE RETURN[TRUE]
END;
CheckPwd: PROC[d: MyData, user, name, pwd: GVBasics.RName]
RETURNS[ BOOL ] =
BEGIN
IF Rope.Length[pwd] = 0 AND Rope.Equal[user, name, FALSE]
THEN { IO.PutRope[d.out, "you don't want an empty password\n"];
RETURN[FALSE] }
ELSE RETURN[TRUE]
END;
gvmsAllowed: ATOM = $yes;
NotGVMS: PROC[d: MyData, a: Rope.ROPE] RETURNS[ BOOL ] =
BEGIN
bad: BOOL = (d.gvms = NIL OR d.gvms^ # gvmsAllowed)
AND ( EndsWith[a, ".gv"] OR EndsWith[a, ".ms"] );
IF bad THEN IO.PutRope[d.out, "use wizard's GV/MS switch first\n"];
RETURN[ NOT bad ]
END;
EndsWith: PROC[a, b: Rope.ROPE] RETURNS[ BOOL ] =
BEGIN
bLength: INT = Rope.Length[b];
aLength: INT = Rope.Length[a];
IF aLength < bLength THEN RETURN[FALSE];
RETURN[ Rope.Equal[ Rope.Substr[a, aLength - bLength, bLength], b, FALSE ] ]
END;
-- ******** SetServer operation ******** --
SetServerProc: Buttons.ButtonProc =
parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL
BEGIN
d: MyData = NARROW[clientData];
name: Rope.ROPE = ViewerTools.GetContents[d.serverT];
IF CheckForm[clientData, name, "Host"]
THEN DoSetServer[d, name];
END;
DoSetServer: ENTRY PROC[d: MyData, name: Rope.ROPE] = TRUSTED
BEGIN
info: GVNames.SetServerInfo;
d.out.PutF["\nSetServer[%g] ... ", [rope[name]] ];
info ← GVNames.SetServer[name];
d.out.PutRope[SELECT info FROM
ok => "ok\n",
allDown => "can't look up name - allDown\n",
noRoute => "no route to that host at present\n",
badName => "bad server name\n",
ENDCASE => ERROR];
END;
-- ******** Miscellaneous sub-routines for the operations ******** --
CheckForm: SAFE PROC[clientData: REF ANY, value, label: Rope.ROPE]
RETURNS[ BOOLEAN ] =
BEGIN
d: MyData = NARROW[clientData];
IF Rope.Length[value] > 0 AND Rope.Fetch[value, 0] = '
THEN { IO.PutF[d.out, "\nPlease fill in the \"%g\" field\n", [rope[label]] ]; RETURN[FALSE] }
ELSE RETURN[TRUE]
END;
TypeRC: PROC[d: MyData, info: GVNames.Outcome, op: GVNames.RSOperation,
name: Rope.ROPE, value: Rope.ROPE ← NIL] =
BEGIN
create: BOOL = SELECT op FROM
CreateIndividual, CreateGroup => TRUE,
ENDCASE => FALSE;
SELECT info FROM
group, individual =>
IO.PutF[d.out, "\"%g\" is %ga %g",
[rope[name]],
[rope[IF create THEN "already " ELSE NIL]],
[rope[IF info = group THEN "group" ELSE "individual"]] ];
notFound =>
IO.PutF[d.out, "\"%g\" %g",
[rope[name]],
[rope[SELECT TRUE FROM
Rope.Find[name, "."] < 0 => "needs an explicit registry",
create => "has an invalid registry or is recently deleted"
ENDCASE => "doesn't exist"]] ];
protocolError =>
IO.PutF[d.out, "protocol error - consult expert." ];
wrongServer =>
IO.PutF[d.out, "wrong server - consult expert." ];
allDown =>
IO.PutF[d.out, "couldn't contact needed server. Try later." ];
badPwd =>
IO.PutF[d.out, "your password is now incorrect. Please login again." ];
outOfDate =>
IO.PutF[d.out, "there's newer information in the database - consult expert." ];
notAllowed =>
IO.PutF[d.out, "you're not allowed to do that - ask an administrator to help you." ];
noChange =>
BEGIN
IsFooOfBaz: PROC[s: Rope.ROPE] =
{ IO.PutF[d.out, "\"%g\" is %g of \"%g\"",
[rope[value]], [rope[s]], [rope[name]] ] };
SELECT op FROM
CreateIndividual, CreateGroup =>
IO.PutF[d.out, "\"%g\" already exists", [rope[name]] ];
AddMember => IsFooOfBaz["already a member"];
AddMailBox => IsFooOfBaz["already a mailbox-site"];
AddForward => IsFooOfBaz["already a forwardee"];
AddOwner => IsFooOfBaz["already an owner"];
AddFriend => IsFooOfBaz["already a friend"];
DeleteMember => IsFooOfBaz["not a member"];
DeleteMailBox => IsFooOfBaz["not a mailbox-site"];
DeleteForward => IsFooOfBaz["not a forwardee"];
DeleteOwner => IsFooOfBaz["not an owner"];
DeleteFriend => IsFooOfBaz["not a friend"];
AddSelf =>
IO.PutF[d.out, "you're already a member of \"%g\"", [rope[name]]];
DeleteSelf =>
IO.PutF[d.out, "you're not a member of \"%g\"", [rope[name]]];
ENDCASE =>
IO.PutF[d.out, "no-change: consult LaurelSupport.pa."];
END;
ENDCASE =>
IO.PutF[d.out, "unknown return code!"];
IO.PutRope[d.out, "\n"];
END;
-- ******** Viewer management ******** --
MyData: TYPE = REF MyDataObject;
MyDataObject: TYPE = MONITORED RECORD[
in: IO.STREAM,
out: IO.STREAM,
level: { normal, owner, admin, wizard } ← normal,
verify: REF ATOM ← NIL,
gvms: REF ATOM ← NIL,
topChild,
kids,
groupT,
dataGT,
indivT,
dataIT,
deadT,
serverT,
script: ViewerClasses.Viewer ← NIL,
maxW: INTEGER,
buttH: INTEGER];
Create: Commander.CommandProc =
[cmd: Handle]
BEGIN
d: MyData = NEW[MyDataObject];
v: ViewerClasses.Viewer = Containers.Create[
info: [name: "Maintain", column: right, scrollable: FALSE, iconic: TRUE]];
BEGIN
-- kludge to find max button size! --
temp: Buttons.Button = Buttons.Create[
info: [name: "Forwarding", parent: v, border: FALSE,
wx: 0, wy: 0],
proc: NIL, clientData: d, fork: FALSE, paint: FALSE];
d.maxW ← temp.ww;
d.buttH ← temp.wh;
Buttons.Destroy[temp];
END;
d.topChild ← CreateSelector[name: "Level:",
values: LIST[$Normal, $Owner, $Administrator, $Wizard],
change: ChangeLevel,
clientData: d,
viewer: v,
x: 2, y: 1].child;
d.script ← TypeScript.Create[
info: [parent: v, wh: v.ch - (d.topChild.wy + d.topChild.wh + 2), ww: v.cw,
border: FALSE,
wy: d.topChild.wy + d.topChild.wh + 2, wx: 0] ];
Containers.ChildXBound[v, d.script];
Containers.ChildYBound[v, d.script];
[in: d.in, out: d.out] ← ViewerIO.CreateViewerStreams[NIL, d.script];
CreateButtons[d, v];
END;
ChangeLevel: PROC[parent: ViewerClasses.Viewer, clientData: REF ANY, value: ATOM] =
BEGIN
d: MyData = NARROW[clientData];
SELECT value FROM
$Normal => d.level ← normal;
$Owner => d.level ← owner;
$Administrator => d.level ← admin;
$Wizard => d.level ← wizard;
ENDCASE => ERROR;
CreateButtons[d, parent]
END;
CreateButtons: ENTRY PROC[d: MyData, parent: ViewerClasses.Viewer] =
BEGIN
child: ViewerClasses.Viewer ← NIL;
EnquiryButton: PROC[name: Rope.ROPE, proc: Buttons.ButtonProc] =
BEGIN
child ← Buttons.Create[
info: [name: name, parent: kids, border: TRUE,
wy: child.wy, wx: child.wx + d.maxW - 1, ww: d.maxW],
proc: proc,
clientData: d,
fork: TRUE,
paint: FALSE];
END;
updateProc: Buttons.ButtonProc ← UpdateGroup;
UpdateButton: PROC[name: Rope.ROPE, op: GVNames.RSOperation,
guarded: BOOL ← FALSE] =
BEGIN
child ← Buttons.Create[
info: [name: name, parent: kids, border: TRUE,
wy: child.wy, wx: child.wx + d.maxW - 1, ww: d.maxW],
proc: updateProc,
clientData: NEW[UpdateOpRec ← [d,op]],
fork: TRUE,
guarded: guarded,
paint: FALSE];
END;
LabelText: PROC[name, data: Rope.ROPE, prev: ViewerClasses.Viewer, newline: BOOL ← TRUE]
RETURNS[ViewerClasses.Viewer] =
BEGIN
x: INTEGER = IF newline THEN 2 ELSE child.wx + d.maxW - 1;
y: INTEGER = IF newline THEN child.wy + child.wh + 1 ELSE child.wy;
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: x + d.maxW + 2, wy: y],
paint: FALSE ];
Containers.ChildXBound[kids, child];
[] ← 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]
END;
Label: PROC[name: Rope.ROPE] =
BEGIN
child ← Labels.Create[
info: [name: name, parent: kids, border: FALSE,
wy: child.wy + child.wh + (IF child.class.flavor = $Button THEN -1 ELSE 2),
wx: 2],
paint: FALSE ];
END;
Rule: PROC =
BEGIN
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];
END;
kids: ViewerClasses.Viewer = Containers.Create[
info: [parent: parent, border: FALSE, scrollable: FALSE, wx: 0, wy: -9999, ww: 9999, wh: 0] ];
Containers.ChildXBound[parent, kids];
Rule[];
d.groupT ← LabelText[
name: "Group:",
data: "group name or pattern",
prev: d.groupT ];
IF d.level IN [owner..wizard]
THEN d.dataGT ← LabelText[
name: "Argument:",
data: "remark string, or member/owner/friend name",
prev: d.dataGT ]
ELSE d.dataGT ← NIL;
Label["Type: "];
EnquiryButton[name: "Matches", proc: TypeGroupNamesProc];
EnquiryButton[name: "Members", proc: TypeGroupMembersProc];
EnquiryButton[name: "Summary", proc: TypeGroupSummaryProc];
IF d.level IN [admin..wizard]
THEN EnquiryButton[name: "Details", proc: TypeGroupDetailsProc];
IF d.level IN [owner..wizard]
THEN BEGIN
Label["Set:"];
UpdateButton[name: "Remark", op: ChangeRemark];
END;
Label["Add:"];
UpdateButton[name: "Self", op: AddSelf];
IF d.level IN [owner..wizard]
THEN BEGIN
UpdateButton[name: "Member", op: AddMember];
UpdateButton[name: "Owner", op: AddOwner];
UpdateButton[name: "Friend", op: AddFriend];
END;
Label["Remove:"];
UpdateButton[name: "Self", op: DeleteSelf];
IF d.level IN [owner..wizard]
THEN BEGIN
UpdateButton[name: "Member", op: DeleteMember];
UpdateButton[name: "Owner", op: DeleteOwner];
UpdateButton[name: "Friend", op: DeleteFriend];
END;
IF d.level IN [admin..wizard]
THEN BEGIN
Label[""];
UpdateButton[name: "Create", op: CreateGroup, guarded: FALSE];
UpdateButton[name: "Delete", op: DeleteGroup, guarded: TRUE];
END;
Rule[];
updateProc ← UpdateIndividual;
d.indivT ← LabelText[
name: "Individual:",
data: UserCredentials.Get[].name,
prev: d.indivT ];
d.dataIT ← LabelText[
name: "Argument:",
data: "password, connect-site, etc.",
prev: d.dataIT ];
Label["Type:"];
EnquiryButton[name: "Matches", proc: TypeIndividualNamesProc];
EnquiryButton[name: "Summary", proc: TypeIndividualSummaryProc];
IF d.level IN [admin..wizard]
THEN EnquiryButton[name: "Details", proc: TypeIndividualDetailsProc];
Label["Set:"];
UpdateButton[name: "Password", op: ChangePassword];
UpdateButton[name: "Connect", op: ChangeConnect];
IF d.level IN [admin..wizard]
THEN BEGIN
Label["Add: "];
UpdateButton[name: "Mailbox", op: AddMailBox, guarded: FALSE];
UpdateButton[name: "Forwarding", op: AddForward, guarded: FALSE];
Label["Remove: "];
UpdateButton[name: "Mailbox", op: DeleteMailBox, guarded: FALSE];
UpdateButton[name: "Forwarding", op: DeleteForward, guarded: FALSE];
Label[""];
UpdateButton[name: "Create", op: CreateIndividual, guarded: FALSE];
UpdateButton[name: "Delete", op: DeleteIndividual, guarded: TRUE];
END;
Rule[];
IF d.level = wizard
THEN BEGIN
d.deadT ← LabelText[
name: "Dead:",
data: "dead name or pattern",
prev: d.deadT];
Label["Type:"];
EnquiryButton[name: "Matches", proc: TypeDeadNamesProc];
EnquiryButton[name: "Details", proc: TypeDeadDetailsProc];
Rule[];
[child, d.verify] ← CreateSelector[
name: "Verify:",
values: LIST[verifyOn, $off],
init: d.verify,
viewer: kids,
x: 2, y: child.wy + child.wh + 2];
[child, d.gvms] ← CreateSelector[
name: "GV/MS updates:",
values: LIST[$no, gvmsAllowed],
init: d.gvms,
viewer: kids,
x: child.wx + child.ww + 10, y: child.wy];
child ← Buttons.Create[
info: [name: "SetServer", parent: kids, wh: d.buttH,
border: TRUE, wx: 2, wy: child.wy + child.wh + 2],
proc: SetServerProc, clientData: d, fork: TRUE, paint: FALSE];
d.serverT ← LabelText[
name: "Host:",
data: "RName, NLS name, or Pup address",
prev: d.serverT,
newline: FALSE ];
Rule[];
END
ELSE { d.serverT ← d.deadT ← NIL };
BEGIN
kidsY: INTEGER = d.topChild.wy + d.topChild.wh + 2;
kidsH: INTEGER = child.wy + child.wh + 2;
IF d.kids # NIL THEN ViewerOps.DestroyViewer[d.kids, FALSE];
d.kids ← kids;
ViewerOps.MoveViewer[viewer: d.script, x: 0, y: kidsY + kidsH, w: d.script.ww,
h: parent.ch - (kids.wy + kidsH),
paint: FALSE];
ViewerOps.SetOpenHeight[parent, kidsY + kidsH + 8 * d.buttH];
IF NOT parent.iconic THEN ViewerOps.ComputeColumn[parent.column];
ViewerOps.MoveViewer[viewer: kids, x: kids.wx, y: kidsY, w: kids.ww, h: kidsH];
END;
END;
TextLabelProc: Buttons.ButtonProc =
parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL
BEGIN
text: ViewerClasses.Viewer = NARROW[clientData];
SELECT mouseButton FROM
red => ViewerTools.SetSelection[text, NIL];
blue => { ViewerTools.SetContents[text, NIL]; ViewerTools.SetSelection[text, NIL] };
yellow => NULL;
ENDCASE => ERROR;
END;
Selector: TYPE = REF SelectorRec;
SelectorRec: TYPE = RECORD[
value: REF ATOM,
change: PROC[parent: ViewerClasses.Viewer, clientData: REF ANY, value: ATOM],
clientData: REF ANY,
buttons: LIST OF Buttons.Button,
values: LIST OF ATOM ];
CreateSelector: PROC[name: Rope.ROPE,
values: LIST OF ATOM,
init: REF ATOM ← NIL,
change: PROC[parent: ViewerClasses.Viewer, clientData: REF ANY, value: ATOM]
← NIL,
clientData: REF ANY ← NIL,
viewer: ViewerClasses.Viewer,
x, y: INTEGER]
RETURNS[child: ViewerClasses.Viewer, value: REF ATOM] =
BEGIN
selector: Selector ← NEW[ SelectorRec ←
[value: IF init # NIL THEN init ELSE NEW[ATOM←values.first],
change: change,
clientData: clientData,
buttons: NIL,
values: values ] ];
last: LIST OF Buttons.Button ← NIL;
value ← selector.value;
child ← Labels.Create[info: [name: name, parent: viewer, border: FALSE, wx: x, wy: y] ];
FOR a: LIST OF ATOM ← values, a.rest UNTIL a = NIL
DO child ← Buttons.Create[
info: [name: Atom.GetPName[a.first], parent: viewer, border: TRUE,
wy: child.wy, wx: child.wx + child.ww + 2],
proc: SelectorProc,
clientData: selector,
fork: TRUE,
paint: TRUE];
IF last = NIL
THEN last ← selector.buttons ← CONS[first: child, rest: NIL]
ELSE { last.rest ← CONS[first: child, rest: NIL]; last ← last.rest };
IF a.first = selector.value^ THEN Buttons.SetDisplayStyle[child, $WhiteOnBlack];
ENDLOOP;
END;
SelectorProc: Buttons.ButtonProc =
parent: REF ANY, clientData: REF ANY, mouseButton: MouseButton, shift, control: BOOL
BEGIN
self: Buttons.Button = NARROW[parent];
selector: Selector = NARROW[clientData];
buttons: LIST OF Buttons.Button ← selector.buttons;
FOR a: LIST OF ATOM ← selector.values, a.rest UNTIL a = NIL
DO IF self = buttons.first
THEN BEGIN
selector.value^ ← a.first;
IF selector.change # NIL THEN selector.change[self.parent, selector.clientData, a.first];
Buttons.SetDisplayStyle[buttons.first, $WhiteOnBlack];
END
ELSE Buttons.SetDisplayStyle[buttons.first, $BlackOnWhite];
buttons ← buttons.rest;
ENDLOOP;
END;
-- ******** Main program ******** --
Commander.Register[key: "Maintain", proc: Create,
doc: "Performs enquiries and updates to the Grapevine database"];
END.