-- 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.

�Êp˜Jš¡Ïckœ
�4œ�-œ
Ïk	œžœžœžœ
žœ"žœ
žœžœ"žœžœžœ#žœ$žœ&žœ4žœžœâ
žœ'žœˆ
žœfžœžžœ!žœ&žœ#žœéžœ
žœžœžœ#žœžœÓ
žœ2žœžœ
žœ(žœžœžœ
žœ-žœ,žœžœSžœIž
�Rœžœžœ%žœž	œ
žœžœ
žœ
ž	œÏn
œžœ
žœ
žœžœ
žœ
žœžœ
žœžœ�Fœžœ
žœ
žœžœžœVžœžœŸœžœ
žœžœ
žœ
žœžœ
žœžœžœ
žœ
žœžœ�Fœžœ
žœ
žœžœžœVžœžœžœŸœžœ
žœ
žœžœ
žœžœžœžœžœžœžœ
žœ
žœ	žœžœ�)Ÿœžœ
žœ
žœžœ
žœžœžœ
žœ
žœžœžœžœžœžœžœžœŸœžœ
žœ
žœžœ
žœžœžœ
žœ
žœžœžœžœžœžœžœžœŸœžœ
žœ
žœžœ
žœžœžœ
žœ
žœžœžœ(žœžœžœŸœžœ
žœ
žœžœ
žœžœžœ
žœ
žœžœžœ%žœžœžœ�Sœ
�=œ�žœžœ�
œ�žœžœžœ
žœ
žœžœ�Ÿœžœ
žœžœ
žœ
žœžœžœžœžœ2žœ
žœ8žœžœŸœžœ
žœ
žœžœ
žœžœ6žœ
žœ
žœžœžœ
žœ^žœžœžœ/žœžœ/žœžœžœžœž
œ
Ÿœžœ
žœžœžœžœžœ žœWžœŸœžœ
žœžœ
žœžœCžœ
žœ
žœžœžœžœ<žœžœCžœžœžœŸœžœ
žœžœžœžœžœ žœZžœŸœžœ
žœžœ
žœžœHžœ
žœ
žœžœžœ
žœCžœžœKžœžœžœŸ
œ)žœžœ)žœžœžœžœž
œ
Ÿœžœ
žœžœžœžœžœžœWžœ
žœ6žœžœŸœžœ
žœžœ
žœžœ?žœ
žœ
žœžœžœ
žœ:žœžœTžœžœžœŸœžœ
žœžœžœžœžœžœžœ7žœ
žœ9žœžœŸœžœ
žœžœ
žœžœEžœ
žœ
žœžœžœ
žœCžœžœZžœžœžœ�RœŸ
œžœ
žœžœžœ
žœžœ
žœžœ
žœw�(œžœ`žœ�œ°
žœžœ�œžœ�Rœ
Ÿœžœ
žœ
žœžœ
žœžœžœ
žœ
žœžœžœ`žœžœžœŸ	œžœ
žœžœžœžœžœ,žœžœžœžœgžœžœ
žœ$žœžœžœ$žœžœžœ+žœ�,Ÿœžœžœžœ	žœžœžœ
žœžœžœžœ>žœ
žœžœ
žœ$žœCžœ
žœ
žœžœ
žœ
žœžœHžœžœžœžœ
žœ žœžœ
žœJžœžœžœžœ
žœ(žœžœ
žœžœ*žœ9žœžœ
žœLžœžœžœžœ�,Ÿ
œžœ
žœ
žœžœ
žœžœžœ
žœ
žœžœžœ
žœ
žœžœžœ%žœžœžœŸœžœžœ
žœ
žœžœ
žœžœžœ
žœžœ
žœžœžœ	žœ
žœ1žœžœžœ
žœ
žœ�œ+�œžœB�œžœ
žœ
žœ
žœžœ
žœžœžœžœ
žœ=žœžœ.žœžœžœžœžœ)žœžœžœ
žœžœ
žœžœ
žœžœ
žœ
žœ8žœ7žœ¦
žœžœžœJžœžœ3žœžœ>žœžœ)žœžœ
žœ
žœžœ6žœžœ
žœ
žœ!žœ�Rœžœ‚
Ÿœžœžœ
žœžœ
žœžœ$žœžœžœŸœžœ	žœžœžœ	žœžœ žœžœžœ'žœ
žœ�œžœžœ8žœ
žœ6žœ	žœžœ
žœ5žœlžœ
žœžœ�œžœ"žœ
žœsŸœžœžœ
žœžœžœ
žœžœ	žœžœ
žœžœžœžœ
žœ#žœžœ
žœ
žœ+žœ žœžœ$žœžœ�œžœ&žœ
žœrŸœžœžœ
žœžœžœ
žœžœ	žœžœ
žœ,žœ%žœžœ
žœ#žœžœ
žœ2žœžœ#žœ3žœžœžœGžœžœ"žœkžœ#žœ4žœ0žœ$žœ�œžœ"žœ
žœrŸœžœžœ
žœžœžœ
žœžœ	žœžœ
žœ+žœ&žœžœ
žœ#žœžœ
žœ2žœžœ-žœ
žœžœ$žœ�œžœžœžœ7žœ
žœkžœ(žœžœžœžœžœ7žœ
žœkžœ(žœžœžœžœ!žœžœžœžœ
žœžœŸœžœžœ
žœžœžœžœ
žœžœžœ"žœ
žœ,žœ
žœ
žœ�œžœžœžœ-žœžœžœ
žœ/žœ�2œ
žœžœižœ%žœžœ*žœ1žœžœžœžœ
žœ
žœžœžœ
žœ5žœžœ
žœžœ/žœ
žœažœžœžœ/žœ
žœPžœžœ
žœ#žœžœ
žœ©
žœžœžœ.žœžœ3žœžœ�Iœ
Ÿœžœ
žœžœžœ"žœ
žœ
žœ žœžœ
žœžœžœ.žœ
žœžœžœžœžœ
žœžœ
žœ
žœ)žœ
žœ
žœ
žœžœžœ1žœžœžœžœžœ.žœžœžœžœ
žœžœ
žœžœ
žœžœ&žœŸœžœ
žœžœžœžœ
žœžœžœžœ
žœ'žœžœŸœžœ
žœžœžœžœ
žœžœžœžœ
žœžœžœ
žœ žœžœžœžœŸœžœ
žœžœžœˆ
žœŸœžœ
žœžœ	žœžœžœžœžœžœžœžœžœžœ"žœžœžœ8žœžœžœžœžœžœž
œžœ �œžœžœ žœ�œžœ%žœžœ7žœžœXžœžœ$žœ
žœ4žœžœZžœžœžœŸœžœžœžœžœžœžœžœžœžœ
žœ
žœžœžœ,žœ
žœ
žœžœžœ#žœ
žœ
žœžœžœ�Rœžœ˜ï¬
—…—Vrdè