
<<File: WalnutExtrasImpl.mesa>>
    <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
<<Contents: operations invoked by buttons & menus in Walnut Control window>>
    <<Willie-Sue, March 20, 1985 9:35:07 am PST>>

<<created May, 1983 by Willie-Sue>>
<<Last edit by:>>
<<Willie-Sue on: July 17, 1984 3:35:37 pm PDT>>

DIRECTORY
AlpineFS USING [StreamOpen],
Buttons USING [ButtonProc],
DB USING [EraseSegment, GetSegmentInfo],
FS USING [ComponentPositions, Error, ErrorDesc, ErrorFromStream, ExpandName, StreamOpen],
Icons USING [IconFlavor, NewIconFromFile],
IO,
MBQueue USING [QueueClientAction],
Menus USING [Menu, MenuProc],
PrincOpsUtils USING [IsBound],
Rope,
ViewerClasses USING [Viewer],
ViewerOps,
ViewerTools USING [GetSelectionContents],
WalnutControlPrivate USING [FlushWQueue],
WalnutDB USING [Msg, MsgSet, Relship, RelshipMsgSetPair,
activeMsgSet, deletedMsgSet,
ArchiveMsgSet, DeclareMsg, DeclareMsgSet, DestroyMsgSet, EqEntities,
GetName, MsgRecToMsg, Null, NumInMsgSet], 
WalnutDisplayerOps USING [msgName, msgSetName],
WalnutMsgOps USING [AddParsedMsgToMSViewer, BuildListOfMsgsViewer,
BuildMsgSetViewer, BuildMsgViewer, MsgInViewer, MsgSetInViewer],
WalnutExtras USING [ChangeDatabase, ChangeWalnutMenu, DoExpunge, InternalChangeMenu,
InternalNewMail, LoadBcdForWalnut],
WalnutLog USING [MsgRec,
currentSegment,
CloseWalnutTransaction, InitializeLog, LogCreateMsgSet,
LogDestroyMsgSet, LogLength, MarkWalnutTransaction,
NextMsgRecFromLog, OpenWalnutTransaction, ResetLogToExpectedLength,
UpdateFromLog],
WalnutMailExtras,
WalnutPrintOps USING [PrintMsgSet],
WalnutRetrieve USING [RetrieveGVMessages],
WalnutStream USING [ReadOldMailFile],
WalnutWindow USING [MsgSetButton,
msgIcon, msgSetIcon, newMailIcon, walnut,
walnutLogName, walnutNullTrans, walnutQueue, walnutMenu, workingMenu,
AddMsgSetButton, DeleteMsgSetButton, DestroyAllMsgSetButtons,
GetSelectedMsgSets, FindMSViewer, Report, ReportRope, UserConfirmed];

WalnutExtrasImpl: CEDAR MONITOR
IMPORTS
DB,
Icons, MBQueue,
AlpineFS, FS, IO, PrincOpsUtils, Rope,
ViewerOps, ViewerTools,
WalnutControlPrivate, WalnutDB, WalnutDisplayerOps, WalnutMsgOps, WalnutExtras,
WalnutLog, WalnutPrintOps, WalnutRetrieve, WalnutStream, WalnutWindow
EXPORTS WalnutDisplayerOps, WalnutExtras, WalnutMailExtras, WalnutWindow
SHARES WalnutWindow =

BEGIN OPEN WalnutDB, WalnutExtras, WalnutWindow;

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

noMsgSetsSelected: ROPE = "No selected MsgSet(s)";
alpineFileTest: ROPE = ".alpine]";
noAlpineFS: ROPE = "Can't read alpine file without being able to run AlpineFSImpl";
noAlpineWrite: ROPE = "Can't write an alpine file without being able to run AlpineFSImpl";

whoToNotifyAfterNewMail: LIST OF PROC_ NIL;

<<* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *>>
WalnutQueueEntry: TYPE = REF QueueEntryObject;
QueueEntryObject: TYPE = MONITORED RECORD[params, result: REF ANY, condition: CONDITION];

DoWaitCall: PUBLIC 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]];
MBQueue.QueueClientAction[walnutQueue, proc, wqe];
WAIT wqe.condition;
END;

DoWaitCallWithResult: ENTRY PROC[proc: PROC[REF ANY], ra: REF ANY_ NIL]
RETURNS[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]];
MBQueue.QueueClientAction[walnutQueue, proc, wqe];
WAIT wqe.condition;
RETURN[wqe.result];
END;

