
<<WalnutWindowCommandsImpl.mesa>>
<<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
<<Willie-Sue, October 28, 1985 4:36:35 pm PST>>
    <<Donahue, May 22, 1985 11:08:54 am PDT>>
    <<Pavel, February 6, 1986 1:34:48 pm PST>>

<<Contents: (Internal communication for) Top level Viewer for Walnut>>

<<Last edit by:>>
<<Willie-Sue on: January 7, 1985 9:22:19 am PST>>
<<Donahue, January 2, 1985 3:42:26 pm PST>>

DIRECTORY
Commander USING [CommandProc, Handle, Register],
Containers,
FS USING [ComponentPositions, Error, ExpandName],
Icons USING [IconFlavor, NewIconFromFile],
IO,
MBQueue USING [Queue, Create, QueueClientAction],
Menus,
MessageWindow USING [Append],
Process USING [Detach],
Rope,
Rules USING [Create],
UserCredentials USING [Get],
UserProfile USING [Token],
ViewerClasses USING [Viewer],
ViewerEvents USING [EventProc, EventRegistration, RegisterEventProc],
ViewerOps,
ViewerSpecs USING[openLeftWidth, openTopY, openRightWidth],

WalnutSendOps USING [userRName],
WalnutSendOpsExtras USING [ChangeUserRName],
WalnutOps USING [MsgSet, dontCareMsgSetVersion,
CopyToExpungeLog, ExpungeMsgs, ReadArchiveFile, Shutdown],

WalnutControlInternal USING [blankMenu, walnutMenu, workingMenu,
BuildWalnutMenus, ChangeMenu, DoArchive, DoWaitCall, DoStartupCall, FlushWQueue, FixUpWalnutViewers, QuitWalnut, RestartWalnut],
WalnutViewer USING [FirstLabel, MakeRuler, MakeTypescript],

WalnutDisplayerInternal USING [QDisplayMsg, QDisplayMsgSet],
WalnutWindowInternal USING [MsgSetButton,
activeMsgSetButton, msgSetsVersion,
CloseDownWalnut, DestroyAllMsgSetButtons, DisableNewMail, GetButton, OpenTS,
Report, RetrieveNewMail, ShowMsgSetButtons, TakeDownWalnutViewers],

WalnutWindow USING [OutCome];

WalnutWindowCommandsImpl: CEDAR PROGRAM
IMPORTS
FS,
Commander,
Containers, Icons, MBQueue, MessageWindow, Rules,
IO, Process, Rope,
UserCredentials, UserProfile,
ViewerEvents, ViewerOps, ViewerSpecs,
WalnutSendOps, WalnutSendOpsExtras, WalnutOps,
WalnutControlInternal, WalnutDisplayerInternal,
WalnutViewer, WalnutWindowInternal
EXPORTS WalnutWindow, WalnutControlInternal, WalnutWindowInternal =

BEGIN OPEN WalnutControlInternal, WalnutWindowInternal;

<<Walnut Viewers types and global data>>

ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;
Viewer: TYPE = ViewerClasses.Viewer;

InitialNotifyLabel: PUBLIC ROPE _
"                                                                                ";

walnutVersion: ROPE _ "Walnut 6.0";

walnut: PUBLIC Viewer _ NIL;

msgSetIcon: PUBLIC Icons.IconFlavor _ tool;
msgIcon: PUBLIC Icons.IconFlavor _ tool;
labelledWalnutIcon: PUBLIC Icons.IconFlavor _ tool;
labelledNewMailIcon: PUBLIC Icons.IconFlavor _ tool;
unLabelledWalnutIcon: PUBLIC Icons.IconFlavor _ tool;
unLabelledNewMailIcon: PUBLIC Icons.IconFlavor _ tool;
walnutIcon: PUBLIC Icons.IconFlavor _ tool;
newMailIcon: PUBLIC Icons.IconFlavor _ tool;

iconFilePathName: PUBLIC ROPE _ NIL;

walnutEventReg: PUBLIC ViewerEvents.EventRegistration_ NIL;
mustQuitWalnut: PUBLIC ROPE _ NIL;
previousUser: PUBLIC ROPE _ NIL;
gettingOrganized: PUBLIC BOOL _ FALSE;
readyToGo: PUBLIC CONDITION;

initialActiveIconic: PUBLIC BOOL _ FALSE;
initialActiveRight: PUBLIC BOOL _ TRUE;
initialActiveOpen: PUBLIC BOOL _ TRUE;
msgSetBorders: PUBLIC BOOL _  FALSE;
walnutRulerBefore, walnutRulerAfter, walnutTS: PUBLIC Viewer;

