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 ];
************
logName: PUBLIC ROPE ¬ "/ux/tmp/Maintain.log";
maintainDataProp: PUBLIC ATOM ¬ Atom.MakeAtom["MaintainDataProp"];
From MaintainDefs
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-- = {
view: View, instanceData, classData, key: REF ANY
viewer: Viewer ← NARROW[o];
viewer: Viewer ← NARROW[view];
cd: CmdRef ¬ cr;
cd: CmdRef ← NARROW[instanceData];
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;
WHILE viewer.parent # NIL DO
viewer ← viewer.parent;
ENDLOOP;
viewer.label ← busyLabel;
viewer.name ← busyName;
Wizard types may need to put a break here and:
To "become a ClearingHouse" interpret:
d.identity ← XNSAuth.MakeStrongIdentityUsingKey[XNSCHName.NameFromRope["Clearinghouse Service:CHServers:CHServers"], [xx, xx, xx, xx]]
where the xx's are obviously filled in with the right numbers.
To un"become a ClearingHouse" interpret:
d.identity ← UserCredentials.GetIdentity[]
To "become a GV Wizard" interpret:
d.gvName ← "Wizard.gv"
d.gvPassword ← "xx"
where xx is obviously filled in with the correct password.
Don't forget that for some special GV operations you have to have first done an identifyCaller operation. One no-op way to do this is to "add member" to an individual.
To un"become a GV Wizard" interpret:
d.gvName ← UserCredentials.Get[].name
d.gvPassword ← UserCredentials.Get[].password
remember that this data is tool instance data.
ViewerOps.PaintViewer[viewer, caption];
selection ¬ gscProc[];
selection ← ViewerTools.GetSelectionContents[];
names ¬ gcProc[d.groupT, ""];
args ¬ gcProc[d.dataGT, ""];
CmdProcInternal[d, cd.cb, names, args, selection, key];
viewer.label ← doneLabel;
viewer.name ← doneName;
ViewerOps.PaintViewer[viewer, caption];
IF viewer.iconic THEN ViewerOps.BlinkViewer[viewer];
};
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 = {
view: View, instanceData, classData, key: REF ANY
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 = {
view: View, instanceData, classData, key: REF ANY
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 = {
view: View, instanceData, classData, key: REF ANY
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 = {
view: View, instanceData, classData, key: REF ANY
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 [
Type
["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],
IsMember
["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
["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
["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
["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],
Misc
["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];
ViewerTools.SetSelection[text, NIL];
};
yellow => {
scProc[o, gscProc[]];
ssProc[o, NIL];
coProc[];
ViewerTools.SetContents[text, ViewerTools.GetSelectionContents[]];
ViewerTools.SetSelection[text, NIL];
TiogaOps.CaretOnly[];
};
blue => {
ssProc[o, NIL];
scProc[o, NIL];
ssProc[o, NIL];
ViewerTools.SetSelection[text, NIL];
ViewerTools.SetContents[text, NIL];
ViewerTools.SetSelection[text, 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 = {
view: View, instanceData, classData, key: REF ANY
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];
PopUpButtons.AmbushInstance[button: GetViewer[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;
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 {
found ← TRUE;
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]];
};