NotifyIfAppropriate: PUBLIC ENTRY PROC[ra: REF ANY] =
BEGIN
wqe: WalnutQueueEntry;
IF (ra = NIL) OR ~ISTYPE[ra, WalnutQueueEntry] THEN RETURN;
wqe_ NARROW[ra];
NOTIFY wqe.condition;
END;

<<* * * * * * * * * * * * * * * * * * *>>
ExpungeProc: PUBLIC 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;

DumpProc: PUBLIC ENTRY PROC[ra: REF ANY] = 
BEGIN
wqe: WalnutQueueEntry;
BEGIN ENABLE UNWIND => { NOTIFY wqe.condition};
wqe_ NARROW[ra];
DoExpunge[FALSE, FALSE];
NOTIFY wqe.condition;
END;
END;

ChangeDBProc: PUBLIC ENTRY PROC[ra: REF ANY] = 
BEGIN
wqe: WalnutQueueEntry;
BEGIN ENABLE UNWIND => { NOTIFY wqe.condition};
wqe_ NARROW[ra];
ChangeDatabase[wqe.params];
NOTIFY wqe.condition;
END;
END;

ScavengeProc: PUBLIC ENTRY PROC[ra: REF ANY] =
BEGIN
wqe: WalnutQueueEntry;
BEGIN ENABLE UNWIND => { NOTIFY wqe.condition};
wqe_ NARROW[ra];
DoScavenge[startPos: 0];
NOTIFY wqe.condition;
END;
END;

<<* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *>>
<<for access from the outside; must run under the Notifier>>

RefForDisplayList: TYPE = REF DisplayListObject;
DisplayListObject: TYPE = RECORD[mL: LIST OF ROPE, name: ROPE, oldV: Viewer];

DisplayListOfMsgs: PUBLIC PROC[mL: LIST OF ROPE, name: ROPE, oldV: Viewer]
RETURNS[v: Viewer] =
BEGIN
rdl: RefForDisplayList_ NEW[DisplayListObject_ [mL, name, oldV]];
result: REF ANY_ DoWaitCallWithResult[DoDisplayListOfMsgs, rdl];
v_ NARROW[result];
END;

DoDisplayListOfMsgs: PUBLIC ENTRY PROC[ra: REF ANY] =
BEGIN
wqe: WalnutQueueEntry;
rdl: RefForDisplayList;
BEGIN ENABLE UNWIND => { NOTIFY wqe.condition};
wqe_ NARROW[ra];
rdl_ NARROW[wqe.params];
wqe.result_ WalnutMsgOps.BuildListOfMsgsViewer[rdl.mL, rdl.name, rdl.oldV];
NOTIFY wqe.condition;
END;
END;

<<* * * * * * * * *>>
RefForDisplayInViewer: TYPE = REF DisplayInViewerObject;
DisplayInViewerObject: TYPE = RECORD[name: ROPE, v: Viewer, shift: BOOL];

DisplayMsgInViewer: PUBLIC PROC[name: ROPE, v: Viewer, shift: BOOL_ FALSE] =
BEGIN
rdv: RefForDisplayInViewer_ NEW[DisplayInViewerObject_ [name, v, shift]];
DoWaitCall[DoDisplayMsgInViewer, rdv];
END;

DoDisplayMsgInViewer: ENTRY PROC[ra: REF ANY] =
BEGIN
wqe: WalnutQueueEntry;
msg: Msg;
rdv: RefForDisplayInViewer;
BEGIN ENABLE UNWIND => { NOTIFY wqe.condition};
wqe_ NARROW[ra];
rdv_ NARROW[wqe.params];
msg_ DeclareMsg[rdv.name, OldOnly].msg;
IF ~Null[msg] THEN []_ WalnutMsgOps.MsgInViewer[rdv.name, msg, rdv.v, rdv.shift];
NOTIFY wqe.condition;
END;
END;

DisplayMsgSetInViewer: PUBLIC PROC[name: ROPE, v: Viewer, shift: BOOL_ FALSE] =
BEGIN
rdv: RefForDisplayInViewer_ NEW[DisplayInViewerObject_ [name, v, shift]];
DoWaitCall[DoDisplayMsgSetInViewer, rdv];
END;

