DIRECTORY
Atom USING [GetPName, MakeAtom],
Buttons USING [ButtonProc, Create],
Commander USING [CommandProc, Register],
Containers USING [ChildXBound, ChildYBound, Create],
IO USING [noWhereStream],
Labels USING [Create],
MaintainDefs,
MaintainMisc USING [RopeFromCommand, RopeFromWhat],
MaintainProcs USING [AmbushInstanceProc, AnotherProc, CaretOnlyProc, ChangeLevel, ChangeLooksProc, CreateProc, CredentialsChange, DisplayThisButton, FixUpCase, FixUpMyData, GetContentsProc, GetDirection, HelpProc, SetContentsProc, SetSelectionProc, ShowCredentials, StopProc, TextLabelProc, ToSpecProc],
Menus USING [AppendMenuEntry, CreateEntry, CreateMenu, Menu, MenuProc],
PopUpButtons USING [AmbushInstance, Class, GetSpec, Image, ImageForRope, Instantiate, inverseColors, ViewerToSpec],
Real USING [Round],
Rope USING [Concat, Equal, Length, ROPE],
Rules USING [Create],
TiogaMenuOps USING [Normalize, PrevPlace],
TiogaOps USING [CaretOnly, FindText, FindWord],
TypeScript USING [ChangeLooks, Create, Reset],
UserProfile USING [Boolean, Token],
ViewerClasses USING [Column, Viewer],
ViewerEvents USING [EventProc, RegisterEventProc, UnRegisterEventProc],
ViewerIO USING [CreateViewerStreams],
ViewerOps USING [AddProp, BlinkIcon, ComputeColumn, DestroyViewer, FetchProp, MoveViewer, SetMenu, SetOpenHeight],
ViewerSpecs USING [windowBorderSize],
ViewerTools USING [GetContents, GetSelectionContents, InhibitUserEdits, MakeNewTextViewer, SetContents, SetSelection],
XNSCredentials USING [GetIdentity, RegisterForChange];
MaintainViewersImpl:
CEDAR
MONITOR
LOCKS d
USING d: MaintainDefs.MyData
IMPORTS Atom, Buttons, Commander, Containers,
IO, Labels, MaintainDefs, MaintainMisc, MaintainProcs, Menus, PopUpButtons, Real, Rope, Rules, TiogaMenuOps, TiogaOps, TypeScript, UserProfile, ViewerEvents, ViewerIO, ViewerOps, ViewerSpecs, ViewerTools, XNSCredentials ~ {
OPEN MaintainDefs;
ROPE: TYPE ~ Rope.ROPE;
Viewer: TYPE ~ ViewerClasses.Viewer;
ColumnTable: TYPE = LIST OF ColumnTableEntry;
ColumnTableEntry:
TYPE =
RECORD [
key: ROPE,
value: ViewerClasses.Column
];
columnTable: ColumnTable =
LIST [
["left", left],
["right", right],
["color", color]];
TLPData: TYPE ~ REF TLPDataRec;
TLPDataRec:
TYPE ~
RECORD[
d: MyData,
c: REF ANY];
TextLabelProc: Buttons.ButtonProc ~ {
tlpData: TLPData ¬ NARROW[clientData];
d: MyData ¬ tlpData.d;
c: Viewer ¬ NARROW[tlpData.c];
o: Viewer ¬ NARROW[parent];
MaintainProcs.TextLabelProc[d, c, mouseButton];
};
StopProc: Menus.MenuProc = {
d: MyData ¬ NARROW[ViewerOps.FetchProp[parent, maintainDataProp]];
MaintainProcs.StopProc[d];
};
AnotherProc: Menus.MenuProc = {
d: MyData ¬ NARROW[clientData];
MaintainProcs.AnotherProc[d, shift, mouseButton];
};
HelpProc: Menus.MenuProc = {
d: MyData ¬ NARROW[ViewerOps.FetchProp[parent, maintainDataProp]];
MaintainProcs.HelpProc[d];
};
CreateButtons:
ENTRY
PROC [d: MyData] = {
ENABLE UNWIND => NULL;
parent: Viewer ¬ NARROW[d.parent];
child: Viewer ¬ NIL;
currentCmd: Command ¬ nullCmd;
buttonsOnLine: CARD ¬ 0;
maxButtonsOnLine: CARD = 4;
MakeCmdButton:
PROC [cc: PopUpButtons.Class, cb: CmdButton] = {
child ¬ cc.Instantiate[
viewerInfo: [name: MaintainMisc.RopeFromWhat[cb.what], parent: kids, border: TRUE, wy: child.wy, wx: child.wx + d.maxW - 1, ww: d.maxW],
instanceData: NEW[CmdRec ¬ [d, cb]],
paint: FALSE];
};
LabelText:
PROC
[name, data: ROPE, prev: Viewer, newline: BOOL ¬ TRUE, wide: BOOL ¬ TRUE] RETURNS[Viewer] = {
x: INTEGER = IF newline THEN 2 ELSE IF wide THEN child.wx + d.maxW - 1 ELSE child.wx + child.ww + 10;
y: INTEGER = IF newline THEN child.wy + child.wh + 1 ELSE child.wy;
tempWW: INTEGER ¬ Real.Round[PopUpButtons.ImageForRope[name].size.x];
child ¬ ViewerTools.MakeNewTextViewer[
info: [parent: kids, wh: d.buttH, ww: 999, scrollable:
TRUE,
data: IF prev = NIL THEN data ELSE ViewerTools.GetContents[prev],
border: FALSE,
wx: IF wide THEN x + d.maxW + 2 ELSE x + tempWW + 2,
wy: y],
paint: FALSE ];
Containers.ChildXBound[kids, child];
[] ¬ Buttons.Create[
info: [name: name, parent: kids, wh: d.buttH,
border: FALSE, wx: x, wy: y],
proc: TextLabelProc, clientData: NEW[TLPDataRec ¬ [d, child]], fork: TRUE, paint: FALSE];
RETURN[child]
};
Label:
PROC [name:
ROPE] = {
child ¬ Labels.Create[
info: [name: name, parent: kids, border:
FALSE,
wy: child.wy + child.wh + (IF child.class.flavor = $PopUpButton THEN -1 ELSE 2),
wx: 2],
paint: FALSE ];
};
Rule:
PROC = {
child ¬ 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];
};
kids: 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: "Name:",
data: "",
prev: GetViewer[d.groupT] ];
d.dataGT ¬ LabelText[
name: "Argument:",
data: "",
prev: GetViewer[d.dataGT] ];
IF d.displayScratch
THEN
d.scratchGT ¬ LabelText[
name: "Scratch:",
data: d.scratchRope,
prev: GetViewer[d.scratchGT] ];
FOR cbl: ClassList ¬ cmdButtons, cbl.rest
WHILE cbl #
NIL
DO
c: PopUpButtons.Class ~ cbl.first;
b: CmdButton ~ NARROW[c.GetSpec[].spec.classData, REF CmdButton];
IF b.nextLine THEN buttonsOnLine ¬ maxButtonsOnLine;
IF ~MaintainProcs.DisplayThisButton[d, b] THEN LOOP;
IF b.cmd # currentCmd
OR buttonsOnLine >= maxButtonsOnLine
THEN {
Label[IF b.cmd # currentCmd THEN Rope.Concat[MaintainMisc.RopeFromCommand[b.cmd], ":"] ELSE ""];
buttonsOnLine ¬ 0;
};
buttonsOnLine ¬ buttonsOnLine + 1;
MakeCmdButton[c, b];
currentCmd ¬ b.cmd;
ENDLOOP;
Rule[];
IF d.level = wizard
THEN {
[child, d.verify] ¬ InstantiateSelector[
class: verifyClass,
init: d.verify,
clientData: d,
viewer: kids,
x: 2, y: child.wy + child.wh + 2];
[child, d.quote] ¬ InstantiateSelector[
class: quoteClass,
init: d.quote,
clientData: d,
viewer: kids,
x: child.wx + child.ww + 10, y: child.wy];
[child, d.gvms] ¬ InstantiateSelector[
class: updatesClass,
init: d.gvms,
clientData: d,
viewer: kids,
x: child.wx + child.ww + 10, y: child.wy];
child ¬ autoDeleteClass.Instantiate[
viewerInfo: [name: autoDeleteClassLabel, parent: kids, wh: d.buttH,
border: TRUE, wx: 2, wy: child.wy + child.wh + 2],
instanceData: d,
image:
IF d.autoDelete
THEN PopUpButtons.ImageForRope[autoDeleteClassLabel, PopUpButtons.inverseColors]
ELSE PopUpButtons.ImageForRope[autoDeleteClassLabel],
paint: FALSE];
child ¬ debugSwitchClass.Instantiate[
viewerInfo: [name: debugSwitchClassLabel, parent: kids, wh: d.buttH,
border: TRUE, wx: child.wx + child.ww + 10, wy: child.wy],
instanceData: d,
image:
IF d.debugSwitch
THEN PopUpButtons.ImageForRope[debugSwitchClassLabel, PopUpButtons.inverseColors]
ELSE PopUpButtons.ImageForRope[debugSwitchClassLabel],
paint: FALSE];
child ¬ updateMapClass.Instantiate[
viewerInfo: [name: "UpdateMap", parent: kids, wh: d.buttH,
border: TRUE, wx: 2, wy: child.wy + child.wh + 2],
instanceData: d, paint: FALSE];
child ¬ setServerClass.Instantiate[
viewerInfo: [name: "SetServer", parent: kids, wh: d.buttH,
border: TRUE, wx: child.wx + child.ww + 10, wy: child.wy],
instanceData: d, paint: FALSE];
d.serverT ¬ LabelText[
name: "Host:",
data: "",
prev: GetViewer[d.serverT],
newline: FALSE,
wide: FALSE ];
Rule[];
}
ELSE { d.serverT ¬ NIL };
{
kidsY: INTEGER = GetViewer[d.topChild].wy + GetViewer[d.topChild].wh + 2;
kidsH: INTEGER = child.wy + child.wh + 2;
IF d.kids # NIL THEN ViewerOps.DestroyViewer[GetViewer[d.kids], FALSE];
d.kids ¬ kids;
ViewerOps.MoveViewer[viewer: GetViewer[d.script], x: 0, y: kidsY + kidsH, w: GetViewer[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];
};
};
ChangeLevel:
PROC [parent:
REF
ANY, clientData:
REF
ANY, value:
ATOM] ~ {
PROC [parent: Viewer, clientData: REF, value: ATOM] = {
v: Viewer = NARROW[parent];
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;
MaintainProcs.ChangeLevel[d, value];
};
ColumnFromRope:
PROC [cr:
ROPE]
RETURNS [ViewerClasses.Column] = {
FOR ce: ColumnTable ¬ columnTable, ce.rest
WHILE ce #
NIL
DO
IF Rope.Equal[cr, ce.first.key, FALSE] THEN RETURN[ce.first.value];
ENDLOOP;
RETURN[right];
};
CreateProc: Commander.CommandProc = {
[cmd: Handle]
Create[
UserProfile.Boolean["Maintain.Iconic", FALSE],
ColumnFromRope[UserProfile.Token["Maintain.Column", "right"]]];
};
InstantiateSelector:
PROC [class: SelectorClass, init:
REF
ATOM ¬
NIL, clientData:
REF ¬
NIL, viewer: Viewer, x, y:
INTEGER]
RETURNS [child: Viewer, value:
REF
ATOM] ~ {
si: SelectorInstance ~
NEW [SelectorInstanceRec ¬ [
clientData: clientData,
value:
IF init #
NIL
THEN init
ELSE NEW[ATOM ¬ Atom.MakeAtom[MaintainProcs.FixUpCase[UserProfile.Token[Rope.Concat["Maintain.", class.name], Atom.GetPName[class.values.first]]]]],
class: class]];
last: LIST OF REF ANY ¬ NIL;
MaintainProcs.FixUpMyData[si];
value ¬ si.value;
child ¬ Labels.Create[info: [name: Rope.Concat[class.name, ":"], parent: viewer, border: FALSE, wx: x, wy: y] ];
FOR cl: ImagedClassList ¬ class.classes, cl.rest
WHILE cl #
NIL
DO
ic: ImagedClass ~ cl.first;
this:
LIST
OF
REF
ANY ~
LIST[child ¬ ic.class.Instantiate[
viewerInfo: [name: Atom.GetPName[NARROW[ic.class.GetSpec[].choices.first.key]], parent: viewer, border: TRUE, wy: child.wy, wx: child.wx + child.ww + 2],
instanceData: si,
image: IF si.value = ic.class.GetSpec[].choices.first.key THEN ic.inverted ELSE ic.normal
]];
IF last=NIL THEN si.buttons ¬ this ELSE last.rest ¬ this;
last ¬ this;
ENDLOOP;
};
ChangeLooks:
PUBLIC MaintainProcs.ChangeLooksProc ~ {
TypeScript.ChangeLooks[GetViewer[d.script], looks];
};
CaretOnly:
PUBLIC MaintainProcs.CaretOnlyProc ~ {
TiogaOps.CaretOnly[];
};
GetContents:
PUBLIC MaintainProcs.GetContentsProc ~ {
contents ¬ ViewerTools.GetContents[GetViewer[where]];
IF Rope.Length[contents] = 0 THEN contents ¬ default;
};
GetSelectedContents:
PUBLIC MaintainProcs.GetContentsProc ~ {
RETURN[ViewerTools.GetSelectionContents[]];
};
SetContents:
PUBLIC MaintainProcs.SetContentsProc ~ {
ViewerTools.SetContents[GetViewer[o], what];
};
SetSelection:
PUBLIC MaintainProcs.SetSelectionProc ~ {
ViewerTools.SetSelection[GetViewer[o], selection];
};
GetViewer:
PUBLIC
PROC[r:
REF
ANY]
RETURNS [v: Viewer ¬
NIL] ~ {
v ¬ NARROW[r];
};
CreateMenu:
ENTRY
PROC [d: MyData, parent: Viewer] = {
ENABLE UNWIND => NULL;
menu: Menus.Menu ¬ Menus.CreateMenu[];
Menus.AppendMenuEntry[menu, Menus.CreateEntry["STOP", StopProc, d]];
Menus.AppendMenuEntry[menu, Menus.CreateEntry["Another", AnotherProc, d]];
Menus.AppendMenuEntry[menu, Menus.CreateEntry["Help", HelpProc, d]];
Menus.AppendMenuEntry[menu, Menus.CreateEntry["Find", FindProc, d]];
Menus.AppendMenuEntry[menu, Menus.CreateEntry["Word", WordProc, d]];
Menus.AppendMenuEntry[menu, Menus.CreateEntry["Normalize", NormalizeProc, d]];
Menus.AppendMenuEntry[menu, Menus.CreateEntry["PrevPlace", PrevPlaceProc, d]];
Menus.AppendMenuEntry[menu, Menus.CreateEntry["Scratch", ScratchProc, d]];
ViewerOps.SetMenu[parent, menu];
};
GetStreams:
PROC [d: MyData, name:
ROPE, backingFile:
ROPE, editedStream:
BOOLEAN] = {
[in: d.in, out: d.out] ¬ ViewerIO.CreateViewerStreams[
name: name,
viewer: GetViewer[d.script],
backingFile: backingFile,
editedStream: editedStream];
};
InhibitEdits:
PROC [where:
REF
ANY] = {
ViewerTools.InhibitUserEdits[GetViewer[where]];
};
TypeScriptReset:
PROC [where:
REF
ANY] = {
TypeScript.Reset[GetViewer[where]];
};
ScratchProc: Menus.MenuProc = {
d: MyData ¬ NARROW[ViewerOps.FetchProp[parent, maintainDataProp]];
IF d = NIL THEN RETURN;
d.displayScratch ¬ ~d.displayScratch;
IF ~d.displayScratch
THEN {
d.scratchRope ¬ ViewerTools.GetContents[GetViewer[d.scratchGT]];
d.scratchGT ¬ NIL;
};
CreateButtons[d]
};
NormalizeProc: Menus.MenuProc = {
d: MyData ¬ NARROW[ViewerOps.FetchProp[parent, maintainDataProp]];
IF d = NIL THEN RETURN;
TiogaMenuOps.Normalize[GetViewer[d.script]];
};
PrevPlaceProc: Menus.MenuProc = {
d: MyData ¬ NARROW[ViewerOps.FetchProp[parent, maintainDataProp]];
IF d = NIL THEN RETURN;
TiogaMenuOps.PrevPlace[GetViewer[d.script]];
};
WordProc: Menus.MenuProc = {
d: MyData ¬ NARROW[ViewerOps.FetchProp[parent, maintainDataProp]];
IF d = NIL THEN RETURN;
IF ~TiogaOps.FindWord[
viewer: GetViewer[d.script],
whichDir: MaintainProcs.GetDirection[mouseButton],
which: feedback,
case: ~shift]
THEN ViewerOps.BlinkIcon[GetViewer[d.script]];
};
FindProc: Menus.MenuProc = {
d: MyData ¬ NARROW[ViewerOps.FetchProp[parent, maintainDataProp]];
IF d = NIL THEN RETURN;
IF ~TiogaOps.FindText[
viewer: GetViewer[d.script],
whichDir: MaintainProcs.GetDirection[mouseButton],
which: feedback,
case: ~shift]
THEN ViewerOps.BlinkIcon[GetViewer[d.script]];
};
NoteDestruction: ViewerEvents.EventProc = {
d: MyData ¬ NARROW[ViewerOps.FetchProp[viewer, maintainDataProp]];
IF event = destroy AND d # NIL THEN NoteDestructionInternal[d];
};
NoteDestructionInternal:
PROC [d: MyData] = {
ENABLE UNWIND => NULL;
IF d #
NIL
THEN {
d.out ¬ IO.noWhereStream;
d.stop ¬ TRUE;
ViewerEvents.UnRegisterEventProc[d.destructionEvent, destroy];
UserCredentials.UnRegisterForChange[CredentialsChange, d];
};
};
Create: MaintainProcs.CreateProc = {
newLevelClass: SelectorClass ¬ levelClass;
d: MaintainDefs.MyData = NEW[MaintainDefs.MyDataObject];
v: Viewer = Containers.Create[
info: [
name: "Maintain",
label: doneLabel,
column: column,
scrollable: FALSE,
iconic: iconic]];
d.flavor ¬ $Viewer;
d.parent ¬ v;
{
kludge to find max button size! --
d.maxW ¬ 0;
d.buttH ¬ 0;
FOR cbl: ClassList ¬ cmdButtons, cbl.rest
WHILE cbl #
NIL
DO
c: PopUpButtons.Class ~ cbl.first;
b: CmdButton ~ NARROW[c.GetSpec[].spec.classData, REF CmdButton];
temp: PopUpButtons.Image ~ PopUpButtons.ImageForRope[MaintainMisc.RopeFromWhat[b.what]];
IF temp.size.x > d.maxW THEN d.maxW ¬ Real.Round[temp.size.x];
IF temp.size.y > d.buttH THEN d.buttH ¬ Real.Round[temp.size.y];
ENDLOOP;
d.maxW ¬ Real.Round[d.maxW + 2*ViewerSpecs.windowBorderSize];
d.buttH ¬ Real.Round[d.buttH + 2*ViewerSpecs.windowBorderSize];
};
newLevelClass.change ¬ ChangeLevel;
d.topChild ¬ InstantiateSelector[class: newLevelClass,
clientData: d,
viewer: v,
x: 2, y: 3].child;
d.topChild ¬ verboseClass.Instantiate[
viewerInfo: [name: verboseClassLabel, parent: v, wh: d.buttH,
border: TRUE, wx: GetViewer[d.topChild].wx + GetViewer[d.topChild].ww + 20, wy: GetViewer[d.topChild].wy],
instanceData: d, paint: FALSE];
d.topChild ¬ InstantiateSelector[class: newModeClass,
clientData: d,
viewer: v,
x: 2,
y: GetViewer[d.topChild].wy + GetViewer[d.topChild].wh + 2].child;
d.displayScratch ¬ UserProfile.Boolean["Maintain.Scratch", TRUE];
d.script ¬ TypeScript.Create[
info: [parent: v, wh: v.ch - (GetViewer[d.topChild].wy + GetViewer[d.topChild].wh + 2), ww: v.cw,
border: FALSE,
wy: GetViewer[d.topChild].wy + GetViewer[d.topChild].wh + 2, wx: 0] ];
Containers.ChildXBound[v, GetViewer[d.script]];
Containers.ChildYBound[v, GetViewer[d.script]];
[in: d.in, out: d.out] ¬ ViewerIO.CreateViewerStreams[
name: "Maintain",
viewer: GetViewer[d.script],
backingFile: logName,
editedStream: FALSE];
ViewerTools.InhibitUserEdits[GetViewer[d.script]];
CreateMenu[d, v];
CreateButtons[d];
d.identity ¬ XNSCredentials.GetIdentity[];
[d.gvName, d.gvPassword] ¬ UserCredentials.Get[];
XNSCredentials.RegisterForChange[MaintainProcs.CredentialsChange, d];
ViewerOps.AddProp[v, maintainDataProp, d];
d.destructionEvent ¬ ViewerEvents.RegisterEventProc[proc: NoteDestruction, event: destroy, filter: v, before: TRUE];
MaintainProcs.ShowCredentials[d];
};
AmbushInstance: MaintainProcs.AmbushInstanceProc ~ { PopUpButtons.AmbushInstance[button: GetViewer[o], image: image, specImage: specImage];};
ToSpec: MaintainProcs.ToSpecProc ~ {
RETURN[PopUpButtons.ViewerToSpec[button: GetViewer[o]]];};
MaintainDefs.RegisterProc[$Viewer, $AmbushInstance, AmbushInstance];
MaintainDefs.RegisterProc[$Viewer, $ComputeColumn, ComputeColumn];
MaintainDefs.RegisterProc[$Viewer, $CaretOnly, CaretOnly];
MaintainDefs.RegisterProc[$Viewer, $ChangeLooks, ChangeLooks];
MaintainDefs.RegisterProc[$Viewer, $CreateButtons, CreateButtons];
MaintainDefs.RegisterProc[$Viewer, $Create, Create];
MaintainDefs.RegisterProc[$Viewer, $DestroyObject, DestroyObject];
MaintainDefs.RegisterProc[$Viewer, $GetContents, GetContents];
MaintainDefs.RegisterProc[$Viewer, $GetSelectedContents, GetSelectedContents];
MaintainDefs.RegisterProc[$Viewer, $IsIconic, IsIconic];
MaintainDefs.RegisterProc[$Viewer, $InstantiateSelector, InstantiateSelector];
MaintainDefs.RegisterProc[$Viewer, $MoveObject, MoveObject];
MaintainDefs.RegisterProc[$Viewer, $SetContents, SetContents];
MaintainDefs.RegisterProc[$Viewer, $SetOpenHeight, SetOpenHeight];
MaintainDefs.RegisterProc[$Viewer, $SetSelection, SetSelection];
MaintainDefs.RegisterProc[$Viewer, $ToSpec, ToSpec];
Commander.Register[key: "Maintain", proc: CreateProc,
doc: "Performs enquiries and updates to the NS and Grapevine databases"];
}.