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.