DoDisplayMsgSetInViewer: ENTRY PROC[ra: REF ANY] =
BEGIN
wqe: WalnutQueueEntry;
msgSet: MsgSet;
rdv: RefForDisplayInViewer;
BEGIN ENABLE UNWIND => { NOTIFY wqe.condition};
wqe_ NARROW[ra];
rdv_ NARROW[wqe.params];
msgSet_ DeclareMsgSet[rdv.name, OldOnly].msgSet;
IF ~Null[msgSet] THEN
[]_ WalnutMsgOps.MsgSetInViewer[rdv.name, msgSet, rdv.v, rdv.shift];
NOTIFY wqe.condition;
END;
END;

<<* * * * * * * * *>>
RefForCreateViewer: TYPE = REF CreateViewerObject;
CreateViewerObject: TYPE = RECORD[name: ROPE, shift, paint: BOOL];

CreateMsgViewer: PUBLIC PROC[name: ROPE, shift, paint: BOOL_ FALSE] RETURNS[v: Viewer] =
BEGIN
rcv: RefForCreateViewer_ NEW[CreateViewerObject_ [name, shift, paint]];
result: REF ANY_ DoWaitCallWithResult[DoCreateMsgViewer, rcv];
v_ NARROW[result];
END;

DoCreateMsgViewer: ENTRY PROC[ra: REF ANY] =
BEGIN
wqe: WalnutQueueEntry;
msg: Msg;
rcv: RefForCreateViewer;
BEGIN ENABLE UNWIND => { NOTIFY wqe.condition};
wqe_ NARROW[ra];
rcv_ NARROW[wqe.params];
msg_ DeclareMsg[rcv.name, OldOnly].msg;
IF ~Null[msg] THEN
wqe.result_ WalnutMsgOps.BuildMsgViewer[rcv.name, msg, rcv.shift, rcv.paint];
NOTIFY wqe.condition;
END;
END;

CreateMsgSetViewer: PUBLIC PROC[name: ROPE, shift, paint: BOOL_ FALSE]
RETURNS[v: Viewer] =
BEGIN
rcv: RefForCreateViewer_ NEW[CreateViewerObject_ [name, shift, paint]];
result: REF ANY_ DoWaitCallWithResult[DoCreateMsgSetViewer, rcv];
v_ NARROW[result];
END;

DoCreateMsgSetViewer: ENTRY PROC[ra: REF ANY] =
BEGIN
wqe: WalnutQueueEntry;
msgSet: MsgSet;
rcv: RefForCreateViewer;
BEGIN ENABLE UNWIND => { NOTIFY wqe.condition};
wqe_ NARROW[ra];
rcv_ NARROW[wqe.params];
msgSet_ DeclareMsgSet[rcv.name, OldOnly].msgSet;
IF ~Null[msgSet] THEN
wqe.result_ WalnutMsgOps.BuildMsgSetViewer[rcv.name, msgSet, rcv.shift, rcv.paint];
NOTIFY wqe.condition;
END;
END;

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

DoScavenge: PUBLIC PROC[startPos: INT] =
BEGIN OPEN WalnutLog;

IF DB.GetSegmentInfo[currentSegment].trans#NIL THEN CloseWalnutTransaction[];
TakeDownWalnutViewers[];
DestroyAllMsgSetButtons[];
WalnutControlPrivate.FlushWQueue[];

<<re-initialize the segment to erase it>>
DB.EraseSegment[segment: currentSegment];
OpenWalnutTransaction[currentSegment, walnutNullTrans, TRUE];    -- no transaction, noLog
Report[" Erasing walnut segment"];

[]_ InitializeLog[walnutLogName];
[]_ UpdateFromLog[startPos];
CloseWalnutTransaction[]; 

OpenWalnutTransaction[currentSegment, NIL, FALSE]    -- with transaction
END;

<<* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *>>
RetrieveNewMailProc: PUBLIC ENTRY PROC[ra: REF ANY] =
BEGIN
wqe: WalnutQueueEntry;
BEGIN ENABLE UNWIND => { NOTIFY wqe.condition};
wqe_ NARROW[ra];
InternalChangeMenu[workingMenu];
InternalNewMail[];
InternalChangeMenu[walnutMenu];
NOTIFY wqe.condition;
END;
END;

DoNewMail: PUBLIC PROC =
BEGIN
startPos: INT_ WalnutLog.LogLength[doFlush: TRUE];
numRetrieved: INT;

