-- 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: December 12, 1983 5:22 pm

DIRECTORY
AlpineFS USING [StreamOpen],
Buttons USING [ButtonProc],
DB USING [EraseSegment, TransactionOf],
FS USING [Error, StreamOpen],
Icons USING [IconFlavor, NewIconFromFile],
IO,
WQueue USING [QueueClientAction],
Menus USING [Menu, MenuProc],
PrincOpsUtils USING [IsBound],
Rope,
ViewerClasses USING [Viewer],
ViewerOps,
ViewerTools USING [GetContents, SetContents],
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, InternalNewMail,
     LoadBcdForWalnut],
WalnutLog USING [MsgRec,
     currentSegment,
     CloseLogStream, CloseWalnutTransaction, InitializeLog, LogCreateMsgSet,
     LogDestroyMsgSet, LogLength, MarkWalnutTransaction,
     NextMsgRecFromLog, OpenWalnutTransaction, ResetLogToExpectedLength,
     UpdateFromLog],
WalnutPrintOps USING [PrintMsgSet],
WalnutRetrieve USING [RetrieveGVMessages],
WalnutStream USING [ReadOldMailFile],
WalnutWindow USING [MsgSetButton,
     fileNameText, msgIcon, msgSetIcon, msgSetText, newMailIcon, walnut,
     walnutLogName, walnutNullTrans, walnutQueue, walnutSegmentFile,
     walnutMenu, workingMenu,
     AddMsgSetButton, DeleteMsgSetButton, DestroyAllMsgSetButtons,
     GetSelectedMsgSets, FindMSViewer, Report, ReportRope, UserConfirmed];

WalnutExtrasImpl: CEDAR MONITOR
IMPORTS
DB,
Icons, WQueue,
AlpineFS, FS, IO, PrincOpsUtils, Rope,
ViewerOps, ViewerTools,
WalnutControlPrivate, WalnutDB, WalnutDisplayerOps, WalnutMsgOps, WalnutExtras,
WalnutLog, WalnutPrintOps, WalnutRetrieve, WalnutStream, WalnutWindow
EXPORTS WalnutDisplayerOps, WalnutExtras, 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";

-- * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
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]];
 WQueue.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]];
 WQueue.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.TransactionOf[currentSegment]#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];
ChangeWalnutMenu[workingMenu];
  InternalNewMail[];
  ChangeWalnutMenu[walnutMenu];
  NOTIFY wqe.condition;
END;
END;

DoNewMail: PUBLIC PROC =
BEGIN
 startPos: INT← WalnutLog.LogLength[doFlush: TRUE];
 autoCommit: BOOL← walnutSegmentFile.Find[alpineFileTest, 0, FALSE] > 0;
 numRetrieved: INT;

 IF autoCommit THEN 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]]];
IF autoCommit THEN WalnutLog.MarkWalnutTransaction[];
  };
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;

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

 BEGIN
  isAlp, ok: BOOL;
  [isAlp, ok]← CheckForAlpineFile[fName];
  IF ~ok THEN {Report[noAlpineFS]; RETURN};
  IF isAlp THEN
  fStream← AlpineFS.StreamOpen[fName ! FS.Error =>
      IF error.group = user THEN GOTO BadOpen]
  ELSE
  fStream← FS.StreamOpen[fName ! FS.Error => IF error.group = user THEN 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[];
IF walnut = NIL THEN CloseLogStream[];

EXITS
BadOpen => Report["Can't open ", fName, "\n"];
END;

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

-- * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
CreateMsgSetButtonProc: PUBLIC Buttons.ButtonProc =
{ WQueue.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;

-- * * * * * * * * * *
SizeOfMsgSetsProc: PUBLIC Menus.MenuProc =
{ msgSetList: LIST OF MsgSetButton← GetSelectedMsgSets[];
WQueue.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[];
WQueue.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[];
WQueue.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.GetContents[fileNameText];
 msgSetList: LIST OF MsgSetButton← GetSelectedMsgSets[];
 WQueue.QueueClientAction[q: walnutQueue, proc: ArchiveProc,
   data: NEW[ArchiveDataObj← [fileName, msgSetList, FALSE]]];
END;

AppendButtonProc: PUBLIC Buttons.ButtonProc =
BEGIN
 fileName: ROPE ← ViewerTools.GetContents[fileNameText];
 msgSetList: LIST OF MsgSetButton← GetSelectedMsgSets[];
 WQueue.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
 num: INT← 0;
 strm: IO.STREAM;
 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"];
  ViewerTools.SetContents[fileNameText, fileName]
  };
 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;
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: ROPE, lName: ROPE← NIL]
 RETURNS[segName, logName: ROPE, logIsAlp, alpNeeded: BOOL] =
BEGIN
 log: ROPE;
 pos: INT;
 alp: ROPE = ".alpine]";
 alpineServer: ROPE = "[Luther.alpine]";
 alpNeeded← FALSE;

 SELECT sName.Fetch[0] FROM
  '< => {sName← alpineServer.Concat[sName]; alpNeeded← TRUE};
  '[ => IF sName.Find[alp, 0, FALSE] > 0 THEN alpNeeded← TRUE;
 ENDCASE => sName← Rope.Concat["[Local]", sName];

-- check for extension
 pos← MAX[sName.Find[">"], 0];

 IF Rope.Find[sName, ".", pos] > 0 THEN segName← sName  -- has extension
  ELSE segName← sName.Concat[".Segment"];
 IF ~alpNeeded THEN
  log← segName.Substr[7, segName.Find[".", 8]-7]
ELSE
  { sPos: INT← segName.Find[">"]+1;
  log← segName.Substr[0, segName.Find[".", sPos]];
  };

IF lName.Length[] = 0 THEN logName← log.Concat[".DBLog"]
ELSE
{ pos← MAX[lName.Find[">"], 0];
logName← lName;
IF logName.Find[".", pos] < 0 THEN logName← logName.Concat[".DBLog"];
  };

 alpNeeded← (logIsAlp← (logName.Find[alp, 0, FALSE] > 0)) OR alpNeeded;
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[AlpineFS.StreamOpen] THEN RETURN[TRUE, TRUE];
 IF ~LoadBcdForWalnut["AlpineFSImpl"] THEN RETURN[TRUE, FALSE];
END;

-- * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

END.