-- File: WalnutExtrasImpl.mesa
-- Contents: operations invoked by buttons & menus in Walnut Control window
-- created May, 1983 by Willie-Sue
-- Last edit by:
-- Willie-Sue on: June 8, 1983 11:02 am
DIRECTORY
Buttons USING [ButtonProc],
Commander USING [CommandProc, Register],
DB,
FileIO,
IO,
MBQueue USING [Flush, QueueClientAction],
Menus USING [Menu],
Rope,
ViewerOps,
ViewerTools USING [GetContents, SetContents],
WalnutDB,
WalnutDBLog,
WalnutDisplayerOps,
WalnutLog,
WalnutRetrieve,
WalnutStream,
WalnutViewer,
WalnutWindow;
WalnutExtrasImpl: CEDAR MONITOR
IMPORTS
DB,
Commander,
MBQueue,
FileIO, IO, Rope,
ViewerOps, ViewerTools,
WalnutDB, WalnutDisplayerOps, WalnutLog, WalnutRetrieve,
WalnutStream, WalnutWindow
EXPORTS WalnutWindow
SHARES WalnutWindow =
BEGIN OPEN IO, WalnutDB, WalnutWindow;
-- Walnut types
-- * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
WalnutQueueEntry: TYPE = REF QueueEntryObject;
QueueEntryObject: TYPE = MONITORED RECORD[params: REF ANY, condition: CONDITION];
DoWaitCall: ENTRY PROC[proc: PROC[REF ANY], ra: REF ANY← NIL] =
-- puts proc on Walnut's queue and waits for its execution to finish
BEGIN ENABLE UNWIND => NULL;
wqe: WalnutQueueEntry← NEW[QueueEntryObject← [params: ra]];
QueueExecCall[proc, wqe];
WAIT wqe.condition;
END;
-- * * * * * * * * * * * * * * * * * * *
WalnutExpunge: PUBLIC Commander.CommandProc =
{IF walnut # NIL THEN DoWaitCall[ExpungeProc] ELSE InternalDumpMsgs[TRUE, FALSE]};
ExpungeProc: ENTRY PROC[ra: REF ANY] =
BEGIN
wqe: WalnutQueueEntry;
BEGIN ENABLE UNWIND => { NOTIFY wqe.condition};
wqe← NARROW[ra];
DoExpunge[TRUE, TRUE];
NOTIFY wqe.condition;
END;
END;
DoExpunge: PUBLIC PROC[doUpdates, tailRewrite: BOOL] =
BEGIN
ok: BOOL;
tempLogName: ROPE← "Walnut.TempLog";
tempLog: IO.STREAM;
ChangeWalnutMenu[workingMenu];
TakeDownWalnutViewers[];
WalnutLog.MarkWalnutTransaction[];
MBQueue.Flush[walnutQueue];
tempLog← FileIO.Open[tempLogName, overwrite];
Report["Dumping message database to ", tempLogName, "..."];
ok← WalnutLog.ExpungeMsgs
[tempLog: tempLog, doUpdates: doUpdates, tailRewrite: (tailRewrite AND enableTailRewrite)];
IF ~ok THEN
{ Report[" Dump was not successful; suggest you abort & scavenge"];
IF ~UserConfirmed[] THEN {ChangeWalnutMenu[walnutMenu]; RETURN};
ChangeWalnutMenu[workingMenu];
};
IF doUpdates THEN WalnutLog.MarkWalnutTransaction[];
Report["New log and database saved."];
ChangeWalnutMenu[walnutMenu];
[]← DisplayMsgSet[activeMsgSet];
END;
-- * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
WalnutScavenge: PUBLIC Commander.CommandProc =
BEGIN
IF walnut # NIL THEN
{ DoWaitCall[ScavengeProc];
Report["\nScavenge finished ... Restarting"];
RestartWalnut[];
Report[" ...done"];
}
ELSE
{ SetUpTSLog["WalnutScavenge"];
Report["Constructing Walnut from ", walnutLogName, "... "];
DB.DeclareSegment[filePath: walnutSegmentFile, segment: $Walnut];
DoScavenge[startPos: 0, internal: FALSE];
CloseTSLog[];
};
END;
ScavengeProc: ENTRY PROC[ra: REF ANY] =
BEGIN
wqe: WalnutQueueEntry;
BEGIN ENABLE UNWIND => { NOTIFY wqe.condition};
wqe← NARROW[ra];
DoScavenge[startPos: 0, internal: TRUE];
NOTIFY wqe.condition;
END;
END;
DoScavenge: PUBLIC PROC[startPos: INT, internal: BOOL] =
BEGIN OPEN WalnutLog;
IF DB.TransactionOf[$Walnut]#NIL THEN CloseWalnutTransaction[];
IF walnut # NIL THEN
{ TakeDownWalnutViewers[]; DestroyAllMsgSetButtons[] };
-- re-initialize the segment to erase it
DB.DeclareSegment[filePath: walnutSegmentFile, segment: $Walnut, version: NewOnly];
OpenWalnutTransaction[walnutNullTrans, TRUE]; -- no transaction, noLog
IF internal THEN Report[" reading log file from beginning ..."]
ELSE Report[" Erasing walnut segment"];
[]← InitializeLog[walnutLogName];
[]← UpdateFromLog[startPos];
CloseWalnutTransaction[];
IF internal THEN OpenWalnutTransaction[NIL, FALSE] -- open with transaction
ELSE CloseLogStream[];
END;
-- * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
GetNewMail: PUBLIC PROC =
{ IF walnut # NIL THEN DoWaitCall[NewMail, NIL]};
WalnutNewMail: PUBLIC Commander.CommandProc =
BEGIN
IF walnut # NIL THEN DoWaitCall[NewMail, NIL]
ELSE
cmd.out.PutRope["Walnut must be running to retrieve new mail"];
END;
NewMail: ENTRY PROC[ra: REF ANY] =
BEGIN
wqe: WalnutQueueEntry;
BEGIN ENABLE UNWIND => { NOTIFY wqe.condition};
wqe← NARROW[ra];
ChangeWalnutMenu[workingMenu];
RetrieveNewMail[];
ChangeWalnutMenu[walnutMenu];
NOTIFY wqe.condition;
END;
END;
DoNewMail: PUBLIC PROC =
BEGIN
startPos: INT← WalnutLog.LogLength[TRUE];
numRetrieved: INT← WalnutRetrieve.RetrieveGVMessages[].numRetrieved;
IF numRetrieved # 0 THEN
{ numNew: INT← GetMessagesFromLog[startPos];
IF numNew # numRetrieved THEN
Report[IO.PutFR["Only %g messages were new", int[numNew]]];
};
END;
-- * * * * * * * * * * * * * * * * * * * * *
GetMessagesFromLog: PROC[startPos: INT] RETURNS[numNew: INT] =
BEGIN
anymore, mExisted: BOOL;
endPos: INT;
sPos: INT← startPos;
msV: Viewer← NIL;
prevMsgSet: MsgSet← NIL;
msg: Msg;
msgRec: WalnutLog.MsgRec;
newMsgSetList: LIST OF MsgSet;
newRelList: LIST OF RelshipMsgSetPair;
numNew← 0;
DO
[endPos, anymore, msgRec]← WalnutLog.NextMsgRecFromLog[sPos];
IF ~anymore THEN EXIT;
IF msgRec = NIL THEN {sPos← endPos; LOOP};
[msg, mExisted, newMsgSetList, newRelList]← MsgRecToMsg[msgRec];
IF ~mExisted THEN numNew← numNew + 1;
FOR mL: LIST OF MsgSet← newMsgSetList, mL.rest UNTIL mL=NIL DO
AddMsgSetButton[msgSet: mL.first, msName: GetName[mL.first], select: FALSE];
ENDLOOP;
FOR rL: LIST OF RelshipMsgSetPair← newRelList, rL.rest UNTIL rL = NIL DO
IF ~EqEntities[rL.first.msgSet, prevMsgSet] THEN
msV← FindMSViewer[prevMsgSet← rL.first.msgSet];
IF msV#NIL THEN
WalnutDisplayerOps.AddParsedMsgToMSViewer[msg, msgRec, msV, rL.first.rel];
ENDLOOP;
sPos← endPos;
ENDLOOP;
RETURN[numNew];
END;
-- * * * * * * * * * * * * * * * * * * * * *
WalnutDump: PUBLIC Commander.CommandProc =
BEGIN
IF walnut # NIL THEN -- walnut is up
cmd.out.PutRope["Must quit out of Walnut first"]
ELSE InternalDumpMsgs[FALSE, FALSE];
END;
InternalDumpMsgs: PROC[doUpdates, tailRewrite: BOOL] =
BEGIN
ok: BOOL; -- walnut window not up, DB may be closed
tempLog: IO.STREAM;
tempLogName: ROPE← "Walnut.TempLog";
SetUpTSLog["WalnutExpunge"];
[]← WalnutLog.InitializeLog[walnutLogName]; -- opens segment if necessary
tempLog← FileIO.Open[tempLogName, write];
Report["Dumping message database to Walnut.TempLog ..."];
ok← WalnutLog.ExpungeMsgs
[tempLog: tempLog, doUpdates: doUpdates, tailRewrite: (tailRewrite AND enableTailRewrite)];
IF ~ok THEN
{ Report[" Dump was not successful; updates not comitted"]; RETURN};
Report["Committing changes ..."];
WalnutLog.CloseWalnutTransaction[];
Report["New log and database saved."];
CloseTSLog[];
END;
WalnutReadMailFile: PUBLIC Commander.CommandProc =
BEGIN
h: IO.STREAM← IO.RIS[cmd.commandLine];
fName: ROPE← h.GetToken[WhiteSpace];
IF walnut = NIL THEN SetUpTSLog["ReadOldMail"];
ReadMailFile[fName, h.GetToken[WhiteSpace]];
IF walnut = NIL THEN CloseTSLog[];
END;
-- make separate proc so callable by program
ReadMailFile: PUBLIC PROC[fName, msgSet: ROPE] =
BEGIN
mfp: LIST OF ROPE← LIST[fName, IF msgSet=NIL THEN "Active" ELSE msgSet];
DoWaitCall[ReadMailFileProc, mfp];
END;
ReadMailFileProc: ENTRY PROC[ra: REF ANY] =
BEGIN
wqe: WalnutQueueEntry;
BEGIN ENABLE UNWIND => { NOTIFY wqe.condition};
mfp: LIST OF ROPE;
wqe← NARROW[ra];
mfp← NARROW[wqe.params];
DoReadMailFile[mfp];
NOTIFY wqe.condition;
END;
END;
DoReadMailFile: PROC[mfp: LIST OF ROPE] =
BEGIN OPEN WalnutLog;
defaultPrefix: ROPE;
fStream: IO.STREAM;
startPos, numNew: INT;
fName: ROPE← mfp.first;
msName: ROPE← mfp.rest.first;
IF fName = NIL THEN {Report["No input file specified so quitting"]; RETURN};
BEGIN
IF walnut = NIL THEN -- walnut not running
startPos← InitializeLog[walnutLogName] -- set up WalnutDB & log
ELSE
{ ChangeWalnutMenu[workingMenu];
MarkWalnutTransaction[]; -- get in a good state
startPos← LogLength[TRUE];
};
IF msName = NIL THEN msName← "Active"
ELSE IF ~DoCreateMsgSet[msName, FALSE, FALSE] THEN RETURN;
defaultPrefix← Rope.Cat["Categories: ", msName, "\n"];
fStream← FileIO.Open[fName, read, oldOnly ! FileIO.OpenFailed => GOTO BadOpen];
Report["Reading messages from ", fName, "... "];
IF ~WalnutStream.ReadOldMailFile[fStream, defaultPrefix] THEN
{ fStream.Close[];
Report["There were problems reading ", fName];
Report["Bug Confirm to keep messages successfully read, Deny to throw them away"];
IF ~UserConfirmed[] THEN { ResetLogToExpectedLength[]; RETURN};
};
fStream.Close[];
numNew← GetMessagesFromLog[startPos];
IF numNew = 0 THEN Report[" No messages in ", fName, " were new"]
ELSE Report[IO.PutFR[
"%g new messages from %g were added to database", IO.int[numNew], IO.rope[fName]]];
IF walnut = NIL THEN
{ MarkWalnutTransaction[]; CloseLogStream[]};
EXITS
BadOpen => Report["Can't open ", fName, "\n"];
END;
IF walnut # NIL THEN ChangeWalnutMenu[walnutMenu];
END;
-- * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
SizeOfMsgSetButtonProc: PUBLIC Buttons.ButtonProc =
{ MBQueue.QueueClientAction
[walnutQueue, SizeOfMsgSetProc, ViewerTools.GetContents[msgSetText]];
};
SizeOfMsgSetProc: PROC[data: REF ANY] =
BEGIN
msName: ROPE ← NARROW[data];
msgSet: MsgSet;
num: INT;
IF msName.Length[] = 0 THEN {Report["No MsgSet specified"]; RETURN};
IF msName.Find[" "] >=0 THEN
{Report[" MsgSet names may not contain spaces"]; RETURN};
msgSet← DeclareMsgSet[msName, OldOnly].msgSet;
IF msgSet = NIL THEN {Report["MsgSet: ", msName, " doesn't exist"]; RETURN};
num← NumInMsgSet[msgSet];
Report[IO.PutFR[" %g msgs in MsgSet %g", IO.int[num], IO.rope[msName]]];
END;
-- * * * * * * * * * *
CreateMsgSetButtonProc: PUBLIC Buttons.ButtonProc =
{ MBQueue.QueueClientAction
[walnutQueue, CreateMsgSetProc, ViewerTools.GetContents[msgSetText]];
};
CreateMsgSetProc: PROC[data: REF ANY] =
BEGIN
msName: ROPE← NARROW[data];
[]← DoCreateMsgSet[msName, TRUE, TRUE];
END;
DoCreateMsgSet: PROC[msName: ROPE, doReport, select: BOOL] RETURNS[nameOK: BOOL] =
BEGIN
msgSet: MsgSet;
existed: BOOL;
IF msName.Length[] = 0 THEN
{ Report["No MsgSet specified"]; RETURN[FALSE]};
-- get the entity
IF msName.Find[" "] >=0 THEN
{ Report[" MsgSet names may not contain spaces"]; RETURN[FALSE]};
[msgSet, existed]← DeclareMsgSet[msName];
IF existed THEN {IF doReport THEN Report["MsgSet: ", msName, " already exists"]}
ELSE
{ WalnutLog.LogCreateMsgSet[msName];
[]← AddMsgSetButton[msgSet, msName, select];
};
RETURN[TRUE];
END;
-- * * * * * * * * * *
DeleteMsgSetButtonProc: PUBLIC Buttons.ButtonProc =
{MBQueue.QueueClientAction
[walnutQueue, DeleteMsgSetProc, ViewerTools.GetContents[msgSetText]];
};
DeleteMsgSetProc: PROC[data: REF ANY] =
BEGIN
msgSet: Entity;
msName: ROPE ← NARROW[data];
IF msName.Length[] = 0 THEN
{ Report["No MsgSet specified"]; RETURN};
-- get the entity
msgSet← DeclareMsgSet[msName, OldOnly].msgSet; -- NIL if not found
IF EqEntities[msgSet, activeMsgSet] OR EqEntities[msgSet, deletedMsgSet] THEN
{ Report[" Can't delete MsgSet: ", msName]; RETURN};
IF DB.Null[msgSet] THEN
{ Report[msName, " MsgSet doesn't exist"]; RETURN};
IF NumInMsgSet[msgSet] # 0 THEN
{ Report[" Confirm deletion of messages in MsgSet: ", msName];
IF ~UserConfirmed[] THEN
{ChangeWalnutMenu[walnutMenu]; RETURN}
};
ChangeWalnutMenu[workingMenu];
WalnutLog.LogDestroyMsgSet[msName];
DeleteMsgSetButton[msgSet];
[]← DestroyMsgSet[msgSet];
ChangeWalnutMenu[walnutMenu];
END;
-- * * * * * * * * * *
ArchiveButtonProc: PUBLIC Buttons.ButtonProc =
BEGIN
fileName: ROPE ← ViewerTools.GetContents[fileNameText];
msgSetList: LIST OF MsgSet← GetSelectedMsgSets[];
MBQueue.QueueClientAction[q: walnutQueue, proc: ArchiveProc,
data: NEW[ArchiveDataObj← [fileName, msgSetList]]];
END;
ArchiveData: TYPE = REF ArchiveDataObj;
ArchiveDataObj: TYPE = RECORD[fName: ROPE, mL: LIST OF MsgSet];
ArchiveProc: PROC[data: REF ANY] =
BEGIN
num: INT← 0;
strm: IO.STREAM;
archiveData: ArchiveData← NARROW[data];
fileName: ROPE← archiveData.fName;
msgSetList: LIST OF MsgSet← archiveData.mL;
newRelList: LIST OF Relship← NIL; -- no used for now
msgSet: MsgSet;
IF fileName.Length[] = 0 THEN
{ Report["No Archive file specified"]; RETURN};
IF msgSetList = NIL THEN
{ Report["No selected MsgSet(s) to archive"]; RETURN};
-- make sure didn't specify same name as log file
IF fileName.Find["."] < 0 THEN
{ fileName← fileName.Concat[".ArchiveLog"];
ViewerTools.SetContents[fileNameText, fileName]
};
IF Rope.Equal[fileName, walnutLogName, FALSE] THEN
{ Report["Can't archive on log file"]; RETURN};
ChangeWalnutMenu[workingMenu];
strm← FileIO.Open[fileName, write];
ReportRope["Archiving the MsgSet(s): "];
FOR mL: LIST OF MsgSet← msgSetList, mL.rest UNTIL mL = NIL DO
ReportRope[GetName[msgSet← mL.first]]; ReportRope[" "];
num← num + NumInMsgSet[msgSet];
newRelList← ArchiveMsgSet[msgSet: msgSet, strm: strm, doDelete: FALSE];
ENDLOOP;
strm.Close[];
Report[IO.PutFR["\n %g messages archived on file: %g", IO.int[num], IO.rope[fileName]]];
ChangeWalnutMenu[walnutMenu];
END;
-- * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
DestroyAllMsgSetButtons: PROC =
BEGIN
selectedMsgSetButtons← NIL;
FOR msb: MsgSetButton← firstMsgSetButton, msb.next UNTIL msb=NIL DO
ViewerOps.DestroyViewer[msb.selector, FALSE];
ENDLOOP;
firstMsgSetButton← lastMsgSetButton← NIL;
ViewerOps.MoveViewer[walnutRulerAfter, walnutRulerAfter.wx,
walnutRulerBefore.wy+walnutRulerBefore.wh+14+1, walnutRulerAfter.ww,
walnutRulerAfter.wh, FALSE];
ViewerOps.MoveViewer[walnutTS, walnutTS.wx,
walnutRulerAfter.wy+walnutRulerAfter.wh+1, walnutTS.ww,
walnutTS.wh, FALSE];
ViewerOps.PaintViewer[walnut, client];
END;
-- * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
-- start code
Commander.Register["WalnutScavenge", WalnutScavenge, "Rebuilds Mail database from log file"];
Commander.Register["WalnutOldMailReader",
WalnutReadMailFile, "Reads Laurel, Hardy or Archive files into Mail database"];
Commander.Register["WalnutExpunge", WalnutExpunge, "Expunges deleted messages"];
Commander.Register["WalnutDump", WalnutDump, "Writes an expunged log file on Walnut.TempLog; does not change database"];
Commander.Register["WalnutNewMail", WalnutNewMail, "Retrieves new mail"];
END.