WalnutLog.MarkWalnutTransaction[];

numRetrieved_ WalnutRetrieve.RetrieveGVMessages[].numRetrieved;
IF numRetrieved # 0 THEN
{ numNew: INT_ GetMessagesFromLog[startPos];
IF numNew # numRetrieved THEN
Report[IO.PutFR["Only %g messages were new", IO.int[numNew]]];
WalnutLog.MarkWalnutTransaction[];
IF whoToNotifyAfterNewMail # NIL THEN
FOR who: LIST OF PROC_ whoToNotifyAfterNewMail, who.rest UNTIL who=NIL DO
who.first[]; ENDLOOP;
};
END;

NotifyAfterNewMail: PUBLIC PROC[proc: PROC] =
BEGIN
IF whoToNotifyAfterNewMail = NIL THEN
{ whoToNotifyAfterNewMail_ LIST[proc]; RETURN};
FOR old: LIST OF PROC_ whoToNotifyAfterNewMail, old.rest UNTIL old=NIL DO
IF old.first = proc THEN RETURN; ENDLOOP;
whoToNotifyAfterNewMail_ CONS[proc, whoToNotifyAfterNewMail];
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
WalnutMsgOps.AddParsedMsgToMSViewer[msg, msgRec, msV, rL.first.rel];
ENDLOOP;
sPos_ endPos;
ENDLOOP;

RETURN[numNew];
END;

<<* * * * * * * * * * * * * * * * * * * * *>>
ReadMailProc: PUBLIC 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;
ed: FS.ErrorDesc;

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
{ InternalChangeMenu[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"];

BEGIN
isAlp, ok: BOOL;
[isAlp, ok]_ CheckForAlpineFile[fName];
IF ~ok THEN {Report[noAlpineFS]; RETURN};
IF isAlp THEN
fStream_ AlpineFS.StreamOpen[fName ! FS.Error => {ed_ error; GOTO BadOpen}]
ELSE
fStream_ FS.StreamOpen[fName ! FS.Error => {ed_ error; GOTO BadOpen}];
END;

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]]];

[]_ LogLength[doFlush: TRUE];
MarkWalnutTransaction[];

EXITS
BadOpen => Report[ed.explanation];
END;

IF walnut # NIL THEN InternalChangeMenu[walnutMenu];
END;

<<* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *>>
CreateMsgSetButtonProc: PUBLIC Buttons.ButtonProc =
{ MBQueue.QueueClientAction
[walnutQueue, CreateMsgSetProc, ViewerTools.GetSelectionContents[]];
};

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;

<<* * * * * * * * * *>>
SizeOfMsgSetsProc: PUBLIC Menus.MenuProc =
{ msgSetList: LIST OF MsgSetButton_ GetSelectedMsgSets[];
MBQueue.QueueClientAction[walnutQueue, SzOfMsgSetsProc, msgSetList];
};

SzOfMsgSetsProc: PROC[data: REF ANY] =
BEGIN
msgSetList: LIST OF MsgSetButton_ NARROW[data];
IF msgSetList = NIL THEN { Report[noMsgSetsSelected]; RETURN};

FOR mL: LIST OF MsgSetButton_ msgSetList, mL.rest UNTIL mL=NIL DO
num: INT_ NumInMsgSet[mL.first.msgSet];
Report[IO.PutFR[" %g msgs in MsgSet %g", IO.int[num], IO.rope[mL.first.selector.name]]];
ENDLOOP;
END;

<<* * * * * * * * * *>>
DeleteMsgSetsProc: PUBLIC Buttons.ButtonProc =
{ msgSetList: LIST OF MsgSetButton_ GetSelectedMsgSets[];
MBQueue.QueueClientAction[walnutQueue, DelMsgSetsProc, msgSetList];
};

DelMsgSetsProc: PROC[data: REF ANY] =
BEGIN
msgSetList: LIST OF MsgSetButton_ NARROW[data];
IF msgSetList = NIL THEN { Report[noMsgSetsSelected, " to delete"]; RETURN};
ChangeWalnutMenu[workingMenu];