mailNotifyLabel: PUBLIC Viewer;    -- is there new mail or not

msgNamePrefix: PUBLIC ROPE;
msgSetNamePrefix: PUBLIC ROPE;

walnutRootFile: PUBLIC ROPE;
readOnlyAccess: PUBLIC BOOL;
personalMailDB: PUBLIC BOOL;

walnutQueue: PUBLIC MBQueue.Queue;

<<* * * * * * * * * * Commander.CommandProc's - only Expunge & Shutdown Wait>>

BuildWalnut: Commander.CommandProc = {
h: IO.STREAM;
dirName, rootName, captionName: ROPE;

IF cmd # NIL  THEN 
{ h _ IO.RIS[cmd.commandLine];
dirName _ h.GetTokenRope[IO.IDProc ! IO.EndOfStream =>
{ dirName _ NIL; CONTINUE }].token;
};

[rootName, captionName] _ ParseRootName[dirName];
IF rootName = NIL THEN {
IF cmd # NIL THEN cmd.out.PutRope["\nNo RootFile specified\n"];
RETURN
};

IF walnut # NIL THEN
IF ~rootName.Equal[walnutRootFile, FALSE] THEN
{ TRUSTED { Process.Detach[ 
    FORK ChangeDatabase[FALSE, rootName, captionName, dirName] ] };
RETURN
}; 

TRUSTED {Process.Detach[FORK DoStartup[FALSE, rootName, captionName, dirName]] };
};

WalnutOldMailReader: Commander.CommandProc = {
h: IO.STREAM;
fName, messageSet: ROPE;

IF walnut = NIL THEN { NoWalnutReport[cmd, "read old mail files"]; RETURN };

h _ IO.RIS[cmd.commandLine];
fName _ h.GetTokenRope[IO.IDProc ! IO.EndOfStream => GOTO noFile].token;
messageSet _ h.GetTokenRope[IO.IDProc ! IO.EndOfStream => CONTINUE].token;
TRUSTED {Process.Detach[FORK ReadMailFile[fName, messageSet, FALSE]] };

EXITS
noFile => Report["No file specified"];
};

WalnutExpunge: Commander.CommandProc = {
IF walnut = NIL THEN { NoWalnutReport[cmd, "do Expunge"]; RETURN};
Expunge[];
};

WalnutDump: Commander.CommandProc = {};

WalnutScavenge: Commander.CommandProc = {
rootName, captionName, dirName: ROPE;
BEGIN
h: IO.STREAM  _ IO.RIS[cmd.commandLine];
dirName _ h.GetTokenRope[IO.IDProc ! IO.EndOfStream =>
{dirName _ NIL; CONTINUE}].token;
END;
[rootName, captionName] _ ParseRootName[dirName];
IF rootName = NIL THEN {
cmd.out.PutRope["\n No rootfile given\n"];
RETURN;
};
TRUSTED {Process.Detach[FORK DoScavenge[rootName, captionName, dirName]]};
};

WalnutMascarade: Commander.CommandProc = {
dirName, rootName, captionName, rootUserName: ROPE;
oldUser: ROPE;
BEGIN
h: IO.STREAM  _ IO.RIS[cmd.commandLine];
dirName _ h.GetTokenRope[IO.IDProc ! IO.EndOfStream =>
{dirName _ NIL; CONTINUE}].token;
END;
[rootName, captionName, dirName, rootUserName] _ ParseRootName[dirName];
IF rootName = NIL THEN {
cmd.out.PutRope["\n No rootfile given\n"];
RETURN;
};
IF NOT rootUserName.Equal[WalnutSendOps.userRName, FALSE] THEN {
oldUser _ WalnutSendOps.userRName;
WalnutSendOpsExtras.ChangeUserRName[rootUserName];
};
DoScavenge[rootName, captionName, dirName];
IF oldUser # NIL THEN WalnutSendOpsExtras.ChangeUserRName[oldUser];
cmd.out.PutF[
" Finished scavenging %g (done by %g)\n", IO.rope[rootName], IO.rope[oldUser]];
};

