-- 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 ANYNIL] =
-- 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.STREAMIO.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 ROPELIST[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: ROPENARROW[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: ROPENARROW[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: ROPENARROW[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.