WalnutWindowInternalImpl.mesa
Copyright Ó 1985, 1989, 1992 by Xerox Corporation. All rights reserved.
Willie-Sue, November 3, 1989 11:15:02 am PST
Jack Kent April 1, 1987 2:54:36 pm PST
Doug Terry, October 28, 1990 11:25 am PST
Willie-s, April 27, 1992 7:49 pm PDT
Contents: (Internal communication for) Top level Viewer for Walnut
Last edit by:
Willie-Sue on: January 7, 1985 9:22:19 am PST
Donahue, January 2, 1985 3:42:26 pm PST
DIRECTORY
<<Atom USING [GetPName],>>
BasicTime USING [Now],
Containers,
Icons USING [IconFlavor],
FS USING [Error, OpenFile, Create, SetKeep, StreamFromOpenFile],
IO,
Labels USING [Set],
MailUtils USING [Credentials, GetUserCredentials],
Menus,
MessageWindow USING [Append],
Process USING [Detach, Pause, SecondsToTicks],
Rope,
SendMailOps USING [RegisterReporter, <<simpleNameListWithoutSpaces,>> UnregisterReporter],
TypeScript USING [Create],
UserProfile USING [Boolean],
ViewerClasses USING [Viewer],
ViewerOps,
ViewerIO USING [CreateViewerStreams],
ViewerSpecs,
WalnutDefs USING [CheckReportProc, Error],
WalnutOps USING [AcceptNewMail, ActiveName, GetNewMail, RecordNewMailInfo, RegisterReporter, ServerInfo, StartNewMail, UnregisterReporter, WalnutOpsHandle],
WalnutNewMail USING [DisableMailRetrieval, EnableMailRetrieval],
WalnutInternal USING [AddNewMsgsToActive, ChangeMenu, CloseDownWalnut, DoWaitCall, FixUpWalnutViewers, GetButton, MailState, QDisplayMsg, QDisplayMsgSet, ShowMsgSetButtons, WaitCallOutcome, workingMenu],
WalnutWindowPrivate USING [IconState, MsgAndHandle, MsgSetButton, MsgSetInfo, WalnutHandle, WalnutHandleRec],
WalnutWindow USING [GetHandleForMail, OutCome];
WalnutWindowInternalImpl: CEDAR PROGRAM
IMPORTS
<<Atom,>> BasicTime, Labels, MailUtils, MessageWindow,
FS, IO, Process, <<Rope,>> SendMailOps, UserProfile,
TypeScript, ViewerOps, ViewerIO,
WalnutDefs, WalnutOps,
WalnutNewMail,
WalnutInternal, WalnutWindow
EXPORTS WalnutInternal, WalnutWindow =
BEGIN OPEN WalnutInternal;
ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;
Viewer: TYPE = ViewerClasses.Viewer;
WalnutHandle: TYPE = WalnutWindowPrivate.WalnutHandle;
WalnutHandleRec: PUBLIC TYPE = WalnutWindowPrivate.WalnutHandleRec;
MsgSetButton: TYPE = WalnutWindowPrivate.MsgSetButton;
MsgSetInfo: TYPE = WalnutWindowPrivate.MsgSetInfo;
MsgAndHandle: TYPE = WalnutWindowPrivate.MsgAndHandle;
crTimeToFlushCount: CARDINAL ¬ 3;
timeToFlushCount: CARDINAL ¬ 10;
* * * * * * * * * * * * exported to WalnutWindow
ReportFormat: PUBLIC PROC[wH: WalnutHandle, format: ROPE ¬ NIL, v1, v2, v3, v4, v5: IO.Value ¬ [null[]] ] =
{ IF wH.wtsOut # NIL THEN wH.wtsOut.PutFL[format, LIST[v1, v2, v3, v4, v5]] };
Report: PUBLIC PROC[wH: WalnutHandle, msg1, msg2, msg3: ROPE ¬ NIL] = {
ReportRope[wH, msg1, msg2, msg3];
IF wH.wtsOut = NIL THEN RETURN;
wH.wtsOut.PutChar['\n];
IF (wH.crCount ¬ wH.crCount + 1) > crTimeToFlushCount THEN {
wH.wtsOut.Flush[];
wH.reportCount ¬ wH.crCount ¬ 0;
};
IF (wH.reportCount ¬ wH.reportCount + 1) > timeToFlushCount THEN {
wH.wtsOut.Flush[];
wH.reportCount ¬ wH.crCount ¬ 0;
};
};
ReportRope: PUBLIC PROC[wH: WalnutHandle, msg1, msg2, msg3: ROPE ¬ NIL] = {
IF wH.wtsOut = NIL THEN
{ IF msg1#NIL THEN MessageWindow.Append[msg1];
IF msg2#NIL THEN MessageWindow.Append[msg2];
IF msg3#NIL THEN MessageWindow.Append[msg3];
RETURN
};
IF msg1#NIL THEN wH.wtsOut.PutRope[msg1];
IF msg2#NIL THEN wH.wtsOut.PutRope[msg2];
IF msg3#NIL THEN wH.wtsOut.PutRope[msg3];
};
DisplayMsg: PUBLIC PROC[wH: WalnutHandle, msg: ROPE, oldV: Viewer, shift, paint: BOOL]
 RETURNS[v: Viewer] = {
Dm: PROC = {   -- don't open if iconic
v ¬ QDisplayMsg[wH: wH, msg: msg, oldV: oldV, shift: shift, openIfIconic: FALSE, paint: paint]
};
[] ¬ DoWaitCall[wH, Dm];
};
DisplayMsgSet: PUBLIC PROC[wH: WalnutHandle, msgSet: ROPE, shift, repaint: BOOL]
 RETURNS[v: Viewer] = {
Dms: PROC = {
v ¬ QDisplayMsgSet[wH, GetButton[wH, msgSet], NIL, shift, repaint];
};
[] ¬ DoWaitCall[wH, Dms];
};
CurrentVersion: PUBLIC PROC[wH: WalnutHandle, msName: ROPE] RETURNS[version: INT ¬ 0] = {
Dms: PROC = { version ¬ GetButton[wH, msName].msgSet.version };
[] ¬ DoWaitCall[wH, Dms]
};
QueueCall: PUBLIC PROC[
wH: WalnutHandle, proc: PROC[wH: WalnutHandle] RETURNS[doReset: BOOL]]
 RETURNS[outCome: WalnutWindow.OutCome] = {
Qc: PROC = {
IF ~proc[wH] THEN RETURN;
ShowMsgSetButtons[wH];
FixUpWalnutViewers[wH];
};
outCome ¬ DoWaitCall[wH, Qc];
};
Shutdown: PUBLIC PROC[wH: WalnutHandle] = {
Sd: PROC = { [] ¬ CloseDownWalnut[wH] };
[] ¬ DoWaitCall[wH, Sd];
};
* * * * * * * * * * * * exported to WalnutWindow
GetNewMail: PUBLIC PROC[wH: WalnutHandle] = {
Rnm: PROC = {
ENABLE UNWIND => { ChangeMenu[wH, wH.walnutMenu, FALSE] };
responses: LIST OF WalnutOps.ServerInfo;
complete: BOOL;
numNew, total: INT ¬ 0;
msB: MsgSetButton ¬ GetButton[wH, WalnutOps.ActiveName];
ChangeMenu[wH, workingMenu, TRUE];
IF msB.msViewer # NIL THEN
IF msB.msViewer.destroyed THEN msB.msViewer ¬ NIL;
IF msB.msViewer = NIL THEN {  -- not displayed
[responses, complete] ¬ WalnutOps.GetNewMail[wH.opsH, msB.msgSet.version, NIL];
numNew ¬ -1;
WalnutOps.AcceptNewMail[wH.opsH, msB.msgSet.version];
}
ELSE
[responses, complete, numNew] ¬ AddNewMsgsToActive[msB];
IF ~complete THEN {
Report[wH, " There were problems with GetNewMail - some messages not available; try again"];
ChangeMenu[wH, wH.walnutMenu, FALSE];
RETURN
};
FOR rL: LIST OF WalnutOps.ServerInfo ¬ responses, rL.rest UNTIL rL = NIL DO
total ¬ total + rL.first.num; ENDLOOP;
IF total = 0 THEN
Report[wH, "No messages were on the newMailLog"]
ELSE {
FOR rL: LIST OF WalnutOps.ServerInfo ¬ responses, rL.rest UNTIL rL = NIL DO
ReportRope[wH, rL.first.server];
IF rL.first.num = 0 THEN
Report[wH, " ... empty"]
ELSE {
IF rL.first.num = 1 THEN Report[wH, " delivered 1 message"]
ELSE ReportFormat[wH, " delivered %g messages\n", [integer[rL.first.num]] ];
};
ENDLOOP;
IF (numNew >= 0) AND (total # numNew) THEN {
IF numNew = 0 THEN
Report[wH, "\nNo new messages added to database"]
ELSE ReportFormat[wH, "\nOnly %g messages were new", [integer[numNew]] ];
};
};
-- XXX Don't put the flag down if the active msg set is iconic
IF msB.msViewer # NIL THEN
IF ( NOT msB.msViewer.iconic ) OR ( NOT UserProfile.Boolean[key: "Walnut.AutoNewMail", default: FALSE] ) THEN
IF wH.personalMailDB THEN SetMailState[wH, noMail];
ChangeMenu[wH, wH.walnutMenu, FALSE];
};
[] ¬ DoWaitCall[wH, Rnm];
};
EnableNewMail: PUBLIC PROC[wH: WalnutHandle] = {
gvMail: BOOL ~ UserProfile.Boolean["Walnut.gvMail", TRUE];
xnsMail: BOOL ~ UserProfile.Boolean["Walnut.xnsMail", TRUE];
progress: BOOL = UserProfile.Boolean[key: "Walnut.ReportNewMailProgress", default: FALSE];
progressLog: ROPE = "/tmp/WalnutNewMailProgress.log";
Rope.Cat["/tilde/", SendMailOps.simpleNameListWithoutSpaces.first, "/WalnutNewMailProgress.log"];
credentials: LIST OF MailUtils.Credentials ¬
MailUtils.GetUserCredentials[
SELECT TRUE FROM ( gvMail AND xnsMail ) => NIL,
gvMail => $gv, xnsMail => $xns, ENDCASE => $xns];
FS.SetKeep[progressLog, 5 ! FS.Error => CONTINUE];
IF wH.newMailRetrievalStream = NIL THEN
IF progress THEN {
wH.newMailRetrievalViewer ¬ TypeScript.Create[
info: [name: "NewMail Retrieval", iconic: FALSE, column: right, openHeight: 64],
paint: FALSE];
ViewerOps.TopViewer[viewer: wH.newMailRetrievalViewer, paint: TRUE];
wH.newMailRetrievalViewer.inhibitDestroy ¬ TRUE;
wH.newMailRetrievalStream ¬ ViewerIO.CreateViewerStreams[
 name: NIL, viewer: wH.newMailRetrievalViewer, backingFile: progressLog].out;
}
ELSE {
of: FS.OpenFile = FS.Create[progressLog, TRUE, 2, TRUE, 5];
wH.newMailRetrievalStream ¬ FS.StreamFromOpenFile[of, $write];
};
WalnutNewMail.EnableMailRetrieval[
opsHandle: wH.opsH,
registeredUsers: credentials,
reportProc: ReportProc,
progressProc: ProgressReport,
getMailLog: GetMailLog,
recordMailInfo: RecordNewMailInfo,
notifyWhenMailRetrieved: NotifyWhenMailRetrieved];
IF wH.newMailRetrievalViewer # NIL THEN
wH.newMailRetrievalViewer.inhibitDestroy ¬ FALSE;
};
DisableNewMail: PUBLIC PROC[wH: WalnutHandle] = {
IF NOT wH.personalMailDB THEN RETURN;
WalnutNewMail.DisableMailRetrieval[wH.opsH];
IF wH.newMailRetrievalStream # NIL THEN {
IF wH.newMailRetrievalViewer = NIL THEN wH.newMailRetrievalStream.Close[]
ELSE IF ~wH.newMailRetrievalViewer.destroyed THEN {
wH.newMailRetrievalStream.Close[];
ViewerOps.DestroyViewer[wH.newMailRetrievalViewer];
};
wH.newMailRetrievalStream ¬ NIL;
wH.newMailRetrievalViewer ¬ NIL;
wH.personalMailDB ¬ FALSE;
};
};
tempName: ROPE = "/tmp/Walnut.TypescriptLog";
OpenTS: PUBLIC PROC[wH: WalnutHandle, r: ROPE, doRegister: BOOL] = {
logName: ROPE = IO.PutFR[tempName, [rope[Atom.GetPName[wH.opsH.segmentID.segment]]] ];
logName: ROPE = tempName;
FS.SetKeep[logName, 7 ! FS.Error => CONTINUE];  -- if tsLogName doesn't exist
IF wH.wtsOut = NIL THEN
{ wH.wtsOut ¬ ViewerIO.CreateViewerStreams[NIL, wH.walnutTS, logName].out;
IF r # NIL THEN wH.wtsOut.PutRope[r];
IF doRegister THEN {
SendMailOps.RegisterReporter[wH.wtsOut];
WalnutOps.RegisterReporter[wH.opsH, wH.wtsOut];
};
};
};
CloseTS: PUBLIC PROC[wH: WalnutHandle] = {
IF wH.wtsOut # NIL THEN wH.wtsOut.Close[];
SendMailOps.UnregisterReporter[wH.wtsOut];
WalnutOps.UnregisterReporter[wH.opsH, wH.wtsOut];
wH.wtsOut ¬ NIL;
};
GetWalnutViewers: PUBLIC PROC[wH: WalnutHandle]
RETURNS [msgSetList, msgList, wallabyList: LIST OF Viewer] = {
RETURN[wH.msgSetViewerList, wH.msgViewerList, wH.wallabyViewerList];
};
TakeDownWalnutViewers: PUBLIC PROC[wH: WalnutHandle] = {
FOR vL: LIST OF Viewer ¬ wH.msgViewerList, vL.rest UNTIL vL=NIL DO
IF NOT vL.first.destroyed AND ViewerOps.FetchProp[vL.first, $Frozen] = NIL THEN ViewerOps.DestroyViewer[vL.first];
vL.first ¬ NIL;
ENDLOOP;
FOR vL: LIST OF Viewer ¬ wH.msgSetViewerList, vL.rest UNTIL vL=NIL DO
IF NOT vL.first.destroyed THEN ViewerOps.DestroyViewer[vL.first];
vL.first ¬ NIL;
ENDLOOP;
FOR vL: LIST OF Viewer ¬ wH.wallabyViewerList, vL.rest UNTIL vL=NIL DO
IF NOT vL.first.destroyed THEN ViewerOps.DestroyViewer[vL.first];
vL.first ¬ NIL;
ENDLOOP;
wH.msgViewerList ¬ NIL;
wH.msgSetViewerList ¬ NIL;
wH.wallabyViewerList ¬ NIL;
};
* * * * * * * * * * support for new mail
newMailCount: CARDINAL ¬ 0;
newMailProgressTimeToFlush: CARDINAL ¬ 10;
ReportProc: WalnutDefs.CheckReportProc = {
wH: WalnutHandle = CheckMailHandle[opsH];
IF wH # NIL THEN ReportFormat[wH, format, v1, v2, v2];
};
ProgressReport: WalnutDefs.CheckReportProc = {
wH: WalnutHandle = CheckMailHandle[opsH];
IF wH = NIL THEN RETURN;
IF wH.newMailRetrievalViewer # NIL THEN
IF wH.newMailRetrievalViewer.destroyed THEN {
wH.newMailRetrievalViewer ¬ NIL;
wH.newMailRetrievalStream ¬ NIL;
};
IF wH.newMailRetrievalStream # NIL THEN {
wH.newMailRetrievalStream.PutF[format, v1, v2, v3];
IF (newMailCount ¬ newMailCount + 1) > newMailProgressTimeToFlush THEN {
newMailCount ¬ 0;
wH.newMailRetrievalStream.Flush[];
};
};
};
GetMailLog: PROC[opsHandle: WalnutOps.WalnutOpsHandle] RETURNS[strm: STREAM] = {
wH: WalnutHandle = CheckMailHandle[opsHandle];
outcome: WaitCallOutcome;
Gml: PROC =
{ strm ¬ WalnutOps.StartNewMail[opsHandle] };
IF wH = NIL THEN RETURN;
IF (outcome ¬ DoWaitCall[wH, Gml]) = ok THEN {
SetMailState[wH, retrieving];
RETURN;
};
IF outcome = notRunning THEN Process.Pause[Process.SecondsToTicks[10]];
outcome ¬ DoWaitCall[wH, Gml];  -- try again
IF outcome = ok THEN SetMailState[wH, retrieving];
};
RecordNewMailInfo: PROC[opsHandle: WalnutOps.WalnutOpsHandle, logLen: INT, server: ROPE, num: INT]
 RETURNS[ok: BOOL ¬ FALSE] = {
wH: WalnutHandle = CheckMailHandle[opsHandle];
Rnml: PROC = {
ok ¬ FALSE;
WalnutOps.RecordNewMailInfo[opsHandle, logLen, server, num];
ok ¬ TRUE;
};
IF wH = NIL THEN RETURN[FALSE];
IF wH.opsH # opsHandle THEN
ERROR WalnutDefs.Error[$control, $WrongOpsHandle, "RecordNewMailInfo"];
[] ¬ DoWaitCall[wH, Rnml];
};
CheckMailHandle: PROC[opsH: WalnutOps.WalnutOpsHandle]
 RETURNS[wH: WalnutHandle] = {
wH ¬ WalnutWindow.GetHandleForMail[];
IF wH = NIL THEN RETURN;
IF wH.opsH # opsH THEN
ERROR WalnutDefs.Error[$control, $WrongOpsHandle];
};
NotifyWhenMailRetrieved: PROC[opsHandle: WalnutOps.WalnutOpsHandle, ok: BOOL, someMail: BOOL] = {
autoNewMail: BOOL;
wH: WalnutHandle = CheckMailHandle[opsHandle];
IF wH = NIL OR ~wH.personalMailDB THEN RETURN;
IF ~(wH.someMail ¬ someMail) THEN { SetMailState[wH, noMail]; RETURN};
SetMailState[wH, thereIsMail];
autoNewMail ¬ UserProfile.Boolean[key: "Walnut.AutoNewMail", default: FALSE];
IF autoNewMail THEN
TRUSTED { Process.Detach[FORK GetNewMail[wH] ] };
};
SetMailState: PUBLIC PROC[wH: WalnutHandle, mailState: MailState] = {
status: ROPE;
iconState: WalnutWindowPrivate.IconState ¬ regular;
IF wH.walnut = NIL THEN RETURN;
SELECT mailState FROM
noMail => status ¬ "There is no new mail at %g";
retrieving => status ¬ "Mail is being retrieved at %g";
thereIsMail => {
iconState ¬ haveNewMail;
status ¬ "You have new mail at %g";
};
waiting => status ¬ "Waiting (10 sec) for initial mail server response at %g";
noState => status ¬ "No mailbox state reported at %g";
noServers => status ¬ "All of the mail servers are down at %g";
someMail => status ¬ "Mail on some server(s) at %g";
ENDCASE => NULL;
IF wH.whichIcon # iconState THEN {
wH.walnut.icon ¬ wH.iconSet[wH.whichIcon ¬ iconState];
IF wH.walnut.iconic THEN ViewerOps.PaintViewer[wH.walnut, all];
};
Labels.Set[wH.mailNotifyLabel, IO.PutFR1[status, [time[BasicTime.Now[]]]] ];
};
END.