WalnutShutdown: Commander.CommandProc =
{ IF walnut # NIL THEN Shutdown[] };

WalnutNewMailProc: Commander.CommandProc = TRUSTED
{ Process.Detach[FORK RetrieveNewMail[]]};

<<* * * * * * * * * * exported to WalnutWindow - these all wait for completion>>

DisplayMsg: PUBLIC PROC[msg: ROPE, oldV: Viewer _ NIL, shift: BOOL _ FALSE]
    RETURNS[v: Viewer] = {
Dm: PROC =        -- don't open if iconic
{ v _ WalnutDisplayerInternal.QDisplayMsg[msg, oldV, shift, FALSE] };
[] _ DoWaitCall[Dm];
};

DisplayMsgSet: PUBLIC PROC[msgSet: ROPE, shift: BOOL _ FALSE, repaint: BOOL _ TRUE]
    RETURNS[v: Viewer] = {
Dms: PROC = {
v _ WalnutDisplayerInternal.QDisplayMsgSet[GetButton[msgSet], NIL, shift, repaint];
};
[] _ DoWaitCall[Dms];
};

CurrentVersion: PUBLIC PROC[msName: ROPE] RETURNS[version: INT] = {
Dms: PROC = { version _ GetButton[msName].msgSet.version };
[] _ DoWaitCall[Dms]
};


StartUp: PUBLIC PROC[rootFile: ROPE, scavengeFirst: BOOL _ FALSE] = {
rootName, captionName: ROPE;
[rootName, captionName] _ ParseRootName[rootFile];
IF walnut # NIL THEN
IF rootFile.Equal[walnutRootFile, FALSE] THEN
{ Report["\nWalnut is already running"]; RETURN}
ELSE {
ChangeDatabase[scavengeFirst, rootName, captionName, rootFile];
RETURN
};

DoStartup[scavengeFirst: scavengeFirst, rootName: rootName,
captionName: captionName, iconLabel: rootFile]
};

Shutdown: PUBLIC PROC = {
Sd: PROC =
{ CloseDownWalnut[] };
[] _ DoWaitCall[Sd];
};
<<>>
QueueCall: PUBLIC PROC[proc: PROC[] RETURNS[doReset: BOOL]]
    RETURNS[outCome: WalnutWindow.OutCome] = {
Qc: PROC =  {
IF ~proc[] THEN RETURN;
WalnutWindowInternal.ShowMsgSetButtons[];
WalnutControlInternal.FixUpWalnutViewers[];
};
outCome _ DoWaitCall[Qc];
};

Expunge: PUBLIC PROC = {
Ep: PROC = {
ENABLE UNWIND => { ChangeMenu[walnutMenu, FALSE] };
ok: BOOL _ TRUE;
Quitting[IO.PutFR["\n****** Starting expunge at %g\n", IO.time[]], TRUE];

BEGIN ENABLE ABORTED => {ok _ FALSE; CONTINUE};
[] _ WalnutOps.ExpungeMsgs[WalnutOps.dontCareMsgSetVersion];
WalnutOps.CopyToExpungeLog[];
END;

IF ~ok THEN {
Report["\n Expunge failed or aborted; some changes have been aborted"];
ChangeMenu[walnutMenu, FALSE];
RETURN
};
Report[IO.PutFR["\n  ***** Expunge complete at %g\n", IO.time[]]];
WalnutOps.Shutdown[];
IF ~RestartWalnut[walnutRootFile, FALSE, TRUE] THEN RETURN;
ChangeMenu[walnutMenu, FALSE];
};
[] _ DoWaitCall[Ep];
};

Scavenge: PUBLIC PROC[rootFile: ROPE] = {
rootName, captionName: ROPE;
[rootName, captionName] _ ParseRootName[rootFile];
IF rootName = NIL THEN RETURN;
DoScavenge[rootName, captionName, rootFile];
};

ReadArchiveFile: PUBLIC PROC[fileName, msgSet: ROPE, useCategoriesInFile: BOOL] =
{ ReadMailFile[fileName, msgSet, useCategoriesInFile] };

WriteArchiveFile: PUBLIC PROC[fileName: ROPE, msgSetList: LIST OF ROPE] = {
Waf: PROC = {
msList: LIST OF WalnutOps.MsgSet;
FOR mL: LIST OF ROPE _ msgSetList, mL.rest UNTIL mL = NIL DO
msList _ CONS[ [mL.first, WalnutOps.dontCareMsgSetVersion], msList];
ENDLOOP;
[] _ WalnutControlInternal.DoArchive[
fileName: fileName, msList: msList, append: FALSE] };
[] _ DoWaitCall[Waf];
};

<<* * * * * * * * * * * * local procedures>>

NoWalnutReport: PROC[cmd: Commander.Handle, msg: ROPE] = {
r: ROPE _ Rope.Concat["Walnut must be running to ", msg];
IF cmd # NIL THEN cmd.out.PutRope[r] ELSE MessageWindow.Append[r]
};

ParseRootName: PROC[dirName: ROPE]
    RETURNS[rootName, captionName, iconLabel, rootUserName: ROPE] = {
rName: ROPE;
alpServer: ROPE = "[Luther.alpine]<";
root: ROPE = ">Walnut.Root";
user: ROPE _ UserCredentials.Get[].name;
cp: FS.ComponentPositions;

IF dirName.Length = 0 THEN {
rName _ UserProfile.Token[key: "Walnut.WalnutRootFile", default: ""];
IF rName.Length[] = 0 THEN rName _ Rope.Cat[alpServer, user, root];
captionName _ walnutVersion;
}
ELSE {
ch: CHAR = dirName.Fetch[0];
IF ch = '[  OR ch = '/ THEN rName _ dirName ELSE
rName _ Rope.Cat[alpServer, dirName, root];
captionName _ Rope.Cat[walnutVersion, "   {", dirName, "}"];
}; 

[rootName, cp, ] _ FS.ExpandName[rName, NIL];
IF cp.ext.length = 0 THEN rootName _ rootName.Concat[".Root"];
rootUserName _ rootName.Substr[cp.dir.start, cp.dir.length];
};

DoStartup: PROC[scavengeFirst: BOOL, rootName, captionName, iconLabel: ROPE] = {
Su: PROC[BOOL] = {
BuildWalnutControlWindow[captionName];
IF scavengeFirst THEN Report[scavMsg];
IF ~RestartWalnut[
rootFile: rootName, scavengeFirst: scavengeFirst, firstTime: TRUE] THEN RETURN;

Report[" ...Ready"];
ViewerOps.AddProp[walnut, $IconLabel, iconLabel];
};
[] _ DoStartupCall[Su];
};

scavMsg: ROPE = "\n Starting scavenge ... ";

DoScavenge: PROC[rootName, captionName, iconLabel: ROPE] = {
Sp: PROC[isRunning: BOOL] = {
ENABLE UNWIND => { ChangeMenu[walnutMenu, FALSE] };
IF isRunning THEN {
Quitting[scavMsg, TRUE];
WalnutOps.Shutdown[];
IF ~RestartWalnut[rootFile: rootName, scavengeFirst: TRUE] THEN RETURN;
Report[" ... scavenge finished"];
ViewerOps.AddProp[walnut, $IconLabel, iconLabel];
ChangeMenu[walnutMenu, FALSE];
}
ELSE DoStartup[scavengeFirst: TRUE, rootName: rootName,
captionName: captionName, iconLabel: iconLabel];
};

[] _ DoStartupCall[Sp];
};

<<* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *>>

BuildWalnutControlWindow: PROC[caption: ROPE] = {
bt: Viewer;
walnutWidth: INTEGER;
transOK: BOOL _ TRUE;

IF walnut # NIL THEN RETURN;

walnut _ ViewerOps.CreateViewer[
flavor: $Container,
info: [name: caption, iconic: FALSE, column: right, scrollable: FALSE,
icon: walnutIcon, openHeight: ViewerSpecs.openTopY/4]];

walnut.inhibitDestroy _ TRUE;
walnutWidth _ IF walnut.column = right THEN ViewerSpecs.openRightWidth ELSE
ViewerSpecs.openLeftWidth;

ViewerOps.SetMenu[walnut, blankMenu];
mailNotifyLabel _ WalnutViewer.FirstLabel[name: InitialNotifyLabel, parent: walnut];

bt _ walnutRulerBefore _ WalnutViewer.MakeRuler[sib: mailNotifyLabel, h: 2];

walnutRulerAfter _ Rules.Create[
info: [parent: walnut, wy: bt.wy+bt.wh+14+4, ww: walnutWidth, wh: 2]];
Containers.ChildXBound[walnut, walnutRulerAfter];

walnutTS _ WalnutViewer.MakeTypescript[sib: walnutRulerAfter];
OpenTS[];

ViewerOps.SetMenu[walnut, workingMenu];
walnutEventReg _
ViewerEvents.RegisterEventProc[proc: QuitProc, event: destroy, filter: walnut];
};

<<* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *>>

QuitProc: ViewerEvents.EventProc = {
IF walnutEventReg = NIL THEN RETURN[FALSE];
MBQueue.QueueClientAction[walnutQueue, QuitWalnut, NIL];
RETURN[TRUE];
};

ChangeDatabase: PROC[scavengeFirst: BOOL, rootName, captionName, iconLabel: ROPE] = {
Cdb: PROC = {
walnut.inhibitDestroy _ TRUE;
Quitting[IO.PutFR["\nClosing database for %g", IO.rope[walnutRootFile]], TRUE ];
WalnutOps.Shutdown[];
IF personalMailDB THEN WalnutWindowInternal.DisableNewMail[];

walnut.name _ captionName;
ViewerOps.PaintViewer[walnut, caption];
IF ~RestartWalnut[rootName, scavengeFirst, TRUE] THEN RETURN;
Report["\nDatabase is now defined by ", walnutRootFile];
ViewerOps.AddProp[walnut, $IconLabel, iconLabel];
};
[] _ DoWaitCall[Cdb];
};

Quitting: PROC[r: ROPE, isBusy: BOOL] = {
ChangeMenu[workingMenu, isBusy];
TakeDownWalnutViewers[];
DestroyAllMsgSetButtons[];
FlushWQueue[];
Report[r];
};

ReadMailFile: PROC[fName, msName: ROPE, useCategoriesInFile: BOOL] =  {
Erm: PROC = {
ENABLE UNWIND => { ChangeMenu[walnutMenu, FALSE] };
fullName: ROPE;
numNew: INT _ 0;
msb: MsgSetButton _ GetButton[msName];
startVersion: INT _ msgSetsVersion;
activeIsOpen: BOOL _ activeMsgSetButton.msViewer # NIL;
msgSet: WalnutOps.MsgSet _
IF useCategoriesInFile THEN [NIL, WalnutOps.dontCareMsgSetVersion]
ELSE IF msb = NIL THEN [msName, WalnutOps.dontCareMsgSetVersion]
ELSE msb.msgSet;
BEGIN
cp: FS.ComponentPositions;
wDir: ROPE _ UserProfile.Token["Walnut.DefaultArchiveDir"];
[fullName, cp, ] _ FS.ExpandName[fName, wDir];
IF cp.ext.length = 0 THEN fullName _ fullName.Concat[".ArchiveLog"];
END;

IF fullName = NIL THEN {Report["No input file specified so quitting"]; RETURN};

Report["Reading messages from ", fullName, "... "];

ChangeMenu[workingMenu, TRUE];
numNew _ WalnutOps.ReadArchiveFile[fullName, msgSet];
SELECT numNew FROM
< 0 => Report["\nProblems reading ", fullName];
0 => Report["\nNo messages in ", fullName, " were new"];
>0 => Report[IO.PutFR[
"\n%g new messages from %g were added to database",
IO.int[numNew], IO.rope[fullName]]];
ENDCASE;
ShowMsgSetButtons[];        -- in case anything changed
ViewerOps.PaintViewer[walnut, client];        -- msgSet buttons don't get painted
IF activeIsOpen THEN [] _ WalnutDisplayerInternal.QDisplayMsgSet[activeMsgSetButton];
ChangeMenu[walnutMenu, FALSE];
};
[] _ DoWaitCall[Erm];
};

<<* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *>>

walnutQueue _ MBQueue.Create[pushModel: FALSE];        -- queue for menu/button pushes
BuildWalnutMenus[];

Commander.Register["Walnut", BuildWalnut, "For retrieving and sending mail"];
Commander.Register["WalnutScavenge", WalnutScavenge,
"Rebuilds Mail database from log file"];
Commander.Register["WalnutOldMailReader",
WalnutOldMailReader, "Reads Laurel, Hardy or Archive files into Mail database"];
Commander.Register["WalnutExpunge", WalnutExpunge, "Expunges deleted messages"];

Commander.Register["WalnutNewMail", WalnutNewMailProc, "Retrieves new mail"];

Commander.Register["WalnutMascarade", WalnutMascarade, "Scavenge someone else's walnut databsae"];

BEGIN
iconFilePathName: ROPE = "Walnut.icons";
    unLabelledWalnutIcon _ Icons.NewIconFromFile[iconFilePathName, 0
    ! FS.Error => GOTO notFound];
unLabelledNewMailIcon_ Icons.NewIconFromFile[iconFilePathName, 5];
labelledWalnutIcon_ Icons.NewIconFromFile[iconFilePathName, 11];
labelledNewMailIcon_ Icons.NewIconFromFile[iconFilePathName, 12];
msgSetIcon_ Icons.NewIconFromFile[iconFilePathName, 1];
msgIcon_ Icons.NewIconFromFile[iconFilePathName, 2];
walnutIcon _ unLabelledWalnutIcon;
newMailIcon _ unLabelledNewMailIcon;
EXITS
notFound => NULL;
END;

END.