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.