WalnutNotifierImpl.mesa
Copyright Ó 1984, 1987, 1988, 1992 by Xerox Corporation. All rights reserved.
Willie-Sue, August 8, 1989 3:11:41 pm PDT
Donahue, May 20, 1985 1:53:31 pm PDT
Pavel, February 6, 1986 2:59:42 pm PST
Contents: Notifier & restart code
created July, 1983 by Willie-Sue
Terry, October 1, 1992 11:39 am PDT
Swinehar, May 30, 1991 2:01 pm PDT
Willie-s, April 30, 1992 11:38 am PDT
DIRECTORY
BasicTime USING [Now],
FS USING [Error, ErrorDesc],
MailRetrieve USING [MBXState],
Icons USING [IconFlavor],
IO,
Labels USING [Set],
Menus USING [MenuProc],
Process USING [Detach],
Rope,
SendMailOps USING [UnregisterReporter],
SystemNames USING [UserName],
TBQueue USING [Action, DequeueAction, FlushWithCallback, QueueClientAction],
UserProfile USING [Boolean, CallWhenProfileChanges, ProfileChangedProc, Token],
ViewerClasses USING [Viewer],
ViewerEvents USING [EventRegistration, UnRegisterEventProc],
ViewerLocks USING [CallUnderWriteLock],
ViewerSpecs USING [openTopY],
ViewerOps,
Wallaby USING [ShutDownWallaby],
WalnutDefs USING [Error, VersionMismatch],
WalnutOps USING [ActiveName, MsgExists, MsgSetsInfo, Scavenge, Shutdown, SizeOfMsgSet, Startup, UnregisterReporter, WalnutOpsHandle],
WalnutNewMail USING [GetLastMailBoxStatus],
WalnutWindowPrivate USING [MsgAndHandle, MsgSetInfo, WalnutHandle, WalnutHandleRec, WalnutState],
WalnutInternal USING [ChangeMenu, DisableNewMail, EnableNewMail, GetButton, GetUserResponse, initialActiveIconic, initialActiveOpen, InternalAddToMsgMenu, InternalReplaceInMsgMenu, msbDefaultLooks, msbSelectedLooks, OpenTS, plainTextStyle, previousUser, QDisplayMsgSet, SetMailState, ShowMsgSetButtons, TakeDownWalnutViewers, tocDefaultLooks, tocSelectedLooks, tocUnreadLooks, userWantsQMs, WaitCallOutcome, workingMenu],
WalnutWindow USING [GetHandleList, Report, ReportRope, ReportFormat];
WalnutNotifierImpl: CEDAR MONITOR
IMPORTS
BasicTime, FS, IO, Process, Rope,
Labels, SendMailOps, SystemNames, TBQueue,
UserProfile, ViewerLocks, ViewerEvents, ViewerOps, ViewerSpecs,
Wallaby, WalnutDefs, WalnutOps, WalnutNewMail,
WalnutInternal, WalnutWindow
EXPORTS WalnutInternal, WalnutWindow =
BEGIN OPEN WalnutInternal;
Walnut Viewers types and global data
ROPE: TYPE = Rope.ROPE;
Viewer: TYPE = ViewerClasses.Viewer;
MsgAndHandle: TYPE = WalnutWindowPrivate.MsgAndHandle;
MsgSetInfo: TYPE = WalnutWindowPrivate.MsgSetInfo;
WalnutState: TYPE = WalnutWindowPrivate.WalnutState;
WalnutHandle: TYPE = WalnutWindowPrivate.WalnutHandle;
WalnutHandleRec: PUBLIC TYPE = WalnutWindowPrivate.WalnutHandleRec;
scavengeMsg: ROPE = "Click Scavenge or Quit";
forceQuitRope: ROPE = "You must quit out of Walnut; Click Quit when ready";
wDefsError: ROPE = "\n **** WalnutDefs.Error: code: %g, info: %g at %g\n";
wVersError: ROPE = "\n **** WalnutDefs.VersionMismatch: explanation: %g at %g\n";
IOErr: ROPE = "\n *** IO.Error: ";
FSErr: ROPE = "\n *** FS.Error: ";
debugging: BOOL ¬ FALSE;
WalnutDefsError: SIGNAL = CODE;
IOError: SIGNAL = CODE;
FSError: SIGNAL = CODE;
WaitForNewMailLabel: ROPE = "Checking for new mail ...";
NoMailLabel: ROPE = "Cannot retrieve mail using this database";
ROAccessLabel: ROPE = "You only have Read access to this database";
* * * * * * * * * * exported to WalnutWindow
MsgMenuClientData: TYPE = REF MsgMenuClientDataRec;
MsgMenuClientDataRec: TYPE =
RECORD[wH: WalnutHandle, mProc: Menus.MenuProc, data: REF ANY, doReset: BOOL];
AddToMsgMenu: PUBLIC ENTRY PROC[wH: WalnutHandle, label: ROPE, proc: Menus.MenuProc, clientData: REF ANY ¬ NIL, onQueue: BOOL ¬ FALSE, doReset: BOOL ¬ TRUE] = {
mmcd: MsgMenuClientData;
IF NOT onQueue THEN {
InternalAddToMsgMenu[wH, label, proc, clientData, onQueue];
RETURN
};
FOR whL: LIST OF WalnutHandle ¬ (IF wH # NIL THEN LIST[wH] ELSE WalnutWindow.GetHandleList[]), whL.rest UNTIL whL = NIL DO
mmcd ¬ NEW[MsgMenuClientDataRec ¬ [whL.first, proc, clientData, doReset]];
InternalAddToMsgMenu[whL.first, label, MsgMenuProc, mmcd, onQueue];
ENDLOOP;
};
ReplaceInMsgMenu: PUBLIC ENTRY PROC[wH: WalnutHandle, label: ROPE, proc: Menus.MenuProc, clientData: REF ANY ¬ NIL, onQueue: BOOL ¬ FALSE, doReset: BOOL ¬ TRUE] RETURNS[oldFound: BOOL]= {
mmcd: MsgMenuClientData;
IF NOT onQueue THEN {
oldFound ¬ InternalReplaceInMsgMenu[wH, label, proc, clientData, onQueue];
RETURN
};
FOR whL: LIST OF WalnutHandle ¬ (IF wH # NIL THEN LIST[wH] ELSE WalnutWindow.GetHandleList[]), whL.rest UNTIL whL = NIL DO
mmcd ¬ NEW[MsgMenuClientDataRec ¬ [whL.first, proc, clientData, doReset]];
oldFound ¬ InternalReplaceInMsgMenu[whL.first, label, MsgMenuProc, mmcd, onQueue];
ENDLOOP;
};
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
GetWalnutState: ENTRY PROC[wH: WalnutHandle] RETURNS[WalnutState] =
{ RETURN[wH.walnutState] };
WalnutNotifier: PUBLIC PROC[wH: WalnutHandle] = {
OPEN TBQueue;
Wn: PROC = {
action: TBQueue.Action ¬ TBQueue.DequeueAction[wH.walnutQueue];
IF GetWalnutState[wH] = running THEN {
WITH action SELECT FROM
e1: Action.tbUser =>
e1.proc[e1.button, e1.clientData, e1.mouseButton, e1.shift, e1.control];
e2: Action.mbUser =>
e2.proc[e2.parent, e2.clientData, e2.mouseButton, e2.shift, e2.control];
e3: Action.client =>
IF e3.proc # NIL THEN e3.proc[e3.data]
ELSE {
wqe: WalnutQueueEntry ¬ NARROW[e3.data];
WaitForWaitCall: ENTRY PROC = {
ENABLE UNWIND => NULL;
NOTIFY wqe.condition;
WAIT wqe.waitCallFinished
};
IF wqe # NIL THEN WaitForWaitCall[];
};
ENDCASE => ERROR;
}
ELSE
WITH action SELECT FROM  -- walnut is not running
e1: Action.tbUser => NULL;
e2: Action.mbUser => NULL;
e3: Action.client =>
IF e3.proc # NIL THEN
{ IF e3.proc = QuitWalnut THEN e3.proc[e3.data] ELSE NULL }
ELSE {
wqe: WalnutQueueEntry ¬ NARROW[e3.data];
Notify: ENTRY PROC = {ENABLE UNWIND => NULL; NOTIFY wqe.condition};
IF wqe # NIL THEN
{ wqe.outcome ¬ notRunning; Notify[] };
};
ENDCASE => ERROR;
};
DO
[] ¬ CarefullyApply[wH, Wn];
ENDLOOP;
};
WhatHappened: TYPE = {ok, flushAndContinue, quitting, restarted};
CarefullyApply: PROC[wH: WalnutHandle, proc1: PROC ¬ NIL, proc2: PROC[BOOL] ¬ NIL]
 RETURNS[result: WhatHappened] = {
ENABLE BEGIN
ABORTED => {
WalnutWindow.Report[wH, "\n Catching ABORTED\n"];
GOTO failure;
};
WalnutDefs.Error => {
IF debugging THEN SIGNAL WalnutDefsError;
IF code = $AlreadyStarted THEN GOTO ignore;
IF code = $DBInternalError THEN GOTO internalError;
WalnutWindow.ReportFormat[wH, wDefsError, [atom[code]], [rope[explanation]], [time[BasicTime.Now[]] ] ];
GOTO failure;
};
WalnutDefs.VersionMismatch => {
WalnutWindow.ReportFormat[wH, wVersError, [rope[explanation]], [time[BasicTime.Now[]] ] ];
GOTO mismatch;
};
FS.Error => {
IF debugging THEN SIGNAL FSError;
WalnutWindow.Report[wH, FSErr, error.explanation];
GOTO failure;
};
IO.Error => {
ed: FS.ErrorDesc;
<<ed ¬ FS.ErrorFromStream[stream ! IO.Error, FS.Error => CONTINUE];>>
IF debugging THEN SIGNAL IOError;
IF ed.explanation # NIL THEN WalnutWindow.Report[wH, IOErr, ed.explanation];
IF ec = Failure THEN {
IF ed.code = $quotaExceeded THEN GOTO outOfSpace ELSE {
WalnutWindow.ReportFormat[wH, "IO Failure with code %g\n", [atom[ed.code]] ];
GOTO failure;
};
}
ELSE {
IF ed.explanation = NIL THEN WalnutWindow.Report[wH, "Other IO error"];
GOTO failure; -- better this than nothing
};
};
END;
IF proc1 # NIL THEN proc1[] ELSE proc2[wH.walnutState = running];
RETURN[ok];
EXITS
internalError => {
wH.walnut.icon ¬ wH.iconSet[broken];
IF wH.walnut.iconic THEN ViewerOps.PaintViewer[wH.walnut, all];
WalnutWindow.Report[wH, "\n DB reported an internal error; you'll have to quit"];
WalnutWindow.Report[wH, "\nThen type WalnutScavenge to the commandTool"];
ViewerOps.BlinkIcon[wH.walnut];
TBQueue.FlushWithCallback[wH.walnutQueue, FlushingQueue];
WalnutWindow.Report[wH, forceQuitRope];
[] ¬ GetUserResponse[wH, wH.forceQuitMenu];
wH.walnut.icon ¬ wH.iconSet[wH.whichIcon];
wH.mustQuitMsg ¬ NIL;
TBQueue.QueueClientAction[wH.walnutQueue, QuitWalnut, wH];
RETURN[quitting];
};
ignore => RETURN[ok];
mismatch =>
IF MismatchHandled[wH] THEN RETURN[flushAndContinue]
ELSE RETURN[HandleFailure[wH]];
failure => RETURN[HandleFailure[wH]];
outOfSpace => {
wH.walnut.icon ¬ wH.iconSet[broken];
IF wH.walnut.iconic THEN ViewerOps.PaintViewer[wH.walnut, all];
WalnutWindow.Report[wH, "\n Out of space"];
ViewerOps.BlinkIcon[wH.walnut];
TBQueue.FlushWithCallback[wH.walnutQueue, FlushingQueue];
WalnutWindow.Report[wH, forceQuitRope];
[] ¬ GetUserResponse[wH, wH.forceQuitMenu];
wH.walnut.icon ¬ wH.iconSet[wH.whichIcon];
wH.mustQuitMsg ¬ NIL;
TBQueue.QueueClientAction[wH.walnutQueue, QuitWalnut, wH];
RETURN[quitting];
};
};
MismatchHandled: PROC[wH: WalnutHandle] RETURNS[ok: BOOL] = {
IF (ok ¬ WalnutOps.MsgSetsInfo[wH.opsH].version = wH.msgSetsVersion) THEN
ShowMsgSetButtons[wH];
RETURN[ok];
};
HandleFailure: PROC[wH: WalnutHandle] RETURNS[WhatHappened] = {
doQuit: BOOL;
wH.walnut.icon ¬ wH.iconSet[broken];
IF wH.walnut.iconic THEN ViewerOps.PaintViewer[wH.walnut, all];
SetWalnutState[wH, waitingForUser];
TBQueue.FlushWithCallback[wH.walnutQueue, FlushingQueue];
WalnutOps.Shutdown[wH.opsH];
IF wH.walnut = NIL THEN {
wH.mustQuitMsg ¬ NIL;
TBQueue.QueueClientAction[wH.walnutQueue, QuitWalnut, wH];
RETURN[quitting];
};
WalnutWindow.Report[wH, "\nClick Quit or Retry"];
IF (doQuit ¬ GetUserResponse[wH, wH.maybeQuitMenu, TRUE]) THEN {
WalnutWindow.Report[wH, " quitting ..."];
wH.walnut.icon ¬ wH.iconSet[wH.whichIcon];
wH.mustQuitMsg ¬ NIL;
TBQueue.QueueClientAction[wH.walnutQueue, QuitWalnut, wH];
RETURN[quitting];
}
ELSE {
wH.walnut.icon ¬ wH.iconSet[wH.whichIcon];
WalnutWindow.Report[wH, " retrying ..."];
TRUSTED { Process.Detach[FORK WaitForRestart[wH]] };
RETURN[restarted];
}
};
FlushingQueue can't be an ENTRY proc
WalnutQueueEntry: TYPE = REF QueueEntryObject;
QueueEntryObject: TYPE = RECORD[
outcome: WaitCallOutcome ¬ ok, condition, waitCallFinished: CONDITION];
FlushingQueue: PROC[action: TBQueue.Action] = {
WITH action SELECT FROM
e1: TBQueue.Action.tbUser => NULL;
e2: TBQueue.Action.mbUser => NULL;
e3: TBQueue.Action.client =>
IF e3.proc # NIL THEN e3.proc[e3.data]
ELSE {
wqe: WalnutQueueEntry ¬ NARROW[e3.data];
Notify: ENTRY PROC = { NOTIFY wqe.condition };
IF wqe # NIL THEN {
wqe.outcome ¬ flushed;
Notify[]
};
};
ENDCASE => ERROR;
};
FlushWQueue: PUBLIC INTERNAL PROC[wH: WalnutHandle] =  -- for WalnutWindowInternalImpl to call
{ TBQueue.FlushWithCallback[wH.walnutQueue, FlushingQueue] };
DoWaitCall: PUBLIC PROC[wH: WalnutHandle, proc: PROC[] ]
 RETURNS[outcome: WaitCallOutcome] = {
puts proc on Walnut's queue and waits for its execution to finish
result: WhatHappened;
wqe: WalnutQueueEntry;
IF wH = NIL THEN RETURN[flushed];  -- a mistake?
wqe ¬ NEW[QueueEntryObject ¬ []];
QueueAndWait[wH, wqe];
IF wqe.outcome = ok THEN  -- ~flushed or ~notRunning
IF (result ¬ CarefullyApply[wH: wH, proc1: proc]) # ok THEN wqe.outcome ¬ flushed;
NotifyWaitCallWaiter[wqe];
RETURN[wqe.outcome]
};
QueueAndWait: ENTRY PROC[wH: WalnutHandle, wqe: WalnutQueueEntry] = {
ENABLE UNWIND => NULL;
TBQueue.QueueClientAction[wH.walnutQueue, NIL, wqe];
WAIT wqe.condition
};
NotifyWaitCallWaiter: ENTRY PROC[wqe: WalnutQueueEntry] =
{ ENABLE UNWIND => NULL; NOTIFY wqe.waitCallFinished };
DoStartupCall: PUBLIC PROC[wH: WalnutHandle, proc: PROC[isRunning: BOOL]]
 RETURNS[outcome: WaitCallOutcome] = {
puts proc on Walnut's queue and waits for its execution to finish; calls proc even if walnut is not running
result: WhatHappened;
wqe: WalnutQueueEntry = NEW[QueueEntryObject ¬ []];
QueueAndWait[wH, wqe];
IF wqe.outcome # flushed THEN  -- ok or notRunning
IF (result ¬ CarefullyApply[wH: wH, proc2: proc]) # ok THEN wqe.outcome ¬ flushed;
NotifyWaitCallWaiter[wqe];
RETURN[wqe.outcome]
};
MsgMenuProc: Menus.MenuProc = {
mmcd: MsgMenuClientData ¬ NARROW[clientData];
mmcd.mProc[parent, mmcd.data, mouseButton, shift, control];
IF ~mmcd.doReset THEN RETURN;
ShowMsgSetButtons[mmcd.wH];
FixUpWalnutViewers[mmcd.wH];
};
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
WaitForRestart: PROC[wH: WalnutHandle, exp: ROPE ¬ NIL] = {
Rw: PROC[BOOL] = {
IF RestartWalnut[wH, FALSE, FALSE] THEN
WalnutWindow.ReportFormat[wH, "Restart finished at %g\n", [time[BasicTime.Now[]]] ];
};
OpenTS[wH, exp];  -- displays exp if ts not already open
[] ¬ DoStartupCall[wH, Rw];
};
RestartWalnut: PUBLIC PROC[wH: WalnutHandle, scavengeFirst, firstTime: BOOL]
RETURNS[restarted: BOOL] = {
DO
BEGIN
ENABLE BEGIN
ABORTED, UNWIND => GOTO retry;
WalnutDefs.Error => {
IF debugging THEN SIGNAL WalnutDefsError;
IF code = $AlreadyStarted THEN GOTO ignore;
WalnutWindow.ReportFormat[wH,
wDefsError, [atom[code]], [rope[explanation]], [time[BasicTime.Now[]]] ];
SELECT code FROM
$BadLog, $SchemaMismatch, $MismatchedExistingSegment,
$WrongRootFile, $DBInternalError, $NoSegment => GOTO needScav;
ENDCASE => GOTO retry;
};
IO.Error => {
ed: FS.ErrorDesc;
<<ed ¬ FS.ErrorFromStream[stream ! IO.Error, FS.Error => CONTINUE];>>
IF debugging THEN SIGNAL IOError;
IF ed.explanation # NIL THEN WalnutWindow.Report[wH, IOErr, ed.explanation];
SELECT ec FROM
Failure => {
IF ed.code = $quotaExceeded THEN WalnutWindow.Report[wH, "\n Out of space"]
ELSE WalnutWindow.ReportFormat[wH, "IO Failure with code %g\n", [atom[ed.code]] ]
};
SyntaxError => WalnutWindow.Report[wH, "SyntaxError"];
NotImplementedForThisStream => WalnutWindow.Report[wH, "NotImplementedForThisStream"];
BadIndex => WalnutWindow.Report[wH, "BadIndex"];
ENDCASE => WalnutWindow.Report[wH, "Other IO Error"];
GOTO retry;
};
FS.Error => {
IF debugging THEN SIGNAL FSError;
WalnutWindow.Report[wH, FSErr, error.explanation];
GOTO retry
};
END;
wasReadOnly: BOOL ¬ wH.readOnlyAccess;
notFoundRope: ROPE = " not found and can't be created";
newMailExists: BOOL;
wH.readOnlyAccess ¬ wH.userAskedForReadOnly;
IF scavengeFirst THEN {
WalnutWindow.ReportFormat[wH, "Starting scavenge at %g ...\n", [time[BasicTime.Now[]]] ];
newMailExists ¬ WalnutOps.Scavenge[wH.opsH];
WalnutWindow.ReportFormat[wH, "\n Scavenge finished at %g\n", [time[BasicTime.Now[]]] ];
}
ELSE newMailExists ¬ WalnutOps.Startup[wH.opsH];
IF wH.dontDoMail THEN wH.opsH.mailFor ¬ NIL;
wH.msgNamePrefix ¬ wH.opsH.dbName.Concat["!Msg!"];
wH.msgSetNamePrefix ¬ wH.opsH.dbName.Concat["!MsgSet!"];
wH.personalMailDB ¬ wH.opsH.mailFor.Equal[SystemNames.UserName[], FALSE];
IF wH.opsH.readOnly THEN
{ wH.walnutMenu ¬ wH.readOnlyDBMenu; wH.personalMailDB ¬ FALSE }
ELSE wH.walnutMenu ¬ IF wH.personalMailDB THEN wH.mailDBMenu ELSE wH.nonMailDBMenu;
Labels.Set[wH.mailNotifyLabel,
IF wH.personalMailDB THEN WaitForNewMailLabel ELSE
IF wH.readOnlyAccess THEN ROAccessLabel ELSE NoMailLabel];
IF wH.personalMailDB THEN EnableNewMail[wH];
ShowMsgSetButtons[wH];
IF ~wH.walnut.iconic THEN ViewerOps.PaintViewer[wH.walnut, client];
check how much space is left (if any) in the control window for a typescript)
IF firstTime THEN
{ dif: INTEGER;
height: INTEGER ¬ ViewerSpecs.openTopY/4;
msgsInDeleted: INT ←
WalnutOps.SizeOfMsgSet[wH.opsH, WalnutOps.DeletedName].messages;
That's too expensive; size of database is remembered, more or less, but sizes of message sets are computed. D. Swinehart March 20, 1991 3:36:57 pm PST
total: INT ← WalnutOps.SizeOfDatabase[wH.opsH].messages;
No point doing it if you ain't going to use it. DCS March 20, 1991 3:37:43 pm PST
LockedSetHeight: PROC = {ViewerOps.SetOpenHeight[wH.walnut, height - dif]};
IF (dif ¬ (height-wH.walnutRulerAfter.wy) - 100) # 0 THEN
{ ViewerLocks.CallUnderWriteLock[LockedSetHeight, wH.walnut];
IF ~wH.walnut.iconic THEN ViewerOps.ComputeColumn[wH.walnut.column]
};
IF msgsInDeleted > total/8 THEN
WalnutWindow.ReportFormat[wH,
"There are %g deleted msgs (%g total); consider doing an expunge\n", [integer[msgsInDeleted]], [integer[total]] ];
};
FixUpWalnutViewers[wH];
IF initialActiveOpen AND firstTime THEN
{ IF wH.personalMailDB OR
WalnutOps.SizeOfMsgSet[wH.opsH, WalnutOps.ActiveName].messages # 0 THEN
[] ¬ QDisplayMsgSet[wH, wH.activeMsgSetButton];
};
IF wH.personalMailDB THEN {
IF newMailExists THEN SetMailState[wH, thereIsMail]
ELSE {
mbxState: MailRetrieve.MBXState ¬ WalnutNewMail.GetLastMailBoxStatus[wH.opsH].mbxState;
IF mbxState = unknown THEN {
SetMailState[wH, waiting];
IF waitForMailboxState THEN {
Process.Pause[Process.SecondsToTicks[10]];
mbxState ← WalnutNewMail.GetLastMailBoxStatus[wH.opsH].mbxState;
};
};
SELECT mbxState FROM
unknown => SetMailState[wH, noState];
allEmpty, someEmpty => SetMailState[wH, noMail];
allDown => SetMailState[wH, noServers];
notEmpty => SetMailState[wH, someMail];
ENDCASE => SetMailState[wH, noMail];
};
};
wH.walnut.inhibitDestroy ¬ FALSE;
SetWalnutState[wH, running];
ChangeMenu[wH, wH.walnutMenu, FALSE];
RETURN[TRUE];
EXITS
ignore => RETURN[TRUE];
retry => {
wH.walnut.icon ¬ wH.iconSet[broken];
IF wH.walnut.iconic THEN ViewerOps.PaintViewer[wH.walnut, all];
WalnutWindow.Report[wH, "Start or Restart failed; click Quit or Retry"];
SetWalnutState[wH, waitingForUser];
IF wH.walnut = NIL OR GetUserResponse[wH, wH.maybeQuitMenu, TRUE] THEN {
IF wH.walnut # NIL THEN wH.walnut.icon ¬ wH.iconSet[wH.whichIcon];
CloseDownWalnut[wH];
RETURN[FALSE]
};
WalnutOps.Shutdown[wH.opsH];  -- before trying to restart
wH.walnut.icon ¬ wH.iconSet[wH.whichIcon];
scavengeFirst ¬ FALSE;
};
needScav => {
wH.walnut.icon ¬ wH.iconSet[broken];
IF wH.walnut.iconic THEN ViewerOps.PaintViewer[wH.walnut, all];
WalnutWindow.Report[wH, "A scavenge is necessary\n", scavengeMsg];
IF ~GetUserResponse[wH, wH.scavMenu] THEN {
wH.walnut.icon ¬ wH.iconSet[wH.whichIcon];
CloseDownWalnut[wH];
SetWalnutState[wH, stopped];
RETURN[FALSE]
};
WalnutWindow.Report[wH, "\n Starting scavenge ...\n"];
wH.walnut.icon ¬ wH.iconSet[wH.whichIcon];
scavengeFirst ¬ TRUE;
};
END;
ENDLOOP;
};
FixUpWalnutViewers: PUBLIC PROC[wH: WalnutHandle] = {
v: Viewer;
FOR vL: LIST OF Viewer ¬ wH.msgSetViewerList, vL.rest UNTIL vL=NIL DO
msI: MsgSetInfo;
IF ( v ¬ vL.first).destroyed THEN LOOP;
msI ¬ NARROW[ViewerOps.FetchProp[v, $MsgSetInfo]];
[] ¬ QDisplayMsgSet[wH, GetButton[msI.button.wH, msI.button.msgSet.name], v];
ENDLOOP;
FOR vL: LIST OF Viewer ¬ wH.msgViewerList, vL.rest UNTIL vL=NIL DO
maH: MsgAndHandle;
IF ( v ¬ vL.first).destroyed THEN LOOP;
maH ¬ NARROW[ViewerOps.FetchProp[v, $WalnutMsgName]];
IF ~WalnutOps.MsgExists[maH.wH.opsH, maH.msg] THEN {
IF ViewerOps.FetchProp[v, $Frozen] # NIL THEN LOOP;
WalnutWindow.ReportFormat[maH.wH, "Msg: %g doesn't exist in %g; destroying viewer", [rope[maH.msg]], [rope[maH.wH.opsH.rootName]] ];
ViewerOps.DestroyViewer[v];
};
ENDLOOP;
};
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
QuitWalnut: PUBLIC PROC[ra: REF ANY] = {
wH: WalnutHandle = NARROW[ra];
msg: ROPE = wH.mustQuitMsg;
IF GetWalnutState[wH] = stopped THEN RETURN; -- ignore
SetWalnutState[wH, waitingForUser];
IF msg # NIL THEN {
wH.walnut.inhibitDestroy ¬ TRUE;
OpenTS[wH];   -- if after rollback, may not be open
TakeDownWalnutViewers[wH];  -- make the user notice
ViewerOps.BlinkIcon[wH.walnut, IF wH.walnut.iconic THEN 0 ELSE 1];
WalnutWindow.Report[wH, "\n **********", msg];
WalnutWindow.Report[wH, "You MUST quit out of Walnut; Click Quit when ready"];
[] ¬ GetUserResponse[wH, wH.forceQuitMenu];
};
CloseDownWalnut[wH];
SetWalnutState[wH, stopped];
wH.walnut ¬ NIL;
};
CloseDownWalnut: PUBLIC PROC[wH: WalnutHandle] = {
clean up after Walnut
v: Viewer ¬ wH.walnut;
IF wH.walnut = NIL THEN RETURN;  -- not running
if wallaby is running then warn client to stop browsing!!
wH.walnut.inhibitDestroy ¬ TRUE;
IF wH.personalMailDB THEN DisableNewMail[wH];
ChangeMenu[wH, workingMenu, FALSE];
wH.selectedMsgSetButtons ¬ wH.firstMsgSetButton ¬ NIL;
TakeDownWalnutViewers[wH];
destroy Wallaby viewers... Be prepared to catch error signals!
Wallaby.ShutDownWallaby[wH];
WalnutWindow.ReportRope[wH, "Closing database and saving log ..."];
WalnutOps.Shutdown[wH.opsH];
IF wH.walnutEventReg # NIL THEN
ViewerEvents.UnRegisterEventProc[wH.walnutEventReg, destroy];
wH.walnutEventReg ¬ NIL;
wH.walnut ¬ NIL;  -- don't let others try to use Report
wH.mailNotifyLabel ¬ NIL;
SendMailOps.UnregisterReporter[wH.wtsOut];
WalnutOps.UnregisterReporter[wH.opsH, wH.wtsOut];
IF wH.wtsOut # NIL THEN wH.wtsOut.Close[];
wH.wtsOut ¬ NIL;
wH.mustQuitMsg ¬ NIL;
v.inhibitDestroy ¬ FALSE;
wH.msgSetsTViewer ¬ NIL;
ViewerOps.DestroyViewer[v];
};
SetWalnutState: ENTRY PROC[wH: WalnutHandle, newState: WalnutState] =
{ wH.walnutState ¬ newState};
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
userChangedMessage: ROPE = "Logged-in user changed";
displayMsgSetInIcon: PUBLIC BOOL ¬
UserProfile.Boolean[key: "Walnut.DisplayMsgSetInIcon", default: FALSE];
This is declared here because of a compiler/loader incompatibility
SetWalnutProfileVars: UserProfile.ProfileChangedProc = {
curUser: ROPE = SystemNames.UserName[];
initialActiveIconic ¬ UserProfile.Boolean[key: "Walnut.InitialActiveIconic", default: FALSE];
initialActiveOpen ¬ UserProfile.Boolean[key: "Walnut.InitialActiveOpen", default: FALSE];
msbDefaultLooks ¬
UserProfile.Token[key: "Walnut.MsgSetButtonDefaultLooks", default: ""];
msbSelectedLooks ¬
UserProfile.Token[key: "Walnut.MsgSetButtonSelectedLooks", default: "bi"];
tocDefaultLooks ¬
UserProfile.Token[key: "Walnut.TOCDefaultLooks", default: ""];
tocSelectedLooks ¬
UserProfile.Token[key: "Walnut.TOCSelectedLooks", default: "sb"];
tocUnreadLooks ¬
UserProfile.Token[key: "Walnut.TOCUnreadLooks", default: "i"];
userWantsQMs ¬
UserProfile.Boolean[key: "Walnut.ShowUnreadWithQMs", default: TRUE];
plainTextStyle ¬
UserProfile.Token[key: "Walnut.PlainTextStyle", default: "cedar"];
displayMsgSetInIcon ¬
UserProfile.Boolean[key: "Walnut.DisplayMsgSetInIcon", default: FALSE];
IF Rope.Equal[previousUser, curUser, FALSE] THEN RETURN;
FOR whL: LIST OF WalnutHandle ¬ WalnutWindow.GetHandleList[], whL.rest UNTIL whL = NIL DO
wH: WalnutHandle;
IF GetWalnutState[wH ¬ whL.first] = running THEN {
wH.mustQuitMsg ¬ userChangedMessage;
TBQueue.FlushWithCallback[wH.walnutQueue, FlushingQueue];
TBQueue.QueueClientAction[wH.walnutQueue, QuitWalnut, wH];
previousUser ¬ curUser;
};
ENDLOOP;
previousUser ¬ curUser;
};
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
WalnutCheckpointProc: Booting.CheckpointProc = {
FOR whL: LIST OF WalnutHandle ¬ WalnutWindow.GetHandleList[], whL.rest UNTIL whL = NIL DO
ENABLE UNWIND => { CloseTS[whL.first]};
Wcp: PROC = {
ChangeMenu[whL.first, workingMenu, FALSE];
WalnutWindow.Report[whL.first, "\nDoing Checkpoint ... "];
DisableNewMail[whL.first];
WalnutOps.Shutdown[whL.first.opsH ! ABORTED => CONTINUE];
CloseTS[whL.first];
};
IF whL.first.walnut = NIL THEN RETURN;
TBQueue.FlushWithCallback[whL.first.walnutQueue, FlushingQueue];
IF DoWaitCall[whL.first, Wcp] # ok THEN
RETURN[IO.PutFR["Walnut's Checkpoint Proc for %g didn't get done", [rope[whL.first.opsH.rootName]]] ];
ENDLOOP;
};
WalnutRollbackProc: Booting.RollbackProc = {
wH: WalnutHandle;
FOR whL: LIST OF WalnutHandle ¬ WalnutWindow.GetHandleList[], whL.rest UNTIL whL = NIL DO
IF GetWalnutState[wH ¬ whL.first] # running THEN RETURN;
CloseTS[wH];  -- to be very sure
IF ~Rope.Equal[UserCredentials.Get[].name, previousUser, FALSE] THEN {
wH.mustQuitMsg ¬ userChangedMessage;
TBQueue.QueueClientAction[wH.walnutQueue, QuitWalnut, wH]
}
ELSE TRUSTED
{ Process.Detach[FORK WaitForRestart[wH, "Restarting after Rollback"]] };
ENDLOOP;
};
clean up Walnut at checkpoint time
TRUSTED {
Booting.RegisterProcs[c: WalnutCheckpointProc, r: WalnutRollbackProc];
};
UserProfile.CallWhenProfileChanges[SetWalnutProfileVars];
END.