FOR mL: LIST OF MsgSetButton_ msgSetList, mL.rest UNTIL mL=NIL DO
msgSet: MsgSet_ mL.first.msgSet;
msName: ROPE_ GetName[msgSet];
IF EqEntities[msgSet, deletedMsgSet] THEN
{ Report["Can't delete the Deleted MsgSet"]; LOOP};
IF NumInMsgSet[msgSet] # 0 THEN
{ Report[" Confirm deletion of messages in MsgSet: ", msName];
IF ~UserConfirmed[] THEN
{ChangeWalnutMenu[walnutMenu]; RETURN}
};
WalnutLog.LogDestroyMsgSet[msName];
DeleteMsgSetButton[msgSet];
[]_ DestroyMsgSet[msgSet];
IF ~EqEntities[msgSet, activeMsgSet] THEN Report["MsgSet: ", msName, " has been deleted"]
ELSE Report["Msgs have been removed from Active"];
ENDLOOP;

ChangeWalnutMenu[walnutMenu];
END;

<<* * * * * * * * * *>>
PrintMsgSetsProc: PUBLIC Menus.MenuProc =
{ msgSetList: LIST OF MsgSetButton_ GetSelectedMsgSets[];
MBQueue.QueueClientAction[walnutQueue, PrtMsgSetsProc, msgSetList];
};

PrtMsgSetsProc: PROC[data: REF ANY] =
BEGIN
msgSetList: LIST OF MsgSetButton_ NARROW[data];
IF msgSetList = NIL THEN { Report[noMsgSetsSelected, " to print"]; RETURN};
ChangeWalnutMenu[workingMenu];

FOR mL: LIST OF MsgSetButton_ msgSetList, mL.rest UNTIL mL=NIL DO
msgSet: MsgSet_ mL.first.msgSet;
msName: ROPE_ GetName[msgSet];
IF ~WalnutPrintOps.PrintMsgSet[msgSet, msName] THEN EXIT;
ENDLOOP;

ChangeWalnutMenu[walnutMenu];
END;

<<* * * * * * * * * *>>
ArchiveButtonProc: PUBLIC Buttons.ButtonProc =
BEGIN
fileName: ROPE _ ViewerTools.GetSelectionContents[];
msgSetList: LIST OF MsgSetButton_ GetSelectedMsgSets[];
MBQueue.QueueClientAction[q: walnutQueue, proc: ArchiveProc,
data: NEW[ArchiveDataObj_ [fileName, msgSetList, FALSE]]];
END;

AppendButtonProc: PUBLIC Buttons.ButtonProc =
BEGIN
fileName: ROPE _ ViewerTools.GetSelectionContents[];
msgSetList: LIST OF MsgSetButton_ GetSelectedMsgSets[];
MBQueue.QueueClientAction[q: walnutQueue, proc: ArchiveProc,
data: NEW[ArchiveDataObj_ [fileName, msgSetList, TRUE]]];
END;

ArchiveData: TYPE = REF ArchiveDataObj;
ArchiveDataObj: TYPE = RECORD[fName: ROPE, mL: LIST OF MsgSetButton, append: BOOL];

ArchiveProc: PROC[data: REF ANY] =
BEGIN
strm: IO.STREAM;
BEGIN ENABLE IO.Error =>
{ ed: FS.ErrorDesc_ FS.ErrorFromStream[strm];
Report[ed.explanation];
IF strm # NIL THEN strm.Close[ ! IO.Error => CONTINUE];
GOTO errorFromStrm
};
num: INT_ 0;
archiveData: ArchiveData_ NARROW[data];
fileName: ROPE_ archiveData.fName;
msgSetList: LIST OF MsgSetButton_ archiveData.mL;
newRelList: LIST OF Relship_ NIL;        -- no used for now
msgSet: MsgSet;
isAlp, ok: BOOL;

IF fileName.Length[] = 0 THEN
{ Report["No Archive file specified"]; RETURN};

IF msgSetList = NIL THEN
{ Report[noMsgSetsSelected, " to archive"]; RETURN};
<<make sure didn't specify same name as log file>>
IF fileName.Find["."] < 0 THEN fileName_ fileName.Concat[".ArchiveLog"];

IF Rope.Equal[fileName, walnutLogName, FALSE] THEN
{ Report["Can't archive on log file"]; RETURN};

[isAlp, ok]_ CheckForAlpineFile[fileName];
IF ~ok THEN { Report[noAlpineWrite]; RETURN};

