-- Maintain: Button-style interface -- MaintainButtons.mesa -- Andrew Birrell February 18, 1983 11:39 am -- Edited by Doug Wyatt, July 14, 1983 9:30 am DIRECTORY Atom USING[ GetPName ], 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, 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 ], ProtocolDefs USING[ RSOperation ], TypeScript USING[ Create ], UserCredentials USING[ GetUserCredentials ], 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, 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[[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: ProtocolDefs.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: ProtocolDefs.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; [user, password] _ UserCredentials.GetUserCredentials[]; -- 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, GVBasics.MakeKey[password], op, target, value, newPwd, 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: ProtocolDefs.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: ProtocolDefs.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: FALSE, 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.GetUserCredentials[].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; Commander.Register[key: "Maintain", proc: Create, doc: "Performs enquiries and updates to the Grapevine database"]; END.