<> <> <> <> <> <> <> <> <> <> <<>> DIRECTORY Atom USING[ GetPName, MakeAtom ], PopUpButtons USING[ AmbushInstance, ChoiceList, Class, HelpFromDoc, Image, ImageForRope, inverseColors, MakeClass, PopUpButtonProc], CHOpsP2V3 USING[ WrongServer ], IO USING[ Close, Flush, noWhereStream, PutF, PutF1, PutRope ], MaintainDefs USING[ ClassList, Command, CmdButton, CmdRec, CmdRef, ImagedClassList, Level, MyData, RetrieveProc, SelectorClass, SelectorClassRec, SelectorInstance, What ], MaintainProcs, MaintainMisc USING[ CallForItems, RopeFromCommand, RopeFromWhat ], MaintainNS USING[ DoEnumerate, DoCommand, DoSetServer ], Menus USING[ MouseButton ], Rope USING[ Concat, Find, Length, Equal, Replace, ROPE, Substr, Translate, TranslatorType ], TiogaOps USING[ SearchDir ], ViewerClasses USING[ Column, Viewer, MouseButton ], XNSCHName USING[ RopeFromName], XNSAuth USING[ GetIdentityDetails, Identity], XNSCredentials USING[ XNSCredentialsChangeProc ]; MaintainImpl: CEDAR MONITOR LOCKS d USING d: MyData IMPORTS Atom, CHOpsP2V3, IO, MaintainDefs, MaintainMisc, MaintainNS, PopUpButtons, Rope, XNSAuth, XNSCHName EXPORTS MaintainProcs, MaintainDefs = { OPEN MaintainDefs; ROPE: TYPE = Rope.ROPE; Viewer: TYPE = ViewerClasses.Viewer; <<************>> logName: PUBLIC ROPE ¬ "/ux/tmp/Maintain.log"; maintainDataProp: PUBLIC ATOM ¬ Atom.MakeAtom["MaintainDataProp"]; <> SelectorClass : TYPE ~ MaintainDefs.SelectorClass; SelectorClassRec : TYPE ~ MaintainDefs.SelectorClassRec; ImagedClassList : TYPE ~ MaintainDefs.ImagedClassList; matchesChoices: PUBLIC PopUpButtons.ChoiceList ¬ LIST [ [$Any, "Match any object."], [$FromSelection, "Match objects specified by the current selection."], [$GroupsAndUsers, "Match groups and users."], [$Group, "Match groups (objects with a group remark)."], [$User, "Match users."], [$Members, "Match objects with members (usually groups)."], [$AddressList, "Match objects with addresses."], [$Workstation, "Match workstations."], [$AssociatedWorkstation, "Match objects with associated workstations."], [$Mailbox, "Match objects with mailboxes."], [$CIU, "Match Communications Interface Units."], [$ECS, "Match External Communications Service."], [$FS, "Match File Services."], [$GWS, "Match Gateway Services."], [$IRS, "Match Internetwork Routing Services."], [$ITS, "Match Interactive Terminal Services."], [$MGW, "Match Mail Gateways."], [$MS, "Match Mail Services."], [$PS, "Match Print Services."], [$RBS, "Match Remote Batch Services."], [$Fetch, "Match Fetch Services."], [$Server, "Match Servers."], [$Alias, "Match objects that are aliases."], [$Aliases, "Match objects that have aliases."] ]; membersChoices: PUBLIC PopUpButtons.ChoiceList ¬ LIST [ [$Members, "List members of a group (members property)."], [NIL, NIL], [NIL, NIL], [$FromSelection, "List the \"members\" of the property specified by the current selection."], [$MailGatewayRouteData, "List the \"members\" for Mail Gateway Route Data."] ]; addMemberChoices: PUBLIC PopUpButtons.ChoiceList ¬ LIST [ [$Members, "Add members to a group (members property)."], [NIL, NIL], [NIL, NIL], [$FromSelection, "Add \"members\" to the property specified by the current selection."], [$MailGatewayRouteData, "Add \"members\" to the Mail Gateway Route Data property."] ]; deleteMemberChoices: PUBLIC PopUpButtons.ChoiceList ¬ LIST [ [$Members, "Delete members from a group (members property)."], [NIL, NIL], [NIL, NIL], [$FromSelection, "Delete \"members\" from the property specified by the current selection."], [$MailGatewayRouteData, "Delete \"members\" from the Mail Gateway Route Data property."] ]; summaryChoices: PUBLIC PopUpButtons.ChoiceList ¬ LIST [ [$TypeSummary, "Give a summary of the given group or individual."], [$DistingOnly, "Give just the distinguished name for valid NS names."], [$NoACLInfo, "Give a summary (minus ACL info) of the given group or individual."] ]; detailChoices: PUBLIC PopUpButtons.ChoiceList ¬ LIST [ [$TypeDetails, "Give a detailed summary of the given group or individual."], [$DistingOnly, "Give just the distinguished name for valid NS names."], [$NoACLInfo, "Give a detailed summary (minus ACL info) of the given group or individual."] ]; createChoices: PUBLIC PopUpButtons.ChoiceList ¬ LIST [ [$CreateIndividual, "Create a new individual with the argument as a remark."], [NIL, NIL], [NIL, NIL], [$CreateCHS, "Create a new CHS object with the argument as its address."], [$CreateObject, "Create a new CHS object."] ]; removeChoices: PUBLIC PopUpButtons.ChoiceList ¬ LIST [ [$RemoveAlias, "Remove this alias from this name."], [NIL, NIL], [NIL, NIL], [$RemoveProperty, "Remove the property (specified by the current selction) from this name."] ]; setChoices: PUBLIC PopUpButtons.ChoiceList ¬ LIST [ [$UserFileService, "Set the user's file service to a new value."], [NIL, NIL], [$AssociatedWorkstation, "Set the Associated Workstation property to the given argument."], [$AddressList, "Set the Address List property to the address given."], [$PrintService, "Set the Print Service property to the given argument."], [$FileSerivce, "Set the File Service property to the given argument."], [$CHService, "Set the CH Service property to the given argument."], [$UserRemark, "Set the User property to the given argument."], [$GroupRemark, "Set the Group property to the given argument."], [$ListOfCard16PropFromSelection, "Set a LIST OF CARD16 property (specified by the current selection) to the given argument."], [$RopePropFromSelection, "Set a ROPE property (specified by the current selection) to the given argument."], [$NamePropFromSelection, "Set a Name property (specified by the current selection) to the given argument."] ]; <<************>> CmdProc2: PopUpButtons.PopUpButtonProc ~ { cd: CmdRef ¬ NARROW[instanceData]; CmdProc[view, cd, key]; }; CreateClasses: PROC [cbs: LIST OF CmdButton] RETURNS [cs: ClassList] ~ { last: ClassList ¬ cs ¬ NIL; FOR cbs ¬ cbs, cbs.rest WHILE cbs # NIL DO cb: CmdButton ~ cbs.first; this: ClassList; buttonName: ROPE; buttonName ¬ Rope.Concat[MaintainMisc.RopeFromCommand[cb.cmd], MaintainMisc.RopeFromWhat[cb.what]]; buttonName ¬ ReplaceThisRope[buttonName, " ", ""]; this ¬ LIST[PopUpButtons.MakeClass[[ classData: NEW [CmdButton ¬ cb], proc: CmdProc2, choices: SELECT cb.what FROM matches => matchesChoices, members => membersChoices, member => IF cb.cmd = add THEN addMemberChoices ELSE deleteMemberChoices, summary => summaryChoices, details => detailChoices, createIndividual => createChoices, fileService => setChoices, alias => IF cb.cmd = remove THEN removeChoices ELSE LIST [[buttonName, cb.doc]], ENDCASE => LIST [[buttonName, cb.doc]], fork: TRUE, guarded: cb.guarded, headMenu: FALSE, help: PopUpButtons.HelpFromDoc["MaintainDoc.Tioga", LIST[ Rope.Concat[MaintainMisc.RopeFromWhat[cb.what], ":"]]] ]]]; IF last # NIL THEN last.rest ¬ this ELSE cs ¬ this; last ¬ this; ENDLOOP; cs ¬ cs; }; CmdProc: PUBLIC PROC [o: REF ANY, cr: MaintainDefs.CmdRef, key: REF ANY]--PopUpButtons.PopUpButtonProc-- = { <> <> <> cd: CmdRef ¬ cr; <> d: MyData ¬ cd.d; gcProc: MaintainProcs.GetContentsProc ¬ LOOPHOLE[MaintainDefs.RetrieveProc[d.flavor, $GetContents]]; gscProc: MaintainProcs.GetSelectedContentsProc ¬ LOOPHOLE[MaintainDefs.RetrieveProc[d.flavor, $GetSelectedContents]]; names, args, selection: ROPE; <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> selection ¬ gscProc[]; <> names ¬ gcProc[d.groupT, ""]; args ¬ gcProc[d.dataGT, ""]; CmdProcInternal[d, cd.cb, names, args, selection, key]; <> <> <> <> }; CmdProcInternal: ENTRY PROC [d: MyData, cb: CmdButton, names, args, selection: ROPE, key: REF ANY] = { ENABLE { UNWIND => NULL; ABORTED => GOTO AbortStuff; CHOpsP2V3.WrongServer => GOTO wrongServer; }; TruncRope: PROC [r: ROPE, n: INT] RETURNS [ROPE] ={ n ¬ MAX[n, 3]; IF Rope.Length[r] <= n THEN RETURN[r]; RETURN[Rope.Concat[Rope.Substr[r, 0, n-3], "..."]]; }; EachItem: PROC [name: ROPE] ={ IF d.stop THEN RETURN; IF cb.doEnumerate THEN MaintainNS.DoEnumerate[d, cb, name, args] ELSE MaintainNS.DoCommand[d, cb, name, args]; }; ForEachArg: PROC [thisArg: ROPE] = { d.argList ¬ CONS[thisArg, d.argList]; d.nArgs ¬ SUCC[d.nArgs]; }; ReverseList: PROC [original: LIST OF ROPE] RETURNS[newList: LIST OF ROPE]= { FOR list: LIST OF ROPE ¬ original, list.rest UNTIL list = NIL DO newList ¬ CONS[list.first, newList]; ENDLOOP; }; temp: ROPE; clProc: MaintainProcs.ChangeLooksProc ¬ LOOPHOLE[MaintainDefs.RetrieveProc[d.flavor, $ChangeLooks]]; d.stop ¬ FALSE; d.firstTime ¬ TRUE; d.moreData ¬ selection; d.cmdData ¬ key; temp ¬ Rope.Concat[MaintainMisc.RopeFromCommand[cb.cmd], MaintainMisc.RopeFromWhat[cb.what]]; temp ¬ ReplaceThisRope[temp, " ", ""]; clProc[d, 'b]; d.out.PutF1["\n%g", [rope[temp]]]; clProc[d, ' ]; d.out.PutF1["[\"%g\"", [rope[TruncRope[names, 40]]]]; SELECT TRUE FROM cb.cmd = type OR cb.what = self => NULL; cb.what = password OR cb.what = simple => d.out.PutF1[", \"%g\"", [rope[OpaqueRope[args]]]]; ENDCASE => d.out.PutF1[", \"%g\"", [rope[TruncRope[args, 40]]]]; d.out.PutRope["] ... "]; d.nArgs ¬ 0; d.argList ¬ NIL; MaintainMisc.CallForItems[d, args, ForEachArg]; d.argList ¬ ReverseList[d.argList]; MaintainMisc.CallForItems[d, names, EachItem, (cb.what = password OR cb.what = simple)]; IF d.stop THEN d.out.PutRope["\n\nStopped.\n"] ELSE d.out.PutRope["\n\nDone.\n"]; d.out.Flush[]; EXITS AbortStuff => { d.out.PutRope["\n\n*** Operation ABORTED!\nDone.\n"]; d.out.Flush[]; }; wrongServer => { gcProc: MaintainProcs.GetContentsProc ¬ LOOPHOLE[MaintainDefs.RetrieveProc[d.flavor, $GetContents]]; d.out.PutF1["\n\n*** Specified server (\"%g\") unable to answer query.\nDone.\n", [rope[gcProc[d.serverT, ""]]]]; d.out.Flush[]; }; }; VerboseProc: PopUpButtons.PopUpButtonProc = { <> viewer: Viewer ¬ NARROW[view]; d: MyData = NARROW[instanceData]; buttonLabel: ROPE = NARROW[classData]; d.verbose ¬ ~d.verbose; IF d.verbose THEN PopUpButtons.AmbushInstance[button: viewer, specImage: TRUE, image: PopUpButtons.ImageForRope[buttonLabel, PopUpButtons.inverseColors]] ELSE PopUpButtons.AmbushInstance[button: viewer, specImage: TRUE, image: PopUpButtons.ImageForRope[buttonLabel]]; }; AutoDeleteProc: PopUpButtons.PopUpButtonProc = { <> viewer: Viewer ¬ NARROW[view]; d: MyData = NARROW[instanceData]; buttonLabel: ROPE = NARROW[classData]; d.autoDelete ¬ ~d.autoDelete; IF d.autoDelete THEN PopUpButtons.AmbushInstance[button: viewer, specImage: TRUE, image: PopUpButtons.ImageForRope[buttonLabel, PopUpButtons.inverseColors]] ELSE PopUpButtons.AmbushInstance[button: viewer, specImage: TRUE, image: PopUpButtons.ImageForRope[buttonLabel]]; }; debugSwitchProc: PopUpButtons.PopUpButtonProc = { <> viewer: Viewer ¬ NARROW[view]; d: MyData = NARROW[instanceData]; buttonLabel: ROPE = NARROW[classData]; d.debugSwitch ¬ ~d.debugSwitch; IF d.debugSwitch THEN PopUpButtons.AmbushInstance[button: viewer, specImage: TRUE, image: PopUpButtons.ImageForRope[buttonLabel, PopUpButtons.inverseColors]] ELSE PopUpButtons.AmbushInstance[button: viewer, specImage: TRUE, image: PopUpButtons.ImageForRope[buttonLabel]]; }; SetServerProc: PUBLIC PROC [d: MyData, atom: ATOM] = { gcProc: MaintainProcs.GetContentsProc ¬ LOOPHOLE[MaintainDefs.RetrieveProc[d.flavor, $GetContents]]; name: ROPE ¬ gcProc[d.serverT]; MaintainNS.DoSetServer[d, name]; }; SetServerProcV: PopUpButtons.PopUpButtonProc = { <> viewer: Viewer ¬ NARROW[view]; d: MyData = NARROW[instanceData]; atom: ATOM = NARROW[key]; SetServerProc[d, atom]; }; levelClass: PUBLIC SelectorClass ¬ CreateSelectorClass[name: "Level", values: LIST[$Normal, $Owner, $Administrator, $Wizard]--, change: ChangeLevel--]; CloseTS: PROC [d: MyData] = { IF d.out # NIL THEN d.out.Close[]; d.out ¬ IO.noWhereStream; }; ChangeLevel: PUBLIC PROC [clientData: MyData, value: ATOM] = { d: MyData = NARROW[clientData]; cbProc: MaintainProcs.CreateButtonsProc ¬ LOOPHOLE[MaintainDefs.RetrieveProc[d.flavor, $CreateButtons]]; SELECT value FROM $Normal => d.level ¬ normal; $Owner => d.level ¬ owner; $Administrator => d.level ¬ admin; $Wizard => d.level ¬ wizard; ENDCASE => ERROR; cbProc[d] }; ClassList: TYPE ~ MaintainDefs.ClassList; cmdButtons: PUBLIC ClassList ¬ CreateClasses[LIST [ <> ["List all groups and individuals matching the given pattern.", type, matches, any, normal], ["List the members of the given group.", type, members, group, normal], ["Give a summary of the given group or individual.", type, summary, any, normal], ["Give a detailed summary of the given group or individual.", type, details, any, admin], ["List all NS Domains matching the given pattern.", type, domains, any, normal, FALSE, FALSE], ["List all NS Organizations matching the given pattern.", type, organizations, any, normal, FALSE, FALSE], ["Checks the \"reasonability\" of the members of the given group.", type, finks, group, admin, TRUE], ["List the domains served by the given ClearingHouse.", type, domainsServed, any, wizard], <> ["Check to see if the argument is a direct member of the given group.", isMember, direct, group, normal], ["Check to see if the argument is a member (closure) of the given group.", isMember, extended, group, normal], ["List all groups matching the given pattern which the argument is a member of.", isMember, occurrences, group, normal], <> ["Set the password for the given individual", set, password, individual, normal, FALSE, FALSE, TRUE], ["Set the NS simple password for the given individual", set, simple, individual, normal, FALSE, FALSE, TRUE], ["Set the remark field for the given individual", set, individualRemark, individual, normal], ["Set the remark field for the given group", set, groupRemark, group, normal], ["Set the \"home\" File Service for the given individual", set, fileService, individual, admin], ["Replace all occurrences of the first argument with the second argument.", set, occurrences, group, admin], <> ["Add yourself as a member to the given group.", add, self, group, normal], ["Add a member to the given group.", add, member, group, owner], ["Add an owner to the given group.", add, owner, group, owner], ["Add a friend to the given group.", add, friend, group, owner], ["Add a mailbox to the given individual.", add, mailbox, individual, admin, TRUE], ["Add forwarding to the given individual.", add, forwarding, individual, admin], ["Add an alias for the given name.", add, alias, any, admin], <> ["Remove yourself as a member from the given group.", remove, self, group, normal], ["Remove a member from the given group.", remove, member, group, owner], ["Remove an owner from the given group.", remove, owner, group, owner], ["Remove a friend from the given group.", remove, friend, group, owner], ["Remove a mailbox for the given individual.", remove, mailbox, individual, admin, TRUE], ["Remove forwarding for the given individual.", remove, forwarding, individual, admin], ["Remove this alias from the ClearingHouse.", remove, alias, any, admin], ["Remove all occurences of the argument from all groups matching pattern.", remove, occurrences, group, admin], <> ["Create a new individual with the given name.", misc, createIndividual, individual, admin, FALSE, TRUE], ["Create a new group with the given name.", misc, createGroup, group, admin, FALSE, TRUE], ["Delete the object with the given name.", misc, delete, any, admin, FALSE, TRUE, TRUE] ]]; DisplayThisButton: PUBLIC PROC [d: MyData, cb: CmdButton] RETURNS [BOOL] = { RETURN[d.level >= cb.level]; }; StopProc: PUBLIC PROCEDURE [d: MyData] = { IF d = NIL THEN RETURN; d.stop ¬ TRUE; d.out.PutRope["\n\n[Stopping... (this may take a minute or two)]\n"]; }; AnotherProc: PUBLIC PROCEDURE [d: MyData, shift: BOOL ¬ FALSE, mb: ViewerClasses.MouseButton ¬ red] = { crProc: MaintainProcs.CreateProc ¬ LOOPHOLE[MaintainDefs.RetrieveProc[d.flavor, $Create]]; [] ¬ crProc[shift, SELECT mb FROM red => left, yellow => color, blue => right, ENDCASE => left]; }; HelpProc: PUBLIC PROCEDURE [d: MyData] = { IF d = NIL THEN RETURN; d.out.PutRope["\n\nMaintain uses PopUpButtons and its associated help facility. To use this facility hold down the mouse button over a command button (rather than \"clicking\"). After a moment you will get a PopUp menu. The top item in the menu will be \"Help\", select it. This will cause PopUpButtons to open up MaintainDoc.tioga and position it at a location relevant to the command you selected. (Note: to get help for guarded buttons you must click once to first remove the guard then hold down the button to get help.) For full documentation read MaintainDoc.\n"]; }; GetDirection: PUBLIC PROC[mb: Menus.MouseButton] RETURNS[sd: TiogaOps.SearchDir ¬ anywhere] = { SELECT mb FROM red => RETURN[forwards]; yellow => RETURN[anywhere]; blue => RETURN[backwards]; ENDCASE; }; TextLabelProc: PUBLIC PROC [d: MyData, o: REF ANY, button: Menus.MouseButton] = { ssProc: MaintainProcs.SetSelectionProc ¬ LOOPHOLE[MaintainDefs.RetrieveProc[d.flavor, $SetSelection]]; scProc: MaintainProcs.SetContentsProc ¬ LOOPHOLE[MaintainDefs.RetrieveProc[d.flavor, $SetContents]]; coProc: MaintainProcs.CaretOnlyProc ¬ LOOPHOLE[MaintainDefs.RetrieveProc[d.flavor, $CaretOnly]]; gscProc: MaintainProcs.GetSelectedContentsProc ¬ LOOPHOLE[MaintainDefs.RetrieveProc[d.flavor, $GetSelectedContents]]; SELECT button FROM red => { ssProc[o, NIL]; <> }; yellow => { scProc[o, gscProc[]]; ssProc[o, NIL]; coProc[]; <> <> <> }; blue => { ssProc[o, NIL]; scProc[o, NIL]; ssProc[o, NIL]; <> <> <> }; ENDCASE => ERROR; }; OpaqueRope: PROC [r: ROPE, c: CHAR ¬ '*] RETURNS [ROPE] = { Trans: Rope.TranslatorType = {RETURN[c]}; RETURN[Rope.Translate[base: r, translator: Trans]]; }; ReplaceThisRope: PUBLIC PROC [r, d, n: ROPE, all: BOOL ¬ TRUE, case: BOOL ¬ TRUE, pos: INT ¬ 0] RETURNS [ROPE] = { ld: INT ¬ Rope.Length[d]; ln: INT ¬ Rope.Length[n]; DO l: INT ¬ Rope.Length[r]; fi: INT ¬ Rope.Find[r, d, pos, case]; IF fi = -1 THEN EXIT; r ¬ Rope.Replace[r, fi, ld, n]; pos ¬ fi + ln; IF ~all THEN EXIT; ENDLOOP; RETURN[r]; }; verboseClassLabel: PUBLIC ROPE ¬ "Verbose"; verboseClass: PUBLIC PopUpButtons.Class ¬ PopUpButtons.MakeClass[[ classData: verboseClassLabel, proc: VerboseProc, choices: LIST[[verboseClassLabel, "Possibly provide additional information when on."]] ]]; autoDeleteClassLabel: PUBLIC ROPE ¬ "Auto Delete"; autoDeleteClass: PUBLIC PopUpButtons.Class ¬ PopUpButtons.MakeClass[[ classData: autoDeleteClassLabel, proc: AutoDeleteProc, choices: LIST[[autoDeleteClassLabel, "TypeFinks will delete bad members automatically when on."]] ]]; debugSwitchClassLabel: PUBLIC ROPE ¬ "Debug"; debugSwitchClass: PUBLIC PopUpButtons.Class ¬ PopUpButtons.MakeClass[[ classData: debugSwitchClassLabel, proc: debugSwitchProc, choices: LIST[[debugSwitchClassLabel, "Enable debugging features when on."]] ]]; setServerClass: PUBLIC PopUpButtons.Class ¬ PopUpButtons.MakeClass[[ proc: SetServerProcV, choices: LIST [[$SetServer, "Set the server to use for operations."]] ]]; verifyClass: PUBLIC SelectorClass ¬ CreateSelectorClass[name: "Verify", values: LIST[$on, $off]]; quoteClass: PUBLIC SelectorClass ¬ CreateSelectorClass[name: "Quote", values: LIST[$off, $on]]; SelectorProc: PopUpButtons.PopUpButtonProc = { <> viewer: Viewer ¬ NARROW[view]; si: SelectorInstance ~ NARROW[instanceData]; sc: SelectorClass ~ si.class; buttons: LIST OF REF ANY ¬ si.buttons; values: LIST OF ATOM ¬ sc.values; icl: ImagedClassList ¬ sc.classes; d: MyData ¬ NARROW[si.clientData]; aiProc: MaintainProcs.AmbushInstanceProc ¬ LOOPHOLE[MaintainDefs.RetrieveProc[d.flavor, $AmbushInstance]]; tsProc: MaintainProcs.ToSpecProc ¬ LOOPHOLE[MaintainDefs.RetrieveProc[d.flavor, $ToSpec]]; UNTIL values = NIL DO IF key = values.first THEN { si.value­ ¬ values.first; IF sc.change # NIL THEN sc.change[viewer.parent, si.clientData, values.first]; IF aiProc # NIL THEN aiProc[o: buttons.first, specImage: TRUE, image: icl.first.inverted]; <> } ELSE IF tsProc # NIL THEN IF tsProc[buttons.first].image = icl.first.inverted THEN IF aiProc # NIL THEN aiProc[o: buttons.first, specImage: TRUE, image: icl.first.normal]; buttons ¬ buttons.rest; values ¬ values.rest; icl ¬ icl.rest; ENDLOOP; }; CreateSelectorClass: PROC [name: ROPE, values: LIST OF ATOM, change: PROC [parent: REF ANY, clientData: REF, value: ATOM] ¬ NIL] RETURNS [sc: SelectorClass] ~ { choices, ctail: PopUpButtons.ChoiceList ¬ NIL; clTail: ImagedClassList ¬ NIL; sc ¬ NEW[ MaintainDefs.SelectorClassRec ¬ [ name: name, change: change, classes: NIL, values: values ] ]; FOR vl: LIST OF ATOM ¬ values, vl.rest WHILE vl # NIL DO this: PopUpButtons.ChoiceList ¬ LIST[[vl.first, Rope.Concat["Select ", Atom.GetPName[vl.first]]]]; IF ctail = NIL THEN choices ¬ this ELSE ctail.rest ¬ this; ctail ¬ this; ENDLOOP; FOR vl: LIST OF ATOM ¬ values, vl.rest WHILE vl # NIL DO this: ImagedClassList ¬ LIST[[ class: PopUpButtons.MakeClass[[ proc: SelectorProc, choices: CONS[[vl.first, Rope.Concat["Select ", Atom.GetPName[vl.first]]], choices], decodeMouseButton: FALSE, decodeShift: FALSE, decodeControl: FALSE, help: PopUpButtons.HelpFromDoc["MaintainDoc.Tioga", LIST[name]] ]], normal: PopUpButtons.ImageForRope[Atom.GetPName[vl.first]], inverted: PopUpButtons.ImageForRope[Atom.GetPName[vl.first], PopUpButtons.inverseColors] ]]; IF clTail=NIL THEN sc.classes ¬ this ELSE clTail.rest ¬ this; clTail ¬ this; ENDLOOP; }; AtomRopes: LIST OF ROPE = LIST [ "Normal", "Owner", "Administrator", "Wizard", "Verbose", "on", "off", "no", "yes", "Auto Debug", "Debug", "SetServer" ]; FixUpCase: PUBLIC PROC[r: ROPE] RETURNS[ROPE] ~ { FOR rl: LIST OF ROPE ¬ AtomRopes, rl.rest WHILE rl # NIL DO IF Rope.Equal[r, rl.first, FALSE] THEN RETURN[rl.first]; ENDLOOP; RETURN[r]; }; FixUpMyData: PUBLIC PROC [si: SelectorInstance] ~ { d: MyData = NARROW [si.clientData]; SELECT si.class FROM levelClass => { SELECT si.value­ FROM $Normal => d.level ¬ normal; $Owner => d.level ¬ owner; $Administrator => d.level ¬ admin; $Wizard => d.level ¬ wizard; ENDCASE => { si.value ¬ NEW[ATOM ¬ $Normal]; d.level ¬ normal; }; }; ENDCASE => NULL; }; CredentialsChange: PUBLIC XNSCredentials.XNSCredentialsChangeProc = { d: MyData ¬ NARROW[clientData]; d.identity ¬ new; ShowCredentials[d, "\n\nNew "]; }; ShowCredentials: PUBLIC PROC [d: MyData, leader: ROPE ¬ ""] = { nsName: ROPE ~ XNSCHName.RopeFromName[XNSAuth.GetIdentityDetails[d.identity].name]; d.out.PutF["%gUser: %g\n", [rope[leader]], [rope[nsName]]]; }; Registry: TYPE = REF RegistryBody ¬ NIL; RegistryBody: TYPE = RECORD[ SEQUENCE length: CARD OF ObjectFileFlavor]; ObjectFileFlavor: TYPE = REF ObjectFileFlavorBody ¬ NIL; ObjectFileFlavorBody: TYPE = RECORD[ flavor: ATOM, methods: SEQUENCE length: CARD OF ObjectFileProc]; ObjectFileProc: TYPE = REF ObjectFileProcBody ¬ NIL; ObjectFileProcBody: TYPE = RECORD[ procType: ATOM, proc: PROC ANY RETURNS ANY]; defaultReigstrySize: CARD = 5; defaultMethodsSize: CARD = 5; r: Registry; RetrieveProc: PUBLIC PROC[flavor: ATOM, procType: ATOM] RETURNS [p: PROC ANY RETURNS ANY] = { i, j: CARD; IF r = NIL THEN RETURN[NIL]; FOR i ¬ 0, i + 1 UNTIL i = r.length OR r[i] = NIL OR flavor = r[i].flavor DO ENDLOOP; IF i # r.length AND r[i] # NIL THEN { FOR j ¬ 0, j+1 UNTIL j = r[i].length OR r[i].methods[j] = NIL OR r[i].methods[j].procType = procType DO ENDLOOP; IF j # r[i].length AND r[i].methods[j] # NIL THEN { <> p ¬ r[i].methods[j].proc; }; }; }; RegisterProc: PUBLIC PROC[flavor: ATOM, procType: ATOM, proc: PROC ANY RETURNS ANY] = { i, slotToInsert : CARD; newR: Registry; newOFF: ObjectFileFlavor; IF r = NIL THEN r ¬ NEW [RegistryBody[defaultReigstrySize]]; FOR i ¬ 0, i + 1 UNTIL i = r.length OR r[i] = NIL OR r[i].flavor = flavor DO ENDLOOP; IF i = r.length THEN { newR ¬ NEW[RegistryBody[r.length + defaultReigstrySize]]; FOR index: CARD ¬ 0, index+ 1 UNTIL index = r.length DO newR[index] ¬ r[index]; ENDLOOP; r ¬ newR; }; IF r[i] = NIL THEN { r[i] ¬ NEW [ObjectFileFlavorBody[defaultMethodsSize]]; r[i].flavor ¬ flavor; slotToInsert ¬ 0; } ELSE { FOR slotToInsert ¬ 0, slotToInsert + 1 UNTIL slotToInsert = r[i].length OR r[i].methods[slotToInsert] = NIL OR r[i].methods[slotToInsert].procType = procType DO ENDLOOP; IF slotToInsert = r[i].length THEN { newOFF ¬ NEW[ObjectFileFlavorBody[r[i].length + defaultMethodsSize]]; newOFF.flavor ¬ r[i].flavor; FOR index: CARD ¬ 0, index+ 1 UNTIL index = r[i].length DO newOFF.methods[index] ¬ r[i].methods[index]; ENDLOOP; r[i] ¬ newOFF; }; }; r[i].methods[slotToInsert] ¬ NEW[ObjectFileProcBody ¬[procType, proc]]; }; <<******** Main program ********>> }.