BEGIN ENABLE UNWIND => {IF strm # NIL THEN strm.Close[]};
ChangeWalnutMenu[workingMenu];
IF archiveData.append THEN
{ strm_ IF isAlp THEN AlpineFS.StreamOpen[fileName, $append]
ELSE FS.StreamOpen[fileName, $append];
Report["Appending msgs to the file: ", fileName]
}
ELSE strm_ IF isAlp THEN AlpineFS.StreamOpen[fileName, $create]
ELSE FS.StreamOpen[fileName, $create];

ReportRope["Archiving the MsgSet(s): "];

FOR mL: LIST OF MsgSetButton_ msgSetList, mL.rest UNTIL mL = NIL DO
ReportRope[GetName[msgSet_ mL.first.msgSet]]; 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;
EXITS
errorFromStrm => NULL;
END;
END;

<<**********************************************************************>>
EnumWalnutViewers: PUBLIC PROC[keepSeparate: BOOL]
RETURNS [msgSetList, msgList, queryList: LIST OF Viewer] =
BEGIN
Enum: ViewerOps.EnumProc =
BEGIN
ra: REF ANY; fullName: ROPE;
IF (ra_ ViewerOps.FetchProp[v, $WalnutQuery]) # NIL THEN
{ IF keepSeparate THEN queryList_ CONS[v, queryList]
ELSE msgSetList_ CONS[v, msgSetList];
RETURN[TRUE]
};
IF (ra_ ViewerOps.FetchProp[v, $Entity]) = NIL THEN RETURN[TRUE];
fullName_ NARROW[ra];
IF fullName.Find[WalnutDisplayerOps.msgSetName, 0, FALSE] = 0 THEN
msgSetList_ CONS[v, msgSetList]
ELSE
IF fullName.Find[WalnutDisplayerOps.msgName, 0, FALSE] = 0 THEN
{ IF keepSeparate THEN msgList_ CONS[v, msgList]
ELSE msgSetList_ CONS[v, msgSetList];
};
RETURN[TRUE];
END;
ViewerOps.EnumerateViewers[Enum]
END;

TakeDownWalnutViewers: PUBLIC PROC =
BEGIN
FOR vL: LIST OF Viewer_ EnumWalnutViewers[FALSE].msgSetList, vL.rest UNTIL vL=NIL DO
ViewerOps.DestroyViewer[vL.first];
ENDLOOP;
END;

ClearMsgSetDisplayers: PUBLIC PROC =
BEGIN
child, v: Viewer;
FOR vL: LIST OF Viewer_ EnumWalnutViewers[TRUE].msgSetList, vL.rest UNTIL vL=NIL DO
v_ vL.first;
UNTIL (child_ v.child) = NIL DO ViewerOps.DestroyViewer[child, FALSE] ENDLOOP;
ENDLOOP;
END;

SetWalnutIcons: PUBLIC PROC[file: ROPE] =
BEGIN
newMailIcon_ Icons.NewIconFromFile[file, 5];
msgSetIcon_ Icons.NewIconFromFile[file, 1];
msgIcon_ Icons.NewIconFromFile[file, 2];
END;

EstablishFileNames: PUBLIC PROC[sName, lName: ROPE]
RETURNS[segName, logName: ROPE, logIsAlp: BOOL] =
BEGIN
alp: ROPE = ".alpine]";
alpineServer: ROPE = "[Luther.alpine]";
cp: FS.ComponentPositions;

[segName, cp, ]_ FS.ExpandName[sName, NIL];        -- no workingDir
IF cp.server.length = 0 THEN segName_ alpineServer.Concat[sName];
IF cp.ext.length = 0 THEN segName_ segName.Concat[".Segment"]; 

[logName, cp, ]_ FS.ExpandName[lName, NIL];
IF cp.ext.length = 0 THEN logName_ logName.Concat[".DBLog"];

logIsAlp_ (logName.Find[alp, 0, FALSE] > 0);
END;

CheckForAlpineFile: PROC[fName: ROPE] RETURNS[isAlp: BOOL, ok: BOOL] =
BEGIN
IF fName.Find[alpineFileTest, 0, FALSE] < 0 THEN RETURN[FALSE, TRUE];
IF PrincOpsUtils.IsBound[LOOPHOLE[AlpineFS.StreamOpen]] THEN RETURN[TRUE, TRUE];
IF ~LoadBcdForWalnut["AlpineFSImpl"] THEN RETURN[TRUE, FALSE];
END;

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

END.